Compare commits

..

20 Commits

Author SHA1 Message Date
9cfca1d008 flow: reference host driver flow-drive-host/flow-run-host + 4 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
Completes the host ABI from work-queue to driver loop: the host supplies only a
(kind payload) -> answer dispatch fn; flow-drive-host services one tick of pending
requests, flow-run-host ticks until quiescent (bounded). Tested via the art-dag
render -> human-review -> publish pipeline driven entirely by flow-run-host. The
art-dag integration is now: define dispatch, call flow-run-host. 166/166, 11 suites.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 19:33:04 +00:00
3cbf33d2d2 flow: host integration ABI (request/await/host-queue) + 11 tests (Phase 8)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 38s
The seam for hooking flow to art-dag and human-in-the-loop later. (request kind
payload) suspends with a typed (flow-request kind payload) envelope and returns the
host's resume value; await-human/await-render sugar. (flow-host-requests) is the
host work queue: (id kind payload) for every suspended flow awaiting a host effect;
request?/request-kind/request-payload parse a tag. Tests include the art-dag-shaped
driver loop (render -> human-review -> publish). Host owns IO+persistence; flow only
requests (replay-safe). 162/162 across 11 suites.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 19:24:16 +00:00
c2d628e9c3 flow: README — API reference + deterministic-replay contract
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m10s
User-facing docs for the flow engine: the node model, every combinator, the
suspend/resume durability contract (escape-only call/cc -> deterministic replay),
lifecycle/introspection/hygiene API, fed-sx distribution, and substrate notes.
Doc-only; 151/151 unchanged.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:37:10 +00:00
aabb950256 flow: store hygiene flow/gc + flow/forget + 9 tests
Some checks are pending
Test, Build, and Deploy / test-build-deploy (push) Waiting to run
flow/gc drops terminal (done/cancelled) records, keeps live suspended flows, returns
count removed; flow/forget id drops one terminal record and refuses live flows.
Bounds unbounded store growth (retention/GC). Bumped conformance sx_server timeout
to 540s for the 10-suite run under CPU contention. 151/151 across 10 suites.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:34:53 +00:00
2b47b2925c flow: end-to-end integration suite + 10 tests (Phase 7)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 54s
Realistic flows composing every phase: an order pipeline (validate via attempt ->
payment suspend -> branch -> ledger federation via remote-node) and an onboarding
flow, each run through the full lifecycle including a simulated crash (export/wipe/
import) and a peer handoff mid-flow, with flow/pending|status|result introspection.
142/142 across 9 suites.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:17:40 +00:00
d9b9da3843 flow: railway attempt combinator — fail-value short-circuit + 10 tests (Phase 6)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 55s
(attempt n1 n2 ...) threads like sequence but stops at the first node returning a
(fail ...) value, returning that failure. Makes the fail/recover error model
compose into validation/ETL pipelines (railway-oriented). 132/132 across 8 suites.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:09:21 +00:00
0a1b89c975 flow: bounded iteration combinators flow-while/flow-until + 6 tests
Some checks are pending
Test, Build, and Deploy / test-build-deploy (push) Waiting to run
(flow-while pred body max) / (flow-until pred body max) re-run body threading the
value while/until pred holds, capped at max steps for a deterministic bound (no
unbounded loops in pure SX). 122/122 across 7 suites.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 18:02:59 +00:00
0e6ba55647 flow: combinator library — tap, recover, map-flow + 11 tests (Phase 5 complete)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 53s
tap: side-effecting pass-through (returns input). recover: fail-VALUE counterpart
of try-catch (run node; on (fail r) run handler on r). map-flow: run a node over
each item of a list, join results sequentially. 116/116 across 7 suites.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:57:48 +00:00
c1d24eb9b3 flow: operational introspection API — flow/status,result,list,pending + 12 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 55s
flow/status id -> done|suspended|cancelled|unknown; flow/result id -> value or
error; flow/list -> (id status) per flow; flow/pending -> (id waiting-tag) for
suspended flows (operator view of what each awaits). Pure store introspection.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:53:23 +00:00
16cb727406 flow: replication + handoff across instances + 6 tests (Phase 4 complete)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 42s
flow-replicate-to copies the plain-data store export to a peer's replica slot;
flow-restore-from imports it. Handoff = replicate, local instance dies, peer
restores and resumes by id. The replay log survives the move, so all resolved
suspends carry over. Same durable-data mechanism as crash recovery, across
instances. All four phases complete: 93/93.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:48:39 +00:00
f8722b3b08 flow: remote-failover — try peers in order, fall through to local + 6 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 45s
(remote-failover addrs fn local) tries fn on each peer in order, moves to the next
on any raised error, and runs the local node if every peer fails. Threads input,
composes in sequences.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:44:04 +00:00
e1f802cfff flow: remote-node via mock fed-sx transport + 7 tests (Phase 4 begins)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m4s
(remote-node addr fn) runs a node on a federation peer. Transport is the fed-sx
boundary, mocked by a peer registry (flow-peer-register!); raises
flow-remote-unreachable / flow-remote-no-fn. Composes with sequence/suspend/retry.
Also fixes conformance.sh to load remote.sx before api.sx.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:40:25 +00:00
97c7623743 flow: crash recovery — store export/import + resumable scan + 8 tests (Phase 3 complete)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 58s
Records are name-keyed (defflow registers names); flow-store-export nulls live
procs to plain data, flow-store-import! restores, flow-resumable-ids scans for
paused flows. Resume re-resolves the proc by name, so a flow survives a wiped
store (simulated restart). The whole durable model persists only plain data.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:25:47 +00:00
e896deffc8 flow: Phase 3 suspend/resume/cancel via deterministic replay + 17 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 50s
Guest Scheme call/cc is escape-only (re-entry hangs), so durable resume uses
deterministic replay: suspend escapes to the driver; resume re-runs the flow and
replays resolved suspends from a (tag value) log. No live continuation is ever
serialized — persisted state is plain data, survives restart. Adds flow/start
(now state-returning, backward compatible), flow/resume, flow/cancel, store.sx.
Harness reuses one env with a per-test reset (full env rebuild 66x was too slow).

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 17:20:09 +00:00
e762cc2e32 flow: timeout combinator — cooperative step budget + 7 tests (Phase 2 complete)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 22s
(timeout budget node) bounds a node deterministically: nodes opt in via (tick),
budget ticks are allowed, the next raises flow-timeout. No scheduler/clock in pure
SX so the budget is a step count, not wall-clock. Budgets nest and are per-run.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 16:42:16 +00:00
4674620d7e flow: retry combinator — re-run node on raised exceptions + 6 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 30s
(retry n node) re-runs up to n attempts on a raised exception; the last attempt's
exception propagates. Explicit (fail ...) values are NOT retried — they pass through.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 16:39:21 +00:00
f3da3b975a flow: try-catch combinator — reify raised exceptions + 6 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
(try-catch node handler) runs node; on a raised exception calls (handler error)
with the reified error via Scheme guard, returns the handler value.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 16:37:26 +00:00
1731476dc6 flow: error model — fail/failed?/fail-reason failure values + 6 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 29s
Explicit (fail reason) values flow downstream as data and are inspected with
failed?/fail-reason — distinct from raised exceptions (retry/try-catch territory).

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 16:35:40 +00:00
65cbdb8387 flow: branch combinator (conditional) + 6 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 50s
Phase 2 control flow. (branch pred then else) selects then/else node by running
pred on the threaded input; named 'branch' since 'cond' is a Scheme special form.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 16:32:37 +00:00
91ffba9975 flow: Phase 1 declarative DAG — sequence/parallel/defflow combinators + 18 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 31s
Flow combinators as a Scheme prelude loaded onto scheme-standard-env; a flow is a
Scheme procedure input->output, run inside the interpreter (sets up Phase 3 call/cc
suspend). flow/start entry point, conformance runner, scoreboard.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 16:22:22 +00:00
71 changed files with 1896 additions and 5420 deletions

141
lib/flow/README.md Normal file
View File

@@ -0,0 +1,141 @@
# flow — durable DAG workflows on Scheme
`flow` is a workflow engine for rose-ash: content pipelines (write → review →
publish → federate), scheduled jobs, and multi-step user flows (signup, confirm,
onboard) that **survive process restarts**. It is a thin Scheme prelude over the
Scheme-on-SX guest (`lib/scheme/`); a flow runs *inside* the interpreter.
Run the suite: `bash lib/flow/conformance.sh`**151/151 across 10 suites**.
## Model
A **flow** is just a Scheme procedure of one argument — the upstream value:
```
node : input -> output
```
Combinators build composite nodes out of child nodes. A node that ignores its
argument is effectively a thunk. There is no separate "graph" object: composition
*is* function composition, so flows are values you can name, pass, and nest.
```scheme
(defflow publish
(sequence
(lambda (draft) (string-append draft "!"))
(branch (lambda (post) (>= (string-length post) 3))
(remote-node 'fed 'publish)
(flow-const 'rejected))))
(flow/start publish "hello") ; => federated, or a (flow-suspended id tag) state
```
## Building blocks (`spec.sx`)
| Combinator | Meaning |
|---|---|
| `(flow-node f)` / `(flow-id x)` / `(flow-const v)` | leaf nodes |
| `(sequence n ...)` | thread input left-to-right |
| `(parallel n ...)` | fan input to every child, join results into a list (sequential eval) |
| `(map-flow node)` | run `node` over each item of a list input, join results |
| `(flow-while pred body max)` / `(flow-until ...)` | bounded iteration (cap `max` steps) |
| `(defflow name body)` | bind + register a named flow (so it survives restart) |
## Control flow + errors (`spec.sx`)
| Combinator | Meaning |
|---|---|
| `(branch pred then else)` | `pred` on input selects `then`/`else` (`cond` is a Scheme special form) |
| `(retry n node)` | re-run on a *raised exception*, up to `n` attempts |
| `(timeout budget node)` | cooperative **step budget**: nodes call `(tick)`; the `(budget+1)`-th tick raises `flow-timeout` |
| `(try-catch node handler)` | catch a raised exception → `(handler error)` |
| `(fail reason)` / `(failed? x)` / `(fail-reason x)` | explicit failure *values* (flow downstream as data) |
| `(recover node handler)` | the fail-VALUE counterpart of try-catch |
| `(attempt n ...)` | railway sequence: stop at the first node returning a `(fail ...)` |
| `(tap effect)` | run a side effect, return input unchanged |
**Two error channels, on purpose.** Raised exceptions are for *bugs/transients*
(caught by `retry`/`try-catch`). `(fail reason)` values are for *expected business
outcomes* (validation rejected, declined) and compose via `attempt`/`recover`.
## Suspend / resume — the durable core (`spec.sx`, `store.sx`)
The guest Scheme's `call/cc` is **escape-only** — re-invoking a captured
continuation after it returns *hangs* the runtime. So flow does **not** serialize
continuations. Instead it uses **deterministic replay**:
- `(suspend tag)` — if `tag` is already in the replay log, return its logged value;
otherwise escape to the driver as `(flow-suspended tag)`.
- `resume` appends `(tag value)` to the log and **re-runs the flow from the start**.
Already-resolved suspends replay their values; the first unresolved one escapes
again (or the flow completes).
The entire persisted state is the replay log — plain data. No live continuation is
ever stored, so flows survive process restarts and even moves between instances.
> **Author contract:** suspend `tag`s must be unique and deterministic across
> replays, and **all** non-determinism / side effects must go through suspend
> points (so their results are logged) — otherwise they re-run on every replay.
### Lifecycle (`store.sx`)
```scheme
(flow/start flow input) ; raw result if it completes, else (flow-suspended id tag)
(flow/resume id value) ; inject value at the waiting tag, continue
(flow/cancel id) ; terminate; a later resume is rejected
```
### Introspection & hygiene
```scheme
(flow/status id) ; done | suspended | cancelled | unknown
(flow/result id) ; result if done, else (flow-error reason)
(flow/list) ; ((id status) ...)
(flow/pending) ; ((id waiting-tag) ...) — what each suspended flow awaits
(flow/gc) ; drop terminal records, keep live ones; returns count removed
(flow/forget id) ; drop one terminal record (refuses live flows)
```
### Crash recovery
```scheme
(flow-store-export) ; the store as plain data (live procs nulled)
(flow-store-import! d) ; restore the store from exported data
(flow-resumable-ids) ; ids of suspended flows to wake on restart
```
On restart the flow definitions are reloaded (`defflow` re-registers names) and the
exported store reimported; `resume` re-resolves each flow's procedure **by name**.
## Distribution via fed-sx (`remote.sx`)
```scheme
(flow-peer-register! addr table) ; mock a peer's exposed functions (fed-sx boundary)
(remote-node addr fn) ; run a node on a peer
(remote-failover addrs fn local) ; try peers in order, fall through to a local node
(flow-replicate-to addr) ; copy this store to a peer's replica slot
(flow-restore-from addr) ; import a peer's replica (handoff)
```
**Handoff** is crash recovery across instances: replicate → local instance dies →
peer restores the (plain-data) store and resumes. The replay log carries over, so
all resolved suspends survive the move.
## Files
| File | Contents |
|---|---|
| `spec.sx` | combinators (flow-combinators-src / flow-control-src / flow-suspend-src) |
| `store.sx` | durable store, lifecycle, crash recovery, introspection, hygiene |
| `remote.sx` | fed-sx transport (mock peer registry), failover, replication |
| `api.sx` | `flow-make-env` / `flow-run` SX helpers (one cached env, per-test reset) |
| `tests/*.sx` | 10 suites, 151 cases |
| `conformance.sh` | loads substrate + flow layer, runs every suite |
## Notes on the substrate
The guest Scheme (`lib/scheme/`, imported read-only) lacks dotted-rest params
`(a . rest)` and named `let`; combinators use `(lambda args ...)` variadics + top-
level recursion. `cons` is list-only (no dotted pairs), so log/assoc entries are
2-element lists. Strings box as `{:scm-string "..."}`. Timeout is a step budget
because there is no wall clock; `parallel` is sequential for the same reason.

65
lib/flow/api.sx Normal file
View File

