Compare commits

..

35 Commits

Author SHA1 Message Date
2913cdc3a8 plans: correct extraction note — declined after reading both impls
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 57s
Reading lib/mod (Prolog) and lib/acl (Datalog) side by side shows the convergence
is in module names only. Federation: opposite trust models (SX registry + decision
sharing vs in-engine Datalog trust facts + fact replication), zero shared code.
Audit: only a ~5-fn core overlaps and it diverges (entry shapes, seq base 0 vs 1,
op sets, mutation idiom) — not worth a shared module under two restricted envs.
Outcome: keep them parallel; revisit only on a third same-model consumer.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 09:10:57 +00:00
538b8a53e0 plans: shared-plumbing extraction note — defer to post-merge integration
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 37s
mod-sx (Prolog) and acl-sx (Datalog) converged on the same module shape but run
on different engines. Only the audit log + fed trust/outbox shapes truly share;
extract at the architecture-merge point refactoring both consumers atomically,
not unilaterally from a loop branch.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 22:20:52 +00:00
739e743918 mod: Ext 19 — end-to-end triage pipeline (capstone), 390/390
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 41s
mod/triage-pipeline domain r reports actor composes domain-policy decision →
explanation → AP activity → wire into one bundle. Integration test runs the whole
federated path across 5 modules (decide → wire → peer → trust-gated apply),
confirming the module-by-module subsystem composes end to end. +15 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 19:40:36 +00:00
c19f658cf2 mod: Ext 18 — ergonomic defrule / ruleset surface, 375/375
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
mod/defrule collects trailing conditions via &rest; mod/ruleset assembles rules.
No macro needed — conditions are plain data, fn supports &rest here. Produces
structurally identical rules to mk-rule (asserted) and works in the engine
unchanged. Closes the roadmap's original defrule surface. +11 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 19:37:12 +00:00
2f75ab11fc mod: Ext 17 — per-domain policy registry, 364/364
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>
2026-06-06 19:33:24 +00:00
82fbf01bb3 mod: Ext 16 — ActivityPub-shaped decision export, 350/350
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 32s
mod/decision->activity maps a decision to a moderation verb (remove→Delete,
ban→Block, hide/escalate→Flag, keep→no activity) shaped like an AP activity,
preserving the precise action. mod/decisions->activities batch-exports dropping
keeps. With wire (Ext 14) + fed trust (Phase 4) the federated moderation path is
end-to-end: decide → activity/wire → peer → trust-gate → apply. +17 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 19:28:49 +00:00
329b3c4903 mod: Ext 15 — disjunctive (:any) conditions, 333/333
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 29s
(:any (list c1 c2 ...)) compiles to Prolog disjunction (g1 ; g2 ; ...), completing
the condition boolean algebra (AND via :when list, :not, :any). cond->goal
recurses so combinators nest arbitrarily; the proof tree shows the compiled
disjunction verbatim. Maps onto Prolog's control constructs rather than
reimplementing boolean logic in SX. +10 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 19:23:15 +00:00
b43901d297 mod: Ext 14 — decision wire format for federation transport, 323/323
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
mod/decision->wire emits a versioned pipe-delimited line (MOD1|r1|hide|spam-hide);
mod/wire->decision parses it back (mod/wire-valid? guards). split-char built over
slice/len (loaded env has no split). Integration test runs the full federated
path: serialize → wire → deserialize → fed-receive-decision trust-gating
(untrusted→advisory, trusted→applied). +16 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 19:17:19 +00:00
68c8e39508 mod: Ext 13 — SLA sweep over pending lifecycle cases, 307/307
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 6m28s
Composes lifecycle (Phase 3) with time (Ext 12): a timed-case pairs a case with
its state-entry tick; mod/overdue? flags pending cases (open/triaged/appealed)
past a deadline; mod/sla-sweep returns the breached report ids. Terminal states
never breach. Pure overlay — lifecycle stays timeless, caller stamps entry. +15 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 19:08:37 +00:00
92addf5146 mod: Ext 12 — temporal burst detection, 292/292
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Reports gain an :at tick (deterministic, supplied). mod/decide-temporal counts
reports about a subject within [now-window, now], asserts burst_count/2, and a
(:burst-at-least K) rule fires only on a real burst. 3 reports at 10/11/12 → hide;
3 at 1/2/12 (window 5) → keep, while the plain count rule escalates both. Fifth
report field threaded through rebuild helpers, non-breaking. +15 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 19:00:51 +00:00
8292607e38 mod: Ext 11 — batch triage + corpus analytics, 277/277
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 58s
mod/decide-batch triages a queue; mod/action-histogram summarizes outcomes by
action; mod/rule-coverage + mod/never-fired measure which rules fire across a
corpus — the empirical complement to lint's static unreachable check (lint finds
rules that can't fire; never-fired finds rules that didn't). +17 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:56:19 +00:00
bf65de7b24 mod: Ext 10 — policy what-if / impact analysis, 260/260
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 57s
mod/decision-diff compares one report's action under two rule sets;
mod/policy-impact batches a set and returns only the reports whose decision flips;
mod/impact-count / mod/impact-report summarize. Lets a mod team measure a policy
change's blast radius before shipping (e.g. removing spam-hide flips r1 hide→keep).
Pure SX over decide-report. +13 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:51:47 +00:00
3764b62206 mod: Ext 9 — policy dry-run trace diagnostics, 247/247
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 49s
mod/trace-rules evaluates a report against every rule, returning each rule's
proved/unproved status + goal-by-goal derivation (an unproved rule shows which
goal failed). mod/first-proved = winner (matches engine precedence, cross-checked),
mod/proved-rules the firing set, mod/trace-report a [fires]/[ - ] rendering.
Answers 'why didn't my rule fire?' without instrumenting the engine. +15 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:48:44 +00:00
062a76e64f mod: Ext 8 — quorum over distinct reporters (anti-brigade), 232/232
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 55s
(:reporters-at-least N) compiles to setof(Br, report(_, Br, Sr), Bsr),
length(Bsr, Nr), Nr >= N — counts distinct reporters, not raw reports.
mod/decide-quorum asserts every report's report/3 fact (base engine scopes to the
decided report) so Prolog can aggregate reporters. One user filing 3 reports stays
:keep under quorum while the count rule escalates. Own suite. +9 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:45:28 +00:00
50eb7079e5 briefings: mod-loop — cut/backtracking allowance + sx_write_file-first + loaded-env/not(Goal) gotchas
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m15s
Make explicit that the loop may lean on Prolog backtracking (pl-query-all) and cut,
preferring clause-order precedence via pl-query-one. Default to sx_write_file over
path/pattern edits; flag that sx_insert_near drops all but the first form. Document
the loaded-env primitive restriction (includes?/chars/etc. undefined after prolog
preloads; use the tokenizer's surviving set) and that negation is the not(Goal)
functor, not the prefix \+ operator.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:30:44 +00:00
c3668e4461 mod: Ext 7 — repeat-offender escalation (audit log as evidence), 223/223
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m13s
mod/subject-sanctions counts prior hide/remove/ban decisions about a subject from
the append-only audit log; mod/decide-escalating upgrades a sanction to :ban when
the subject has >= k priors. Non-sanction outcomes (keep/escalate) pass through.
Closes the loop between audit and policy — the trail feeds future decisions. Own
suite. +19 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:29:36 +00:00
01be84b5d8 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>
2026-06-06 18:20:15 +00:00
e53a292f1a mod: Ext 5 — policy rule-set lint (unreachable/catch-all/dups), 190/190
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m12s
Static analysis of a policy without running the engine: mod/unreachable-rules
flags rules after an unconditional rule (dead under first-match precedence),
mod/has-catchall? checks total coverage, mod/duplicate-rule-names + mod/rules-ok?
give a well-formedness verdict policy authors can assert. Own suite. +14 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:15:41 +00:00
3d2c1d94f2 mod: Ext 4 — report linking + dedup (Prolog-backed retrieval), 176/176
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 49s
mod/related-ids and mod/reporters-of find reports about a subject via a Prolog
relational query (report(Id, _, 'subject')) — the policy substrate reused for
retrieval. mod/dedup-reports collapses identical reports by a normalized
reporter|subject|reason key; mod/distinct-reporters-of counts unique reporters.
Own suite (tests/link.sx). +12 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:09:37 +00:00
102c806451 mod: Ext 3 — human-readable proof explanation (mod/explain), 164/164
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 47s
mod/explain renders a decision's proof tree into legible text: action + rule,
evidence line, and each derivation goal with [proved]/[unproved] and the
unification bindings that satisfied it (e.g. {B=ann, N=3, S=dave}). Pure SX over
the Phase-2 proof data — the audit trail's 'why' made readable. +10 tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:06:29 +00:00
779a592614 mod: Ext 2 — weighted/aggregate scoring (:score-at-least), 154/154
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 52s
Report :signals ({:kind :weight}) project to signal(Id, 'kind', weight) facts;
condition (:score-at-least N) compiles to aggregate_all(sum(W), signal(Id,_,W),T),
T >= N. Low-confidence signals accumulate past a threshold via genuine Prolog
arithmetic aggregation. Default policy untouched — proven via custom rule sets.
+8 extension tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:02:52 +00:00
2ea87796a1 mod: Ext 1 — negation-as-failure conditions (:not / :attr), 146/146
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 44s
Report attributes (:attrs) project to attr(Id, name) facts; policy gains (:attr x)
and (:not <cond>) conditions. The Prolog substrate exposes negation as a functor
not(Goal) (the prefix \+ operator doesn't parse here). Closed-world example:
hide spam unless author verified. Default policy untouched — feature proven via
custom rule sets, so all 132 base tests stay green. +14 extension tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:59:01 +00:00
ee9851c063 mod: Phase 4 — federation (trust, sharing, revocation), 132/132 — roadmap done
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 55s
Cross-instance reports ingest into the local registry with origin tags; the
engine decides them unchanged. Decision sharing pushes to a mock fed-sx outbox
(mod/fed-send! is the transport seam). Trust is advisory by default: a peer's
decision binds locally only under (mod/trusted? peer :mod), else it lands in the
advisory log unapplied. Revocation composes with the Phase-2 proof model —
fed-revoke-if-invalidated re-runs the engine and undoes moderation only when the
action no longer holds (exoneration flips hide→keep → revoked + origin notified).
+26 fed tests. Full mod-on-sx roadmap complete.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:54:37 +00:00
f4f34c1d33 mod: Phase 3 — lifecycle state machine + escalation + appeal, 106/106
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 54s
Pure SX state machine (lib/mod/lifecycle.sx) over the engine:
open→triaged→decided→appealed→final, transition table guards illegal moves.
Auto-tier resolves terminal actions; escalate parks at human-tier (resolve
blocked until review supplies evidence). Appeal re-runs the engine — new
exonerated-keep rule at top precedence lets exoneration override a prior hide.
Api façade (mod/triage/resolve/review/appeal/finalize) over a case registry,
logging committed decisions to the audit trail. +46 escalation tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:50:05 +00:00
6e825e1283 mod: Phase 2 — evidence accumulation + proof trees + audit log, 60/60
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m7s
Reports carry an :evidence list, asserted as evidence/3 facts; reviewer-remove
rule (highest precedence) lets human review override classification. Proof tree
built constructively by re-querying each rule body goal against the same DB with
the report id bound, so derivations carry real unification bindings. Append-only
audit log records decision + proof + evidence snapshot per decide, monotonic seq,
never mutates prior entries. +29 audit tests.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:37:02 +00:00
8dfc987095 mod: Phase 1 — report schema + policy engine on Prolog, 31/31
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m5s
Reports → Prolog facts (report/3, classification/2, report_count/2); ordered
policy rules compile to policy_action/3 clauses, first match wins via
pl-query-one. Decisions carry their proof (matching rule + conditions +
evidence). Spam/abuse keyword classification, repeated-report escalation via
Prolog join+arithmetic, no-rule→keep default. Registry api + conformance harness.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:30:50 +00:00
72174941aa briefings: add mod-on-sx loop briefing
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 45s
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:18:02 +00:00
c3a0727645 plans: five rose-ash subsystem plans + three loop briefings
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 19s
Plans for acl-on-sx (Datalog), flow-on-sx (Scheme), feed-on-sx (APL),
mod-on-sx (Prolog), search-on-sx (Haskell). Each is a 4-phase queue
sitting on its respective guest language, targeting rose-ash needs:
access control, durable workflows, activity feeds, moderation, search.
Federation extension in Phase 4 of each (plugs into fed-sx).

Briefings for the three loops we're kicking off now: acl-loop,
flow-loop, feed-loop. mod-sx and search-sx briefings will follow
once the first three have surfaced any shared infrastructure
worth extracting to lib/guest/.

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-06-06 15:55:39 +00:00
1b94082a71 Merge loops/erlang into architecture: Erlang substrate fixes (FFI + tokenizer + charlists + integer literals)
Four small, contained substrate fixes that came out of the fed-sx-m1 milestone work — all scoped to
lib/erlang/, no other-language regressions:

  c6f397c3  register binary_to_list/1 + list_to_binary/1 BIFs (+9 ffi tests, 738/738)
  9fe5c904  $X char literals decode to char code in tokenizer (+12 eval tests, 750/750)
  5098a8f0  atom_to_list/integer_to_list return Erlang charlists; list_to_* accept both (+9 eval, 759/759)
  bcabed6b  integer literals truncate to strict int (was float; broke integer->char)

Together these complete the byte-level term-codec primitive set:
  binary_to_list / list_to_binary (iolist-aware; round-trips for free)
  $X char literals decoding to int char codes
  atom_to_list / integer_to_list returning standard Erlang charlists
  integer literals coercing to strict int (not float)

Any Erlang-on-SX consumer that needs to construct/deconstruct byte sequences or work with charlists now
does so with standard Erlang semantics. Scoreboard: 759/759 (full Erlang suite).

Loop branch loops/erlang stays alive for future Erlang substrate work; this just lands the closed deliverables.
2026-06-06 15:45:46 +00:00
57184daaee briefings: add kernel-on-sx loop briefing
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 42s
Sibling to apl-loop / common-lisp-loop / scheme-loop. Captures the
queue-driven kernel loop pattern (Phase B stratification entry-point,
env-as-value successor, motivates lib/guest/reflective/).

Co-Authored-By: Claude Opus 4.7 (1M context) <noreply@anthropic.com>
2026-06-06 15:28:09 +00:00
d9e2627b89 Merge loops/go into architecture: Go-on-SX, 609/609 across 11 phases, loop closed
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 24s
2026-06-06 15:17:17 +00:00
bcabed6bce erlang: integer literals truncate to strict int (was float; broke integer->char)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 30s
2026-06-06 08:05:57 +00:00
5098a8f015 erlang: atom_to_list/integer_to_list return Erlang charlists; list_to_* accept both (+9 net eval, 759/759) 2026-06-06 08:04:45 +00:00
9fe5c9044d erlang: $X char literals decode to char code in tokenizer (+12 eval tests, 750/750) 2026-06-06 08:03:46 +00:00
c6f397c3d9 erlang: register binary_to_list/1 + list_to_binary/1 BIFs (+9 ffi tests, 738/738) 2026-06-06 08:02:36 +00:00
65 changed files with 6513 additions and 36 deletions

View File

@@ -1561,7 +1561,66 @@
(er-register-pure-bif! "crypto" "hash" 2 er-bif-crypto-hash)
(er-register-pure-bif! "cid" "from_bytes" 1 er-bif-cid-from-bytes)
(er-register-pure-bif! "cid" "to_string" 1 er-bif-cid-to-string)
;; ── binary_to_list / list_to_binary (Step 3b — term codec) ──────
;; Standard Erlang semantics:
;; binary_to_list(<<B1,B2,...>>) -> [B1, B2, ...] (Erlang cons of ints)
;; list_to_binary(IoList) -> <<...>> (flattens nested
;; iolists; elements are byte ints 0-255 or binaries)
;; Bad arg / out-of-range byte / non-iolist element -> error:badarg.
(define er-bif-binary-to-list
(fn (vs)
(let ((v (nth vs 0)))
(cond
(not (er-binary? v))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else
(let ((bs (get v :bytes)) (out (er-mk-nil)))
(for-each
(fn (i)
(set! out (er-mk-cons (nth bs (- (- (len bs) 1) i)) out)))
(range 0 (len bs)))
out)))))
;; Walk an Erlang iolist, appending bytes to `acc` (a mutable SX list).
;; Accepts: nil, cons-of-X, binary, integer in 0..255. Anything else
;; signals failure by setting (nth fail 0) to true.
(define er-iolist-walk!
(fn (v acc fail)
(cond
(nth fail 0) nil
(er-nil? v) nil
(er-cons? v)
(do (er-iolist-walk! (get v :head) acc fail)
(er-iolist-walk! (get v :tail) acc fail))
(er-binary? v)
(for-each
(fn (i) (append! acc (nth (get v :bytes) i)))
(range 0 (len (get v :bytes))))
(= (type-of v) "number")
(cond
(and (>= v 0) (<= v 255)) (append! acc v)
:else (set-nth! fail 0 true))
:else (set-nth! fail 0 true))))
(define er-bif-list-to-binary
(fn (vs)
(let ((v (nth vs 0)) (acc (list)) (fail (list false)))
(cond
(not (or (er-nil? v) (er-cons? v) (er-binary? v)))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else
(do
(er-iolist-walk! v acc fail)
(cond
(nth fail 0)
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else (er-mk-binary acc)))))))
(er-register-bif! "file" "list_dir" 1 er-bif-file-list-dir)
(er-register-pure-bif! "erlang" "binary_to_list" 1 er-bif-binary-to-list)
(er-register-pure-bif! "erlang" "list_to_binary" 1 er-bif-list-to-binary)
(er-mk-atom "ok")))
;; Register everything at load time.

View File

@@ -1,18 +1,18 @@
{
"language": "erlang",
"total_pass": 729,
"total": 729,
"total_pass": 761,
"total": 761,
"suites": [
{"name":"tokenize","pass":62,"total":62,"status":"ok"},
{"name":"parse","pass":52,"total":52,"status":"ok"},
{"name":"eval","pass":385,"total":385,"status":"ok"},
{"name":"eval","pass":408,"total":408,"status":"ok"},
{"name":"runtime","pass":93,"total":93,"status":"ok"},
{"name":"ring","pass":4,"total":4,"status":"ok"},
{"name":"ping-pong","pass":4,"total":4,"status":"ok"},
{"name":"bank","pass":8,"total":8,"status":"ok"},
{"name":"echo","pass":7,"total":7,"status":"ok"},
{"name":"fib","pass":8,"total":8,"status":"ok"},
{"name":"ffi","pass":28,"total":28,"status":"ok"},
{"name":"ffi","pass":37,"total":37,"status":"ok"},
{"name":"vm","pass":78,"total":78,"status":"ok"}
]
}

View File

@@ -1,19 +1,19 @@
# Erlang-on-SX Scoreboard
**Total: 729 / 729 tests passing**
**Total: 761 / 761 tests passing**
| | Suite | Pass | Total |
|---|---|---|---|
| ✅ | tokenize | 62 | 62 |
| ✅ | parse | 52 | 52 |
| ✅ | eval | 385 | 385 |
| ✅ | eval | 408 | 408 |
| ✅ | runtime | 93 | 93 |
| ✅ | ring | 4 | 4 |
| ✅ | ping-pong | 4 | 4 |
| ✅ | bank | 8 | 8 |
| ✅ | echo | 7 | 7 |
| ✅ | fib | 8 | 8 |
| ✅ | ffi | 28 | 28 |
| ✅ | ffi | 37 | 37 |
| ✅ | vm | 78 | 78 |

View File

@@ -228,9 +228,10 @@
(er-eval-test "tuple_size 0" (ev "tuple_size({})") 0)
;; ── BIFs: atom / list conversions ───────────────────────────────
(er-eval-test "atom_to_list" (ev "atom_to_list(hello)") "hello")
(er-eval-test "atom_to_list -> charlist length" (ev "length(atom_to_list(hello))") 5)
(er-eval-test "atom_to_list -> head $h" (ev "hd(atom_to_list(hello))") 104)
(er-eval-test "list_to_atom roundtrip"
(nm (ev "list_to_atom(atom_to_list(foo))")) "foo")
(nm (ev "list_to_atom(atom_to_list(foo))")) "foo") ;; round-trip via charlist
(er-eval-test "list_to_atom fresh"
(nm (ev "list_to_atom(\"bar\")")) "bar")
@@ -1060,11 +1061,13 @@
(er-eval-test "list_to_tuple roundtrip"
(ev "tuple_size(list_to_tuple([10, 20, 30]))") 3)
(er-eval-test "integer_to_list" (ev "integer_to_list(42)") "42")
(er-eval-test "integer_to_list neg" (ev "integer_to_list(-99)") "-99")
(er-eval-test "integer_to_list -> charlist length" (ev "length(integer_to_list(42))") 2)
(er-eval-test "integer_to_list 42 head $4" (ev "hd(integer_to_list(42))") 52)
(er-eval-test "integer_to_list neg -> charlist length" (ev "length(integer_to_list(-99))") 3)
(er-eval-test "integer_to_list -99 head $-" (ev "hd(integer_to_list(-99))") 45)
(er-eval-test "list_to_integer" (ev "list_to_integer(\"123\")") 123)
(er-eval-test "list_to_integer roundtrip"
(ev "list_to_integer(integer_to_list(7))") 7)
(ev "list_to_integer(integer_to_list(7))") 7) ;; round-trip via charlist
(er-eval-test "is_function fun"
(nm (ev "F = fun (X) -> X end, is_function(F)")) "true")
@@ -1341,6 +1344,42 @@
(get (nth (get er-rt-cap-result :elements) 4) :name) "true")
;; ── $X char literals (Step 3b substrate fix 2026-06-04) ──────────
(er-eval-test "char $A" (ev "$A") 65)
(er-eval-test "char $a" (ev "$a") 97)
(er-eval-test "char $0 is digit, not escape-NUL" (ev "$0") 48)
(er-eval-test "char $\\n is newline (10)" (ev "$\\n") 10)
(er-eval-test "char $\\t is tab (9)" (ev "$\\t") 9)
(er-eval-test "char $\\r is CR (13)" (ev "$\\r") 13)
(er-eval-test "char $\\s is space (32)" (ev "$\\s") 32)
(er-eval-test "char $\\0 is NUL (0)" (ev "$\\0") 0)
(er-eval-test "char $\\\\ is backslash (92)" (ev "$\\\\") 92)
(er-eval-test "[$h,$i] head is 104" (ev "hd([$h, $i])") 104)
(er-eval-test "list_to_binary char-list -> bytes"
(ev "byte_size(list_to_binary([$f, $e, $d]))") 3)
(er-eval-test "list_to_binary char-list round-trip"
(nm (ev "list_to_binary([$h, $i]) =:= <<104, 105>>")) "true")
;; ── atom_to_list / integer_to_list charlist semantics (Step 3b substrate fix #3) ──
(er-eval-test "atom_to_list hd is char code"
(ev "hd(atom_to_list(hi))") 104)
(er-eval-test "atom_to_list maps to bytes via list_to_binary"
(ev "byte_size(list_to_binary(atom_to_list(hello)))") 5)
(er-eval-test "atom_to_list -> list_to_binary -> bytes content"
(nm (ev "list_to_binary(atom_to_list(ok)) =:= <<111, 107>>")) "true")
(er-eval-test "integer_to_list 12345 -> 5 chars"
(ev "length(integer_to_list(12345))") 5)
(er-eval-test "integer_to_list -> bytes -> back"
(ev "list_to_integer(integer_to_list(99999))") 99999)
(er-eval-test "list_to_atom from charlist"
(nm (ev "list_to_atom([$f, $o, $o])")) "foo")
(er-eval-test "list_to_atom from SX-string back-compat"
(nm (ev "list_to_atom(\"bar\")")) "bar")
(er-eval-test "list_to_integer from charlist"
(ev "list_to_integer([$1, $0, $0])") 100)
(define
er-eval-test-summary
(str "eval " er-eval-test-pass "/" er-eval-test-count))

View File

@@ -160,6 +160,51 @@
(ffi-nm (ffi-ev "element(2, file:list_dir(\"/no/such/dir/xyz\"))"))
"enoent")
(er-ffi-test
"binary_to_list <<1,2,3>> length"
(ffi-ev "length(binary_to_list(<<1,2,3,4,5>>))")
5)
(er-ffi-test
"binary_to_list hd byte"
(ffi-ev "hd(binary_to_list(<<7,8,9>>))")
7)
(er-ffi-test
"binary_to_list empty -> []"
(ffi-nm (ffi-ev "case binary_to_list(<<>>) of [] -> empty end"))
"empty")
(er-ffi-test
"list_to_binary flat list bytes"
(ffi-ev "byte_size(list_to_binary([1,2,3]))")
3)
(er-ffi-test
"list_to_binary nested iolist"
(ffi-ev "byte_size(list_to_binary([1, <<2,3>>, [4, [5]]]))")
5)
(er-ffi-test
"list_to_binary round-trip via binary_to_list"
(ffi-nm (ffi-ev "list_to_binary(binary_to_list(<<10,20,30>>)) =:= <<10,20,30>>"))
"true")
(er-ffi-test
"binary_to_list non-binary -> error:badarg"
(ffi-nm (ffi-ev "try binary_to_list(42) catch error:badarg -> ok end"))
"ok")
(er-ffi-test
"list_to_binary out-of-range byte -> error:badarg"
(ffi-nm (ffi-ev "try list_to_binary([300]) catch error:badarg -> ok end"))
"ok")
(er-ffi-test
"list_to_binary non-iolist -> error:badarg"
(ffi-nm (ffi-ev "try list_to_binary(42) catch error:badarg -> ok end"))
"ok")
;; ── Still deferred (no host primitive): httpc (HTTP client, v2),
;; sqlite-* (v2 indexes). Assert NOT registered so a future iteration
;; that wires them without updating this suite fails fast.

View File

