mod: Ext 6 — strictest-wins decision strategy + action severity, 204/204
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m3s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m3s
mod/decide-strictest collects every proven rule (pl-query-all) and applies the harshest action by mod/action-severity (keep<escalate<hide<remove<ban), an alternative to the engine's first-match precedence. Diverges from first-match exactly when rule order and severity disagree. Same decision shape + :strategy; engine untouched. Own suite. +14 tests. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -14,6 +14,7 @@ PRELOADS=(
|
||||
lib/mod/policy.sx
|
||||
lib/mod/engine.sx
|
||||
lib/mod/explain.sx
|
||||
lib/mod/severity.sx
|
||||
lib/mod/lifecycle.sx
|
||||
lib/mod/audit.sx
|
||||
lib/mod/api.sx
|
||||
@@ -30,4 +31,5 @@ SUITES=(
|
||||
"extensions:lib/mod/tests/extensions.sx:(mod-extensions-tests-run!)"
|
||||
"link:lib/mod/tests/link.sx:(mod-link-tests-run!)"
|
||||
"lint:lib/mod/tests/lint.sx:(mod-lint-tests-run!)"
|
||||
"severity:lib/mod/tests/severity.sx:(mod-severity-tests-run!)"
|
||||
)
|
||||
|
||||
@@ -1,8 +1,8 @@
|
||||
{
|
||||
"lang": "mod",
|
||||
"total_passed": 190,
|
||||
"total_passed": 204,
|
||||
"total_failed": 0,
|
||||
"total": 190,
|
||||
"total": 204,
|
||||
"suites": [
|
||||
{"name":"decide","passed":31,"failed":0,"total":31},
|
||||
{"name":"audit","passed":29,"failed":0,"total":29},
|
||||
@@ -10,7 +10,8 @@
|
||||
{"name":"fed","passed":26,"failed":0,"total":26},
|
||||
{"name":"extensions","passed":32,"failed":0,"total":32},
|
||||
{"name":"link","passed":12,"failed":0,"total":12},
|
||||
{"name":"lint","passed":14,"failed":0,"total":14}
|
||||
{"name":"lint","passed":14,"failed":0,"total":14},
|
||||
{"name":"severity","passed":14,"failed":0,"total":14}
|
||||
],
|
||||
"generated": "2026-06-06T18:15:06+00:00"
|
||||
"generated": "2026-06-06T18:19:30+00:00"
|
||||
}
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# mod scoreboard
|
||||
|
||||
**190 / 190 passing** (0 failure(s)).
|
||||
**204 / 204 passing** (0 failure(s)).
|
||||
|
||||
| Suite | Passed | Total | Status |
|
||||
|-------|--------|-------|--------|
|
||||
@@ -11,3 +11,4 @@
|
||||
| extensions | 32 | 32 | ok |
|
||||
| link | 12 | 12 | ok |
|
||||
| lint | 14 | 14 | ok |
|
||||
| severity | 14 | 14 | ok |
|
||||
|
||||
60
lib/mod/severity.sx
Normal file
60
lib/mod/severity.sx
Normal file
@@ -0,0 +1,60 @@
|
||||
;; lib/mod/severity.sx — "strictest-wins" decision strategy.
|
||||
;;
|
||||
;; The default engine resolves precedence by rule ORDER (first proven clause wins,
|
||||
;; via pl-query-one). Some policies instead want the HARSHEST applicable sanction
|
||||
;; regardless of order. mod/decide-strictest collects every rule that proves
|
||||
;; (pl-query-all) and picks the highest-severity action. Same decision shape as
|
||||
;; the engine, plus :strategy. Built over the engine's helpers; engine untouched.
|
||||
|
||||
(define
|
||||
mod/action-severity
|
||||
(fn
|
||||
(action)
|
||||
(cond
|
||||
((= action "ban") 4)
|
||||
((= action "remove") 3)
|
||||
((= action "hide") 2)
|
||||
((= action "escalate") 1)
|
||||
(true 0))))
|
||||
|
||||
(define
|
||||
mod/strictest-sol
|
||||
(fn
|
||||
(sols)
|
||||
(reduce
|
||||
(fn
|
||||
(acc s)
|
||||
(if
|
||||
(nil? acc)
|
||||
s
|
||||
(if
|
||||
(<
|
||||
(mod/action-severity (dict-get acc "Action"))
|
||||
(mod/action-severity (dict-get s "Action")))
|
||||
s
|
||||
acc)))
|
||||
nil
|
||||
sols)))
|
||||
|
||||
(define
|
||||
mod/decide-strictest
|
||||
(fn
|
||||
(r reports rules)
|
||||
(let
|
||||
((count (mod/report-count (mod/report-about r) reports))
|
||||
(kinds (mod/classify-keywords r))
|
||||
(id (mod/report-id r)))
|
||||
(let
|
||||
((program (mod/build-program r count rules)))
|
||||
(let
|
||||
((db (pl-load program)))
|
||||
(let
|
||||
((sols (pl-query-all db (str "policy_action(" id ", Action, Rule)"))))
|
||||
(let
|
||||
((best (mod/strictest-sol sols)))
|
||||
(if
|
||||
(nil? best)
|
||||
{:action "keep" :proof {:goals (list) :evidence kinds :conditions (list) :rule "none" :count count} :report-id id :rule "none" :strategy "strictest"}
|
||||
(let
|
||||
((rule (mod/find-rule rules (dict-get best "Rule"))))
|
||||
{:action (mod/rule-action rule) :proof {:goals (mod/proof-goals db id (mod/rule-when rule)) :evidence kinds :conditions (mod/rule-when rule) :rule (mod/rule-name rule) :count count} :report-id id :rule (mod/rule-name rule) :strategy "strictest"})))))))))
|
||||
120
lib/mod/tests/severity.sx
Normal file
120
lib/mod/tests/severity.sx
Normal file
@@ -0,0 +1,120 @@
|
||||
;; lib/mod/tests/severity.sx — Ext 6: strictest-wins decision strategy.
|
||||
|
||||
(define mod-sev-count 0)
|
||||
(define mod-sev-pass 0)
|
||||
(define mod-sev-fail 0)
|
||||
(define mod-sev-failures (list))
|
||||
|
||||
(define
|
||||
mod-sev-test!
|
||||
(fn
|
||||
(name got expected)
|
||||
(begin
|
||||
(set! mod-sev-count (+ mod-sev-count 1))
|
||||
(if
|
||||
(= got expected)
|
||||
(set! mod-sev-pass (+ mod-sev-pass 1))
|
||||
(begin
|
||||
(set! mod-sev-fail (+ mod-sev-fail 1))
|
||||
(append!
|
||||
mod-sev-failures
|
||||
(str name "\n expected: " expected "\n got: " got)))))))
|
||||
|
||||
;; ── severity ranking ──
|
||||
|
||||
(mod-sev-test! "ban most severe" (mod/action-severity "ban") 4)
|
||||
(mod-sev-test!
|
||||
"remove > hide"
|
||||
(< (mod/action-severity "hide") (mod/action-severity "remove"))
|
||||
true)
|
||||
(mod-sev-test! "keep least severe" (mod/action-severity "keep") 0)
|
||||
(mod-sev-test!
|
||||
"escalate above keep"
|
||||
(< (mod/action-severity "keep") (mod/action-severity "escalate"))
|
||||
true)
|
||||
|
||||
;; ── strictest agrees with default-rules on simple cases ──
|
||||
|
||||
(define mod-sev-spam (mod/mk-report "r1" "a" "b" "this is spam"))
|
||||
(mod-sev-test!
|
||||
"strictest spam → hide"
|
||||
(get
|
||||
(mod/decide-strictest mod-sev-spam (list mod-sev-spam) mod/default-rules)
|
||||
:action)
|
||||
"hide")
|
||||
(define mod-sev-clean (mod/mk-report "r2" "a" "b" "a fine post"))
|
||||
(mod-sev-test!
|
||||
"strictest clean → keep"
|
||||
(get
|
||||
(mod/decide-strictest
|
||||
mod-sev-clean
|
||||
(list mod-sev-clean)
|
||||
mod/default-rules)
|
||||
:action)
|
||||
"keep")
|
||||
(mod-sev-test!
|
||||
"decision tagged strategy strictest"
|
||||
(get
|
||||
(mod/decide-strictest mod-sev-spam (list mod-sev-spam) mod/default-rules)
|
||||
:strategy)
|
||||
"strictest")
|
||||
|
||||
;; ── strictest diverges from first-match when order ≠ severity ──
|
||||
|
||||
(define
|
||||
mod-sev-rules
|
||||
(list
|
||||
(mod/mk-rule
|
||||
"early-escalate"
|
||||
:escalate (list (list :count-at-least 1)))
|
||||
(mod/mk-rule "spam-remove" :remove (list (list :classification "spam")))
|
||||
(mod/mk-rule "default-keep" :keep (list))))
|
||||
|
||||
(define mod-sev-r (mod/mk-report "r3" "a" "b" "this is spam"))
|
||||
|
||||
(mod-sev-test!
|
||||
"first-match picks earliest rule (escalate)"
|
||||
(get (mod/decide-report mod-sev-r (list mod-sev-r) mod-sev-rules) :action)
|
||||
"escalate")
|
||||
(mod-sev-test!
|
||||
"strictest picks harshest action (remove)"
|
||||
(get
|
||||
(mod/decide-strictest mod-sev-r (list mod-sev-r) mod-sev-rules)
|
||||
:action)
|
||||
"remove")
|
||||
(mod-sev-test!
|
||||
"strictest names the harshest rule"
|
||||
(get (mod/decide-strictest mod-sev-r (list mod-sev-r) mod-sev-rules) :rule)
|
||||
"spam-remove")
|
||||
(mod-sev-test!
|
||||
"strictest carries proof goals"
|
||||
(len
|
||||
(get
|
||||
(get
|
||||
(mod/decide-strictest mod-sev-r (list mod-sev-r) mod-sev-rules)
|
||||
:proof)
|
||||
:goals))
|
||||
1)
|
||||
|
||||
;; ── strictest among three matches (spam + repeated) ──
|
||||
|
||||
(define mod-sev-rep (mod/mk-report "r4" "a" "b" "buy now spam"))
|
||||
(define mod-sev-reps (list mod-sev-rep mod-sev-rep mod-sev-rep))
|
||||
(mod-sev-test!
|
||||
"strictest among hide+escalate+keep → hide (default rules)"
|
||||
(get
|
||||
(mod/decide-strictest mod-sev-rep mod-sev-reps mod/default-rules)
|
||||
:action)
|
||||
"hide")
|
||||
|
||||
;; ── strictest-sol helper ──
|
||||
|
||||
(mod-sev-test!
|
||||
"strictest-sol picks max severity"
|
||||
(dict-get
|
||||
(mod/strictest-sol (list {:Action "keep" :Rule "k"} {:Action "remove" :Rule "r"} {:Action "hide" :Rule "h"}))
|
||||
"Action")
|
||||
"remove")
|
||||
(mod-sev-test! "strictest-sol nil for empty" (mod/strictest-sol (list)) nil)
|
||||
|
||||
(define mod-severity-tests-run! (fn () {:failures mod-sev-failures :total mod-sev-count :passed mod-sev-pass :failed mod-sev-fail}))
|
||||
@@ -16,7 +16,7 @@ federation extension.
|
||||
|
||||
## Status (rolling)
|
||||
|
||||
`bash lib/mod/conformance.sh` → **190/190** (roadmap + 5 extensions complete)
|
||||
`bash lib/mod/conformance.sh` → **204/204** (roadmap + 6 extensions complete)
|
||||
|
||||
## Ground rules
|
||||
|
||||
@@ -147,6 +147,11 @@ lib/mod/fed.sx
|
||||
derivation goal-by-goal with `[proved]`/`[unproved]` marks and unification
|
||||
bindings. E.g. `Report rc: escalate (rule: repeated-escalate)` … `[proved]
|
||||
report(rc, B, S), report_count(S, N), N >= 3 {B=ann, N=3, S=dave}`.
|
||||
- [x] **Ext 6 — strictest-wins strategy** (`lib/mod/severity.sx`, +14). Alternative
|
||||
to first-match: `mod/decide-strictest` collects every proven rule (`pl-query-all`)
|
||||
and picks the highest-`mod/action-severity` action (keep<escalate<hide<remove<ban).
|
||||
Diverges from the default engine when rule order and severity disagree. Same
|
||||
decision shape + `:strategy`; engine untouched.
|
||||
- [x] **Ext 5 — policy lint** (`lib/mod/lint.sx`, +14). Static analysis of a rule
|
||||
set: `mod/unreachable-rules` flags rules placed after an unconditional (always-
|
||||
matching) rule — structurally dead under first-match precedence;
|
||||
@@ -160,6 +165,11 @@ lib/mod/fed.sx
|
||||
|
||||
## Progress log
|
||||
|
||||
- **Ext 6 — strictest-wins strategy, 204/204** (+14). A second decision strategy
|
||||
alongside first-match: collect all proven rules and apply the harshest sanction.
|
||||
Shows the substrate supports more than one precedence policy over the same rule
|
||||
facts — `pl-query-all` for the full match set, severity ranking in SX. Verified
|
||||
it diverges from first-match exactly when rule order and severity disagree.
|
||||
- **Ext 5 — policy lint, 190/190** (+14). Static analysis of the rule set itself,
|
||||
catching the failure modes first-match precedence makes easy: dead rules after a
|
||||
catch-all, missing catch-all (undecided reports), duplicate names. `mod/rules-ok?`
|
||||
|
||||
Reference in New Issue
Block a user