giles
84d5732b38
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 41s
examples/acl.sx: a tested template migrating an ACL-grants store from a hand-rolled ephemeral map to persist — grants/revokes as events, current set as a projection, O(1) checks via a materialized view, audit via read-window. Header carries the BEFORE->AFTER diff. Proves grants survive restart on the durable backend (the capability the BEFORE version lacked). The pattern other subsystem loops copy; does not touch the real lib/acl. 201/201. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
80 lines
2.9 KiB
Plaintext
80 lines
2.9 KiB
Plaintext
; persist/examples/acl — a WORKED MIGRATION REFERENCE. A subsystem (acl grants:
|
|
; who may access what) currently hand-rolls an in-memory mutable map that loses
|
|
; every grant on restart and keeps no audit trail. This shows the same subsystem
|
|
; rebuilt on persist. It is the template other subsystem loops copy; it does NOT
|
|
; touch the real lib/acl (out of this loop's scope).
|
|
;
|
|
; BEFORE — hand-rolled, ephemeral, no history, no concurrency safety:
|
|
; (define acl-grants {}) ; resource -> principal list (mutable)
|
|
; (define acl-grant! (fn (r p) (set! acl-grants (assoc acl-grants r (cons p (get acl-grants r))))))
|
|
; (define acl-revoke! (fn (r p) (set! acl-grants (assoc acl-grants r (remove p ...)))))
|
|
; (define acl-can? (fn (r p) (contains? (get acl-grants r) p)))
|
|
; ;; vanishes on restart; "when/why was X granted?" is unanswerable.
|
|
;
|
|
; AFTER — on persist. Grants/revokes are EVENTS (history matters), the current
|
|
; grant set is a PROJECTION, checks read a materialized VIEW, and the audit trail
|
|
; is a time-windowed query. Every fn takes a backend `b`, so the same code runs
|
|
; on the in-memory backend today and the durable backend unchanged.
|
|
; Requires: lib/persist/log.sx, lib/persist/project.sx, lib/persist/view.sx,
|
|
; lib/persist/query.sx.
|
|
|
|
(define acl/stream (fn (resource) (str "acl/" resource)))
|
|
|
|
; write side — grant/revoke append events (the history is the source of truth)
|
|
(define
|
|
acl/grant
|
|
(fn
|
|
(b resource principal at)
|
|
(persist/append b (acl/stream resource) "granted" at {:principal principal})))
|
|
(define
|
|
acl/revoke
|
|
(fn
|
|
(b resource principal at)
|
|
(persist/append b (acl/stream resource) "revoked" at {:principal principal})))
|
|
|
|
; fold step: grant adds a principal (once), revoke removes it
|
|
(define
|
|
acl/step
|
|
(fn
|
|
(set e)
|
|
(let
|
|
((p (get (persist/event-data e) :principal)))
|
|
(if
|
|
(equal? (persist/event-type e) "granted")
|
|
(if (contains? set p) set (append set p))
|
|
(filter (fn (x) (not (equal? x p))) set)))))
|
|
|
|
; read side — current grant set + membership check (replays the log)
|
|
(define
|
|
acl/grants
|
|
(fn
|
|
(b resource)
|
|
(persist/project-fold b (acl/stream resource) acl/step (list))))
|
|
(define
|
|
acl/can?
|
|
(fn (b resource principal) (contains? (acl/grants b resource) principal)))
|
|
|
|
; materialized view — attach to a hub for O(1) checks that stay current on write
|
|
(define
|
|
acl/view
|
|
(fn
|
|
(resource)
|
|
(persist/view
|
|
(str "acl-current/" resource)
|
|
(acl/stream resource)
|
|
acl/step
|
|
(list))))
|
|
(define
|
|
acl/can-fast?
|
|
(fn
|
|
(b resource principal)
|
|
(contains? (persist/view-peek b (acl/view resource)) principal)))
|
|
|
|
; audit — grants/revokes for a resource in a time window (the new capability the
|
|
; hand-rolled version could never answer)
|
|
(define
|
|
acl/audit-window
|
|
(fn
|
|
(b resource from to)
|
|
(persist/read-window b (acl/stream resource) from to)))
|