@@ -0,0 +1,65 @@
;; lib/flow/api.sx — flow runtime entry points.
;;
;; Builds a Scheme env preloaded with the flow combinators (lib/flow/spec.sx),
;; the durable store + lifecycle (lib/flow/store.sx), the fed-sx remote layer
;; (lib/flow/remote.sx), and the host integration ABI (lib/flow/host.sx), and
;; provides SX helpers to run flow programs.
;;
;; Scheme-level API (available inside flow programs):
;; (flow/start flow input) — run a flow; raw result if it completes, else
;; (flow-suspended id tag). Defined in store.sx.
;; (flow/resume id value) — resume a suspended flow (store.sx)
;; (flow/cancel id) — cancel a flow (store.sx)
;; (suspend tag) — suspension point (spec.sx)
;; (request kind payload) — host request envelope over suspend (host.sx)
;; (remote-node addr fn) — node executed on a federation peer (remote.sx)
;;
;; SX-level helpers (for hosts and tests):
;; (flow-make-env) — fresh standard env + combinators + store + remote + host
;; (flow-run src) — eval a Scheme program string in a reset shared env
;; (flow-run-in env src) — eval a Scheme program string in a given env
;;
;; flow-run reuses ONE env (building the full standard env is expensive) and
;; resets the mutable flow globals before each program, so tests stay isolated
;; without paying for a fresh standard env each time. flow-registry persists (it
;; models reloaded flow definitions surviving a restart).
(define
flow-make-env
(fn
()
(let
((env (scheme-standard-env)))
(flow-load-combinators! env)
(flow-load-store! env)
(flow-load-remote! env)
(flow-load-host! env)
env)))
(define
flow-run-in
(fn (env src) (scheme-eval-program (scheme-parse-all src) env)))
(define
flow-reset-src
"(set! flow-store (list)) (set! flow-next-id 0) (set! flow-replay-log (list)) (set! flow-suspend-k #f) (set! flow-timeout-budget -1) (set! flow-peers (list)) (set! flow-replicas (list))")
(define flow-env-cache false)
(define
flow-shared-env
(fn
()
(begin
(if flow-env-cache nil (set! flow-env-cache (flow-make-env)))
flow-env-cache)))
(define
flow-run
(fn
(src)
(let
((env (flow-shared-env)))
(begin
(scheme-eval-program (scheme-parse-all flow-reset-src) env)
(scheme-eval-program (scheme-parse-all src) env)))))

103
lib/flow/conformance.sh Executable file
View File

@@ -0,0 +1,103 @@
#!/usr/bin/env bash
# flow-on-sx conformance runner — runs all flow test suites in one sx_server process.
#
# Usage:
# bash lib/flow/conformance.sh # run all suites
# bash lib/flow/conformance.sh -v # verbose (list each suite)
set -uo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
fi
if [ ! -x "$SX_SERVER" ]; then
echo "ERROR: sx_server.exe not found." >&2
exit 1
fi
VERBOSE="${1:-}"
# Suites: NAME RUNNER-FN PATH
SUITES=(
"basic flow-basic-tests-run! lib/flow/tests/basic.sx"
"control flow-ctl-tests-run! lib/flow/tests/control.sx"
"suspend flow-sus-tests-run! lib/flow/tests/suspend.sx"
"recovery flow-rec-tests-run! lib/flow/tests/recovery.sx"
"distributed flow-dist-tests-run! lib/flow/tests/distributed.sx"
"api flow-api-tests-run! lib/flow/tests/api.sx"
"combinators flow-cmb-tests-run! lib/flow/tests/combinators.sx"
"railway flow-rail-tests-run! lib/flow/tests/railway.sx"
"integration flow-int-tests-run! lib/flow/tests/integration.sx"
"hygiene flow-hyg-tests-run! lib/flow/tests/hygiene.sx"
"host flow-hst-tests-run! lib/flow/tests/host.sx"
)
TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
EPOCH=1
emit_load () { echo "(epoch $EPOCH)"; echo "(load \"$1\")"; EPOCH=$((EPOCH+1)); }
emit_eval () { echo "(epoch $EPOCH)"; echo "(eval \"$1\")"; EPOCH=$((EPOCH+1)); }
{
emit_load "lib/guest/lex.sx"
emit_load "lib/guest/reflective/env.sx"
emit_load "lib/guest/reflective/quoting.sx"
emit_load "lib/scheme/parser.sx"
emit_load "lib/scheme/eval.sx"
emit_load "lib/scheme/runtime.sx"
emit_load "lib/flow/spec.sx"
emit_load "lib/flow/store.sx"
emit_load "lib/flow/remote.sx"
emit_load "lib/flow/host.sx"
emit_load "lib/flow/api.sx"
for SUITE in "${SUITES[@]}"; do
read -r _NAME _RUNNER FILE <<< "$SUITE"
emit_load "$FILE"
emit_eval "($_RUNNER)"
done
} > "$TMPFILE"
OUTPUT=$(timeout 540 "$SX_SERVER" < "$TMPFILE" 2>&1 || true)
TOTAL_PASS=0
TOTAL_FAIL=0
FAILED_SUITES=()
LAST_DICT_LINES=$(echo "$OUTPUT" | grep -E '^\{:' || true)
I=0
while read -r LINE; do
[ -z "$LINE" ] && continue
P=$(echo "$LINE" | grep -oE ':passed [0-9]+' | awk '{print $2}')
F=$(echo "$LINE" | grep -oE ':failed [0-9]+' | awk '{print $2}')
[ -z "$P" ] && P=0
[ -z "$F" ] && F=0
SUITE_INFO="${SUITES[$I]}"
SUITE_NAME=$(echo "$SUITE_INFO" | awk '{print $1}')
TOTAL_PASS=$((TOTAL_PASS + P))
TOTAL_FAIL=$((TOTAL_FAIL + F))
if [ "$F" -gt 0 ]; then
FAILED_SUITES+=("$SUITE_NAME: $P/$((P+F))")
printf 'X %-12s %d/%d\n' "$SUITE_NAME" "$P" "$((P+F))"
echo "$LINE" | grep -oE ':name "[^"]*"' | sed 's/:name / fail: /'
elif [ "$VERBOSE" = "-v" ]; then
printf 'ok %-12s %d passed\n' "$SUITE_NAME" "$P"
fi
I=$((I+1))
done <<< "$LAST_DICT_LINES"
TOTAL=$((TOTAL_PASS + TOTAL_FAIL))
if [ "$TOTAL" -eq 0 ]; then
echo "ERROR: no suite results parsed. Raw output:" >&2
echo "$OUTPUT" >&2
exit 1
fi
if [ $TOTAL_FAIL -eq 0 ]; then
echo "ok $TOTAL_PASS/$TOTAL flow-on-sx tests passed (${#SUITES[@]} suites)"
else
echo "FAIL $TOTAL_PASS/$TOTAL passed, $TOTAL_FAIL failed:"
for S in "${FAILED_SUITES[@]}"; do echo " $S"; done
exit 1
fi

42
lib/flow/host.sx Normal file
View File

@@ -0,0 +1,42 @@
;; lib/flow/host.sx — the host integration ABI (Phase 8).
;;
;; `suspend` is flow's seam to the outside world, but a bare (suspend tag) is just a
;; signal — every author would invent their own tag shape. This layer defines a
;; stable request/response contract so a host (e.g. an art-dag driver, or a human
;; review UI) can hook in WITHOUT reverse-engineering ad-hoc tags.
;;
;; A flow asks the host to do something and waits for the answer:
;; (request kind payload) — suspend with a typed envelope (flow-request kind
;; payload); evaluates to the host's resume value.
;; (await-human prompt) — request kind=human (a decision point)
;; (await-render recipe) — request kind=render (e.g. an art-dag job)
;; (await-effect kind p) — request of an arbitrary kind
;;
;; The host drives flows by polling its work queue and resuming:
;; (flow-host-requests) — ((id kind payload) ...) for every SUSPENDED flow whose
;; waiting tag is a host request. The host dispatches by kind (render -> submit a
;; Celery job; human -> show UI), then calls (flow/resume id answer).
;; (request? tag) / (request-kind tag) / (request-payload tag) — parse one tag.
;;
;; Reference driver — the host only supplies `dispatch`, a (kind payload) -> answer:
;; (flow-drive-host dispatch) — one tick: service every CURRENTLY pending
;; request (snapshot), resuming each with (dispatch kind payload); returns the
;; count serviced. Resumes may create new requests — serviced on the next tick.
;; (flow-run-host dispatch maxticks) — tick until quiescent (no pending requests)
;; or maxticks reached; returns total requests serviced. Bounded for determinism.
;;
;; Contract: the host owns IO and persistence. flow stays deterministic — a flow
;; never performs IO itself, it only `request`s; the host performs the effect and
;; feeds the result back via resume (which the replay log records, so the effect is
;; not re-run on recovery). Persist with flow-store-export after each transition and
;; flow-store-import! on boot.
(define
flow-host-src
"(define (request kind payload) (suspend (list (quote flow-request) kind payload)))\n (define (request? tag) (and (pair? tag) (eq? (car tag) (quote flow-request))))\n (define (request-kind tag) (car (cdr tag)))\n (define (request-payload tag) (car (cdr (cdr tag))))\n (define (await-human prompt) (request (quote human) prompt))\n (define (await-render recipe) (request (quote render) recipe))\n (define (await-effect kind payload) (request kind payload))\n (define (flow-host-req-step pend)\n (if (null? pend)\n (list)\n (let ((id (car (car pend))) (tag (car (cdr (car pend)))))\n (if (request? tag)\n (cons (list id (request-kind tag) (request-payload tag))\n (flow-host-req-step (cdr pend)))\n (flow-host-req-step (cdr pend))))))\n (define (flow-host-requests) (flow-host-req-step (flow/pending)))\n (define (flow-drive-host-step reqs dispatch)\n (if (null? reqs)\n 0\n (begin\n (flow/resume (car (car reqs)) (dispatch (car (cdr (car reqs))) (car (cdr (cdr (car reqs))))))\n (+ 1 (flow-drive-host-step (cdr reqs) dispatch)))))\n (define (flow-drive-host dispatch) (flow-drive-host-step (flow-host-requests) dispatch))\n (define (flow-run-host dispatch maxticks)\n (if (<= maxticks 0)\n 0\n (let ((n (flow-drive-host dispatch)))\n (if (= n 0) 0 (+ n (flow-run-host dispatch (- maxticks 1)))))))")
(define
flow-load-host!
(fn
(env)
(begin (scheme-eval-program (scheme-parse-all flow-host-src) env) env)))

34
lib/flow/remote.sx Normal file
View File

