Compare commits

..

13 Commits

Author SHA1 Message Date
9437f99e28 acl: hardening suite (+25) — diamonds, cycles, validation, audit save/restore
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 35s
New adversarial/cross-phase coverage: diamond resource+group hierarchies
(deny wins per path), chain inheritance + leaf deny, cycle termination,
multi-peer delegation, fact validation, audit snapshot/restore round-trip.
Adds acl-validate-facts/acl-facts-valid? (schema) and acl-audit-snapshot/
restore!/copy (audit). Fixed acl-audit-restore! rebuilding the live log via
map (append! silently no-ops on map-derived lists).

Suite is prover-free: a substrate JIT bug loops the recursive proof
reconstructor on deep chains in warm processes (documented in Blockers);
acl-permit? is unaffected. 145/145.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 22:44:28 +00:00
40be9cd074 acl: Phase 4 federation (trust-gated delegation, revocation) + 31 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 10m25s
federation.sx adds peer/trust/delegate/level_covers facts and one engine
rule: delegated grants apply only when local trust covers the action,
re-checked every query (non-transitive, fail-safe). Local/inherited deny
overrides federated grants; delegation composes with group and resource
inheritance. acl-revoke!/acl-fed-assert! propagate retraction/assertion;
mock fed-sx transport for tests. Federated proofs reconstruct via the
existing explainer. Roadmap complete: 120/120.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 16:54:34 +00:00
15c97119e4 acl: Phase 3 explanation + audit, 35 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 40s
explain.sx reconstructs a canonical proof tree (first-rule, first-solution)
by goal-directed search over the saturated db, since Datalog keeps no
provenance; depth-capped for cyclic safety. acl-explain returns
{:allowed? :proof :reason} with the blocking eff_deny proof on denial.
audit.sx is an append-only decision log (monotonic seq, disk serializer).
api gains acl/explain, acl/audit, acl/audit-tail.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 16:47:07 +00:00
9261d69cc5 acl: Phase 2 inheritance (groups, resource trees, roles) + 30 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 36s
eff_grant/eff_deny derived relations inherit through member_of (group +
role membership) and child_of (resource hierarchy); role_grant confers
role capabilities. Deny-overrides via stratified negation, deny
authoritative across the inheritance closure. Cyclic membership
terminates. Phase 1 suite unchanged.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 16:36:24 +00:00
fe47334e52 acl: Phase 1 direct grants + deny-overrides, 24 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 56s
Datalog ACL layer (schema/facts/engine/api) over lib/datalog/. Direct
grant permits unless explicit deny names same (S,A,R) — deny-overrides
via stratified negation. Conformance wrapper + scoreboard.

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

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

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

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

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

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

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

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

45
lib/acl/api.sx Normal file
View File

@@ -0,0 +1,45 @@
;; lib/acl/api.sx — public ACL surface over an implicit current db.
;;
;; Callers load a fact set once, then issue decisions without threading the db
;; through every call. The current db is module state; (acl/load! facts) rebuilds
;; it. This is the boundary the rest of rose-ash imports.
(define acl-current-db nil)
;; Replace the current fact base. Rebuilds the Datalog db under the active
;; ruleset (see lib/acl/engine.sx).
(define
acl/load!
(fn
(facts)
(do (set! acl-current-db (acl-build-db facts)) acl-current-db)))
;; Ensure a db exists, building an empty one on first use.
(define
acl-ensure-db!
(fn
()
(do
(when
(= acl-current-db nil)
(set! acl-current-db (acl-build-db (list))))
acl-current-db)))
;; Public decision against the current db (pure, no logging).
(define
acl/permit?
(fn (subj act res) (acl-permit? (acl-ensure-db!) subj act res)))
;; Decision-with-proof against the current db. See lib/acl/explain.sx.
(define
acl/explain
(fn (subj act res) (acl-explain (acl-ensure-db!) subj act res)))
;; Audited decision: logs the outcome to the append-only audit log and returns
;; the boolean. See lib/acl/audit.sx.
(define
acl/audit
(fn (subj act res) (acl-audit-decide! (acl-ensure-db!) subj act res)))
;; Recent audited decisions (chronological).
(define acl/audit-tail (fn (n) (acl-audit-tail n)))

110
lib/acl/audit.sx Normal file
View File

