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>
105 lines
2.8 KiB
Plaintext
105 lines
2.8 KiB
Plaintext
; Reference migration — acl grants on persist. Proves the AFTER behaviour,
|
|
; including the capabilities the hand-rolled BEFORE version could not provide
|
|
; (durability across restart + an audit trail).
|
|
|
|
(persist-test
|
|
"grant then can?"
|
|
(let
|
|
((b (persist/open)))
|
|
(begin
|
|
(acl/grant b "doc-1" "alice" 0)
|
|
(acl/can? b "doc-1" "alice")))
|
|
true)
|
|
(persist-test
|
|
"no grant means no access"
|
|
(acl/can? (persist/open) "doc-1" "alice")
|
|
false)
|
|
(persist-test
|
|
"revoke removes access"
|
|
(let
|
|
((b (persist/open)))
|
|
(begin
|
|
(acl/grant b "doc-1" "alice" 0)
|
|
(acl/revoke b "doc-1" "alice" 1)
|
|
(acl/can? b "doc-1" "alice")))
|
|
false)
|
|
(persist-test
|
|
"multiple principals tracked independently"
|
|
(let
|
|
((b (persist/open)))
|
|
(begin
|
|
(acl/grant b "doc-1" "alice" 0)
|
|
(acl/grant b "doc-1" "bob" 1)
|
|
(acl/revoke b "doc-1" "alice" 2)
|
|
(list (acl/can? b "doc-1" "alice") (acl/can? b "doc-1" "bob"))))
|
|
(list false true))
|
|
(persist-test
|
|
"granting twice is idempotent in the set"
|
|
(let
|
|
((b (persist/open)))
|
|
(begin
|
|
(acl/grant b "doc-1" "alice" 0)
|
|
(acl/grant b "doc-1" "alice" 1)
|
|
(len (acl/grants b "doc-1"))))
|
|
1)
|
|
(persist-test
|
|
"grants on different resources are isolated"
|
|
(let
|
|
((b (persist/open)))
|
|
(begin
|
|
(acl/grant b "doc-1" "alice" 0)
|
|
(acl/grant b "doc-2" "bob" 0)
|
|
(list (acl/can? b "doc-1" "bob") (acl/can? b "doc-2" "bob"))))
|
|
(list false true))
|
|
(persist-test
|
|
"audit window answers when-was-it-granted (new capability)"
|
|
(let
|
|
((b (persist/open)))
|
|
(begin
|
|
(acl/grant b "doc-1" "alice" 100)
|
|
(acl/revoke b "doc-1" "alice" 200)
|
|
(acl/grant b "doc-1" "bob" 300)
|
|
(len (acl/audit-window b "doc-1" 150 300))))
|
|
2)
|
|
(persist-test
|
|
"materialized view stays current on publish"
|
|
(let
|
|
((b (persist/open)))
|
|
(let
|
|
((h (persist/view-attach (persist/hub b) (acl/view "doc-1"))))
|
|
(begin
|
|
(persist/publish
|
|
h
|
|
(acl/stream "doc-1")
|
|
"granted"
|
|
0
|
|
{:principal "alice"})
|
|
(acl/can-fast? b "doc-1" "alice"))))
|
|
true)
|
|
(persist-test
|
|
"grants survive restart on the durable backend (the headline win)"
|
|
(let
|
|
((disk (persist/mem-backend)))
|
|
(begin
|
|
(let
|
|
((db (persist/mock-durable disk)))
|
|
(begin
|
|
(acl/grant db "doc-1" "alice" 0)
|
|
(acl/grant db "doc-1" "bob" 1)))
|
|
(let
|
|
((db2 (persist/mock-durable disk)))
|
|
(list (acl/can? db2 "doc-1" "alice") (acl/can? db2 "doc-1" "bob")))))
|
|
(list true true))
|
|
(persist-test
|
|
"revoke before restart is still revoked after"
|
|
(let
|
|
((disk (persist/mem-backend)))
|
|
(begin
|
|
(let
|
|
((db (persist/mock-durable disk)))
|
|
(begin
|
|
(acl/grant db "doc-1" "alice" 0)
|
|
(acl/revoke db "doc-1" "alice" 1)))
|
|
(acl/can? (persist/mock-durable disk) "doc-1" "alice")))
|
|
false)
|