@@ -0,0 +1,34 @@
;; lib/flow/remote.sx — distributed nodes via fed-sx (Phase 4).
;;
;; A node can execute on a federation peer. The transport is the fed-sx boundary;
;; it is MOCKED in tests by a peer registry mapping addr -> function table. In
;; production flow-transport would issue a fed-sx call; here it dispatches locally.
;;
;; (flow-peer-register! addr table) — register a mock peer. table is a list of
;; (fn-name proc) entries — the functions that peer exposes.
;; (flow-transport addr fn input) — invoke fn on the peer with input. Raises
;; (flow-remote-unreachable) if the addr is unknown, (flow-remote-no-fn) if the
;; peer does not expose fn.
;; (remote-node addr fn) — a node that runs fn on the peer at addr.
;; (remote-failover addrs fn local) — try fn on each peer in addrs in order; on a
;; raised error move to the next peer; if every peer fails, run the `local`
;; node as a fallback.
;;
;; Persistence across instances + handoff. Each instance runs the same flow
;; definitions, so the only thing that needs to cross the wire is the (plain-data)
;; store — exactly flow-store-export from store.sx. Replication pushes that export
;; to a peer's replica slot; handoff = restore the replica on the peer and resume.
;;
;; (flow-replicate-to addr) — copy this instance's store to peer addr's replica
;; (flow-restore-from addr) — import the replica from peer addr (#t / #f)
;; (flow-replica-get addr) — the raw replicated store at addr (or #f)
(define
flow-remote-src
"(define flow-peers (list))\n (define (flow-assoc key alist)\n (if (null? alist)\n #f\n (if (eq? (car (car alist)) key) (car (cdr (car alist))) (flow-assoc key (cdr alist)))))\n (define (flow-peer-register! addr table) (set! flow-peers (cons (list addr table) flow-peers)))\n (define (flow-transport addr fn input)\n (let ((table (flow-assoc addr flow-peers)))\n (if table\n (let ((proc (flow-assoc fn table)))\n (if proc (proc input) (raise (quote flow-remote-no-fn))))\n (raise (quote flow-remote-unreachable)))))\n (define (remote-node addr fn) (lambda (input) (flow-transport addr fn input)))\n (define (flow-failover-step addrs fn input local)\n (if (null? addrs)\n (local input)\n (guard (e (#t (flow-failover-step (cdr addrs) fn input local)))\n (flow-transport (car addrs) fn input))))\n (define (remote-failover addrs fn local)\n (lambda (input) (flow-failover-step addrs fn input local)))\n\n (define flow-replicas (list))\n (define (flow-replicas-remove addr reps)\n (if (null? reps)\n (list)\n (if (eq? (car (car reps)) addr)\n (flow-replicas-remove addr (cdr reps))\n (cons (car reps) (flow-replicas-remove addr (cdr reps))))))\n (define (flow-replicate-to addr)\n (set! flow-replicas (cons (list addr (flow-store-export)) (flow-replicas-remove addr flow-replicas))))\n (define (flow-replica-get addr) (flow-assoc addr flow-replicas))\n (define (flow-restore-from addr)\n (let ((data (flow-replica-get addr)))\n (if data (begin (flow-store-import! data) #t) #f)))")
(define
flow-load-remote!
(fn
(env)
(begin (scheme-eval-program (scheme-parse-all flow-remote-src) env) env)))

19
lib/flow/scoreboard.json Normal file
View File

@@ -0,0 +1,19 @@
{
"total": 166,
"passed": 166,
"failed": 0,
"suites": {
"basic": { "passed": 18, "total": 18 },
"control": { "passed": 31, "total": 31 },
"suspend": { "passed": 17, "total": 17 },
"recovery": { "passed": 8, "total": 8 },
"distributed": { "passed": 19, "total": 19 },
"api": { "passed": 12, "total": 12 },
"combinators": { "passed": 17, "total": 17 },
"railway": { "passed": 10, "total": 10 },
"integration": { "passed": 10, "total": 10 },
"hygiene": { "passed": 9, "total": 9 },
"host": { "passed": 15, "total": 15 }
},
"phases": { "phase1": "done", "phase2": "done", "phase3": "done", "phase4": "done", "phase5": "done", "phase6": "done", "phase7": "done", "phase8": "done" }
}

53
lib/flow/scoreboard.md Normal file
View File

@@ -0,0 +1,53 @@
# flow-on-sx Scoreboard
**All tests pass: 166 / 166 across 11 suites. Phases 1-8 complete.**
`bash lib/flow/conformance.sh`
## Per-suite breakdown
| Suite | Passing | Covers |
|-------|--------:|--------|
| basic | 18 | Phase 1: single nodes, linear sequence, data-flow threading, defflow, parallel fan/join, nested composition, publish-shaped flow |
| control | 31 | Phase 2: `branch` (6); error model `fail`/`failed?`/`fail-reason` (6); `try-catch` (6); `retry n` (6); `timeout` cooperative step budget (7) |
| suspend | 17 | Phase 3: suspend/resume/cancel via deterministic replay; multi-step, replay determinism, lifecycle guards, suspend-in-branch |
| recovery | 8 | Phase 3: crash recovery — store export/import, resumable scan, restart-at-every-step, replay-log survival |
| distributed | 19 | Phase 4: `remote-node` (7); `remote-failover` (6); replication + handoff across instances (6) |
| api | 12 | Phase 5: introspection — `flow/status`, `flow/result`, `flow/list`, `flow/pending` |
| combinators | 17 | Phase 5: `tap`, `recover` (fail-value), `map-flow` fan-over-list, `flow-while`/`flow-until` bounded iteration |
| railway | 10 | Phase 6: `attempt` — fail-value short-circuiting sequence + recover rejoin |
| integration | 10 | Phase 7: end-to-end order + onboarding flows composing every phase (suspend, branch, federation, crash recovery, handoff, introspection) |
| hygiene | 9 | Phase 5: `flow/gc` (prune terminal flows), `flow/forget` (drop one terminal record) |
| host | 15 | Phase 8: host ABI — `request`/`await-human`/`await-render`, `flow-host-requests` queue, `flow-run-host` reference driver; art-dag-shaped render→review→publish loop |
## Architecture
Flow combinators are a **Scheme prelude** (`lib/flow/spec.sx`) loaded onto
`scheme-standard-env`. A flow is a Scheme procedure `input -> output`. The whole
flow executes inside the Scheme interpreter, so Phase 3's `suspend` (call/cc) will
capture the flow continuation directly.
- `lib/flow/spec.sx` — combinators: `flow-node`, `flow-id`, `flow-const`,
`sequence`, `parallel`, `defflow`; `flow-load-combinators!`.
- `lib/flow/api.sx``flow/start` (Scheme); `flow-make-env`, `flow-run`,
`flow-run-in` (SX helpers).
- `lib/flow/tests/basic.sx` — 18 cases.
- `lib/flow/conformance.sh` — loads substrate + flow layer, runs suites.
## Semantics notes
- **node** = 1-arg Scheme procedure; the upstream value is the argument. A node
ignoring its argument is effectively a thunk.
- **sequence** threads left-to-right; empty sequence = identity.
- **parallel** fans the same input to every branch and joins results into a list.
Evaluation is **sequential** for now; true concurrency arrives in Phase 3.
## Phases
- [x] Phase 1 — Declarative DAG + sequential execution (combinators + 18 tests, `flow/start`)
- [x] Phase 2 — Control flow + error handling (branch, error model, try-catch, retry, timeout)
- [x] Phase 3 — Suspend/resume (suspend/resume/cancel + crash recovery via deterministic replay)
- [x] Phase 4 — Distributed nodes via fed-sx (remote-node, failover, replication + handoff)
- [x] Phase 5 — Operational API + combinators (introspection, tap, recover, map-flow)
- [ ] Phase 3 — Suspend / resume (the showcase)
- [ ] Phase 4 — Distributed nodes via fed-sx

61
lib/flow/spec.sx Normal file
View File

@@ -0,0 +1,61 @@
;; lib/flow/spec.sx — flow combinators as a Scheme prelude.
;;
;; A flow is a Scheme procedure of one argument: the upstream value.
;; node : input -> output
;; A leaf node ignoring its argument is effectively a thunk. Combinators
;; build composite nodes out of child nodes. The whole flow runs INSIDE the
;; Scheme interpreter.
;;
;; Phase 1 combinators (flow-combinators-src):
;; flow-node / flow-id / flow-const / sequence / parallel / defflow
;; defflow both binds the flow and registers it by name (flow-register!, in
;; store.sx) so it can be re-resolved after a process restart.
;; map-flow (Phase 5): run a node over each item of a list input, join results.
;; flow-while / flow-until (Phase 5): bounded iteration — re-run body, threading
;; the value, while/until pred holds, up to `max` steps (deterministic bound; no
;; unbounded loops in pure SX).
;;
;; Phase 2 combinators (flow-control-src):
;; branch / fail / failed? / fail-reason / try-catch / retry / timeout / tick
;; tap (Phase 5): side-effecting pass-through (returns input unchanged).
;; recover (Phase 5): the fail-VALUE counterpart of try-catch.
;; attempt (Phase 6): railway sequence — thread nodes left-to-right but stop at
;; the first node that returns a (fail ...) value, returning that failure.
;;
;; Phase 3 suspend core (flow-suspend-src):
;; The guest Scheme's call/cc is ESCAPE-ONLY (re-invoking a captured k after it
;; returns hangs the runtime), so suspend/resume CANNOT re-enter a continuation.
;; Instead, durability uses DETERMINISTIC REPLAY: a flow re-runs from the start
;; on each resume; suspend points that have already been resolved replay their
;; logged value, and the first unresolved suspend escapes back to the driver.
;; The entire persisted state is the replay log (plain (tag value) data), which
;; survives process restart — no live continuation is ever serialized.
;;
;; (suspend tag) — if tag is in the replay log, return its value; else escape
;; to the driver as (flow-suspended tag). tags must be unique & deterministic
;; across replays. ALL effects/non-determinism must go through suspend so their
;; results are logged (otherwise they re-run on every replay).
;; (flow-drive flow input log) — run flow with the given replay log; returns
;; (flow-done result) or (flow-suspended tag).
(define
flow-combinators-src
"(define (flow-node f) f)\n (define (flow-id input) input)\n (define (flow-const v) (lambda (input) v))\n (define (flow-seq-step ns v)\n (if (null? ns) v (flow-seq-step (cdr ns) ((car ns) v))))\n (define sequence (lambda ns (lambda (input) (flow-seq-step ns input))))\n (define parallel (lambda ns (lambda (input) (map (lambda (n) (n input)) ns))))\n (define (map-flow node) (lambda (items) (map node items)))\n (define (flow-while-step pred body input n)\n (if (<= n 0)\n input\n (if (pred input) (flow-while-step pred body (body input) (- n 1)) input)))\n (define (flow-while pred body max) (lambda (input) (flow-while-step pred body input max)))\n (define (flow-until-step pred body input n)\n (if (<= n 0)\n input\n (if (pred input) input (flow-until-step pred body (body input) (- n 1)))))\n (define (flow-until pred body max) (lambda (input) (flow-until-step pred body input max)))\n (define-syntax defflow\n (syntax-rules ()\n ((defflow nm body)\n (begin (define nm body) (flow-register! (quote nm) nm)))))")
(define
flow-control-src
"(define (branch pred then else)\n (lambda (input) (if (pred input) (then input) (else input))))\n (define (fail reason) (list (quote flow-fail) reason))\n (define (failed? x) (and (pair? x) (eq? (car x) (quote flow-fail))))\n (define (fail-reason x) (car (cdr x)))\n (define (recover node handler)\n (lambda (input)\n (let ((r (node input)))\n (if (failed? r) (handler (fail-reason r)) r))))\n (define (tap effect)\n (lambda (input) (begin (effect input) input)))\n (define (flow-attempt-step ns v)\n (if (failed? v)\n v\n (if (null? ns) v (flow-attempt-step (cdr ns) ((car ns) v)))))\n (define attempt (lambda ns (lambda (input) (flow-attempt-step ns input))))\n (define (try-catch node handler)\n (lambda (input) (guard (e (#t (handler e))) (node input))))\n (define (flow-retry-step n node input)\n (guard (e (#t (if (<= n 1) (raise e) (flow-retry-step (- n 1) node input))))\n (node input)))\n (define (retry n node) (lambda (input) (flow-retry-step n node input)))\n (define flow-timeout-budget -1)\n (define (tick)\n (if (< flow-timeout-budget 0)\n 0\n (begin\n (set! flow-timeout-budget (- flow-timeout-budget 1))\n (if (< flow-timeout-budget 0)\n (raise (quote flow-timeout))\n flow-timeout-budget))))\n (define (timeout budget node)\n (lambda (input)\n (let ((saved flow-timeout-budget))\n (set! flow-timeout-budget budget)\n (guard (e (#t (begin (set! flow-timeout-budget saved) (raise e))))\n (let ((result (node input)))\n (set! flow-timeout-budget saved)\n result)))))")
(define
flow-suspend-src
"(define flow-replay-log (list))\n (define flow-suspend-k #f)\n (define (flow-log-lookup tag log)\n (if (null? log)\n (list #f #f)\n (if (eq? (car (car log)) tag)\n (list #t (car (cdr (car log))))\n (flow-log-lookup tag (cdr log)))))\n (define (suspend tag)\n (let ((hit (flow-log-lookup tag flow-replay-log)))\n (if (car hit)\n (car (cdr hit))\n (flow-suspend-k (list (quote flow-suspended) tag)))))\n (define (flow-drive flow input log)\n (set! flow-replay-log log)\n (call/cc\n (lambda (k)\n (set! flow-suspend-k k)\n (list (quote flow-done) (flow input)))))")
(define
flow-load-combinators!
(fn
(env)
(begin
(scheme-eval-program (scheme-parse-all flow-combinators-src) env)
(scheme-eval-program (scheme-parse-all flow-control-src) env)
(scheme-eval-program (scheme-parse-all flow-suspend-src) env)
env)))

45
lib/flow/store.sx Normal file

File diff suppressed because one or more lines are too long

79
lib/flow/tests/api.sx Normal file
View File

@@ -0,0 +1,79 @@
;; lib/flow/tests/api.sx — Phase 5: operational introspection API.
(define flow-api-pass 0)
(define flow-api-fail 0)
(define flow-api-fails (list))
(define
flow-api-test
(fn
(name actual expected)
(if
(= actual expected)
(set! flow-api-pass (+ flow-api-pass 1))
(begin
(set! flow-api-fail (+ flow-api-fail 1))
(append! flow-api-fails {:name name :expected expected :actual actual})))))
(define flow-a (fn (src) (flow-run src)))
;; ── flow/status ─────────────────────────────────────────────────
(flow-api-test "status: unknown id" (flow-a "(flow/status 999)") "unknown")
(flow-api-test
"status: suspended flow"
(flow-a
"(defflow w (lambda (x) (suspend (quote q)))) (define id (car (cdr (flow/start w 0)))) (flow/status id)")
"suspended")
(flow-api-test
"status: completed flow"
(flow-a
"(defflow w (sequence (lambda (x) (suspend (quote q))) (lambda (v) v))) (define id (car (cdr (flow/start w 0)))) (flow/resume id 5) (flow/status id)")
"done")
(flow-api-test
"status: cancelled flow"
(flow-a
"(defflow w (lambda (x) (suspend (quote q)))) (define id (car (cdr (flow/start w 0)))) (flow/cancel id) (flow/status id)")
"cancelled")
;; ── flow/result ─────────────────────────────────────────────────
(flow-api-test
"result: returns the value of a completed flow"
(flow-a
"(defflow w (sequence (lambda (x) (suspend (quote q))) (lambda (v) (list (quote got) v)))) (define id (car (cdr (flow/start w 0)))) (flow/resume id 9) (flow/result id)")
(list "got" 9))
(flow-api-test
"result: a still-suspended flow has no result"
(flow-a
"(defflow w (lambda (x) (suspend (quote q)))) (define id (car (cdr (flow/start w 0)))) (flow/result id)")
(list "flow-error" "not-done"))
(flow-api-test
"result: unknown id errors"
(flow-a "(flow/result 999)")
(list "flow-error" "no-such-flow"))
;; ── flow/list ───────────────────────────────────────────────────
(flow-api-test "list: empty store" (flow-a "(flow/list)") (list))
(flow-api-test
"list: reports id + status for each flow (newest first)"
(flow-a
"(defflow w (lambda (x) (suspend (quote q)))) (flow/start w 0) (flow/start (lambda (x) (* x 2)) 5) (flow/list)")
(list (list 2 "done") (list 1 "suspended")))
;; ── flow/pending ────────────────────────────────────────────────
(flow-api-test
"pending: lists suspended flows with their waiting tag"
(flow-a
"(defflow w (lambda (x) (suspend (quote review)))) (flow/start w 0) (flow/pending)")
(list (list 1 "review")))
(flow-api-test
"pending: excludes completed and cancelled flows"
(flow-a
"(defflow w (lambda (x) (suspend (quote q)))) (defflow v (sequence (lambda (x) (suspend (quote r))) (lambda (y) y))) (define i1 (car (cdr (flow/start w 0)))) (define i2 (car (cdr (flow/start v 0)))) (define i3 (car (cdr (flow/start w 0)))) (flow/resume i2 1) (flow/cancel i3) (flow/pending)")
(list (list 1 "q")))
(flow-api-test
"pending: operator can drain all pending flows"
(flow-a
"(defflow w (sequence (lambda (x) (suspend (quote q))) (lambda (v) (* v 10)))) (flow/start w 0) (flow/start w 0) (define ps (flow/pending)) (flow/resume (car (car ps)) 1) (flow/resume (car (car (cdr ps))) 2) (flow/list)")
(list (list 1 "done") (list 2 "done")))
(define flow-api-tests-run! (fn () {:total (+ flow-api-pass flow-api-fail) :passed flow-api-pass :failed flow-api-fail :fails flow-api-fails}))

121
lib/flow/tests/basic.sx Normal file
View File

@@ -0,0 +1,121 @@
;; lib/flow/tests/basic.sx — Phase 1: declarative DAG + sequential execution.
(define flow-basic-pass 0)
(define flow-basic-fail 0)
(define flow-basic-fails (list))
(define
flow-basic-test
(fn
(name actual expected)
(if
(= actual expected)
(set! flow-basic-pass (+ flow-basic-pass 1))
(begin
(set! flow-basic-fail (+ flow-basic-fail 1))
(append! flow-basic-fails {:name name :expected expected :actual actual})))))
;; Run a Scheme flow-program string and return its final value.
(define flow-b (fn (src) (flow-run src)))
;; Scheme strings are boxed as {:scm-string "..."}; unwrap to a host string.
(define flow-bs (fn (src) (get (flow-run src) :scm-string)))
;; ── single node ─────────────────────────────────────────────────
(flow-basic-test
"node: identity passes input through"
(flow-b "(flow/start flow-id 7)")
7)
(flow-basic-test
"node: const ignores input"
(flow-b "(flow/start (flow-const 99) 1)")
99)
(flow-basic-test
"node: bare lambda is a node"
(flow-b "(flow/start (lambda (x) (* x x)) 6)")
36)
;; ── linear sequence ─────────────────────────────────────────────
(flow-basic-test
"sequence: empty is identity"
(flow-b "(flow/start (sequence) 42)")
42)
(flow-basic-test
"sequence: single child"
(flow-b "(flow/start (sequence (lambda (x) (+ x 1))) 41)")
42)
(flow-basic-test
"sequence: two children thread"
(flow-b
"(flow/start (sequence (lambda (x) (+ x 1)) (lambda (x) (* x 10))) 4)")
50)
(flow-basic-test
"sequence: three children thread"
(flow-b
"(flow/start (sequence (lambda (x) (+ x 1)) (lambda (x) (* x 2)) (lambda (x) (- x 3))) 5)")
9)
;; ── data flow between nodes ─────────────────────────────────────
(flow-basic-test
"data flow: string accumulation"
(flow-bs
"(flow/start (sequence (lambda (s) (string-append s \"-a\")) (lambda (s) (string-append s \"-b\"))) \"x\")")
"x-a-b")
(flow-basic-test
"data flow: list build"
(flow-b
"(flow/start (sequence (lambda (x) (cons x (list))) (lambda (xs) (cons 0 xs))) 7)")
(list 0 7))
;; ── defflow ─────────────────────────────────────────────────────
(flow-basic-test
"defflow: names a flow"
(flow-b
"(defflow inc2 (sequence (lambda (x) (+ x 1)) (lambda (x) (+ x 1)))) (flow/start inc2 40)")
42)
(flow-basic-test
"defflow: reusable"
(flow-b
"(defflow dbl (lambda (x) (* x 2))) (+ (flow/start dbl 3) (flow/start dbl 10))")
26)
;; ── parallel (sequential semantics, join into list) ─────────────
(flow-basic-test
"parallel: fans input to all branches"
(flow-b
"(flow/start (parallel (lambda (x) (+ x 1)) (lambda (x) (* x 2)) (lambda (x) (- x 3))) 10)")
(list 11 20 7))
(flow-basic-test
"parallel: empty joins to empty list"
(flow-b "(flow/start (parallel) 5)")
(list))
(flow-basic-test
"parallel: single branch"
(flow-b "(flow/start (parallel (lambda (x) (* x x))) 9)")
(list 81))
;; ── nested composition ──────────────────────────────────────────
(flow-basic-test
"nested: sequence of sequences"
(flow-b
"(flow/start (sequence (sequence (lambda (x) (+ x 1)) (lambda (x) (+ x 1))) (sequence (lambda (x) (* x 3)))) 0)")
6)
(flow-basic-test
"nested: parallel inside sequence, join then reduce"
(flow-b
"(flow/start (sequence (parallel (lambda (x) (+ x 1)) (lambda (x) (* x 2))) (lambda (xs) (apply + xs))) 10)")
31)
(flow-basic-test
"nested: sequence inside parallel branch"
(flow-b
"(flow/start (parallel (sequence (lambda (x) (+ x 1)) (lambda (x) (* x 2))) (lambda (x) x)) 5)")
(list 12 5))
;; ── publish-shaped flow (the architecture sketch) ───────────────
(flow-basic-test
"publish: write -> (review | spell) -> join lengths"
(flow-b
"(defflow publish (sequence (lambda (draft) (string-append draft \"!\")) (parallel (lambda (c) (string-length c)) (lambda (c) (string-length (string-append c \"?\")))))) (flow/start publish \"hi\")")
(list 3 4))
(define flow-basic-tests-run! (fn () {:total (+ flow-basic-pass flow-basic-fail) :passed flow-basic-pass :failed flow-basic-fail :fails flow-basic-fails}))

View File

@@ -0,0 +1,108 @@
;; lib/flow/tests/combinators.sx — Phase 5: combinator library (tap, recover, map-flow, iteration).
(define flow-cmb-pass 0)
(define flow-cmb-fail 0)
(define flow-cmb-fails (list))
(define
flow-cmb-test
(fn
(name actual expected)
(if
(= actual expected)
(set! flow-cmb-pass (+ flow-cmb-pass 1))
(begin
(set! flow-cmb-fail (+ flow-cmb-fail 1))
(append! flow-cmb-fails {:name name :expected expected :actual actual})))))
(define flow-m (fn (src) (flow-run src)))
;; ── tap (side-effecting pass-through) ───────────────────────────
(flow-cmb-test
"tap: returns input unchanged"
(flow-m "(flow/start (tap (lambda (x) (* x 999))) 7)")
7)
(flow-cmb-test
"tap: runs the side effect"
(flow-m
"(define seen 0) (flow/start (tap (lambda (x) (set! seen x))) 42) seen")
42)
(flow-cmb-test
"tap: value flows on while the effect observes it"
(flow-m
"(define log 0) (flow/start (sequence (lambda (x) (+ x 1)) (tap (lambda (x) (set! log x))) (lambda (x) (* x 2))) 10) (list log (flow/result 1))")
(list 11 22))
;; ── recover (fail-value counterpart of try-catch) ───────────────
(flow-cmb-test
"recover: passes a non-fail value through"
(flow-m "(flow/start (recover (lambda (x) (* x 2)) (lambda (r) -1)) 5)")
10)
(flow-cmb-test
"recover: handles a fail value via the reason"
(flow-m
"(flow/start (recover (lambda (x) (fail (quote too-small))) (lambda (r) (list (quote recovered) r))) 1)")
(list "recovered" "too-small"))
(flow-cmb-test
"recover: handler can supply a default value"
(flow-m
"(flow/start (sequence (recover (lambda (x) (if (> x 0) x (fail (quote neg))) ) (flow-const 0)) (lambda (x) (* x 10))) -3)")
0)
(flow-cmb-test
"recover: does not catch raised exceptions (those are try-catch's job)"
(flow-m
"(flow/start (try-catch (recover (lambda (x) (raise (quote boom))) (flow-const 0)) (lambda (e) e)) 1)")
"boom")
;; ── map-flow (run a node over a list, join) ─────────────────────
(flow-cmb-test
"map-flow: applies the node to each item"
(flow-m "(flow/start (map-flow (lambda (x) (* x x))) (list 1 2 3 4))")
(list 1 4 9 16))
(flow-cmb-test
"map-flow: empty list joins to empty"
(flow-m "(flow/start (map-flow (lambda (x) (+ x 1))) (list))")
(list))
(flow-cmb-test
"map-flow: each item runs an independent sub-flow"
(flow-m
"(flow/start (map-flow (sequence (lambda (x) (+ x 1)) (lambda (x) (* x 2)))) (list 0 4 9))")
(list 2 10 20))
(flow-cmb-test
"map-flow: composes — fan over a list then reduce the join"
(flow-m
"(flow/start (sequence (map-flow (lambda (x) (* x 10))) (lambda (xs) (apply + xs))) (list 1 2 3))")
60)
;; ── flow-while / flow-until (bounded iteration) ─────────────────
(flow-cmb-test
"flow-while: iterates while the predicate holds"
(flow-m
"(flow/start (flow-while (lambda (x) (< x 10)) (lambda (x) (+ x 1)) 100) 0)")
10)
(flow-cmb-test
"flow-while: a false predicate leaves input unchanged"
(flow-m
"(flow/start (flow-while (lambda (x) (< x 0)) (lambda (x) (+ x 1)) 100) 5)")
5)
(flow-cmb-test
"flow-while: respects the max-iteration bound"
(flow-m "(flow/start (flow-while (lambda (x) #t) (lambda (x) (+ x 1)) 3) 0)")
3)
(flow-cmb-test
"flow-while: doubles until past a threshold"
(flow-m
"(flow/start (flow-while (lambda (x) (< x 50)) (lambda (x) (* x 2)) 100) 3)")
96)
(flow-cmb-test
"flow-until: iterates until the predicate becomes true"
(flow-m
"(flow/start (flow-until (lambda (x) (>= x 10)) (lambda (x) (+ x 3)) 100) 0)")
12)
(flow-cmb-test
"flow-until: composes inside a sequence"
(flow-m
"(flow/start (sequence (flow-until (lambda (x) (> x 100)) (lambda (x) (* x 3)) 100) (lambda (x) (- x 100))) 5)")
35)
(define flow-cmb-tests-run! (fn () {:total (+ flow-cmb-pass flow-cmb-fail) :passed flow-cmb-pass :failed flow-cmb-fail :fails flow-cmb-fails}))

179
lib/flow/tests/control.sx Normal file
View File

@@ -0,0 +1,179 @@
;; lib/flow/tests/control.sx — Phase 2: control flow + error handling.
(define flow-ctl-pass 0)
(define flow-ctl-fail 0)
(define flow-ctl-fails (list))
(define
flow-ctl-test
(fn
(name actual expected)
(if
(= actual expected)
(set! flow-ctl-pass (+ flow-ctl-pass 1))
(begin
(set! flow-ctl-fail (+ flow-ctl-fail 1))
(append! flow-ctl-fails {:name name :expected expected :actual actual})))))
(define flow-c (fn (src) (flow-run src)))
(define flow-cs (fn (src) (get (flow-run src) :scm-string)))
;; ── branch ──────────────────────────────────────────────────────
(flow-ctl-test
"branch: true selects then"
(flow-c
"(flow/start (branch (lambda (x) (> x 0)) (lambda (x) (* x 100)) (lambda (x) (- 0 x))) 5)")
500)
(flow-ctl-test
"branch: false selects else"
(flow-c
"(flow/start (branch (lambda (x) (> x 0)) (lambda (x) (* x 100)) (lambda (x) (- 0 x))) -3)")
3)
(flow-ctl-test
"branch: predicate sees the threaded input"
(flow-c
"(flow/start (sequence (lambda (x) (+ x 1)) (branch (lambda (x) (> x 3)) (flow-const 100) (flow-const 0))) 3)")
100)
(flow-ctl-test
"branch: branches are full nodes (sequence inside)"
(flow-c
"(flow/start (branch (lambda (x) (< x 10)) (sequence (lambda (x) (+ x 1)) (lambda (x) (* x 2))) (flow-const 0)) 4)")
10)
(flow-ctl-test
"branch: nested branch (3-way sign)"
(flow-c
"(defflow sign (branch (lambda (x) (> x 0)) (flow-const 1) (branch (lambda (x) (< x 0)) (flow-const -1) (flow-const 0)))) (list (flow/start sign 7) (flow/start sign -7) (flow/start sign 0))")
(list 1 -1 0))
(flow-ctl-test
"branch: publish-shaped approval gate"
(flow-cs
"(defflow publish (branch (lambda (post) (>= (string-length post) 3)) (lambda (post) (string-append post \" [published]\")) (lambda (post) (string-append post \" [rejected]\")))) (flow/start publish \"ok\")")
"ok [rejected]")
;; ── error model — explicit (fail reason) values ─────────────────
(flow-ctl-test
"fail: failed? is true for a failure value"
(flow-c "(failed? (fail 404))")
true)
(flow-ctl-test
"fail: fail-reason extracts the reason"
(flow-c "(fail-reason (fail 404))")
404)
(flow-ctl-test
"fail: failed? is false for a plain value"
(flow-c "(failed? 7)")
false)
(flow-ctl-test
"fail: failed? is false for an ordinary list"
(flow-c "(failed? (list 1 2 3))")
false)
(flow-ctl-test
"fail: a node may emit a failure as data"
(flow-c
"(defflow validate (lambda (s) (if (>= (string-length s) 3) s (fail (quote too-short))))) (failed? (flow/start validate \"hi\"))")
true)
(flow-ctl-test
"fail: failure flows downstream, branch recovers"
(flow-c
"(defflow guarded (sequence (lambda (s) (if (>= (string-length s) 3) (string-length s) (fail (quote too-short)))) (branch failed? (lambda (f) (list (quote recovered) (fail-reason f))) (lambda (n) (list (quote ok) n))))) (flow/start guarded \"hi\")")
(list "recovered" "too-short"))
;; ── try-catch — reify raised exceptions ─────────────────────────
(flow-ctl-test
"try-catch: no exception returns node result"
(flow-c "(flow/start (try-catch (lambda (x) (* x 2)) (lambda (e) -1)) 5)")
10)
(flow-ctl-test
"try-catch: handler runs on raise"
(flow-c
"(flow/start (try-catch (lambda (x) (raise (quote boom))) (flow-const 99)) 1)")
99)
(flow-ctl-test
"try-catch: handler receives the reified error"
(flow-c "(flow/start (try-catch (lambda (x) (raise 42)) (lambda (e) e)) 0)")
42)
(flow-ctl-test
"try-catch: catches exception from deep inside a sequence"
(flow-c
"(flow/start (try-catch (sequence (lambda (x) (+ x 1)) (lambda (x) (raise (quote deep)))) (flow-const -99)) 5)")
-99)
(flow-ctl-test
"try-catch: handler may convert to a failure value"
(flow-c
"(failed? (flow/start (try-catch (lambda (x) (raise (quote bad))) (lambda (e) (fail e))) 0))")
true)
(flow-ctl-test
"try-catch: composes — recover then continue"
(flow-c
"(flow/start (sequence (try-catch (lambda (x) (raise (quote x))) (flow-const 10)) (lambda (n) (* n 5))) 0)")
50)
;; ── retry — re-run on raised exceptions ─────────────────────────
(flow-ctl-test
"retry: succeeds after transient failures"
(flow-c
"(define ctr 0) (defflow flaky (lambda (x) (set! ctr (+ ctr 1)) (if (< ctr 3) (raise (quote nope)) (* x 10)))) (list (flow/start (retry 5 flaky) 7) ctr)")
(list 70 3))
(flow-ctl-test
"retry: exhausted re-raises (caught by try-catch)"
(flow-c
"(flow/start (try-catch (retry 2 (lambda (x) (raise (quote always)))) (flow-const (quote gaveup))) 0)")
"gaveup")
(flow-ctl-test
"retry: n=1 means a single attempt"
(flow-c
"(define ctr 0) (flow/start (try-catch (retry 1 (lambda (x) (set! ctr (+ ctr 1)) (raise (quote bad)))) (lambda (e) ctr)) 0)")
1)
(flow-ctl-test
"retry: success on first attempt does not re-run"
(flow-c
"(define ctr 0) (flow/start (sequence (retry 5 (lambda (x) (set! ctr (+ ctr 1)) (* x 2))) (lambda (n) ctr)) 21)")
1)
(flow-ctl-test
"retry: does not retry explicit failure values"
(flow-c
"(define ctr 0) (failed? (flow/start (retry 5 (lambda (x) (set! ctr (+ ctr 1)) (fail (quote bad)))) 0))")
true)
(flow-ctl-test
"retry: failure-value path runs node exactly once"
(flow-c
"(define ctr 0) (flow/start (sequence (retry 5 (lambda (x) (set! ctr (+ ctr 1)) (fail (quote bad)))) (lambda (f) ctr)) 0)")
1)
;; ── timeout — cooperative step budget ───────────────────────────
(flow-ctl-test
"timeout: work within budget completes"
(flow-c
"(define (cd n) (if (<= n 0) 99 (begin (tick) (cd (- n 1))))) (flow/start (try-catch (timeout 10 (lambda (x) (cd x))) (flow-const (quote timed-out))) 5)")
99)
(flow-ctl-test
"timeout: work exceeding budget raises flow-timeout"
(flow-c
"(define (cd n) (if (<= n 0) 99 (begin (tick) (cd (- n 1))))) (flow/start (try-catch (timeout 10 (lambda (x) (cd x))) (flow-const (quote timed-out))) 20)")
"timed-out")
(flow-ctl-test
"timeout: exact budget boundary completes"
(flow-c
"(define (cd n) (if (<= n 0) 99 (begin (tick) (cd (- n 1))))) (flow/start (try-catch (timeout 5 (lambda (x) (cd x))) (flow-const (quote timed-out))) 5)")
99)
(flow-ctl-test
"timeout: one tick over the budget raises"
(flow-c
"(define (cd n) (if (<= n 0) 99 (begin (tick) (cd (- n 1))))) (flow/start (try-catch (timeout 5 (lambda (x) (cd x))) (flow-const (quote timed-out))) 6)")
"timed-out")
(flow-ctl-test
"timeout: the raised error is identifiable"
(flow-c
"(define (cd n) (if (<= n 0) 99 (begin (tick) (cd (- n 1))))) (flow/start (try-catch (timeout 2 (lambda (x) (cd x))) (lambda (e) e)) 9)")
"flow-timeout")
(flow-ctl-test
"timeout: a node that never ticks is unbounded"
(flow-c "(flow/start (timeout 0 (lambda (x) (* x 2))) 5)")
10)
(flow-ctl-test
"timeout: budget is restored across sequential timeouts"
(flow-c
"(define (cd n) (if (<= n 0) 1 (begin (tick) (cd (- n 1))))) (flow/start (sequence (timeout 4 (lambda (x) (cd x))) (timeout 4 (lambda (x) (cd 3))) (lambda (x) (begin (tick) (+ x 100)))) 3)")
101)
(define flow-ctl-tests-run! (fn () {:total (+ flow-ctl-pass flow-ctl-fail) :passed flow-ctl-pass :failed flow-ctl-fail :fails flow-ctl-fails}))

View File

@@ -0,0 +1,120 @@
;; lib/flow/tests/distributed.sx — Phase 4: distributed nodes via fed-sx (mocked).
(define flow-dist-pass 0)
(define flow-dist-fail 0)
(define flow-dist-fails (list))
(define
flow-dist-test
(fn
(name actual expected)
(if
(= actual expected)
(set! flow-dist-pass (+ flow-dist-pass 1))
(begin
(set! flow-dist-fail (+ flow-dist-fail 1))
(append! flow-dist-fails {:name name :expected expected :actual actual})))))
(define flow-d (fn (src) (flow-run src)))
;; ── remote-node ─────────────────────────────────────────────────
(flow-dist-test
"remote: a node executes on a peer"
(flow-d
"(flow-peer-register! (quote edge) (list (list (quote double) (lambda (x) (* x 2))))) (flow/start (remote-node (quote edge) (quote double)) 21)")
42)
(flow-dist-test
"remote: remote nodes compose in a sequence"
(flow-d
"(flow-peer-register! (quote edge) (list (list (quote inc) (lambda (x) (+ x 1))) (list (quote double) (lambda (x) (* x 2))))) (flow/start (sequence (remote-node (quote edge) (quote inc)) (remote-node (quote edge) (quote double))) 4)")
10)
(flow-dist-test
"remote: a remote node mixes with local nodes"
(flow-d
"(flow-peer-register! (quote edge) (list (list (quote double) (lambda (x) (* x 2))))) (flow/start (sequence (lambda (x) (+ x 5)) (remote-node (quote edge) (quote double)) (lambda (x) (- x 1))) 10)")
29)
(flow-dist-test
"remote: unreachable peer raises flow-remote-unreachable"
(flow-d
"(flow/start (try-catch (remote-node (quote ghost) (quote double)) (lambda (e) e)) 1)")
"flow-remote-unreachable")
(flow-dist-test
"remote: unknown function on a peer raises flow-remote-no-fn"
(flow-d
"(flow-peer-register! (quote edge) (list (list (quote double) (lambda (x) (* x 2))))) (flow/start (try-catch (remote-node (quote edge) (quote missing)) (lambda (e) e)) 1)")
"flow-remote-no-fn")
(flow-dist-test
"remote: a remote node can suspend the flow (peer returns control)"
(flow-d
"(flow-peer-register! (quote edge) (list (list (quote review) (lambda (x) x)))) (flow/start (sequence (remote-node (quote edge) (quote review)) (lambda (x) (suspend (quote human))) (lambda (v) (list (quote published) v))) 7)")
(list "flow-suspended" 1 "human"))
(flow-dist-test
"remote: a transient remote failure is recoverable with retry"
(flow-d
"(define hits 0) (flow-peer-register! (quote edge) (list (list (quote flaky) (lambda (x) (begin (set! hits (+ hits 1)) (if (< hits 2) (raise (quote down)) (* x 3))))))) (list (flow/start (retry 3 (remote-node (quote edge) (quote flaky))) 7) hits)")
(list 21 2))
;; ── failover (retry on a different peer, fall through to local) ──
(flow-dist-test
"failover: first reachable peer serves the request"
(flow-d
"(flow-peer-register! (quote p2) (list (list (quote f) (lambda (x) (+ x 100))))) (flow/start (remote-failover (list (quote p2) (quote down)) (quote f) (flow-const (quote local))) 5)")
105)
(flow-dist-test
"failover: skips an unreachable peer to the next one"
(flow-d
"(flow-peer-register! (quote p2) (list (list (quote f) (lambda (x) (+ x 100))))) (flow/start (remote-failover (list (quote down) (quote p2)) (quote f) (flow-const (quote local))) 5)")
105)
(flow-dist-test
"failover: skips a peer whose function raises"
(flow-d
"(flow-peer-register! (quote bad) (list (list (quote f) (lambda (x) (raise (quote boom)))))) (flow-peer-register! (quote good) (list (list (quote f) (lambda (x) (* x 10))))) (flow/start (remote-failover (list (quote bad) (quote good)) (quote f) (flow-const 0)) 4)")
40)
(flow-dist-test
"failover: all peers fail, the local fallback runs"
(flow-d
"(flow/start (remote-failover (list (quote down1) (quote down2)) (quote f) (lambda (x) (* x -1))) 9)")
-9)
(flow-dist-test
"failover: threads the input through to the chosen peer"
(flow-d
"(flow-peer-register! (quote p) (list (list (quote f) (lambda (x) (list (quote got) x))))) (flow/start (sequence (lambda (x) (+ x 1)) (remote-failover (list (quote p)) (quote f) (flow-const 0))) 41)")
(list "got" 42))
(flow-dist-test
"failover: composes inside a larger sequence"
(flow-d
"(flow-peer-register! (quote p) (list (list (quote f) (lambda (x) (* x 2))))) (flow/start (sequence (remote-failover (list (quote down) (quote p)) (quote f) (flow-const 1)) (lambda (x) (+ x 3))) 5)")
13)
;; ── replication + handoff ───────────────────────────────────────
(flow-dist-test
"replicate: a peer holds the exported store"
(flow-d
"(defflow w (lambda (x) (suspend (quote q)))) (flow/start w 10) (flow-replicate-to (quote peerB)) (if (flow-replica-get (quote peerB)) (quote replicated) (quote missing))")
"replicated")
(flow-dist-test
"handoff: a peer resumes a flow after the local instance dies"
(flow-d
"(defflow w (sequence (lambda (x) (suspend (quote q))) (lambda (v) (list (quote done) v)))) (define id (car (cdr (flow/start w 10)))) (flow-replicate-to (quote peerB)) (set! flow-store (list)) (flow-restore-from (quote peerB)) (flow/resume id 55)")
(list "done" 55))
(flow-dist-test
"handoff: restored peer reports the flow as resumable"
(flow-d
"(defflow w (lambda (x) (suspend (quote q)))) (define id (car (cdr (flow/start w 10)))) (flow-replicate-to (quote peerB)) (set! flow-store (list)) (flow-restore-from (quote peerB)) (flow-resumable-ids)")
(list 1))
(flow-dist-test
"handoff: without restore the dead instance has lost the flow"
(flow-d
"(defflow w (lambda (x) (suspend (quote q)))) (define id (car (cdr (flow/start w 10)))) (flow-replicate-to (quote peerB)) (set! flow-store (list)) (flow/resume id 1)")
(list "flow-error" "no-such-flow"))
(flow-dist-test
"restore: from an unknown peer yields false"
(flow-d "(flow-restore-from (quote nowhere))")
false)
(flow-dist-test
"handoff: replication preserves the replay log across the move"
(flow-d
"(defflow two (sequence (lambda (x) (suspend (quote a))) (lambda (x) (suspend (quote b))) (lambda (x) (list x)))) (define id (car (cdr (flow/start two 0)))) (flow/resume id 11) (flow-replicate-to (quote peerB)) (set! flow-store (list)) (flow-restore-from (quote peerB)) (flow/resume id 22)")
(list 22))
(define flow-dist-tests-run! (fn () {:total (+ flow-dist-pass flow-dist-fail) :passed flow-dist-pass :failed flow-dist-fail :fails flow-dist-fails}))

106
lib/flow/tests/host.sx Normal file
View File

@@ -0,0 +1,106 @@
;; lib/flow/tests/host.sx — Phase 8: host integration ABI (request/await/host-queue/driver).
(define flow-hst-pass 0)
(define flow-hst-fail 0)
(define flow-hst-fails (list))
(define
flow-hst-test
(fn
(name actual expected)
(if
(= actual expected)
(set! flow-hst-pass (+ flow-hst-pass 1))
(begin
(set! flow-hst-fail (+ flow-hst-fail 1))
(append! flow-hst-fails {:name name :expected expected :actual actual})))))
(define flow-hst (fn (src) (flow-run src)))
;; ── request envelope ────────────────────────────────────────────
(flow-hst-test
"request: suspends with a typed envelope"
(flow-hst
"(car (cdr (cdr (flow/start (lambda (x) (request (quote render) x)) 5))))")
(list "flow-request" "render" 5))
(flow-hst-test
"request?: recognizes an envelope"
(flow-hst "(request? (list (quote flow-request) (quote human) 1))")
true)
(flow-hst-test
"request?: a plain tag is not a request"
(flow-hst "(request? (list (quote review) 1))")
false)
(flow-hst-test
"request-kind / request-payload: parse the envelope"
(flow-hst
"(define t (list (quote flow-request) (quote render) (list (quote recipe) 7))) (list (request-kind t) (request-payload t))")
(list "render" (list "recipe" 7)))
;; ── named decision points ───────────────────────────────────────
(flow-hst-test
"await-human: is a request of kind human"
(flow-hst
"(car (cdr (cdr (flow/start (lambda (x) (await-human x)) (quote approve?)))))")
(list "flow-request" "human" "approve?"))
(flow-hst-test
"await-render: is a request of kind render"
(flow-hst
"(car (cdr (cdr (flow/start (lambda (x) (await-render x)) (quote recipe)))))")
(list "flow-request" "render" "recipe"))
(flow-hst-test
"request: the host's resume value flows back into the flow"
(flow-hst
"(defflow f (sequence (lambda (x) (await-render x)) (lambda (art) (list (quote got) art)))) (define id (car (cdr (flow/start f 1)))) (flow/resume id (quote the-artifact))")
(list "got" "the-artifact"))
;; ── host work queue ─────────────────────────────────────────────
(flow-hst-test
"flow-host-requests: lists (id kind payload) for pending requests"
(flow-hst
"(flow/start (lambda (x) (await-render x)) 99) (flow-host-requests)")
(list (list 1 "render" 99)))
(flow-hst-test
"flow-host-requests: excludes bare (non-request) suspends"
(flow-hst
"(defflow a (lambda (x) (await-render x))) (defflow b (lambda (x) (suspend (quote plain)))) (flow/start a 1) (flow/start b 2) (flow-host-requests)")
(list (list 1 "render" 1)))
;; ── the art-dag-shaped host driver loop (manual resumes) ────────
(flow-hst-test
"host driver: render then human-review then publish"
(flow-hst
"(defflow pipeline (sequence (lambda (recipe) (await-render recipe)) (lambda (art) (await-human (list (quote review) art))) (branch (lambda (d) (eq? d (quote approve))) (flow-const (quote published)) (flow-const (fail (quote rejected)))))) (define id (car (cdr (flow/start pipeline 99)))) (define r1 (flow-host-requests)) (flow/resume id (list (quote art) 99)) (define r2 (flow-host-requests)) (flow/resume id (quote approve)) (list r1 r2 (flow/status id) (flow/result id))")
(list
(list (list 1 "render" 99))
(list (list 1 "human" (list "review" (list "art" 99))))
"done"
"published"))
(flow-hst-test
"host driver: rejection at the human gate yields a failure"
(flow-hst
"(defflow pipeline (sequence (lambda (recipe) (await-render recipe)) (lambda (art) (await-human (list (quote review) art))) (branch (lambda (d) (eq? d (quote approve))) (flow-const (quote published)) (flow-const (fail (quote rejected)))))) (define id (car (cdr (flow/start pipeline 1)))) (flow/resume id (quote artifact)) (failed? (flow/resume id (quote reject)))")
true)
;; ── reference driver: host supplies only a dispatch fn ──────────
(flow-hst-test
"flow-drive-host: one tick services every pending request"
(flow-hst
"(flow/start (lambda (x) (await-render x)) 5) (define n (flow-drive-host (lambda (k p) (list (quote done) p)))) (list n (flow/status 1) (flow/result 1))")
(list 1 "done" (list "done" 5)))
(flow-hst-test
"flow-run-host: drives a render -> human pipeline to completion"
(flow-hst
"(defflow pipeline (sequence (lambda (recipe) (await-render recipe)) (lambda (art) (await-human (list (quote review) art))) (branch (lambda (d) (eq? d (quote approve))) (flow-const (quote published)) (flow-const (fail (quote rejected)))))) (define id (car (cdr (flow/start pipeline 99)))) (define serviced (flow-run-host (lambda (kind payload) (if (eq? kind (quote render)) (list (quote art) payload) (quote approve))) 10)) (list serviced (flow/status id) (flow/result id))")
(list 2 "done" "published"))
(flow-hst-test
"flow-run-host: returns 0 when nothing is pending"
(flow-hst "(flow-run-host (lambda (k p) p) 5)")
0)
(flow-hst-test
"flow-run-host: respects the maxticks bound"
(flow-hst
"(defflow pipe2 (sequence (lambda (r) (await-render r)) (lambda (a) (await-human a)) (lambda (d) d))) (define id (car (cdr (flow/start pipe2 1)))) (define serviced (flow-run-host (lambda (k p) p) 1)) (list serviced (flow/status id))")
(list 1 "suspended"))
(define flow-hst-tests-run! (fn () {:total (+ flow-hst-pass flow-hst-fail) :passed flow-hst-pass :failed flow-hst-fail :fails flow-hst-fails}))

67
lib/flow/tests/hygiene.sx Normal file
View File

@@ -0,0 +1,67 @@
;; lib/flow/tests/hygiene.sx — Phase 5: store hygiene (flow/gc, flow/forget).
(define flow-hyg-pass 0)
(define flow-hyg-fail 0)
(define flow-hyg-fails (list))
(define
flow-hyg-test
(fn
(name actual expected)
(if
(= actual expected)
(set! flow-hyg-pass (+ flow-hyg-pass 1))
(begin
(set! flow-hyg-fail (+ flow-hyg-fail 1))
(append! flow-hyg-fails {:name name :expected expected :actual actual})))))
(define flow-h (fn (src) (flow-run src)))
;; ── flow/gc ─────────────────────────────────────────────────────
(flow-hyg-test
"gc: empty store removes nothing"
(flow-h "(flow/gc)")
0)
(flow-hyg-test
"gc: removes a done flow, keeps a suspended one"
(flow-h
"(defflow w (lambda (x) (suspend (quote q)))) (flow/start w 0) (flow/start (lambda (x) x) 5) (define removed (flow/gc)) (list removed (flow/list))")
(list 1 (list (list 1 "suspended"))))
(flow-hyg-test
"gc: removes a cancelled flow"
(flow-h
"(defflow w (lambda (x) (suspend (quote q)))) (define id (car (cdr (flow/start w 0)))) (flow/cancel id) (flow/gc)")
1)
(flow-hyg-test
"gc: a kept suspended flow is still resumable"
(flow-h
"(defflow w (sequence (lambda (x) (suspend (quote q))) (lambda (v) (* v 2)))) (define id (car (cdr (flow/start w 0)))) (flow/start (lambda (x) x) 1) (flow/gc) (flow/resume id 21)")
42)
(flow-hyg-test
"gc: counts every terminal flow it drops"
(flow-h
"(flow/start (lambda (x) x) 1) (flow/start (lambda (x) x) 2) (defflow w (lambda (x) (suspend (quote q)))) (flow/start w 0) (flow/gc)")
2)
;; ── flow/forget ─────────────────────────────────────────────────
(flow-hyg-test
"forget: drops a completed flow"
(flow-h
"(defflow w (sequence (lambda (x) (suspend (quote q))) (lambda (v) v))) (define id (car (cdr (flow/start w 0)))) (flow/resume id 7) (list (flow/forget id) (flow/status id))")
(list true "unknown"))
(flow-hyg-test
"forget: refuses to drop a live (suspended) flow"
(flow-h
"(defflow w (lambda (x) (suspend (quote q)))) (define id (car (cdr (flow/start w 0)))) (list (flow/forget id) (flow/status id))")
(list false "suspended"))
(flow-hyg-test
"forget: drops a cancelled flow"
(flow-h
"(defflow w (lambda (x) (suspend (quote q)))) (define id (car (cdr (flow/start w 0)))) (flow/cancel id) (list (flow/forget id) (flow/status id))")
(list true "unknown"))
(flow-hyg-test
"forget: unknown id yields false"
(flow-h "(flow/forget 999)")
false)
(define flow-hyg-tests-run! (fn () {:total (+ flow-hyg-pass flow-hyg-fail) :passed flow-hyg-pass :failed flow-hyg-fail :fails flow-hyg-fails}))

View File

@@ -0,0 +1,115 @@
;; lib/flow/tests/integration.sx — Phase 7: end-to-end flows composing every phase.
(define flow-int-pass 0)
(define flow-int-fail 0)
(define flow-int-fails (list))
(define
flow-int-test
(fn
(name actual expected)
(if
(= actual expected)
(set! flow-int-pass (+ flow-int-pass 1))
(begin
(set! flow-int-fail (+ flow-int-fail 1))
(append! flow-int-fails {:name name :expected expected :actual actual})))))
(define flow-i (fn (src) (flow-run src)))
;; The order-processing flow, defined once per program via this prelude string:
;; validate amount (attempt: fail if <= 0)
;; -> suspend for payment confirmation (resume value = confirmed amount)
;; -> branch: confirmed>0 ? record on the ledger peer : declined failure
(define
order-prelude
"(flow-peer-register! (quote ledger) (list (list (quote record) (lambda (amt) (list (quote recorded) amt)))))\n (defflow order\n (attempt\n (lambda (amt) (if (> amt 0) amt (fail (quote invalid-amount))))\n (lambda (amt) (suspend (quote await-payment)))\n (branch (lambda (amt) (> amt 0))\n (remote-node (quote ledger) (quote record))\n (flow-const (fail (quote declined))))))")
;; ── happy path through every phase ──────────────────────────────
(flow-int-test
"order: validate -> suspend -> resume -> branch -> federate"
(flow-i
(str
order-prelude
"(define id (car (cdr (flow/start order 100)))) (flow/resume id 250)"))
(list "recorded" 250))
(flow-int-test
"order: starting suspends awaiting payment"
(flow-i
(str
order-prelude
"(define s (flow/start order 100)) (list (car s) (car (cdr (cdr s))))"))
(list "flow-suspended" "await-payment"))
(flow-int-test
"order: invalid amount fails up front and never suspends"
(flow-i
(str
order-prelude
"(define r (flow/start order -5)) (list (failed? r) (fail-reason r))"))
(list true "invalid-amount"))
(flow-int-test
"order: a declined payment yields a failure value"
(flow-i
(str
order-prelude
"(define id (car (cdr (flow/start order 100)))) (failed? (flow/resume id 0))"))
true)
;; ── crash recovery mid-flow ─────────────────────────────────────
(flow-int-test
"order: survives a simulated crash between suspend and resume"
(flow-i
(str
order-prelude
"(define id (car (cdr (flow/start order 100)))) (define saved (flow-store-export)) (set! flow-store (list)) (flow-store-import! saved) (flow/resume id 250)"))
(list "recorded" 250))
;; ── handoff to a peer mid-flow ──────────────────────────────────
(flow-int-test
"order: hands off to a peer that resumes and completes"
(flow-i
(str
order-prelude
"(define id (car (cdr (flow/start order 100)))) (flow-replicate-to (quote nodeB)) (set! flow-store (list)) (flow-restore-from (quote nodeB)) (flow/resume id 250)"))
(list "recorded" 250))
;; ── introspection during the flow's life ────────────────────────
(flow-int-test
"order: pending shows what the flow awaits, then result after resume"
(flow-i
(str
order-prelude
"(define id (car (cdr (flow/start order 100)))) (define p (flow/pending)) (flow/resume id 250) (list p (flow/status id) (flow/result id))"))
(list
(list (list 1 "await-payment"))
"done"
(list "recorded" 250)))
;; ── onboarding: two human steps + cancellation ──────────────────
(define
onboard-prelude
"(defflow onboard\n (sequence\n (lambda (user) (+ user 1))\n (lambda (x) (suspend (quote confirm-email)))\n (lambda (x) (suspend (quote complete-profile)))\n (lambda (x) (list (quote onboarded) x))))")
(flow-int-test
"onboard: two suspends resume in order to completion"
(flow-i
(str
onboard-prelude
"(define id (car (cdr (flow/start onboard 0)))) (flow/resume id 7) (flow/resume id 9)"))
(list "onboarded" 9))
(flow-int-test
"onboard: the second pending tag appears after the first resume"
(flow-i
(str
onboard-prelude
"(define id (car (cdr (flow/start onboard 0)))) (flow/resume id 7) (car (cdr (car (flow/pending))))"))
"complete-profile")
(flow-int-test
"onboard: cancelling abandons the flow"
(flow-i
(str
onboard-prelude
"(define id (car (cdr (flow/start onboard 0)))) (flow/cancel id) (list (flow/status id) (car (flow/resume id 7)))"))
(list "cancelled" "flow-error"))
(define flow-int-tests-run! (fn () {:total (+ flow-int-pass flow-int-fail) :passed flow-int-pass :failed flow-int-fail :fails flow-int-fails}))

73
lib/flow/tests/railway.sx Normal file
View File

@@ -0,0 +1,73 @@
;; lib/flow/tests/railway.sx — Phase 6: railway-oriented composition (attempt).
(define flow-rail-pass 0)
(define flow-rail-fail 0)
(define flow-rail-fails (list))
(define
flow-rail-test
(fn
(name actual expected)
(if
(= actual expected)
(set! flow-rail-pass (+ flow-rail-pass 1))
(begin
(set! flow-rail-fail (+ flow-rail-fail 1))
(append! flow-rail-fails {:name name :expected expected :actual actual})))))
(define flow-r (fn (src) (flow-run src)))
;; ── attempt — short-circuit on the first (fail ...) ─────────────
(flow-rail-test
"attempt: threads like sequence when nothing fails"
(flow-r
"(flow/start (attempt (lambda (x) (+ x 1)) (lambda (x) (* x 10))) 4)")
50)
(flow-rail-test
"attempt: empty is identity"
(flow-r "(flow/start (attempt) 7)")
7)
(flow-rail-test
"attempt: returns the first failure"
(flow-r
"(failed? (flow/start (attempt (lambda (x) (fail (quote bad))) (lambda (x) (* x 10))) 4))")
true)
(flow-rail-test
"attempt: the failure carries its reason"
(flow-r
"(fail-reason (flow/start (attempt (lambda (x) x) (lambda (x) (fail (quote rejected)))) 4))")
"rejected")
(flow-rail-test
"attempt: nodes after a failure do not run"
(flow-r
"(define ran 0) (flow/start (attempt (lambda (x) (fail (quote stop))) (lambda (x) (begin (set! ran (+ ran 1)) x))) 0) ran")
0)
(flow-rail-test
"attempt: a failed input short-circuits immediately"
(flow-r
"(define ran 0) (fail-reason (flow/start (attempt (lambda (x) (begin (set! ran (+ ran 1)) x))) (fail (quote pre))))")
"pre")
(flow-rail-test
"attempt: middle failure halts the chain"
(flow-r
"(define ran 0) (flow/start (attempt (lambda (x) (+ x 1)) (lambda (x) (fail (quote mid))) (lambda (x) (begin (set! ran (+ ran 1)) x))) 5) ran")
0)
;; ── attempt + recover (rejoin the happy track) ──────────────────
(flow-rail-test
"attempt + recover: recover turns a failure into a value"
(flow-r
"(flow/start (recover (attempt (lambda (x) (if (> x 0) x (fail (quote non-positive)))) (lambda (x) (* x 2))) (flow-const 0)) -5)")
0)
(flow-rail-test
"attempt + recover: happy path passes recover through"
(flow-r
"(flow/start (recover (attempt (lambda (x) (if (> x 0) x (fail (quote non-positive)))) (lambda (x) (* x 2))) (flow-const 0)) 5)")
10)
(flow-rail-test
"attempt: validation pipeline reports the failing stage"
(flow-r
"(defflow validate (attempt (lambda (s) (if (>= (string-length s) 3) s (fail (quote too-short)))) (lambda (s) (if (<= (string-length s) 8) s (fail (quote too-long)))) (lambda (s) (list (quote ok) (string-length s))))) (list (fail-reason (flow/start validate \"hi\")) (flow/start validate \"hello\"))")
(list "too-short" (list "ok" 5)))
(define flow-rail-tests-run! (fn () {:total (+ flow-rail-pass flow-rail-fail) :passed flow-rail-pass :failed flow-rail-fail :fails flow-rail-fails}))

View File

@@ -0,0 +1,71 @@
;; lib/flow/tests/recovery.sx — Phase 3: crash recovery (store export/import + restart).
;;
;; "restart" is simulated within one program: (set! flow-store (list)) wipes the
;; in-memory store (process death), while flow-registry persists as it would after
;; reloading flow definitions. Recovery = import the exported (plain-data) store and
;; resume; the flow proc is re-resolved by name.
(define flow-rec-pass 0)
(define flow-rec-fail 0)
(define flow-rec-fails (list))
(define
flow-rec-test
(fn
(name actual expected)
(if
(= actual expected)
(set! flow-rec-pass (+ flow-rec-pass 1))
(begin
(set! flow-rec-fail (+ flow-rec-fail 1))
(append! flow-rec-fails {:name name :expected expected :actual actual})))))
(define flow-r (fn (src) (flow-run src)))
;; ── export / wipe / import ──────────────────────────────────────
(flow-rec-test
"export nulls the live procedure"
(flow-r
"(defflow w (lambda (x) (suspend (quote await)))) (flow/start w 10) (car (cdr (car (cdr (car (flow-store-export))))))")
false)
(flow-rec-test
"a wiped store loses the flow (process death)"
(flow-r
"(defflow w (lambda (x) (suspend (quote await)))) (define id (car (cdr (flow/start w 10)))) (set! flow-store (list)) (flow/resume id 1)")
(list "flow-error" "no-such-flow"))
(flow-rec-test
"import restores a wiped store and resume completes"
(flow-r
"(defflow w (sequence (lambda (x) (suspend (quote await))) (lambda (c) (list (quote done) c)))) (define id (car (cdr (flow/start w 10)))) (define saved (flow-store-export)) (set! flow-store (list)) (flow-store-import! saved) (flow/resume id 777)")
(list "done" 777))
;; ── resumable scan ──────────────────────────────────────────────
(flow-rec-test
"resumable-ids lists the suspended flow after import"
(flow-r
"(defflow w (lambda (x) (suspend (quote await)))) (define id (car (cdr (flow/start w 10)))) (define saved (flow-store-export)) (set! flow-store (list)) (flow-store-import! saved) (flow-resumable-ids)")
(list 1))
(flow-rec-test
"resumable-ids excludes completed flows"
(flow-r
"(defflow w (sequence (lambda (x) (suspend (quote await))) (lambda (c) c))) (define id (car (cdr (flow/start w 10)))) (flow/resume id 5) (flow-resumable-ids)")
(list))
(flow-rec-test
"resumable-ids excludes cancelled flows after import"
(flow-r
"(defflow w (lambda (x) (suspend (quote await)))) (define id (car (cdr (flow/start w 10)))) (flow/cancel id) (define saved (flow-store-export)) (set! flow-store (list)) (flow-store-import! saved) (flow-resumable-ids)")
(list))
;; ── restart at every step ───────────────────────────────────────
(flow-rec-test
"two suspends survive a restart between each step"
(flow-r
"(defflow two (sequence (lambda (x) (suspend (quote a))) (lambda (x) (suspend (quote b))) (lambda (x) (list (quote end) x)))) (define id (car (cdr (flow/start two 0)))) (define s1 (flow-store-export)) (set! flow-store (list)) (flow-store-import! s1) (flow/resume id 100) (define s2 (flow-store-export)) (set! flow-store (list)) (flow-store-import! s2) (flow/resume id 200)")
(list "end" 200))
(flow-rec-test
"import preserves the replay log (earlier value survives restart)"
(flow-r
"(defflow two (sequence (lambda (x) (suspend (quote a))) (lambda (x) (suspend (quote b))) (lambda (x) (list x)))) (define id (car (cdr (flow/start two 0)))) (flow/resume id 11) (define saved (flow-store-export)) (set! flow-store (list)) (flow-store-import! saved) (flow/resume id 22)")
(list 22))
(define flow-rec-tests-run! (fn () {:total (+ flow-rec-pass flow-rec-fail) :passed flow-rec-pass :failed flow-rec-fail :fails flow-rec-fails}))

114
lib/flow/tests/suspend.sx Normal file
View File

@@ -0,0 +1,114 @@
;; lib/flow/tests/suspend.sx — Phase 3: suspend / resume / cancel (deterministic replay).
(define flow-sus-pass 0)
(define flow-sus-fail 0)
(define flow-sus-fails (list))
(define
flow-sus-test
(fn
(name actual expected)
(if
(= actual expected)
(set! flow-sus-pass (+ flow-sus-pass 1))
(begin
(set! flow-sus-fail (+ flow-sus-fail 1))
(append! flow-sus-fails {:name name :expected expected :actual actual})))))
(define flow-s (fn (src) (flow-run src)))
;; ── flow/start ──────────────────────────────────────────────────
(flow-sus-test
"start: non-suspending flow returns the raw result"
(flow-s "(flow/start (lambda (x) (* x 2)) 5)")
10)
(flow-sus-test
"start: a suspending flow returns a flow-suspended state"
(flow-s
"(defflow w (sequence (lambda (x) (+ x 1)) (lambda (g) (suspend (quote await))) (lambda (c) c))) (car (flow/start w 10))")
"flow-suspended")
(flow-sus-test
"start: suspended state carries a numeric id"
(flow-s
"(defflow w (lambda (x) (suspend (quote await)))) (car (cdr (flow/start w 10)))")
1)
(flow-sus-test
"start: suspended state carries the suspend tag"
(flow-s
"(defflow w (lambda (x) (suspend (quote await)))) (car (cdr (cdr (flow/start w 10))))")
"await")
;; ── flow/resume ─────────────────────────────────────────────────
(flow-sus-test
"resume: injects the value and completes"
(flow-s
"(defflow w (sequence (lambda (x) (+ x 1)) (lambda (g) (suspend (quote await))) (lambda (c) (list (quote done) c)))) (define s (flow/start w 10)) (flow/resume (car (cdr s)) 777)")
(list "done" 777))
(flow-sus-test
"resume: injected value threads into the next node"
(flow-s
"(defflow w (sequence (lambda (x) (suspend (quote v))) (lambda (n) (* n 3)))) (define s (flow/start w 0)) (flow/resume (car (cdr s)) 14)")
42)
(flow-sus-test
"resume: replays earlier suspends (recompute is deterministic)"
(flow-s
"(define runs 0) (defflow w (sequence (lambda (x) (begin (set! runs (+ runs 1)) (+ x 1))) (lambda (g) (suspend (quote await))) (lambda (c) c))) (define s (flow/start w 10)) (flow/resume (car (cdr s)) 99) runs")
2)
;; ── multi-step suspension ───────────────────────────────────────
(flow-sus-test
"multi: first resume suspends at the next tag"
(flow-s
"(defflow two (sequence (lambda (x) (suspend (quote a))) (lambda (x) (suspend (quote b))) (lambda (x) (list (quote end) x)))) (define s (flow/start two 0)) (define s2 (flow/resume (car (cdr s)) 100)) (car (cdr (cdr s2)))")
"b")
(flow-sus-test
"multi: second resume completes with the latest value"
(flow-s
"(defflow two (sequence (lambda (x) (suspend (quote a))) (lambda (x) (suspend (quote b))) (lambda (x) (list (quote end) x)))) (define id (car (cdr (flow/start two 0)))) (flow/resume id 100) (flow/resume id 200)")
(list "end" 200))
;; ── error / lifecycle guards ────────────────────────────────────
(flow-sus-test
"resume: completed flow cannot be resumed again"
(flow-s
"(defflow w (lambda (x) (suspend (quote q)))) (define id (car (cdr (flow/start w 0)))) (flow/resume id 1) (flow/resume id 2)")
(list "flow-error" "not-suspended"))
(flow-sus-test
"resume: unknown id errors"
(flow-s "(flow/resume 999 1)")
(list "flow-error" "no-such-flow"))
;; ── flow/cancel ─────────────────────────────────────────────────
(flow-sus-test
"cancel: returns a flow-cancelled state"
(flow-s
"(defflow w (lambda (x) (suspend (quote q)))) (define id (car (cdr (flow/start w 0)))) (flow/cancel id)")
(list "flow-cancelled" 1))
(flow-sus-test
"cancel: a cancelled flow cannot be resumed (stale resume rejected)"
(flow-s
"(defflow w (lambda (x) (suspend (quote q)))) (define id (car (cdr (flow/start w 0)))) (flow/cancel id) (flow/resume id 5)")
(list "flow-error" "not-suspended"))
(flow-sus-test
"cancel: unknown id errors"
(flow-s "(flow/cancel 999)")
(list "flow-error" "no-such-flow"))
;; ── composition ─────────────────────────────────────────────────
(flow-sus-test
"suspend inside a branch arm"
(flow-s
"(defflow gate (branch (lambda (x) (> x 0)) (lambda (x) (suspend (quote approve))) (flow-const (quote rejected)))) (define s (flow/start gate 5)) (flow/resume (car (cdr s)) (quote approved))")
"approved")
(flow-sus-test
"two independent runs get independent ids"
(flow-s
"(defflow w (lambda (x) (suspend (quote q)))) (list (car (cdr (flow/start w 0))) (car (cdr (flow/start w 0))))")
(list 1 2))
(flow-sus-test
"suspend reason may be a structured value"
(flow-s
"(defflow w (lambda (x) (suspend (list (quote needs) (quote approval))))) (car (cdr (cdr (flow/start w 0))))")
(list "needs" "approval"))
(define flow-sus-tests-run! (fn () {:total (+ flow-sus-pass flow-sus-fail) :passed flow-sus-pass :failed flow-sus-fail :fails flow-sus-fails}))

View File

@@ -1,40 +0,0 @@
;; 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)))