@@ -0,0 +1,110 @@
;; lib/acl/audit.sx — append-only decision log.
;;
;; Every decision routed through acl-audit-decide! is appended to an in-memory
;; log with a monotonic sequence number (no wall-clock — deterministic and
;; testable; a host can stamp time at the serializer boundary). The log is
;; append-only: there is no mutate or delete, only append, tail, clear,
;; snapshot/restore, and serialize-for-disk.
(define acl-audit-log (list))
(define acl-audit-seq 0)
;; Copy a list into a fresh, append!-able list. `map`/`rest`-derived lists are
;; NOT extensible by append! in this runtime (it silently no-ops), so the live
;; log must always be a list built with `list` + `append!`.
(define
acl-audit-copy
(fn
(xs)
(let
((fresh (list)))
(do (for-each (fn (e) (append! fresh e)) xs) fresh))))
(define
acl-audit-clear!
(fn
()
(do (set! acl-audit-log (list)) (set! acl-audit-seq 0) nil)))
;; Append a decision record. Returns the record.
(define
acl-audit-record!
(fn
(subj act res allowed?)
(let
((entry {:allowed? allowed? :act act :subj subj :res res :seq acl-audit-seq}))
(do
(set! acl-audit-seq (+ acl-audit-seq 1))
(append! acl-audit-log entry)
entry))))
;; Decide against db, log the outcome, and return the boolean. This is the
;; audited path; acl-permit? remains the pure, side-effect-free decision.
(define
acl-audit-decide!
(fn
(db subj act res)
(let
((allowed? (acl-permit? db subj act res)))
(do (acl-audit-record! subj act res allowed?) allowed?))))
(define acl-audit-count (fn () (len acl-audit-log)))
;; Most recent n entries (in chronological order). n >= log size returns all.
(define
acl-audit-tail
(fn
(n)
(let
((total (len acl-audit-log)))
(if
(<= total n)
acl-audit-log
(acl-audit-drop acl-audit-log (- total n))))))
(define
acl-audit-drop
(fn
(xs k)
(if (<= k 0) xs (acl-audit-drop (rest xs) (- k 1)))))
;; Structured snapshot for save/restore — a {:seq :entries} value carrying a
;; copy of the log (so later appends don't mutate a held snapshot).
(define acl-audit-snapshot (fn () {:seq acl-audit-seq :entries (acl-audit-copy acl-audit-log)}))
;; Replace the live log from a snapshot. Restores both entries and the seq
;; counter so subsequent records continue numbering correctly. The log is
;; rebuilt as a fresh append!-able list (see acl-audit-copy).
(define
acl-audit-restore!
(fn
(snap)
(do
(set! acl-audit-log (acl-audit-copy (get snap :entries)))
(set! acl-audit-seq (get snap :seq))
nil)))
;; Serialize the whole log to a disk-ready string: one record per line,
;; "seq\tsubj\tact\tres\tallowed?". A host writes this; structured reload is via
;; snapshot/restore.
(define
acl-audit-serialize
(fn
()
(reduce
(fn
(acc e)
(str
acc
(get e :seq)
"\t"
(get e :subj)
"\t"
(get e :act)
"\t"
(get e :res)
"\t"
(get e :allowed?)
"\n"))
""
acl-audit-log)))

32
lib/acl/conformance.conf Normal file
View File

@@ -0,0 +1,32 @@
# ACL conformance config — sourced by lib/guest/conformance.sh.
LANG_NAME=acl
MODE=dict
PRELOADS=(
lib/datalog/tokenizer.sx
lib/datalog/parser.sx
lib/datalog/unify.sx
lib/datalog/db.sx
lib/datalog/builtins.sx
lib/datalog/aggregates.sx
lib/datalog/strata.sx
lib/datalog/eval.sx
lib/datalog/api.sx
lib/datalog/magic.sx
lib/acl/schema.sx
lib/acl/facts.sx
lib/acl/engine.sx
lib/acl/explain.sx
lib/acl/audit.sx
lib/acl/federation.sx
lib/acl/api.sx
)
SUITES=(
"direct:lib/acl/tests/direct.sx:(acl-direct-tests-run!)"
"inherit:lib/acl/tests/inherit.sx:(acl-inherit-tests-run!)"
"explain:lib/acl/tests/explain.sx:(acl-explain-tests-run!)"
"fed:lib/acl/tests/fed.sx:(acl-fed-tests-run!)"
"harden:lib/acl/tests/harden.sx:(acl-harden-tests-run!)"
)

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

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

72
lib/acl/engine.sx Normal file
View File

@@ -0,0 +1,72 @@
;; lib/acl/engine.sx — ACL ruleset + decision reducer over lib/datalog/.
;;
;; The engine is a thin layer: it owns the permit ruleset (SX data rules) and
;; reduces a (subject, action, resource) decision to a Datalog query against a
;; db built from EDB facts. The rule engine itself is Datalog's.
;;
;; Policy — inheritance + federation with deny-overrides:
;;
;; eff_grant(S,A,R) :- grant(S,A,R). ; direct
;; eff_grant(S,A,R) :- member_of(S,G), eff_grant(G,A,R). ; group/role chain
;; eff_grant(S,A,R) :- child_of(R,P), eff_grant(S,A,P). ; resource tree
;; eff_grant(S,A,R) :- member_of(S,Role), role_grant(Role,A,R). ; role expansion
;; eff_grant(S,A,R) :- delegate(Peer,S,A,R), ; federated grant
;; trust(Peer,L), level_covers(L,A).
;;
;; eff_deny(S,A,R) :- deny(S,A,R). ; direct
;; eff_deny(S,A,R) :- member_of(S,G), eff_deny(G,A,R). ; group chain
;; eff_deny(S,A,R) :- child_of(R,P), eff_deny(S,A,P). ; resource tree
;;
;; permit(S,A,R) :- eff_grant(S,A,R), not eff_deny(S,A,R).
;;
;; DENY-OVERRIDES: an effective deny anywhere in the inheritance closure of
;; (S,A,R) defeats any effective grant — including federated grants. Deny
;; inherits through the *same* group and resource chains as grant, so a
;; group-level or ancestor-resource deny is authoritative for members/
;; descendants. This is the principled, fail-safe reading of "deny wins".
;;
;; FEDERATION — non-transitive trust: a peer's `delegate` fact only grants if a
;; *local* `trust(Peer, L)` exists AND that level `level_covers` the action.
;; Trust is re-checked on every query (it is a body literal), never baked in at
;; fact-ingestion time, so revoking trust or narrowing a level takes effect
;; immediately on the next decision.
;;
;; Termination & stratification:
;; - eff_grant/eff_deny recurse only over member_of and child_of, which are
;; EDB relations with no function symbols, so the closure is finite (cyclic
;; membership/containment just reaches a fixpoint, never loops). The
;; federation rule is non-recursive.
;; - permit negates eff_deny; neither eff_grant nor eff_deny depends on
;; permit, so the program is stratifiable (permit sits in a higher stratum).
(define
acl-rules
(quote
((eff_grant S A R <- (grant S A R))
(eff_grant S A R <- (member_of S G) (eff_grant G A R))
(eff_grant S A R <- (child_of R P) (eff_grant S A P))
(eff_grant S A R <- (member_of S Role) (role_grant Role A R))
(eff_grant
S
A
R
<-
(delegate Peer S A R)
(trust Peer L)
(level_covers L A))
(eff_deny S A R <- (deny S A R))
(eff_deny S A R <- (member_of S G) (eff_deny G A R))
(eff_deny S A R <- (child_of R P) (eff_deny S A P))
(permit S A R <- (eff_grant S A R) {:neg (eff_deny S A R)}))))
;; Build a Datalog db from a list of EDB facts under the ACL ruleset.
(define acl-build-db (fn (facts) (dl-program-data facts acl-rules)))
;; Core decision: does the db permit subject S to perform action A on
;; resource R? Reduces to a ground Datalog query on the derived `permit`
;; relation — non-empty result means permitted.
(define
acl-permit?
(fn
(db subj act res)
(> (len (dl-query db (list (quote permit) subj act res))) 0)))

125
lib/acl/explain.sx Normal file
View File

@@ -0,0 +1,125 @@
;; lib/acl/explain.sx — proof-tree reconstruction over the saturated db.
;;
;; lib/datalog/ records derived facts but not their provenance, so the proof is
;; reconstructed here by goal-directed search over the *saturated* db: for a
;; ground goal we find the first ACL rule (in rule order) whose body holds, take
;; the first solution binding its remaining variables, and recurse on each body
;; literal. Negated literals are recorded as verified `:neg-ok` leaves.
;;
;; CANONICAL DERIVATION: the Datalog derivation graph is a DAG (a fact may hold
;; many ways). We pick ONE canonical proof — first matching rule, first solution
;; — matching the rule order in lib/acl/engine.sx (direct/EDB rules first). A
;; depth cap guards against pathological cyclic data producing unbounded search.
;;
;; A proof node is one of:
;; {:fact <lit> :via "edb"} — base EDB fact
;; {:fact <lit> :rule <head> :body (<node|negleaf> ...)} — derived
;; {:neg-ok <lit>} — negation verified to fail
;; {:fact <lit> :truncated true} — depth cap hit
(define acl-proof-max-depth 64)
;; Substitute a body literal, descending into {:neg ...} dicts (dl-apply-subst
;; does not recurse into dicts, which would leak the neg's free vars).
(define
acl-subst-lit
(fn
(lit s)
(if
(and (dict? lit) (has-key? lit :neg))
{:neg (dl-apply-subst (get lit :neg) s)}
(dl-apply-subst lit s))))
(define
acl-lit-edb?
(fn
(lit)
(and
(list? lit)
(> (len lit) 0)
(symbol? (first lit))
(has-key? acl-edb-arity (symbol->string (first lit))))))
(define
acl-subst-zip!
(fn
(d ks vs)
(when
(> (len ks) 0)
(do
(dict-set! d (symbol->string (first ks)) (first vs))
(acl-subst-zip! d (rest ks) (rest vs))))))
;; Bind a rule head's variables to a ground goal's arguments (positional).
(define
acl-bind-head
(fn
(head goal)
(let
((d {}))
(do (acl-subst-zip! d (rest head) (rest goal)) d))))
(define
acl-subst-union
(fn
(a b)
(let
((d {}))
(do
(for-each (fn (k) (dict-set! d k (get a k))) (keys a))
(for-each (fn (k) (dict-set! d k (get b k))) (keys b))
d))))
(define acl-prove (fn (db goal) (acl-prove-d db goal 0)))
(define
acl-prove-d
(fn
(db goal depth)
(cond
((> depth acl-proof-max-depth) {:truncated true :fact goal})
((acl-lit-edb? goal)
(if (> (len (dl-query db goal)) 0) {:via "edb" :fact goal} nil))
(else (acl-prove-rules db goal acl-rules depth)))))
(define
acl-prove-rules
(fn
(db goal rules depth)
(if
(= (len rules) 0)
nil
(let
((p (dl-rule-from-list (first rules))))
(if
(= (first (get p :head)) (first goal))
(let
((hs (acl-bind-head (get p :head) goal)))
(let
((qbody (map (fn (l) (acl-subst-lit l hs)) (get p :body))))
(let
((sols (dl-query db qbody)))
(if
(> (len sols) 0)
(acl-prove-build db goal p hs (first sols) depth)
(acl-prove-rules db goal (rest rules) depth)))))
(acl-prove-rules db goal (rest rules) depth))))))
(define
acl-prove-build
(fn
(db goal p hs sol depth)
(let ((full (acl-subst-union hs sol))) {:body (map (fn (l) (let ((g (acl-subst-lit l full))) (if (and (dict? g) (has-key? g :neg)) {:neg-ok (get g :neg)} (acl-prove-d db g (+ depth 1))))) (get p :body)) :rule (get p :head) :fact goal})))
;; Public decision-with-proof. Returns:
;; {:allowed? <bool> :proof <node|nil> :reason <eff_deny proof|nil>}
;; When permitted, :proof is the permit derivation. When denied, :proof is nil
;; and :reason carries the blocking eff_deny proof if one exists (an explicit or
;; inherited deny), else nil (simply no grant).
(define
acl-explain
(fn
(db subj act res)
(let
((proof (acl-prove db (list (quote permit) subj act res))))
(if (= proof nil) {:allowed? false :proof nil :reason (acl-prove db (list (quote eff_deny) subj act res))} {:allowed? true :proof proof :reason nil}))))

47
lib/acl/facts.sx Normal file
View File

@@ -0,0 +1,47 @@
;; lib/acl/facts.sx — EDB fact constructors.
;;
;; Each constructor returns a Datalog fact tuple (a list whose head is the
;; predicate symbol). These are the only shapes lib/acl/engine.sx feeds to
;; lib/datalog/.
;; Phase 1: actor/resource/grant/deny.
;; Phase 2: member_of (subject -> group/role), child_of (resource -> parent),
;; role_grant (role -> action,resource capability).
;; Phase 4: peer/trust/delegate/level_covers (federation).
(define acl-actor (fn (id kind) (list (quote actor) id kind)))
(define acl-resource-fact (fn (id kind) (list (quote resource) id kind)))
(define acl-grant (fn (subj act res) (list (quote grant) subj act res)))
(define acl-deny (fn (subj act res) (list (quote deny) subj act res)))
;; subject S is a member of group/role G (one hop; transitivity is derived).
(define acl-member-of (fn (subj grp) (list (quote member_of) subj grp)))
;; resource R is a child of parent P (one hop; transitivity is derived).
(define acl-child-of (fn (res parent) (list (quote child_of) res parent)))
;; role confers capability (act on res) to every member of the role.
(define
acl-role-grant
(fn (role act res) (list (quote role_grant) role act res)))
;; --- federation ---
;; a known peer instance at addr, of some kind (e.g. peer).
(define acl-peer (fn (addr kind) (list (quote peer) addr kind)))
;; local trust in a peer at a named level. Gates delegated grants at query time.
(define acl-trust (fn (peer level) (list (quote trust) peer level)))
;; a peer asserts that subject S may A on R. Only takes effect if local trust in
;; that peer covers action A (see level_covers).
(define
acl-delegate
(fn (peer subj act res) (list (quote delegate) peer subj act res)))
;; local policy: trust `level` authorises delegated grants for action `act`.
(define
acl-level-covers
(fn (level act) (list (quote level_covers) level act)))

61
lib/acl/federation.sx Normal file
View File

@@ -0,0 +1,61 @@
;; lib/acl/federation.sx — cross-instance ACL facts + revocation.
;;
;; fed-sx replicates ACL facts between instances; this module models the local
;; side. A peer's authority arrives as `delegate(Peer, S, A, R)` facts, which
;; only take effect when a local `trust(Peer, L)` and `level_covers(L, A)`
;; authorise them (enforced by the engine rule, re-checked every query). The
;; actual network transport is fed-sx's job and is mocked in tests as a dict.
;;
;; Trust is NOT transitive: trusting peer α does not extend to peers α trusts.
;; Only delegate facts that α itself asserts, and that local trust covers, flow.
;; Mock fed-sx pull: `transport` is a dict mapping a peer address (its string
;; name) to the list of delegate facts that peer asserts. Returns the facts for
;; `addr`, or an empty list if the peer is unknown / unreachable.
(define
acl-fed-fetch
(fn
(transport addr)
(let
((k (if (symbol? addr) (symbol->string addr) addr)))
(if (has-key? transport k) (get transport k) (list)))))
;; Gather delegate facts from every peer in `addrs` via the transport.
(define
acl-fed-collect
(fn
(transport addrs)
(let
((acc (list)))
(do
(for-each
(fn
(addr)
(for-each
(fn (f) (append! acc f))
(acl-fed-fetch transport addr)))
addrs)
acc))))
;; Build a db from local facts plus delegate facts pulled from `peers`. Local
;; facts must include the `trust`/`level_covers` policy; replicated delegate
;; facts are gated against it by the engine rule at query time.
(define
acl-fed-build-db
(fn
(local-facts transport peers)
(let
((all (list)))
(do
(for-each (fn (f) (append! all f)) local-facts)
(for-each
(fn (f) (append! all f))
(acl-fed-collect transport peers))
(acl-build-db all)))))
;; Propagated revocation: retract a replicated fact (e.g. a peer's delegate, or
;; local trust) from a live db. The next decision re-saturates and reflects it.
(define acl-revoke! (fn (db fact) (do (dl-retract! db fact) db)))
;; Propagated assertion: ingest a newly replicated fact into a live db.
(define acl-fed-assert! (fn (db fact) (do (dl-assert! db fact) db)))

71
lib/acl/schema.sx Normal file
View File

@@ -0,0 +1,71 @@
;; lib/acl/schema.sx — ACL sorts and EDB predicate vocabulary.
;;
;; Datalog is untyped; this module is the schema-as-data layer. It declares
;; the subject/resource/action sorts and the arity of every EDB predicate the
;; ACL engine recognises, plus light validators. Facts that pass these checks
;; are well-formed inputs to lib/acl/engine.sx.
(define acl-subject-kinds (quote (user group role service)))
(define acl-resource-kinds (quote (page post thread peer)))
;; Actions are open-ended (a grant may name any action symbol), but these are
;; the platform's well-known verbs.
(define acl-actions (quote (read edit comment moderate federate)))
;; EDB predicate name -> arity.
;; Phase 1: actor/resource/grant/deny.
;; Phase 2: member_of (subject->group/role), child_of (resource->parent),
;; role_grant (role->action,resource).
;; Phase 4: peer (addr->kind), trust (peer->level),
;; delegate (peer->subj,action,resource), level_covers (level->action).
(define acl-edb-arity {:role_grant 3 :child_of 2 :trust 2 :peer 2 :actor 2 :level_covers 2 :delegate 4 :member_of 2 :deny 3 :grant 3 :resource 2})
(define
acl-member?
(fn
(x xs)
(cond
((= (len xs) 0) false)
((= (first xs) x) true)
(else (acl-member? x (rest xs))))))
(define acl-subject-kind? (fn (k) (acl-member? k acl-subject-kinds)))
(define acl-resource-kind? (fn (k) (acl-member? k acl-resource-kinds)))
(define acl-known-action? (fn (a) (acl-member? a acl-actions)))
;; A fact is a list whose head is a predicate symbol. Valid when the predicate
;; is known and the argument count matches the declared arity.
(define
acl-fact-valid?
(fn
(f)
(and
(list? f)
(> (len f) 0)
(symbol? (first f))
(let
((pred (symbol->string (first f))))
(and
(has-key? acl-edb-arity pred)
(= (- (len f) 1) (get acl-edb-arity pred)))))))
;; Return the sublist of facts that fail acl-fact-valid?. Empty list means the
;; whole set is well-formed. acl-build-db stays lenient (Datalog accepts any
;; tuple, and custom action symbols are allowed); callers opt in to checking.
(define
acl-validate-facts
(fn
(facts)
(let
((bad (list)))
(do
(for-each
(fn (f) (when (not (acl-fact-valid? f)) (append! bad f)))
facts)
bad))))
(define
acl-facts-valid?
(fn (facts) (= (len (acl-validate-facts facts)) 0)))

14
lib/acl/scoreboard.json Normal file
View File

@@ -0,0 +1,14 @@
{
"lang": "acl",
"total_passed": 145,
"total_failed": 0,
"total": 145,
"suites": [
{"name":"direct","passed":24,"failed":0,"total":24},
{"name":"inherit","passed":30,"failed":0,"total":30},
{"name":"explain","passed":35,"failed":0,"total":35},
{"name":"fed","passed":31,"failed":0,"total":31},
{"name":"harden","passed":25,"failed":0,"total":25}
],
"generated": "2026-06-06T22:43:27+00:00"
}

11
lib/acl/scoreboard.md Normal file
View File

@@ -0,0 +1,11 @@
# acl scoreboard
**145 / 145 passing** (0 failure(s)).
| Suite | Passed | Total | Status |
|-------|--------|-------|--------|
| direct | 24 | 24 | ok |
| inherit | 30 | 30 | ok |
| explain | 35 | 35 | ok |
| fed | 31 | 31 | ok |
| harden | 25 | 25 | ok |

170
lib/acl/tests/direct.sx Normal file
View File

@@ -0,0 +1,170 @@
;; lib/acl/tests/direct.sx — Phase 1: direct grants + deny-overrides.
(define acl-dt-pass 0)
(define acl-dt-fail 0)
(define acl-dt-failures (list))
(define
acl-dt-check!
(fn
(name got expected)
(if
(= got expected)
(set! acl-dt-pass (+ acl-dt-pass 1))
(do
(set! acl-dt-fail (+ acl-dt-fail 1))
(append!
acl-dt-failures
(str name "\n expected: " expected "\n got: " got))))))
;; A small fixture used by most cases: alice can read page1, is denied edit on
;; page1, and a service may federate peer1.
(define
acl-dt-fixture
(fn
()
(acl-build-db
(list
(acl-actor (quote alice) (quote user))
(acl-actor (quote svc1) (quote service))
(acl-resource-fact (quote page1) (quote page))
(acl-resource-fact (quote peer1) (quote peer))
(acl-grant (quote alice) (quote read) (quote page1))
(acl-grant (quote alice) (quote edit) (quote page1))
(acl-deny (quote alice) (quote edit) (quote page1))
(acl-grant (quote svc1) (quote federate) (quote peer1))))))
(define
acl-dt-run-all!
(fn
()
(let
((db (acl-dt-fixture)))
(do
(acl-dt-check!
"direct grant permits"
(acl-permit? db (quote alice) (quote read) (quote page1))
true)
(acl-dt-check!
"service grant permits federate"
(acl-permit? db (quote svc1) (quote federate) (quote peer1))
true)
(acl-dt-check!
"missing action denied"
(acl-permit? db (quote alice) (quote comment) (quote page1))
false)
(acl-dt-check!
"missing resource denied"
(acl-permit? db (quote alice) (quote read) (quote page2))
false)
(acl-dt-check!
"missing subject denied"
(acl-permit? db (quote bob) (quote read) (quote page1))
false)
(acl-dt-check!
"wrong subject for service grant denied"
(acl-permit? db (quote alice) (quote federate) (quote peer1))
false)
(acl-dt-check!
"grant plus deny -> deny wins"
(acl-permit? db (quote alice) (quote edit) (quote page1))
false)
(acl-dt-check!
"deny alone still denies"
(acl-permit?
(acl-build-db
(list (acl-deny (quote alice) (quote read) (quote page1))))
(quote alice)
(quote read)
(quote page1))
false)
(acl-dt-check!
"deny on edit does not block read"
(acl-permit? db (quote alice) (quote read) (quote page1))
true)
(acl-dt-check!
"empty db denies"
(acl-permit?
(acl-build-db (list))
(quote alice)
(quote read)
(quote page1))
false)
(let
((db2 (acl-build-db (list (acl-grant (quote a) (quote read) (quote r)) (acl-grant (quote b) (quote read) (quote r)) (acl-deny (quote b) (quote read) (quote r))))))
(do
(acl-dt-check!
"subject a allowed"
(acl-permit? db2 (quote a) (quote read) (quote r))
true)
(acl-dt-check!
"subject b denied by override"
(acl-permit? db2 (quote b) (quote read) (quote r))
false)))
(let
((db3 (acl-build-db (list (acl-actor (quote editors) (quote role)) (acl-grant (quote editors) (quote edit) (quote post1))))))
(acl-dt-check!
"role subject direct grant"
(acl-permit? db3 (quote editors) (quote edit) (quote post1))
true))
(do
(acl/load!
(list
(acl-grant (quote carol) (quote moderate) (quote thread1))))
(acl-dt-check!
"api permit via current db"
(acl/permit? (quote carol) (quote moderate) (quote thread1))
true)
(acl-dt-check!
"api deny via current db"
(acl/permit? (quote carol) (quote read) (quote thread1))
false))
(do
(acl/load! (list))
(acl-dt-check!
"api reload clears prior grants"
(acl/permit? (quote carol) (quote moderate) (quote thread1))
false))
(acl-dt-check!
"schema grant arity valid"
(acl-fact-valid? (acl-grant (quote x) (quote read) (quote y)))
true)
(acl-dt-check!
"schema bad arity invalid"
(acl-fact-valid? (list (quote grant) (quote x)))
false)
(acl-dt-check!
"schema unknown predicate invalid"
(acl-fact-valid? (list (quote frobnicate) (quote x)))
false)
(acl-dt-check!
"schema subject kind known"
(acl-subject-kind? (quote service))
true)
(acl-dt-check!
"schema resource kind unknown"
(acl-resource-kind? (quote galaxy))
false)
(acl-dt-check!
"schema known action"
(acl-known-action? (quote moderate))
true)
(acl-dt-check!
"grant constructor shape"
(acl-grant (quote u) (quote read) (quote p))
(list (quote grant) (quote u) (quote read) (quote p)))
(acl-dt-check!
"actor constructor shape"
(acl-actor (quote u) (quote user))
(list (quote actor) (quote u) (quote user)))))))
(define
acl-direct-tests-run!
(fn
()
(do
(set! acl-dt-pass 0)
(set! acl-dt-fail 0)
(set! acl-dt-failures (list))
(acl-dt-run-all!)
{:failures acl-dt-failures :total (+ acl-dt-pass acl-dt-fail) :passed acl-dt-pass :failed acl-dt-fail})))

316
lib/acl/tests/explain.sx Normal file
View File

@@ -0,0 +1,316 @@
;; lib/acl/tests/explain.sx — Phase 3: proof correctness + audit completeness.
(define acl-et-pass 0)
(define acl-et-fail 0)
(define acl-et-failures (list))
;; Name-based deep equality. The host `=` compares symbols by interned
;; identity, which is unstable across substitution/saturation; comparing by
;; name (as the datalog suite does) makes structural assertions deterministic.
(define
acl-et-eq?
(fn
(a b)
(cond
((and (list? a) (list? b))
(and (= (len a) (len b)) (acl-et-eq-l? a b 0)))
((and (dict? a) (dict? b))
(let
((ka (keys a)) (kb (keys b)))
(and (= (len ka) (len kb)) (acl-et-eq-d? a b ka 0))))
((and (symbol? a) (symbol? b))
(= (symbol->string a) (symbol->string b)))
(else (= a b)))))
(define
acl-et-eq-l?
(fn
(a b i)
(cond
((>= i (len a)) true)
((not (acl-et-eq? (nth a i) (nth b i))) false)
(else (acl-et-eq-l? a b (+ i 1))))))
(define
acl-et-eq-d?
(fn
(a b ka i)
(cond
((>= i (len ka)) true)
((let ((k (nth ka i))) (not (acl-et-eq? (get a k) (get b k))))
false)
(else (acl-et-eq-d? a b ka (+ i 1))))))
(define
acl-et-check!
(fn
(name got expected)
(if
(acl-et-eq? got expected)
(set! acl-et-pass (+ acl-et-pass 1))
(do
(set! acl-et-fail (+ acl-et-fail 1))
(append!
acl-et-failures
(str name "\n expected: " expected "\n got: " got))))))
;; --- proof-tree walkers ---
;; True if EDB fact `target` appears as a base leaf anywhere in the proof.
(define
acl-et-has-leaf?
(fn
(node target)
(cond
((= node nil) false)
((and (dict? node) (has-key? node :via))
(acl-et-eq? (get node :fact) target))
((and (dict? node) (has-key? node :body))
(acl-et-any-leaf? (get node :body) target))
(else false))))
(define
acl-et-any-leaf?
(fn
(nodes target)
(cond
((= (len nodes) 0) false)
((acl-et-has-leaf? (first nodes) target) true)
(else (acl-et-any-leaf? (rest nodes) target)))))
;; True if the proof records a verified negation (deny did not fire).
(define
acl-et-has-negok?
(fn
(node)
(cond
((= node nil) false)
((and (dict? node) (has-key? node :neg-ok)) true)
((and (dict? node) (has-key? node :body))
(acl-et-any-negok? (get node :body)))
(else false))))
(define
acl-et-any-negok?
(fn
(nodes)
(cond
((= (len nodes) 0) false)
((acl-et-has-negok? (first nodes)) true)
(else (acl-et-any-negok? (rest nodes))))))
(define
acl-et-run-all!
(fn
()
(do
(let
((db (acl-build-db (list (acl-grant (quote u) (quote read) (quote p))))))
(let
((e (acl-explain db (quote u) (quote read) (quote p))))
(do
(acl-et-check! "direct: allowed?" (get e :allowed?) true)
(acl-et-check!
"direct: proof root fact"
(get (get e :proof) :fact)
(list (quote permit) (quote u) (quote read) (quote p)))
(acl-et-check!
"direct: grant leaf present"
(acl-et-has-leaf?
(get e :proof)
(list (quote grant) (quote u) (quote read) (quote p)))
true)
(acl-et-check!
"direct: negation verified"
(acl-et-has-negok? (get e :proof))
true)
(acl-et-check!
"direct: reason nil when allowed"
(get e :reason)
nil))))
(let
((db (acl-build-db (list (acl-member-of (quote alice) (quote team)) (acl-member-of (quote team) (quote org)) (acl-grant (quote org) (quote read) (quote doc))))))
(let
((e (acl-explain db (quote alice) (quote read) (quote doc))))
(do
(acl-et-check! "group: allowed?" (get e :allowed?) true)
(acl-et-check!
"group: member_of alice leaf"
(acl-et-has-leaf?
(get e :proof)
(list (quote member_of) (quote alice) (quote team)))
true)
(acl-et-check!
"group: member_of team leaf"
(acl-et-has-leaf?
(get e :proof)
(list (quote member_of) (quote team) (quote org)))
true)
(acl-et-check!
"group: grant org leaf at base"
(acl-et-has-leaf?
(get e :proof)
(list (quote grant) (quote org) (quote read) (quote doc)))
true))))
(let
((db (acl-build-db (list (acl-child-of (quote sec) (quote book)) (acl-grant (quote u) (quote read) (quote book))))))
(let
((e (acl-explain db (quote u) (quote read) (quote sec))))
(do
(acl-et-check! "resource: allowed?" (get e :allowed?) true)
(acl-et-check!
"resource: child_of leaf"
(acl-et-has-leaf?
(get e :proof)
(list (quote child_of) (quote sec) (quote book)))
true)
(acl-et-check!
"resource: grant on parent leaf"
(acl-et-has-leaf?
(get e :proof)
(list (quote grant) (quote u) (quote read) (quote book)))
true))))
(let
((db (acl-build-db (list (acl-member-of (quote bob) (quote editor)) (acl-role-grant (quote editor) (quote edit) (quote page1))))))
(let
((e (acl-explain db (quote bob) (quote edit) (quote page1))))
(do
(acl-et-check! "role: allowed?" (get e :allowed?) true)
(acl-et-check!
"role: member_of leaf"
(acl-et-has-leaf?
(get e :proof)
(list (quote member_of) (quote bob) (quote editor)))
true)
(acl-et-check!
"role: role_grant leaf"
(acl-et-has-leaf?
(get e :proof)
(list
(quote role_grant)
(quote editor)
(quote edit)
(quote page1)))
true))))
(let
((db (acl-build-db (list (acl-grant (quote u) (quote edit) (quote p)) (acl-deny (quote u) (quote edit) (quote p))))))
(let
((e (acl-explain db (quote u) (quote edit) (quote p))))
(do
(acl-et-check! "deny: not allowed" (get e :allowed?) false)
(acl-et-check! "deny: no proof" (get e :proof) nil)
(acl-et-check!
"deny: reason root is eff_deny"
(get (get e :reason) :fact)
(list (quote eff_deny) (quote u) (quote edit) (quote p)))
(acl-et-check!
"deny: reason has deny leaf"
(acl-et-has-leaf?
(get e :reason)
(list (quote deny) (quote u) (quote edit) (quote p)))
true))))
(let
((db (acl-build-db (list (acl-member-of (quote alice) (quote team)) (acl-grant (quote alice) (quote read) (quote doc)) (acl-deny (quote team) (quote read) (quote doc))))))
(let
((e (acl-explain db (quote alice) (quote read) (quote doc))))
(do
(acl-et-check!
"inherited deny: not allowed"
(get e :allowed?)
false)
(acl-et-check!
"inherited deny: reason has member_of leaf"
(acl-et-has-leaf?
(get e :reason)
(list (quote member_of) (quote alice) (quote team)))
true)
(acl-et-check!
"inherited deny: reason has group deny leaf"
(acl-et-has-leaf?
(get e :reason)
(list (quote deny) (quote team) (quote read) (quote doc)))
true))))
(let
((db (acl-build-db (list))))
(let
((e (acl-explain db (quote u) (quote read) (quote p))))
(do
(acl-et-check! "no grant: not allowed" (get e :allowed?) false)
(acl-et-check! "no grant: proof nil" (get e :proof) nil)
(acl-et-check! "no grant: reason nil" (get e :reason) nil))))
(let
((db (acl-build-db (list (acl-grant (quote u) (quote read) (quote p)) (acl-deny (quote u) (quote edit) (quote p))))))
(do
(acl-audit-clear!)
(acl-et-check! "audit: starts empty" (acl-audit-count) 0)
(acl-et-check!
"audit decide allowed returns true"
(acl-audit-decide! db (quote u) (quote read) (quote p))
true)
(acl-et-check!
"audit decide denied returns false"
(acl-audit-decide! db (quote u) (quote edit) (quote p))
false)
(acl-audit-decide! db (quote u) (quote comment) (quote p))
(acl-et-check!
"audit: count after three decisions"
(acl-audit-count)
3)
(acl-et-check!
"audit: tail size respects n"
(len (acl-audit-tail 2))
2)
(acl-et-check!
"audit: tail returns most recent"
(get (first (acl-audit-tail 1)) :act)
(quote comment))
(acl-et-check!
"audit: first record seq is 0"
(get (first (acl-audit-tail 3)) :seq)
0)
(acl-et-check!
"audit: allowed flag recorded"
(get (first (acl-audit-tail 3)) :allowed?)
true)
(acl-et-check!
"audit: serialize line count"
(len (acl-et-lines (acl-audit-serialize)))
3)
(acl-audit-clear!)
(acl-et-check!
"audit: clear resets count"
(acl-audit-count)
0))))))
;; count newline-terminated lines in a serialized log
(define acl-et-lines (fn (s) (acl-et-count-nl s 0 0)))
(define
acl-et-count-nl
(fn
(s i n)
(if
(>= i (len s))
(if (= n 0) (list) (acl-et-rangelist n))
(acl-et-count-nl
s
(+ i 1)
(if (= (slice s i (+ i 1)) "\n") (+ n 1) n)))))
(define
acl-et-rangelist
(fn
(n)
(if
(<= n 0)
(list)
(cons n (acl-et-rangelist (- n 1))))))
(define
acl-explain-tests-run!
(fn
()
(do
(set! acl-et-pass 0)
(set! acl-et-fail 0)
(set! acl-et-failures (list))
(acl-et-run-all!)
{:failures acl-et-failures :total (+ acl-et-pass acl-et-fail) :passed acl-et-pass :failed acl-et-fail})))

273
lib/acl/tests/fed.sx Normal file
View File

@@ -0,0 +1,273 @@
;; lib/acl/tests/fed.sx — Phase 4: federation (peer trust, delegation,
;; cross-instance chains, revocation). fed-sx transport is mocked as a dict.
(define acl-ft-pass 0)
(define acl-ft-fail 0)
(define acl-ft-failures (list))
;; Name-based deep equality (host `=` compares symbols by unstable interned
;; identity; see lib/acl/tests/explain.sx).
(define
acl-ft-eq?
(fn
(a b)
(cond
((and (list? a) (list? b))
(and (= (len a) (len b)) (acl-ft-eq-l? a b 0)))
((and (symbol? a) (symbol? b))
(= (symbol->string a) (symbol->string b)))
(else (= a b)))))
(define
acl-ft-eq-l?
(fn
(a b i)
(cond
((>= i (len a)) true)
((not (acl-ft-eq? (nth a i) (nth b i))) false)
(else (acl-ft-eq-l? a b (+ i 1))))))
(define
acl-ft-check!
(fn
(name got expected)
(if
(acl-ft-eq? got expected)
(set! acl-ft-pass (+ acl-ft-pass 1))
(do
(set! acl-ft-fail (+ acl-ft-fail 1))
(append!
acl-ft-failures
(str name "\n expected: " expected "\n got: " got))))))
;; proof leaf walker (federated proofs reconstruct through the engine rule).
(define
acl-ft-has-leaf?
(fn
(node target)
(cond
((= node nil) false)
((and (dict? node) (has-key? node :via))
(acl-ft-eq? (get node :fact) target))
((and (dict? node) (has-key? node :body))
(acl-ft-any-leaf? (get node :body) target))
(else false))))
(define
acl-ft-any-leaf?
(fn
(nodes target)
(cond
((= (len nodes) 0) false)
((acl-ft-has-leaf? (first nodes) target) true)
(else (acl-ft-any-leaf? (rest nodes) target)))))
(define acl-ft-p? (fn (db s a r) (acl-permit? db s a r)))
;; A standard federation fixture: local trusts peer alpha at "readonly", which
;; covers read+comment. alpha delegates several capabilities to alice.
(define
acl-ft-fixture
(fn
()
(acl-build-db
(list
(acl-trust (quote alpha) (quote readonly))
(acl-level-covers (quote readonly) (quote read))
(acl-level-covers (quote readonly) (quote comment))
(acl-delegate (quote alpha) (quote alice) (quote read) (quote doc))
(acl-delegate (quote alpha) (quote alice) (quote edit) (quote doc))))))
(define
acl-ft-run-all!
(fn
()
(do
(let
((db (acl-ft-fixture)))
(do
(acl-ft-check!
"trusted delegate, level covers action -> permit"
(acl-ft-p? db (quote alice) (quote read) (quote doc))
true)
(acl-ft-check!
"trusted delegate, level does NOT cover action -> deny"
(acl-ft-p? db (quote alice) (quote edit) (quote doc))
false)
(acl-ft-check!
"delegated but action class uncovered (comment has no delegate)"
(acl-ft-p? db (quote alice) (quote comment) (quote doc))
false)))
(let
((db (acl-build-db (list (acl-level-covers (quote readonly) (quote read)) (acl-delegate (quote beta) (quote bob) (quote read) (quote doc))))))
(acl-ft-check!
"untrusted peer delegate -> deny"
(acl-ft-p? db (quote bob) (quote read) (quote doc))
false))
(let
((db (acl-build-db (list (acl-trust (quote alpha) (quote readonly)) (acl-delegate (quote alpha) (quote alice) (quote read) (quote doc))))))
(acl-ft-check!
"trust but no level_covers -> deny"
(acl-ft-p? db (quote alice) (quote read) (quote doc))
false))
(let
((db (acl-build-db (list (acl-trust (quote alpha) (quote full)) (acl-level-covers (quote full) (quote read)) (acl-delegate (quote alpha) (quote alice) (quote read) (quote doc)) (acl-delegate (quote beta) (quote bob) (quote read) (quote doc))))))
(do
(acl-ft-check!
"trust is per-peer: alpha's delegate applies"
(acl-ft-p? db (quote alice) (quote read) (quote doc))
true)
(acl-ft-check!
"trust not transitive: beta's delegate does not apply"
(acl-ft-p? db (quote bob) (quote read) (quote doc))
false)))
(let
((db (acl-build-db (list (acl-trust (quote alpha) (quote full)) (acl-level-covers (quote full) (quote read)) (acl-delegate (quote alpha) (quote alice) (quote read) (quote doc)) (acl-deny (quote alice) (quote read) (quote doc))))))
(acl-ft-check!
"local deny overrides federated grant"
(acl-ft-p? db (quote alice) (quote read) (quote doc))
false))
(let
((db (acl-build-db (list (acl-trust (quote alpha) (quote full)) (acl-level-covers (quote full) (quote read)) (acl-member-of (quote alice) (quote team)) (acl-delegate (quote alpha) (quote team) (quote read) (quote doc))))))
(acl-ft-check!
"federated grant to group reaches member"
(acl-ft-p? db (quote alice) (quote read) (quote doc))
true))
(let
((db (acl-build-db (list (acl-trust (quote alpha) (quote full)) (acl-level-covers (quote full) (quote read)) (acl-child-of (quote sec) (quote book)) (acl-delegate (quote alpha) (quote u) (quote read) (quote book))))))
(acl-ft-check!
"federated grant on parent resource reaches child"
(acl-ft-p? db (quote u) (quote read) (quote sec))
true))
(let
((transport {:gamma (list (acl-delegate (quote gamma) (quote carol) (quote read) (quote post))) :alpha (list (acl-delegate (quote alpha) (quote alice) (quote read) (quote doc)))}))
(do
(acl-ft-check!
"fetch known peer returns its delegates"
(len (acl-fed-fetch transport (quote alpha)))
1)
(acl-ft-check!
"fetch unknown peer returns empty"
(len (acl-fed-fetch transport (quote delta)))
0)
(acl-ft-check!
"collect across peers"
(len
(acl-fed-collect transport (list (quote alpha) (quote gamma))))
2)
(let
((db (acl-fed-build-db (list (acl-trust (quote alpha) (quote readonly)) (acl-trust (quote gamma) (quote readonly)) (acl-level-covers (quote readonly) (quote read))) transport (list (quote alpha) (quote gamma)))))
(do
(acl-ft-check!
"fed-build-db: alpha delegate permits"
(acl-ft-p? db (quote alice) (quote read) (quote doc))
true)
(acl-ft-check!
"fed-build-db: gamma delegate permits"
(acl-ft-p? db (quote carol) (quote read) (quote post))
true)
(acl-ft-check!
"fed-build-db: untrusted action still denied"
(acl-ft-p? db (quote alice) (quote edit) (quote doc))
false)))))
(let
((db (acl-build-db (list (acl-trust (quote alpha) (quote full)) (acl-level-covers (quote full) (quote read)) (acl-delegate (quote alpha) (quote alice) (quote read) (quote doc))))))
(do
(acl-ft-check!
"before revoke: permitted"
(acl-ft-p? db (quote alice) (quote read) (quote doc))
true)
(acl-revoke!
db
(acl-delegate
(quote alpha)
(quote alice)
(quote read)
(quote doc)))
(acl-ft-check!
"after delegate revoked: denied"
(acl-ft-p? db (quote alice) (quote read) (quote doc))
false)))
(let
((db (acl-build-db (list (acl-trust (quote alpha) (quote full)) (acl-level-covers (quote full) (quote read)) (acl-delegate (quote alpha) (quote alice) (quote read) (quote doc))))))
(do
(acl-ft-check!
"before trust revoke: permitted"
(acl-ft-p? db (quote alice) (quote read) (quote doc))
true)
(acl-revoke! db (acl-trust (quote alpha) (quote full)))
(acl-ft-check!
"after trust revoked: denied"
(acl-ft-p? db (quote alice) (quote read) (quote doc))
false)))
(let
((db (acl-build-db (list (acl-level-covers (quote full) (quote read)) (acl-delegate (quote alpha) (quote alice) (quote read) (quote doc))))))
(do
(acl-ft-check!
"delegate without trust: denied"
(acl-ft-p? db (quote alice) (quote read) (quote doc))
false)
(acl-fed-assert! db (acl-trust (quote alpha) (quote full)))
(acl-ft-check!
"trust ingested then re-checked: permitted"
(acl-ft-p? db (quote alice) (quote read) (quote doc))
true)))
(let
((db (acl-ft-fixture)))
(let
((e (acl-explain db (quote alice) (quote read) (quote doc))))
(do
(acl-ft-check! "federated proof allowed?" (get e :allowed?) true)
(acl-ft-check!
"federated proof has delegate leaf"
(acl-ft-has-leaf?
(get e :proof)
(list
(quote delegate)
(quote alpha)
(quote alice)
(quote read)
(quote doc)))
true)
(acl-ft-check!
"federated proof has trust leaf"
(acl-ft-has-leaf?
(get e :proof)
(list (quote trust) (quote alpha) (quote readonly)))
true)
(acl-ft-check!
"federated proof has level_covers leaf"
(acl-ft-has-leaf?
(get e :proof)
(list (quote level_covers) (quote readonly) (quote read)))
true))))
(acl-ft-check!
"schema delegate arity valid"
(acl-fact-valid?
(acl-delegate (quote p) (quote s) (quote a) (quote r)))
true)
(acl-ft-check!
"schema trust arity valid"
(acl-fact-valid? (acl-trust (quote p) (quote l)))
true)
(acl-ft-check!
"schema peer arity valid"
(acl-fact-valid? (acl-peer (quote p) (quote peer)))
true)
(acl-ft-check!
"schema level_covers arity valid"
(acl-fact-valid? (acl-level-covers (quote l) (quote read)))
true)
(acl-ft-check!
"schema delegate bad arity invalid"
(acl-fact-valid? (list (quote delegate) (quote p) (quote s)))
false))))
(define
acl-fed-tests-run!
(fn
()
(do
(set! acl-ft-pass 0)
(set! acl-ft-fail 0)
(set! acl-ft-failures (list))
(acl-ft-run-all!)
{:failures acl-ft-failures :total (+ acl-ft-pass acl-ft-fail) :passed acl-ft-pass :failed acl-ft-fail})))

228
lib/acl/tests/harden.sx Normal file
View File

@@ -0,0 +1,228 @@
;; lib/acl/tests/harden.sx — adversarial / cross-phase hardening.
;;
;; Diamond hierarchies, conflict resolution where deny must win through every
;; path, chain inheritance, cycle termination, multi-peer delegation, fact
;; validation, and audit save/restore.
;;
;; PROVER-FREE BY DESIGN: this suite calls only acl-permit? (which runs in
;; compiled Datalog, safe at any depth) plus pure data ops — never acl-explain /
;; acl-prove-d. The SX-side proof reconstructor recurses, and once the kernel
;; JIT-compiles it (after the explain/fed suites warm the process) it loops on
;; chains deeper than ~3 (substrate JIT bug — see plan Blockers). Proof
;; reconstruction is covered by tests/explain.sx (and federated proofs by
;; tests/fed.sx), both of which stay under the warm-process depth threshold.
(define acl-hd-pass 0)
(define acl-hd-fail 0)
(define acl-hd-failures (list))
(define
acl-hd-check!
(fn
(name got expected)
(if
(= got expected)
(set! acl-hd-pass (+ acl-hd-pass 1))
(do
(set! acl-hd-fail (+ acl-hd-fail 1))
(append!
acl-hd-failures
(str name "\n expected: " expected "\n got: " got))))))
(define acl-hd-p? (fn (db s a r) (acl-permit? db s a r)))
(define
acl-hd-run-all!
(fn
()
(do
(let
((grant-deny (acl-build-db (list (acl-child-of (quote r) (quote p1)) (acl-child-of (quote r) (quote p2)) (acl-grant (quote u) (quote read) (quote p1)) (acl-deny (quote u) (quote read) (quote p2)))))
(both-grant
(acl-build-db
(list
(acl-child-of (quote r) (quote p1))
(acl-child-of (quote r) (quote p2))
(acl-grant (quote u) (quote read) (quote p1))
(acl-grant (quote u) (quote read) (quote p2))))))
(do
(acl-hd-check!
"diamond resource: grant+deny parents -> deny wins"
(acl-hd-p? grant-deny (quote u) (quote read) (quote r))
false)
(acl-hd-check!
"diamond resource: both grant -> permit"
(acl-hd-p? both-grant (quote u) (quote read) (quote r))
true)
(acl-hd-check!
"diamond resource: deny does not leak to other parent"
(acl-hd-p? grant-deny (quote u) (quote read) (quote p1))
true)))
(let
((grant-deny (acl-build-db (list (acl-member-of (quote alice) (quote g1)) (acl-member-of (quote alice) (quote g2)) (acl-grant (quote g1) (quote read) (quote doc)) (acl-deny (quote g2) (quote read) (quote doc)))))
(both-grant
(acl-build-db
(list
(acl-member-of (quote alice) (quote g1))
(acl-member-of (quote alice) (quote g2))
(acl-grant (quote g1) (quote read) (quote doc))
(acl-grant (quote g2) (quote read) (quote doc))))))
(do
(acl-hd-check!
"diamond group: grant+deny groups -> deny wins"
(acl-hd-p? grant-deny (quote alice) (quote read) (quote doc))
false)
(acl-hd-check!
"diamond group: both grant -> permit"
(acl-hd-p? both-grant (quote alice) (quote read) (quote doc))
true)))
(let
((chain (acl-build-db (list (acl-member-of (quote a0) (quote a1)) (acl-member-of (quote a1) (quote a2)) (acl-member-of (quote a2) (quote a3)) (acl-member-of (quote a3) (quote a4)) (acl-grant (quote a4) (quote read) (quote res)))))
(chain-deny
(acl-build-db
(list
(acl-member-of (quote a0) (quote a1))
(acl-member-of (quote a1) (quote a2))
(acl-member-of (quote a2) (quote a3))
(acl-member-of (quote a3) (quote a4))
(acl-grant (quote a4) (quote read) (quote res))
(acl-deny (quote a0) (quote read) (quote res))))))
(do
(acl-hd-check!
"chain: top-group grant reaches leaf member"
(acl-hd-p? chain (quote a0) (quote read) (quote res))
true)
(acl-hd-check!
"chain: intermediate also covered"
(acl-hd-p? chain (quote a2) (quote read) (quote res))
true)
(acl-hd-check!
"chain: leaf-member deny overrides top grant"
(acl-hd-p? chain-deny (quote a0) (quote read) (quote res))
false)
(acl-hd-check!
"chain: deny on leaf does not block sibling level"
(acl-hd-p? chain-deny (quote a1) (quote read) (quote res))
true)))
(let
((self-member (acl-build-db (list (acl-member-of (quote a) (quote a)) (acl-grant (quote a) (quote read) (quote r)))))
(self-child
(acl-build-db
(list
(acl-child-of (quote r) (quote r))
(acl-grant (quote u) (quote read) (quote r)))))
(two-cycle
(acl-build-db
(list
(acl-member-of (quote x) (quote y))
(acl-member-of (quote y) (quote x))
(acl-grant (quote y) (quote read) (quote r))))))
(do
(acl-hd-check!
"self-membership cycle terminates and grants"
(acl-hd-p? self-member (quote a) (quote read) (quote r))
true)
(acl-hd-check!
"self-child cycle terminates and grants"
(acl-hd-p? self-child (quote u) (quote read) (quote r))
true)
(acl-hd-check!
"two-node membership cycle terminates"
(acl-hd-p? two-cycle (quote x) (quote read) (quote r))
true)))
(let
((db (acl-build-db (list (acl-trust (quote alpha) (quote full)) (acl-level-covers (quote full) (quote read)) (acl-member-of (quote alice) (quote team)) (acl-delegate (quote alpha) (quote team) (quote read) (quote doc)) (acl-deny (quote alice) (quote read) (quote doc))))))
(acl-hd-check!
"federated group grant, local member deny -> deny wins"
(acl-hd-p? db (quote alice) (quote read) (quote doc))
false))
(let
((db (acl-build-db (list (acl-trust (quote alpha) (quote full)) (acl-level-covers (quote full) (quote read)) (acl-delegate (quote alpha) (quote bob) (quote read) (quote doc)) (acl-delegate (quote beta) (quote bob) (quote read) (quote doc))))))
(acl-hd-check!
"two peers delegate, one trusted -> permit"
(acl-hd-p? db (quote bob) (quote read) (quote doc))
true))
(let
((db (acl-build-db (list (acl-trust (quote alpha) (quote full)) (acl-trust (quote beta) (quote full)) (acl-level-covers (quote full) (quote read)) (acl-delegate (quote alpha) (quote bob) (quote read) (quote doc)) (acl-delegate (quote beta) (quote bob) (quote read) (quote doc))))))
(acl-hd-check!
"two peers both trusted -> permit"
(acl-hd-p? db (quote bob) (quote read) (quote doc))
true))
(let
((empty (acl-build-db (list))))
(acl-hd-check!
"empty db: nothing permitted"
(acl-hd-p? empty (quote u) (quote read) (quote r))
false))
(do
(acl-hd-check!
"validate: clean set has no bad facts"
(len
(acl-validate-facts
(list
(acl-grant (quote u) (quote read) (quote p))
(acl-member-of (quote u) (quote g))
(acl-delegate (quote pe) (quote u) (quote read) (quote p)))))
0)
(acl-hd-check!
"validate: facts-valid? true on clean set"
(acl-facts-valid?
(list (acl-grant (quote u) (quote read) (quote p))))
true)
(acl-hd-check!
"validate: surfaces wrong-arity and unknown predicate"
(len
(acl-validate-facts
(list
(acl-grant (quote u) (quote read) (quote p))
(list (quote grant) (quote u))
(list (quote bogus) (quote x) (quote y)))))
2)
(acl-hd-check!
"validate: empty set is valid"
(acl-facts-valid? (list))
true))
(let
((db (acl-build-db (list (acl-grant (quote u) (quote read) (quote p)) (acl-deny (quote u) (quote edit) (quote p))))))
(do
(acl-audit-clear!)
(acl-audit-decide! db (quote u) (quote read) (quote p))
(acl-audit-decide! db (quote u) (quote edit) (quote p))
(let
((snap (acl-audit-snapshot)))
(do
(acl-audit-clear!)
(acl-hd-check!
"audit: cleared count is 0"
(acl-audit-count)
0)
(acl-audit-restore! snap)
(acl-hd-check!
"audit: restored count"
(acl-audit-count)
2)
(acl-hd-check!
"audit: restored last act"
(get (first (acl-audit-tail 1)) :act)
(quote edit))
(acl-audit-decide! db (quote u) (quote comment) (quote p))
(acl-hd-check!
"audit: seq continues after restore"
(get (first (acl-audit-tail 1)) :seq)
2)
(acl-hd-check!
"audit: snapshot is an immutable copy"
(len (get snap :entries))
2)
(acl-audit-clear!))))))))
(define
acl-harden-tests-run!
(fn
()
(do
(set! acl-hd-pass 0)
(set! acl-hd-fail 0)
(set! acl-hd-failures (list))
(acl-hd-run-all!)
{:failures acl-hd-failures :total (+ acl-hd-pass acl-hd-fail) :passed acl-hd-pass :failed acl-hd-fail})))

202
lib/acl/tests/inherit.sx Normal file
View File

@@ -0,0 +1,202 @@
;; lib/acl/tests/inherit.sx — Phase 2: inheritance (groups, resource trees,
;; role expansion) with deny-overrides.
(define acl-it-pass 0)
(define acl-it-fail 0)
(define acl-it-failures (list))
(define
acl-it-check!
(fn
(name got expected)
(if
(= got expected)
(set! acl-it-pass (+ acl-it-pass 1))
(do
(set! acl-it-fail (+ acl-it-fail 1))
(append!
acl-it-failures
(str name "\n expected: " expected "\n got: " got))))))
(define acl-it-p? (fn (db s a r) (acl-permit? db s a r)))
(define
acl-it-run-all!
(fn
()
(do
(let
((db (acl-build-db (list (acl-member-of (quote alice) (quote team)) (acl-grant (quote team) (quote read) (quote doc))))))
(do
(acl-it-check!
"group grant reaches member"
(acl-it-p? db (quote alice) (quote read) (quote doc))
true)
(acl-it-check!
"group grant: non-member excluded"
(acl-it-p? db (quote bob) (quote read) (quote doc))
false)
(acl-it-check!
"group grant: wrong action"
(acl-it-p? db (quote alice) (quote edit) (quote doc))
false)))
(let
((db (acl-build-db (list (acl-member-of (quote alice) (quote team)) (acl-member-of (quote team) (quote org)) (acl-member-of (quote org) (quote company)) (acl-grant (quote company) (quote read) (quote doc))))))
(do
(acl-it-check!
"deep nested group grant reaches leaf member"
(acl-it-p? db (quote alice) (quote read) (quote doc))
true)
(acl-it-check!
"intermediate group also covered"
(acl-it-p? db (quote team) (quote read) (quote doc))
true)
(acl-it-check!
"mid group org covered"
(acl-it-p? db (quote org) (quote read) (quote doc))
true)))
(let
((db (acl-build-db (list (acl-member-of (quote a) (quote b)) (acl-member-of (quote b) (quote a)) (acl-grant (quote b) (quote read) (quote r))))))
(do
(acl-it-check!
"cyclic membership terminates and grants"
(acl-it-p? db (quote a) (quote read) (quote r))
true)
(acl-it-check!
"cyclic membership covers both"
(acl-it-p? db (quote b) (quote read) (quote r))
true)))
(let
((db (acl-build-db (list (acl-child-of (quote sec) (quote chap)) (acl-child-of (quote chap) (quote book)) (acl-grant (quote u) (quote read) (quote book))))))
(do
(acl-it-check!
"parent grant reaches direct child"
(acl-it-p? db (quote u) (quote read) (quote chap))
true)
(acl-it-check!
"parent grant reaches deep descendant"
(acl-it-p? db (quote u) (quote read) (quote sec))
true)
(acl-it-check!
"parent grant covers parent itself"
(acl-it-p? db (quote u) (quote read) (quote book))
true)
(acl-it-check!
"child grant does not climb to parent"
(acl-it-p?
(acl-build-db
(list
(acl-child-of (quote sec) (quote book))
(acl-grant (quote u) (quote read) (quote sec))))
(quote u)
(quote read)
(quote book))
false)))
(let
((db (acl-build-db (list (acl-member-of (quote alice) (quote team)) (acl-child-of (quote post1) (quote board)) (acl-grant (quote team) (quote comment) (quote board))))))
(do
(acl-it-check!
"group + resource: member on child resource"
(acl-it-p? db (quote alice) (quote comment) (quote post1))
true)
(acl-it-check!
"group + resource: member on parent resource"
(acl-it-p? db (quote alice) (quote comment) (quote board))
true)))
(let
((db (acl-build-db (list (acl-member-of (quote bob) (quote editor)) (acl-role-grant (quote editor) (quote edit) (quote page1)) (acl-role-grant (quote editor) (quote read) (quote page1))))))
(do
(acl-it-check!
"role confers edit to member"
(acl-it-p? db (quote bob) (quote edit) (quote page1))
true)
(acl-it-check!
"role confers read to member"
(acl-it-p? db (quote bob) (quote read) (quote page1))
true)
(acl-it-check!
"role: capability not in tuple denied"
(acl-it-p? db (quote bob) (quote moderate) (quote page1))
false)
(acl-it-check!
"role: non-member excluded"
(acl-it-p? db (quote eve) (quote edit) (quote page1))
false)))
(let
((db (acl-build-db (list (acl-member-of (quote bob) (quote editor)) (acl-child-of (quote draft) (quote page1)) (acl-role-grant (quote editor) (quote edit) (quote page1))))))
(acl-it-check!
"role grant flows to child resource"
(acl-it-p? db (quote bob) (quote edit) (quote draft))
true))
(let
((db (acl-build-db (list (acl-member-of (quote alice) (quote team)) (acl-grant (quote team) (quote read) (quote doc)) (acl-deny (quote alice) (quote read) (quote doc))))))
(acl-it-check!
"explicit deny beats inherited group allow"
(acl-it-p? db (quote alice) (quote read) (quote doc))
false))
(let
((db (acl-build-db (list (acl-member-of (quote alice) (quote team)) (acl-grant (quote alice) (quote read) (quote doc)) (acl-deny (quote team) (quote read) (quote doc))))))
(do
(acl-it-check!
"group deny inherits and overrides direct grant"
(acl-it-p? db (quote alice) (quote read) (quote doc))
false)
(acl-it-check!
"group deny: another member also blocked"
(acl-it-p? db (quote team) (quote read) (quote doc))
false)))
(let
((db (acl-build-db (list (acl-child-of (quote sec) (quote book)) (acl-grant (quote u) (quote read) (quote sec)) (acl-deny (quote u) (quote read) (quote book))))))
(acl-it-check!
"ancestor deny overrides descendant grant"
(acl-it-p? db (quote u) (quote read) (quote sec))
false))
(let
((db (acl-build-db (list (acl-member-of (quote alice) (quote team)) (acl-grant (quote team) (quote read) (quote doc)) (acl-grant (quote team) (quote edit) (quote doc)) (acl-deny (quote alice) (quote edit) (quote doc))))))
(do
(acl-it-check!
"deny on edit leaves inherited read intact"
(acl-it-p? db (quote alice) (quote read) (quote doc))
true)
(acl-it-check!
"deny on edit blocks edit"
(acl-it-p? db (quote alice) (quote edit) (quote doc))
false)))
(let
((db (acl-build-db (list (acl-member-of (quote alice) (quote team)) (acl-deny (quote team) (quote read) (quote doc))))))
(acl-it-check!
"inherited deny, no grant: denied"
(acl-it-p? db (quote alice) (quote read) (quote doc))
false))
(let
((db (acl-build-db (list (acl-child-of (quote a) (quote root)) (acl-child-of (quote b) (quote root)) (acl-grant (quote u) (quote read) (quote root)) (acl-deny (quote u) (quote read) (quote a))))))
(do
(acl-it-check!
"deny on sibling a blocks a"
(acl-it-p? db (quote u) (quote read) (quote a))
false)
(acl-it-check!
"deny on sibling a leaves b permitted"
(acl-it-p? db (quote u) (quote read) (quote b))
true)
(acl-it-check!
"root itself still permitted"
(acl-it-p? db (quote u) (quote read) (quote root))
true)))
(let
((db (acl-build-db (list (acl-grant (quote x) (quote read) (quote y))))))
(acl-it-check!
"direct grant under inheritance ruleset"
(acl-it-p? db (quote x) (quote read) (quote y))
true)))))
(define
acl-inherit-tests-run!
(fn
()
(do
(set! acl-it-pass 0)
(set! acl-it-fail 0)
(set! acl-it-failures (list))
(acl-it-run-all!)
{:failures acl-it-failures :total (+ acl-it-pass acl-it-fail) :passed acl-it-pass :failed acl-it-fail})))

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

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

@@ -0,0 +1,281 @@
# acl-on-sx: Access Control on Datalog
rose-ash needs fine-grained, explainable, federation-aware access control. Subjects
(users, groups, roles, services) × actions (read, edit, comment, moderate, federate)
× resources (pages, posts, threads, peers). Decisions must come with a trace — not just
permit/deny, but **why**.
Datalog's bottom-up rule engine produces transparent permit/deny chains: the proof tree
is the audit trail. Inheritance over groups + resource hierarchies is recursive Datalog
in one rule. Federation extends naturally — fed-sx replicates ACL facts, peers reason
over the union.
End-state: a Datalog-on-SX layer specifically for ACL, with explanation API, audit log,
and federation extension. Reuses `lib/datalog/` evaluator and term model where possible.
## Status (rolling)
`bash lib/acl/conformance.sh`**145/145** (all four phases + hardening)
## Ground rules
- **Scope:** only touch `lib/acl/**` and `plans/acl-on-sx.md`. Do **not** edit `spec/`,
`hosts/`, `shared/`, `lib/datalog/**`, or other `lib/<lang>/`. You may **import**
from `lib/datalog/` (its public API in `lib/datalog/datalog.sx`); do **not** copy or
modify Datalog code.
- **Shared-file issues** go under "Blockers" with a minimal repro; do not fix here.
- **SX files:** use `sx-tree` MCP tools only.
- **Architecture:** thin layer on top of `lib/datalog/`. Define schema, surface API,
audit + federation hooks. The rule engine itself is Datalog's.
- **Watch for shared patterns** going into `lib/guest/` — both acl-sx and mod-sx need
rule-engine plumbing. If you find shared shape, flag it for extraction (don't
extract yet — wait for mod-sx to start).
- **Commits:** one feature per commit. Keep Progress log updated and tick boxes.
## Architecture sketch
```
ACL declarations (SX) User query
│ │
▼ ▼
lib/acl/schema.sx lib/acl/api.sx
— subject sorts — (acl/permit? subj act res)
— resource sorts — (acl/explain subj act res)
— action sorts — (acl/audit subj act res :allowed?)
— fact schema │
│ ▼
▼ lib/acl/engine.sx
lib/acl/facts.sx — builds Datalog query
— actor(id, kind) — invokes lib/datalog/
— resource(id, kind) — extracts proof tree
— member_of(actor, group) │
— child_of(res, parent) ▼
— grant(actor, act, res) lib/acl/audit.sx
— deny (actor, act, res) — persistent decision log
— query API
```
## Phase 1 — Direct grants
- [x] `lib/acl/schema.sx` — sorts: subject {user, group, role, service}, action,
resource {page, post, thread, peer}
- [x] `lib/acl/facts.sx``actor`, `resource`, `grant`, `deny` predicates as Datalog
EDB
- [x] `lib/acl/engine.sx``(permit? subj act res db)` reduces to Datalog query
- [x] `lib/acl/api.sx` — public `(acl/permit? ...)` taking implicit current db
- [x] `lib/acl/tests/direct.sx` — 15+ cases: direct grant, missing grant, explicit deny
- [x] `lib/acl/scoreboard.{json,md}` baseline
- [x] `lib/acl/conformance.sh` runs the suite
## Phase 2 — Inheritance
- [x] `member_of(actor, group)` chain — group grants apply to members (transitive)
- [x] `child_of(res, parent)` chain — parent grants apply to children (transitive)
- [x] role expansion — role contains list of (action, resource) tuples
- [x] deny-overrides — explicit deny wins over inherited allow
- [x] `lib/acl/tests/inherit.sx` — 25+ cases: nested groups, deep resource trees,
conflict resolution, deny precedence
- [x] document the deny-overrides choice in plan
### deny-overrides policy (the choice)
Encoded as stratified negation: `permit(S,A,R) :- eff_grant(S,A,R), not
eff_deny(S,A,R)`. Both `eff_grant` and `eff_deny` inherit through the *same*
`member_of` (group/role) and `child_of` (resource) chains. Consequences:
- An explicit deny on the exact (S,A,R) defeats any inherited allow.
- A **group-level** or **ancestor-resource** deny inherits down and defeats a
member's/descendant's grant — deny is authoritative across the closure, not
only at the leaf. This is the fail-safe reading: the most permissive
interpretation of "deny wins" would let a narrow grant escape a broad deny;
we chose the opposite.
- Deny is dimension-scoped: a deny on (S, edit, R) never blocks (S, read, R).
Stratifiable because neither `eff_grant` nor `eff_deny` depends on `permit`;
`permit` sits in a strictly higher stratum. Termination is guaranteed —
recursion is only over EDB `member_of`/`child_of` (no function symbols), so
cyclic membership/containment reaches a fixpoint rather than looping (tested).
## Phase 3 — Explanation + audit
- [x] `(acl/explain subj act res)``{:allowed? T :proof <tree>}`
- [x] proof tree extracts from Datalog's derivation
- [x] `lib/acl/audit.sx` — append-only decision log (in-memory + serializer for disk)
- [x] `(acl/audit-tail n)` for recent decisions
- [x] `lib/acl/tests/explain.sx` — proof correctness, audit completeness
### proof reconstruction (the choice)
`lib/datalog/` records derived facts but not provenance, so `lib/acl/explain.sx`
reconstructs the proof by goal-directed search over the *saturated* db: for a
ground goal, find the first ACL rule (in `acl-rules` order) whose body holds,
take the first `dl-query` solution binding the rest, recurse on each body
literal; negated literals become verified `:neg-ok` leaves. The Datalog
derivation graph is a DAG (a fact may hold many ways) — we pick ONE **canonical
proof: first-rule, first-solution**, with EDB/direct rules ordered first so
proofs bottom out quickly. A depth cap (64) guards pathological cyclic data.
`acl-explain` returns `{:allowed? :proof :reason}`; on denial `:reason` carries
the blocking `eff_deny` proof (explicit or inherited) when one exists, else nil
(no grant). Audit log is append-only with monotonic seq numbers (no wall-clock,
for determinism); `acl-audit-decide!` is the logged path, `acl-permit?` stays
pure.
## Phase 4 — Federation
- [x] peer trust facts — `peer(addr, kind)`, `trust(peer, level)`
- [x] delegated grants — `delegate(peer, actor, action, resource)`
- [x] cross-instance permit chain — query asks local + queries trusted peers via fed-sx
- [x] revocation propagation — fact retraction across federation
- [x] `lib/acl/tests/fed.sx` — federated grant chains (mock fed-sx transport in tests)
### federation policy (the choice)
One engine rule carries federation:
`eff_grant(S,A,R) :- delegate(Peer,S,A,R), trust(Peer,L), level_covers(L,A)`.
- **Non-transitive trust.** A peer's `delegate` only grants if a *local*
`trust(Peer,L)` exists and that level `level_covers` the action. There is no
peer-to-peer trust propagation — trusting α never extends to peers α trusts.
- **Trust re-checked every query.** `trust`/`level_covers` are body literals
evaluated at decision time, never baked in at ingestion. Revoking trust or
narrowing a level takes effect on the next `acl-permit?`.
- **Deny still wins.** Federated grants are `eff_grant`, so local (and inherited)
deny overrides them exactly as for local grants.
- **Composes with inheritance.** A delegate to a group flows to members; a
delegate on a parent resource flows to children (federated `eff_grant` feeds
the same recursion).
- **Revocation = retraction.** `acl-revoke!` wraps `dl-retract!`; the next query
re-saturates. `acl-fed-assert!` wraps `dl-assert!` for newly-replicated facts.
- **Transport is fed-sx's job.** `lib/acl/federation.sx` mocks the pull as a
dict {peer-addr → delegate-facts}; `acl-fed-build-db` merges local policy +
pulled delegates.
## Progress log
- **Phase 1 complete (24/24).** ACL is a thin layer over `lib/datalog/`:
- `schema.sx` — sorts (subject/resource kinds, well-known actions) + EDB
predicate arity table + `acl-fact-valid?` validator. Schema is data, since
Datalog is untyped.
- `facts.sx``acl-actor`/`acl-resource-fact`/`acl-grant`/`acl-deny`
constructors returning Datalog fact tuples.
- `engine.sx` — owns the ruleset `acl-phase1-rules` and reduces decisions to
`dl-query`. `acl-build-db` = `dl-program-data facts rules`; `acl-permit?` =
non-empty `(permit S A R)` query.
- `api.sx``acl/load!` rebuilds an implicit current db; `acl/permit?` queries
it. (Slash-symbols like `acl/permit?` parse fine as single tokens.)
- **deny-overrides** encoded as `permit(S,A,R) :- grant(S,A,R), not deny(S,A,R)`.
Stratifies cleanly because `deny` is EDB-only (no rule derives it). Verified:
grant+deny on same (S,A,R) → denied.
- Conformance: `conformance.conf` (datalog preloads + acl modules) + thin
`conformance.sh` wrapper over `lib/guest/conformance.sh`. Scoreboard
generated by the shared driver.
- **Shared-plumbing note (for eventual `lib/guest/rules/`):** the
`build-db = dl-program-data(facts, rules)` + `decide = non-empty ground query`
shape is exactly what mod-sx (Prolog moderation) will also need. The reusable
seam is engine.sx's two functions — facts→db and ground-query→bool — both
pure pass-throughs to the rule engine. Not extracting yet (wait for mod-sx as
second consumer per ground rules).
- **Phase 2 complete (54/54, +30 inherit).** Extended `acl-rules` with
`eff_grant`/`eff_deny` derived relations; `member_of` carries both group and
role membership, `child_of` carries resource trees, `role_grant` confers a
role's (action,resource) capabilities. Direct grants unchanged (base case of
`eff_grant`), Phase 1 suite still green. Constructors `acl-member-of`,
`acl-child-of`, `acl-role-grant` added; schema arity table extended. See the
deny-overrides policy section above. Verified cyclic membership terminates.
- **Shared-plumbing update:** the reusable seam is still just engine.sx's
`facts -> db` + `ground-query -> bool`. The inheritance *rules* are
ACL-specific (group/resource/role vocabulary); mod-sx will have its own. So
the `lib/guest/rules/` extraction stays at the build/decide level, not the
ruleset level.
- **Phase 3 complete (89/89, +35 explain).** Added `explain.sx` (proof
reconstruction, see policy section above), `audit.sx` (append-only log), and
extended `api.sx` with `acl/explain`/`acl/audit`/`acl/audit-tail`. No engine
changes — explanation reads the same saturated db the decision uses.
- **Substrate gotcha:** the host `=` compares symbols by interned identity,
which is *unstable* across `dl-query` saturation/substitution within a
single image — the same two structurally-equal symbol-lists compared `=`
true once and false moments later in the REPL. Conformance runs in a fresh
process per suite so it's deterministic there, but test assertions now use a
name-based `acl-et-eq?` (compare symbols via `symbol->string`), matching the
datalog suite's `dl-api-deep=?` convention. Worth flagging to the kernel
owners but out of acl scope.
- **Phase 4 complete (120/120, +31 fed).** Added `federation.sx` (mock
transport + `acl-fed-build-db`/`acl-revoke!`/`acl-fed-assert!`), one engine
rule (the trust-gated delegate rule), 4 fact constructors, 4 schema arities.
Federated proofs reconstruct for free — `explain.sx` iterates `acl-rules`, so
the delegate rule's EDB body (`delegate`/`trust`/`level_covers`) shows up as
proof leaves with no explain changes. **Roadmap done: all four phases green.**
- **Shared-plumbing final note (for `lib/guest/rules/`):** the durable
reusable seam across acl-sx and the coming mod-sx is exactly four
pass-throughs to the rule engine — `build-db(facts)`, `decide(ground-query)
-> bool`, `explain(goal) -> proof-tree`, and the revoke/assert mutators.
The *rulesets* and *vocabulary* are language-specific (ACL: grant/deny/
member_of/...; mod-sx: Prolog moderation predicates). When mod-sx lands,
extract those four functions (engine.sx + the generic half of explain.sx's
goal-directed reconstructor) into `lib/guest/rules/`, leaving each consumer
its own rules + fact constructors. Proof reconstruction is the non-obvious
reusable piece: it only needs the ruleset as data + a saturated db, both of
which any datalog-backed guest has.
- **dict-mode conformance is slow, not hung:** all suites load + run in one
process (~30-40s for 120 tests, no per-suite timeout). Do not kill early.
- **Tooling note:** sx-tree path-based edit tools (`sx_replace_node`,
`sx_read_subtree` with a path) ignored the path argument in this worktree
(always resolved to index 0 / `[0,..]`), in BOTH `(a b c)` and `(a,b,c)`
forms. `sx_write_file`, `sx_validate`, `sx_find_all`, `sx_summarise`,
`sx_eval` all work; used full-file rewrites instead of path edits throughout.
## Hardening (post-roadmap)
- **`lib/acl/tests/harden.sx` (+25).** Adversarial / cross-phase coverage beyond
the per-phase suites. **Prover-free by design** (see JIT blocker below): only
`acl-permit?` (compiled Datalog, safe at any depth) + pure data ops, never
`acl-explain`/`acl-prove-d`.
- Diamond hierarchies (resource and group): grant on one path + deny on
another → deny wins; both-grant → permit; deny does not leak to siblings.
- Chain inheritance (literal 4-link): top-group grant reaches leaf member and
intermediates; leaf-member deny overrides the top grant; deny on the leaf
doesn't block a higher level.
- Cycle termination: self-membership, self-child, and 2-node membership cycles
all reach a fixpoint and decide correctly.
- Federation conflicts: federated group-grant with a locally-denied member →
deny; multi-peer delegation (one trusted, or both trusted) → permit.
- Degenerate inputs: empty db permits nothing.
- Fact validation: `acl-validate-facts` surfaces wrong-arity + unknown
predicates; `acl-facts-valid?` on clean/empty sets.
- Audit save/restore: snapshot → clear → restore round-trips entries + seq;
seq continues without collision after restore; snapshot is an immutable copy.
- Proof reconstruction itself is covered by tests/explain.sx + tests/fed.sx
(both stay under the warm-process JIT depth threshold); the depth-cap safety
net is verified manually in a warm REPL image but excluded from conformance.
- **New API:** `acl-validate-facts`/`acl-facts-valid?` (schema.sx, opt-in — build
stays lenient); `acl-audit-snapshot`/`acl-audit-restore!`/`acl-audit-copy`
(audit.sx).
- **Substrate gotcha (recorded):** `append!` extends a list built with `(list)`
but **silently no-ops on a `map`/`rest`-derived list** in this runtime. Bit the
first cut of `acl-audit-restore!` (rebuilt the live log via `map`, so later
records didn't append). Fix: always rebuild mutable lists via `(list)` +
`append!` (`acl-audit-copy`). Worth flagging to kernel owners; out of acl scope.
## Blockers
- **JIT loops on deep proof reconstruction (substrate, not acl).** Once the
kernel JIT-compiles the mutually-recursive prover (`acl-prove-d`/
`acl-prove-rules`/`acl-prove-build` in `explain.sx`) — which happens after a
process has run enough explains to cross the compile threshold — the compiled
version **loops indefinitely** on a `member_of`/`child_of` chain deeper than
~3. Symptoms: `acl-explain` over a 4+-deep chain returns instantly in a cold /
warm-REPL image but **hangs** in a long-lived process. The per-phase explain
and fed suites pass only because their proofs stay ≤3 deep; a 5th suite that
explained deeper chains hung the whole conformance run (no per-suite timeout
in dict mode). Matches `[[project_jit_bytecode_bug]]` (ACTIVE).
- *Impact beyond tests:* `acl-explain` is unsafe for deep hierarchies in a
warm production OCaml server. `acl-permit?` is unaffected (it reduces to
compiled Datalog, no SX-side recursion) — only the SX proof reconstructor is.
- *Workaround in acl:* harden suite is prover-free; explain is exercised only
at shallow depth. *Real fix is in the kernel JIT* (out of acl scope) — e.g.
the `_jit_compiling` guard / disabling JIT for the recursive prover, or
fixing the bytecode loop. Recommend the kernel owners reproduce with:
`acl-explain` over a 6-deep `member_of` chain after ~70 prior explains.
- *Minimal repro recorded.* Until fixed, callers needing explanations for
deep hierarchies should flatten or cap depth, or run explain in a cold
worker.

View File

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

View File

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

View File

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

View File

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

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

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

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

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

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

@@ -0,0 +1,112 @@
# mod-on-sx: Moderation on Prolog
rose-ash needs moderation infrastructure: reports flagged by users, automated
classifications (spam, abuse), tiered escalation (auto → human → appeal), audit
trails. Each decision is the conclusion of a backtracking search over evidence and
policy rules — exactly what Prolog does.
Where acl-sx says "may this happen?", mod-sx says "should this stay?" The former is
a positive decision (proof of grant); the latter often a negative one (proof of
violation), and policy chains naturally backtrack: if the first rule doesn't apply,
try the next.
End-state: a Prolog-on-SX layer for moderation policy declaration and evaluation,
with persistent report lifecycle, audit log, escalation state machine, and
federation extension.
## Status (rolling)
`bash lib/mod/conformance.sh`**0/0** (not yet started)
## Ground rules
- **Scope:** only touch `lib/mod/**` and `plans/mod-on-sx.md`. Do **not** edit
`spec/`, `hosts/`, `shared/`, `lib/prolog/**`, or other `lib/<lang>/`. You may
**import** from `lib/prolog/` (public API in `lib/prolog/prolog.sx`); do **not**
modify Prolog.
- **Shared-file issues** go under "Blockers" with a minimal repro; do not fix here.
- **SX files:** use `sx-tree` MCP tools only.
- **Architecture:** policies are Prolog rules over `report(...)` and `evidence(...)`
facts. Decisions are query results. Proof trees become audit records. The state
machine for report lifecycle is separate (an SX module on top).
- **Shared with acl-sx:** rule-engine plumbing may be liftable into `lib/guest/`.
Watch for it; flag in Progress log but do not extract until both subsystems are
past Phase 2.
- **Commits:** one feature per commit. Keep Progress log updated and tick boxes.
## Architecture sketch
```
Report Decision
{:by :about :reason :at} {:action :proof :next-state}
│ ▲
▼ │
lib/mod/schema.sx lib/mod/engine.sx
— report/4, evidence/2, — query Prolog with report fact
classification/3 predicates — extract proof tree
│ ▲
▼ │
lib/mod/policy.sx lib/mod/lifecycle.sx
— rule syntax → Prolog — state machine
— action heads: — open → triaged → decided
{:keep :hide :remove — appeal handling
:escalate :ban} │
│ ▼
▼ lib/mod/audit.sx
lib/mod/api.sx — append-only decision log
— (mod/report ...) — proof tree persistence
— (mod/decide report) — query API
— (mod/appeal id)
lib/mod/fed.sx
— cross-instance reports via fed-sx
— decision sharing / trust model
```
## Phase 1 — Report representation + simple policy
- [ ] `lib/mod/schema.sx``report(id, by, about, reason)`, `evidence(id, kind, val)`,
`policy-action(report, action)` predicates as Prolog facts/rules
- [ ] `lib/mod/policy.sx` — rule declarations: `(defrule action :when conditions)`
desugars to Prolog clause
- [ ] `lib/mod/engine.sx``(decide report-id)` runs Prolog query, returns first
matching action
- [ ] `lib/mod/api.sx``(mod/report by about reason)`, `(mod/decide id)`
- [ ] `lib/mod/tests/decide.sx` — 15+ cases: spam keyword → hide, repeated reports →
escalate, no rule matches → keep
- [ ] `lib/mod/scoreboard.{json,md}`
- [ ] `lib/mod/conformance.sh`
## Phase 2 — Evidence + audit trail
- [ ] evidence accumulation — additional facts asserted before query
- [ ] proof tree from Prolog derivation tree
- [ ] `lib/mod/audit.sx` — append-only log (decision + proof + evidence snapshot)
- [ ] `(mod/audit id)` retrieval
- [ ] `lib/mod/tests/audit.sx` — proof correctness, trail completeness
## Phase 3 — Escalation + lifecycle state machine
- [ ] state machine: `:open → :triaged → :decided → :appealed → :final`
- [ ] auto-tier: first-pass rules decide quick cases
- [ ] human-tier: rules that emit `:escalate` move to next state
- [ ] appeal: re-runs with appeal evidence, may override prior decision
- [ ] `(mod/appeal id new-evidence)` API
- [ ] `lib/mod/tests/escalation.sx` — full lifecycle traversal cases
## Phase 4 — Federation
- [ ] cross-instance reports — peer raises report about local content (or vice versa)
- [ ] decision sharing — actions taken locally propagate to peers via fed-sx
- [ ] trust model — peer's decision is advisory unless `(trust peer :mod)` is granted
- [ ] revocation — undo applied moderation if proof was invalidated
- [ ] `lib/mod/tests/fed.sx` — federated decision chains (mock fed-sx in tests)
## Progress log
(loop fills this in)
## Blockers
(loop fills this in)

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

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