diff --git a/lib/acl/api.sx b/lib/acl/api.sx new file mode 100644 index 00000000..d0ec64a2 --- /dev/null +++ b/lib/acl/api.sx @@ -0,0 +1,31 @@ +;; 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. +(define + acl/permit? + (fn (subj act res) (acl-permit? (acl-ensure-db!) subj act res))) diff --git a/lib/acl/conformance.conf b/lib/acl/conformance.conf new file mode 100644 index 00000000..4338be18 --- /dev/null +++ b/lib/acl/conformance.conf @@ -0,0 +1,25 @@ +# 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/api.sx +) + +SUITES=( + "direct:lib/acl/tests/direct.sx:(acl-direct-tests-run!)" +) diff --git a/lib/acl/conformance.sh b/lib/acl/conformance.sh new file mode 100755 index 00000000..225bea24 --- /dev/null +++ b/lib/acl/conformance.sh @@ -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" "$@" diff --git a/lib/acl/engine.sx b/lib/acl/engine.sx new file mode 100644 index 00000000..ee58fd63 --- /dev/null +++ b/lib/acl/engine.sx @@ -0,0 +1,29 @@ +;; 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. +;; +;; Phase 1 policy — direct grants with deny-overrides: +;; +;; permit(S, A, R) :- grant(S, A, R), not deny(S, A, R). +;; +;; A grant permits unless an explicit deny names the same (S, A, R). Deny wins: +;; the negated literal {:neg (deny S A R)} stratifies cleanly because deny is an +;; EDB relation (no rule derives it), so the fixpoint is well-defined. + +(define + acl-phase1-rules + (quote ((permit S A R <- (grant S A R) {:neg (deny S A R)})))) + +;; Build a Datalog db from a list of EDB facts under the Phase 1 ruleset. +(define acl-build-db (fn (facts) (dl-program-data facts acl-phase1-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))) diff --git a/lib/acl/facts.sx b/lib/acl/facts.sx new file mode 100644 index 00000000..68990f72 --- /dev/null +++ b/lib/acl/facts.sx @@ -0,0 +1,13 @@ +;; 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 covers actor/resource/grant/deny. + +(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))) diff --git a/lib/acl/schema.sx b/lib/acl/schema.sx new file mode 100644 index 00000000..9bf0a618 --- /dev/null +++ b/lib/acl/schema.sx @@ -0,0 +1,48 @@ +;; 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 uses actor/resource/grant/deny; +;; member_of and child_of are reserved for Phase 2 inheritance. +(define acl-edb-arity {:child_of 2 :actor 2 :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))))))) diff --git a/lib/acl/scoreboard.json b/lib/acl/scoreboard.json new file mode 100644 index 00000000..52b81beb --- /dev/null +++ b/lib/acl/scoreboard.json @@ -0,0 +1,10 @@ +{ + "lang": "acl", + "total_passed": 24, + "total_failed": 0, + "total": 24, + "suites": [ + {"name":"direct","passed":24,"failed":0,"total":24} + ], + "generated": "2026-06-06T16:31:36+00:00" +} diff --git a/lib/acl/scoreboard.md b/lib/acl/scoreboard.md new file mode 100644 index 00000000..8ba9fd0b --- /dev/null +++ b/lib/acl/scoreboard.md @@ -0,0 +1,7 @@ +# acl scoreboard + +**24 / 24 passing** (0 failure(s)). + +| Suite | Passed | Total | Status | +|-------|--------|-------|--------| +| direct | 24 | 24 | ok | diff --git a/lib/acl/tests/direct.sx b/lib/acl/tests/direct.sx new file mode 100644 index 00000000..279f6ba8 --- /dev/null +++ b/lib/acl/tests/direct.sx @@ -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}))) diff --git a/plans/acl-on-sx.md b/plans/acl-on-sx.md index 898c8138..c4facd8f 100644 --- a/plans/acl-on-sx.md +++ b/plans/acl-on-sx.md @@ -15,7 +15,7 @@ and federation extension. Reuses `lib/datalog/` evaluator and term model where p ## Status (rolling) -`bash lib/acl/conformance.sh` → **0/0** (not yet started) +`bash lib/acl/conformance.sh` → **24/24** (Phase 1 complete) ## Ground rules @@ -57,15 +57,15 @@ lib/acl/facts.sx — builds Datalog query ## Phase 1 — Direct grants -- [ ] `lib/acl/schema.sx` — sorts: subject {user, group, role, service}, action, +- [x] `lib/acl/schema.sx` — sorts: subject {user, group, role, service}, action, resource {page, post, thread, peer} -- [ ] `lib/acl/facts.sx` — `actor`, `resource`, `grant`, `deny` predicates as Datalog +- [x] `lib/acl/facts.sx` — `actor`, `resource`, `grant`, `deny` predicates as Datalog EDB -- [ ] `lib/acl/engine.sx` — `(permit? subj act res db)` reduces to Datalog query -- [ ] `lib/acl/api.sx` — public `(acl/permit? ...)` taking implicit current db -- [ ] `lib/acl/tests/direct.sx` — 15+ cases: direct grant, missing grant, explicit deny -- [ ] `lib/acl/scoreboard.{json,md}` baseline -- [ ] `lib/acl/conformance.sh` runs the suite +- [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 @@ -95,7 +95,34 @@ lib/acl/facts.sx — builds Datalog query ## Progress log -(loop fills this in) +- **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). + - **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,..]`). `sx_write_file`, `sx_validate`, + `sx_find_all`, `sx_eval` all work; used full-file rewrites instead of path + edits. ## Blockers