View File

@@ -1,163 +0,0 @@
;; 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)))

View File

@@ -1,54 +0,0 @@
;; 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*)))

View File

@@ -1,55 +0,0 @@
;; 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))))

View File

@@ -1,60 +0,0 @@
# 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!)"
)

View File

@@ -1,3 +0,0 @@
#!/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" "$@"

View File

@@ -1,16 +0,0 @@
;; 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))

View File

@@ -1,64 +0,0 @@
;; 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})))))))))

View File

@@ -1,55 +0,0 @@
;; 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)))))))

View File

@@ -1,145 +0,0 @@
;; 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})))))

View File

@@ -1,160 +0,0 @@
;; 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)))))

View File

@@ -1,92 +0,0 @@
;; 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))))

View File

@@ -1,69 +0,0 @@
;; 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))))

View File

@@ -1,59 +0,0 @@
;; 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)))))))

View File

@@ -1,18 +0,0 @@
;; 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)))

View File

@@ -1,40 +0,0 @@
;; 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*)))

View File

@@ -1,137 +0,0 @@
;; 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))))

View File

@@ -1,40 +0,0 @@
;; 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"}))))))))

View File

@@ -1,259 +0,0 @@
;; 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))))))

View File

@@ -1,30 +0,0 @@
{
"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"
}

