acl: Phase 2 inheritance (groups, resource trees, roles) + 30 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 36s
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>
This commit is contained in:
@@ -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!)"
|
||||
)
|
||||
|
||||
@@ -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`
|
||||
|
||||
@@ -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)))
|
||||
|
||||
@@ -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?
|
||||
|
||||
@@ -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"
|
||||
}
|
||||
|
||||
@@ -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 |
|
||||
|
||||
202
lib/acl/tests/inherit.sx
Normal file
202
lib/acl/tests/inherit.sx
Normal 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})))
|
||||
@@ -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`,
|
||||
|
||||
Reference in New Issue
Block a user