From 9261d69cc5088ceef1234a017f27a907cd01d936 Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 6 Jun 2026 16:36:24 +0000 Subject: [PATCH] acl: Phase 2 inheritance (groups, resource trees, roles) + 30 tests 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) --- lib/acl/conformance.conf | 1 + lib/acl/engine.sx | 44 +++++++-- lib/acl/facts.sx | 16 +++- lib/acl/schema.sx | 8 +- lib/acl/scoreboard.json | 9 +- lib/acl/scoreboard.md | 3 +- lib/acl/tests/inherit.sx | 202 +++++++++++++++++++++++++++++++++++++++ plans/acl-on-sx.md | 45 +++++++-- 8 files changed, 303 insertions(+), 25 deletions(-) create mode 100644 lib/acl/tests/inherit.sx diff --git a/lib/acl/conformance.conf b/lib/acl/conformance.conf index 4338be18..86dbb133 100644 --- a/lib/acl/conformance.conf +++ b/lib/acl/conformance.conf @@ -22,4 +22,5 @@ PRELOADS=( SUITES=( "direct:lib/acl/tests/direct.sx:(acl-direct-tests-run!)" + "inherit:lib/acl/tests/inherit.sx:(acl-inherit-tests-run!)" ) diff --git a/lib/acl/engine.sx b/lib/acl/engine.sx index ee58fd63..a0925d1f 100644 --- a/lib/acl/engine.sx +++ b/lib/acl/engine.sx @@ -4,20 +4,46 @@ ;; 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: +;; Policy — inheritance with deny-overrides: ;; -;; permit(S, A, R) :- grant(S, A, R), not deny(S, A, R). +;; 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 ;; -;; 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. +;; 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. Deny inherits through the *same* group +;; and resource chains as grant, so a group-level or ancestor-resource deny is +;; authoritative for members/descendants — not just a deny naming the exact +;; (S,A,R). This is the principled, fail-safe reading of "deny wins". +;; +;; 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). +;; - 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-phase1-rules - (quote ((permit S A R <- (grant S A R) {:neg (deny S A R)})))) + 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_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 Phase 1 ruleset. -(define acl-build-db (fn (facts) (dl-program-data facts acl-phase1-rules))) +;; 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` diff --git a/lib/acl/facts.sx b/lib/acl/facts.sx index 68990f72..0e07e124 100644 --- a/lib/acl/facts.sx +++ b/lib/acl/facts.sx @@ -2,7 +2,10 @@ ;; ;; 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. +;; 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). (define acl-actor (fn (id kind) (list (quote actor) id kind))) @@ -11,3 +14,14 @@ (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))) diff --git a/lib/acl/schema.sx b/lib/acl/schema.sx index 9bf0a618..3fc1c310 100644 --- a/lib/acl/schema.sx +++ b/lib/acl/schema.sx @@ -12,9 +12,11 @@ ;; 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}) +;; 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). +(define acl-edb-arity {:role_grant 3 :child_of 2 :actor 2 :member_of 2 :deny 3 :grant 3 :resource 2}) (define acl-member? diff --git a/lib/acl/scoreboard.json b/lib/acl/scoreboard.json index 52b81beb..919e8b91 100644 --- a/lib/acl/scoreboard.json +++ b/lib/acl/scoreboard.json @@ -1,10 +1,11 @@ { "lang": "acl", - "total_passed": 24, + "total_passed": 54, "total_failed": 0, - "total": 24, + "total": 54, "suites": [ - {"name":"direct","passed":24,"failed":0,"total":24} + {"name":"direct","passed":24,"failed":0,"total":24}, + {"name":"inherit","passed":30,"failed":0,"total":30} ], - "generated": "2026-06-06T16:31:36+00:00" + "generated": "2026-06-06T16:35:53+00:00" } diff --git a/lib/acl/scoreboard.md b/lib/acl/scoreboard.md index 8ba9fd0b..03601f35 100644 --- a/lib/acl/scoreboard.md +++ b/lib/acl/scoreboard.md @@ -1,7 +1,8 @@ # acl scoreboard -**24 / 24 passing** (0 failure(s)). +**54 / 54 passing** (0 failure(s)). | Suite | Passed | Total | Status | |-------|--------|-------|--------| | direct | 24 | 24 | ok | +| inherit | 30 | 30 | ok | diff --git a/lib/acl/tests/inherit.sx b/lib/acl/tests/inherit.sx new file mode 100644 index 00000000..11722481 --- /dev/null +++ b/lib/acl/tests/inherit.sx @@ -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}))) diff --git a/plans/acl-on-sx.md b/plans/acl-on-sx.md index c4facd8f..d8e531fa 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` → **24/24** (Phase 1 complete) +`bash lib/acl/conformance.sh` → **54/54** (Phases 1-2 complete) ## Ground rules @@ -69,13 +69,32 @@ lib/acl/facts.sx — builds Datalog query ## Phase 2 — Inheritance -- [ ] `member_of(actor, group)` chain — group grants apply to members (transitive) -- [ ] `child_of(res, parent)` chain — parent grants apply to children (transitive) -- [ ] role expansion — role contains list of (action, resource) tuples -- [ ] deny-overrides — explicit deny wins over inherited allow -- [ ] `lib/acl/tests/inherit.sx` — 25+ cases: nested groups, deep resource trees, +- [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 -- [ ] document the deny-overrides choice in plan +- [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 @@ -118,6 +137,18 @@ lib/acl/facts.sx — builds Datalog query 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. - **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`,