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>
This commit is contained in:
2026-06-06 16:32:13 +00:00
parent c3a0727645
commit fe47334e52
10 changed files with 372 additions and 9 deletions

31
lib/acl/api.sx Normal file
View 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
View 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
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" "$@"

29
lib/acl/engine.sx Normal file
View 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
View 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
View 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
View 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
View 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
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})))

View File

@@ -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