acl: Phase 1 direct grants + deny-overrides, 24 tests
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 56s
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>
This commit is contained in:
31
lib/acl/api.sx
Normal file
31
lib/acl/api.sx
Normal file
@@ -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)))
|
||||||
25
lib/acl/conformance.conf
Normal file
25
lib/acl/conformance.conf
Normal file
@@ -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!)"
|
||||||
|
)
|
||||||
3
lib/acl/conformance.sh
Executable file
3
lib/acl/conformance.sh
Executable 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" "$@"
|
||||||
29
lib/acl/engine.sx
Normal file
29
lib/acl/engine.sx
Normal file
@@ -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)))
|
||||||
13
lib/acl/facts.sx
Normal file
13
lib/acl/facts.sx
Normal file
@@ -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)))
|
||||||
48
lib/acl/schema.sx
Normal file
48
lib/acl/schema.sx
Normal file
@@ -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)))))))
|
||||||
10
lib/acl/scoreboard.json
Normal file
10
lib/acl/scoreboard.json
Normal file
@@ -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"
|
||||||
|
}
|
||||||
7
lib/acl/scoreboard.md
Normal file
7
lib/acl/scoreboard.md
Normal file
@@ -0,0 +1,7 @@
|
|||||||
|
# acl scoreboard
|
||||||
|
|
||||||
|
**24 / 24 passing** (0 failure(s)).
|
||||||
|
|
||||||
|
| Suite | Passed | Total | Status |
|
||||||
|
|-------|--------|-------|--------|
|
||||||
|
| direct | 24 | 24 | ok |
|
||||||
170
lib/acl/tests/direct.sx
Normal file
170
lib/acl/tests/direct.sx
Normal 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})))
|
||||||
@@ -15,7 +15,7 @@ and federation extension. Reuses `lib/datalog/` evaluator and term model where p
|
|||||||
|
|
||||||
## Status (rolling)
|
## Status (rolling)
|
||||||
|
|
||||||
`bash lib/acl/conformance.sh` → **0/0** (not yet started)
|
`bash lib/acl/conformance.sh` → **24/24** (Phase 1 complete)
|
||||||
|
|
||||||
## Ground rules
|
## Ground rules
|
||||||
|
|
||||||
@@ -57,15 +57,15 @@ lib/acl/facts.sx — builds Datalog query
|
|||||||
|
|
||||||
## Phase 1 — Direct grants
|
## 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}
|
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
|
EDB
|
||||||
- [ ] `lib/acl/engine.sx` — `(permit? subj act res db)` reduces to Datalog query
|
- [x] `lib/acl/engine.sx` — `(permit? subj act res db)` reduces to Datalog query
|
||||||
- [ ] `lib/acl/api.sx` — public `(acl/permit? ...)` taking implicit current db
|
- [x] `lib/acl/api.sx` — public `(acl/permit? ...)` taking implicit current db
|
||||||
- [ ] `lib/acl/tests/direct.sx` — 15+ cases: direct grant, missing grant, explicit deny
|
- [x] `lib/acl/tests/direct.sx` — 15+ cases: direct grant, missing grant, explicit deny
|
||||||
- [ ] `lib/acl/scoreboard.{json,md}` baseline
|
- [x] `lib/acl/scoreboard.{json,md}` baseline
|
||||||
- [ ] `lib/acl/conformance.sh` runs the suite
|
- [x] `lib/acl/conformance.sh` runs the suite
|
||||||
|
|
||||||
## Phase 2 — Inheritance
|
## Phase 2 — Inheritance
|
||||||
|
|
||||||
@@ -95,7 +95,34 @@ lib/acl/facts.sx — builds Datalog query
|
|||||||
|
|
||||||
## Progress log
|
## 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
|
## Blockers
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user