mod: Ext 5 — policy rule-set lint (unreachable/catch-all/dups), 190/190
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m12s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m12s
Static analysis of a policy without running the engine: mod/unreachable-rules flags rules after an unconditional rule (dead under first-match precedence), mod/has-catchall? checks total coverage, mod/duplicate-rule-names + mod/rules-ok? give a well-formedness verdict policy authors can assert. Own suite. +14 tests. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
69
lib/mod/lint.sx
Normal file
69
lib/mod/lint.sx
Normal file
@@ -0,0 +1,69 @@
|
||||
;; lib/mod/lint.sx — static analysis of a policy rule set.
|
||||
;;
|
||||
;; Because precedence is "first matching clause wins" (pl-query-one), the rule
|
||||
;; order has correctness consequences a moderator can get wrong: a rule placed
|
||||
;; after an unconditional (empty :when) rule can never fire, and a rule set with
|
||||
;; no unconditional rule may leave some reports undecided. lint-rules surfaces
|
||||
;; these without running the engine.
|
||||
|
||||
(define mod/rule-unconditional? (fn (r) (empty? (mod/rule-when r))))
|
||||
|
||||
;; names of rules that follow the first unconditional rule — structurally dead,
|
||||
;; since the unconditional rule always matches first
|
||||
(define
|
||||
mod/unreachable-rules
|
||||
(fn
|
||||
(rules)
|
||||
(get
|
||||
(reduce
|
||||
(fn
|
||||
(acc r)
|
||||
(if
|
||||
(get acc :hit)
|
||||
{:dead (append (get acc :dead) (list (mod/rule-name r))) :hit true}
|
||||
(if (mod/rule-unconditional? r) {:dead (get acc :dead) :hit true} acc)))
|
||||
{:dead (list) :hit false}
|
||||
rules)
|
||||
:dead)))
|
||||
|
||||
(define
|
||||
mod/has-catchall?
|
||||
(fn (rules) (mod/any? mod/rule-unconditional? rules)))
|
||||
|
||||
(define
|
||||
mod/count-eq
|
||||
(fn
|
||||
(x lst)
|
||||
(reduce (fn (a y) (if (= y x) (+ a 1) a)) 0 lst)))
|
||||
|
||||
(define
|
||||
mod/duplicate-rule-names
|
||||
(fn
|
||||
(rules)
|
||||
(let
|
||||
((names (map mod/rule-name rules)))
|
||||
(mod/distinct
|
||||
(reduce
|
||||
(fn
|
||||
(acc n)
|
||||
(if
|
||||
(< 1 (mod/count-eq n names))
|
||||
(append acc (list n))
|
||||
acc))
|
||||
(list)
|
||||
names)))))
|
||||
|
||||
(define mod/lint-rules (fn (rules) {:duplicate-names (mod/duplicate-rule-names rules) :has-catchall (mod/has-catchall? rules) :unreachable (mod/unreachable-rules rules)}))
|
||||
|
||||
;; a rule set is well-formed when nothing is dead, it has a catch-all, and rule
|
||||
;; names are unique
|
||||
(define
|
||||
mod/rules-ok?
|
||||
(fn
|
||||
(rules)
|
||||
(let
|
||||
((l (mod/lint-rules rules)))
|
||||
(if
|
||||
(empty? (get l :unreachable))
|
||||
(if (get l :has-catchall) (empty? (get l :duplicate-names)) false)
|
||||
false))))
|
||||
Reference in New Issue
Block a user