giles
e448220b33
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 33s
federation.sx — peer-asserted subjects, advisory and trust-gated. An
assertion is accepted only from an explicitly trusted peer (else
{error, untrusted}) and is flagged {peer_asserted, Peer}, never promoted to
local authority; acl decides what a peer-asserted identity may do. Cross-
instance subject mapping namespaces remote subjects by peer
({federated, Peer, Remote}) so two peers' "alice" never collide, with
optional explicit aliasing. Adds an audit-completeness test. New
tests/federation.sx. All four phases done — 124/124.
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
118 lines
5.6 KiB
Plaintext
118 lines
5.6 KiB
Plaintext
;; identity/tests/audit.sx — the grant audit ledger. Every grant
|
|
;; transition is recorded; the ledger is queryable per subject and
|
|
;; chronological. Covers issue/refresh/revoke wiring through the token
|
|
;; registry, reuse-triggered revoke, per-subject isolation, completeness,
|
|
;; and direct ledger use.
|
|
|
|
(define id-audit-test-count 0)
|
|
(define id-audit-test-pass 0)
|
|
(define id-audit-test-fails (list))
|
|
|
|
(define
|
|
id-audit-test
|
|
(fn
|
|
(name actual expected)
|
|
(set! id-audit-test-count (+ id-audit-test-count 1))
|
|
(if
|
|
(= actual expected)
|
|
(set! id-audit-test-pass (+ id-audit-test-pass 1))
|
|
(append! id-audit-test-fails {:name name :expected expected :actual actual}))))
|
|
|
|
(define ida-ev erlang-eval-ast)
|
|
(define idanm (fn (v) (get v :name)))
|
|
|
|
(identity-load-audit!)
|
|
(identity-load-token!)
|
|
|
|
;; ── issue is audited ─────────────────────────────────────────────
|
|
|
|
(id-audit-test
|
|
"issue records one event for the subject"
|
|
(ida-ev
|
|
"A = identity_audit:start(),\n Reg = identity_tokens:start(A),\n identity_tokens:issue(Reg, alice, web, read),\n identity_audit:count(A, alice)")
|
|
1)
|
|
|
|
(id-audit-test
|
|
"the recorded action is issue"
|
|
(idanm
|
|
(ida-ev
|
|
"A = identity_audit:start(),\n Reg = identity_tokens:start(A),\n identity_tokens:issue(Reg, alice, web, read),\n case identity_audit:actions(A, alice) of\n [issue] -> matched;\n _ -> nomatch\n end"))
|
|
"matched")
|
|
|
|
;; ── full grant lifecycle is audited in order ─────────────────────
|
|
|
|
(id-audit-test
|
|
"issue, refresh, revoke are recorded in order"
|
|
(idanm
|
|
(ida-ev
|
|
"A = identity_audit:start(),\n Reg = identity_tokens:start(A),\n {ok, G, R} = identity_tokens:issue_grant(Reg, alice, web, read),\n identity_tokens:refresh(Reg, R),\n identity_tokens:revoke(Reg, G),\n case identity_audit:actions(A, alice) of\n [issue, refresh, revoke] -> matched;\n _ -> nomatch\n end"))
|
|
"matched")
|
|
|
|
;; ── reuse-triggered revoke is audited ────────────────────────────
|
|
|
|
(id-audit-test
|
|
"a refresh-reuse cascade records a revoke event"
|
|
(idanm
|
|
(ida-ev
|
|
"A = identity_audit:start(),\n Reg = identity_tokens:start(A),\n {ok, _G, R} = identity_tokens:issue_grant(Reg, alice, web, read),\n identity_tokens:refresh(Reg, R),\n identity_tokens:refresh(Reg, R),\n case identity_audit:actions(A, alice) of\n [issue, refresh, revoke] -> matched;\n _ -> nomatch\n end"))
|
|
"matched")
|
|
|
|
;; ── per-subject isolation ────────────────────────────────────────
|
|
|
|
(id-audit-test
|
|
"the ledger separates subjects"
|
|
(ida-ev
|
|
"A = identity_audit:start(),\n Reg = identity_tokens:start(A),\n identity_tokens:issue(Reg, alice, web, read),\n identity_tokens:issue(Reg, bob, cli, write),\n identity_tokens:issue(Reg, alice, mobile, read),\n identity_audit:count(A, alice)")
|
|
2)
|
|
|
|
(id-audit-test
|
|
"an unaudited subject has zero events"
|
|
(ida-ev
|
|
"A = identity_audit:start(),\n Reg = identity_tokens:start(A),\n identity_tokens:issue(Reg, alice, web, read),\n identity_audit:count(A, ghost)")
|
|
0)
|
|
|
|
;; ── the full log accumulates across subjects ─────────────────────
|
|
|
|
(id-audit-test
|
|
"all events accumulate in the ledger"
|
|
(ida-ev
|
|
"A = identity_audit:start(),\n Reg = identity_tokens:start(A),\n identity_tokens:issue(Reg, alice, web, read),\n identity_tokens:issue(Reg, bob, cli, write),\n length(identity_audit:all(A))")
|
|
2)
|
|
|
|
;; ── completeness: no grant transition is dropped ─────────────────
|
|
|
|
(id-audit-test
|
|
"the ledger is complete across a mixed transition stream"
|
|
(ida-ev
|
|
"A = identity_audit:start(),\n Reg = identity_tokens:start(A),\n identity_tokens:issue(Reg, alice, web, read),\n {ok, _G, R} = identity_tokens:issue_grant(Reg, alice, cli, read),\n identity_tokens:refresh(Reg, R),\n {ok, B} = identity_tokens:issue(Reg, bob, web, read),\n identity_tokens:revoke(Reg, B),\n length(identity_audit:all(A))")
|
|
5)
|
|
|
|
;; ── start/0 stays unaudited (no regression) ──────────────────────
|
|
|
|
(id-audit-test
|
|
"an unaudited registry still issues working tokens"
|
|
(idanm
|
|
(ida-ev
|
|
"Reg = identity_tokens:start(),\n {ok, T} = identity_tokens:issue(Reg, alice, web, read),\n case identity_tokens:introspect(Reg, T) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
|
|
"active")
|
|
|
|
;; ── direct ledger use (e.g. login/consent events) ────────────────
|
|
|
|
(id-audit-test
|
|
"events can be recorded directly on the ledger"
|
|
(idanm
|
|
(ida-ev
|
|
"A = identity_audit:start(),\n identity_audit:record(A, alice, login),\n identity_audit:record(A, alice, consent),\n case identity_audit:actions(A, alice) of\n [login, consent] -> matched;\n _ -> nomatch\n end"))
|
|
"matched")
|
|
|
|
(id-audit-test
|
|
"an audit entry carries its subject"
|
|
(idanm
|
|
(ida-ev
|
|
"A = identity_audit:start(),\n identity_audit:record(A, alice, login),\n case identity_audit:audit(A, alice) of\n [{_, Subject, _}] -> Subject;\n _ -> nomatch\n end"))
|
|
"alice")
|
|
|
|
(define
|
|
id-audit-test-summary
|
|
(str "audit " id-audit-test-pass "/" id-audit-test-count))
|