diff --git a/lib/mod/conformance.conf b/lib/mod/conformance.conf index 92e4abac..ccc017a9 100644 --- a/lib/mod/conformance.conf +++ b/lib/mod/conformance.conf @@ -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!)" ) diff --git a/lib/mod/scoreboard.json b/lib/mod/scoreboard.json index d75cab7b..5f185e5d 100644 --- a/lib/mod/scoreboard.json +++ b/lib/mod/scoreboard.json @@ -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" } diff --git a/lib/mod/scoreboard.md b/lib/mod/scoreboard.md index ecec4269..0fe3c277 100644 --- a/lib/mod/scoreboard.md +++ b/lib/mod/scoreboard.md @@ -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 | diff --git a/lib/mod/severity.sx b/lib/mod/severity.sx new file mode 100644 index 00000000..aae53f43 --- /dev/null +++ b/lib/mod/severity.sx @@ -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"}))))))))) diff --git a/lib/mod/tests/severity.sx b/lib/mod/tests/severity.sx new file mode 100644 index 00000000..2a40c6f5 --- /dev/null +++ b/lib/mod/tests/severity.sx @@ -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})) diff --git a/plans/mod-on-sx.md b/plans/mod-on-sx.md index 8670105d..c2ba8fce 100644 --- a/plans/mod-on-sx.md +++ b/plans/mod-on-sx.md @@ -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