giles
9437f99e28
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 35s
New adversarial/cross-phase coverage: diamond resource+group hierarchies (deny wins per path), chain inheritance + leaf deny, cycle termination, multi-peer delegation, fact validation, audit snapshot/restore round-trip. Adds acl-validate-facts/acl-facts-valid? (schema) and acl-audit-snapshot/ restore!/copy (audit). Fixed acl-audit-restore! rebuilding the live log via map (append! silently no-ops on map-derived lists). Suite is prover-free: a substrate JIT bug loops the recursive proof reconstructor on deep chains in warm processes (documented in Blockers); acl-permit? is unaffected. 145/145. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
72 lines
2.4 KiB
Plaintext
72 lines
2.4 KiB
Plaintext
;; 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: actor/resource/grant/deny.
|
|
;; Phase 2: member_of (subject->group/role), child_of (resource->parent),
|
|
;; role_grant (role->action,resource).
|
|
;; Phase 4: peer (addr->kind), trust (peer->level),
|
|
;; delegate (peer->subj,action,resource), level_covers (level->action).
|
|
(define acl-edb-arity {:role_grant 3 :child_of 2 :trust 2 :peer 2 :actor 2 :level_covers 2 :delegate 4 :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)))))))
|
|
|
|
;; Return the sublist of facts that fail acl-fact-valid?. Empty list means the
|
|
;; whole set is well-formed. acl-build-db stays lenient (Datalog accepts any
|
|
;; tuple, and custom action symbols are allowed); callers opt in to checking.
|
|
(define
|
|
acl-validate-facts
|
|
(fn
|
|
(facts)
|
|
(let
|
|
((bad (list)))
|
|
(do
|
|
(for-each
|
|
(fn (f) (when (not (acl-fact-valid? f)) (append! bad f)))
|
|
facts)
|
|
bad))))
|
|
|
|
(define
|
|
acl-facts-valid?
|
|
(fn (facts) (= (len (acl-validate-facts facts)) 0)))
|