View File

@@ -1,27 +0,0 @@
# 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 |

View File

@@ -1,60 +0,0 @@
;; 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"})))))))))

View File

@@ -1,47 +0,0 @@
;; 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))))

View File

@@ -1,62 +0,0 @@
;; 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"})))))))))

View File

@@ -1,95 +0,0 @@
;; 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}))

View File

@@ -1,187 +0,0 @@
;; 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}))

View File

@@ -1,101 +0,0 @@
;; 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}))

View File

@@ -1,215 +0,0 @@
;; 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}))

View File

@@ -1,95 +0,0 @@
;; 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

@@ -1,145 +0,0 @@
;; 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}))

View File

@@ -1,279 +0,0 @@
;; 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}))

View File

@@ -1,313 +0,0 @@
;; 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}))

View File

@@ -1,154 +0,0 @@
;; 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}))

View File

@@ -1,86 +0,0 @@
;; 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}))

View File

@@ -1,122 +0,0 @@
;; 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}))

View File

@@ -1,115 +0,0 @@
;; 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}))

View File

@@ -1,112 +0,0 @@
;; 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}))

View File

@@ -1,112 +0,0 @@
;; 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}))

View File

@@ -1,119 +0,0 @@
;; 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}))

View File

@@ -1,120 +0,0 @@
;; lib/mod/tests/severity.sx — Ext 6: strictest-wins decision strategy.
(define mod-sev-count 0)
(define mod-sev-pass 0)
(define mod-sev-fail 0)
(define mod-sev-failures (list))
(define
mod-sev-test!
(fn
(name got expected)
(begin
(set! mod-sev-count (+ mod-sev-count 1))
(if
(= got expected)
(set! mod-sev-pass (+ mod-sev-pass 1))
(begin
(set! mod-sev-fail (+ mod-sev-fail 1))
(append!
mod-sev-failures
(str name "\n expected: " expected "\n got: " got)))))))
;; ── severity ranking ──
(mod-sev-test! "ban most severe" (mod/action-severity "ban") 4)
(mod-sev-test!
"remove > hide"
(< (mod/action-severity "hide") (mod/action-severity "remove"))
true)
(mod-sev-test! "keep least severe" (mod/action-severity "keep") 0)
(mod-sev-test!
"escalate above keep"
(< (mod/action-severity "keep") (mod/action-severity "escalate"))
true)
;; ── strictest agrees with default-rules on simple cases ──
(define mod-sev-spam (mod/mk-report "r1" "a" "b" "this is spam"))
(mod-sev-test!
"strictest spam → hide"
(get
(mod/decide-strictest mod-sev-spam (list mod-sev-spam) mod/default-rules)
:action)
"hide")
(define mod-sev-clean (mod/mk-report "r2" "a" "b" "a fine post"))
(mod-sev-test!
"strictest clean → keep"
(get
(mod/decide-strictest
mod-sev-clean
(list mod-sev-clean)
mod/default-rules)
:action)
"keep")
(mod-sev-test!
"decision tagged strategy strictest"
(get
(mod/decide-strictest mod-sev-spam (list mod-sev-spam) mod/default-rules)
:strategy)
"strictest")
;; ── strictest diverges from first-match when order ≠ severity ──
(define
mod-sev-rules
(list
(mod/mk-rule
"early-escalate"
:escalate (list (list :count-at-least 1)))
(mod/mk-rule "spam-remove" :remove (list (list :classification "spam")))
(mod/mk-rule "default-keep" :keep (list))))
(define mod-sev-r (mod/mk-report "r3" "a" "b" "this is spam"))
(mod-sev-test!
"first-match picks earliest rule (escalate)"
(get (mod/decide-report mod-sev-r (list mod-sev-r) mod-sev-rules) :action)
"escalate")
(mod-sev-test!
"strictest picks harshest action (remove)"
(get
(mod/decide-strictest mod-sev-r (list mod-sev-r) mod-sev-rules)
:action)
"remove")
(mod-sev-test!
"strictest names the harshest rule"
(get (mod/decide-strictest mod-sev-r (list mod-sev-r) mod-sev-rules) :rule)
"spam-remove")
(mod-sev-test!
"strictest carries proof goals"
(len
(get
(get
(mod/decide-strictest mod-sev-r (list mod-sev-r) mod-sev-rules)
:proof)
:goals))
1)
;; ── strictest among three matches (spam + repeated) ──
(define mod-sev-rep (mod/mk-report "r4" "a" "b" "buy now spam"))
(define mod-sev-reps (list mod-sev-rep mod-sev-rep mod-sev-rep))
(mod-sev-test!
"strictest among hide+escalate+keep → hide (default rules)"
(get
(mod/decide-strictest mod-sev-rep mod-sev-reps mod/default-rules)
:action)
"hide")
;; ── strictest-sol helper ──
(mod-sev-test!
"strictest-sol picks max severity"
(dict-get
(mod/strictest-sol (list {:Action "keep" :Rule "k"} {:Action "remove" :Rule "r"} {:Action "hide" :Rule "h"}))
"Action")
"remove")
(mod-sev-test! "strictest-sol nil for empty" (mod/strictest-sol (list)) nil)
(define mod-severity-tests-run! (fn () {:failures mod-sev-failures :total mod-sev-count :passed mod-sev-pass :failed mod-sev-fail}))

