giles
e53a292f1a
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>
123 lines
3.1 KiB
Plaintext
123 lines
3.1 KiB
Plaintext
;; lib/mod/tests/lint.sx — Ext 5: policy rule-set static analysis.
|
|
|
|
(define mod-lint-count 0)
|
|
(define mod-lint-pass 0)
|
|
(define mod-lint-fail 0)
|
|
(define mod-lint-failures (list))
|
|
|
|
(define
|
|
mod-lint-test!
|
|
(fn
|
|
(name got expected)
|
|
(begin
|
|
(set! mod-lint-count (+ mod-lint-count 1))
|
|
(if
|
|
(= got expected)
|
|
(set! mod-lint-pass (+ mod-lint-pass 1))
|
|
(begin
|
|
(set! mod-lint-fail (+ mod-lint-fail 1))
|
|
(append!
|
|
mod-lint-failures
|
|
(str name "\n expected: " expected "\n got: " got)))))))
|
|
|
|
;; ── the default rule set is well-formed ──
|
|
|
|
(mod-lint-test!
|
|
"default rules: no unreachable"
|
|
(mod/unreachable-rules mod/default-rules)
|
|
(list))
|
|
(mod-lint-test!
|
|
"default rules: has catch-all"
|
|
(mod/has-catchall? mod/default-rules)
|
|
true)
|
|
(mod-lint-test!
|
|
"default rules: no duplicate names"
|
|
(mod/duplicate-rule-names mod/default-rules)
|
|
(list))
|
|
(mod-lint-test!
|
|
"default rules: well-formed"
|
|
(mod/rules-ok? mod/default-rules)
|
|
true)
|
|
|
|
;; ── unreachable detection ──
|
|
|
|
(define
|
|
mod-lint-shadowed
|
|
(list
|
|
(mod/mk-rule "spam-hide" :hide (list (list :classification "spam")))
|
|
(mod/mk-rule "catch-all" :keep (list))
|
|
(mod/mk-rule
|
|
"abuse-remove"
|
|
:remove (list (list :classification "abuse")))
|
|
(mod/mk-rule
|
|
"repeated"
|
|
:escalate (list (list :count-at-least 3)))))
|
|
|
|
(mod-lint-test!
|
|
"rules after catch-all are unreachable"
|
|
(mod/unreachable-rules mod-lint-shadowed)
|
|
(list "abuse-remove" "repeated"))
|
|
(mod-lint-test!
|
|
"shadowed rule set is not ok"
|
|
(mod/rules-ok? mod-lint-shadowed)
|
|
false)
|
|
|
|
;; ── missing catch-all ──
|
|
|
|
(define
|
|
mod-lint-nocatch
|
|
(list
|
|
(mod/mk-rule "spam-hide" :hide (list (list :classification "spam")))
|
|
(mod/mk-rule
|
|
"abuse-remove"
|
|
:remove (list (list :classification "abuse")))))
|
|
|
|
(mod-lint-test!
|
|
"no catch-all detected"
|
|
(mod/has-catchall? mod-lint-nocatch)
|
|
false)
|
|
(mod-lint-test!
|
|
"no unreachable when no catch-all"
|
|
(mod/unreachable-rules mod-lint-nocatch)
|
|
(list))
|
|
(mod-lint-test!
|
|
"no-catch-all rule set is not ok"
|
|
(mod/rules-ok? mod-lint-nocatch)
|
|
false)
|
|
|
|
;; ── duplicate names ──
|
|
|
|
(define
|
|
mod-lint-dups
|
|
(list
|
|
(mod/mk-rule "x" :hide (list (list :classification "spam")))
|
|
(mod/mk-rule "x" :remove (list (list :classification "abuse")))
|
|
(mod/mk-rule "default" :keep (list))))
|
|
|
|
(mod-lint-test!
|
|
"duplicate names detected"
|
|
(mod/duplicate-rule-names mod-lint-dups)
|
|
(list "x"))
|
|
(mod-lint-test!
|
|
"duplicate-name rule set is not ok"
|
|
(mod/rules-ok? mod-lint-dups)
|
|
false)
|
|
|
|
;; ── helpers ──
|
|
|
|
(mod-lint-test!
|
|
"rule-unconditional? true for empty when"
|
|
(mod/rule-unconditional? (mod/mk-rule "d" :keep (list)))
|
|
true)
|
|
(mod-lint-test!
|
|
"rule-unconditional? false with conditions"
|
|
(mod/rule-unconditional?
|
|
(mod/mk-rule "s" :hide (list (list :classification "spam"))))
|
|
false)
|
|
(mod-lint-test!
|
|
"count-eq counts occurrences"
|
|
(mod/count-eq "a" (list "a" "b" "a"))
|
|
2)
|
|
|
|
(define mod-lint-tests-run! (fn () {:failures mod-lint-failures :total mod-lint-count :passed mod-lint-pass :failed mod-lint-fail}))
|