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/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!)"
|
||||||
)
|
)
|
||||||
|
|||||||
@@ -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"
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -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
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)
|
## 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?`
|
||||||
|
|||||||
Reference in New Issue
Block a user