@@ -229,13 +229,37 @@
(= ch "$")
(do
(er-advance! 1)
(if
(and (< pos src-len) (= (er-cur) "\\"))
(do
(er-advance! 1)
(when (< pos src-len) (er-advance! 1)))
(when (< pos src-len) (er-advance! 1)))
(er-emit! "integer" (slice src start pos) start)
;; Emit the char's decimal code as the integer token value
;; (was: raw "$X" text — parse-number then returned nil).
(let
((code (cond
(>= pos src-len) 0
(= (er-cur) "\\")
(do
(er-advance! 1)
(let ((esc (if (< pos src-len) (er-cur) "")))
(when (< pos src-len) (er-advance! 1))
(cond
(= esc "n") 10
(= esc "t") 9
(= esc "r") 13
(= esc "s") 32
(= esc "b") 8
(= esc "e") 27
(= esc "f") 12
(= esc "v") 11
(= esc "d") 127
(= esc "0") 0
(= esc "\\") 92
(= esc "\"") 34
(= esc "'") 39
(= esc "") 0
:else (char->integer (nth (string->list esc) 0)))))
:else
(let ((c (er-cur)))
(er-advance! 1)
(char->integer (nth (string->list c) 0))))))
(er-emit! "integer" (str code) start))
(scan!))
(er-lower? ch)
(do

View File

@@ -107,7 +107,12 @@
(let
((ty (get node :type)))
(cond
(= ty "integer") (parse-number (get node :value))
(= ty "integer")
(let ((n (parse-number (get node :value))))
(cond
(= n nil) (error (str "Erlang: invalid integer literal: "
(get node :value)))
:else (truncate n)))
(= ty "float") (parse-number (get node :value))
(= ty "atom") (er-mk-atom (get node :value))
(= ty "string") (get node :value)
@@ -821,16 +826,30 @@
(len (get v :elements))
(error "Erlang: tuple_size: not a tuple")))))
(define er-string->charlist
(fn (s)
(let ((cs (string->list s)) (out (er-mk-nil)))
(for-each
(fn (i)
(set! out (er-mk-cons
(char->integer (nth cs (- (- (len cs) 1) i)))
out)))
(range 0 (len cs)))
out)))
(define
er-bif-atom-to-list
(fn
(vs)
(let
((v (er-bif-arg1 vs "atom_to_list")))
;; Standard Erlang: atom_to_list/1 returns an Erlang charlist
;; (list of integer char codes). Was: SX string of :name —
;; unusable from Erlang-land for [Char|T] / ++ / binary segments.
(if
(er-atom? v)
(get v :name)
(error "Erlang: atom_to_list: not an atom")))))
(er-string->charlist (get v :name))
(raise (er-mk-error-marker (er-mk-atom "badarg")))))))
(define
er-bif-list-to-atom
@@ -838,10 +857,11 @@
(vs)
(let
((v (er-bif-arg1 vs "list_to_atom")))
(if
(= (type-of v) "string")
(er-mk-atom v)
(error "Erlang: list_to_atom: not a string")))))
;; Accept Erlang charlist (cons of ints) or SX string.
(let ((s (er-source-to-string v)))
(cond
(= s nil) (raise (er-mk-error-marker (er-mk-atom "badarg")))
:else (er-mk-atom s))))))
;; ── lists module ─────────────────────────────────────────────────
(define
@@ -1597,10 +1617,12 @@
(vs)
(let
((v (er-bif-arg1 vs "integer_to_list")))
;; Standard Erlang: integer_to_list/1 returns an Erlang charlist
;; (e.g. integer_to_list(42) -> [$4, $2] -> [52, 50]).
(cond
(not (= (type-of v) "number"))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else (str v)))))
:else (er-string->charlist (str v))))))
(define
er-bif-list-to-integer
@@ -1608,15 +1630,14 @@
(vs)
(let
((v (er-bif-arg1 vs "list_to_integer")))
(cond
(not (= (type-of v) "string"))
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else (let
((n (parse-number v)))
(cond
(= n nil)
(raise (er-mk-error-marker (er-mk-atom "badarg")))
:else n))))))
;; Accept Erlang charlist (cons of ints) or SX string.
(let ((s (er-source-to-string v)))
(cond
(= s nil) (raise (er-mk-error-marker (er-mk-atom "badarg")))
:else (let ((n (parse-number s)))
(cond
(= n nil) (raise (er-mk-error-marker (er-mk-atom "badarg")))
:else n)))))))
(define
er-bif-is-function

40
lib/mod/activity.sx Normal file
View File

@@ -0,0 +1,40 @@
;; lib/mod/activity.sx — export decisions as ActivityPub-shaped events.
;;
;; The rose-ash platform propagates cross-domain effects as ActivityPub-shaped
;; activities. A moderation decision maps to a moderation verb so the rest of the
;; platform (and federated peers) can act on it: remove→Delete, ban→Block,
;; hide/escalate→Flag, keep→no activity. The precise mod action is preserved in
;; :action so a consumer can disambiguate (e.g. hide vs escalate, both Flag).
(define
mod/action->verb
(fn
(action)
(cond
((= action "remove") "Delete")
((= action "ban") "Block")
((= action "hide") "Flag")
((= action "escalate") "Flag")
(true nil))))
(define
mod/decision->activity
(fn
(d actor)
(let
((verb (mod/action->verb (get d :action))))
(if (nil? verb) nil {:type verb :action (get d :action) :actor actor :summary (str "moderation/" (get d :action) " via " (get d :rule)) :object (get d :report-id) :rule (get d :rule)}))))
;; map a batch of decisions to activities, dropping the no-op keeps
(define
mod/decisions->activities
(fn
(decisions actor)
(reduce
(fn
(acc d)
(let
((a (mod/decision->activity d actor)))
(if (nil? a) acc (append acc (list a)))))
(list)
decisions)))

163
lib/mod/api.sx Normal file
View File

@@ -0,0 +1,163 @@
;; lib/mod/api.sx — report registry + lifecycle façade + public entry points.
;;
;; mod/report files a report (assigning a sequential id) and opens a lifecycle
;; case for it; mod/add-evidence accumulates evidence; mod/decide runs the engine
;; and commits to the audit log. The lifecycle façade (mod/triage, mod/resolve,
;; mod/review, mod/appeal, mod/finalize) drives the per-report case through its
;; states, logging each committed decision to the audit trail.
(define mod/*reports* (list))
(define mod/*cases* (list))
(define mod/*counter* 0)
(define mod/*rules* mod/default-rules)
(define
mod/reset!
(fn
()
(begin
(set! mod/*reports* (list))
(set! mod/*cases* (list))
(set! mod/*counter* 0)
(mod/audit-reset!))))
(define
mod/report
(fn
(by about reason)
(begin
(set! mod/*counter* (+ mod/*counter* 1))
(let
((id (str "r" mod/*counter*)))
(let
((r (mod/mk-report id by about reason)))
(begin
(append! mod/*reports* r)
(append! mod/*cases* {:id id :case (mod/mk-case r)})
r))))))
(define
mod/get-report
(fn
(id)
(reduce
(fn (acc r) (if (= (mod/report-id r) id) r acc))
nil
mod/*reports*)))
(define
mod/add-evidence
(fn
(id kind val)
(let
((r (mod/get-report id)))
(if
(nil? r)
nil
(let
((updated (mod/attach-evidence r (mod/mk-evidence kind val))))
(begin
(set!
mod/*reports*
(map
(fn (x) (if (= (mod/report-id x) id) updated x))
mod/*reports*))
updated))))))
(define
mod/decide
(fn
(id)
(let
((r (mod/get-report id)))
(if
(nil? r)
nil
(let
((d (mod/decide-report r mod/*reports* mod/*rules*)))
(begin (mod/log-decision! d (mod/report-evidence r)) d))))))
;; ── lifecycle façade over the case registry ──
(define
mod/case-of
(fn
(id)
(reduce
(fn (acc rec) (if (= (get rec :id) id) (get rec :case) acc))
nil
mod/*cases*)))
(define
mod/case-store!
(fn
(id c)
(set!
mod/*cases*
(map
(fn (rec) (if (= (get rec :id) id) {:id id :case c} rec))
mod/*cases*))))
;; apply a lifecycle op to the stored case, persist it, and (when a decision was
;; committed cleanly) append it to the audit log; returns the updated case
(define
mod/case-apply!
(fn
(id op log?)
(let
((c (mod/case-of id)))
(if
(nil? c)
nil
(let
((c2 (op c)))
(begin
(mod/case-store! id c2)
(when
log?
(when
(nil? (mod/case-error c2))
(let
((d (mod/case-decision c2)))
(if
(nil? d)
nil
(mod/log-decision!
d
(mod/report-evidence (mod/case-report c2)))))))
c2))))))
(define
mod/triage
(fn
(id)
(mod/case-apply!
id
(fn (c) (mod/case-triage c mod/*reports* mod/*rules*))
false)))
(define
mod/resolve
(fn (id) (mod/case-apply! id (fn (c) (mod/case-resolve c)) true)))
(define
mod/review
(fn
(id kind val)
(mod/case-apply!
id
(fn (c) (mod/case-review c kind val mod/*reports* mod/*rules*))
true)))
(define
mod/appeal
(fn
(id kind val)
(mod/case-apply!
id
(fn (c) (mod/case-appeal c kind val mod/*reports* mod/*rules*))
true)))
(define
mod/finalize
(fn (id) (mod/case-apply! id (fn (c) (mod/case-finalize c)) false)))

54
lib/mod/audit.sx Normal file
View File

@@ -0,0 +1,54 @@
;; lib/mod/audit.sx — append-only decision log.
;;
;; Every decision the api commits is recorded as an immutable audit entry holding
;; the decision (action + matching rule), the proof tree (the derivation that
;; justified it), and a snapshot of the evidence in force at decision time. The
;; log is append-only: entries are never mutated or removed, only appended, each
;; with a monotonic sequence number. Retrieval is by report id (full history) or
;; by sequence.
(define mod/*audit-log* (list))
(define mod/*audit-seq* 0)
(define
mod/audit-reset!
(fn
()
(begin (set! mod/*audit-log* (list)) (set! mod/*audit-seq* 0))))
(define mod/mk-audit-entry (fn (seq decision evidence-snapshot) {:action (get decision :action) :evidence evidence-snapshot :proof (get decision :proof) :rule (get decision :rule) :report-id (get decision :report-id) :seq seq}))
(define
mod/log-decision!
(fn
(decision evidence-snapshot)
(begin
(set! mod/*audit-seq* (+ mod/*audit-seq* 1))
(let
((entry (mod/mk-audit-entry mod/*audit-seq* decision evidence-snapshot)))
(begin (append! mod/*audit-log* entry) entry)))))
;; entries for one report, in chronological (sequence) order
(define
mod/audit
(fn
(id)
(reduce
(fn
(acc e)
(if (= (get e :report-id) id) (append acc (list e)) acc))
(list)
mod/*audit-log*)))
(define mod/audit-all (fn () mod/*audit-log*))
(define mod/audit-count (fn () (len mod/*audit-log*)))
;; most recent decision logged for a report (nil if none)
(define
mod/audit-latest
(fn
(id)
(reduce
(fn (acc e) (if (= (get e :report-id) id) e acc))
nil
mod/*audit-log*)))

55
lib/mod/batch.sx Normal file
View File

@@ -0,0 +1,55 @@
;; lib/mod/batch.sx — batch triage + corpus analytics.
;;
;; Operational layer: decide a whole queue of reports at once, summarize the
;; outcomes by action, and measure which rules actually fire across a corpus.
;; mod/never-fired is the empirical complement to lint's static unreachable check
;; (Ext 5): lint finds rules that CAN'T fire by structure; never-fired finds rules
;; that DIDN'T fire on real data.
(define
mod/decide-batch
(fn
(reports rules)
(map (fn (r) (mod/decide-report r reports rules)) reports)))
(define
mod/count-action
(fn
(decisions action)
(reduce
(fn (acc d) (if (= (get d :action) action) (+ acc 1) acc))
0
decisions)))
(define mod/action-histogram (fn (decisions) {:keep (mod/count-action decisions "keep") :remove (mod/count-action decisions "remove") :escalate (mod/count-action decisions "escalate") :hide (mod/count-action decisions "hide") :ban (mod/count-action decisions "ban")}))
(define
mod/rule-fire-count
(fn
(decisions rule-name)
(reduce
(fn (acc d) (if (= (get d :rule) rule-name) (+ acc 1) acc))
0
decisions)))
(define
mod/rule-coverage
(fn
(reports rules)
(let
((decisions (mod/decide-batch reports rules)))
(map (fn (rule) {:rule (mod/rule-name rule) :fired (mod/rule-fire-count decisions (mod/rule-name rule))}) rules))))
(define
mod/never-fired
(fn
(reports rules)
(reduce
(fn
(acc c)
(if
(= (get c :fired) 0)
(append acc (list (get c :rule)))
acc))
(list)
(mod/rule-coverage reports rules))))

60
lib/mod/conformance.conf Normal file
View File

@@ -0,0 +1,60 @@
# Mod conformance config — sourced by lib/guest/conformance.sh.
LANG_NAME=mod
MODE=dict
PRELOADS=(
lib/guest/pratt.sx
lib/prolog/tokenizer.sx
lib/prolog/parser.sx
lib/prolog/runtime.sx
lib/prolog/query.sx
lib/prolog/compiler.sx
lib/mod/schema.sx
lib/mod/policy.sx
lib/mod/defrule.sx
lib/mod/engine.sx
lib/mod/explain.sx
lib/mod/severity.sx
lib/mod/offenders.sx
lib/mod/quorum.sx
lib/mod/trace.sx
lib/mod/whatif.sx
lib/mod/batch.sx
lib/mod/temporal.sx
lib/mod/sla.sx
lib/mod/wire.sx
lib/mod/activity.sx
lib/mod/policies.sx
lib/mod/pipeline.sx
lib/mod/lifecycle.sx
lib/mod/audit.sx
lib/mod/api.sx
lib/mod/fed.sx
lib/mod/link.sx
lib/mod/lint.sx
)
SUITES=(
"decide:lib/mod/tests/decide.sx:(mod-decide-tests-run!)"
"audit:lib/mod/tests/audit.sx:(mod-audit-tests-run!)"
"escalation:lib/mod/tests/escalation.sx:(mod-escalation-tests-run!)"
"fed:lib/mod/tests/fed.sx:(mod-fed-tests-run!)"
"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!)"
"offenders:lib/mod/tests/offenders.sx:(mod-offenders-tests-run!)"
"quorum:lib/mod/tests/quorum.sx:(mod-quorum-tests-run!)"
"trace:lib/mod/tests/trace.sx:(mod-trace-tests-run!)"
"whatif:lib/mod/tests/whatif.sx:(mod-whatif-tests-run!)"
"batch:lib/mod/tests/batch.sx:(mod-batch-tests-run!)"
"temporal:lib/mod/tests/temporal.sx:(mod-temporal-tests-run!)"
"sla:lib/mod/tests/sla.sx:(mod-sla-tests-run!)"
"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!)"
"defrule:lib/mod/tests/defrule.sx:(mod-defrule-tests-run!)"
"pipeline:lib/mod/tests/pipeline.sx:(mod-pipeline-tests-run!)"
)

3
lib/mod/conformance.sh Executable file
View File

@@ -0,0 +1,3 @@
#!/usr/bin/env bash
# Thin wrapper — see lib/guest/conformance.sh and lib/mod/conformance.conf.
exec bash "$(dirname "$0")/../guest/conformance.sh" "$(dirname "$0")/conformance.conf" "$@"

16
lib/mod/defrule.sx Normal file
View File

@@ -0,0 +1,16 @@
;; lib/mod/defrule.sx — ergonomic rule / ruleset construction.
;;
;; The roadmap sketched a (defrule action :when conditions) surface. Conditions
;; already evaluate to plain data, so this needs no macro — variadic functions
;; suffice: mod/defrule collects its trailing condition forms via &rest (dropping
;; the explicit outer (list ...)), and mod/ruleset assembles rules the same way.
;;
;; (mod/ruleset
;; (mod/defrule "spam-hide" :hide (list :classification "spam"))
;; (mod/defrule "default-keep" :keep))
(define
mod/defrule
(fn (name action &rest conds) (mod/mk-rule name action conds)))
(define mod/ruleset (fn (&rest rules) rules))

64
lib/mod/engine.sx Normal file
View File

@@ -0,0 +1,64 @@
;; lib/mod/engine.sx — decide a report by querying the policy program.
;;
;; build-program assembles the report's facts plus the compiled policy clauses;
;; decide-report runs the Prolog query and returns a decision. A decision is a
;; proof, not a bare keyword: it carries the matching rule, the conditions it
;; required, the evidence that satisfied them, and a derivation — the proof tree.
;;
;; The proof tree is built constructively: for the matching rule, each body goal
;; is re-queried against the same DB with the report id bound, recording the goal
;; text, whether it was solved, and the bindings that satisfied it. That is a
;; genuine derivation drawn from the Prolog database, ready for the audit trail.
(define
mod/find-rule
(fn
(rules name)
(reduce
(fn
(acc r)
(if (nil? acc) (if (= (mod/rule-name r) name) r acc) acc))
nil
rules)))
(define
mod/build-program
(fn
(r count rules)
(str (mod/report-facts r count) "\n" (mod/rules->program rules))))
(define
mod/proof-goals
(fn
(db id conds)
(if
(empty? conds)
(list {:solved true :goal "true" :bindings {}})
(map
(fn
(c)
(let
((g (mod/cond->goal c id)))
(let ((sols (pl-query-all db g))) {:solved (if (empty? sols) false true) :goal g :bindings (if (empty? sols) {} (first sols))})))
conds))))
(define
mod/decide-report
(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
((sol (pl-query-one db (str "policy_action(" id ", Action, Rule)"))))
(if
(nil? sol)
{:action "keep" :proof {:goals (list) :evidence kinds :conditions (list) :rule "none" :count count} :report-id id :rule "none"}
(let
((rname (dict-get sol "Rule")))
(let ((rule (mod/find-rule rules rname))) {:action (mod/rule-action rule) :proof {:goals (mod/proof-goals db id (mod/rule-when rule)) :evidence kinds :conditions (mod/rule-when rule) :rule rname :count count} :report-id id :rule rname})))))))))

55
lib/mod/explain.sx Normal file
View File

@@ -0,0 +1,55 @@
;; lib/mod/explain.sx — human-readable proof explanation.
;;
;; Turns a decision (from mod/decide-report, or any audit entry) into a readable
;; multi-line "why": the action, the rule that fired, the evidence in play, and
;; the derivation goal-by-goal with [proved]/[unproved] marks and the unification
;; bindings that satisfied each goal. Pure SX over the Phase-2 proof tree.
(define
mod/explain-binds
(fn
(binds)
(mod/join-with
", "
(map (fn (k) (str k "=" (dict-get binds k))) (keys binds)))))
(define
mod/explain-goal
(fn
(g)
(let
((mark (if (get g :solved) " [proved] " " [unproved] "))
(binds (get g :bindings)))
(if
(empty? (keys binds))
(str mark (get g :goal))
(str mark (get g :goal) " {" (mod/explain-binds binds) "}")))))
(define
mod/explain-evidence
(fn
(evidence)
(if
(empty? evidence)
"Evidence: (none)"
(str "Evidence: " (mod/join-with ", " evidence)))))
(define
mod/explain
(fn
(decision)
(let
((id (get decision :report-id))
(action (get decision :action))
(rule (get decision :rule))
(proof (get decision :proof)))
(let
((goals (get proof :goals)) (evidence (get proof :evidence)))
(mod/join-with
"\n"
(append
(list
(str "Report " id ": " action " (rule: " rule ")")
(mod/explain-evidence evidence)
"Because:")
(map mod/explain-goal goals)))))))

145
lib/mod/fed.sx Normal file
View File

@@ -0,0 +1,145 @@
;; lib/mod/fed.sx — federation: cross-instance reports, decision sharing, trust,
;; revocation. fed-sx itself is mocked here (an in-memory outbox); the real wire
;; transport would replace mod/fed-send!.
;;
;; Trust is advisory by default (the hard rule): a peer's decision only binds
;; locally when (mod/trusted? peer :mod) holds. An untrusted peer's decision is
;; recorded as a suggestion in the advisory log and is NOT applied. Local
;; decisions propagate outward via the outbox. Revocation undoes a locally
;; applied action when its proof is invalidated, notifying the origin peer.
(define mod/*fed-trust* (list)) ;; {:peer :scope}
(define mod/*fed-outbox* (list)) ;; {:to :type :payload}
(define mod/*fed-advisory* (list)) ;; {:peer :decision} — received, not applied
(define mod/*fed-applied* (list)) ;; {:report-id :action :origin :revoked}
(define mod/*fed-origins* (list)) ;; {:id :origin}
(define
mod/fed-reset!
(fn
()
(begin
(set! mod/*fed-trust* (list))
(set! mod/*fed-outbox* (list))
(set! mod/*fed-advisory* (list))
(set! mod/*fed-applied* (list))
(set! mod/*fed-origins* (list)))))
;; ── trust model ──
(define
mod/trust-match?
(fn
(t peer scope)
(if (= (get t :peer) peer) (= (get t :scope) scope) false)))
(define
mod/grant-trust
(fn (peer scope) (begin (append! mod/*fed-trust* {:scope scope :peer peer}) true)))
(define
mod/revoke-trust
(fn
(peer scope)
(set!
mod/*fed-trust*
(reduce
(fn
(acc t)
(if (mod/trust-match? t peer scope) acc (append acc (list t))))
(list)
mod/*fed-trust*))))
(define
mod/trusted?
(fn
(peer scope)
(mod/any? (fn (t) (mod/trust-match? t peer scope)) mod/*fed-trust*)))
;; ── cross-instance reports ──
(define
mod/fed-receive-report
(fn
(peer by about reason)
(let
((r (mod/report by about reason)))
(begin (append! mod/*fed-origins* {:id (mod/report-id r) :origin peer}) r))))
(define
mod/report-origin
(fn
(id)
(reduce
(fn (acc o) (if (= (get o :id) id) (get o :origin) acc))
"local"
mod/*fed-origins*)))
;; ── decision sharing (mock fed-sx send) ──
(define
mod/fed-send!
(fn (to type payload) (begin (append! mod/*fed-outbox* {:type type :to to :payload payload}) true)))
(define mod/fed-outbox (fn () mod/*fed-outbox*))
(define
mod/fed-share-decision
(fn
(decision peers)
(reduce
(fn
(acc p)
(begin (mod/fed-send! p "decision" decision) (append acc (list p))))
(list)
peers)))
;; ── receiving a peer's decision (advisory unless trusted) ──
(define
mod/fed-applied-action
(fn
(report-id)
(reduce
(fn (acc a) (if (= (get a :report-id) report-id) a acc))
nil
mod/*fed-applied*)))
(define
mod/fed-receive-decision
(fn
(peer decision)
(if
(mod/trusted? peer :mod)
(begin (append! mod/*fed-applied* {:revoked false :action (get decision :action) :report-id (get decision :report-id) :origin peer}) {:advisory false :peer peer :applied true :decision decision})
(begin (append! mod/*fed-advisory* {:peer peer :decision decision}) {:advisory true :peer peer :applied false :decision decision}))))
;; ── revocation ──
(define
mod/fed-revoke!
(fn
(report-id reason)
(begin
(set!
mod/*fed-applied*
(map
(fn (a) (if (= (get a :report-id) report-id) {:revoked true :action (get a :action) :report-id (get a :report-id) :origin (get a :origin)} a))
mod/*fed-applied*))
(mod/fed-send! (mod/report-origin report-id) "revocation" {:report-id report-id :reason reason})
report-id)))
;; re-run the engine; if the action no longer holds, the prior decision's proof
;; is invalidated — revoke the applied moderation.
(define
mod/fed-revoke-if-invalidated
(fn
(report decision reports rules)
(let
((d2 (mod/decide-report report reports rules)))
(if
(= (get d2 :action) (get decision :action))
{:revoked false :decision d2}
(begin
(mod/fed-revoke! (get decision :report-id) "proof invalidated")
{:revoked true :decision d2})))))

160
lib/mod/lifecycle.sx Normal file
View File

@@ -0,0 +1,160 @@
;; lib/mod/lifecycle.sx — report lifecycle state machine (pure SX over the engine).
;;
;; Lifecycle state is deliberately separate from policy: the Prolog rules answer
;; "what action?", this module answers "where in the process is this report?".
;;
;; :open ──triage──▶ :triaged ──resolve/review──▶ :decided ──appeal──▶ :appealed
;; │ │
;; └────finalize───▶ :final ◀┘
;;
;; A case is an immutable value {:report :state :decision :tier :error :history}.
;; Every transition returns a NEW case; illegal transitions return the case
;; unchanged with :error set. Tiers: triage runs the engine (auto-tier); a
;; terminal action (hide/remove/keep) resolves immediately, an :escalate action
;; flags the case for human review (human-tier) before it can be resolved.
(define mod/case* (fn (report state decision tier err history) {:history history :state state :report report :error err :tier tier :decision decision}))
(define
mod/mk-case
(fn (report) (mod/case* report "open" nil nil nil (list))))
(define mod/case-report (fn (c) (get c :report)))
(define mod/case-state (fn (c) (get c :state)))
(define mod/case-decision (fn (c) (get c :decision)))
(define mod/case-tier (fn (c) (get c :tier)))
(define mod/case-error (fn (c) (get c :error)))
(define mod/case-history (fn (c) (get c :history)))
;; ── transition table ──
(define mod/lc-transitions {:final (list) :appealed (list "final") :decided (list "appealed" "final") :open (list "triaged") :triaged (list "decided")})
(define mod/member? (fn (x lst) (mod/any? (fn (y) (= y x)) lst)))
(define
mod/lc-can-transition?
(fn
(from to)
(let
((outs (get mod/lc-transitions from)))
(if (nil? outs) false (mod/member? to outs)))))
;; ── core transition: validate, record history, or flag :error ──
(define
mod/case-goto
(fn
(c to note report decision tier)
(let
((from (mod/case-state c)))
(if
(mod/lc-can-transition? from to)
(mod/case*
report
to
decision
tier
nil
(append (mod/case-history c) (list {:note note :to to :from from})))
(mod/case*
(mod/case-report c)
from
(mod/case-decision c)
(mod/case-tier c)
(str "illegal transition: " from " -> " to)
(mod/case-history c))))))
(define
mod/case-error-set
(fn
(c msg)
(mod/case*
(mod/case-report c)
(mod/case-state c)
(mod/case-decision c)
(mod/case-tier c)
msg
(mod/case-history c))))
;; ── lifecycle operations ──
;; :open → :triaged — run the auto-tier first pass.
(define
mod/case-triage
(fn
(c reports rules)
(let
((d (mod/decide-report (mod/case-report c) reports rules)))
(let
((tier (if (= (get d :action) "escalate") "human" "auto")))
(mod/case-goto
c
"triaged"
"auto-tier first pass"
(mod/case-report c)
d
tier)))))
;; :triaged → :decided — auto-tier resolves; human-tier is blocked until review.
(define
mod/case-resolve
(fn
(c)
(if
(= (mod/case-tier c) "human")
(mod/case-error-set c "awaiting human review (escalated)")
(mod/case-goto
c
"decided"
"auto-tier resolved"
(mod/case-report c)
(mod/case-decision c)
(mod/case-tier c)))))
;; :triaged → :decided — human review: attach evidence, re-decide, resolve.
(define
mod/case-review
(fn
(c kind val reports rules)
(let
((nr (mod/attach-evidence (mod/case-report c) (mod/mk-evidence kind val))))
(let
((d (mod/decide-report nr reports rules)))
(mod/case-goto c "decided" (str "human review: " kind) nr d "human")))))
;; :decided → :appealed — appeal: attach evidence, re-decide (may override).
(define
mod/case-appeal
(fn
(c kind val reports rules)
(let
((nr (mod/attach-evidence (mod/case-report c) (mod/mk-evidence kind val))))
(let
((d (mod/decide-report nr reports rules)))
(mod/case-goto
c
"appealed"
(str "appeal: " kind)
nr
d
(mod/case-tier c))))))
;; :decided | :appealed → :final
(define
mod/case-finalize
(fn
(c)
(mod/case-goto
c
"final"
"finalized"
(mod/case-report c)
(mod/case-decision c)
(mod/case-tier c))))
(define
mod/case-action
(fn
(c)
(let ((d (mod/case-decision c))) (if (nil? d) nil (get d :action)))))

92
lib/mod/link.sx Normal file
View File

@@ -0,0 +1,92 @@
;; lib/mod/link.sx — report linking + deduplication.
;;
;; Reports about the same subject form a cluster; identical reports (same
;; reporter + subject + reason) are duplicates. Linking is Prolog-backed: all
;; report facts are loaded and related ids are found by unification — the same
;; relational substrate the policy engine uses, here for retrieval rather than
;; decision. Dedup is pure SX over a normalized link key.
(define
mod/link-key
(fn
(r)
(str
(mod/report-by r)
"|"
(mod/report-about r)
"|"
(downcase (mod/report-reason r)))))
(define
mod/dedup-reports
(fn
(reports)
(reduce
(fn
(acc r)
(if
(mod/any? (fn (x) (= (mod/link-key x) (mod/link-key r))) acc)
acc
(append acc (list r))))
(list)
reports)))
(define
mod/duplicate-count
(fn (reports) (- (len reports) (len (mod/dedup-reports reports)))))
;; ── Prolog-backed relational retrieval ──
(define
mod/report-rel-facts
(fn
(reports)
(mod/join-with
"\n"
(map
(fn
(r)
(str
"report("
(mod/report-id r)
", "
(mod/pl-quote (mod/report-by r))
", "
(mod/pl-quote (mod/report-about r))
")."))
reports))))
(define
mod/related-ids
(fn
(subject reports)
(let
((db (pl-load (mod/report-rel-facts reports))))
(map
(fn (sol) (dict-get sol "Id"))
(pl-query-all db (str "report(Id, _, " (mod/pl-quote subject) ")"))))))
(define
mod/reporters-of
(fn
(subject reports)
(let
((db (pl-load (mod/report-rel-facts reports))))
(map
(fn (sol) (dict-get sol "By"))
(pl-query-all db (str "report(_, By, " (mod/pl-quote subject) ")"))))))
(define
mod/distinct
(fn
(items)
(reduce
(fn
(acc x)
(if (mod/any? (fn (y) (= y x)) acc) acc (append acc (list x))))
(list)
items)))
(define
mod/distinct-reporters-of
(fn (subject reports) (mod/distinct (mod/reporters-of subject reports))))

69
lib/mod/lint.sx Normal file
View File

@@ -0,0 +1,69 @@
;; lib/mod/lint.sx — static analysis of a policy rule set.
;;
;; Because precedence is "first matching clause wins" (pl-query-one), the rule
;; order has correctness consequences a moderator can get wrong: a rule placed
;; after an unconditional (empty :when) rule can never fire, and a rule set with
;; no unconditional rule may leave some reports undecided. lint-rules surfaces
;; these without running the engine.
(define mod/rule-unconditional? (fn (r) (empty? (mod/rule-when r))))
;; names of rules that follow the first unconditional rule — structurally dead,
;; since the unconditional rule always matches first
(define
mod/unreachable-rules
(fn
(rules)
(get
(reduce
(fn
(acc r)
(if
(get acc :hit)
{:dead (append (get acc :dead) (list (mod/rule-name r))) :hit true}
(if (mod/rule-unconditional? r) {:dead (get acc :dead) :hit true} acc)))
{:dead (list) :hit false}
rules)
:dead)))
(define
mod/has-catchall?
(fn (rules) (mod/any? mod/rule-unconditional? rules)))
(define
mod/count-eq
(fn
(x lst)
(reduce (fn (a y) (if (= y x) (+ a 1) a)) 0 lst)))
(define
mod/duplicate-rule-names
(fn
(rules)
(let
((names (map mod/rule-name rules)))
(mod/distinct
(reduce
(fn
(acc n)
(if
(< 1 (mod/count-eq n names))
(append acc (list n))
acc))
(list)
names)))))
(define mod/lint-rules (fn (rules) {:duplicate-names (mod/duplicate-rule-names rules) :has-catchall (mod/has-catchall? rules) :unreachable (mod/unreachable-rules rules)}))
;; a rule set is well-formed when nothing is dead, it has a catch-all, and rule
;; names are unique
(define
mod/rules-ok?
(fn
(rules)
(let
((l (mod/lint-rules rules)))
(if
(empty? (get l :unreachable))
(if (get l :has-catchall) (empty? (get l :duplicate-names)) false)
false))))

59
lib/mod/offenders.sx Normal file
View File

@@ -0,0 +1,59 @@
;; lib/mod/offenders.sx — repeat-offender escalation (audit log as evidence).
;;
;; The append-only audit trail is itself a source of evidence: a subject already
;; sanctioned several times is a repeat offender. mod/decide-escalating decides a
;; report normally, then — if the action is a sanction and the subject has at
;; least k PRIOR sanctions in the audit log — upgrades it to :ban. This is the one
;; place a decision depends on history beyond the single report, and it reads that
;; history from the audit log rather than re-deriving it.
(define
mod/sanction?
(fn
(action)
(mod/any? (fn (a) (= a action)) (list "hide" "remove" "ban"))))
;; count of prior sanctioning decisions in the audit log about a subject
(define
mod/subject-sanctions
(fn
(subject)
(reduce
(fn
(acc e)
(let
((r (mod/get-report (get e :report-id))))
(if
(nil? r)
acc
(if
(if
(= (mod/report-about r) subject)
(mod/sanction? (get e :action))
false)
(+ acc 1)
acc))))
0
(mod/audit-all))))
(define
mod/repeat-offender?
(fn (subject k) (<= k (mod/subject-sanctions subject))))
(define
mod/decide-escalating
(fn
(id k)
(let
((r (mod/get-report id)))
(if
(nil? r)
nil
(let
((priors (mod/subject-sanctions (mod/report-about r))))
(let
((d (mod/decide id)))
(if
(if (mod/sanction? (get d :action)) (<= k priors) false)
{:action "ban" :proof {:goals (get (get d :proof) :goals) :prior-sanctions priors :evidence (get (get d :proof) :evidence) :conditions (list) :rule "repeat-offender-ban" :count (get (get d :proof) :count)} :report-id id :rule "repeat-offender-ban" :strategy "escalating"}
d)))))))

18
lib/mod/pipeline.sx Normal file
View File

@@ -0,0 +1,18 @@
;; lib/mod/pipeline.sx — end-to-end triage orchestration.
;;
;; A single entry point that runs a report through the subsystem and returns the
;; full artifact bundle: the decision (under the report's domain policy), a
;; human-readable explanation, an ActivityPub-shaped event for the bus, and the
;; wire line for federated peers. Composes policies (Ext 17), explain (Ext 3),
;; activity (Ext 16) and wire (Ext 14) — the modules are independent, this is just
;; the convenience that wires them together for the common "process a report" path.
(define
mod/triage-pipeline
(fn
(domain r reports actor)
(let ((d (mod/decide-in domain r reports))) {:activity (mod/decision->activity d actor) :action (get d :action) :wire (mod/decision->wire d) :rule (get d :rule) :decision d :explanation (mod/explain d)})))
(define mod/pipeline-action (fn (p) (get p :action)))
(define mod/pipeline-activity (fn (p) (get p :activity)))
(define mod/pipeline-wire (fn (p) (get p :wire)))

40
lib/mod/policies.sx Normal file
View 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*)))

137
lib/mod/policy.sx Normal file
View File

@@ -0,0 +1,137 @@
;; lib/mod/policy.sx — moderation rules → Prolog clauses.
;;
;; A rule is {:name :action :when}. :when is a list of condition forms; each
;; compiles to a Prolog goal. The conditions in a :when list are ANDed (joined by
;; ", "); :not negates and :any (a list of sub-conditions) disjoins — so the
;; condition language is a small boolean algebra over the leaf predicates.
;; Rule order is precedence: the engine queries with pl-query-one, so the first
;; clause that proves wins. The final default rule has an empty body (true) so
;; every report yields at least :keep — "no rule matched" is a real result, not a
;; query failure.
;;
;; cond->goal takes an id-term so the same condition can be compiled with the
;; head variable "Id" (for clause bodies) or a concrete report id (for proof-tree
;; goal-by-goal re-querying in the engine).
;;
;; Precedence (top wins): exoneration evidence (appeal override) > confirmed-abuse
;; evidence (human review) > spam/abuse classification > repeated-report count >
;; default keep.
(define mod/mk-rule (fn (name action conds) {:when conds :name name :action action}))
(define mod/rule-name (fn (r) (get r :name)))
(define mod/rule-action (fn (r) (get r :action)))
(define mod/rule-when (fn (r) (get r :when)))
(define
mod/default-rules
(list
(mod/mk-rule
"exonerated-keep"
:keep (list (list :evidence "exonerated")))
(mod/mk-rule
"reviewer-remove"
:remove (list (list :evidence "confirmed-abuse")))
(mod/mk-rule "spam-hide" :hide (list (list :classification "spam")))
(mod/mk-rule
"abuse-remove"
:remove (list (list :classification "abuse")))
(mod/mk-rule
"repeated-escalate"
:escalate (list (list :count-at-least 3)))
(mod/mk-rule "default-keep" :keep (list))))
;; ── condition → Prolog goal ──
;;
;; (:classification "spam") → classification(Id, spam)
;; (:evidence "kind") → evidence(Id, 'kind', _)
;; (:attr "verified") → attr(Id, verified)
;; (:not <cond>) → not(<cond>) (negation)
;; (:any (list c1 c2 ...)) → (g1 ; g2 ; ...) (disjunction)
;; (:count-at-least 3) → report(Id, B, S), report_count(S, N), N >= 3
;; (:score-at-least 5) → aggregate_all(sum(W), signal(Id, _, W), T), T >= 5
;; (:reporters-at-least 2) → report(Id, _, Sr), setof(Br, report(_, Br, Sr), Bsr),
;; length(Bsr, Nr), Nr >= 2 (quorum engine)
;; (:burst-at-least 3) → report(Id, _, Sb), burst_count(Sb, Nb), Nb >= 3
;; (temporal engine)
(define
mod/cond->goal
(fn
(c idterm)
(let
((tag (first c)))
(cond
((= tag :classification)
(str "classification(" idterm ", " (nth c 1) ")"))
((= tag :evidence)
(str
"evidence("
idterm
", "
(mod/pl-quote (nth c 1))
", _)"))
((= tag :attr) (str "attr(" idterm ", " (nth c 1) ")"))
((= tag :not)
(str "not(" (mod/cond->goal (nth c 1) idterm) ")"))
((= tag :any)
(str
"("
(mod/join-with
" ; "
(map
(fn (sub) (mod/cond->goal sub idterm))
(nth c 1)))
")"))
((= tag :count-at-least)
(str
"report("
idterm
", B, S), report_count(S, N), N >= "
(nth c 1)))
((= tag :score-at-least)
(str
"aggregate_all(sum(W), signal("
idterm
", _, W), T), T >= "
(nth c 1)))
((= tag :reporters-at-least)
(str
"report("
idterm
", _, Sr), setof(Br, report(_, Br, Sr), Bsr), "
"length(Bsr, Nr), Nr >= "
(nth c 1)))
((= tag :burst-at-least)
(str
"report("
idterm
", _, Sb), burst_count(Sb, Nb), Nb >= "
(nth c 1)))
(true "true")))))
(define
mod/conds->body
(fn
(conds idterm)
(if
(empty? conds)
"true"
(mod/join-with ", " (map (fn (c) (mod/cond->goal c idterm)) conds)))))
(define
mod/rule->clause
(fn
(r)
(str
"policy_action(Id, "
(mod/rule-action r)
", '"
(mod/rule-name r)
"') :- "
(mod/conds->body (mod/rule-when r) "Id")
".")))
(define
mod/rules->program
(fn (rules) (mod/join-with "\n" (map mod/rule->clause rules))))

40
lib/mod/quorum.sx Normal file
View File

@@ -0,0 +1,40 @@
;; lib/mod/quorum.sx — quorum decisions over distinct reporters (anti-brigade).
;;
;; The base engine asserts only the decided report's report/3 fact, so it can't
;; reason about WHO reported a subject. The quorum engine additionally asserts
;; every report's report/3 fact (via link's rel-facts), letting a rule require N
;; *distinct* reporters with `setof`/`length` — so one user filing many reports
;; does not manufacture consensus. Same decision shape as the base engine, plus
;; :strategy "quorum".
(define
mod/build-quorum-program
(fn
(r count reports rules)
(str
(mod/report-rel-facts reports)
"\n"
(mod/report-facts r count)
"\n"
(mod/rules->program rules))))
(define
mod/decide-quorum
(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-quorum-program r count reports rules)))
(let
((db (pl-load program)))
(let
((sol (pl-query-one db (str "policy_action(" id ", Action, Rule)"))))
(if
(nil? sol)
{:action "keep" :proof {:goals (list) :evidence kinds :conditions (list) :rule "none" :count count} :report-id id :rule "none" :strategy "quorum"}
(let
((rule (mod/find-rule rules (dict-get sol "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 "quorum"}))))))))

259
lib/mod/schema.sx Normal file
View File

@@ -0,0 +1,259 @@
;; lib/mod/schema.sx — report representation + Prolog fact generation.
;;
;; A report is a dict {:id :by :about :reason :evidence :attrs :signals :at}.
;; :evidence — accumulated {:kind :val} entries (human review, scanners)
;; :attrs — attribute names ("verified") for negation-as-failure conditions
;; :signals — weighted {:kind :weight} entries for aggregate scoring rules
;; :at — integer timestamp/tick (deterministic; supplied, not clock-read)
;; The engine derives keyword classifications from the reason text and projects
;; the report, its classifications, evidence, attributes, and signals into Prolog
;; facts that policy clauses match against.
(define mod/mk-report (fn (id by about reason) {:attrs (list) :id id :signals (list) :by by :evidence (list) :about about :at 0 :reason reason}))
(define mod/report-id (fn (r) (get r :id)))
(define mod/report-by (fn (r) (get r :by)))
(define mod/report-about (fn (r) (get r :about)))
(define mod/report-reason (fn (r) (get r :reason)))
(define
mod/report-evidence
(fn (r) (let ((e (get r :evidence))) (if (nil? e) (list) e))))
(define
mod/report-attrs
(fn (r) (let ((a (get r :attrs))) (if (nil? a) (list) a))))
(define
mod/report-signals
(fn (r) (let ((s (get r :signals))) (if (nil? s) (list) s))))
(define
mod/report-at
(fn (r) (let ((t (get r :at))) (if (nil? t) 0 t))))
(define mod/mk-evidence (fn (kind val) {:val val :kind kind}))
(define mod/evidence-kind (fn (e) (get e :kind)))
(define mod/evidence-val (fn (e) (get e :val)))
(define mod/mk-signal (fn (kind weight) {:kind kind :weight weight}))
(define mod/signal-kind (fn (s) (get s :kind)))
(define mod/signal-weight (fn (s) (get s :weight)))
(define mod/report* (fn (r evs attrs sigs at) {:attrs attrs :id (mod/report-id r) :signals sigs :by (mod/report-by r) :evidence evs :about (mod/report-about r) :at at :reason (mod/report-reason r)}))
(define
mod/with-evidence
(fn
(r evs)
(mod/report*
r
evs
(mod/report-attrs r)
(mod/report-signals r)
(mod/report-at r))))
(define
mod/with-attrs
(fn
(r attrs)
(mod/report*
r
(mod/report-evidence r)
attrs
(mod/report-signals r)
(mod/report-at r))))
(define
mod/with-signals
(fn
(r sigs)
(mod/report*
r
(mod/report-evidence r)
(mod/report-attrs r)
sigs
(mod/report-at r))))
(define
mod/with-at
(fn
(r at)
(mod/report*
r
(mod/report-evidence r)
(mod/report-attrs r)
(mod/report-signals r)
at)))
(define
mod/attach-evidence
(fn
(r e)
(mod/with-evidence r (append (mod/report-evidence r) (list e)))))
(define
mod/attach-attr
(fn (r a) (mod/with-attrs r (append (mod/report-attrs r) (list a)))))
(define
mod/attach-signal
(fn (r s) (mod/with-signals r (append (mod/report-signals r) (list s)))))
;; ── substring search (the prolog-loaded env lacks includes?; slice/len do work) ──
(define
mod/contains-at?
(fn
(hay needle hl nl pos)
(if
(< hl (+ pos nl))
false
(if
(= (slice hay pos (+ pos nl)) needle)
true
(mod/contains-at? hay needle hl nl (+ pos 1))))))
(define
mod/str-contains?
(fn
(hay needle)
(let
((hl (len hay)) (nl (len needle)))
(if
(= nl 0)
true
(mod/contains-at? hay needle hl nl 0)))))
;; ── evidence derivation (keyword classification) ──
(define
mod/spam-keywords
(list "spam" "buy now" "click here" "free money" "viagra" "limited offer"))
(define
mod/abuse-keywords
(list "abuse" "harassment" "threat" "slur" "hate speech"))
(define
mod/any?
(fn (pred coll) (reduce (fn (acc x) (if acc acc (pred x))) false coll)))
(define
mod/reason-matches?
(fn
(reason kws)
(let
((low (downcase reason)))
(mod/any? (fn (k) (mod/str-contains? low k)) kws))))
(define
mod/classify-keywords
(fn
(r)
(let
((reason (mod/report-reason r)) (kinds (list)))
(begin
(when
(mod/reason-matches? reason mod/spam-keywords)
(append! kinds "spam"))
(when
(mod/reason-matches? reason mod/abuse-keywords)
(append! kinds "abuse"))
kinds))))
(define
mod/report-count
(fn
(about reports)
(reduce
(fn
(acc r)
(if (= (mod/report-about r) about) (+ acc 1) acc))
0
reports)))
;; ── Prolog fact projection ──
(define
mod/join-with
(fn
(sep items)
(reduce (fn (acc x) (if (= acc "") x (str acc sep x))) "" items)))
(define mod/pl-quote (fn (s) (str "'" s "'")))
(define
mod/classification-facts
(fn
(id kinds)
(mod/join-with
"\n"
(map (fn (k) (str "classification(" id ", " k ").")) kinds))))
(define
mod/evidence-facts
(fn
(id evs)
(mod/join-with
"\n"
(map
(fn
(e)
(str
"evidence("
id
", "
(mod/pl-quote (mod/evidence-kind e))
", "
(mod/pl-quote (str (mod/evidence-val e)))
")."))
evs))))
(define
mod/attr-facts
(fn
(id attrs)
(mod/join-with "\n" (map (fn (a) (str "attr(" id ", " a ").")) attrs))))
(define
mod/signal-facts
(fn
(id sigs)
(mod/join-with
"\n"
(map
(fn
(s)
(str
"signal("
id
", "
(mod/pl-quote (mod/signal-kind s))
", "
(mod/signal-weight s)
")."))
sigs))))
(define
mod/report-facts
(fn
(r count)
(let
((id (mod/report-id r))
(by (mod/pl-quote (mod/report-by r)))
(about (mod/pl-quote (mod/report-about r))))
(let
((cls (mod/classification-facts id (mod/classify-keywords r)))
(evs (mod/evidence-facts id (mod/report-evidence r)))
(ats (mod/attr-facts id (mod/report-attrs r)))
(sgs (mod/signal-facts id (mod/report-signals r))))
(mod/join-with
"\n"
(list
(str "report(" id ", " by ", " about ").")
(str "report_count(" about ", " count ").")
cls
evs
ats
sgs))))))

30
lib/mod/scoreboard.json Normal file
View File

@@ -0,0 +1,30 @@
{
"lang": "mod",
"total_passed": 390,
"total_failed": 0,
"total": 390,
"suites": [
{"name":"decide","passed":31,"failed":0,"total":31},
{"name":"audit","passed":29,"failed":0,"total":29},
{"name":"escalation","passed":46,"failed":0,"total":46},
{"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":"severity","passed":14,"failed":0,"total":14},
{"name":"offenders","passed":19,"failed":0,"total":19},
{"name":"quorum","passed":9,"failed":0,"total":9},
{"name":"trace","passed":15,"failed":0,"total":15},
{"name":"whatif","passed":13,"failed":0,"total":13},
{"name":"batch","passed":17,"failed":0,"total":17},
{"name":"temporal","passed":15,"failed":0,"total":15},
{"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":"policies","passed":14,"failed":0,"total":14},
{"name":"defrule","passed":11,"failed":0,"total":11},
{"name":"pipeline","passed":15,"failed":0,"total":15}
],
"generated": "2026-06-06T19:40:03+00:00"
}

27
lib/mod/scoreboard.md Normal file
View File

@@ -0,0 +1,27 @@
# mod scoreboard
**390 / 390 passing** (0 failure(s)).
| Suite | Passed | Total | Status |
|-------|--------|-------|--------|
| decide | 31 | 31 | ok |
| audit | 29 | 29 | ok |
| escalation | 46 | 46 | ok |
| fed | 26 | 26 | ok |
| extensions | 32 | 32 | ok |
| link | 12 | 12 | ok |
| lint | 14 | 14 | ok |
| severity | 14 | 14 | ok |
| offenders | 19 | 19 | ok |
| quorum | 9 | 9 | ok |
| trace | 15 | 15 | ok |
| whatif | 13 | 13 | ok |
| batch | 17 | 17 | ok |
| temporal | 15 | 15 | ok |
| sla | 15 | 15 | ok |
| wire | 16 | 16 | ok |
| disjunction | 10 | 10 | ok |
| activity | 17 | 17 | ok |
| policies | 14 | 14 | ok |
| defrule | 11 | 11 | ok |
| pipeline | 15 | 15 | 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"})))))))))

47
lib/mod/sla.sx Normal file
View File

@@ -0,0 +1,47 @@
;; lib/mod/sla.sx — service-level sweep over pending lifecycle cases.
;;
;; Composes the Phase-3 lifecycle with the Ext-12 time dimension: a case left in a
;; pending state (open / triaged / appealed) past a deadline has breached SLA and
;; should resurface. A timed-case pairs a case with the tick it entered its
;; current state (the caller stamps this — the lifecycle stays timeless and pure).
;; Terminal states (decided / final) never breach.
(define mod/pending-states (list "open" "triaged" "appealed"))
(define mod/pending-state? (fn (s) (mod/member? s mod/pending-states)))
(define mod/mk-timed-case (fn (c entered-at) {:entered-at entered-at :case c}))
(define mod/tc-case (fn (tc) (get tc :case)))
(define mod/tc-entered-at (fn (tc) (get tc :entered-at)))
(define
mod/overdue?
(fn
(tc now deadline)
(if
(mod/pending-state? (mod/case-state (mod/tc-case tc)))
(< deadline (- now (mod/tc-entered-at tc)))
false)))
(define
mod/sla-sweep
(fn
(timed-cases now deadline)
(reduce
(fn
(acc tc)
(if
(mod/overdue? tc now deadline)
(append
acc
(list (mod/report-id (mod/case-report (mod/tc-case tc)))))
acc))
(list)
timed-cases)))
(define
mod/overdue-count
(fn
(timed-cases now deadline)
(len (mod/sla-sweep timed-cases now deadline))))
(define mod/age (fn (tc now) (- now (mod/tc-entered-at tc))))

62
lib/mod/temporal.sx Normal file
View File

@@ -0,0 +1,62 @@
;; lib/mod/temporal.sx — burst detection over a time window.
;;
;; A plain report count can't tell a burst (N reports in minutes) from slow
;; accumulation (N reports over months). mod/decide-temporal takes a `now` tick
;; and a `window`, counts reports about the subject with :at within [now-window,
;; now], asserts it as burst_count/2, and lets a `(:burst-at-least K)` rule fire
;; only on a genuine burst. Time is supplied (deterministic), never clock-read.
(define
mod/window-count
(fn
(subject reports now window)
(reduce
(fn
(acc r)
(if
(if
(= (mod/report-about r) subject)
(<= (- now window) (mod/report-at r))
false)
(+ acc 1)
acc))
0
reports)))
(define
mod/build-temporal-program
(fn
(r count bcount rules)
(str
(mod/report-facts r count)
"\n"
"burst_count("
(mod/pl-quote (mod/report-about r))
", "
bcount
").\n"
(mod/rules->program rules))))
(define
mod/decide-temporal
(fn
(r reports rules now window)
(let
((about (mod/report-about r))
(id (mod/report-id r))
(kinds (mod/classify-keywords r)))
(let
((count (mod/report-count about reports))
(bcount (mod/window-count about reports now window)))
(let
((program (mod/build-temporal-program r count bcount rules)))
(let
((db (pl-load program)))
(let
((sol (pl-query-one db (str "policy_action(" id ", Action, Rule)"))))
(if
(nil? sol)
{:action "keep" :proof {:burst bcount :goals (list) :evidence kinds :conditions (list) :rule "none" :count count} :report-id id :rule "none" :strategy "temporal"}
(let
((rule (mod/find-rule rules (dict-get sol "Rule"))))
{:action (mod/rule-action rule) :proof {:burst bcount :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 "temporal"})))))))))

95
lib/mod/tests/activity.sx Normal file
View File

@@ -0,0 +1,95 @@
;; lib/mod/tests/activity.sx — Ext 16: ActivityPub-shaped decision export.
(define mod-ap-count 0)
(define mod-ap-pass 0)
(define mod-ap-fail 0)
(define mod-ap-failures (list))
(define
mod-ap-test!
(fn
(name got expected)
(begin
(set! mod-ap-count (+ mod-ap-count 1))
(if
(= got expected)
(set! mod-ap-pass (+ mod-ap-pass 1))
(begin
(set! mod-ap-fail (+ mod-ap-fail 1))
(append!
mod-ap-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; ── action → AP verb ──
(mod-ap-test! "remove → Delete" (mod/action->verb "remove") "Delete")
(mod-ap-test! "ban → Block" (mod/action->verb "ban") "Block")
(mod-ap-test! "hide → Flag" (mod/action->verb "hide") "Flag")
(mod-ap-test! "escalate → Flag" (mod/action->verb "escalate") "Flag")
(mod-ap-test! "keep → nil (no activity)" (mod/action->verb "keep") nil)
;; ── single decision → activity ──
(define mod-ap-spam (mod/mk-report "r1" "a" "bob" "this is spam"))
(define
mod-ap-dec
(mod/decide-report mod-ap-spam (list mod-ap-spam) mod/default-rules))
(define mod-ap-act (mod/decision->activity mod-ap-dec "instance.example"))
(mod-ap-test! "activity type is Flag (hide)" (get mod-ap-act :type) "Flag")
(mod-ap-test! "activity object is report id" (get mod-ap-act :object) "r1")
(mod-ap-test!
"activity actor preserved"
(get mod-ap-act :actor)
"instance.example")
(mod-ap-test!
"activity preserves precise action"
(get mod-ap-act :action)
"hide")
(mod-ap-test! "activity carries rule" (get mod-ap-act :rule) "spam-hide")
(mod-ap-test!
"activity summary"
(get mod-ap-act :summary)
"moderation/hide via spam-hide")
;; ── keep produces no activity ──
(define mod-ap-clean (mod/mk-report "r2" "a" "b" "a fine post"))
(define
mod-ap-keep
(mod/decide-report mod-ap-clean (list mod-ap-clean) mod/default-rules))
(mod-ap-test!
"keep decision → nil activity"
(mod/decision->activity mod-ap-keep "x")
nil)
;; ── abuse → Delete ──
(define mod-ap-abuse (mod/mk-report "r3" "a" "b" "harassment here"))
(define
mod-ap-abuse-dec
(mod/decide-report mod-ap-abuse (list mod-ap-abuse) mod/default-rules))
(mod-ap-test!
"abuse decision → Delete activity"
(get (mod/decision->activity mod-ap-abuse-dec "x") :type)
"Delete")
;; ── batch export drops keeps ──
(define mod-ap-decisions (list mod-ap-dec mod-ap-keep mod-ap-abuse-dec))
(define mod-ap-acts (mod/decisions->activities mod-ap-decisions "inst"))
(mod-ap-test! "batch export drops the keep" (len mod-ap-acts) 2)
(mod-ap-test!
"batch export first is the Flag"
(get (first mod-ap-acts) :type)
"Flag")
(mod-ap-test!
"batch export second is the Delete"
(get (nth mod-ap-acts 1) :type)
"Delete")
(mod-ap-test!
"empty decisions → no activities"
(mod/decisions->activities (list) "inst")
(list))
(define mod-activity-tests-run! (fn () {:failures mod-ap-failures :total mod-ap-count :passed mod-ap-pass :failed mod-ap-fail}))

187
lib/mod/tests/audit.sx Normal file
View File

@@ -0,0 +1,187 @@
;; lib/mod/tests/audit.sx — Phase 2: evidence accumulation + proof tree + audit.
(define mod-aud-count 0)
(define mod-aud-pass 0)
(define mod-aud-fail 0)
(define mod-aud-failures (list))
(define
mod-aud-test!
(fn
(name got expected)
(begin
(set! mod-aud-count (+ mod-aud-count 1))
(if
(= got expected)
(set! mod-aud-pass (+ mod-aud-pass 1))
(begin
(set! mod-aud-fail (+ mod-aud-fail 1))
(append!
mod-aud-failures
(str name "\n expected: " expected "\n got: " got)))))))
(define
mod-aud-decide1
(fn (r) (mod/decide-report r (list r) mod/default-rules)))
;; ── proof tree: keyword classification ──
(define
mod-aud-spam
(mod-aud-decide1 (mod/mk-report "r1" "alice" "bob" "this is spam")))
(define mod-aud-spam-goals (get (get mod-aud-spam :proof) :goals))
(mod-aud-test! "spam proof has one goal" (len mod-aud-spam-goals) 1)
(mod-aud-test!
"spam proof goal text"
(get (first mod-aud-spam-goals) :goal)
"classification(r1, spam)")
(mod-aud-test!
"spam proof goal solved"
(get (first mod-aud-spam-goals) :solved)
true)
;; ── proof tree: count rule with real bindings ──
(define mod-aud-rep-r (mod/mk-report "r3" "ann" "dave" "x"))
(define
mod-aud-rep
(mod/decide-report
mod-aud-rep-r
(list mod-aud-rep-r mod-aud-rep-r mod-aud-rep-r)
mod/default-rules))
(define mod-aud-rep-goals (get (get mod-aud-rep :proof) :goals))
(define mod-aud-rep-binds (get (first mod-aud-rep-goals) :bindings))
(mod-aud-test!
"count proof goal solved"
(get (first mod-aud-rep-goals) :solved)
true)
(mod-aud-test! "count proof binding N" (dict-get mod-aud-rep-binds "N") "3")
(mod-aud-test!
"count proof binding S (subject)"
(dict-get mod-aud-rep-binds "S")
"dave")
;; ── proof tree: default keep has a 'true' goal ──
(define
mod-aud-keep
(mod-aud-decide1 (mod/mk-report "rk" "a" "b" "a fine post")))
(define mod-aud-keep-goals (get (get mod-aud-keep :proof) :goals))
(mod-aud-test!
"keep proof goal text true"
(get (first mod-aud-keep-goals) :goal)
"true")
(mod-aud-test!
"keep proof goal solved"
(get (first mod-aud-keep-goals) :solved)
true)
;; ── evidence accumulation drives a rule ──
(define
mod-aud-rev-r
(mod/attach-evidence
(mod/mk-report "re" "a" "carol" "neutral")
(mod/mk-evidence "confirmed-abuse" "human")))
(define mod-aud-rev (mod-aud-decide1 mod-aud-rev-r))
(mod-aud-test!
"evidence has length 1"
(len (mod/report-evidence mod-aud-rev-r))
1)
(mod-aud-test!
"evidence reviewer-remove → remove"
(get mod-aud-rev :action)
"remove")
(mod-aud-test!
"evidence reviewer-remove rule"
(get mod-aud-rev :rule)
"reviewer-remove")
(mod-aud-test!
"evidence proof goal solved"
(get (first (get (get mod-aud-rev :proof) :goals)) :solved)
true)
(mod-aud-test!
"no evidence → not reviewer-remove"
(get (mod-aud-decide1 (mod/mk-report "rn" "a" "b" "neutral")) :rule)
"default-keep")
;; ── append-only audit log via the api ──
(mod/reset!)
(mod/report "alice" "bob" "this is spam")
(mod/report "carol" "eve" "fine post")
(define mod-aud-d1 (mod/decide "r1"))
(define mod-aud-d2 (mod/decide "r2"))
(mod-aud-test! "two decisions logged" (mod/audit-count) 2)
(mod-aud-test!
"first entry seq 1"
(get (first (mod/audit-all)) :seq)
1)
(mod-aud-test!
"audit r1 returns one entry"
(len (mod/audit "r1"))
1)
(mod-aud-test!
"audit r1 action matches decision"
(get (first (mod/audit "r1")) :action)
(get mod-aud-d1 :action))
(mod-aud-test!
"audit r1 rule matches decision"
(get (first (mod/audit "r1")) :rule)
"spam-hide")
(mod-aud-test!
"audit r1 entry carries proof goals"
(len (get (get (first (mod/audit "r1")) :proof) :goals))
1)
(mod-aud-test!
"audit r2 keep"
(get (first (mod/audit "r2")) :action)
"keep")
(mod-aud-test! "audit unknown report → empty" (mod/audit "r99") (list))
;; ── append-only: re-deciding appends, never mutates ──
(define mod-aud-d1b (mod/decide "r1"))
(mod-aud-test! "re-decide appends (count 3)" (mod/audit-count) 3)
(mod-aud-test!
"audit r1 now has 2 entries"
(len (mod/audit "r1"))
2)
(mod-aud-test!
"audit r1 seqs monotonic"
(get (nth (mod/audit "r1") 1) :seq)
3)
(mod-aud-test!
"audit-latest r1 is seq 3"
(get (mod/audit-latest "r1") :seq)
3)
(mod-aud-test!
"first r1 entry unchanged (still seq 1)"
(get (first (mod/audit "r1")) :seq)
1)
;; ── evidence snapshot captured at decision time ──
(mod/add-evidence "r2" "confirmed-abuse" "human")
(define mod-aud-d2b (mod/decide "r2"))
(mod-aud-test!
"post-evidence decision flips to remove"
(get mod-aud-d2b :action)
"remove")
(mod-aud-test!
"audit snapshot records evidence kind"
(mod/evidence-kind (first (get (mod/audit-latest "r2") :evidence)))
"confirmed-abuse")
(mod-aud-test!
"earlier r2 entry had empty evidence snapshot"
(len (get (first (mod/audit "r2")) :evidence))
0)
(define mod-audit-tests-run! (fn () {:failures mod-aud-failures :total mod-aud-count :passed mod-aud-pass :failed mod-aud-fail}))

101
lib/mod/tests/batch.sx Normal file
View File

@@ -0,0 +1,101 @@
;; lib/mod/tests/batch.sx — Ext 11: batch triage + corpus analytics.
(define mod-b-count 0)
(define mod-b-pass 0)
(define mod-b-fail 0)
(define mod-b-failures (list))
(define
mod-b-test!
(fn
(name got expected)
(begin
(set! mod-b-count (+ mod-b-count 1))
(if
(= got expected)
(set! mod-b-pass (+ mod-b-pass 1))
(begin
(set! mod-b-fail (+ mod-b-fail 1))
(append!
mod-b-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; corpus: 2 spam, 1 abuse, 2 clean — distinct subjects so the count rule stays quiet
(define
mod-b-corpus
(list
(mod/mk-report "r1" "u" "s1" "this is spam")
(mod/mk-report "r2" "u" "s2" "buy now offer")
(mod/mk-report "r3" "u" "s3" "harassment here")
(mod/mk-report "r4" "u" "s4" "a fine post")
(mod/mk-report "r5" "u" "s5" "thanks for sharing")))
(define mod-b-decisions (mod/decide-batch mod-b-corpus mod/default-rules))
;; ── decide-batch ──
(mod-b-test! "one decision per report" (len mod-b-decisions) 5)
(mod-b-test!
"first decision is hide"
(get (first mod-b-decisions) :action)
"hide")
;; ── action histogram ──
(define mod-b-hist (mod/action-histogram mod-b-decisions))
(mod-b-test! "histogram hide count" (get mod-b-hist :hide) 2)
(mod-b-test! "histogram remove count" (get mod-b-hist :remove) 1)
(mod-b-test! "histogram keep count" (get mod-b-hist :keep) 2)
(mod-b-test! "histogram escalate count" (get mod-b-hist :escalate) 0)
(mod-b-test! "histogram ban count" (get mod-b-hist :ban) 0)
(mod-b-test!
"histogram totals match corpus"
(+
(+ (get mod-b-hist :hide) (get mod-b-hist :remove))
(+
(get mod-b-hist :keep)
(+ (get mod-b-hist :escalate) (get mod-b-hist :ban))))
5)
;; ── rule coverage (empirical) ──
(define mod-b-cov (mod/rule-coverage mod-b-corpus mod/default-rules))
(mod-b-test! "coverage has one row per rule" (len mod-b-cov) 6)
(mod-b-test!
"spam-hide fired twice"
(mod/rule-fire-count mod-b-decisions "spam-hide")
2)
(mod-b-test!
"abuse-remove fired once"
(mod/rule-fire-count mod-b-decisions "abuse-remove")
1)
(mod-b-test!
"default-keep fired twice"
(mod/rule-fire-count mod-b-decisions "default-keep")
2)
;; ── never-fired: rules not exercised by this corpus ──
(define mod-b-never (mod/never-fired mod-b-corpus mod/default-rules))
(mod-b-test!
"exonerated-keep never fired"
(mod/member? "exonerated-keep" mod-b-never)
true)
(mod-b-test!
"reviewer-remove never fired"
(mod/member? "reviewer-remove" mod-b-never)
true)
(mod-b-test!
"repeated-escalate never fired"
(mod/member? "repeated-escalate" mod-b-never)
true)
(mod-b-test!
"spam-hide DID fire (not in never-fired)"
(mod/member? "spam-hide" mod-b-never)
false)
(mod-b-test!
"three rules never fired on this corpus"
(len mod-b-never)
3)
(define mod-batch-tests-run! (fn () {:failures mod-b-failures :total mod-b-count :passed mod-b-pass :failed mod-b-fail}))

215
lib/mod/tests/decide.sx Normal file
View File

@@ -0,0 +1,215 @@
;; lib/mod/tests/decide.sx — Phase 1: report representation + simple policy.
(define mod-dec-count 0)
(define mod-dec-pass 0)
(define mod-dec-fail 0)
(define mod-dec-failures (list))
(define
mod-dec-test!
(fn
(name got expected)
(begin
(set! mod-dec-count (+ mod-dec-count 1))
(if
(= got expected)
(set! mod-dec-pass (+ mod-dec-pass 1))
(begin
(set! mod-dec-fail (+ mod-dec-fail 1))
(append!
mod-dec-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; decide a single report (count over a 1-element registry)
(define
mod-dec-one
(fn
(reason)
(let
((r (mod/mk-report "r1" "alice" "bob" reason)))
(mod/decide-report r (list r) mod/default-rules))))
(define mod-dec-action (fn (reason) (get (mod-dec-one reason) :action)))
;; ── spam keyword → :hide ──
(mod-dec-test!
"spam keyword 'spam' → hide"
(mod-dec-action "this is spam")
"hide")
(mod-dec-test!
"spam keyword 'buy now' → hide"
(mod-dec-action "buy now while stocks last")
"hide")
(mod-dec-test!
"spam keyword case-insensitive 'CLICK HERE' → hide"
(mod-dec-action "CLICK HERE now")
"hide")
(mod-dec-test!
"spam keyword 'free money' → hide"
(mod-dec-action "win free money fast")
"hide")
;; ── abuse keyword → :remove ──
(mod-dec-test!
"abuse keyword 'harassment' → remove"
(mod-dec-action "ongoing harassment of users")
"remove")
(mod-dec-test!
"abuse keyword 'threat' → remove"
(mod-dec-action "this is a threat")
"remove")
(mod-dec-test!
"abuse keyword 'slur' → remove"
(mod-dec-action "contains a slur")
"remove")
;; ── no rule → :keep ──
(mod-dec-test!
"neutral reason → keep"
(mod-dec-action "I disagree with this post")
"keep")
(mod-dec-test! "empty reason → keep" (mod-dec-action "") "keep")
;; ── decision carries the matching rule (proof, not bare keyword) ──
(mod-dec-test!
"spam decision rule name"
(get (mod-dec-one "this is spam") :rule)
"spam-hide")
(mod-dec-test!
"keep decision rule name"
(get (mod-dec-one "fine post") :rule)
"default-keep")
(mod-dec-test!
"abuse decision rule name"
(get (mod-dec-one "harassment here") :rule)
"abuse-remove")
(mod-dec-test!
"spam proof :rule"
(get (get (mod-dec-one "spam!") :proof) :rule)
"spam-hide")
(mod-dec-test!
"spam proof :evidence"
(get (get (mod-dec-one "spam!") :proof) :evidence)
(list "spam"))
(mod-dec-test!
"spam proof :count"
(get (get (mod-dec-one "spam!") :proof) :count)
1)
;; ── classification (evidence derivation) ──
(mod-dec-test!
"classify spam"
(mod/classify-keywords (mod/mk-report "r1" "a" "b" "spam!"))
(list "spam"))
(mod-dec-test!
"classify abuse"
(mod/classify-keywords (mod/mk-report "r1" "a" "b" "abuse"))
(list "abuse"))
(mod-dec-test!
"classify neutral → empty"
(mod/classify-keywords (mod/mk-report "r1" "a" "b" "hello"))
(list))
(mod-dec-test!
"classify both spam+abuse"
(mod/classify-keywords (mod/mk-report "r1" "a" "b" "spam and abuse"))
(list "spam" "abuse"))
;; ── report-count + repeated → :escalate ──
(define
mod-dec-three
(list
(mod/mk-report "r1" "a" "bob" "x")
(mod/mk-report "r2" "c" "bob" "y")
(mod/mk-report "r3" "d" "bob" "z")))
(mod-dec-test!
"report-count counts subject"
(mod/report-count "bob" mod-dec-three)
3)
(mod-dec-test!
"3 reports about subject → escalate"
(get
(mod/decide-report (first mod-dec-three) mod-dec-three mod/default-rules)
:action)
"escalate")
(mod-dec-test!
"escalate rule name"
(get
(mod/decide-report (first mod-dec-three) mod-dec-three mod/default-rules)
:rule)
"repeated-escalate")
(define
mod-dec-two
(list
(mod/mk-report "r1" "a" "carol" "x")
(mod/mk-report "r2" "c" "carol" "y")))
(mod-dec-test!
"2 reports about subject → keep (below threshold)"
(get
(mod/decide-report (first mod-dec-two) mod-dec-two mod/default-rules)
:action)
"keep")
;; ── precedence: spam beats repeated ──
(define
mod-dec-spam-among-many
(list
(mod/mk-report "r1" "a" "dave" "buy now spam")
(mod/mk-report "r2" "c" "dave" "y")
(mod/mk-report "r3" "d" "dave" "z")))
(mod-dec-test!
"spam wins over repeated (precedence)"
(get
(mod/decide-report
(first mod-dec-spam-among-many)
mod-dec-spam-among-many
mod/default-rules)
:action)
"hide")
;; ── accessors ──
(mod-dec-test!
"report-about accessor"
(mod/report-about (mod/mk-report "r1" "a" "bob" "x"))
"bob")
(mod-dec-test!
"report-by accessor"
(mod/report-by (mod/mk-report "r1" "alice" "bob" "x"))
"alice")
;; ── api registry ──
(mod/reset!)
(define mod-dec-r1 (mod/report "alice" "bob" "this is spam"))
(define mod-dec-r2 (mod/report "carol" "eve" "fine post"))
(mod-dec-test!
"mod/report assigns sequential id r1"
(mod/report-id mod-dec-r1)
"r1")
(mod-dec-test!
"mod/report assigns sequential id r2"
(mod/report-id mod-dec-r2)
"r2")
(mod-dec-test!
"mod/decide via registry → hide"
(get (mod/decide "r1") :action)
"hide")
(mod-dec-test!
"mod/decide via registry → keep"
(get (mod/decide "r2") :action)
"keep")
(mod-dec-test! "mod/decide unknown id → nil" (mod/decide "r99") nil)
(define mod-decide-tests-run! (fn () {:failures mod-dec-failures :total mod-dec-count :passed mod-dec-pass :failed mod-dec-fail}))

95
lib/mod/tests/defrule.sx Normal file
View File

@@ -0,0 +1,95 @@
;; lib/mod/tests/defrule.sx — Ext 18: ergonomic defrule / ruleset.
(define mod-dr-count 0)
(define mod-dr-pass 0)
(define mod-dr-fail 0)
(define mod-dr-failures (list))
(define
mod-dr-test!
(fn
(name got expected)
(begin
(set! mod-dr-count (+ mod-dr-count 1))
(if
(= got expected)
(set! mod-dr-pass (+ mod-dr-pass 1))
(begin
(set! mod-dr-fail (+ mod-dr-fail 1))
(append!
mod-dr-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; ── defrule produces the same structure as mk-rule ──
(define
mod-dr-r
(mod/defrule "spam-hide" :hide (list :classification "spam")))
(mod-dr-test! "defrule name" (mod/rule-name mod-dr-r) "spam-hide")
(mod-dr-test! "defrule action" (mod/rule-action mod-dr-r) "hide")
(mod-dr-test!
"defrule when wraps the conditions"
(mod/rule-when mod-dr-r)
(list (list :classification "spam")))
(mod-dr-test!
"defrule equals mk-rule equivalent"
(mod/rule-when mod-dr-r)
(mod/rule-when
(mod/mk-rule "spam-hide" :hide (list (list :classification "spam")))))
;; ── multi-condition + no-condition ──
(define
mod-dr-multi
(mod/defrule
"strict"
:hide (list :classification "spam")
(list :not (list :attr "verified"))))
(mod-dr-test!
"defrule collects multiple conditions"
(len (mod/rule-when mod-dr-multi))
2)
(define mod-dr-catch (mod/defrule "default-keep" :keep))
(mod-dr-test!
"defrule with no conditions is unconditional"
(mod/rule-when mod-dr-catch)
(list))
;; ── ruleset assembles a list ──
(define
mod-dr-rules
(mod/ruleset
(mod/defrule "spam-hide" :hide (list :classification "spam"))
(mod/defrule "default-keep" :keep)))
(mod-dr-test! "ruleset length" (len mod-dr-rules) 2)
(mod-dr-test!
"ruleset first rule name"
(mod/rule-name (first mod-dr-rules))
"spam-hide")
;; ── engine works with defrule/ruleset-built policy ──
(define mod-dr-spam (mod/mk-report "r1" "a" "b" "this is spam"))
(define mod-dr-clean (mod/mk-report "r2" "a" "b" "a fine post"))
(mod-dr-test!
"defrule policy: spam → hide"
(get
(mod/decide-report mod-dr-spam (list mod-dr-spam) mod-dr-rules)
:action)
"hide")
(mod-dr-test!
"defrule policy: clean → keep"
(get
(mod/decide-report mod-dr-clean (list mod-dr-clean) mod-dr-rules)
:action)
"keep")
(mod-dr-test!
"defrule policy: spam names the rule"
(get (mod/decide-report mod-dr-spam (list mod-dr-spam) mod-dr-rules) :rule)
"spam-hide")
(define mod-defrule-tests-run! (fn () {:failures mod-dr-failures :total mod-dr-count :passed mod-dr-pass :failed mod-dr-fail}))

View File

@@ -0,0 +1,145 @@
;; lib/mod/tests/disjunction.sx — Ext 15: disjunctive (:any) conditions.
(define mod-or-count 0)
(define mod-or-pass 0)
(define mod-or-fail 0)
(define mod-or-failures (list))
(define
mod-or-test!
(fn
(name got expected)
(begin
(set! mod-or-count (+ mod-or-count 1))
(if
(= got expected)
(set! mod-or-pass (+ mod-or-pass 1))
(begin
(set! mod-or-fail (+ mod-or-fail 1))
(append!
mod-or-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; one rule, OR of two classifications → one action covers both
(define
mod-or-rules
(list
(mod/mk-rule
"spam-or-abuse-hide"
:hide (list
(list
:any (list (list :classification "spam") (list :classification "abuse")))))
(mod/mk-rule "default-keep" :keep (list))))
(define mod-or-spam (mod/mk-report "r1" "a" "b" "this is spam"))
(define mod-or-abuse (mod/mk-report "r2" "a" "b" "harassment here"))
(define mod-or-clean (mod/mk-report "r3" "a" "b" "a fine post"))
(mod-or-test!
"OR: spam branch → hide"
(get
(mod/decide-report mod-or-spam (list mod-or-spam) mod-or-rules)
:action)
"hide")
(mod-or-test!
"OR: abuse branch → hide"
(get
(mod/decide-report mod-or-abuse (list mod-or-abuse) mod-or-rules)
:action)
"hide")
(mod-or-test!
"OR: neither branch → keep"
(get
(mod/decide-report mod-or-clean (list mod-or-clean) mod-or-rules)
:action)
"keep")
;; ── goal text + proof ──
(mod-or-test!
"cond->goal :any joins with ;"
(mod/cond->goal
(list
:any (list (list :classification "spam") (list :classification "abuse")))
"Id")
"(classification(Id, spam) ; classification(Id, abuse))")
(define
mod-or-dec
(mod/decide-report mod-or-spam (list mod-or-spam) mod-or-rules))
(mod-or-test!
"OR proof goal solved"
(get (first (get (get mod-or-dec :proof) :goals)) :solved)
true)
(mod-or-test!
"OR proof goal text"
(get (first (get (get mod-or-dec :proof) :goals)) :goal)
"(classification(r1, spam) ; classification(r1, abuse))")
;; ── :any composes with :not (NOR-ish) and :attr ──
(define
mod-or-mixed-rules
(list
(mod/mk-rule
"spam-or-flagged-hide"
:hide (list
(list
:any (list (list :classification "spam") (list :attr "flagged")))))
(mod/mk-rule "default-keep" :keep (list))))
(define
mod-or-flagged
(mod/attach-attr (mod/mk-report "r4" "a" "b" "a fine post") "flagged"))
(mod-or-test!
"OR over classification|attr: flagged clean post → hide"
(get
(mod/decide-report
mod-or-flagged
(list mod-or-flagged)
mod-or-mixed-rules)
:action)
"hide")
(mod-or-test!
"cond->goal :any with :not branch"
(mod/cond->goal
(list
:any (list
(list :classification "spam")
(list :not (list :attr "verified"))))
"Id")
"(classification(Id, spam) ; not(attr(Id, verified)))")
;; AND still works alongside OR in the same :when list
(define
mod-or-and-rules
(list
(mod/mk-rule
"spam-and-not-verified"
:hide (list
(list
:any (list (list :classification "spam") (list :classification "abuse")))
(list :not (list :attr "verified"))))
(mod/mk-rule "default-keep" :keep (list))))
(define
mod-or-spam-verified
(mod/attach-attr (mod/mk-report "r5" "a" "b" "this is spam") "verified"))
(mod-or-test!
"AND of OR + NOT: verified spam → keep"
(get
(mod/decide-report
mod-or-spam-verified
(list mod-or-spam-verified)
mod-or-and-rules)
:action)
"keep")
(mod-or-test!
"AND of OR + NOT: unverified abuse → hide"
(get
(mod/decide-report mod-or-abuse (list mod-or-abuse) mod-or-and-rules)
:action)
"hide")
(define mod-disjunction-tests-run! (fn () {:failures mod-or-failures :total mod-or-count :passed mod-or-pass :failed mod-or-fail}))

279
lib/mod/tests/escalation.sx Normal file
View File

@@ -0,0 +1,279 @@
;; lib/mod/tests/escalation.sx — Phase 3: lifecycle state machine + escalation.
(define mod-esc-count 0)
(define mod-esc-pass 0)
(define mod-esc-fail 0)
(define mod-esc-failures (list))
(define
mod-esc-test!
(fn
(name got expected)
(begin
(set! mod-esc-count (+ mod-esc-count 1))
(if
(= got expected)
(set! mod-esc-pass (+ mod-esc-pass 1))
(begin
(set! mod-esc-fail (+ mod-esc-fail 1))
(append!
mod-esc-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; ── transition table guard ──
(mod-esc-test!
"open → triaged allowed"
(mod/lc-can-transition? "open" "triaged")
true)
(mod-esc-test!
"triaged → decided allowed"
(mod/lc-can-transition? "triaged" "decided")
true)
(mod-esc-test!
"decided → appealed allowed"
(mod/lc-can-transition? "decided" "appealed")
true)
(mod-esc-test!
"appealed → final allowed"
(mod/lc-can-transition? "appealed" "final")
true)
(mod-esc-test!
"open → decided rejected"
(mod/lc-can-transition? "open" "decided")
false)
(mod-esc-test!
"triaged → final rejected"
(mod/lc-can-transition? "triaged" "final")
false)
(mod-esc-test!
"final is terminal"
(mod/lc-can-transition? "final" "open")
false)
;; ── initial state ──
(define
mod-esc-c0
(mod/mk-case (mod/mk-report "r1" "alice" "bob" "this is spam")))
(mod-esc-test! "new case is open" (mod/case-state mod-esc-c0) "open")
(mod-esc-test! "new case has no decision" (mod/case-decision mod-esc-c0) nil)
;; ── auto-tier: spam triages + resolves to decided/hide ──
(define
mod-esc-spam-rep
(list (mod/mk-report "r1" "alice" "bob" "this is spam")))
(define
mod-esc-t1
(mod/case-triage mod-esc-c0 mod-esc-spam-rep mod/default-rules))
(mod-esc-test! "spam triaged" (mod/case-state mod-esc-t1) "triaged")
(mod-esc-test! "spam triage tier auto" (mod/case-tier mod-esc-t1) "auto")
(mod-esc-test! "spam triage action hide" (mod/case-action mod-esc-t1) "hide")
(define mod-esc-r1 (mod/case-resolve mod-esc-t1))
(mod-esc-test!
"auto resolve → decided"
(mod/case-state mod-esc-r1)
"decided")
(mod-esc-test!
"decision preserved through resolve"
(mod/case-action mod-esc-r1)
"hide")
;; ── illegal transition flags :error, leaves state ──
(define mod-esc-bad (mod/case-finalize mod-esc-c0))
(mod-esc-test!
"finalize from open is illegal"
(mod/case-state mod-esc-bad)
"open")
(mod-esc-test!
"illegal transition sets error"
(nil? (mod/case-error mod-esc-bad))
false)
;; ── human-tier: repeated report escalates, resolve blocked, review decides ──
(define mod-esc-rep-r (mod/mk-report "r3" "ann" "dave" "off-topic"))
(define mod-esc-rep-reports (list mod-esc-rep-r mod-esc-rep-r mod-esc-rep-r))
(define mod-esc-rep-c0 (mod/mk-case mod-esc-rep-r))
(define
mod-esc-rep-t
(mod/case-triage mod-esc-rep-c0 mod-esc-rep-reports mod/default-rules))
(mod-esc-test!
"repeated triage action escalate"
(mod/case-action mod-esc-rep-t)
"escalate")
(mod-esc-test!
"repeated triage tier human"
(mod/case-tier mod-esc-rep-t)
"human")
(mod-esc-test!
"repeated still triaged after triage"
(mod/case-state mod-esc-rep-t)
"triaged")
(define mod-esc-rep-block (mod/case-resolve mod-esc-rep-t))
(mod-esc-test!
"auto-resolve blocked on human tier (state unchanged)"
(mod/case-state mod-esc-rep-block)
"triaged")
(mod-esc-test!
"blocked resolve sets error"
(nil? (mod/case-error mod-esc-rep-block))
false)
(define
mod-esc-rep-rev
(mod/case-review
mod-esc-rep-t
"confirmed-abuse"
"human"
mod-esc-rep-reports
mod/default-rules))
(mod-esc-test!
"human review → decided"
(mod/case-state mod-esc-rep-rev)
"decided")
(mod-esc-test!
"human review action remove"
(mod/case-action mod-esc-rep-rev)
"remove")
(mod-esc-test!
"review attached evidence to report"
(len (mod/report-evidence (mod/case-report mod-esc-rep-rev)))
1)
(define mod-esc-rep-final (mod/case-finalize mod-esc-rep-rev))
(mod-esc-test!
"review case finalizes"
(mod/case-state mod-esc-rep-final)
"final")
;; ── appeal overrides a prior decision ──
(define
mod-esc-ap-c0
(mod/mk-case (mod/mk-report "r5" "u" "v" "buy now spam")))
(define mod-esc-ap-rep (list (mod/mk-report "r5" "u" "v" "buy now spam")))
(define
mod-esc-ap-t
(mod/case-triage mod-esc-ap-c0 mod-esc-ap-rep mod/default-rules))
(define mod-esc-ap-d (mod/case-resolve mod-esc-ap-t))
(mod-esc-test!
"appeal precondition decided/hide"
(mod/case-action mod-esc-ap-d)
"hide")
(define
mod-esc-ap-appealed
(mod/case-appeal
mod-esc-ap-d
"exonerated"
"moderator"
mod-esc-ap-rep
mod/default-rules))
(mod-esc-test!
"appeal → appealed state"
(mod/case-state mod-esc-ap-appealed)
"appealed")
(mod-esc-test!
"appeal overrides hide → keep"
(mod/case-action mod-esc-ap-appealed)
"keep")
(mod-esc-test!
"appeal recorded via exonerated-keep rule"
(get (mod/case-decision mod-esc-ap-appealed) :rule)
"exonerated-keep")
(define mod-esc-ap-final (mod/case-finalize mod-esc-ap-appealed))
(mod-esc-test! "appealed → final" (mod/case-state mod-esc-ap-final) "final")
;; ── history records the full traversal ──
(mod-esc-test!
"full lifecycle history length 4 (triage,resolve,appeal,finalize)"
(len (mod/case-history mod-esc-ap-final))
4)
(mod-esc-test!
"first history step open→triaged"
(get (first (mod/case-history mod-esc-ap-final)) :to)
"triaged")
(mod-esc-test!
"last history step → final"
(get (nth (mod/case-history mod-esc-ap-final) 3) :to)
"final")
;; ── api-level lifecycle façade ──
(mod/reset!)
(mod/report "alice" "bob" "this is spam")
(mod/report "carol" "dave" "off-topic")
(mod/report "carol" "dave" "off-topic")
(mod/report "carol" "dave" "off-topic")
(mod-esc-test!
"api: case opens at open"
(mod/case-state (mod/case-of "r1"))
"open")
(define mod-esc-api-t1 (mod/triage "r1"))
(mod-esc-test!
"api: triage spam → triaged"
(mod/case-state mod-esc-api-t1)
"triaged")
(mod-esc-test!
"api: triage spam action hide"
(mod/case-action mod-esc-api-t1)
"hide")
(define mod-esc-api-r1 (mod/resolve "r1"))
(mod-esc-test!
"api: resolve → decided"
(mod/case-state mod-esc-api-r1)
"decided")
(mod-esc-test!
"api: resolve logged decision"
(len (mod/audit "r1"))
1)
(define mod-esc-api-app (mod/appeal "r1" "exonerated" "mod"))
(mod-esc-test!
"api: appeal → appealed"
(mod/case-state mod-esc-api-app)
"appealed")
(mod-esc-test!
"api: appeal overrides → keep"
(mod/case-action mod-esc-api-app)
"keep")
(mod-esc-test!
"api: appeal logged second decision"
(len (mod/audit "r1"))
2)
(mod-esc-test!
"api: finalize → final"
(mod/case-state (mod/finalize "r1"))
"final")
;; r4 is the 3rd report about dave → escalates via the human tier
(define mod-esc-api-t4 (mod/triage "r4"))
(mod-esc-test!
"api: repeated triage escalates (human tier)"
(mod/case-tier mod-esc-api-t4)
"human")
(define mod-esc-api-blk (mod/resolve "r4"))
(mod-esc-test!
"api: escalated resolve blocked"
(mod/case-state mod-esc-api-blk)
"triaged")
(define mod-esc-api-rev (mod/review "r4" "confirmed-abuse" "human"))
(mod-esc-test!
"api: review → decided/remove"
(mod/case-action mod-esc-api-rev)
"remove")
(mod-esc-test! "api: unknown id → nil" (mod/triage "r99") nil)
(define mod-escalation-tests-run! (fn () {:failures mod-esc-failures :total mod-esc-count :passed mod-esc-pass :failed mod-esc-fail}))

313
lib/mod/tests/extensions.sx Normal file
View File

@@ -0,0 +1,313 @@
;; lib/mod/tests/extensions.sx — beyond-roadmap extensions.
;;
;; Ext 1: negation-as-failure conditions (:not / :attr) + report attributes.
;; "hide spam UNLESS the author is verified" (closed-world reasoning).
;; Ext 2: weighted/aggregate evidence scoring (:score-at-least) + report signals.
;; Many low-confidence signals accumulate past a threshold via Prolog
;; aggregate_all(sum(W), ...).
;; Ext 3: human-readable proof explanation (mod/explain) over the proof tree.
;; Demonstrated with custom rule sets so the default policy (and its conformance
;; tests) stays untouched.
(define mod-ext-count 0)
(define mod-ext-pass 0)
(define mod-ext-fail 0)
(define mod-ext-failures (list))
(define
mod-ext-test!
(fn
(name got expected)
(begin
(set! mod-ext-count (+ mod-ext-count 1))
(if
(= got expected)
(set! mod-ext-pass (+ mod-ext-pass 1))
(begin
(set! mod-ext-fail (+ mod-ext-fail 1))
(append!
mod-ext-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; ── Ext 1: report attributes ──
(define mod-ext-r0 (mod/mk-report "r1" "a" "b" "this is spam"))
(mod-ext-test!
"fresh report has no attrs"
(len (mod/report-attrs mod-ext-r0))
0)
(define mod-ext-rv (mod/attach-attr mod-ext-r0 "verified"))
(mod-ext-test!
"attach-attr adds one attr"
(len (mod/report-attrs mod-ext-rv))
1)
(mod-ext-test!
"attach-attr preserves evidence field"
(len
(mod/report-evidence
(mod/attach-evidence mod-ext-rv (mod/mk-evidence "x" "y"))))
1)
(mod-ext-test!
"attach-evidence preserves attrs"
(len
(mod/report-attrs
(mod/attach-evidence mod-ext-rv (mod/mk-evidence "x" "y"))))
1)
;; ── Ext 1: negation-as-failure: spam hidden unless author verified ──
(define
mod-ext-rules
(list
(mod/mk-rule
"spam-unverified-hide"
:hide (list
(list :classification "spam")
(list :not (list :attr "verified"))))
(mod/mk-rule "default-keep" :keep (list))))
(define mod-ext-spam-plain (mod/mk-report "p1" "a" "b" "this is spam"))
(define
mod-ext-spam-verified
(mod/attach-attr (mod/mk-report "p2" "a" "b" "this is spam") "verified"))
(define mod-ext-clean (mod/mk-report "p3" "a" "b" "a fine post"))
(mod-ext-test!
"unverified spam → hide"
(get
(mod/decide-report
mod-ext-spam-plain
(list mod-ext-spam-plain)
mod-ext-rules)
:action)
"hide")
(mod-ext-test!
"verified author spam → keep (negation blocks)"
(get
(mod/decide-report
mod-ext-spam-verified
(list mod-ext-spam-verified)
mod-ext-rules)
:action)
"keep")
(mod-ext-test!
"clean post → keep"
(get
(mod/decide-report mod-ext-clean (list mod-ext-clean) mod-ext-rules)
:action)
"keep")
;; ── Ext 1: negation appears in the goal text + proof ──
(define
mod-ext-dec
(mod/decide-report
mod-ext-spam-plain
(list mod-ext-spam-plain)
mod-ext-rules))
(define mod-ext-goals (get (get mod-ext-dec :proof) :goals))
(mod-ext-test!
"rule that matched is spam-unverified-hide"
(get mod-ext-dec :rule)
"spam-unverified-hide")
(mod-ext-test! "proof has two goals" (len mod-ext-goals) 2)
(mod-ext-test!
"negation goal text"
(get (nth mod-ext-goals 1) :goal)
"not(attr(p1, verified))")
(mod-ext-test!
"negation goal solved for unverified"
(get (nth mod-ext-goals 1) :solved)
true)
;; ── Ext 1: cond->goal compiles :attr and :not directly ──
(mod-ext-test!
"cond->goal :attr"
(mod/cond->goal (list :attr "verified") "Id")
"attr(Id, verified)")
(mod-ext-test!
"cond->goal :not wraps inner"
(mod/cond->goal (list :not (list :classification "spam")) "Id")
"not(classification(Id, spam))")
;; ── Ext 1: positive :attr condition (allowlist-style) ──
(define
mod-ext-allow-rules
(list
(mod/mk-rule "trusted-keep" :keep (list (list :attr "trusted")))
(mod/mk-rule "spam-hide" :hide (list (list :classification "spam")))
(mod/mk-rule "default-keep" :keep (list))))
(define
mod-ext-trusted-spam
(mod/attach-attr (mod/mk-report "t1" "a" "b" "this is spam") "trusted"))
(mod-ext-test!
"trusted attr exempts spam → keep"
(get
(mod/decide-report
mod-ext-trusted-spam
(list mod-ext-trusted-spam)
mod-ext-allow-rules)
:action)
"keep")
;; ── Ext 2: weighted signals + aggregate scoring ──
(define mod-ext-s0 (mod/mk-report "s1" "a" "b" "neutral"))
(mod-ext-test!
"fresh report has no signals"
(len (mod/report-signals mod-ext-s0))
0)
(define
mod-ext-s1
(mod/attach-signal mod-ext-s0 (mod/mk-signal "link" 2)))
(mod-ext-test!
"attach-signal adds one"
(len (mod/report-signals mod-ext-s1))
1)
(mod-ext-test!
"attach-signal preserves attrs"
(len
(mod/report-attrs
(mod/attach-signal mod-ext-rv (mod/mk-signal "x" 1))))
1)
(define
mod-ext-score-rules
(list
(mod/mk-rule
"high-score-hide"
:hide (list (list :score-at-least 5)))
(mod/mk-rule "default-keep" :keep (list))))
;; one weak signal (2) — below threshold
(define
mod-ext-weak
(mod/attach-signal
(mod/mk-report "w1" "a" "b" "neutral")
(mod/mk-signal "link" 2)))
(mod-ext-test!
"single weak signal → keep (below threshold)"
(get
(mod/decide-report mod-ext-weak (list mod-ext-weak) mod-ext-score-rules)
:action)
"keep")
;; three signals summing to 6 — over threshold
(define
mod-ext-strong0
(mod/attach-signal
(mod/mk-report "w2" "a" "b" "neutral")
(mod/mk-signal "link" 2)))
(define
mod-ext-strong1
(mod/attach-signal mod-ext-strong0 (mod/mk-signal "newaccount" 2)))
(define
mod-ext-strong
(mod/attach-signal mod-ext-strong1 (mod/mk-signal "burst" 2)))
(mod-ext-test!
"accumulated signals (2+2+2=6) → hide"
(get
(mod/decide-report
mod-ext-strong
(list mod-ext-strong)
mod-ext-score-rules)
:action)
"hide")
(mod-ext-test!
"scoring rule named in decision"
(get
(mod/decide-report
mod-ext-strong
(list mod-ext-strong)
mod-ext-score-rules)
:rule)
"high-score-hide")
;; exactly at threshold (5) fires
(define
mod-ext-exact0
(mod/attach-signal
(mod/mk-report "w3" "a" "b" "neutral")
(mod/mk-signal "link" 3)))
(define
mod-ext-exact
(mod/attach-signal mod-ext-exact0 (mod/mk-signal "burst" 2)))
(mod-ext-test!
"exactly at threshold (5) → hide"
(get
(mod/decide-report mod-ext-exact (list mod-ext-exact) mod-ext-score-rules)
:action)
"hide")
(mod-ext-test!
"cond->goal :score-at-least"
(mod/cond->goal (list :score-at-least 5) "Id")
"aggregate_all(sum(W), signal(Id, _, W), T), T >= 5")
;; ── Ext 3: human-readable proof explanation ──
(define mod-ext-spam-explain (mod/explain mod-ext-dec))
(mod-ext-test!
"explain mentions the report id"
(mod/str-contains? mod-ext-spam-explain "Report p1")
true)
(mod-ext-test!
"explain mentions the action"
(mod/str-contains? mod-ext-spam-explain "hide")
true)
(mod-ext-test!
"explain mentions the rule"
(mod/str-contains? mod-ext-spam-explain "spam-unverified-hide")
true)
(mod-ext-test!
"explain marks proved goals"
(mod/str-contains? mod-ext-spam-explain "[proved]")
true)
(mod-ext-test!
"explain renders the evidence line"
(mod/str-contains? mod-ext-spam-explain "Evidence: spam")
true)
;; count-rule explanation shows the unification bindings
(define mod-ext-rep-r (mod/mk-report "rc" "ann" "dave" "off-topic"))
(define
mod-ext-rep-d
(mod/decide-report
mod-ext-rep-r
(list mod-ext-rep-r mod-ext-rep-r mod-ext-rep-r)
mod/default-rules))
(define mod-ext-rep-explain (mod/explain mod-ext-rep-d))
(mod-ext-test!
"explain shows binding N=3"
(mod/str-contains? mod-ext-rep-explain "N=3")
true)
(mod-ext-test!
"explain shows subject binding"
(mod/str-contains? mod-ext-rep-explain "dave")
true)
;; explain-goal direct: unproved goal gets [unproved]
(mod-ext-test!
"explain-goal marks unproved"
(mod/str-contains? (mod/explain-goal {:solved false :goal "attr(x, foo)" :bindings {}}) "[unproved]")
true)
;; explain-binds renders key=value pairs
(mod-ext-test!
"explain-binds renders pair"
(mod/explain-binds {:N "3"})
"N=3")
;; no-evidence decision says (none)
(define
mod-ext-keep-d
(mod/decide-report mod-ext-clean (list mod-ext-clean) mod-ext-rules))
(mod-ext-test!
"explain (none) for empty evidence"
(mod/str-contains? (mod/explain mod-ext-keep-d) "Evidence: (none)")
true)
(define mod-extensions-tests-run! (fn () {:failures mod-ext-failures :total mod-ext-count :passed mod-ext-pass :failed mod-ext-fail}))

154
lib/mod/tests/fed.sx Normal file
View File

@@ -0,0 +1,154 @@
;; lib/mod/tests/fed.sx — Phase 4: federation (mock fed-sx).
(define mod-fed-count 0)
(define mod-fed-pass 0)
(define mod-fed-fail 0)
(define mod-fed-failures (list))
(define
mod-fed-test!
(fn
(name got expected)
(begin
(set! mod-fed-count (+ mod-fed-count 1))
(if
(= got expected)
(set! mod-fed-pass (+ mod-fed-pass 1))
(begin
(set! mod-fed-fail (+ mod-fed-fail 1))
(append!
mod-fed-failures
(str name "\n expected: " expected "\n got: " got)))))))
(mod/reset!)
(mod/fed-reset!)
;; ── trust model (advisory by default) ──
(mod-fed-test! "trust initially false" (mod/trusted? "peerA" :mod) false)
(mod/grant-trust "peerA" :mod)
(mod-fed-test! "trust after grant" (mod/trusted? "peerA" :mod) true)
(mod-fed-test! "trust wrong scope" (mod/trusted? "peerA" :other) false)
(mod-fed-test! "trust other peer" (mod/trusted? "peerB" :mod) false)
(mod/revoke-trust "peerA" :mod)
(mod-fed-test! "trust after revoke" (mod/trusted? "peerA" :mod) false)
;; ── cross-instance reports ──
(define
mod-fed-fr
(mod/fed-receive-report "peerB" "alice" "bob" "this is spam"))
(mod-fed-test! "fed report assigned id r1" (mod/report-id mod-fed-fr) "r1")
(mod-fed-test! "fed report origin is peer" (mod/report-origin "r1") "peerB")
(define mod-fed-local (mod/report "carol" "dave" "fine post"))
(mod-fed-test!
"local report origin is local"
(mod/report-origin (mod/report-id mod-fed-local))
"local")
(mod-fed-test!
"engine decides fed report (spam → hide)"
(get
(mod/decide-report mod-fed-fr (list mod-fed-fr) mod/default-rules)
:action)
"hide")
;; ── decision sharing (outbox) ──
(define mod-fed-dec {:action "hide" :rule "spam-hide" :report-id "r1"})
(define
mod-fed-shared
(mod/fed-share-decision mod-fed-dec (list "peerB" "peerC")))
(mod-fed-test! "share returns notified peers" (len mod-fed-shared) 2)
(mod-fed-test! "outbox has two messages" (len (mod/fed-outbox)) 2)
(mod-fed-test!
"outbox message type decision"
(get (first (mod/fed-outbox)) :type)
"decision")
(mod-fed-test!
"outbox message addressed to peer"
(get (first (mod/fed-outbox)) :to)
"peerB")
;; ── receiving a peer decision: advisory unless trusted ──
(define mod-fed-untrusted (mod/fed-receive-decision "peerZ" {:action "remove" :rule "reviewer-remove" :report-id "rx"}))
(mod-fed-test!
"untrusted decision not applied"
(get mod-fed-untrusted :applied)
false)
(mod-fed-test!
"untrusted decision advisory"
(get mod-fed-untrusted :advisory)
true)
(mod-fed-test!
"untrusted decision absent from applied log"
(mod/fed-applied-action "rx")
nil)
(mod-fed-test!
"advisory log records suggestion"
(len mod/*fed-advisory*)
1)
(mod/grant-trust "peerT" :mod)
(define mod-fed-trusted (mod/fed-receive-decision "peerT" {:action "hide" :rule "spam-hide" :report-id "ry"}))
(mod-fed-test! "trusted decision applied" (get mod-fed-trusted :applied) true)
(mod-fed-test!
"trusted decision binds locally"
(get (mod/fed-applied-action "ry") :action)
"hide")
;; ── revocation ──
(mod-fed-test!
"applied action not yet revoked"
(get (mod/fed-applied-action "ry") :revoked)
false)
(mod/fed-revoke! "ry" "manual")
(mod-fed-test!
"revoke marks applied action revoked"
(get (mod/fed-applied-action "ry") :revoked)
true)
(mod-fed-test!
"revoke emits a revocation message"
(mod/any? (fn (m) (= (get m :type) "revocation")) (mod/fed-outbox))
true)
;; revoke-if-invalidated: proof still holds → no revocation
(define mod-fed-spam-r (mod/mk-report "rs" "a" "b" "this is spam"))
(define
mod-fed-spam-d
(mod/decide-report mod-fed-spam-r (list mod-fed-spam-r) mod/default-rules))
(mod-fed-test! "spam decision is hide" (get mod-fed-spam-d :action) "hide")
(define
mod-fed-rev-same
(mod/fed-revoke-if-invalidated
mod-fed-spam-r
mod-fed-spam-d
(list mod-fed-spam-r)
mod/default-rules))
(mod-fed-test!
"valid proof → not revoked"
(get mod-fed-rev-same :revoked)
false)
;; exoneration invalidates the proof → revocation
(define
mod-fed-exon-r
(mod/attach-evidence mod-fed-spam-r (mod/mk-evidence "exonerated" "mod")))
(define
mod-fed-rev-inv
(mod/fed-revoke-if-invalidated
mod-fed-exon-r
mod-fed-spam-d
(list mod-fed-exon-r)
mod/default-rules))
(mod-fed-test!
"invalidated proof → revoked"
(get mod-fed-rev-inv :revoked)
true)
(mod-fed-test!
"re-decision after exoneration is keep"
(get (get mod-fed-rev-inv :decision) :action)
"keep")
(define mod-fed-tests-run! (fn () {:failures mod-fed-failures :total mod-fed-count :passed mod-fed-pass :failed mod-fed-fail}))

86
lib/mod/tests/link.sx Normal file
View File

@@ -0,0 +1,86 @@
;; lib/mod/tests/link.sx — Ext 4: report linking + dedup.
(define mod-lnk-count 0)
(define mod-lnk-pass 0)
(define mod-lnk-fail 0)
(define mod-lnk-failures (list))
(define
mod-lnk-test!
(fn
(name got expected)
(begin
(set! mod-lnk-count (+ mod-lnk-count 1))
(if
(= got expected)
(set! mod-lnk-pass (+ mod-lnk-pass 1))
(begin
(set! mod-lnk-fail (+ mod-lnk-fail 1))
(append!
mod-lnk-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; ── link-key + dedup ──
(define mod-lnk-a (mod/mk-report "r1" "alice" "bob" "this is spam"))
(define mod-lnk-a2 (mod/mk-report "r2" "alice" "bob" "THIS IS SPAM"))
(define mod-lnk-b (mod/mk-report "r3" "carol" "bob" "abuse"))
(define mod-lnk-c (mod/mk-report "r4" "alice" "eve" "this is spam"))
(mod-lnk-test!
"identical reports share a link key (case-insensitive reason)"
(= (mod/link-key mod-lnk-a) (mod/link-key mod-lnk-a2))
true)
(mod-lnk-test!
"different reporter → different key"
(= (mod/link-key mod-lnk-a) (mod/link-key mod-lnk-b))
false)
(mod-lnk-test!
"different subject → different key"
(= (mod/link-key mod-lnk-a) (mod/link-key mod-lnk-c))
false)
(define mod-lnk-set (list mod-lnk-a mod-lnk-a2 mod-lnk-b mod-lnk-c))
(mod-lnk-test!
"dedup collapses identical reports"
(len (mod/dedup-reports mod-lnk-set))
3)
(mod-lnk-test!
"duplicate-count counts collapsed"
(mod/duplicate-count mod-lnk-set)
1)
(mod-lnk-test!
"dedup of all-distinct keeps all"
(len (mod/dedup-reports (list mod-lnk-a mod-lnk-b mod-lnk-c)))
3)
;; ── Prolog-backed relational linking ──
(mod-lnk-test!
"related-ids finds all reports about subject"
(len (mod/related-ids "bob" mod-lnk-set))
3)
(mod-lnk-test!
"related-ids returns the ids"
(mod/related-ids "eve" mod-lnk-set)
(list "r4"))
(mod-lnk-test!
"related-ids empty for unknown subject"
(mod/related-ids "nobody" mod-lnk-set)
(list))
;; reporters: bob reported by alice (x2) + carol → 3 raw, 2 distinct
(mod-lnk-test!
"reporters-of counts all reports"
(len (mod/reporters-of "bob" mod-lnk-set))
3)
(mod-lnk-test!
"distinct reporters-of dedups reporters"
(len (mod/distinct-reporters-of "bob" mod-lnk-set))
2)
(mod-lnk-test!
"distinct utility removes dups"
(mod/distinct (list "a" "b" "a" "c" "b"))
(list "a" "b" "c"))
(define mod-link-tests-run! (fn () {:failures mod-lnk-failures :total mod-lnk-count :passed mod-lnk-pass :failed mod-lnk-fail}))

122
lib/mod/tests/lint.sx Normal file
View File

@@ -0,0 +1,122 @@
;; lib/mod/tests/lint.sx — Ext 5: policy rule-set static analysis.
(define mod-lint-count 0)
(define mod-lint-pass 0)
(define mod-lint-fail 0)
(define mod-lint-failures (list))
(define
mod-lint-test!
(fn
(name got expected)
(begin
(set! mod-lint-count (+ mod-lint-count 1))
(if
(= got expected)
(set! mod-lint-pass (+ mod-lint-pass 1))
(begin
(set! mod-lint-fail (+ mod-lint-fail 1))
(append!
mod-lint-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; ── the default rule set is well-formed ──
(mod-lint-test!
"default rules: no unreachable"
(mod/unreachable-rules mod/default-rules)
(list))
(mod-lint-test!
"default rules: has catch-all"
(mod/has-catchall? mod/default-rules)
true)
(mod-lint-test!
"default rules: no duplicate names"
(mod/duplicate-rule-names mod/default-rules)
(list))
(mod-lint-test!
"default rules: well-formed"
(mod/rules-ok? mod/default-rules)
true)
;; ── unreachable detection ──
(define
mod-lint-shadowed
(list
(mod/mk-rule "spam-hide" :hide (list (list :classification "spam")))
(mod/mk-rule "catch-all" :keep (list))
(mod/mk-rule
"abuse-remove"
:remove (list (list :classification "abuse")))
(mod/mk-rule
"repeated"
:escalate (list (list :count-at-least 3)))))
(mod-lint-test!
"rules after catch-all are unreachable"
(mod/unreachable-rules mod-lint-shadowed)
(list "abuse-remove" "repeated"))
(mod-lint-test!
"shadowed rule set is not ok"
(mod/rules-ok? mod-lint-shadowed)
false)
;; ── missing catch-all ──
(define
mod-lint-nocatch
(list
(mod/mk-rule "spam-hide" :hide (list (list :classification "spam")))
(mod/mk-rule
"abuse-remove"
:remove (list (list :classification "abuse")))))
(mod-lint-test!
"no catch-all detected"
(mod/has-catchall? mod-lint-nocatch)
false)
(mod-lint-test!
"no unreachable when no catch-all"
(mod/unreachable-rules mod-lint-nocatch)
(list))
(mod-lint-test!
"no-catch-all rule set is not ok"
(mod/rules-ok? mod-lint-nocatch)
false)
;; ── duplicate names ──
(define
mod-lint-dups
(list
(mod/mk-rule "x" :hide (list (list :classification "spam")))
(mod/mk-rule "x" :remove (list (list :classification "abuse")))
(mod/mk-rule "default" :keep (list))))
(mod-lint-test!
"duplicate names detected"
(mod/duplicate-rule-names mod-lint-dups)
(list "x"))
(mod-lint-test!
"duplicate-name rule set is not ok"
(mod/rules-ok? mod-lint-dups)
false)
;; ── helpers ──
(mod-lint-test!
"rule-unconditional? true for empty when"
(mod/rule-unconditional? (mod/mk-rule "d" :keep (list)))
true)
(mod-lint-test!
"rule-unconditional? false with conditions"
(mod/rule-unconditional?
(mod/mk-rule "s" :hide (list (list :classification "spam"))))
false)
(mod-lint-test!
"count-eq counts occurrences"
(mod/count-eq "a" (list "a" "b" "a"))
2)
(define mod-lint-tests-run! (fn () {:failures mod-lint-failures :total mod-lint-count :passed mod-lint-pass :failed mod-lint-fail}))

115
lib/mod/tests/offenders.sx Normal file
View File

@@ -0,0 +1,115 @@
;; lib/mod/tests/offenders.sx — Ext 7: repeat-offender escalation.
(define mod-off-count 0)
(define mod-off-pass 0)
(define mod-off-fail 0)
(define mod-off-failures (list))
(define
mod-off-test!
(fn
(name got expected)
(begin
(set! mod-off-count (+ mod-off-count 1))
(if
(= got expected)
(set! mod-off-pass (+ mod-off-pass 1))
(begin
(set! mod-off-fail (+ mod-off-fail 1))
(append!
mod-off-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; ── sanction? predicate ──
(mod-off-test! "hide is a sanction" (mod/sanction? "hide") true)
(mod-off-test! "remove is a sanction" (mod/sanction? "remove") true)
(mod-off-test! "ban is a sanction" (mod/sanction? "ban") true)
(mod-off-test! "keep is not a sanction" (mod/sanction? "keep") false)
(mod-off-test! "escalate is not a sanction" (mod/sanction? "escalate") false)
;; ── repeat-offender escalation over the audit log ──
(mod/reset!)
(mod/report "u1" "spammer" "this is spam")
(mod/report "u2" "spammer" "buy now offer")
(mod/report "u3" "spammer" "click here free money")
(mod/report "u4" "innocent" "fine post")
(mod-off-test!
"no sanctions before any decision"
(mod/subject-sanctions "spammer")
0)
(define mod-off-d1 (mod/decide-escalating "r1" 2))
(mod-off-test!
"first spam → hide (0 priors)"
(get mod-off-d1 :action)
"hide")
(mod-off-test!
"one sanction recorded"
(mod/subject-sanctions "spammer")
1)
(define mod-off-d2 (mod/decide-escalating "r2" 2))
(mod-off-test!
"second spam → hide (1 prior, below k=2)"
(get mod-off-d2 :action)
"hide")
(mod-off-test!
"two sanctions recorded"
(mod/subject-sanctions "spammer")
2)
(define mod-off-d3 (mod/decide-escalating "r3" 2))
(mod-off-test!
"third spam → ban (2 priors ≥ k)"
(get mod-off-d3 :action)
"ban")
(mod-off-test!
"ban decision names repeat-offender rule"
(get mod-off-d3 :rule)
"repeat-offender-ban")
(mod-off-test!
"ban proof records prior sanction count"
(get (get mod-off-d3 :proof) :prior-sanctions)
2)
;; ── different subjects accumulate independently ──
(define mod-off-d4 (mod/decide-escalating "r4" 2))
(mod-off-test!
"innocent keep → not escalated"
(get mod-off-d4 :action)
"keep")
(mod-off-test!
"innocent has no sanctions"
(mod/subject-sanctions "innocent")
0)
(mod-off-test!
"repeat-offender? true for spammer at k=2"
(mod/repeat-offender? "spammer" 2)
true)
(mod-off-test!
"repeat-offender? false for innocent at k=1"
(mod/repeat-offender? "innocent" 1)
false)
;; ── non-sanction decisions are never upgraded to ban ──
;; r5 is a clean post, but it is the 4th report about "spammer", so the
;; repeated-report rule escalates it. escalate is not a sanction, so it passes
;; through decide-escalating unchanged (never becomes :ban).
(mod/report "u5" "spammer" "a perfectly fine post")
(define mod-off-d5 (mod/decide-escalating "r5" 1))
(mod-off-test!
"non-sanction (escalate) decision is not upgraded to ban"
(get mod-off-d5 :action)
"escalate")
(mod-off-test!
"decide-escalating unknown id → nil"
(mod/decide-escalating "r99" 2)
nil)
(define mod-offenders-tests-run! (fn () {:failures mod-off-failures :total mod-off-count :passed mod-off-pass :failed mod-off-fail}))

112
lib/mod/tests/pipeline.sx Normal file
View File

@@ -0,0 +1,112 @@
;; lib/mod/tests/pipeline.sx — Ext 19: end-to-end triage orchestration.
(define mod-pp-count 0)
(define mod-pp-pass 0)
(define mod-pp-fail 0)
(define mod-pp-failures (list))
(define
mod-pp-test!
(fn
(name got expected)
(begin
(set! mod-pp-count (+ mod-pp-count 1))
(if
(= got expected)
(set! mod-pp-pass (+ mod-pp-pass 1))
(begin
(set! mod-pp-fail (+ mod-pp-fail 1))
(append!
mod-pp-failures
(str name "\n expected: " expected "\n got: " got)))))))
(mod/policies-reset!)
(mod/register-policy!
"market"
(mod/ruleset
(mod/defrule "market-spam-remove" :remove (list :classification "spam"))
(mod/defrule "default-keep" :keep)))
;; ── spam in the market domain: full bundle ──
(define mod-pp-spam (mod/mk-report "r1" "u" "bob" "this is spam"))
(define
mod-pp
(mod/triage-pipeline "market" mod-pp-spam (list mod-pp-spam) "inst.example"))
(mod-pp-test!
"pipeline action (market policy → remove)"
(mod/pipeline-action mod-pp)
"remove")
(mod-pp-test! "pipeline rule" (get mod-pp :rule) "market-spam-remove")
(mod-pp-test!
"pipeline explanation mentions the action"
(mod/str-contains? (get mod-pp :explanation) "remove")
true)
(mod-pp-test!
"pipeline activity is Delete (remove)"
(get (mod/pipeline-activity mod-pp) :type)
"Delete")
(mod-pp-test!
"pipeline activity object is the report"
(get (mod/pipeline-activity mod-pp) :object)
"r1")
(mod-pp-test!
"pipeline wire round-trips to the same action"
(get (mod/wire->decision (mod/pipeline-wire mod-pp)) :action)
"remove")
;; ── same report, blog domain (default) → hide, Flag ──
(define
mod-pp-blog
(mod/triage-pipeline "blog" mod-pp-spam (list mod-pp-spam) "inst.example"))
(mod-pp-test!
"blog default policy → hide"
(mod/pipeline-action mod-pp-blog)
"hide")
(mod-pp-test!
"blog activity is Flag"
(get (mod/pipeline-activity mod-pp-blog) :type)
"Flag")
;; ── clean report: keep, no activity, explanation says (none) ──
(define mod-pp-clean (mod/mk-report "r2" "u" "eve" "a fine post"))
(define
mod-pp-k
(mod/triage-pipeline
"market"
mod-pp-clean
(list mod-pp-clean)
"inst.example"))
(mod-pp-test! "clean → keep" (mod/pipeline-action mod-pp-k) "keep")
(mod-pp-test! "keep → no activity" (mod/pipeline-activity mod-pp-k) nil)
(mod-pp-test!
"keep explanation says no evidence"
(mod/str-contains? (get mod-pp-k :explanation) "Evidence: (none)")
true)
(mod-pp-test!
"keep wire still round-trips"
(get (mod/wire->decision (mod/pipeline-wire mod-pp-k)) :rule)
"default-keep")
;; ── federated handoff: market decision crosses to a peer, trust-gated ──
(mod/fed-reset!)
(define mod-pp-peer-dec (mod/wire->decision (mod/pipeline-wire mod-pp)))
(mod-pp-test!
"untrusted peer: market decision is advisory"
(get (mod/fed-receive-decision "peerX" mod-pp-peer-dec) :applied)
false)
(mod/grant-trust "peerY" :mod)
(mod-pp-test!
"trusted peer: market decision applies"
(get (mod/fed-receive-decision "peerY" mod-pp-peer-dec) :applied)
true)
(mod-pp-test!
"applied action is remove"
(get (mod/fed-applied-action "r1") :action)
"remove")
(define mod-pipeline-tests-run! (fn () {:failures mod-pp-failures :total mod-pp-count :passed mod-pp-pass :failed mod-pp-fail}))

112
lib/mod/tests/policies.sx Normal file
View 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}))

119
lib/mod/tests/quorum.sx Normal file
View File

@@ -0,0 +1,119 @@
;; lib/mod/tests/quorum.sx — Ext 8: quorum over distinct reporters.
(define mod-q-count 0)
(define mod-q-pass 0)
(define mod-q-fail 0)
(define mod-q-failures (list))
(define
mod-q-test!
(fn
(name got expected)
(begin
(set! mod-q-count (+ mod-q-count 1))
(if
(= got expected)
(set! mod-q-pass (+ mod-q-pass 1))
(begin
(set! mod-q-fail (+ mod-q-fail 1))
(append!
mod-q-failures
(str name "\n expected: " expected "\n got: " got)))))))
(define
mod-q-rules
(list
(mod/mk-rule
"quorum-hide"
:hide (list (list :reporters-at-least 2)))
(mod/mk-rule "default-keep" :keep (list))))
;; ── two distinct reporters meet quorum ──
(define
mod-q-two
(list
(mod/mk-report "r1" "alice" "bob" "off-topic")
(mod/mk-report "r2" "carol" "bob" "off-topic")))
(mod-q-test!
"two distinct reporters → hide"
(get (mod/decide-quorum (first mod-q-two) mod-q-two mod-q-rules) :action)
"hide")
(mod-q-test!
"quorum decision names the rule"
(get (mod/decide-quorum (first mod-q-two) mod-q-two mod-q-rules) :rule)
"quorum-hide")
(mod-q-test!
"quorum decision tagged strategy"
(get (mod/decide-quorum (first mod-q-two) mod-q-two mod-q-rules) :strategy)
"quorum")
;; ── single reporter does not meet quorum ──
(define mod-q-one (list (mod/mk-report "r1" "alice" "bob" "off-topic")))
(mod-q-test!
"one reporter → keep (below quorum)"
(get (mod/decide-quorum (first mod-q-one) mod-q-one mod-q-rules) :action)
"keep")
;; ── anti-brigade: one user filing many reports does NOT meet quorum ──
(define
mod-q-brigade
(list
(mod/mk-report "r1" "alice" "bob" "off-topic")
(mod/mk-report "r2" "alice" "bob" "off-topic")
(mod/mk-report "r3" "alice" "bob" "off-topic")))
(mod-q-test!
"three reports, one reporter → keep (quorum counts distinct)"
(get
(mod/decide-quorum (first mod-q-brigade) mod-q-brigade mod-q-rules)
:action)
"keep")
;; contrast: the count rule WOULD fire on the same brigade (3 reports ≥ 3) —
;; quorum is strictly stronger against single-actor brigading
(mod-q-test!
"count rule fires on the brigade (distinct from quorum)"
(get
(mod/decide-report (first mod-q-brigade) mod-q-brigade mod/default-rules)
:action)
"escalate")
;; ── three distinct reporters ──
(define
mod-q-three
(list
(mod/mk-report "r1" "alice" "bob" "off-topic")
(mod/mk-report "r2" "carol" "bob" "off-topic")
(mod/mk-report "r3" "dave" "bob" "off-topic")))
(mod-q-test!
"three distinct reporters → hide"
(get
(mod/decide-quorum (first mod-q-three) mod-q-three mod-q-rules)
:action)
"hide")
(mod-q-test!
"quorum proof goal solved"
(get
(first
(get
(get
(mod/decide-quorum (first mod-q-three) mod-q-three mod-q-rules)
:proof)
:goals))
:solved)
true)
;; ── cond->goal compiles :reporters-at-least ──
(mod-q-test!
"cond->goal :reporters-at-least"
(mod/cond->goal (list :reporters-at-least 2) "Id")
"report(Id, _, Sr), setof(Br, report(_, Br, Sr), Bsr), length(Bsr, Nr), Nr >= 2")
(define mod-quorum-tests-run! (fn () {:failures mod-q-failures :total mod-q-count :passed mod-q-pass :failed mod-q-fail}))

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}))

108
lib/mod/tests/sla.sx Normal file
View File

@@ -0,0 +1,108 @@
;; lib/mod/tests/sla.sx — Ext 13: SLA sweep over pending lifecycle cases.
(define mod-sla-count 0)
(define mod-sla-pass 0)
(define mod-sla-fail 0)
(define mod-sla-failures (list))
(define
mod-sla-test!
(fn
(name got expected)
(begin
(set! mod-sla-count (+ mod-sla-count 1))
(if
(= got expected)
(set! mod-sla-pass (+ mod-sla-pass 1))
(begin
(set! mod-sla-fail (+ mod-sla-fail 1))
(append!
mod-sla-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; ── pending-state? ──
(mod-sla-test! "open is pending" (mod/pending-state? "open") true)
(mod-sla-test! "triaged is pending" (mod/pending-state? "triaged") true)
(mod-sla-test! "appealed is pending" (mod/pending-state? "appealed") true)
(mod-sla-test! "decided is not pending" (mod/pending-state? "decided") false)
(mod-sla-test! "final is not pending" (mod/pending-state? "final") false)
;; build cases in known states
(define mod-sla-spam (mod/mk-report "r1" "u" "bob" "this is spam"))
(define mod-sla-spam-reports (list mod-sla-spam))
(define
mod-sla-triaged
(mod/case-triage
(mod/mk-case mod-sla-spam)
mod-sla-spam-reports
mod/default-rules))
(define mod-sla-decided (mod/case-resolve mod-sla-triaged))
(define mod-sla-open (mod/mk-case (mod/mk-report "r2" "u" "eve" "hello")))
;; ── overdue? ──
(define mod-sla-tc-old (mod/mk-timed-case mod-sla-triaged 0))
(define mod-sla-tc-fresh (mod/mk-timed-case mod-sla-triaged 90))
(define mod-sla-tc-done (mod/mk-timed-case mod-sla-decided 0))
(mod-sla-test!
"old triaged case is overdue"
(mod/overdue? mod-sla-tc-old 100 50)
true)
(mod-sla-test!
"fresh triaged case not overdue"
(mod/overdue? mod-sla-tc-fresh 100 50)
false)
(mod-sla-test!
"decided case never overdue"
(mod/overdue? mod-sla-tc-done 100 50)
false)
(mod-sla-test!
"age computes elapsed ticks"
(mod/age mod-sla-tc-old 100)
100)
(mod-sla-test!
"boundary: exactly at deadline not overdue"
(mod/overdue?
(mod/mk-timed-case mod-sla-triaged 50)
100
50)
false)
(mod-sla-test!
"boundary: one past deadline overdue"
(mod/overdue?
(mod/mk-timed-case mod-sla-triaged 49)
100
50)
true)
;; ── sweep over a mixed queue ──
(define
mod-sla-queue
(list
(mod/mk-timed-case mod-sla-triaged 0)
(mod/mk-timed-case mod-sla-decided 0)
(mod/mk-timed-case mod-sla-open 90))) ;; r2, pending, age 10 → not
(mod-sla-test!
"sweep finds only the overdue pending case"
(mod/sla-sweep mod-sla-queue 100 50)
(list "r1"))
(mod-sla-test!
"overdue-count agrees"
(mod/overdue-count mod-sla-queue 100 50)
1)
;; tighten deadline so the young open case also breaches
(mod-sla-test!
"tighter deadline catches the open case too"
(mod/overdue-count mod-sla-queue 100 5)
2)
(mod-sla-test!
"empty queue → no breaches"
(mod/sla-sweep (list) 100 50)
(list))
(define mod-sla-tests-run! (fn () {:failures mod-sla-failures :total mod-sla-count :passed mod-sla-pass :failed mod-sla-fail}))

156
lib/mod/tests/temporal.sx Normal file
View File

@@ -0,0 +1,156 @@
;; lib/mod/tests/temporal.sx — Ext 12: burst detection over a time window.
(define mod-tm-count 0)
(define mod-tm-pass 0)
(define mod-tm-fail 0)
(define mod-tm-failures (list))
(define
mod-tm-test!
(fn
(name got expected)
(begin
(set! mod-tm-count (+ mod-tm-count 1))
(if
(= got expected)
(set! mod-tm-pass (+ mod-tm-pass 1))
(begin
(set! mod-tm-fail (+ mod-tm-fail 1))
(append!
mod-tm-failures
(str name "\n expected: " expected "\n got: " got)))))))
(define
mod-tm-at
(fn (id about t) (mod/with-at (mod/mk-report id "u" about "off-topic") t)))
(define
mod-tm-rules
(list
(mod/mk-rule "burst-hide" :hide (list (list :burst-at-least 3)))
(mod/mk-rule "default-keep" :keep (list))))
;; ── window-count helper ──
(define
mod-tm-burst
(list
(mod-tm-at "r1" "bob" 10)
(mod-tm-at "r2" "bob" 11)
(mod-tm-at "r3" "bob" 12)))
(define
mod-tm-slow
(list
(mod-tm-at "r1" "bob" 1)
(mod-tm-at "r2" "bob" 2)
(mod-tm-at "r3" "bob" 12)))
(mod-tm-test!
"window-count: all 3 within window"
(mod/window-count "bob" mod-tm-burst 12 5)
3)
(mod-tm-test!
"window-count: only 1 within window"
(mod/window-count "bob" mod-tm-slow 12 5)
1)
(mod-tm-test!
"window-count: subject filter"
(mod/window-count "eve" mod-tm-burst 12 5)
0)
;; ── burst fires; slow accumulation does not ──
(mod-tm-test!
"burst (3 in window) → hide"
(get
(mod/decide-temporal
(first mod-tm-burst)
mod-tm-burst
mod-tm-rules
12
5)
:action)
"hide")
(mod-tm-test!
"slow accumulation (1 in window) → keep"
(get
(mod/decide-temporal
(first mod-tm-slow)
mod-tm-slow
mod-tm-rules
12
5)
:action)
"keep")
;; ── contrast: the plain count rule fires on BOTH (3 total reports) ──
(mod-tm-test!
"count rule fires on slow case (distinct from burst)"
(get
(mod/decide-report (first mod-tm-slow) mod-tm-slow mod/default-rules)
:action)
"escalate")
;; ── decision shape ──
(define
mod-tm-d
(mod/decide-temporal
(first mod-tm-burst)
mod-tm-burst
mod-tm-rules
12
5))
(mod-tm-test! "burst decision rule" (get mod-tm-d :rule) "burst-hide")
(mod-tm-test!
"burst decision tagged strategy"
(get mod-tm-d :strategy)
"temporal")
(mod-tm-test!
"burst recorded in proof"
(get (get mod-tm-d :proof) :burst)
3)
(mod-tm-test!
"burst proof goal solved"
(get (first (get (get mod-tm-d :proof) :goals)) :solved)
true)
;; ── window boundary is inclusive ──
(define
mod-tm-edge
(list
(mod-tm-at "r1" "bob" 7)
(mod-tm-at "r2" "bob" 8)
(mod-tm-at "r3" "bob" 9)))
(mod-tm-test!
"window boundary inclusive (now-window = at)"
(mod/window-count "bob" mod-tm-edge 12 5)
3)
;; ── schema :at round-trips and survives evidence attach ──
(mod-tm-test!
"report-at reads timestamp"
(mod/report-at (mod-tm-at "r1" "bob" 42))
42)
(mod-tm-test!
"default report-at is 0"
(mod/report-at (mod/mk-report "r1" "a" "b" "x"))
0)
(mod-tm-test!
"attach-evidence preserves :at"
(mod/report-at
(mod/attach-evidence
(mod-tm-at "r1" "bob" 42)
(mod/mk-evidence "k" "v")))
42)
;; ── cond->goal :burst-at-least ──
(mod-tm-test!
"cond->goal :burst-at-least"
(mod/cond->goal (list :burst-at-least 3) "Id")
"report(Id, _, Sb), burst_count(Sb, Nb), Nb >= 3")
(define mod-temporal-tests-run! (fn () {:failures mod-tm-failures :total mod-tm-count :passed mod-tm-pass :failed mod-tm-fail}))

116
lib/mod/tests/trace.sx Normal file
View File

@@ -0,0 +1,116 @@
;; lib/mod/tests/trace.sx — Ext 9: policy dry-run diagnostics.
(define mod-tr-count 0)
(define mod-tr-pass 0)
(define mod-tr-fail 0)
(define mod-tr-failures (list))
(define
mod-tr-test!
(fn
(name got expected)
(begin
(set! mod-tr-count (+ mod-tr-count 1))
(if
(= got expected)
(set! mod-tr-pass (+ mod-tr-pass 1))
(begin
(set! mod-tr-fail (+ mod-tr-fail 1))
(append!
mod-tr-failures
(str name "\n expected: " expected "\n got: " got)))))))
(define
mod-tr-find
(fn
(trace nm)
(reduce (fn (acc t) (if (= (get t :rule) nm) t acc)) nil trace)))
;; ── trace a spam report against the default rules ──
(define mod-tr-spam (mod/mk-report "r1" "alice" "bob" "this is spam"))
(define
mod-tr-t
(mod/trace-rules mod-tr-spam (list mod-tr-spam) mod/default-rules))
(mod-tr-test! "trace covers every rule" (len mod-tr-t) 6)
(mod-tr-test!
"spam-hide fires"
(get (mod-tr-find mod-tr-t "spam-hide") :proved)
true)
(mod-tr-test!
"default-keep always fires"
(get (mod-tr-find mod-tr-t "default-keep") :proved)
true)
(mod-tr-test!
"reviewer-remove does not fire (no evidence)"
(get (mod-tr-find mod-tr-t "reviewer-remove") :proved)
false)
(mod-tr-test!
"exonerated-keep does not fire"
(get (mod-tr-find mod-tr-t "exonerated-keep") :proved)
false)
(mod-tr-test!
"abuse-remove does not fire"
(get (mod-tr-find mod-tr-t "abuse-remove") :proved)
false)
;; ── winner matches the engine ──
(mod-tr-test!
"first-proved is spam-hide"
(get (mod/first-proved mod-tr-t) :rule)
"spam-hide")
(mod-tr-test!
"winner action matches decide-report"
(get (mod/first-proved mod-tr-t) :action)
(get
(mod/decide-report mod-tr-spam (list mod-tr-spam) mod/default-rules)
:action))
;; ── an unproved rule shows which goal failed ──
(define
mod-tr-rev-goals
(get (mod-tr-find mod-tr-t "reviewer-remove") :goals))
(mod-tr-test!
"reviewer-remove goal is unsolved"
(get (first mod-tr-rev-goals) :solved)
false)
(define mod-tr-spam-goals (get (mod-tr-find mod-tr-t "spam-hide") :goals))
(mod-tr-test!
"spam-hide goal is solved"
(get (first mod-tr-spam-goals) :solved)
true)
;; ── proved-rules list + rendering ──
(mod-tr-test!
"proved-rules lists fired rules in order"
(mod/proved-rules mod-tr-t)
(list "spam-hide" "default-keep"))
(mod-tr-test!
"trace-report marks a firing rule"
(mod/str-contains? (mod/trace-report mod-tr-t) "[fires] spam-hide")
true)
(mod-tr-test!
"trace-report marks a non-firing rule"
(mod/str-contains? (mod/trace-report mod-tr-t) "[ - ] reviewer-remove")
true)
;; ── clean report: only default-keep fires ──
(define mod-tr-clean (mod/mk-report "r2" "a" "b" "a fine post"))
(define
mod-tr-tc
(mod/trace-rules mod-tr-clean (list mod-tr-clean) mod/default-rules))
(mod-tr-test!
"clean report: only default-keep proves"
(mod/proved-rules mod-tr-tc)
(list "default-keep"))
(mod-tr-test!
"clean report winner is default-keep"
(get (mod/first-proved mod-tr-tc) :rule)
"default-keep")
(define mod-trace-tests-run! (fn () {:failures mod-tr-failures :total mod-tr-count :passed mod-tr-pass :failed mod-tr-fail}))

117
lib/mod/tests/whatif.sx Normal file
View File

@@ -0,0 +1,117 @@
;; lib/mod/tests/whatif.sx — Ext 10: policy what-if / impact analysis.
(define mod-wi-count 0)
(define mod-wi-pass 0)
(define mod-wi-fail 0)
(define mod-wi-failures (list))
(define
mod-wi-test!
(fn
(name got expected)
(begin
(set! mod-wi-count (+ mod-wi-count 1))
(if
(= got expected)
(set! mod-wi-pass (+ mod-wi-pass 1))
(begin
(set! mod-wi-fail (+ mod-wi-fail 1))
(append!
mod-wi-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; rules-b is the default policy with spam-hide removed: spam now falls through
;; to default-keep. A spam report flips hide → keep; everything else is unchanged.
(define mod-wi-rules-a mod/default-rules)
(define
mod-wi-rules-b
(list
(mod/mk-rule
"reviewer-remove"
:remove (list (list :evidence "confirmed-abuse")))
(mod/mk-rule
"abuse-remove"
:remove (list (list :classification "abuse")))
(mod/mk-rule
"repeated-escalate"
:escalate (list (list :count-at-least 3)))
(mod/mk-rule "default-keep" :keep (list))))
(define mod-wi-spam (mod/mk-report "r1" "a" "bob" "this is spam"))
(define mod-wi-abuse (mod/mk-report "r2" "a" "carol" "harassment here"))
(define mod-wi-clean (mod/mk-report "r3" "a" "dave" "a fine post"))
;; ── single-report diff ──
(define
mod-wi-d
(mod/decision-diff
mod-wi-spam
(list mod-wi-spam)
mod-wi-rules-a
mod-wi-rules-b))
(mod-wi-test! "spam before = hide" (get mod-wi-d :before) "hide")
(mod-wi-test! "spam after = keep" (get mod-wi-d :after) "keep")
(mod-wi-test! "spam decision flips" (get mod-wi-d :changed) true)
(mod-wi-test! "diff carries report id" (get mod-wi-d :report-id) "r1")
(define
mod-wi-da
(mod/decision-diff
mod-wi-abuse
(list mod-wi-abuse)
mod-wi-rules-a
mod-wi-rules-b))
(mod-wi-test! "abuse unchanged (remove both)" (get mod-wi-da :changed) false)
(mod-wi-test! "abuse stays remove" (get mod-wi-da :after) "remove")
(define
mod-wi-dc
(mod/decision-diff
mod-wi-clean
(list mod-wi-clean)
mod-wi-rules-a
mod-wi-rules-b))
(mod-wi-test! "clean unchanged (keep both)" (get mod-wi-dc :changed) false)
;; ── batch impact ──
(define mod-wi-batch (list mod-wi-spam mod-wi-abuse mod-wi-clean))
(define
mod-wi-impact
(mod/policy-impact mod-wi-batch mod-wi-rules-a mod-wi-rules-b))
(mod-wi-test!
"impact lists only changed reports"
(len mod-wi-impact)
1)
(mod-wi-test!
"impacted report is the spam one"
(get (first mod-wi-impact) :report-id)
"r1")
(mod-wi-test!
"impact-count agrees"
(mod/impact-count mod-wi-batch mod-wi-rules-a mod-wi-rules-b)
1)
;; ── identical rule sets → no impact ──
(mod-wi-test!
"same rules → zero impact"
(mod/impact-count mod-wi-batch mod-wi-rules-a mod-wi-rules-a)
0)
(mod-wi-test!
"same rules → empty report"
(mod/impact-report mod-wi-batch mod-wi-rules-a mod-wi-rules-a)
"No decisions change.")
;; ── rendering ──
(mod-wi-test!
"impact-report renders the flip"
(mod/str-contains?
(mod/impact-report mod-wi-batch mod-wi-rules-a mod-wi-rules-b)
"r1: hide → keep")
true)
(define mod-whatif-tests-run! (fn () {:failures mod-wi-failures :total mod-wi-count :passed mod-wi-pass :failed mod-wi-fail}))

96
lib/mod/tests/wire.sx Normal file
View File

@@ -0,0 +1,96 @@
;; lib/mod/tests/wire.sx — Ext 14: decision wire format + federated transport.
(define mod-w-count 0)
(define mod-w-pass 0)
(define mod-w-fail 0)
(define mod-w-failures (list))
(define
mod-w-test!
(fn
(name got expected)
(begin
(set! mod-w-count (+ mod-w-count 1))
(if
(= got expected)
(set! mod-w-pass (+ mod-w-pass 1))
(begin
(set! mod-w-fail (+ mod-w-fail 1))
(append!
mod-w-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; ── split-char ──
(mod-w-test! "split on pipe" (mod/split-char "a|b|c" "|") (list "a" "b" "c"))
(mod-w-test! "split single field" (mod/split-char "abc" "|") (list "abc"))
(mod-w-test!
"split four fields"
(len (mod/split-char "MOD1|r1|hide|spam-hide" "|"))
4)
;; ── serialize ──
(define
mod-w-dec
(mod/decide-report
(mod/mk-report "r1" "a" "bob" "this is spam")
(list (mod/mk-report "r1" "a" "bob" "this is spam"))
mod/default-rules))
(define mod-w-line (mod/decision->wire mod-w-dec))
(mod-w-test!
"wire is versioned + delimited"
mod-w-line
"MOD1|r1|hide|spam-hide")
(mod-w-test!
"wire-valid? accepts well-formed"
(mod/wire-valid? mod-w-line)
true)
(mod-w-test!
"wire-valid? rejects junk"
(mod/wire-valid? "not a wire line")
false)
(mod-w-test!
"wire-valid? rejects wrong version"
(mod/wire-valid? "MOD9|r1|hide|x")
false)
;; ── round-trip ──
(define mod-w-back (mod/wire->decision mod-w-line))
(mod-w-test! "round-trip report-id" (get mod-w-back :report-id) "r1")
(mod-w-test! "round-trip action" (get mod-w-back :action) "hide")
(mod-w-test! "round-trip rule" (get mod-w-back :rule) "spam-hide")
(mod-w-test! "round-trip tags :wire" (get mod-w-back :wire) true)
(mod-w-test! "malformed → nil" (mod/wire->decision "garbage") nil)
;; ── full federated transport: serialize → wire → deserialize → trust-gate ──
(mod/fed-reset!)
(define mod-w-peer-dec (mod/wire->decision mod-w-line))
;; untrusted peer: decision is advisory, not applied
(define mod-w-recv1 (mod/fed-receive-decision "peerX" mod-w-peer-dec))
(mod-w-test!
"wired decision from untrusted peer → advisory"
(get mod-w-recv1 :applied)
false)
(mod-w-test!
"untrusted wired decision not applied locally"
(mod/fed-applied-action "r1")
nil)
;; trusted peer: decision binds locally
(mod/grant-trust "peerY" :mod)
(define mod-w-recv2 (mod/fed-receive-decision "peerY" mod-w-peer-dec))
(mod-w-test!
"wired decision from trusted peer → applied"
(get mod-w-recv2 :applied)
true)
(mod-w-test!
"trusted wired decision binds locally"
(get (mod/fed-applied-action "r1") :action)
"hide")
(define mod-wire-tests-run! (fn () {:failures mod-w-failures :total mod-w-count :passed mod-w-pass :failed mod-w-fail}))

56
lib/mod/trace.sx Normal file
View File

@@ -0,0 +1,56 @@
;; lib/mod/trace.sx — policy dry-run diagnostics.
;;
;; decide-report returns the winning rule; a policy author debugging "why didn't
;; my rule fire?" needs the whole picture. mod/trace-rules evaluates a report
;; against every rule and reports each rule's proved/unproved status plus its
;; goal-by-goal derivation — so an unproved rule shows exactly which goal failed.
;; The winner is the first proved rule (same precedence as the engine).
(define
mod/trace-rules
(fn
(r reports rules)
(let
((count (mod/report-count (mod/report-about r) reports))
(id (mod/report-id r)))
(let
((db (pl-load (mod/build-program r count rules))))
(let
((proved-names (map (fn (s) (dict-get s "Rule")) (pl-query-all db (str "policy_action(" id ", _, Rule)")))))
(map
(fn (rule) (let ((nm (mod/rule-name rule))) {:proved (mod/member? nm proved-names) :goals (mod/proof-goals db id (mod/rule-when rule)) :action (mod/rule-action rule) :rule nm}))
rules))))))
(define
mod/first-proved
(fn
(trace)
(reduce
(fn (acc t) (if (nil? acc) (if (get t :proved) t acc) acc))
nil
trace)))
(define
mod/proved-rules
(fn
(trace)
(reduce
(fn
(acc t)
(if (get t :proved) (append acc (list (get t :rule))) acc))
(list)
trace)))
(define
mod/trace-row
(fn
(t)
(str
(if (get t :proved) "[fires] " "[ - ] ")
(get t :rule)
" → "
(get t :action))))
(define
mod/trace-report
(fn (trace) (mod/join-with "\n" (map mod/trace-row trace))))

56
lib/mod/whatif.sx Normal file
View File

@@ -0,0 +1,56 @@
;; lib/mod/whatif.sx — policy what-if / impact analysis.
;;
;; Before shipping a policy change, a moderation team needs to know which past or
;; pending reports would decide differently. mod/decision-diff compares one
;; report's action under two rule sets; mod/policy-impact runs a whole batch and
;; returns only the reports whose decision flips. Pure SX over decide-report.
(define
mod/decision-diff
(fn
(r reports rules-a rules-b)
(let
((a (get (mod/decide-report r reports rules-a) :action))
(b (get (mod/decide-report r reports rules-b) :action)))
{:after b :changed (if (= a b) false true) :report-id (mod/report-id r) :before a})))
(define
mod/policy-impact
(fn
(reports rules-a rules-b)
(reduce
(fn
(acc r)
(let
((d (mod/decision-diff r reports rules-a rules-b)))
(if (get d :changed) (append acc (list d)) acc)))
(list)
reports)))
(define
mod/impact-count
(fn
(reports rules-a rules-b)
(len (mod/policy-impact reports rules-a rules-b))))
(define
mod/impact-report
(fn
(reports rules-a rules-b)
(let
((changed (mod/policy-impact reports rules-a rules-b)))
(if
(empty? changed)
"No decisions change."
(mod/join-with
"\n"
(map
(fn
(d)
(str
(get d :report-id)
": "
(get d :before)
" → "
(get d :after)))
changed))))))

55
lib/mod/wire.sx Normal file
View File

@@ -0,0 +1,55 @@
;; lib/mod/wire.sx — portable decision wire format for federation transport.
;;
;; fed.sx shares decisions as in-memory dicts and leaves mod/fed-send! as the
;; transport seam. This is the bytes that cross it: a versioned, pipe-delimited
;; line encoding the verdict a peer needs (report id, action, rule) — enough to
;; trust-gate and apply/advise, without shipping the whole proof tree. The
;; loaded env has no string split, so split is built over slice/len.
(define
mod/split-loop
(fn
(s ch n start pos acc)
(if
(= pos n)
(append acc (list (slice s start n)))
(if
(= (slice s pos (+ pos 1)) ch)
(mod/split-loop
s
ch
n
(+ pos 1)
(+ pos 1)
(append acc (list (slice s start pos))))
(mod/split-loop s ch n start (+ pos 1) acc)))))
(define
mod/split-char
(fn (s ch) (mod/split-loop s ch (len s) 0 0 (list))))
(define
mod/decision->wire
(fn
(d)
(str "MOD1|" (get d :report-id) "|" (get d :action) "|" (get d :rule))))
(define
mod/wire-valid?
(fn
(w)
(let
((parts (mod/split-char w "|")))
(if
(= (len parts) 4)
(= (nth parts 0) "MOD1")
false))))
(define
mod/wire->decision
(fn
(w)
(if
(mod/wire-valid? w)
(let ((parts (mod/split-char w "|"))) {:action (nth parts 2) :wire true :rule (nth parts 3) :report-id (nth parts 1)})
nil)))

102
plans/acl-on-sx.md Normal file
View File

@@ -0,0 +1,102 @@
# acl-on-sx: Access Control on Datalog
rose-ash needs fine-grained, explainable, federation-aware access control. Subjects
(users, groups, roles, services) × actions (read, edit, comment, moderate, federate)
× resources (pages, posts, threads, peers). Decisions must come with a trace — not just
permit/deny, but **why**.
Datalog's bottom-up rule engine produces transparent permit/deny chains: the proof tree
is the audit trail. Inheritance over groups + resource hierarchies is recursive Datalog
in one rule. Federation extends naturally — fed-sx replicates ACL facts, peers reason
over the union.
End-state: a Datalog-on-SX layer specifically for ACL, with explanation API, audit log,
and federation extension. Reuses `lib/datalog/` evaluator and term model where possible.
## Status (rolling)
`bash lib/acl/conformance.sh`**0/0** (not yet started)
## Ground rules
- **Scope:** only touch `lib/acl/**` and `plans/acl-on-sx.md`. Do **not** edit `spec/`,
`hosts/`, `shared/`, `lib/datalog/**`, or other `lib/<lang>/`. You may **import**
from `lib/datalog/` (its public API in `lib/datalog/datalog.sx`); do **not** copy or
modify Datalog code.
- **Shared-file issues** go under "Blockers" with a minimal repro; do not fix here.
- **SX files:** use `sx-tree` MCP tools only.
- **Architecture:** thin layer on top of `lib/datalog/`. Define schema, surface API,
audit + federation hooks. The rule engine itself is Datalog's.
- **Watch for shared patterns** going into `lib/guest/` — both acl-sx and mod-sx need
rule-engine plumbing. If you find shared shape, flag it for extraction (don't
extract yet — wait for mod-sx to start).
- **Commits:** one feature per commit. Keep Progress log updated and tick boxes.
## Architecture sketch
```
ACL declarations (SX) User query
│ │
▼ ▼
lib/acl/schema.sx lib/acl/api.sx
— subject sorts — (acl/permit? subj act res)
— resource sorts — (acl/explain subj act res)
— action sorts — (acl/audit subj act res :allowed?)
— fact schema │
│ ▼
▼ lib/acl/engine.sx
lib/acl/facts.sx — builds Datalog query
— actor(id, kind) — invokes lib/datalog/
— resource(id, kind) — extracts proof tree
— member_of(actor, group) │
— child_of(res, parent) ▼
— grant(actor, act, res) lib/acl/audit.sx
— deny (actor, act, res) — persistent decision log
— query API
```
## Phase 1 — Direct grants
- [ ] `lib/acl/schema.sx` — sorts: subject {user, group, role, service}, action,
resource {page, post, thread, peer}
- [ ] `lib/acl/facts.sx``actor`, `resource`, `grant`, `deny` predicates as Datalog
EDB
- [ ] `lib/acl/engine.sx``(permit? subj act res db)` reduces to Datalog query
- [ ] `lib/acl/api.sx` — public `(acl/permit? ...)` taking implicit current db
- [ ] `lib/acl/tests/direct.sx` — 15+ cases: direct grant, missing grant, explicit deny
- [ ] `lib/acl/scoreboard.{json,md}` baseline
- [ ] `lib/acl/conformance.sh` runs the suite
## Phase 2 — Inheritance
- [ ] `member_of(actor, group)` chain — group grants apply to members (transitive)
- [ ] `child_of(res, parent)` chain — parent grants apply to children (transitive)
- [ ] role expansion — role contains list of (action, resource) tuples
- [ ] deny-overrides — explicit deny wins over inherited allow
- [ ] `lib/acl/tests/inherit.sx` — 25+ cases: nested groups, deep resource trees,
conflict resolution, deny precedence
- [ ] document the deny-overrides choice in plan
## Phase 3 — Explanation + audit
- [ ] `(acl/explain subj act res)``{:allowed? T :proof <tree>}`
- [ ] proof tree extracts from Datalog's derivation
- [ ] `lib/acl/audit.sx` — append-only decision log (in-memory + serializer for disk)
- [ ] `(acl/audit-tail n)` for recent decisions
- [ ] `lib/acl/tests/explain.sx` — proof correctness, audit completeness
## Phase 4 — Federation
- [ ] peer trust facts — `peer(addr, kind)`, `trust(peer, level)`
- [ ] delegated grants — `delegate(peer, actor, action, resource)`
- [ ] cross-instance permit chain — query asks local + queries trusted peers via fed-sx
- [ ] revocation propagation — fact retraction across federation
- [ ] `lib/acl/tests/fed.sx` — federated grant chains (mock fed-sx transport in tests)
## Progress log
(loop fills this in)
## Blockers
(loop fills this in)

View File

@@ -0,0 +1,93 @@
# acl-on-sx loop agent (single agent, queue-driven)
Role: iterates `plans/acl-on-sx.md` forever. **First subsystem loop after fed-sx.**
Sits on `lib/datalog/` — rule engine reused, schema/api/audit/federation added on
top. The deliverable isn't "implement Datalog ACL"; it's *also* to surface shared
rule-engine plumbing into `lib/guest/` (the mod-sx loop will be the second consumer,
validating extraction).
```
description: acl-on-sx queue loop
subagent_type: general-purpose
run_in_background: true
isolation: worktree
```
## Prompt
You are the sole background agent working `/root/rose-ash/plans/acl-on-sx.md`.
Isolated worktree, forever, one commit per feature. Push to `origin/loops/acl`
after every commit.
## Restart baseline — check before iterating
1. Read `plans/acl-on-sx.md` — roadmap + Progress log.
2. `ls lib/acl/` — pick up from the most advanced file.
3. If `lib/acl/tests/*.sx` exist, run them via `bash lib/acl/conformance.sh`. Green
before new work.
4. If `lib/acl/scoreboard.md` exists, that's your baseline.
5. Read `lib/datalog/datalog.sx` public API once — that's your substrate.
## The queue
Phase order per `plans/acl-on-sx.md`:
- **Phase 1** — direct grants. Schema, EDB facts, engine, api, 15+ tests
- **Phase 2** — inheritance (member_of, child_of, role expansion, deny-overrides)
- **Phase 3** — explanation + audit (proof tree, audit log)
- **Phase 4** — federation (peer trust, delegation, cross-instance permit chain)
Within a phase, pick the checkbox that unlocks the most tests per effort.
Every iteration: implement → test → commit → tick `[ ]` → Progress log → next.
## Ground rules (hard)
- **Scope:** only `lib/acl/**` and `plans/acl-on-sx.md`. Do **not** edit `spec/`,
`hosts/`, `shared/`, other `lib/<lang>/` dirs, `lib/stdlib.sx`, or `lib/` root.
May **import** from `lib/datalog/` only (its public API).
- **NEVER call `sx_build`.** 600s watchdog. If sx_server binary broken → Blockers
entry, stop.
- **Shared-file issues** → plan's Blockers with minimal repro.
- **SX files:** `sx-tree` MCP tools ONLY. `sx_validate` after edits.
- **Worktree:** commit, then push to `origin/loops/acl`. Never touch `main` or
`architecture`.
- **Commit granularity:** one feature per commit. Short factual messages
(`acl: child_of resource inheritance + 8 tests`).
- **Plan file:** update Progress log + tick boxes every commit.
- **Watch for shared infrastructure** with future mod-sx (Prolog moderation). If you
build a generic rule-engine adapter, note it in Progress log so the eventual
`lib/guest/rules/` extraction has both consumers identified.
## ACL-specific gotchas
- **Datalog is bottom-up.** No goal-directed search. Don't reach for cut or
backtracking — that's mod-sx's job. Your decisions emerge from fixpoint.
- **Deny-overrides** is the policy: if both an allow and deny rule fire, deny wins.
Encode this via stratified negation; document the choice clearly in plan.
- **Inheritance termination:** recursive rules with `member_of` chains must
terminate. Datalog guarantees this absent function symbols — don't introduce them
in your schema.
- **Proof tree shape:** Datalog's derivation graph is a DAG, not a tree, when the
same fact is derived multiple ways. For audit, pick one canonical derivation
(shortest, or first); document choice.
- **Federation isn't transitive trust.** A peer's `delegate(...)` fact only applies
if local `trust(peer, level)` covers the action class. Re-check trust on every
query, not at fact-ingestion time.
## General gotchas (all loops)
- SX `do` = R7RS iteration. Use `begin` for multi-expr sequences.
- `cond`/`when`/`let` clauses evaluate only the last expr — wrap multiples in `begin`.
- `env-bind!` creates a binding; `env-set!` mutates an existing one (walks scope chain).
- `sx_validate` after every structural edit.
- `list?` returns false on raw JS Arrays — host data must be SX-converted.
## Style
- No comments in `.sx` unless non-obvious.
- No new planning docs — update `plans/acl-on-sx.md` inline.
- Short, factual commit messages.
- One feature per iteration. Commit. Log. Push. Next.
Go. Start by reading the plan; find the first unchecked `[ ]`; implement it.

View File

@@ -0,0 +1,99 @@
# feed-on-sx loop agent (single agent, queue-driven)
Role: iterates `plans/feed-on-sx.md` forever. **Activity feeds on APL** — timelines,
notifications, fanout, ranking, all as APL array math on activity vectors. Densest
possible expression of feed composition. Sits on `lib/apl/` (450+/450+ tests
already); adds a feed-shaped vocabulary on top.
```
description: feed-on-sx queue loop
subagent_type: general-purpose
run_in_background: true
isolation: worktree
```
## Prompt
You are the sole background agent working `/root/rose-ash/plans/feed-on-sx.md`.
Isolated worktree, forever, one commit per feature. Push to `origin/loops/feed`
after every commit.
## Restart baseline — check before iterating
1. Read `plans/feed-on-sx.md` — roadmap + Progress log.
2. `ls lib/feed/` — pick up from the most advanced file.
3. If `lib/feed/tests/*.sx` exist, run them via `bash lib/feed/conformance.sh`. Green
before new work.
4. If `lib/feed/scoreboard.md` exists, that's your baseline.
5. Read `lib/apl/apl.sx` public API once — that's your substrate. Familiarize
yourself with at least: ` / ⌽ ↑ ↓ ⌷ ∊ ∘.× /\ ⍋` (you will use all of these).
## The queue
Phase order per `plans/feed-on-sx.md`:
- **Phase 1** — stream model + basic ops (record schema, filter, sort, take)
- **Phase 2** — **THE SHOWCASE**: fanout via outer product. activities `∘.×`
followers → inbox matrix, flatten + dedupe
- **Phase 3** — aggregation + ranking (group-by, velocity, recency, top-N)
- **Phase 4** — visibility filter (acl-sx) + federation (fed-sx inbox + backfill)
Within a phase, pick the checkbox that unlocks the most tests per effort.
Every iteration: implement → test → commit → tick `[ ]` → Progress log → next.
## Ground rules (hard)
- **Scope:** only `lib/feed/**` and `plans/feed-on-sx.md`. Do **not** edit `spec/`,
`hosts/`, `shared/`, other `lib/<lang>/` dirs, `lib/stdlib.sx`, or `lib/` root.
May **import** from `lib/apl/` only (its public API).
- **NEVER call `sx_build`.** 600s watchdog. If sx_server binary broken → Blockers
entry, stop.
- **Shared-file issues** → plan's Blockers with minimal repro.
- **SX files:** `sx-tree` MCP tools ONLY. `sx_validate` after edits.
- **Unicode in `.sx`:** raw UTF-8 only, never `\uXXXX` escapes. APL glyphs land
directly in source.
- **Worktree:** commit, then push to `origin/loops/feed`. Never touch `main` or
`architecture`.
- **Commit granularity:** one feature per commit. Short factual messages
(`feed: outer-product fanout + dedupe by (actor,verb,object) + 9 tests`).
- **Plan file:** update Progress log + tick boxes every commit.
## feed-specific gotchas
- **Activities are heterogeneous.** Different verbs carry different shapes
(`:object` might be page-id, post-id, user-id). Don't over-normalize — keep
`:tags` as a flexible bag. APL operations over heterogeneous records work fine
via dict lookups; only the indexed fields need uniform shape.
- **Fanout produces matrices fast.** N activities × M followers → NM items. Apply
filter/dedupe early, not after materialization. Use guard predicates *inside*
the outer product where possible (compose with `∘.{a v ⊢ ...}`).
- **Dedupe key isn't always `(actor,verb,object)`.** For "alice liked X" and "bob
liked X" the dedupe key is `(verb,object)` (collapse the actors into a list).
For "alice posted X" each `:actor` is distinct. Each verb may want its own
dedupe rule; codify these in `lib/feed/dedupe.sx`.
- **Recency decay matters more than score precision.** Use a simple half-life decay
(e.g. score × 0.5^(age/window)) rather than a clever curve. Calibrate the
window via tests, not theory.
- **Ranking should be deterministic on ties.** Always include a tiebreaker (id, or
hash). Otherwise tests will flake.
- **The ACL filter is per-viewer.** A timeline is computed *for* a user; the same
candidate stream produces different timelines for different viewers. Don't
cache pre-ACL timelines.
## General gotchas (all loops)
- SX `do` = R7RS iteration. Use `begin` for multi-expr sequences.
- `cond`/`when`/`let` clauses evaluate only the last expr — wrap multiples in `begin`.
- `env-bind!` creates a binding; `env-set!` mutates an existing one (walks scope chain).
- `sx_validate` after every structural edit.
- `list?` returns false on raw JS Arrays — host data must be SX-converted.
## Style
- No comments in `.sx` unless non-obvious.
- No new planning docs — update `plans/feed-on-sx.md` inline.
- Short, factual commit messages.
- One feature per iteration. Commit. Log. Push. Next.
Go. Start by reading the plan; find the first unchecked `[ ]`; implement it.

View File

@@ -0,0 +1,98 @@
# flow-on-sx loop agent (single agent, queue-driven)
Role: iterates `plans/flow-on-sx.md` forever. **Durable workflows on Scheme** — the
call/cc + delimited continuation showcase that justifies pulling R7RS into
production. art-dag's natural successor: DAG-of-tasks with pause/resume across
process restarts. fed-sx extension turns local flows into distributed ones.
```
description: flow-on-sx queue loop
subagent_type: general-purpose
run_in_background: true
isolation: worktree
```
## Prompt
You are the sole background agent working `/root/rose-ash/plans/flow-on-sx.md`.
Isolated worktree, forever, one commit per feature. Push to `origin/loops/flow`
after every commit.
## Restart baseline — check before iterating
1. Read `plans/flow-on-sx.md` — roadmap + Progress log.
2. `ls lib/flow/` — pick up from the most advanced file.
3. If `lib/flow/tests/*.sx` exist, run them via `bash lib/flow/conformance.sh`. Green
before new work.
4. If `lib/flow/scoreboard.md` exists, that's your baseline.
5. Read `lib/scheme/scheme.sx` public API once — that's your substrate.
## The queue
Phase order per `plans/flow-on-sx.md`:
- **Phase 1** — declarative DAG: `defflow`, `sequence`, `parallel`, sync runtime,
basic api
- **Phase 2** — control flow + error handling: `cond`, `retry`, `timeout`,
`try-catch`
- **Phase 3** — **THE SHOWCASE**: `suspend`/`resume` via `call/cc`, persistent
store, crash recovery
- **Phase 4** — distributed nodes via fed-sx (remote-node, handoff, replication)
Within a phase, pick the checkbox that unlocks the most tests per effort.
Every iteration: implement → test → commit → tick `[ ]` → Progress log → next.
## Ground rules (hard)
- **Scope:** only `lib/flow/**` and `plans/flow-on-sx.md`. Do **not** edit `spec/`,
`hosts/`, `shared/`, other `lib/<lang>/` dirs, `lib/stdlib.sx`, or `lib/` root.
May **import** from `lib/scheme/` only (its public API).
- **NEVER call `sx_build`.** 600s watchdog. If sx_server binary broken → Blockers
entry, stop.
- **Shared-file issues** → plan's Blockers with minimal repro.
- **SX files:** `sx-tree` MCP tools ONLY. `sx_validate` after edits.
- **Worktree:** commit, then push to `origin/loops/flow`. Never touch `main` or
`architecture`.
- **Commit granularity:** one feature per commit. Short factual messages
(`flow: retry combinator with exponential backoff + 6 tests`).
- **Plan file:** update Progress log + tick boxes every commit.
## flow-specific gotchas
- **Continuations must be re-entrant.** Phase 3's `suspend` captures a continuation
that may be re-entered after a process restart. That means: no captured file
descriptors, no captured sockets, no captured live runtime references that won't
survive serialization. State referenced by the continuation must be plain SX data
or live in the flow store.
- **call/cc, not call-with-escape-continuation.** R7RS distinguishes. Use the full
call/cc for resume; escape-only continuations cannot be re-entered. Read
`lib/scheme/r7rs.md` (or equivalent) to confirm semantics.
- **`parallel` in Phase 1 is sequential.** Don't try threading until Phase 3+. Just
evaluate branches in order, collect results, return joined value. Document the
semantics clearly so users don't assume true concurrency.
- **Retry doesn't retry continuations.** If a node has already suspended, retry on
resume doesn't re-run it from scratch — it resumes. `retry` only applies to
exceptions raised before suspend. Be explicit in the API.
- **Cancellation invalidates the continuation.** `(flow/cancel id)` must remove the
stored continuation so a stale `resume` cannot wake it. Document semantics.
- **Timeouts in pure SX are tricky.** Without a scheduler, `timeout` is a budget on
step count or wall-clock probed at safe points. Pick one approach (probably step
budget for determinism) and document.
## General gotchas (all loops)
- SX `do` = R7RS iteration. Use `begin` for multi-expr sequences.
- `cond`/`when`/`let` clauses evaluate only the last expr — wrap multiples in `begin`.
- `env-bind!` creates a binding; `env-set!` mutates an existing one (walks scope chain).
- `sx_validate` after every structural edit.
- `list?` returns false on raw JS Arrays — host data must be SX-converted.
## Style
- No comments in `.sx` unless non-obvious.
- No new planning docs — update `plans/flow-on-sx.md` inline.
- Short, factual commit messages.
- One feature per iteration. Commit. Log. Push. Next.
Go. Start by reading the plan; find the first unchecked `[ ]`; implement it.

View File

@@ -0,0 +1,106 @@
# kernel-on-sx loop agent (single agent, queue-driven)
Role: iterates `plans/kernel-on-sx.md` forever. **First chisel of the Phase B stratification work** — natural successor to env-as-value, validates SX's reflection story (first-class environments, evaluators, operatives). Goal isn't just "implement Kernel"; it's *also* to surface common patterns into `lib/guest/` (specifically motivating a future `lib/guest/reflective/` sub-layer). One feature per commit.
```
description: kernel-on-sx queue loop
subagent_type: general-purpose
run_in_background: true
isolation: worktree
```
## DO NOT START WITHOUT THE PREREQUISITES
This loop **must not** start until the lib-guest core kits are in place. Kernel's parser consumes `lib/guest/core/lex.sx` and `lib/guest/core/pratt.sx` (s-expression-shaped, minimal demand); its evaluator's pattern dispatch consumes `lib/guest/core/match.sx`.
**Pre-flight check:**
```
ls /root/rose-ash/lib/guest/lex.sx /root/rose-ash/lib/guest/pratt.sx \
/root/rose-ash/lib/guest/match.sx /root/rose-ash/lib/guest/ast.sx
```
If any of those `lib/guest/*.sx` files are missing, **stop and report**. Do not start.
## Prompt
You are the sole background agent working `/root/rose-ash/plans/kernel-on-sx.md`. You run in an isolated git worktree on branch `loops/kernel`. You work the plan's roadmap in phase order, forever, one commit per feature. Push to `origin/loops/kernel` after every commit.
## Restart baseline — check before iterating
1. Read `plans/kernel-on-sx.md` — Roadmap + Progress log + Blockers tell you where you are.
2. Run the pre-flight check above. If any lib/guest kit is missing, stop immediately and update the plan's Blockers section.
3. `ls lib/kernel/` — pick up from the most advanced file that exists. If the directory does not exist, you are at Phase 1.
4. If `lib/kernel/tests/*.sx` exist, run them via the epoch protocol against `sx_server.exe`. They must be green before new work.
## The queue
Phase order per `plans/kernel-on-sx.md`:
- **Phase 1** — Parser (s-expression reader, minimal — consumes `lib/guest/lex` + `lib/guest/pratt`)
- **Phase 2** — Core evaluator with first-class environments
- **Phase 3** — `$vau` / `$lambda` / `wrap` / `unwrap` (the operativeapplicative distinction)
- **Phase 4** — Standard environment construction
- **Phase 5** — Encapsulations (Kernel's opaque-type idiom)
- **Phase 6** — Hygienic operatives (Shutt's later work — operatives that don't capture)
- **Phase 7** — Propose `lib/guest/reflective/` (extraction phase — see chiselling discipline)
Within a phase, pick the checkbox with the best tests-per-effort ratio.
Every iteration: implement → test → commit → tick `[ ]` in plan → append Progress log → push → next.
## Lib/guest chiselling discipline (the defining feature of this loop)
You are not just implementing Kernel — you are *chiselling* the substrate to surface what `lib/guest/reflective/` should contain. Every commit must end with a one-line **"chisel note"** appended to the plan's Progress log entry, in this format:
```
chisel: <one of: consumes-X | shapes-reflective | proposes-Y | nothing>
```
- `consumes-X` — this commit used an existing `lib/guest/X` kit (e.g., `consumes-pratt`, `consumes-match`).
- `shapes-reflective` — this commit revealed something about what `lib/guest/reflective/` should look like (e.g., env-reification helper signatures, applicative-vs-operative dispatch protocol). Add a paragraph to the plan's "lib/guest feedback loop" section describing the insight.
- `proposes-Y` — this commit revealed a gap in another existing kit (e.g., `match.sx` doesn't quite handle X). Open a Blockers entry describing the gap.
- `nothing` — pure Kernel work that didn't touch the substrate or lib/guest story (rare; if you write this twice in a row, stop and reflect on why).
**Phase 7 (extraction)** is **gated** by the two-consumer rule. Kernel alone is one consumer. The natural second consumer is a future MetaScheme port, a Common-Lisp meta-evaluator port, or a Kernel dialect (cKanren-style). **Until a second consumer exists, do NOT actually extract** — instead, mark Phase 7 `[partial — pending second consumer]` and document the proposed `lib/guest/reflective/` API surface in the plan's progress log. The extraction itself happens later, when a second consumer materialises.
This discipline is the point of the loop, not a bookkeeping tax. The chisel notes are what tell us — at the end of Kernel's run — whether a `lib/guest/reflective/` sub-layer is real or just one-language-shaped.
## Ground rules (hard)
- **Scope:** only `lib/kernel/**` and `plans/kernel-on-sx.md`. Do **not** edit `spec/`, `hosts/`, `shared/`, `lib/guest/**` (read-only consumer at this phase), or other `lib/<lang>/`.
- **Consume `lib/guest/core/`** wherever it covers a need. Hand-rolling defeats the chiselling goal.
- **Do not extract into `lib/guest/reflective/` from this loop.** That's Phase 7 territory, gated by the two-consumer rule. Until there's a second consumer, document the API surface only.
- **Substrate gaps** (env-as-value not exposing X, `eval` semantics drift, JIT not handling reflective patterns) → Blockers entry with minimal repro. Do **not** fix substrate from this loop. Substrate work belongs to `sx-improvements.md` / `jit-perf-regression.md`.
- **NEVER call `sx_build`.** 600s watchdog will kill you. If `sx_server.exe` is broken, add a Blockers entry and stop.
- **SX files:** `sx-tree` MCP tools ONLY. `sx_validate` after every edit. Never `Edit`/`Read`/`Write` on `.sx`.
- **Worktree:** commit, then push to `origin/loops/kernel`. Never touch `main`. Never push to `architecture`.
- **Commit granularity:** one feature per commit. Short factual messages: `kernel: $vau operative + 6 tests`.
- **Plan file:** update Progress log + tick boxes every commit. Include the chisel note.
- **If blocked** for two iterations on the same issue, add to Blockers and move on.
## Kernel-specific gotchas
- **Operatives don't evaluate their arguments.** `$vau` builds an operative; the body sees the *unevaluated* argument expressions plus the dynamic environment. This is the opposite of every other guest in the set. `(define-via-vau)` builds a binding by calling `eval` inside the body on the (still-syntax) argument.
- **Applicatives wrap operatives.** `(wrap op)` produces an applicative that evaluates its args first, then calls `op` with the values. `$lambda` is sugar for `wrap``$vau`.
- **Dynamic vs static environments.** Operative body sees both: the static env where the `$vau` was created (closure-style), AND the dynamic env where the call happens (passed as the env-param). Different from lexical-only languages.
- **No special forms in the evaluator.** `$if`, `$define!`, `$lambda` are all just operatives bound in the standard environment. The evaluator is `lookup-and-call` — no hardcoded switch on symbols. This is the whole point: the language is reified as data.
- **`eval` is a primitive callable on user environments.** This is where SX's env-as-value matters most. If env-as-value isn't fully landed in the substrate, this is where it'll break.
- **Encapsulations (Phase 5) are Kernel's opaque-types idiom.** `make-encapsulation-type` returns three operatives: encapsulator (constructs), predicate (tests), decapsulator (extracts). Used to define promises, streams, modules.
- **Hygienic operatives (Phase 6) are research-grade.** Shutt's later work. Operatives that don't accidentally capture caller bindings. Likely uses scope sets / frame stamps. Treat as exploration, not implementation-deadline.
## General gotchas (all loops)
- SX `do` = R7RS iteration. Use `begin` for multi-expr sequences.
- `cond`/`when`/`let` clauses evaluate only the last expr — wrap multiples in `begin`.
- `env-bind!` creates a binding; `env-set!` mutates an existing one (walks scope chain).
- `sx_validate` after every structural edit.
- `list?` returns false on raw JS Arrays — host data must be SX-converted.
- Shell heredoc `||` gets eaten — escape or use `case`.
## Style
- No comments in `.sx` unless non-obvious.
- No new planning docs — update `plans/kernel-on-sx.md` inline.
- Short, factual commit messages with chisel note: `kernel: $vau operative + 6 tests [shapes-reflective]`.
- One feature per iteration. Commit. Log. Push. Next.
Go. Run the pre-flight check. If lib/guest kits are missing, stop. Otherwise read the plan, find the first unchecked `[ ]`, implement it. Remember: every commit ends with a chisel note, and Phase 7 extraction waits for a second consumer.

View File

@@ -0,0 +1,136 @@
# mod-on-sx loop agent (single agent, queue-driven)
Role: iterates `plans/mod-on-sx.md` forever. **Moderation on Prolog** — reports,
policy rules, decisions as backtracking proof search, audit trails, escalation
state machine, federation. Where acl-sx asks "may this happen?", mod-sx asks
"should this stay?" Sits on `lib/prolog/` (its test suite already green); adds a
moderation-shaped vocabulary on top.
```
description: mod-on-sx queue loop
subagent_type: general-purpose
run_in_background: true
isolation: worktree
```
## Prompt
You are the sole background agent working `plans/mod-on-sx.md`. Isolated worktree
`/root/rose-ash-loops/mod` on branch `loops/mod`, forever, one commit per feature.
Push to `origin/loops/mod` after every commit. Never touch `main` or `architecture`.
## Restart baseline — check before iterating
1. Read `plans/mod-on-sx.md` — roadmap + Progress log.
2. `ls lib/mod/` — pick up from the most advanced file.
3. If `lib/mod/tests/*.sx` exist, run them via `bash lib/mod/conformance.sh`. Green
before new work.
4. If `lib/mod/scoreboard.md` exists, that's your baseline.
5. Read the `lib/prolog/` public API once — that's your substrate. The plan cites
`lib/prolog/prolog.sx` but that file does **not** exist; the real entry points
are `lib/prolog/runtime.sx`, `query.sx`, `compiler.sx`, `parser.sx`. Investigate
them (sx_find_all / grep for `(define ` heads) to learn how to assert facts and
run queries before writing any policy code.
## The queue
Phase order per `plans/mod-on-sx.md`:
- **Phase 1** — report representation + simple policy (schema, defrule→clause,
`(decide id)` query, api). Tests: spam keyword → hide, repeated reports →
escalate, no rule → keep.
- **Phase 2** — evidence accumulation + audit trail (proof tree from derivation,
append-only decision log, retrieval).
- **Phase 3** — escalation + lifecycle state machine
(`:open → :triaged → :decided → :appealed → :final`), auto/human tiers, appeal.
- **Phase 4** — federation (cross-instance reports, decision sharing, trust model,
revocation; mock fed-sx in tests).
Within a phase, pick the checkbox that unlocks the most tests per effort.
Every iteration: implement → test → commit → tick `[ ]` → Progress log → next.
## Ground rules (hard)
- **Scope:** only `lib/mod/**` and `plans/mod-on-sx.md`. Do **not** edit `spec/`,
`hosts/`, `shared/`, other `lib/<lang>/` dirs, `lib/stdlib.sx`, or `lib/` root.
May **import** from `lib/prolog/` only (its public API). Do **not** modify Prolog.
- **NEVER call `sx_build`.** 600s watchdog. If the sx_server binary is broken →
Blockers entry, stop. Run tests by invoking the sx_server binary directly from a
conformance.sh (see how `lib/prolog/conformance.sh` drives it), pointing
`SX_SERVER` at `/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe`
(fresh worktrees have no `_build/`).
- **Shared-file issues** → plan's Blockers with minimal repro; don't fix here.
- **SX files:** `sx-tree` MCP tools ONLY. **They take `file:` not `path:`** — a
wrong key yields `Yojson Type_error("Expected string, got null")`, which looks
like a broken binary but is just a param mismatch. `sx_validate` after edits.
Path-based edits (`sx_replace_node`) count comment headers in their indices and
can clobber the wrong node — re-read after, or prefer `sx_write_file` for small
files. **Default to `sx_write_file` (rewrite the whole file) over path/pattern
edits** — these are small files and the rewrite always parses-before-writing.
`sx_insert_near` inserts only the FIRST top-level form of a multi-form source
(it silently drops the rest; byte count barely moves) — never use it to add a
block of forms; rewrite the file instead. `sx_replace_by_pattern` is fiddly to
match — don't fight it, just rewrite.
- **Unicode in `.sx`:** raw UTF-8 only, never `\uXXXX` escapes.
- **Commit granularity:** one feature per commit. Short factual messages
(`mod: spam-keyword policy rule → :hide + 6 tests`). Push to `origin/loops/mod`.
- **Plan file:** update Progress log (newest first) + tick boxes every commit.
## mod-specific gotchas
- **Decisions are proofs, not booleans.** A decision should carry *why* — the
matching rule / derivation — so Phase 2's audit trail can persist it. Design the
Phase-1 `decide` return shape with that in mind (don't return a bare keyword you
later have to retrofit).
- **Policy chains backtrack.** Order matters: first matching rule wins. Make rule
precedence explicit and deterministic (tests will depend on it). A "no rule
matched" outcome must be a real, testable result (`:keep`), not a query failure
you forget to handle.
- **You may lean on backtracking and cut.** The substrate is full Prolog —
`pl-query-all` gives every proven clause (use it for "strictest-wins" or
multi-match analysis), `pl-query-one` gives the first (clause order = precedence).
Cut (`!`) and the other control constructs are available if you need to prune
alternatives inside a body, but for rule precedence prefer plain clause ordering
resolved by `pl-query-one` — it's the clean, testable default. Don't hand-roll
precedence in SX when the engine's backtracking already gives it to you.
- **Negative decisions need closed-world care.** "No evidence of violation" vs
"evidence absent" differ. Be explicit about negation-as-failure where you use it.
In this substrate, negation is the **functor** `not(Goal)` / `\+(Goal)` — the
prefix `\+ Goal` operator does **not** parse. Unknown predicates *fail* (no
existence error), so a report lacking some fact safely falls through a rule that
references it. Quote user-data atoms (`'foo-bar'`) — a bare hyphen is the minus
operator and will misparse.
- **Loaded-env strips the high-level string prims.** After the prolog preloads are
loaded, the eval env loses `includes?`, `chars`, `str-join`, `keyword` and
friends — they are **undefined** (a function calling one fails only when called,
often mid-test-load, looking like a mystery crash). Only the set the Prolog
tokenizer itself uses survives: `slice`, `len`, `nth`, `=`, `join` (sep first:
`(join sep list)`), `downcase`, `map`, `reduce`, `append`/`append!`, `when`,
`cond`, `if`, `let`, `begin`, `get`, `dict-get`, `keys`, `empty?`, `first`,
`reverse`, `+`, `-`, `<`, `<=`. Build substring search yourself over `slice`/
`len` (see `mod/str-contains?`). Treat `not`, `and`, `or`, `>` as suspect in
guest code unless you've confirmed them — nest `if`/`when` and use `(< a b)`.
- **Lifecycle state is separate from policy.** Keep the state machine (Phase 3) as
an SX module over the engine, not tangled into Prolog rules.
- **Federation trust is advisory by default.** A peer's decision only binds locally
when `(trust peer :mod)` holds; otherwise it's a suggestion. Don't auto-apply.
## General gotchas (all loops)
- SX `do` = R7RS iteration. Use `begin` for multi-expr sequences.
- `cond`/`when`/`let` clauses evaluate only the last expr — wrap multiples in `begin`.
- `let` is parallel, not sequential — nest `let`s when a binding references an earlier one.
- `env-bind!` creates a binding; `env-set!` mutates an existing one (walks scope chain).
- `sx_validate` after every structural edit.
- Namespace-prefix all guest helpers (`mod/...`) — short/host-colliding names
(`bind`, `conj`, `name`) get silently shadowed or hang the runtime.
## Style
- No comments in `.sx` unless non-obvious.
- No new planning docs — update `plans/mod-on-sx.md` inline.
- Short, factual commit messages.
- One feature per iteration. Commit. Log. Push. Next.
Go. Start by reading the plan; find the first unchecked `[ ]`; implement it.

105
plans/feed-on-sx.md Normal file
View File

@@ -0,0 +1,105 @@
# feed-on-sx: Activity Feeds on APL
Timelines, notifications, activity aggregation. The math is array math: filter, sort,
reduce, scan, outer product. APL is the densest possible expression of feed
composition — a fanout-and-rank pipeline reads as a single line.
rose-ash needs: per-user home timeline, notification feed, activity stream digestion,
backfill for new follows, deduplication across cross-posts. Every operation is an
array-shaped transformation.
End-state: an APL-flavored layer on `lib/apl/` with feed-specific combinators
(`fanout`, `dedupe`, `score`, `rank`), an SX adapter for callers who don't want raw
APL, ACL visibility filtering via `lib/acl/`, federation via fed-sx.
## Status (rolling)
`bash lib/feed/conformance.sh`**0/0** (not yet started)
## Ground rules
- **Scope:** only touch `lib/feed/**` and `plans/feed-on-sx.md`. Do **not** edit
`spec/`, `hosts/`, `shared/`, `lib/apl/**`, or other `lib/<lang>/`. You may
**import** from `lib/apl/` (public API in `lib/apl/apl.sx`); do **not** modify APL.
- **Shared-file issues** go under "Blockers" with a minimal repro; do not fix here.
- **SX files:** use `sx-tree` MCP tools only.
- **Architecture:** an activity is a small dict (`{:actor :verb :object :at :tags}`); a
stream is an APL vector of such dicts. Operations are APL primitives lifted onto
this shape. SX adapter exposes ergonomic API to non-APL callers.
- **Unicode:** raw UTF-8 in `.sx` files. APL glyphs land directly.
- **Commits:** one feature per commit. Keep Progress log updated and tick boxes.
## Architecture sketch
```
Raw activities (any shape) Per-user view
│ ▲
▼ │
lib/feed/normalize.sx lib/feed/timeline.sx
— {:actor :verb :object — (timeline user)
:at :tags} record — applies filter ∘ rank ∘ take
│ ▲
▼ │
lib/feed/stream.sx lib/feed/rank.sx
— APL vector of activities — velocity, recency
— filter, sort, take — TF-IDF-ish over :tags
│ ▲
▼ │
lib/feed/fanout.sx lib/feed/dedupe.sx
— followers vector — group by :object
— activities ∘.× followers — collapse cross-posts
— flatten + dedupe
lib/feed/api.sx lib/feed/fed.sx
— (feed/post activity) — inbox via fed-sx
— (feed/timeline user) — backfill on subscribe
— (feed/notify user)
```
## Phase 1 — Stream model + basic ops
- [ ] `lib/feed/normalize.sx` — activity record schema; coerce arbitrary inputs
- [ ] `lib/feed/stream.sx` — APL vector representation; filter by predicate; sort by
`:at`; take N (`↑`); reverse (`⌽`)
- [ ] `lib/feed/api.sx``(feed/post activity)`, `(feed/all)`
- [ ] `lib/feed/tests/basic.sx` — 15+ cases: post, query, filter, sort
- [ ] `lib/feed/scoreboard.{json,md}`
- [ ] `lib/feed/conformance.sh`
## Phase 2 — Fanout via outer product
- [ ] follower graph: `followers user → vector of user ids`
- [ ] fanout: activities `∘.×` followers → matrix `(activity, follower)` pairs
- [ ] flatten to inbox events vector
- [ ] dedupe — group by `(actor, verb, object)` collapse to one inbox event per
receiver
- [ ] `lib/feed/tests/fanout.sx` — 20+ cases: small graph, mutual follow, popular
actor (high-fanout), cross-post dedupe
## Phase 3 — Aggregation + ranking
- [ ] group-by — `(actor, day) → count` via key-reduce
- [ ] velocity score — recent activity count over window
- [ ] recency score — decay by age
- [ ] composite rank — weighted sum of components
- [ ] top-N per timeline
- [ ] `lib/feed/tests/rank.sx` — 20+ cases: ranking stable on tie, decay shape,
per-user weighting
## Phase 4 — Visibility filter + federation
- [ ] ACL filter — each candidate activity passed through `(acl/permit? viewer :read
activity)`
- [ ] fed-sx outbound — local `feed/post` fans out to remote followers' inboxes
- [ ] fed-sx inbound — peer activities arrive at local inbox
- [ ] backfill on subscribe — request peer history, merge into local stream
- [ ] `lib/feed/tests/integration.sx` — federated timeline with ACL applied
## Progress log
(loop fills this in)
## Blockers
(loop fills this in)

108
plans/flow-on-sx.md Normal file
View File

@@ -0,0 +1,108 @@
# flow-on-sx: Durable DAG Workflows on Scheme
rose-ash needs workflows that survive restarts: content pipelines (write → review →
publish → federate), scheduled jobs (digest emails), multi-step user flows (signup,
confirm, onboard). art-dag is the precedent — DAG-of-tasks with pause/resume at IO
boundaries.
Scheme's `call/cc` + delimited continuations make pause/resume natural: a `suspend`
captures the continuation, serializes it as part of the flow record, and `resume`
re-enters at exactly that point. No state-machine bookkeeping by hand. R7RS-small is
already at 2644/2644 (see kernel/architecture status).
End-state: a Scheme-on-SX layer over the existing scheme runtime, with combinators
for sequence/parallel/branch/retry/timeout/suspend, persistent flow store, and a
federation extension via fed-sx for remote-node execution.
## Status (rolling)
`bash lib/flow/conformance.sh`**0/0** (not yet started)
## Ground rules
- **Scope:** only touch `lib/flow/**` and `plans/flow-on-sx.md`. Do **not** edit
`spec/`, `hosts/`, `shared/`, `lib/scheme/**`, or other `lib/<lang>/`. You may
**import** from `lib/scheme/` (public API via `lib/scheme/scheme.sx`); do **not**
modify Scheme.
- **Shared-file issues** go under "Blockers" with a minimal repro; do not fix here.
- **SX files:** use `sx-tree` MCP tools only.
- **Architecture:** flow combinators are Scheme macros + procedures. Runtime is a
driver loop that walks the flow graph and invokes `call/cc` at `suspend` points.
Persistence layer serializes the continuation + open file/socket placeholders are
forbidden (continuations must be resumable across process restart).
- **art-dag awareness:** read `plans/art-dag*` if it exists for design lineage; do not
import code.
- **Commits:** one feature per commit. Keep Progress log updated and tick boxes.
## Architecture sketch
```
(defflow publish
(sequence
(write-content)
(parallel
(review)
(spell-check))
(cond approved?
(sequence (publish) (federate))
(notify-author))))
lib/flow/spec.sx lib/flow/runtime.sx lib/flow/store.sx
— defflow — driver loop — append-only flow log
— sequence/parallel — node dispatch — checkpoint serialize
— cond/retry/timeout — call/cc at suspend — restart loader
— suspend/resume │ │
▼ ▼
lib/flow/api.sx lib/flow/remote.sx
— (flow/start name args) — fed-sx adapter
— (flow/resume id value) — node-on-peer execution
— (flow/cancel id) — failure handling
```
## Phase 1 — Declarative DAG + sequential execution
- [ ] `lib/flow/spec.sx``defflow` macro, `sequence` combinator
- [ ] node = Scheme thunk; output threads to next node (data flow)
- [ ] `parallel` combinator (sequential semantics for now — TRUE parallelism in Phase 3)
- [ ] runtime executes a flow synchronously, returns final value
- [ ] `lib/flow/api.sx``(flow/start name args)` entry point
- [ ] `lib/flow/tests/basic.sx` — 15+ cases: linear sequence, nested sequences,
data flow between nodes, parallel-with-join
- [ ] `lib/flow/scoreboard.{json,md}`
- [ ] `lib/flow/conformance.sh`
## Phase 2 — Control flow + error handling
- [ ] `cond` combinator — predicate selects branch
- [ ] `retry n [backoff]` — re-runs node up to n times on exception
- [ ] `timeout ms` — bounds node execution
- [ ] `try-catch` — exception handler with reified error
- [ ] error model — exceptions vs explicit `(fail :reason ...)` results
- [ ] `lib/flow/tests/control.sx` — 25+ cases: each combinator + composition
## Phase 3 — Suspend / resume (the showcase)
- [ ] `(suspend reason)``call/cc` captures continuation, returns flow-id to caller
- [ ] `lib/flow/store.sx` — serialize flow state (continuation + open vars)
- [ ] `(flow/resume id value)` — load continuation, inject value, re-enter
- [ ] `(flow/cancel id)` — explicit termination
- [ ] crash recovery — on restart, scan store for paused flows, mark resumable
- [ ] `lib/flow/tests/suspend.sx` — pause-resume scenarios, cancellation, "restart"
scenarios (simulated by re-loading store)
## Phase 4 — Distributed nodes via fed-sx
- [ ] `(remote-node addr fn args)` — execute node on a federation peer
- [ ] failure semantics — retry on different peer, fall through to local
- [ ] persistence across instances — flow state replicates via fed-sx
- [ ] handoff — flow started here can resume on a peer if the local instance is down
- [ ] `lib/flow/tests/distributed.sx` — federated flow scenarios (mock fed-sx in tests)
## Progress log
(loop fills this in)
## Blockers
(loop fills this in)

451
plans/mod-on-sx.md Normal file
View File

@@ -0,0 +1,451 @@
# mod-on-sx: Moderation on Prolog
rose-ash needs moderation infrastructure: reports flagged by users, automated
classifications (spam, abuse), tiered escalation (auto → human → appeal), audit
trails. Each decision is the conclusion of a backtracking search over evidence and
policy rules — exactly what Prolog does.
Where acl-sx says "may this happen?", mod-sx says "should this stay?" The former is
a positive decision (proof of grant); the latter often a negative one (proof of
violation), and policy chains naturally backtrack: if the first rule doesn't apply,
try the next.
End-state: a Prolog-on-SX layer for moderation policy declaration and evaluation,
with persistent report lifecycle, audit log, escalation state machine, and
federation extension.
## Status (rolling)
`bash lib/mod/conformance.sh`**390/390** (roadmap + 19 extensions complete)
## Ground rules
- **Scope:** only touch `lib/mod/**` and `plans/mod-on-sx.md`. Do **not** edit
`spec/`, `hosts/`, `shared/`, `lib/prolog/**`, or other `lib/<lang>/`. You may
**import** from `lib/prolog/` (public API in `lib/prolog/prolog.sx`); do **not**
modify Prolog.
- **Shared-file issues** go under "Blockers" with a minimal repro; do not fix here.
- **SX files:** use `sx-tree` MCP tools only.
- **Architecture:** policies are Prolog rules over `report(...)` and `evidence(...)`
facts. Decisions are query results. Proof trees become audit records. The state
machine for report lifecycle is separate (an SX module on top).
- **Shared with acl-sx:** rule-engine plumbing may be liftable into `lib/guest/`.
Watch for it; flag in Progress log but do not extract until both subsystems are
past Phase 2.
- **Commits:** one feature per commit. Keep Progress log updated and tick boxes.
## Architecture sketch
```
Report Decision
{:by :about :reason :at} {:action :proof :next-state}
│ ▲
▼ │
lib/mod/schema.sx lib/mod/engine.sx
— report/4, evidence/2, — query Prolog with report fact
classification/3 predicates — extract proof tree
│ ▲
▼ │
lib/mod/policy.sx lib/mod/lifecycle.sx
— rule syntax → Prolog — state machine
— action heads: — open → triaged → decided
{:keep :hide :remove — appeal handling
:escalate :ban} │
│ ▼
▼ lib/mod/audit.sx
lib/mod/api.sx — append-only decision log
— (mod/report ...) — proof tree persistence
— (mod/decide report) — query API
— (mod/appeal id)
lib/mod/fed.sx
— cross-instance reports via fed-sx
— decision sharing / trust model
```
## Phase 1 — Report representation + simple policy
- [x] `lib/mod/schema.sx``report(id, by, about)`, `classification(id, kind)`,
`report_count(subject, n)` Prolog facts; keyword classifier derives evidence
- [x] `lib/mod/policy.sx``mod/mk-rule` + ordered `mod/default-rules`; conditions
(`:classification`, `:count-at-least`) compile to Prolog goals; `policy_action/3`
clauses, last clause `true` so every report yields at least `:keep`
- [x] `lib/mod/engine.sx``(mod/decide-report r reports rules)` queries
`policy_action(Id, Action, Rule)` with `pl-query-one` (clause order = precedence);
returns a decision dict `{:action :rule :report-id :proof}` carrying the why
- [x] `lib/mod/api.sx` — registry + `(mod/report by about reason)`, `(mod/decide id)`
- [x] `lib/mod/tests/decide.sx` — 31 cases: spam/abuse keyword, repeated→escalate,
no-rule→keep, precedence (spam beats repeated), proof shape, registry ids
- [x] `lib/mod/scoreboard.{json,md}`
- [x] `lib/mod/conformance.sh`
## Phase 2 — Evidence + audit trail
- [x] evidence accumulation — `report :evidence` list; `mod/attach-evidence` +
api `mod/add-evidence`; asserted as `evidence(Id, 'kind', 'val')` facts;
new `:evidence` condition + `reviewer-remove` rule consume it
- [x] proof tree from Prolog derivation — `mod/proof-goals` re-queries each body
goal (id bound) against the same DB, recording goal text, solved?, and the
bindings that satisfied it (e.g. count goal yields N=3, S=subject)
- [x] `lib/mod/audit.sx` — append-only log: monotonic `:seq`, decision + proof +
evidence snapshot; never mutates prior entries
- [x] `(mod/audit id)` retrieval (+ `mod/audit-latest`, `mod/audit-all`, count)
- [x] `lib/mod/tests/audit.sx` — 29 cases: proof goal text/bindings, evidence-driven
decisions, append-only ordering, per-report retrieval, snapshot-at-decision-time
## Phase 3 — Escalation + lifecycle state machine
- [x] state machine: `lib/mod/lifecycle.sx` — `:open → :triaged → :decided →
:appealed → :final` as a pure SX module over the engine; transition table guards
illegal moves (sets `:error`, leaves state); immutable cases with `:history`
- [x] auto-tier: `mod/case-triage` runs the engine; terminal action (hide/remove/
keep) → tier `auto`, `mod/case-resolve` advances to `:decided`
- [x] human-tier: `:escalate` action → tier `human`; `mod/case-resolve` is blocked
(sets `:error`); `mod/case-review` attaches evidence, re-decides, advances
- [x] appeal: `mod/case-appeal` attaches appeal evidence + re-runs the engine; new
`exonerated-keep` rule (top precedence) lets exoneration override a prior `:hide`
- [x] `(mod/appeal id new-evidence)` API — lifecycle façade over a case registry in
api.sx (`mod/triage` / `resolve` / `review` / `appeal` / `finalize`), logging
each committed decision to the audit trail
- [x] `lib/mod/tests/escalation.sx` — 46 cases: transition guards, auto/human tiers,
blocked resolve, full appeal-override traversal, history, api façade
## Phase 4 — Federation
- [x] cross-instance reports — `mod/fed-receive-report peer …` ingests a peer's
report into the local registry, tagging origin; `mod/report-origin` resolves it
(local reports default to `"local"`); the engine decides federated reports
unchanged
- [x] decision sharing — `mod/fed-share-decision decision peers` pushes messages to
the mock outbox (`mod/fed-send!` is the seam the real fed-sx transport replaces)
- [x] trust model — `mod/fed-receive-decision` applies a peer's decision locally
ONLY when `(mod/trusted? peer :mod)`; otherwise it lands in the advisory log,
unapplied. `mod/grant-trust` / `mod/revoke-trust` manage the trust registry
- [x] revocation — `mod/fed-revoke!` marks the applied action revoked + emits a
revocation message to the origin; `mod/fed-revoke-if-invalidated` re-runs the
engine and revokes only when the action no longer holds (proof invalidated)
- [x] `lib/mod/tests/fed.sx` — 26 cases: trust grant/scope/revoke, cross-instance
ingest + origin, outbox sharing, advisory-vs-trusted apply, revocation +
invalidation (exoneration flips hide→keep → revoked)
## Extensions (post-roadmap)
- [x] **Ext 1 — negation-as-failure** (`lib/mod/tests/extensions.sx`, +14). Report
`:attrs`; policy conditions `(:attr "x")` → `attr(Id, x)` and `(:not <cond>)` →
`not(<cond>)` (the Prolog supports `not/1` and `\+/1` as *functors*, not the
prefix `\+` operator). Closed-world example: "hide spam UNLESS author verified".
Default policy untouched — demonstrated via custom rule sets, so all 132 base
tests stay green.
- [x] **Ext 2 — weighted/aggregate scoring** (+8). Report `:signals` ({:kind
:weight}) project to `signal(Id, 'kind', weight)` facts; condition
`(:score-at-least N)` → `aggregate_all(sum(W), signal(Id, _, W), T), T >= N`.
Many weak signals accumulate past a threshold — genuine Prolog arithmetic
aggregation. Default policy untouched.
- [x] **Ext 3 — proof explanation** (`lib/mod/explain.sx`, +10). `mod/explain`
renders a decision into a readable "why": action + rule, evidence line, and the
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 19 — end-to-end triage pipeline** (`lib/mod/pipeline.sx`, +15).
`mod/triage-pipeline domain r reports actor` runs a report through domain-policy
decision → explanation → AP activity → wire, returning the full bundle. The test
is a genuine integration across 5 modules including a federated handoff (market
decision → wire → peer → trust-gated apply). The capstone that proves the
independently-built modules compose.
- [x] **Ext 18 — ergonomic defrule / ruleset** (`lib/mod/defrule.sx`, +11). The
roadmap's `(defrule …)` surface, done with `&rest` variadics (no macro needed —
conditions are already plain data): `mod/defrule` collects trailing conditions,
`mod/ruleset` assembles rules. Produces structurally identical rules to `mk-rule`
and works in the engine unchanged.
- [x] **Ext 17 — per-domain policy registry** (`lib/mod/policies.sx`, +14).
`mod/register-policy! domain rules` + `mod/decide-in domain r reports` give each
rose-ash domain (blog/market/events/…) its own rule set; unregistered domains
fall back to default-rules so a new domain is never unmoderated. Same spam report
→ :remove under a strict market policy, :hide under blog's default.
- [x] **Ext 16 — ActivityPub-shaped export** (`lib/mod/activity.sx`, +17).
`mod/decision->activity` maps a decision to a moderation verb (remove→Delete,
ban→Block, hide/escalate→Flag, keep→no activity) shaped like an AP activity
({:type :actor :object :summary}), the precise mod action preserved in :action.
`mod/decisions->activities` batch-exports, dropping keeps — ready for the
platform's AP event bus / federated peers.
- [x] **Ext 15 — disjunctive conditions** (`policy.sx` + `tests/disjunction.sx`,
+10). `(:any (list c1 c2 …))` compiles to Prolog disjunction `(g1 ; g2 ; …)`,
completing the condition boolean algebra (AND via the :when list, `:not`, `:any`).
Composes recursively — `:any` over `:not`/`:attr`/classification, and ANDs with
other conditions in the same rule. One rule now covers "spam OR abuse".
- [x] **Ext 14 — decision wire format** (`lib/mod/wire.sx`, +16). The bytes that
cross `fed/fed-send!`: `mod/decision->wire` emits a versioned pipe-delimited line
(`MOD1|r1|hide|spam-hide`), `mod/wire->decision` parses it back (`mod/wire-valid?`
guards). Built `mod/split-char` over `slice`/`len` (loaded env has no split).
Integration test exercises the full path: serialize → wire → deserialize →
`fed-receive-decision` trust-gating (untrusted→advisory, trusted→applied).
- [x] **Ext 13 — SLA sweep over pending cases** (`lib/mod/sla.sx`, +15). Composes
lifecycle (Phase 3) with time (Ext 12): a timed-case pairs a case with the tick
it entered its state; `mod/overdue?` flags pending cases (open/triaged/appealed)
past a deadline; `mod/sla-sweep` returns the breached report ids. Terminal states
never breach. Pure overlay — lifecycle stays timeless, the caller stamps entry.
- [x] **Ext 12 — temporal burst detection** (`lib/mod/temporal.sx`, +15). Reports
gain an `:at` tick (deterministic, supplied — never clock-read).
`mod/decide-temporal now window` counts reports about the subject within
`[now-window, now]`, asserts `burst_count/2`, and a `(:burst-at-least K)` rule
fires only on a real burst. Verified: 3 reports at ticks 10/11/12 → hide;
3 reports at 1/2/12 (window 5) → keep, while the plain count rule escalates both.
- [x] **Ext 11 — batch triage + corpus analytics** (`lib/mod/batch.sx`, +17).
`mod/decide-batch` triages a queue; `mod/action-histogram` summarizes outcomes by
action; `mod/rule-coverage` / `mod/never-fired` measure which rules fire across a
corpus — the *empirical* complement to lint's static unreachable check (Ext 5):
lint finds rules that can't fire, never-fired finds rules that didn't.
- [x] **Ext 10 — policy what-if / impact** (`lib/mod/whatif.sx`, +13).
`mod/decision-diff` compares one report's action under two rule sets;
`mod/policy-impact` runs a batch and returns only the reports whose decision
flips; `mod/impact-count` / `mod/impact-report` summarize. Lets a team measure a
policy change before shipping it (e.g. "removing spam-hide flips r1 hide→keep").
- [x] **Ext 9 — policy dry-run trace** (`lib/mod/trace.sx`, +15). `mod/trace-rules`
evaluates a report against every rule and returns each rule's proved/unproved
status + its goal-by-goal derivation, so an unproved rule shows which goal
failed. `mod/first-proved` = the winner (engine precedence), `mod/proved-rules`
the full firing set, `mod/trace-report` a `[fires]`/`[ - ]` rendering. Answers
"why didn't my rule fire?" without instrumenting the engine.
- [x] **Ext 8 — quorum over distinct reporters** (`lib/mod/quorum.sx`, +9). Anti-
brigade: `(:reporters-at-least N)` compiles to `setof(Br, report(_, Br, Sr), Bsr),
length(Bsr, Nr), Nr >= N` — distinct reporters, not raw report count.
`mod/decide-quorum` asserts every report's `report/3` fact (the base engine only
asserts the decided one) so Prolog can aggregate reporters. Verified one user
filing 3 reports stays `:keep` under quorum while the count rule would escalate.
(Substrate note: `^` existential doesn't parse; `setof(B, p(_, B, S), …)` with `_`
yields the distinct set in a single solution here.)
- [x] **Ext 7 — repeat-offender escalation** (`lib/mod/offenders.sx`, +19). The
audit log as evidence: `mod/subject-sanctions` counts prior hide/remove/ban
decisions about a subject; `mod/decide-escalating id k` decides normally then
upgrades a *sanction* to `:ban` when the subject already has ≥k prior sanctions.
Non-sanction outcomes (keep/escalate) pass through untouched. First decision
whose input spans history beyond the single report — read from the trail, not
re-derived.
- [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;
`mod/has-catchall?` checks every report gets a decision; `mod/duplicate-rule-names`
+ `mod/rules-ok?` give a one-call well-formedness verdict. No engine run needed.
- [x] **Ext 4 — report linking / dedup** (`lib/mod/link.sx`, +12). `mod/related-ids`
and `mod/reporters-of` find reports about a subject via a Prolog relational query
(`report(Id, _, 'subject')`) — the policy substrate reused for retrieval.
`mod/dedup-reports` collapses identical reports (reporter|subject|reason key,
case-insensitive); `mod/distinct-reporters-of` counts unique reporters.
## Shared-plumbing extraction — evaluated post-merge, DECLINED
Both layers now live on architecture; the extraction was evaluated by reading
both implementations side by side. **Finding: do not extract — the convergence is
in module *names* only, not implementations.** The engines and decision models
genuinely differ, so a shared module would be premature abstraction that ages
badly. (This reverses the pre-read note that listed audit + fed trust/outbox as
candidates; reading the code showed they don't actually share.)
- **Federation — zero shared code.** mod gates trust in SX (a `{:peer :scope}`
registry + `grant`/`revoke`/`trusted?`) and shares *decisions* (outbox,
advisory/applied logs, `receive-decision`). acl gates trust *inside Datalog*
(`trust(Peer,L)` / `level_covers` facts + an engine rule re-checked per query)
and shares *facts* (`fetch`/`collect`/`build-db`, `assert!`/`retract!`). acl has
no trust registry, no `trusted?`, no outbox. Opposite architectures — the only
common token is the word "trust."
- **Audit — only a ~5-fn core overlaps, and it diverges.** Entry shapes differ
entirely (mod `{:action :rule :proof :evidence :report-id :seq}` vs acl
`{:allowed? :act :subj :res :seq}`); seq base differs (acl 0, mod 1, both
test-visible); op sets barely intersect (mod: by-`report-id` + `latest`; acl:
`tail`/`snapshot`/`restore`/`serialize`); even the list idiom differs (acl
`append!`+copy vs mod pure `append`+`set!`). A shared module would also have to
satisfy two different restricted eval envs (prolog- vs datalog-loaded). Cost
(shared module + refactor both + rewrite acl's serialize/snapshot onto a foreign
core + cross-env risk + coupling two independent loops) far exceeds the benefit
(dedup ~5 trivial lines that don't even agree on seq-base or mutation idiom).
- **Engines + `explain`** were never shareable: Datalog yields derivation trees
natively; mod reconstructs proofs via per-goal `pl-query-all`.
- **Trivia** (`join-with`, `any?`, `str-contains?`, `distinct`) is one-liners, not
worth a module.
**Outcome:** keep mod (Prolog) and acl (Datalog) as parallel independent
implementations. The parallel structure is correct for two different engines; the
shared abstraction is not. Revisit only if a third rule-engine consumer appears
with the *same* trust/audit model (rule of three), not before.
## Progress log
- **Ext 19 — end-to-end triage pipeline, 390/390** (+15). Capstone: one
orchestration call composes domain policy + decide + explain + activity + wire,
and the integration test runs the whole federated path (decide in a domain →
wire → peer → trust-gated apply) across 5 modules. Confirms the subsystem — built
module-by-module — actually composes end to end. mod-sx now spans schema → policy
DSL (boolean algebra + count/score/reporters/burst) → engine + proofs → audit →
lifecycle → SLA → federation (trust/wire/AP) → analytics (trace/whatif/lint/batch)
→ domain policies → pipeline, all on the green lib/prolog substrate, 390 tests.
- **Ext 18 — ergonomic defrule / ruleset, 375/375** (+11). Closes the roadmap's
original `defrule` surface. `fn` supports `&rest` here, and conditions evaluate
to plain data, so no macro is needed — variadic functions give the ergonomics
safely. Equivalence to `mk-rule` is asserted, so it's pure sugar with no new
semantics.
- **Ext 17 — per-domain policy registry, 364/364** (+14). Multi-tenant policy:
the engine already took `rules` as a parameter, so domain-scoping is just a
registry + a default fallback — no engine change. Makes the whole policy
vocabulary (16 prior features) per-domain configurable. Default fallback means
adding a domain can't accidentally leave it unmoderated.
- **Ext 16 — ActivityPub-shaped export, 350/350** (+17). Bridges mod-sx to the
wider rose-ash platform, which propagates cross-domain effects as AP-shaped
activities. Decisions become Flag/Delete/Block activities (keep = no-op); with
the wire format (Ext 14) and fed trust model (Phase 4) the federated moderation
path is now end-to-end: decide → activity/wire → peer → trust-gate → apply.
- **Ext 15 — disjunctive conditions, 333/333** (+10). The condition DSL is now a
full boolean algebra: AND (the :when list), `:not` (NAF), `:any` (Prolog `;`).
cond->goal recurses, so the combinators nest arbitrarily — `:any` of `:not`s, an
`:any` ANDed with a `:not`, etc. — and the proof tree shows the compiled
disjunction verbatim. Maps directly onto Prolog's own control constructs rather
than reimplementing boolean logic in SX.
- **Ext 14 — decision wire format, 323/323** (+16). Fills the federation transport
seam: decisions now serialize to a portable line and parse back, and the
integration test runs the whole federated path end-to-end (serialize on one
instance → trust-gated apply on another). Needed a hand-rolled `split-char`
(loaded env has no split) — over `slice`/`len`, same toolkit as `str-contains?`.
- **Ext 13 — SLA sweep, 307/307** (+15). Two subsystems compose cleanly: lifecycle
states + temporal ticks → "which pending cases have sat too long". Kept lifecycle
pure by having the SLA layer carry entry-time externally (timed-case wrapper)
rather than stamping the case — same separation-of-concerns as keeping the state
machine out of Prolog.
- **Ext 12 — temporal burst detection, 292/292** (+15). Adds the time dimension:
a windowed count distinguishes a burst from slow accumulation, where the plain
count rule cannot. Time is a supplied tick (`:at`), keeping everything
deterministic and testable — no clock primitive. Fifth report field (`:at`)
threaded through the rebuild helpers, same non-breaking pattern as
evidence/attrs/signals; all 277 prior tests stayed green.
- **Ext 11 — batch triage + corpus analytics, 277/277** (+17). Operational layer:
triage a queue, histogram the outcomes, and measure rule coverage over real
data. `never-fired` pairs with lint (Ext 5) — static "can't fire" vs empirical
"didn't fire" — giving policy authors both views of dead rules. Histogram avoids
dict mutation by counting over a fixed action vocabulary.
- **Ext 10 — policy what-if / impact, 260/260** (+13). Decisions are now
comparable across rule sets — diff one report, or batch a whole set and surface
only the flips. Pure SX over `decide-report`, no engine change. Closes the
policy-authoring loop alongside lint (Ext 5) and trace (Ext 9): lint checks
well-formedness, trace explains one report, what-if measures a change's blast
radius before it ships.
- **Ext 9 — policy dry-run trace, 247/247** (+15). Whole-rule-set diagnostics over
the proof machinery: every rule's fire/no-fire and the goal that decided it. The
winner agrees with `decide-report` by construction (first proved = pl-query-one),
cross-checked in a test. Turns the proof tree from a per-decision artifact into a
policy-debugging tool.
- **Ext 8 — quorum over distinct reporters, 232/232** (+9). Distinct-reporter
consensus via Prolog `setof`/`length`, requiring a second engine variant that
asserts all reports (the base engine deliberately scopes facts to the decided
report). Demonstrates the substrate handles set-aggregation, and that the
brigade case (one actor, many reports) is defeated by counting reporters not
reports. `^` existential doesn't parse here — `setof(B, p(_,B,S), …)` with `_`
gives the distinct set in one solution.
- **Ext 7 — repeat-offender escalation, 223/223** (+19). Decisions can now depend
on history: the append-only audit log is read back as evidence, and a subject
with k prior sanctions has its next sanction upgraded to `:ban`. Closes the loop
between audit (Phase 2) and policy — the trail isn't just a record, it feeds
future decisions. Non-sanction outcomes never escalate (verified: a clean post
that the count rule escalates stays `:escalate`, never `:ban`).
- **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?`
is a single well-formedness gate a policy author can assert in their own tests.
- **Ext 4 — report linking / dedup, 176/176** (+12). Relational retrieval
(`related-ids`, `reporters-of`) reuses the Prolog substrate for *querying* report
clusters, not just deciding them — `report(Id, _, 'subject')` by unification.
Dedup is pure SX over a normalized link key. Own suite (`tests/link.sx`) — going
forward, new extensions get their own test file rather than growing
`extensions.sx`. With roadmap + 4 extensions the subsystem now spans schema →
policy DSL (6 condition types) → engine + proofs → audit → lifecycle →
federation → explanation → linking, all on the green `lib/prolog` substrate.
- **Ext 3 — proof explanation, 164/164** (+10). `mod/explain` turns the Phase-2
proof tree into human-readable text — the audit trail's "why" made legible. Pure
SX over existing decision data; no engine change. Renders unification bindings
inline (`{B=ann, N=3, S=dave}`) so a moderator sees exactly which facts proved
the decision.
- **Ext 2 — weighted/aggregate scoring, 154/154** (+8). `:signals` + the
`(:score-at-least N)` condition push aggregation into Prolog
(`aggregate_all(sum(W), …)`), so low-confidence signals can accumulate to a
takedown. The schema's report-rebuild helpers (`report*` / `with-*`) now thread
six fields; each addition stays non-breaking because empty collections project
to empty fact blocks. Default policy and its 132 tests untouched (proven via
custom rule sets).
- **Ext 1 — negation-as-failure, 146/146** (+14). `:attr` and `:not` conditions
give the policy closed-world reasoning. The substrate's negation is a functor
(`not(Goal)`), not the ISO prefix `\+` operator (that doesn't parse here) —
noted for any future negation work. Kept the default rule set and its 132 tests
untouched by proving the feature through custom rule sets instead.
- **Phase 4 complete — 132/132** (+26 fed). **Full roadmap done.** Federation:
cross-instance reports, decision sharing, advisory-by-default trust, revocation.
fed-sx is mocked behind `mod/fed-send!` (in-memory outbox) — the only seam a real
transport must replace. The hard rule is enforced: a peer's decision binds
locally only under `(mod/trusted? peer :mod)`; otherwise it is recorded as a
suggestion and never auto-applied. Revocation composes with the proof model from
Phase 2 — `mod/fed-revoke-if-invalidated` re-runs the *same* engine and undoes a
moderation only when the action it once proved no longer holds (an exoneration
evidence flips hide→keep, triggering revocation + an origin-bound revocation
message).
- **Liftable (acl-sx watch):** the trust registry (`grant`/`revoke`/`trusted?`
over `{:peer :scope}`) and the outbox/send! seam are generic federation
plumbing; candidates for `lib/guest/` if acl-sx grows a federation phase.
- **Phase 3 complete — 106/106** (+46 escalation). Lifecycle state machine,
auto/human tiers, appeal-override, and an api façade. The state machine is a
pure SX module (`lib/mod/lifecycle.sx`) over the engine — policy stays in
Prolog, lifecycle stays out of it, per the design constraint. Cases are
immutable values threaded through transitions; illegal moves set `:error`
rather than throwing (the env's error handling is untested, so this keeps tests
deterministic). Tier logic: triage runs the engine, an `:escalate` action parks
the case at the human tier where `mod/case-resolve` is blocked until
`mod/case-review` supplies evidence. Appeal-override works because the new
`exonerated-keep` rule sits at top precedence — appeal evidence re-runs the same
engine and a higher-precedence clause wins. The api façade (`mod/triage` …
`mod/finalize`) keeps a per-report case registry and logs each committed
decision to the Phase-2 audit trail, so lifecycle + audit compose.
- **Gotcha:** `sx_insert_near` inserts only the FIRST top-level form of a
multi-form source — silently drops the rest (byte count barely changes). For
multi-form additions, rewrite the file with `sx_write_file`.
- **Phase 2 complete — 60/60** (+29 audit). Evidence accumulation, constructive
proof trees, append-only audit log. A decision's `:proof :goals` is a real
derivation: each body goal is re-queried against the same Prolog DB with the
report id bound, so the count rule's proof carries `N=3, S=<subject>` straight
from unification — not a reconstruction. Evidence is asserted as
`evidence(Id, 'kind', 'val')`; the new `reviewer-remove` rule (placed first =
highest precedence) lets human review override automated classification.
`mod/decide` now commits each decision to the audit log with the evidence
snapshot in force at decision time. Unknown predicates in this Prolog fail
gracefully (verified) — so an evidence-less report safely falls through the
reviewer rule without an existence error.
- **Liftable (acl-sx watch):** the proof-tree builder (`mod/proof-goals` —
re-query-each-goal) and the append-only log shape are both generic. Both
subsystems are now past Phase 2; next time either touches plumbing, evaluate
lifting `proof-goals` + the audit-log primitives into `lib/guest/`.
- **Phase 1 complete — 31/31.** Report schema, keyword classifier, policy DSL,
engine, registry api, conformance harness. Decisions are proofs: each carries
`:rule` (matching clause), `:proof {:rule :conditions :evidence :count}`.
Precedence is Prolog clause order resolved by `pl-query-one`; a trailing
`true`-bodied default rule makes "no rule matched" a real `:keep`, not a query
failure. Evidence (spam/abuse classification) derived in SX and asserted as
`classification/2` facts; repeated-report escalation uses a genuine Prolog
join + arithmetic (`report(Id,_,S), report_count(S,N), N >= 3`).
- **Gotcha (env):** loading the prolog libs strips `includes?` (and other
high-level string prims) from the eval env — only the set the prolog
tokenizer itself uses survives (`slice`, `len`, `nth`, `=`, `join`,
`downcase`, `map`, `reduce`, `append!`). Implemented `mod/str-contains?` over
`slice`/`len` rather than relying on `includes?`. Watch for this in later
phases — stick to the blessed primitive set.
- **Liftable (acl-sx watch):** `mod/join-with`, `mod/str-contains?`, `mod/any?`,
and the rule→clause compilation shape are generic rule-engine plumbing. Do not
extract to `lib/guest/` until both mod-sx and acl-sx are past Phase 2.
## Blockers
(none)

106
plans/search-on-sx.md Normal file
View File

@@ -0,0 +1,106 @@
# search-on-sx: Full-text + structured search on Haskell
rose-ash needs search across pages, posts, threads, federated content. Tokenize,
index, query, rank, filter by visibility. Typed ADTs make query parsing clean,
lazy lists make posting-list iteration efficient, and Haskell-on-SX is at 1514/1514.
End-state: a Haskell-on-SX layer with inverted index, query AST, boolean +
phrase + ranked queries (TF-IDF, BM25), ACL-aware post-filter, and a federation
extension that merges per-peer indices.
## Status (rolling)
`bash lib/search/conformance.sh`**0/0** (not yet started)
## Ground rules
- **Scope:** only touch `lib/search/**` and `plans/search-on-sx.md`. Do **not** edit
`spec/`, `hosts/`, `shared/`, `lib/haskell/**`, or other `lib/<lang>/`. You may
**import** from `lib/haskell/` (public API in `lib/haskell/haskell.sx`); do **not**
modify Haskell.
- **Shared-file issues** go under "Blockers" with a minimal repro; do not fix here.
- **SX files:** use `sx-tree` MCP tools only.
- **Architecture:** index = `Map Term [(DocId, [Pos])]`. Query AST = ADT. Eval =
fold of posting lists with set ops + ranking math. Ranking is pure (no IO until
result emission).
- **Commits:** one feature per commit. Keep Progress log updated and tick boxes.
## Architecture sketch
```
Document Query
{:id :text :tags} "alice AND bob OR phrase \"x y\""
│ │
▼ ▼
lib/search/tokenize.sx lib/search/parse.sx
— tokenize :: Text → [Term] — parse :: Text → Query
— normalize (lowercase, strip) — Query = Term | And | Or
— (optionally) stem | Not | Phrase
│ │
▼ ▼
lib/search/index.sx lib/search/eval.sx
— Map Term [(DocId, [Pos])] — eval :: Index → Query → [DocId]
— insert / delete / lookup — boolean + phrase positions
— persistence (optional later) │
│ ▼
└────────────────► lib/search/rank.sx
— TF-IDF / BM25 scoring
— top-N
lib/search/api.sx
— (search/index doc)
— (search/query q)
— (search/top n q)
lib/search/fed.sx
— federated query (merge peer results)
— ACL filter post-merge
```
## Phase 1 — Tokenize + index
- [ ] `lib/search/tokenize.sx` — normalize (lowercase, strip punctuation), split on
whitespace, return positions
- [ ] `lib/search/index.sx` — inverted index data structure (typed `Map` from
haskell lib); `insert`, `delete`, `lookup`
- [ ] `lib/search/api.sx``(search/index doc)`, `(search/lookup term)`
- [ ] `lib/search/tests/index.sx` — 15+ cases: tokenize, insert + lookup, update,
delete, multi-doc
- [ ] `lib/search/scoreboard.{json,md}`
- [ ] `lib/search/conformance.sh`
## Phase 2 — Query AST + boolean evaluation
- [ ] Query ADT: `Term Text | And Query Query | Or Query Query | Not Query |
Phrase [Text]`
- [ ] `lib/search/parse.sx` — query syntax parser (boolean operators, quoted phrases)
- [ ] `lib/search/eval.sx` — boolean eval via set ops on posting lists
- [ ] phrase eval — adjacency check using positions
- [ ] `lib/search/tests/boolean.sx` — 25+ cases: term, and, or, not, phrase,
composition, parser edge cases
## Phase 3 — Ranking
- [ ] document frequency tracking — extend index with `df` per term
- [ ] TF-IDF scoring
- [ ] BM25 scoring (configurable k1, b)
- [ ] top-N retrieval (heap-based)
- [ ] `lib/search/tests/rank.sx` — 20+ cases: TF-IDF behavior, BM25 vs TF-IDF,
ranking stability, top-N correctness
## Phase 4 — ACL filter + federation
- [ ] post-filter — each candidate result tested via `(acl/permit? viewer :read doc)`
- [ ] federated query — fan out to peer instances via fed-sx, merge results
- [ ] merge policy — interleave by rank, dedupe by `(peer, doc-id)`
- [ ] `lib/search/tests/integration.sx` — federated search with ACL filter
## Progress log
(loop fills this in)
## Blockers
(loop fills this in)