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

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:
2026-06-06 18:20:15 +00:00
parent e53a292f1a
commit 01be84b5d8
6 changed files with 200 additions and 6 deletions

View File

@@ -14,6 +14,7 @@ PRELOADS=(
lib/mod/policy.sx lib/mod/policy.sx
lib/mod/engine.sx lib/mod/engine.sx
lib/mod/explain.sx lib/mod/explain.sx
lib/mod/severity.sx
lib/mod/lifecycle.sx lib/mod/lifecycle.sx
lib/mod/audit.sx lib/mod/audit.sx
lib/mod/api.sx lib/mod/api.sx
@@ -30,4 +31,5 @@ SUITES=(
"extensions:lib/mod/tests/extensions.sx:(mod-extensions-tests-run!)" "extensions:lib/mod/tests/extensions.sx:(mod-extensions-tests-run!)"
"link:lib/mod/tests/link.sx:(mod-link-tests-run!)" "link:lib/mod/tests/link.sx:(mod-link-tests-run!)"
"lint:lib/mod/tests/lint.sx:(mod-lint-tests-run!)" "lint:lib/mod/tests/lint.sx:(mod-lint-tests-run!)"
"severity:lib/mod/tests/severity.sx:(mod-severity-tests-run!)"
) )

View File

@@ -1,8 +1,8 @@
{ {
"lang": "mod", "lang": "mod",
"total_passed": 190, "total_passed": 204,
"total_failed": 0, "total_failed": 0,
"total": 190, "total": 204,
"suites": [ "suites": [
{"name":"decide","passed":31,"failed":0,"total":31}, {"name":"decide","passed":31,"failed":0,"total":31},
{"name":"audit","passed":29,"failed":0,"total":29}, {"name":"audit","passed":29,"failed":0,"total":29},
@@ -10,7 +10,8 @@
{"name":"fed","passed":26,"failed":0,"total":26}, {"name":"fed","passed":26,"failed":0,"total":26},
{"name":"extensions","passed":32,"failed":0,"total":32}, {"name":"extensions","passed":32,"failed":0,"total":32},
{"name":"link","passed":12,"failed":0,"total":12}, {"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"
} }

View File

@@ -1,6 +1,6 @@
# mod scoreboard # mod scoreboard
**190 / 190 passing** (0 failure(s)). **204 / 204 passing** (0 failure(s)).
| Suite | Passed | Total | Status | | Suite | Passed | Total | Status |
|-------|--------|-------|--------| |-------|--------|-------|--------|
@@ -11,3 +11,4 @@
| extensions | 32 | 32 | ok | | extensions | 32 | 32 | ok |
| link | 12 | 12 | ok | | link | 12 | 12 | ok |
| lint | 14 | 14 | ok | | lint | 14 | 14 | ok |
| severity | 14 | 14 | ok |

60
lib/mod/severity.sx Normal file
View 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
View 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}))

View File

@@ -16,7 +16,7 @@ federation extension.
## Status (rolling) ## 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 ## Ground rules
@@ -147,6 +147,11 @@ lib/mod/fed.sx
derivation goal-by-goal with `[proved]`/`[unproved]` marks and unification derivation goal-by-goal with `[proved]`/`[unproved]` marks and unification
bindings. E.g. `Report rc: escalate (rule: repeated-escalate)` … `[proved] 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}`. 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 - [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- set: `mod/unreachable-rules` flags rules placed after an unconditional (always-
matching) rule — structurally dead under first-match precedence; matching) rule — structurally dead under first-match precedence;
@@ -160,6 +165,11 @@ lib/mod/fed.sx
## Progress log ## 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, - **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 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?` catch-all, missing catch-all (undecided reports), duplicate names. `mod/rules-ok?`