mod: Ext 17 — per-domain policy registry, 364/364
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
mod/register-policy! domain rules + mod/decide-in domain r reports give each rose-ash domain its own rule set; unregistered domains fall back to default-rules (never unmoderated). Same spam report → remove under a strict market policy, hide under blog default. Engine already took rules as a param, so this is registry + fallback, no engine change. +14 tests. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -24,6 +24,7 @@ PRELOADS=(
|
||||
lib/mod/sla.sx
|
||||
lib/mod/wire.sx
|
||||
lib/mod/activity.sx
|
||||
lib/mod/policies.sx
|
||||
lib/mod/lifecycle.sx
|
||||
lib/mod/audit.sx
|
||||
lib/mod/api.sx
|
||||
@@ -51,4 +52,5 @@ SUITES=(
|
||||
"wire:lib/mod/tests/wire.sx:(mod-wire-tests-run!)"
|
||||
"disjunction:lib/mod/tests/disjunction.sx:(mod-disjunction-tests-run!)"
|
||||
"activity:lib/mod/tests/activity.sx:(mod-activity-tests-run!)"
|
||||
"policies:lib/mod/tests/policies.sx:(mod-policies-tests-run!)"
|
||||
)
|
||||
|
||||
40
lib/mod/policies.sx
Normal file
40
lib/mod/policies.sx
Normal file
@@ -0,0 +1,40 @@
|
||||
;; lib/mod/policies.sx — per-domain policy registry.
|
||||
;;
|
||||
;; rose-ash spans domains (blog, market, events, federation, …) that want
|
||||
;; different moderation — a marketplace listing and a blog comment are not held to
|
||||
;; the same bar. This registry maps a domain to a rule set; mod/decide-in resolves
|
||||
;; the right policy and decides. Unregistered domains fall back to the default
|
||||
;; rules, so adding a domain never leaves it unmoderated.
|
||||
|
||||
(define mod/*policies* (list))
|
||||
|
||||
(define mod/policies-reset! (fn () (set! mod/*policies* (list))))
|
||||
|
||||
(define
|
||||
mod/register-policy!
|
||||
(fn (domain rules) (begin (append! mod/*policies* {:domain domain :rules rules}) true)))
|
||||
|
||||
(define
|
||||
mod/policy-registered?
|
||||
(fn
|
||||
(domain)
|
||||
(mod/any? (fn (p) (= (get p :domain) domain)) mod/*policies*)))
|
||||
|
||||
(define
|
||||
mod/policy-for
|
||||
(fn
|
||||
(domain)
|
||||
(reduce
|
||||
(fn (acc p) (if (= (get p :domain) domain) (get p :rules) acc))
|
||||
mod/default-rules
|
||||
mod/*policies*)))
|
||||
|
||||
(define
|
||||
mod/decide-in
|
||||
(fn
|
||||
(domain r reports)
|
||||
(mod/decide-report r reports (mod/policy-for domain))))
|
||||
|
||||
(define
|
||||
mod/registered-domains
|
||||
(fn () (map (fn (p) (get p :domain)) mod/*policies*)))
|
||||
@@ -1,8 +1,8 @@
|
||||
{
|
||||
"lang": "mod",
|
||||
"total_passed": 350,
|
||||
"total_passed": 364,
|
||||
"total_failed": 0,
|
||||
"total": 350,
|
||||
"total": 364,
|
||||
"suites": [
|
||||
{"name":"decide","passed":31,"failed":0,"total":31},
|
||||
{"name":"audit","passed":29,"failed":0,"total":29},
|
||||
@@ -21,7 +21,8 @@
|
||||
{"name":"sla","passed":15,"failed":0,"total":15},
|
||||
{"name":"wire","passed":16,"failed":0,"total":16},
|
||||
{"name":"disjunction","passed":10,"failed":0,"total":10},
|
||||
{"name":"activity","passed":17,"failed":0,"total":17}
|
||||
{"name":"activity","passed":17,"failed":0,"total":17},
|
||||
{"name":"policies","passed":14,"failed":0,"total":14}
|
||||
],
|
||||
"generated": "2026-06-06T19:28:13+00:00"
|
||||
"generated": "2026-06-06T19:32:52+00:00"
|
||||
}
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
# mod scoreboard
|
||||
|
||||
**350 / 350 passing** (0 failure(s)).
|
||||
**364 / 364 passing** (0 failure(s)).
|
||||
|
||||
| Suite | Passed | Total | Status |
|
||||
|-------|--------|-------|--------|
|
||||
@@ -22,3 +22,4 @@
|
||||
| wire | 16 | 16 | ok |
|
||||
| disjunction | 10 | 10 | ok |
|
||||
| activity | 17 | 17 | ok |
|
||||
| policies | 14 | 14 | ok |
|
||||
|
||||
112
lib/mod/tests/policies.sx
Normal file
112
lib/mod/tests/policies.sx
Normal file
@@ -0,0 +1,112 @@
|
||||
;; lib/mod/tests/policies.sx — Ext 17: per-domain policy registry.
|
||||
|
||||
(define mod-pol-count 0)
|
||||
(define mod-pol-pass 0)
|
||||
(define mod-pol-fail 0)
|
||||
(define mod-pol-failures (list))
|
||||
|
||||
(define
|
||||
mod-pol-test!
|
||||
(fn
|
||||
(name got expected)
|
||||
(begin
|
||||
(set! mod-pol-count (+ mod-pol-count 1))
|
||||
(if
|
||||
(= got expected)
|
||||
(set! mod-pol-pass (+ mod-pol-pass 1))
|
||||
(begin
|
||||
(set! mod-pol-fail (+ mod-pol-fail 1))
|
||||
(append!
|
||||
mod-pol-failures
|
||||
(str name "\n expected: " expected "\n got: " got)))))))
|
||||
|
||||
(mod/policies-reset!)
|
||||
|
||||
;; market is strict: spam is removed outright, not just hidden
|
||||
(define
|
||||
mod-pol-market-rules
|
||||
(list
|
||||
(mod/mk-rule
|
||||
"market-spam-remove"
|
||||
:remove (list (list :classification "spam")))
|
||||
(mod/mk-rule "default-keep" :keep (list))))
|
||||
|
||||
(mod-pol-test!
|
||||
"unregistered domain falls back to default"
|
||||
(mod/policy-registered? "market")
|
||||
false)
|
||||
(mod/register-policy! "market" mod-pol-market-rules)
|
||||
(mod-pol-test!
|
||||
"domain registered after register!"
|
||||
(mod/policy-registered? "market")
|
||||
true)
|
||||
|
||||
(define mod-pol-spam (mod/mk-report "r1" "a" "b" "this is spam"))
|
||||
|
||||
;; ── same report, different domain → different action ──
|
||||
|
||||
(mod-pol-test!
|
||||
"market policy removes spam"
|
||||
(get (mod/decide-in "market" mod-pol-spam (list mod-pol-spam)) :action)
|
||||
"remove")
|
||||
(mod-pol-test!
|
||||
"market decision uses market rule"
|
||||
(get (mod/decide-in "market" mod-pol-spam (list mod-pol-spam)) :rule)
|
||||
"market-spam-remove")
|
||||
(mod-pol-test!
|
||||
"blog (unregistered) uses default → hide"
|
||||
(get (mod/decide-in "blog" mod-pol-spam (list mod-pol-spam)) :action)
|
||||
"hide")
|
||||
(mod-pol-test!
|
||||
"blog decision uses default rule"
|
||||
(get (mod/decide-in "blog" mod-pol-spam (list mod-pol-spam)) :rule)
|
||||
"spam-hide")
|
||||
|
||||
;; ── policy-for resolution ──
|
||||
|
||||
(mod-pol-test!
|
||||
"policy-for market returns market rules"
|
||||
(mod/policy-for "market")
|
||||
mod-pol-market-rules)
|
||||
(mod-pol-test!
|
||||
"policy-for unknown returns default"
|
||||
(mod/policy-for "events")
|
||||
mod/default-rules)
|
||||
(mod-pol-test!
|
||||
"registered-domains lists market"
|
||||
(mod/registered-domains)
|
||||
(list "market"))
|
||||
|
||||
;; ── a second domain ──
|
||||
|
||||
(define
|
||||
mod-pol-events-rules
|
||||
(list (mod/mk-rule "events-keep-all" :keep (list))))
|
||||
|
||||
(mod/register-policy! "events" mod-pol-events-rules)
|
||||
(mod-pol-test!
|
||||
"events policy keeps everything (even spam)"
|
||||
(get (mod/decide-in "events" mod-pol-spam (list mod-pol-spam)) :action)
|
||||
"keep")
|
||||
(mod-pol-test!
|
||||
"two domains registered"
|
||||
(len (mod/registered-domains))
|
||||
2)
|
||||
(mod-pol-test!
|
||||
"market still removes after second registration"
|
||||
(get (mod/decide-in "market" mod-pol-spam (list mod-pol-spam)) :action)
|
||||
"remove")
|
||||
|
||||
;; ── clean report is keep everywhere ──
|
||||
|
||||
(define mod-pol-clean (mod/mk-report "r2" "a" "b" "a fine post"))
|
||||
(mod-pol-test!
|
||||
"clean report keep in market"
|
||||
(get (mod/decide-in "market" mod-pol-clean (list mod-pol-clean)) :action)
|
||||
"keep")
|
||||
(mod-pol-test!
|
||||
"clean report keep in blog"
|
||||
(get (mod/decide-in "blog" mod-pol-clean (list mod-pol-clean)) :action)
|
||||
"keep")
|
||||
|
||||
(define mod-policies-tests-run! (fn () {:failures mod-pol-failures :total mod-pol-count :passed mod-pol-pass :failed mod-pol-fail}))
|
||||
Reference in New Issue
Block a user