giles
40be9cd074
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 10m25s
federation.sx adds peer/trust/delegate/level_covers facts and one engine rule: delegated grants apply only when local trust covers the action, re-checked every query (non-transitive, fail-safe). Local/inherited deny overrides federated grants; delegation composes with group and resource inheritance. acl-revoke!/acl-fed-assert! propagate retraction/assertion; mock fed-sx transport for tests. Federated proofs reconstruct via the existing explainer. Roadmap complete: 120/120. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
62 lines
2.2 KiB
Plaintext
62 lines
2.2 KiB
Plaintext
;; lib/acl/federation.sx — cross-instance ACL facts + revocation.
|
||
;;
|
||
;; fed-sx replicates ACL facts between instances; this module models the local
|
||
;; side. A peer's authority arrives as `delegate(Peer, S, A, R)` facts, which
|
||
;; only take effect when a local `trust(Peer, L)` and `level_covers(L, A)`
|
||
;; authorise them (enforced by the engine rule, re-checked every query). The
|
||
;; actual network transport is fed-sx's job and is mocked in tests as a dict.
|
||
;;
|
||
;; Trust is NOT transitive: trusting peer α does not extend to peers α trusts.
|
||
;; Only delegate facts that α itself asserts, and that local trust covers, flow.
|
||
|
||
;; Mock fed-sx pull: `transport` is a dict mapping a peer address (its string
|
||
;; name) to the list of delegate facts that peer asserts. Returns the facts for
|
||
;; `addr`, or an empty list if the peer is unknown / unreachable.
|
||
(define
|
||
acl-fed-fetch
|
||
(fn
|
||
(transport addr)
|
||
(let
|
||
((k (if (symbol? addr) (symbol->string addr) addr)))
|
||
(if (has-key? transport k) (get transport k) (list)))))
|
||
|
||
;; Gather delegate facts from every peer in `addrs` via the transport.
|
||
(define
|
||
acl-fed-collect
|
||
(fn
|
||
(transport addrs)
|
||
(let
|
||
((acc (list)))
|
||
(do
|
||
(for-each
|
||
(fn
|
||
(addr)
|
||
(for-each
|
||
(fn (f) (append! acc f))
|
||
(acl-fed-fetch transport addr)))
|
||
addrs)
|
||
acc))))
|
||
|
||
;; Build a db from local facts plus delegate facts pulled from `peers`. Local
|
||
;; facts must include the `trust`/`level_covers` policy; replicated delegate
|
||
;; facts are gated against it by the engine rule at query time.
|
||
(define
|
||
acl-fed-build-db
|
||
(fn
|
||
(local-facts transport peers)
|
||
(let
|
||
((all (list)))
|
||
(do
|
||
(for-each (fn (f) (append! all f)) local-facts)
|
||
(for-each
|
||
(fn (f) (append! all f))
|
||
(acl-fed-collect transport peers))
|
||
(acl-build-db all)))))
|
||
|
||
;; Propagated revocation: retract a replicated fact (e.g. a peer's delegate, or
|
||
;; local trust) from a live db. The next decision re-saturates and reflects it.
|
||
(define acl-revoke! (fn (db fact) (do (dl-retract! db fact) db)))
|
||
|
||
;; Propagated assertion: ingest a newly replicated fact into a live db.
|
||
(define acl-fed-assert! (fn (db fact) (do (dl-assert! db fact) db)))
|