View File

@@ -1,108 +0,0 @@
;; 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}))

View File

@@ -1,156 +0,0 @@
;; 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}))

View File

@@ -1,116 +0,0 @@
;; 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}))

View File

@@ -1,117 +0,0 @@
;; 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}))

View File

@@ -1,96 +0,0 @@
;; 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}))

View File

@@ -1,56 +0,0 @@
;; 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))))

View File

@@ -1,56 +0,0 @@
;; 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))))))

View File

@@ -1,55 +0,0 @@
;; 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)))

View File

@@ -1,136 +0,0 @@
# 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.

View File

@@ -16,7 +16,7 @@ federation extension via fed-sx for remote-node execution.
## Status (rolling) ## Status (rolling)
`bash lib/flow/conformance.sh`**0/0** (not yet started) `bash lib/flow/conformance.sh`**166/166** (Phases 1-8 complete; host ABI + reference driver)
## Ground rules ## Ground rules
@@ -62,47 +62,167 @@ lib/flow/spec.sx lib/flow/runtime.sx lib/flow/store.sx
## Phase 1 — Declarative DAG + sequential execution ## Phase 1 — Declarative DAG + sequential execution
- [ ] `lib/flow/spec.sx``defflow` macro, `sequence` combinator - [x] `lib/flow/spec.sx``defflow` macro, `sequence` combinator
- [ ] node = Scheme thunk; output threads to next node (data flow) - [x] node = Scheme procedure of one arg (upstream value threaded in); output
- [ ] `parallel` combinator (sequential semantics for now — TRUE parallelism in Phase 3) threads to next node (data flow). A node ignoring its arg is a thunk.
- [ ] runtime executes a flow synchronously, returns final value - [x] `parallel` combinator (sequential semantics for now — TRUE parallelism in Phase 3)
- [ ] `lib/flow/api.sx``(flow/start name args)` entry point - [x] runtime executes a flow synchronously, returns final value
- [ ] `lib/flow/tests/basic.sx` — 15+ cases: linear sequence, nested sequences, - [x] `lib/flow/api.sx``(flow/start flow input)` entry point
data flow between nodes, parallel-with-join - [x] `lib/flow/tests/basic.sx` — 18 cases: single nodes, linear/nested sequence,
- [ ] `lib/flow/scoreboard.{json,md}` data flow between nodes, parallel-with-join, publish-shaped flow
- [ ] `lib/flow/conformance.sh` - [x] `lib/flow/scoreboard.{json,md}`
- [x] `lib/flow/conformance.sh`
## Phase 2 — Control flow + error handling ## Phase 2 — Control flow + error handling
- [ ] `cond` combinator — predicate selects branch - [x] `cond` combinator — predicate selects branch (named `branch`; `cond` is a
- [ ] `retry n [backoff]` — re-runs node up to n times on exception Scheme special form). `(branch pred then else)` — 6 tests.
- [ ] `timeout ms`bounds node execution - [x] `retry n`re-runs node up to n attempts on a raised exception; last
- [ ] `try-catch` — exception handler with reified error exception propagates. Only raised exceptions are retried `(fail ...)` values
- [ ] error model — exceptions vs explicit `(fail :reason ...)` results pass through. 6 tests. (Backoff deferred: no wall clock in pure SX.)
- [ ] `lib/flow/tests/control.sx` — 25+ cases: each combinator + composition - [x] `timeout budget` — bounds node execution via a **cooperative step budget**
(deterministic; no scheduler/clock in pure SX). Nodes opt in via `(tick)`;
`budget` ticks allowed, the next raises `flow-timeout`. Non-ticking nodes are
unbounded; budgets nest. 7 tests.
- [x] `try-catch` — exception handler with reified error: `(try-catch node handler)`
runs node; on raise, calls `(handler error)` and returns its value. 6 tests.
- [x] error model — exceptions vs explicit `(fail reason)` results: `fail`/`failed?`/
`fail-reason` produce/inspect failure values that flow downstream as data
(distinct from raised exceptions caught by retry/try-catch). 6 tests.
- [x] `lib/flow/tests/control.sx` — 31 cases: branch, error model, try-catch,
retry, timeout + compositions
## Phase 3 — Suspend / resume (the showcase) ## Phase 3 — Suspend / resume (the showcase)
- [ ] `(suspend reason)``call/cc` captures continuation, returns flow-id to caller - [x] `(suspend tag)` — guest call/cc is ESCAPE-ONLY (re-entry hangs), so resume
- [ ] `lib/flow/store.sx` — serialize flow state (continuation + open vars) uses **deterministic replay**: suspend escapes to the driver as `(flow-suspended
- [ ] `(flow/resume id value)` — load continuation, inject value, re-enter tag)`; resume re-runs the flow, replaying resolved suspends from a `(tag value)`
- [ ] `(flow/cancel id)` — explicit termination log. No live continuation is ever serialized — the log is plain data.
- [ ] crash recovery — on restart, scan store for paused flows, mark resumable - [x] `lib/flow/store.sx` — flow store: id→record `(flow input log status payload)`;
- [ ] `lib/flow/tests/suspend.sx` — pause-resume scenarios, cancellation, "restart" `flow-drive` runs a flow against a replay log.
scenarios (simulated by re-loading store) - [x] `(flow/resume id value)` — append `(tag value)` to the log, re-drive; raw
result on completion, `(flow-suspended id tag)` on a further suspend.
- [x] `(flow/cancel id)` — mark cancelled; a later resume is rejected (stale replay
cannot wake a cancelled flow).
- [x] crash recovery — `flow-store-export` (procs nulled → plain data),
`flow-store-import!`, `flow-resumable-ids`. Records are name-keyed; resume
re-resolves the proc by name (defflow registers names), so a flow survives a
wiped store. `tests/recovery.sx`, 8 cases (export/wipe/import, resumable scan,
restart-at-every-step, replay-log survival).
- [x] `lib/flow/tests/suspend.sx` — 17 cases: start/resume/cancel, multi-step,
replay determinism, lifecycle guards, suspend-in-branch
- Harness: `flow-run` now reuses one env with a per-test reset (building the full
standard env 66× was too slow) — see `api.sx`.
## Phase 4 — Distributed nodes via fed-sx ## Phase 4 — Distributed nodes via fed-sx
- [ ] `(remote-node addr fn args)` — execute node on a federation peer - [x] `(remote-node addr fn)` — execute a node on a federation peer. Transport is
- [ ] failure semantics — retry on different peer, fall through to local the fed-sx boundary, MOCKED via a peer registry (`flow-peer-register!`); raises
- [ ] persistence across instances — flow state replicates via fed-sx `flow-remote-unreachable` / `flow-remote-no-fn`. Composes with sequence, suspend,
- [ ] handoff — flow started here can resume on a peer if the local instance is down retry. `tests/distributed.sx`, 7 cases.
- [ ] `lib/flow/tests/distributed.sx` — federated flow scenarios (mock fed-sx in tests) - [x] failure semantics — `(remote-failover addrs fn local)` tries each peer in
order, moves to the next on any raised error, and runs the `local` node if every
peer fails. 6 tests.
- [x] persistence across instances — `(flow-replicate-to addr)` copies this
instance's store (the plain-data export) to a peer's replica slot;
`(flow-restore-from addr)` imports it. Same mechanism as crash recovery, across
instances.
- [x] handoff — a flow started here resumes on a peer after the local instance dies:
replicate → wipe local store → restore on peer → `flow/resume`. The replay log
(and thus all resolved suspends) survives the move.
- [x] `lib/flow/tests/distributed.sx` — 19 cases: remote-node, failover,
replication, handoff (including replay-log survival across the move)
## Phase 5 — Operational API + combinator library
The four roadmap phases are complete; this phase rounds out the engine into
something operators and authors actually use. Accumulation, not a rewrite.
- [x] introspection API — `flow/status id`, `flow/result id`, `flow/list`,
`flow/pending` (operator view of what each suspended flow awaits). 12 tests in
`tests/api.sx`.
- [x] store hygiene — `flow/gc` drops terminal (done/cancelled) records keeping
live suspended flows (returns count); `flow/forget id` drops one terminal record
and refuses live flows. Bounds unbounded store growth. 9 tests in `tests/hygiene.sx`.
- [x] `tap` — side-effecting pass-through node (logging/metrics) that returns input
- [x] `recover` — complement to try-catch for the fail-VALUE channel: run node; if it
yields `(fail ...)`, run a recovery node on the reason
- [x] `map-flow` — run a flow per item of a list, join results (sequential)
- [x] `flow-while` / `flow-until` — bounded iteration: re-run body threading the
value while/until pred holds, capped at `max` steps (deterministic bound)
- [x] `lib/flow/tests/api.sx` (12) + `lib/flow/tests/combinators.sx` (17)
## Phase 6 — Railway-oriented composition
Make the `(fail reason)` value channel compose into real validation/ETL pipelines.
- [x] `attempt` — like `sequence`, but short-circuits at the first node that returns
a `(fail ...)` value, returning that failure (the railway track). Pairs with
`recover` for the rejoin.
- [x] `lib/flow/tests/railway.sx` — 10 cases: fail short-circuiting, no-run-after-
failure, recover rejoin, validation pipeline reporting the failing stage
## Phase 8 — Host integration ABI (art-dag / human-in-the-loop)
`suspend` is the seam to the outside world, but a bare tag is an ad-hoc convention.
This phase defines a stable request/response contract a host (an art-dag driver, a
review UI) codes against — so flow can orchestrate art-dag with human decision
points later without reverse-engineering tag shapes. `lib/flow/host.sx`.
- [x] `(request kind payload)` — suspend with a typed `(flow-request kind payload)`
envelope; evaluates to the host's resume value. `await-human`/`await-render`/
`await-effect` sugar.
- [x] `(flow-host-requests)` — the host work queue: `(id kind payload)` for every
suspended flow waiting on a host request; `request?`/`request-kind`/
`request-payload` parse a tag.
- [x] `(flow-drive-host dispatch)` / `(flow-run-host dispatch maxticks)` — reference
host driver: the host supplies only a `(kind payload) -> answer` dispatch fn; the
loop drains pending requests and resumes until quiescent (bounded).
- [x] `lib/flow/tests/host.sx` — 15 cases incl. the art-dag-shaped driver loop
(render → human-review → publish) run both manually and via `flow-run-host`.
- Contract (documented in `host.sx` + README): the host owns IO + persistence; a
flow never does IO, it only `request`s; the host performs the effect and feeds the
result back via resume (logged, so not re-run on recovery). NOT done here (host
side, out of `lib/flow` scope): the real Celery/IPFS bridge and a persistent store
backend — those live in the art-dag integration, coding against this ABI.
## Phase 7 — End-to-end integration
Prove the phases compose: realistic flows exercising attempt + suspend + branch +
remote-node + crash-recovery + handoff + introspection together.
- [x] `lib/flow/tests/integration.sx` — 10 cases: an order-processing flow (validate
→ payment suspend → branch → ledger federation) and an onboarding flow, run through
the full lifecycle including a simulated crash and a peer handoff mid-flow, plus
introspection (`flow/pending`/`status`/`result`) during the flow's life
## Progress log ## Progress log
(loop fills this in) - **Phase 1 (combinators + sequential runtime).** Flow built as a Scheme prelude
loaded onto `scheme-standard-env`: a flow is a Scheme procedure `input -> output`,
so the whole flow runs inside the interpreter (sets up Phase 3 call/cc suspend).
Combinators `flow-node`/`flow-id`/`flow-const`/`sequence`/`parallel`/`defflow` in
`spec.sx`; `flow/start` + SX helpers (`flow-make-env`/`flow-run`) in `api.sx`.
18/18 in `tests/basic.sx`. Substrate constraints found: dotted rest params
`(a . rest)` and named `let` are unsupported in `lib/scheme/eval.sx`, so
combinators use `(lambda args ...)` variadics + top-level recursion. Scheme
strings come back boxed as `{:scm-string "..."}` — unwrap with `(get s :scm-string)`.
- **Phases 2-4.** Control flow (branch/retry/timeout/try-catch + fail-value error
model), then the showcase: durable suspend/resume. Guest call/cc is escape-only
(re-entry hangs), so resume uses **deterministic replay** — re-run the flow,
replaying resolved suspends from a `(tag value)` log; only plain data persists, so
flows survive a wiped store (crash recovery) and a move to another instance
(replication + handoff). Phase 4 models the fed-sx boundary with a mock peer
registry. Timeout is a cooperative step budget (no wall clock in pure SX). Test
harness reuses one env with a per-test reset for speed.
- **Phases 5-7 + docs.** Operational API (introspection, hygiene), combinator
library (tap/recover/map-flow/while/until), railway `attempt`, end-to-end
integration suite, and `lib/flow/README.md` (full API reference + replay-semantics
contract). **151/151 across 10 suites.** Conformance sx_server timeout raised to
540s for the 10-suite run under shared-machine CPU contention.
## Blockers ## Blockers
(loop fills this in) (none)

View File

@@ -16,7 +16,7 @@ federation extension.
## Status (rolling) ## Status (rolling)
`bash lib/mod/conformance.sh`**390/390** (roadmap + 19 extensions complete) `bash lib/mod/conformance.sh`**0/0** (not yet started)
## Ground rules ## Ground rules
@@ -66,386 +66,47 @@ lib/mod/fed.sx
## Phase 1 — Report representation + simple policy ## Phase 1 — Report representation + simple policy
- [x] `lib/mod/schema.sx``report(id, by, about)`, `classification(id, kind)`, - [ ] `lib/mod/schema.sx``report(id, by, about, reason)`, `evidence(id, kind, val)`,
`report_count(subject, n)` Prolog facts; keyword classifier derives evidence `policy-action(report, action)` predicates as Prolog facts/rules
- [x] `lib/mod/policy.sx``mod/mk-rule` + ordered `mod/default-rules`; conditions - [ ] `lib/mod/policy.sx`rule declarations: `(defrule action :when conditions)`
(`:classification`, `:count-at-least`) compile to Prolog goals; `policy_action/3` desugars to Prolog clause
clauses, last clause `true` so every report yields at least `:keep` - [ ] `lib/mod/engine.sx``(decide report-id)` runs Prolog query, returns first
- [x] `lib/mod/engine.sx``(mod/decide-report r reports rules)` queries matching action
`policy_action(Id, Action, Rule)` with `pl-query-one` (clause order = precedence); - [ ] `lib/mod/api.sx``(mod/report by about reason)`, `(mod/decide id)`
returns a decision dict `{:action :rule :report-id :proof}` carrying the why - [ ] `lib/mod/tests/decide.sx` — 15+ cases: spam keyword → hide, repeated reports →
- [x] `lib/mod/api.sx` — registry + `(mod/report by about reason)`, `(mod/decide id)` escalate, no rule matches → keep
- [x] `lib/mod/tests/decide.sx` — 31 cases: spam/abuse keyword, repeated→escalate, - [ ] `lib/mod/scoreboard.{json,md}`
no-rule→keep, precedence (spam beats repeated), proof shape, registry ids - [ ] `lib/mod/conformance.sh`
- [x] `lib/mod/scoreboard.{json,md}`
- [x] `lib/mod/conformance.sh`
## Phase 2 — Evidence + audit trail ## Phase 2 — Evidence + audit trail
- [x] evidence accumulation — `report :evidence` list; `mod/attach-evidence` + - [ ] evidence accumulation — additional facts asserted before query
api `mod/add-evidence`; asserted as `evidence(Id, 'kind', 'val')` facts; - [ ] proof tree from Prolog derivation tree
new `:evidence` condition + `reviewer-remove` rule consume it - [ ] `lib/mod/audit.sx` — append-only log (decision + proof + evidence snapshot)
- [x] proof tree from Prolog derivation — `mod/proof-goals` re-queries each body - [ ] `(mod/audit id)` retrieval
goal (id bound) against the same DB, recording goal text, solved?, and the - [ ] `lib/mod/tests/audit.sx` — proof correctness, trail completeness
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 ## Phase 3 — Escalation + lifecycle state machine
- [x] state machine: `lib/mod/lifecycle.sx``:open → :triaged → :decided → - [ ] state machine: `:open → :triaged → :decided → :appealed → :final`
:appealed → :final` as a pure SX module over the engine; transition table guards - [ ] auto-tier: first-pass rules decide quick cases
illegal moves (sets `:error`, leaves state); immutable cases with `:history` - [ ] human-tier: rules that emit `:escalate` move to next state
- [x] auto-tier: `mod/case-triage` runs the engine; terminal action (hide/remove/ - [ ] appeal: re-runs with appeal evidence, may override prior decision
keep) → tier `auto`, `mod/case-resolve` advances to `:decided` - [ ] `(mod/appeal id new-evidence)` API
- [x] human-tier: `:escalate` action → tier `human`; `mod/case-resolve` is blocked - [ ] `lib/mod/tests/escalation.sx` — full lifecycle traversal cases
(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 ## Phase 4 — Federation
- [x] cross-instance reports — `mod/fed-receive-report peer …` ingests a peer's - [ ] cross-instance reports — peer raises report about local content (or vice versa)
report into the local registry, tagging origin; `mod/report-origin` resolves it - [ ] decision sharing — actions taken locally propagate to peers via fed-sx
(local reports default to `"local"`); the engine decides federated reports - [ ] trust model — peer's decision is advisory unless `(trust peer :mod)` is granted
unchanged - [ ] revocation — undo applied moderation if proof was invalidated
- [x] decision sharing — `mod/fed-share-decision decision peers` pushes messages to - [ ] `lib/mod/tests/fed.sx` — federated decision chains (mock fed-sx in tests)
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 ## Progress log
- **Ext 19 — end-to-end triage pipeline, 390/390** (+15). Capstone: one (loop fills this in)
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 ## Blockers
(none) (loop fills this in)