Compare commits

...

25 Commits

Author SHA1 Message Date
8130521f02 identity: dynamic client registration (RFC 7591, +5 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 30s
register_dynamic generates a client_id + secret server-side and registers
the client, returning {ok, ClientId, Secret} — self-service onboarding
distinct from the manual register_client. A dynamic confidential client can
then use client_credentials; a dynamic public client stays
unauthorized_client. New tests/dynreg.sx. 222/222.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 04:48:45 +00:00
398209d484 identity: pushed authorization requests (PAR, RFC 9126, +7 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 36s
push_authorization_request lodges the authorization params under a
single-use request_uri; authorize_pushed redeems it into the normal consent
flow. Pushed requests reuse the pending store ({pushed, Rec} keyed by the
request_uri ref — distinct from consent req_ids, so no collision and no new
loop state). The pushed binding (client + redirect + PKCE) is still enforced
at exchange. New tests/par.sx. 217/217.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 04:09:55 +00:00
3c3b09688a identity: RFC 7662 full introspection metadata — introspect_full (+9 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 18s
introspect_full returns {active, Subject, Client, Scope, Exp, Iat, bearer}
for live tokens and {inactive} otherwise — deepening the opaque-token /
live-lookup model. Access tokens now carry Iat (clock-at-issue); exp = iat +
ttl. Simple introspect is unchanged (all prior suites green). New
tests/introspect.sx. 210/210.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 03:56:16 +00:00
ded7170540 identity: token exchange — downscope into an independent token (RFC 8693, +8 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 58s
oauth.sx gains token_exchange(SubjectToken, RequestedScope): a valid access
token is downscoped into a NEW independent grant for the same subject
(subset only, else invalid_scope; inactive subject token → invalid_grant).
The exchanged token's lifecycle is independent of the subject token
(revoking either leaves the other active); exchanges chain. Least-privilege
handoff to downstream services. New tests/exchange.sx. 201/201.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 03:31:14 +00:00
b1f9c6bef0 identity: subject-wide session management — sessions + logout_all (+8 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 34s
api.sx gains sessions(Subject) (enumerate a subject's live sessions) and
logout_all(Subject) ("log out everywhere") — revokes and deregisters every
session the subject holds, auditing a logout per session, leaving other
subjects' sessions untouched. Builds on registry.sessions_for. New
tests/session_mgmt.sx. 193/193.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 03:16:21 +00:00
db885e15bc identity: identity->acl delegation boundary — 401 gates before 403 (+8 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 57s
delegation.sx makes the loop's central rule concrete: check() introspects
the token first — inactive → {error, unauthenticated} (401), acl never
consulted — and only an authenticated subject's request is delegated to
acl, which returns permit/deny ({error, forbidden} = 403). 401 strictly
precedes 403. acl-on-sx (Datalog) is a different SX guest wired at the
integration layer, so the decider here is a labelled stub (permits when
Action in Scope); swap the pid and the boundary is unchanged. New
tests/delegation.sx. 185/185 — extensions backlog clear.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 03:05:12 +00:00
d2f5b49d3f identity: unify api.sx facade over audit + membership (+9 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 19s
The identity coordinator now owns an audit ledger and a membership registry
alongside its token table (started with the ledger) and session registry.
login/logout are audited; new ops history/enroll/member_status/member_project
surface the audit and membership axes through the one `identity` door.
Identity proves who and reports membership; acl still decides permission.
Existing api behaviour unchanged. New tests/facade.sx. 177/177.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 02:51:48 +00:00
226d755b57 identity: device authorization grant (RFC 8628, +10 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 40s
device.sx — for input-constrained devices. authorize → {device_code,
user_code}; the human approves/denies out-of-band by user_code; the device
polls by device_code through the §3.5 status machine (authorization_pending
→ access_denied / {ok, Token}). Device code is single-use once a token
issues; approve-after-deny is rejected. Tokens grant-backed via token.sx.
Device-code expiry + slow_down deferred (no wall clock). New
tests/device.sx. 168/168.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 02:39:03 +00:00
3f3459d129 identity: client-credentials grant (RFC 6749 §4.4, +9 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 40s
oauth.sx now owns a client registry (loop/6) with register_client and the
client_credentials grant. A confidential client authenticates and gets a
token acting on its own behalf (subject = the client), no refresh token
(§4.4.3). A public client is unauthorized_client; any auth failure (unknown
client or wrong secret) is invalid_client — no client-existence oracle
(§5.2). identity-load-oauth! now pulls its deps. New tests/grants.sx.
158/158.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 02:22:26 +00:00
9860582b4a identity: OAuth client registry — public/confidential clients + redirect allow-list (11 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 25s
clients.sx (RFC 6749 §2) — confidential clients must present the correct
secret at the token endpoint (wrong → invalid_client); public clients are
identified but not authenticated; redirect_uris are pre-registered and
checked by exact-match valid_redirect (§3.1.2.2 + Security BCP). Standalone
module for now; wiring confidential-client auth into oauth exchange is a
follow-up. New tests/clients.sx. 149/149.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 02:03:44 +00:00
a43825f25f identity: access-token TTL via logical clock — expires_in (RFC 6749 §4.2.2, +8 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 22s
The token registry holds a logical clock (advance/now; the substrate has no
wall clock). Grants carry a Ttl; each access token carries an Expires
(Now-at-issue + Ttl, or infinity); introspect returns inactive once Now
reaches it. Refresh mints a fresh short-lived access token — short access
tokens, long refresh tokens. issue/4 and issue_grant/4 default to infinity so
all prior behaviour is unchanged. New tests/expiry.sx. token loop/6. 138/138.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 01:53:19 +00:00
e951f23f14 identity: scope-as-set + scope narrowing on refresh (RFC 6749 §6, +6 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 44s
Each access token now carries its own effective scope (<= the grant's max).
refresh/3 requests a narrower scope; the request must be a subset of the
grant scope, else {error, invalid_scope} and the refresh token is NOT
consumed (client may retry, §5.2). refresh/2 keeps full scope; scope stays
opaque (atom or list) for issue so all prior atom-scope tests are unchanged.
Also files a Blocker: PKCE S256 is blocked on erlang substrate bugs (binary
=:= always true; crypto:hash ignores binary content). token 24/24, 130/130.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 01:43:16 +00:00
21673b6731 identity: mark base roadmap complete (124/124); add extensions backlog
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m6s
All four phases done. Records an extensions queue (PKCE S256, token TTL,
scope sets/narrowing, client registry, client-credentials/device grants,
acl delegation, state/nonce, unified facade) to keep deepening the engine.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 01:29:47 +00:00
e448220b33 identity: trust-gated federated identity + cross-instance mapping (Phase 4 complete, +13)
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>
2026-06-07 01:29:08 +00:00
a5c22c5a01 identity: grant audit ledger — issue/refresh/revoke events, queryable per subject (10 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 42s
audit.sx is an append-only ledger process. token.sx gains start/1(Audit)
and emits an event on every grant transition (issue, refresh, revoke —
including reuse-triggered revoke); start/0 stays unaudited so existing use
is unchanged (token.sx has no compile-time dep on the audit module, it just
sends to a pid). The ledger answers (identity/audit subject) via
audit/actions/count/all, chronological. In-memory event stream; persist
backing is a later Erlang<->persist bridge, out of scope. 111/111.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 01:16:18 +00:00
785faf2441 identity: delegated grant-verification cache with generation invalidation (Phase 3 complete, +9)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 55s
cache.sx — a process wrapping the token registry, memoising introspect.
Revocation stays real via generation invalidation: any revoke/refresh bumps
a generation counter, so every cached positive instantly becomes a miss and
re-validates against the live registry. A revoked token never reads valid
out of cache, not for a millisecond. stats() exposes hits/misses. New
tests/cache.sx. 101/101.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 01:03:57 +00:00
dc00ed9786 identity: membership state machine + per-app grant projection (17 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
membership.sx — coop membership as a guarded state machine
(none→pending→active→lapsed⇄active, any→revoked terminal); invalid
transitions return explicit {error, CurrentStatus}, never silent no-ops.
project(Subject, App) renders the one canonical state into a per-app claim
({member,Tier,App} / {pending,App} / {lapsed,App} / {denied,App} /
{non_member,App}) — identity reports what the membership is; acl decides
whether the app should honour it. New tests/membership.sx. 92/92.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 00:54:51 +00:00
56cf920041 identity: silent SSO prompt=none fast-path — one session, many clients (10 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 43s
oauth.sx now owns a session registry. establish creates a subject session;
silent_authorize (OIDC prompt=none §3.1.2.1) asks "does this subject have a
live session?" — if yes it mints a code skipping consent, bound to client +
redirect_uri + PKCE exactly like a consented code; if no it returns
login_required (a negative state, not a login redirect). One session serves
many clients; end_session closes the fast-path. New tests/sso.sx. 75/75.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 00:45:15 +00:00
20ba152e36 identity: wire refresh into oauth + e2e flow tests (Phase 2 complete, +3 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 53s
exchange now issues an access+refresh pair (RFC 6749 §4.1.4/§5.1) via
token.sx issue_grant; added the refresh grant (§6) delegating to token
rotation. End-to-end: code-exchange → refresh → introspect (active),
refresh-token reuse rejected (invalid_grant), and revoke-then-refresh
blocked by grant cascade. oauth 17/17, 65/65.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 00:35:10 +00:00
baee67f561 identity: refresh-token rotation + cascading revocation (token.sx grant-centric, +9 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 37s
The grant {Subject,Client,Scope,Status} becomes the unit of authorization
and cascade; access + refresh tokens reference it. issue_grant returns an
access+refresh pair; refresh (RFC 6749 §6) supersedes the presented refresh
token and mints a fresh pair; reusing a superseded refresh token is treated
as theft (RFC 6819 §5.2.2.3) and revokes the whole family, killing the live
descendant. revoke of any token cascades to the grant. All prior token
behaviour preserved. token 18/18, 62/62.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 00:26:05 +00:00
27f43dbf10 identity: OAuth2 authorization-code flow as message protocol + PKCE (14 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 54s
oauth.sx — RFC 6749 §4.1 as a state machine on one authz-server process:
authorize → {consent_required} → consent(allow|deny) → {code} → exchange
→ {ok, Token}. Exchange enforces single-use codes (§10.5, replay →
invalid_grant), client_id + redirect_uri binding (§4.1.3), and PKCE
(RFC 7636 plain) verifier match. Issued tokens are grant-backed via
token.sx so revocation stays real. 53/53.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 00:11:18 +00:00
064bbf18b3 identity: service facade api.sx — login/verify/revoke/logout (10 tests, Phase 1 complete)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 57s
identity:start() spawns one coordinator owning the token table + session
registry and exposes the whole-domain ops. The coordinator is the owner
sessions notify on idle timeout, so an expired session deregisters itself
— timeout-driven, never swept. verify/2 answers identity only ({active,
Subject, Client, Scope}); permission is delegated to acl. 39/39.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 00:00:05 +00:00
938e90455d identity: session registry — route by id and (subject, client) + SSO fan-out (9 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 50s
Directory process holding (SessionId, Subject, Client, Pid) rows. Answers
the SSO probe lookup(Subject, Client) and the fan-out sessions_for(Subject)
(one subject, many clients). Routes only — no grant state, decides nothing.
Integration-tested: register a live session, route to it, confirm active.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 23:55:34 +00:00
ac63501266 identity: opaque grant-backed tokens — issue/introspect/revoke (9 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 33s
Token table is a process; the token is an opaque make_ref carrying no
information. introspect() is a live table lookup every time, so
revocation is real (RFC 7009 §2): a revoked token reads {inactive} on
the next introspection with no validity window. Reply shapes follow
RFC 7662 §2.2 ({active, Subject, Client, Scope} / {inactive}).

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 23:48:30 +00:00
1c6b80404e identity: session-as-process — create/lookup/expire/revoke + idle timeout (11 tests)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 48s
Session is an Erlang process holding {subject, client, status}. lookup/
touch/expire/revoke are messages; expiry is the process's own
`receive ... after Ttl` timeout (RFC-agnostic; no global sweep), which
notifies the owner and tombstones. Tombstoned sessions answer lookups
with an explicit {error, expired|revoked}, never a silent dead mailbox.
Adds the conformance harness + scoreboard.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-06 23:45:50 +00:00
37 changed files with 3221 additions and 16 deletions

36
lib/identity/api.sx Normal file

File diff suppressed because one or more lines are too long

27
lib/identity/audit.sx Normal file
View File

@@ -0,0 +1,27 @@
;; identity/audit.sx — the grant audit ledger.
;;
;; Every transition that changes a grant — issue, refresh, revoke (and,
;; wired from oauth, consent) — appends an immutable event to this
;; append-only process. The ledger is queryable by subject, which is what
;; `(identity/audit subject)` answers. This is the in-memory realisation
;; of the event stream; a persist-backed stream is a later substrate
;; concern (Erlang↔persist bridge), kept out of scope here per the loop's
;; \"in-memory log until persist lands\" allowance — the queryable
;; semantics are identical.
;;
;; Events are {Seq, Subject, Action}; Seq is a monotonic sequence number.
;; Reads return chronological (oldest-first) order:
;;
;; record(A, Subject, Action) -> ok (one-way; FIFO-ordered)
;; audit(A, Subject) -> [{Seq, Subject, Action}, ...]
;; actions(A, Subject) -> [Action, ...]
;; count(A, Subject) -> N
;; all(A) -> [{Seq, Subject, Action}, ...]
(define
identity-audit-source
"-module(identity_audit).\n\n start() ->\n spawn(fun () -> loop([], 0) end).\n\n record(A, Subject, Action) ->\n A ! {event, Subject, Action},\n ok.\n\n audit(A, Subject) ->\n A ! {audit, Subject, self()},\n receive {audit_reply, R} -> R end.\n\n actions(A, Subject) ->\n A ! {actions, Subject, self()},\n receive {audit_reply, R} -> R end.\n\n count(A, Subject) ->\n A ! {count, Subject, self()},\n receive {audit_reply, R} -> R end.\n\n all(A) ->\n A ! {all, self()},\n receive {audit_reply, R} -> R end.\n\n loop(Events, Seq) ->\n receive\n {event, Subject, Action} ->\n loop([{Seq, Subject, Action} | Events], Seq + 1);\n {audit, Subject, From} ->\n From ! {audit_reply, collect(Subject, Events, [])},\n loop(Events, Seq);\n {actions, Subject, From} ->\n From ! {audit_reply, action_list(Subject, Events, [])},\n loop(Events, Seq);\n {count, Subject, From} ->\n From ! {audit_reply, count_subj(Subject, Events, 0)},\n loop(Events, Seq);\n {all, From} ->\n From ! {audit_reply, reverse(Events, [])},\n loop(Events, Seq);\n {stop, From} ->\n From ! {audit_reply, ok}\n end.\n\n collect(_, [], Acc) -> Acc;\n collect(Subject, [{Seq, S, A} | Rest], Acc) ->\n case S =:= Subject of\n true -> collect(Subject, Rest, [{Seq, S, A} | Acc]);\n false -> collect(Subject, Rest, Acc)\n end.\n\n action_list(_, [], Acc) -> Acc;\n action_list(Subject, [{_, S, A} | Rest], Acc) ->\n case S =:= Subject of\n true -> action_list(Subject, Rest, [A | Acc]);\n false -> action_list(Subject, Rest, Acc)\n end.\n\n count_subj(_, [], N) -> N;\n count_subj(Subject, [{_, S, _} | Rest], N) ->\n case S =:= Subject of\n true -> count_subj(Subject, Rest, N + 1);\n false -> count_subj(Subject, Rest, N)\n end.\n\n reverse([], Acc) -> Acc;\n reverse([H | T], Acc) -> reverse(T, [H | Acc]).")
(define
identity-load-audit!
(fn () (erlang-load-module identity-audit-source)))

29
lib/identity/cache.sx Normal file
View File

@@ -0,0 +1,29 @@
;; identity/cache.sx — a delegated grant-verification cache, mirroring the
;; Redis-cache pattern apps use in front of grant verification.
;;
;; The cache is a process wrapping a token registry. introspect() is
;; memoised; issue/issue_grant/refresh/revoke pass through. The danger
;; with any cache is staleness: a revoked token must NOT keep reading
;; valid out of the cache, not even for a millisecond (the loop's hard
;; rule). We get that for free with GENERATION invalidation:
;;
;; - each cache entry records the generation it was written at;
;; - a hit requires entry.generation == current generation;
;; - any state-changing op that can invalidate an existing token
;; (revoke — which cascades to a grant; refresh — whose reuse cascades)
;; bumps the generation.
;;
;; So a single revoke instantly invalidates every cached positive: the
;; next introspect is a miss and re-validates against the live registry,
;; which returns {inactive}. Revocation stays real; the cache only ever
;; accelerates the steady state, never overrides a revocation.
;;
;; stats() -> {Hits, Misses} so callers can see the cache is live.
(define
identity-cache-source
"-module(identity_grant_cache).\n\n start() ->\n spawn(fun () ->\n Reg = identity_tokens:start(),\n loop(Reg, 1, [], 0, 0)\n end).\n\n issue(C, Subject, Client, Scope) ->\n C ! {issue, Subject, Client, Scope, self()},\n receive {cache_reply, R} -> R end.\n\n issue_grant(C, Subject, Client, Scope) ->\n C ! {issue_grant, Subject, Client, Scope, self()},\n receive {cache_reply, R} -> R end.\n\n refresh(C, RefreshTok) ->\n C ! {refresh, RefreshTok, self()},\n receive {cache_reply, R} -> R end.\n\n introspect(C, Token) ->\n C ! {introspect, Token, self()},\n receive {cache_reply, R} -> R end.\n\n revoke(C, Token) ->\n C ! {revoke, Token, self()},\n receive {cache_reply, R} -> R end.\n\n stats(C) ->\n C ! {stats, self()},\n receive {cache_reply, R} -> R end.\n\n loop(Reg, Gen, Entries, Hits, Misses) ->\n receive\n {introspect, Tok, From} ->\n case lookup_fresh(Tok, Gen, Entries) of\n {hit, Result} ->\n From ! {cache_reply, Result},\n loop(Reg, Gen, Entries, Hits + 1, Misses);\n miss ->\n Result = identity_tokens:introspect(Reg, Tok),\n From ! {cache_reply, Result},\n loop(Reg, Gen, put_entry(Tok, Result, Gen, Entries), Hits, Misses + 1)\n end;\n {issue, Subject, Client, Scope, From} ->\n From ! {cache_reply, identity_tokens:issue(Reg, Subject, Client, Scope)},\n loop(Reg, Gen, Entries, Hits, Misses);\n {issue_grant, Subject, Client, Scope, From} ->\n From ! {cache_reply, identity_tokens:issue_grant(Reg, Subject, Client, Scope)},\n loop(Reg, Gen, Entries, Hits, Misses);\n {refresh, RTok, From} ->\n From ! {cache_reply, identity_tokens:refresh(Reg, RTok)},\n loop(Reg, Gen + 1, Entries, Hits, Misses);\n {revoke, Tok, From} ->\n identity_tokens:revoke(Reg, Tok),\n From ! {cache_reply, ok},\n loop(Reg, Gen + 1, Entries, Hits, Misses);\n {stats, From} ->\n From ! {cache_reply, {Hits, Misses}},\n loop(Reg, Gen, Entries, Hits, Misses)\n end.\n\n lookup_fresh(_, _, []) -> miss;\n lookup_fresh(Tok, Gen, [{T, {Result, G}} | Rest]) ->\n case T =:= Tok of\n true ->\n case G =:= Gen of\n true -> {hit, Result};\n false -> miss\n end;\n false -> lookup_fresh(Tok, Gen, Rest)\n end.\n\n put_entry(Tok, Result, Gen, Entries) ->\n [{Tok, {Result, Gen}} | remove(Tok, Entries)].\n\n remove(_, []) -> [];\n remove(Tok, [{T, V} | Rest]) ->\n case T =:= Tok of\n true -> remove(Tok, Rest);\n false -> [{T, V} | remove(Tok, Rest)]\n end.")
(define
identity-load-cache!
(fn () (erlang-load-module identity-cache-source)))

28
lib/identity/clients.sx Normal file
View File

@@ -0,0 +1,28 @@
;; identity/clients.sx — the OAuth client registry (RFC 6749 §2).
;;
;; A client is registered with a type, a secret, and its allow-listed
;; redirect_uris:
;;
;; public — cannot keep a secret (SPAs, native apps, §2.1);
;; identified but not authenticated.
;; confidential — can authenticate; MUST present its secret at the token
;; endpoint (§3.2.1, §4.1.3). A wrong secret is
;; invalid_client — never a soft pass.
;;
;; Redirect URIs must be pre-registered (§3.1.2.2 + OAuth Security BCP):
;; valid_redirect/3 is the exact-match check the authorize/exchange steps
;; consult so an attacker cannot redirect the code to an unregistered URI.
;;
;; register(C, ClientId, Type, Secret, RedirectUris) -> ok | {error, exists}
;; lookup(C, ClientId) -> {ok, Type, RedirectUris} | {error, unknown_client}
;; authenticate(C, ClientId, Sec) -> {ok, public} | {ok, confidential}
;; | {error, invalid_client} | {error, unknown_client}
;; valid_redirect(C, ClientId, U) -> true | false
(define
identity-clients-source
"-module(identity_clients).\n\n start() ->\n spawn(fun () -> loop([]) end).\n\n register(C, ClientId, Type, Secret, RedirectUris) ->\n C ! {register, ClientId, Type, Secret, RedirectUris, self()},\n receive {client_reply, R} -> R end.\n\n lookup(C, ClientId) ->\n C ! {lookup, ClientId, self()},\n receive {client_reply, R} -> R end.\n\n authenticate(C, ClientId, Secret) ->\n C ! {authenticate, ClientId, Secret, self()},\n receive {client_reply, R} -> R end.\n\n valid_redirect(C, ClientId, Uri) ->\n C ! {valid_redirect, ClientId, Uri, self()},\n receive {client_reply, R} -> R end.\n\n loop(Clients) ->\n receive\n {register, ClientId, Type, Secret, RedirectUris, From} ->\n case find(ClientId, Clients) of\n {ok, _} ->\n From ! {client_reply, {error, exists}},\n loop(Clients);\n none ->\n From ! {client_reply, ok},\n loop([{ClientId, {Type, Secret, RedirectUris}} | Clients])\n end;\n {lookup, ClientId, From} ->\n case find(ClientId, Clients) of\n none -> From ! {client_reply, {error, unknown_client}};\n {ok, {Type, _, Uris}} -> From ! {client_reply, {ok, Type, Uris}}\n end,\n loop(Clients);\n {authenticate, ClientId, Secret, From} ->\n case find(ClientId, Clients) of\n none ->\n From ! {client_reply, {error, unknown_client}};\n {ok, {public, _, _}} ->\n From ! {client_reply, {ok, public}};\n {ok, {confidential, S, _}} ->\n case S =:= Secret of\n true -> From ! {client_reply, {ok, confidential}};\n false -> From ! {client_reply, {error, invalid_client}}\n end\n end,\n loop(Clients);\n {valid_redirect, ClientId, Uri, From} ->\n case find(ClientId, Clients) of\n none -> From ! {client_reply, false};\n {ok, {_, _, Uris}} -> From ! {client_reply, member(Uri, Uris)}\n end,\n loop(Clients);\n {stop, From} ->\n From ! {client_reply, ok}\n end.\n\n member(_, []) -> false;\n member(X, [Y | Rest]) ->\n case X =:= Y of\n true -> true;\n false -> member(X, Rest)\n end.\n\n find(_, []) -> none;\n find(Key, [{K, V} | Rest]) ->\n case K =:= Key of\n true -> {ok, V};\n false -> find(Key, Rest)\n end.")
(define
identity-load-clients!
(fn () (erlang-load-module identity-clients-source)))

211
lib/identity/conformance.sh Executable file
View File

@@ -0,0 +1,211 @@
#!/usr/bin/env bash
# identity-on-sx conformance runner.
#
# Loads the Erlang-on-SX substrate, the identity library, and every
# identity test suite via the epoch protocol, collects pass/fail counts,
# and writes lib/identity/scoreboard.json + .md.
#
# Usage:
# bash lib/identity/conformance.sh # run all suites
# bash lib/identity/conformance.sh -v # verbose per-suite
set -uo pipefail
cd "$(git rev-parse --show-toplevel)"
SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
if [ ! -x "$SX_SERVER" ]; then
SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
fi
if [ ! -x "$SX_SERVER" ]; then
echo "ERROR: sx_server.exe not found." >&2
exit 1
fi
VERBOSE="${1:-}"
TMPFILE=$(mktemp)
OUTFILE=$(mktemp)
trap "rm -f $TMPFILE $OUTFILE" EXIT
# Each suite: name | counter pass | counter total
SUITES=(
"session|id-session-test-pass|id-session-test-count"
"token|id-token-test-pass|id-token-test-count"
"registry|id-registry-test-pass|id-registry-test-count"
"api|id-api-test-pass|id-api-test-count"
"oauth|id-oauth-test-pass|id-oauth-test-count"
"sso|id-sso-test-pass|id-sso-test-count"
"membership|id-membership-test-pass|id-membership-test-count"
"cache|id-cache-test-pass|id-cache-test-count"
"audit|id-audit-test-pass|id-audit-test-count"
"federation|id-fed-test-pass|id-fed-test-count"
"expiry|id-expiry-test-pass|id-expiry-test-count"
"clients|id-clients-test-pass|id-clients-test-count"
"grants|id-grants-test-pass|id-grants-test-count"
"device|id-device-test-pass|id-device-test-count"
"facade|id-facade-test-pass|id-facade-test-count"
"delegation|id-deleg-test-pass|id-deleg-test-count"
"session-mgmt|id-smgmt-test-pass|id-smgmt-test-count"
"exchange|id-xchg-test-pass|id-xchg-test-count"
"introspect|id-intr-test-pass|id-intr-test-count"
"par|id-par-test-pass|id-par-test-count"
"dynreg|id-dyn-test-pass|id-dyn-test-count"
)
cat > "$TMPFILE" << 'EPOCHS'
(epoch 1)
(load "lib/erlang/tokenizer.sx")
(load "lib/erlang/parser.sx")
(load "lib/erlang/parser-core.sx")
(load "lib/erlang/parser-expr.sx")
(load "lib/erlang/parser-module.sx")
(load "lib/erlang/transpile.sx")
(load "lib/erlang/runtime.sx")
(load "lib/identity/session.sx")
(load "lib/identity/token.sx")
(load "lib/identity/registry.sx")
(load "lib/identity/api.sx")
(load "lib/identity/oauth.sx")
(load "lib/identity/membership.sx")
(load "lib/identity/cache.sx")
(load "lib/identity/audit.sx")
(load "lib/identity/federation.sx")
(load "lib/identity/clients.sx")
(load "lib/identity/device.sx")
(load "lib/identity/delegation.sx")
(load "lib/identity/tests/session.sx")
(load "lib/identity/tests/token.sx")
(load "lib/identity/tests/registry.sx")
(load "lib/identity/tests/api.sx")
(load "lib/identity/tests/oauth.sx")
(load "lib/identity/tests/sso.sx")
(load "lib/identity/tests/membership.sx")
(load "lib/identity/tests/cache.sx")
(load "lib/identity/tests/audit.sx")
(load "lib/identity/tests/federation.sx")
(load "lib/identity/tests/expiry.sx")
(load "lib/identity/tests/clients.sx")
(load "lib/identity/tests/grants.sx")
(load "lib/identity/tests/device.sx")
(load "lib/identity/tests/facade.sx")
(load "lib/identity/tests/delegation.sx")
(load "lib/identity/tests/session_mgmt.sx")
(load "lib/identity/tests/exchange.sx")
(load "lib/identity/tests/introspect.sx")
(load "lib/identity/tests/par.sx")
(load "lib/identity/tests/dynreg.sx")
(epoch 100)
(eval "(list id-session-test-pass id-session-test-count)")
(epoch 101)
(eval "(list id-token-test-pass id-token-test-count)")
(epoch 102)
(eval "(list id-registry-test-pass id-registry-test-count)")
(epoch 103)
(eval "(list id-api-test-pass id-api-test-count)")
(epoch 104)
(eval "(list id-oauth-test-pass id-oauth-test-count)")
(epoch 105)
(eval "(list id-sso-test-pass id-sso-test-count)")
(epoch 106)
(eval "(list id-membership-test-pass id-membership-test-count)")
(epoch 107)
(eval "(list id-cache-test-pass id-cache-test-count)")
(epoch 108)
(eval "(list id-audit-test-pass id-audit-test-count)")
(epoch 109)
(eval "(list id-fed-test-pass id-fed-test-count)")
(epoch 110)
(eval "(list id-expiry-test-pass id-expiry-test-count)")
(epoch 111)
(eval "(list id-clients-test-pass id-clients-test-count)")
(epoch 112)
(eval "(list id-grants-test-pass id-grants-test-count)")
(epoch 113)
(eval "(list id-device-test-pass id-device-test-count)")
(epoch 114)
(eval "(list id-facade-test-pass id-facade-test-count)")
(epoch 115)
(eval "(list id-deleg-test-pass id-deleg-test-count)")
(epoch 116)
(eval "(list id-smgmt-test-pass id-smgmt-test-count)")
(epoch 117)
(eval "(list id-xchg-test-pass id-xchg-test-count)")
(epoch 118)
(eval "(list id-intr-test-pass id-intr-test-count)")
(epoch 119)
(eval "(list id-par-test-pass id-par-test-count)")
(epoch 120)
(eval "(list id-dyn-test-pass id-dyn-test-count)")
EPOCHS
timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1
parse_pair() {
local epoch="$1"
local line
line=$(grep -A1 "^(ok-len $epoch " "$OUTFILE" | tail -1)
echo "$line" | sed -E 's/[()]//g'
}
TOTAL_PASS=0
TOTAL_COUNT=0
JSON_SUITES=""
MD_ROWS=""
idx=0
for entry in "${SUITES[@]}"; do
name="${entry%%|*}"
epoch=$((100 + idx))
pair=$(parse_pair "$epoch")
pass=$(echo "$pair" | awk '{print $1}')
count=$(echo "$pair" | awk '{print $2}')
if [ -z "$pass" ] || [ -z "$count" ]; then
pass=0
count=0
fi
TOTAL_PASS=$((TOTAL_PASS + pass))
TOTAL_COUNT=$((TOTAL_COUNT + count))
status="ok"
marker="✅"
if [ "$pass" != "$count" ]; then
status="fail"
marker="❌"
fi
if [ "$VERBOSE" = "-v" ]; then
printf " %-12s %s/%s\n" "$name" "$pass" "$count"
fi
if [ -n "$JSON_SUITES" ]; then JSON_SUITES+=","; fi
JSON_SUITES+=$'\n '
JSON_SUITES+="{\"name\":\"$name\",\"pass\":$pass,\"total\":$count,\"status\":\"$status\"}"
MD_ROWS+="| $marker | $name | $pass | $count |"$'\n'
idx=$((idx + 1))
done
printf '\nidentity-on-sx conformance: %d / %d\n' "$TOTAL_PASS" "$TOTAL_COUNT"
cat > lib/identity/scoreboard.json <<JSON
{
"language": "identity",
"total_pass": $TOTAL_PASS,
"total": $TOTAL_COUNT,
"suites": [$JSON_SUITES
]
}
JSON
cat > lib/identity/scoreboard.md <<MD
# identity-on-sx Scoreboard
**Total: ${TOTAL_PASS} / ${TOTAL_COUNT} tests passing**
| | Suite | Pass | Total |
|---|---|---|---|
$MD_ROWS
Generated by \`lib/identity/conformance.sh\`.
MD
if [ "$TOTAL_PASS" -eq "$TOTAL_COUNT" ]; then
exit 0
else
exit 1
fi

View File

@@ -0,0 +1,34 @@
;; identity/delegation.sx — the identity -> acl delegation boundary.
;;
;; This is the loop's central architectural rule made concrete:
;; AUTHENTICATION is identity's job; AUTHORIZATION is acl's. A request is
;; checked in two stages, and the order matters:
;;
;; 1. identity proves WHO via the opaque token (introspect). If the token
;; is inactive, the answer is {error, unauthenticated} — a 401. acl is
;; NEVER consulted; \"I don't know who you are\" is not a permission
;; question.
;; 2. only for an authenticated subject does identity construct the
;; permission query {Subject, Scope, Action, Resource} and HAND IT OFF
;; to acl. acl returns permit | deny; deny is {error, forbidden} — a
;; 403. identity itself never decides permission.
;;
;; The real decider is acl-on-sx (Datalog), which runs as a different
;; guest language on SX and is wired in at the integration layer. Here the
;; acl side is a labelled STUB process so the boundary is exercised: it
;; permits when the Action is within the token's granted Scope. Swap the
;; stub pid for the acl adapter and the boundary is unchanged.
;;
;; check(TokReg, Acl, Token, Action, Resource) ->
;; {ok, Subject} | {error, unauthenticated} | {error, forbidden}
(define
identity-delegation-source
"-module(identity_delegation).\n\n check(TokReg, Acl, Token, Action, Resource) ->\n case identity_tokens:introspect(TokReg, Token) of\n {inactive} ->\n {error, unauthenticated};\n {active, Subject, _Client, Scope} ->\n Acl ! {acl_query, Subject, Scope, Action, Resource, self()},\n receive {acl_verdict, V} ->\n case V of\n permit -> {ok, Subject};\n deny -> {error, forbidden}\n end\n end\n end.\n\n %% --- stub acl decider (stands in for acl-on-sx / Datalog) ---\n %% Permits iff the Action is one of the token's granted scopes. The real\n %% acl decides on rules + facts; this only exercises the handoff shape.\n stub_acl() ->\n spawn(fun () -> acl_loop() end).\n\n acl_loop() ->\n receive\n {acl_query, _Subject, Scope, Action, _Resource, From} ->\n From ! {acl_verdict, decide(Action, Scope)},\n acl_loop();\n stop ->\n ok\n end.\n\n decide(Action, Scope) ->\n case member(Action, Scope) of\n true -> permit;\n false -> deny\n end.\n\n member(_, []) -> false;\n member(X, [Y | Rest]) ->\n case X =:= Y of\n true -> true;\n false -> member(X, Rest)\n end.")
(define
identity-load-delegation!
(fn
()
(identity-load-token!)
(erlang-load-module identity-delegation-source)))

33
lib/identity/device.sx Normal file
View File

@@ -0,0 +1,33 @@
;; identity/device.sx — the device authorization grant (RFC 8628).
;;
;; For input-constrained devices (TVs, CLIs): the device gets a device_code
;; + user_code, the user approves out-of-band on another device, and the
;; device polls the token endpoint until it flips. The poll status machine
;; is RFC 8628 §3.5:
;;
;; authorize(ClientId, Scope) -> {ok, DeviceCode, UserCode}
;; approve(UserCode, Subject) -> ok | {error, ...} (the human's browser)
;; deny(UserCode) -> ok | {error, ...}
;; poll(DeviceCode) ->
;; pending -> {error, authorization_pending}
;; denied -> {error, access_denied}
;; approved -> {ok, Token} (device code is then single-use)
;; consumed -> {error, invalid_grant}
;; unknown -> {error, invalid_grant}
;;
;; Tokens are grant-backed (token.sx) so revocation stays real. Device-code
;; expiry and slow_down (poll-rate limiting) are deferred — the substrate
;; has no wall clock and the core status machine is the security-relevant
;; part; introspect via token.sx already honours token TTL.
;;
;; State: loop(TokReg, Requests) where Requests is
;; [{DeviceCode, UserCode, ClientId, Scope, Status}]
;; Status :: pending | {approved, Subject} | denied | consumed
(define
identity-device-source
"-module(identity_device).\n\n start() ->\n spawn(fun () ->\n TokReg = identity_tokens:start(),\n loop(TokReg, [])\n end).\n\n authorize(D, ClientId, Scope) ->\n D ! {authorize, ClientId, Scope, self()},\n receive {device_reply, R} -> R end.\n\n approve(D, UserCode, Subject) ->\n D ! {approve, UserCode, Subject, self()},\n receive {device_reply, R} -> R end.\n\n deny(D, UserCode) ->\n D ! {deny, UserCode, self()},\n receive {device_reply, R} -> R end.\n\n poll(D, DeviceCode) ->\n D ! {poll, DeviceCode, self()},\n receive {device_reply, R} -> R end.\n\n introspect(D, Token) ->\n D ! {introspect, Token, self()},\n receive {device_reply, R} -> R end.\n\n loop(TokReg, Requests) ->\n receive\n {authorize, ClientId, Scope, From} ->\n DeviceCode = make_ref(),\n UserCode = make_ref(),\n From ! {device_reply, {ok, DeviceCode, UserCode}},\n loop(TokReg, [{DeviceCode, UserCode, ClientId, Scope, pending} | Requests]);\n {approve, UserCode, Subject, From} ->\n case find_user(UserCode, Requests) of\n none ->\n From ! {device_reply, {error, unknown_code}},\n loop(TokReg, Requests);\n {ok, {_, _, _, _, pending}} ->\n From ! {device_reply, ok},\n loop(TokReg, set_user(UserCode, {approved, Subject}, Requests));\n {ok, {_, _, _, _, St}} ->\n From ! {device_reply, {error, St}},\n loop(TokReg, Requests)\n end;\n {deny, UserCode, From} ->\n case find_user(UserCode, Requests) of\n none ->\n From ! {device_reply, {error, unknown_code}},\n loop(TokReg, Requests);\n {ok, {_, _, _, _, pending}} ->\n From ! {device_reply, ok},\n loop(TokReg, set_user(UserCode, denied, Requests));\n {ok, {_, _, _, _, St}} ->\n From ! {device_reply, {error, St}},\n loop(TokReg, Requests)\n end;\n {poll, DeviceCode, From} ->\n case find_device(DeviceCode, Requests) of\n none ->\n From ! {device_reply, {error, invalid_grant}},\n loop(TokReg, Requests);\n {ok, {_, _, _, _, pending}} ->\n From ! {device_reply, {error, authorization_pending}},\n loop(TokReg, Requests);\n {ok, {_, _, _, _, denied}} ->\n From ! {device_reply, {error, access_denied}},\n loop(TokReg, Requests);\n {ok, {_, _, _, _, consumed}} ->\n From ! {device_reply, {error, invalid_grant}},\n loop(TokReg, Requests);\n {ok, {_, _, ClientId, Scope, {approved, Subject}}} ->\n {ok, Token} = identity_tokens:issue(TokReg, Subject, ClientId, Scope),\n From ! {device_reply, {ok, Token}},\n loop(TokReg, set_device(DeviceCode, consumed, Requests))\n end;\n {introspect, Token, From} ->\n From ! {device_reply, identity_tokens:introspect(TokReg, Token)},\n loop(TokReg, Requests);\n {stop, From} ->\n From ! {device_reply, ok}\n end.\n\n find_device(_, []) -> none;\n find_device(DCode, [{D, U, C, S, St} | Rest]) ->\n case D =:= DCode of\n true -> {ok, {D, U, C, S, St}};\n false -> find_device(DCode, Rest)\n end.\n\n find_user(_, []) -> none;\n find_user(UCode, [{D, U, C, S, St} | Rest]) ->\n case U =:= UCode of\n true -> {ok, {D, U, C, S, St}};\n false -> find_user(UCode, Rest)\n end.\n\n set_device(_, _, []) -> [];\n set_device(DCode, NewSt, [{D, U, C, S, St} | Rest]) ->\n case D =:= DCode of\n true -> [{D, U, C, S, NewSt} | Rest];\n false -> [{D, U, C, S, St} | set_device(DCode, NewSt, Rest)]\n end.\n\n set_user(_, _, []) -> [];\n set_user(UCode, NewSt, [{D, U, C, S, St} | Rest]) ->\n case U =:= UCode of\n true -> [{D, U, C, S, NewSt} | Rest];\n false -> [{D, U, C, S, St} | set_user(UCode, NewSt, Rest)]\n end.")
(define
identity-load-device!
(fn () (identity-load-token!) (erlang-load-module identity-device-source)))

View File

@@ -0,0 +1,30 @@
;; identity/federation.sx — federated identity: peer-asserted subjects,
;; advisory and trust-gated.
;;
;; A peer instance can assert \"this remote subject authenticated with me\".
;; We accept such an assertion ONLY from a peer we explicitly trust
;; (trust-gated); an assertion from an unknown peer is {error, untrusted},
;; never silently honoured. Even when accepted, the resulting identity is
;; ADVISORY: it is flagged peer_asserted with its origin peer, never
;; promoted to local authority. Downstream (acl) decides how much a
;; peer-asserted identity may do; identity only records who asserted it.
;;
;; Cross-instance subject mapping turns a (Peer, RemoteSubject) pair into a
;; stable local subject. By default it is namespaced — {federated, Peer,
;; RemoteSubject} — so two peers' \"alice\" never collide; an explicit map
;; can alias a remote subject to a local one.
;;
;; trust(F, Peer) / untrust(F, Peer) / trusted(F, Peer)
;; map(F, Peer, Remote, Local) -> ok (optional alias)
;; resolve(F, Peer, Remote) -> {ok, LocalSubject}
;; assert_id(F, Peer, Remote) -> {ok, LocalSubject}
;; | {error, untrusted}
;; provenance(F, LocalSubject) -> {peer_asserted, Peer} | {local}
(define
identity-federation-source
"-module(identity_federation).\n\n start() ->\n spawn(fun () -> loop([], [], []) end).\n\n trust(F, Peer) ->\n F ! {trust, Peer, self()},\n receive {fed_reply, R} -> R end.\n\n untrust(F, Peer) ->\n F ! {untrust, Peer, self()},\n receive {fed_reply, R} -> R end.\n\n trusted(F, Peer) ->\n F ! {trusted, Peer, self()},\n receive {fed_reply, R} -> R end.\n\n map(F, Peer, Remote, Local) ->\n F ! {map, Peer, Remote, Local, self()},\n receive {fed_reply, R} -> R end.\n\n resolve(F, Peer, Remote) ->\n F ! {resolve, Peer, Remote, self()},\n receive {fed_reply, R} -> R end.\n\n assert_id(F, Peer, Remote) ->\n F ! {assert_id, Peer, Remote, self()},\n receive {fed_reply, R} -> R end.\n\n provenance(F, Local) ->\n F ! {provenance, Local, self()},\n receive {fed_reply, R} -> R end.\n\n loop(Trusted, Maps, Asserted) ->\n receive\n {trust, Peer, From} ->\n From ! {fed_reply, ok},\n loop(add_unique(Peer, Trusted), Maps, Asserted);\n {untrust, Peer, From} ->\n From ! {fed_reply, ok},\n loop(drop(Peer, Trusted), Maps, Asserted);\n {trusted, Peer, From} ->\n From ! {fed_reply, member(Peer, Trusted)},\n loop(Trusted, Maps, Asserted);\n {map, Peer, Remote, Local, From} ->\n From ! {fed_reply, ok},\n loop(Trusted, [{{Peer, Remote}, Local} | drop_map(Peer, Remote, Maps)], Asserted);\n {resolve, Peer, Remote, From} ->\n From ! {fed_reply, {ok, resolve_local(Peer, Remote, Maps)}},\n loop(Trusted, Maps, Asserted);\n {assert_id, Peer, Remote, From} ->\n case member(Peer, Trusted) of\n false ->\n From ! {fed_reply, {error, untrusted}},\n loop(Trusted, Maps, Asserted);\n true ->\n Local = resolve_local(Peer, Remote, Maps),\n From ! {fed_reply, {ok, Local}},\n loop(Trusted, Maps, [{Local, Peer} | drop_assert(Local, Asserted)])\n end;\n {provenance, Local, From} ->\n case find_assert(Local, Asserted) of\n {ok, Peer} -> From ! {fed_reply, {peer_asserted, Peer}};\n none -> From ! {fed_reply, {local}}\n end,\n loop(Trusted, Maps, Asserted);\n {stop, From} ->\n From ! {fed_reply, ok}\n end.\n\n resolve_local(Peer, Remote, Maps) ->\n case find_map(Peer, Remote, Maps) of\n {ok, Local} -> Local;\n none -> {federated, Peer, Remote}\n end.\n\n find_map(_, _, []) -> none;\n find_map(Peer, Remote, [{{P, R}, Local} | Rest]) ->\n case same(P, Peer, R, Remote) of\n true -> {ok, Local};\n false -> find_map(Peer, Remote, Rest)\n end.\n\n drop_map(_, _, []) -> [];\n drop_map(Peer, Remote, [{{P, R}, Local} | Rest]) ->\n case same(P, Peer, R, Remote) of\n true -> drop_map(Peer, Remote, Rest);\n false -> [{{P, R}, Local} | drop_map(Peer, Remote, Rest)]\n end.\n\n same(P, Peer, R, Remote) ->\n case P =:= Peer of\n true -> R =:= Remote;\n false -> false\n end.\n\n find_assert(_, []) -> none;\n find_assert(Local, [{L, Peer} | Rest]) ->\n case L =:= Local of\n true -> {ok, Peer};\n false -> find_assert(Local, Rest)\n end.\n\n drop_assert(_, []) -> [];\n drop_assert(Local, [{L, Peer} | Rest]) ->\n case L =:= Local of\n true -> drop_assert(Local, Rest);\n false -> [{L, Peer} | drop_assert(Local, Rest)]\n end.\n\n add_unique(X, Xs) ->\n case member(X, Xs) of\n true -> Xs;\n false -> [X | Xs]\n end.\n\n drop(_, []) -> [];\n drop(X, [Y | Rest]) ->\n case X =:= Y of\n true -> drop(X, Rest);\n false -> [Y | drop(X, Rest)]\n end.\n\n member(_, []) -> false;\n member(X, [Y | Rest]) ->\n case X =:= Y of\n true -> true;\n false -> member(X, Rest)\n end.")
(define
identity-load-federation!
(fn () (erlang-load-module identity-federation-source)))

View File

@@ -0,0 +1,31 @@
;; identity/membership.sx — coop membership state + per-app projection.
;;
;; Membership is canonical subject state held by one process, a guarded
;; state machine (invalid transitions are explicit errors, never silent
;; no-ops):
;;
;; none --request--> pending --approve--> active
;; active --lapse--> lapsed --reinstate--> active
;; {pending|active|lapsed} --revoke--> revoked (terminal)
;;
;; A per-app GRANT PROJECTION renders that one canonical state into the
;; view a given client app consumes — mirroring rose-ash's per-app grant
;; verification. The projection is pure identity: it reports WHAT the
;; subject's membership is for that app; it does NOT decide whether the
;; app should let them in. That permission question is acl's, keyed off
;; this projection.
;;
;; project(Subject, App) ->
;; active -> {member, Tier, App}
;; pending -> {pending, App}
;; lapsed -> {lapsed, App}
;; revoked -> {denied, App}
;; none -> {non_member, App}
(define
identity-membership-source
"-module(identity_membership).\n\n start() ->\n spawn(fun () -> loop([]) end).\n\n request(M, Subject, Tier) ->\n M ! {request, Subject, Tier, self()},\n receive {membership_reply, R} -> R end.\n\n approve(M, Subject) ->\n M ! {approve, Subject, self()},\n receive {membership_reply, R} -> R end.\n\n lapse(M, Subject) ->\n M ! {lapse, Subject, self()},\n receive {membership_reply, R} -> R end.\n\n reinstate(M, Subject) ->\n M ! {reinstate, Subject, self()},\n receive {membership_reply, R} -> R end.\n\n revoke(M, Subject) ->\n M ! {revoke, Subject, self()},\n receive {membership_reply, R} -> R end.\n\n status(M, Subject) ->\n M ! {status, Subject, self()},\n receive {membership_reply, R} -> R end.\n\n project(M, Subject, App) ->\n M ! {project, Subject, App, self()},\n receive {membership_reply, R} -> R end.\n\n loop(Members) ->\n receive\n {request, Subject, Tier, From} ->\n case find(Subject, Members) of\n none ->\n From ! {membership_reply, ok},\n loop([{Subject, {pending, Tier}} | Members]);\n {ok, _} ->\n From ! {membership_reply, {error, exists}},\n loop(Members)\n end;\n {approve, Subject, From} ->\n case find(Subject, Members) of\n none ->\n From ! {membership_reply, {error, not_found}},\n loop(Members);\n {ok, {pending, Tier}} ->\n From ! {membership_reply, ok},\n loop(set_record(Subject, {active, Tier}, Members));\n {ok, {St, _}} ->\n From ! {membership_reply, {error, St}},\n loop(Members)\n end;\n {lapse, Subject, From} ->\n case find(Subject, Members) of\n none ->\n From ! {membership_reply, {error, not_found}},\n loop(Members);\n {ok, {active, Tier}} ->\n From ! {membership_reply, ok},\n loop(set_record(Subject, {lapsed, Tier}, Members));\n {ok, {St, _}} ->\n From ! {membership_reply, {error, St}},\n loop(Members)\n end;\n {reinstate, Subject, From} ->\n case find(Subject, Members) of\n none ->\n From ! {membership_reply, {error, not_found}},\n loop(Members);\n {ok, {lapsed, Tier}} ->\n From ! {membership_reply, ok},\n loop(set_record(Subject, {active, Tier}, Members));\n {ok, {St, _}} ->\n From ! {membership_reply, {error, St}},\n loop(Members)\n end;\n {revoke, Subject, From} ->\n case find(Subject, Members) of\n none ->\n From ! {membership_reply, {error, not_found}},\n loop(Members);\n {ok, {_, Tier}} ->\n From ! {membership_reply, ok},\n loop(set_record(Subject, {revoked, Tier}, Members))\n end;\n {status, Subject, From} ->\n case find(Subject, Members) of\n none -> From ! {membership_reply, {none}};\n {ok, {St, Tier}} -> From ! {membership_reply, {ok, St, Tier}}\n end,\n loop(Members);\n {project, Subject, App, From} ->\n From ! {membership_reply, project_view(Subject, App, Members)},\n loop(Members);\n {stop, From} ->\n From ! {membership_reply, ok}\n end.\n\n project_view(Subject, App, Members) ->\n case find(Subject, Members) of\n none -> {non_member, App};\n {ok, {active, Tier}} -> {member, Tier, App};\n {ok, {pending, _}} -> {pending, App};\n {ok, {lapsed, _}} -> {lapsed, App};\n {ok, {revoked, _}} -> {denied, App}\n end.\n\n set_record(_, _, []) -> [];\n set_record(Subject, Rec, [{S, Old} | Rest]) ->\n case S =:= Subject of\n true -> [{S, Rec} | Rest];\n false -> [{S, Old} | set_record(Subject, Rec, Rest)]\n end.\n\n find(_, []) -> none;\n find(Key, [{K, V} | Rest]) ->\n case K =:= Key of\n true -> {ok, V};\n false -> find(Key, Rest)\n end.")
(define
identity-load-membership!
(fn () (erlang-load-module identity-membership-source)))

37
lib/identity/oauth.sx Normal file

File diff suppressed because one or more lines are too long

22
lib/identity/registry.sx Normal file
View File

@@ -0,0 +1,22 @@
;; identity/registry.sx — routes sessions by id and by (subject, client).
;;
;; The registry is the directory that makes SSO possible: one subject can
;; hold many sessions (one per client), and the OAuth machine asks it the
;; single question that drives silent login — \"is there a live session
;; for this subject + this client?\". It stores (SessionId, Subject,
;; Client, Pid) rows and answers:
;;
;; whereis_session(Id) -> {ok, Pid} | {error, not_found}
;; lookup(Subject, Client) -> {ok, Pid} | {error, not_found} (SSO probe)
;; sessions_for(Subject) -> {ok, [SessionId, ...]} (fan-out)
;;
;; The registry only routes — it holds no grant state and decides nothing.
;; Liveness of the routed-to session is that session process's own affair.
(define
identity-registry-source
"-module(identity_registry).\n\n start() ->\n spawn(fun () -> loop([]) end).\n\n register(Reg, SessionId, Subject, Client, Pid) ->\n Reg ! {register, SessionId, Subject, Client, Pid, self()},\n receive {registry_reply, R} -> R end.\n\n whereis_session(Reg, SessionId) ->\n Reg ! {whereis_session, SessionId, self()},\n receive {registry_reply, R} -> R end.\n\n lookup(Reg, Subject, Client) ->\n Reg ! {lookup, Subject, Client, self()},\n receive {registry_reply, R} -> R end.\n\n sessions_for(Reg, Subject) ->\n Reg ! {sessions_for, Subject, self()},\n receive {registry_reply, R} -> R end.\n\n deregister(Reg, SessionId) ->\n Reg ! {deregister, SessionId, self()},\n receive {registry_reply, R} -> R end.\n\n stop(Reg) ->\n Reg ! {stop, self()},\n receive {registry_reply, R} -> R end.\n\n loop(Entries) ->\n receive\n {register, SessionId, Subject, Client, Pid, From} ->\n From ! {registry_reply, ok},\n loop([{SessionId, Subject, Client, Pid} | remove_id(SessionId, Entries)]);\n {whereis_session, SessionId, From} ->\n From ! {registry_reply, find_id(SessionId, Entries)},\n loop(Entries);\n {lookup, Subject, Client, From} ->\n From ! {registry_reply, find_sc(Subject, Client, Entries)},\n loop(Entries);\n {sessions_for, Subject, From} ->\n From ! {registry_reply, {ok, collect_subject(Subject, Entries)}},\n loop(Entries);\n {deregister, SessionId, From} ->\n From ! {registry_reply, ok},\n loop(remove_id(SessionId, Entries));\n {stop, From} ->\n From ! {registry_reply, ok}\n end.\n\n find_id(_, []) -> {error, not_found};\n find_id(Id, [{Sid, _, _, Pid} | Rest]) ->\n case Sid =:= Id of\n true -> {ok, Pid};\n false -> find_id(Id, Rest)\n end.\n\n find_sc(_, _, []) -> {error, not_found};\n find_sc(Subject, Client, [{_, Su, Cl, Pid} | Rest]) ->\n case Su =:= Subject of\n true ->\n case Cl =:= Client of\n true -> {ok, Pid};\n false -> find_sc(Subject, Client, Rest)\n end;\n false -> find_sc(Subject, Client, Rest)\n end.\n\n collect_subject(_, []) -> [];\n collect_subject(Subject, [{Sid, Su, _, _} | Rest]) ->\n case Su =:= Subject of\n true -> [Sid | collect_subject(Subject, Rest)];\n false -> collect_subject(Subject, Rest)\n end.\n\n remove_id(_, []) -> [];\n remove_id(Id, [{Sid, Su, Cl, Pid} | Rest]) ->\n case Sid =:= Id of\n true -> remove_id(Id, Rest);\n false -> [{Sid, Su, Cl, Pid} | remove_id(Id, Rest)]\n end.")
(define
identity-load-registry!
(fn () (erlang-load-module identity-registry-source)))

View File

@@ -0,0 +1,28 @@
{
"language": "identity",
"total_pass": 222,
"total": 222,
"suites": [
{"name":"session","pass":11,"total":11,"status":"ok"},
{"name":"token","pass":24,"total":24,"status":"ok"},
{"name":"registry","pass":9,"total":9,"status":"ok"},
{"name":"api","pass":10,"total":10,"status":"ok"},
{"name":"oauth","pass":17,"total":17,"status":"ok"},
{"name":"sso","pass":10,"total":10,"status":"ok"},
{"name":"membership","pass":17,"total":17,"status":"ok"},
{"name":"cache","pass":9,"total":9,"status":"ok"},
{"name":"audit","pass":11,"total":11,"status":"ok"},
{"name":"federation","pass":12,"total":12,"status":"ok"},
{"name":"expiry","pass":8,"total":8,"status":"ok"},
{"name":"clients","pass":11,"total":11,"status":"ok"},
{"name":"grants","pass":9,"total":9,"status":"ok"},
{"name":"device","pass":10,"total":10,"status":"ok"},
{"name":"facade","pass":9,"total":9,"status":"ok"},
{"name":"delegation","pass":8,"total":8,"status":"ok"},
{"name":"session-mgmt","pass":8,"total":8,"status":"ok"},
{"name":"exchange","pass":8,"total":8,"status":"ok"},
{"name":"introspect","pass":9,"total":9,"status":"ok"},
{"name":"par","pass":7,"total":7,"status":"ok"},
{"name":"dynreg","pass":5,"total":5,"status":"ok"}
]
}

View File

@@ -0,0 +1,30 @@
# identity-on-sx Scoreboard
**Total: 222 / 222 tests passing**
| | Suite | Pass | Total |
|---|---|---|---|
| ✅ | session | 11 | 11 |
| ✅ | token | 24 | 24 |
| ✅ | registry | 9 | 9 |
| ✅ | api | 10 | 10 |
| ✅ | oauth | 17 | 17 |
| ✅ | sso | 10 | 10 |
| ✅ | membership | 17 | 17 |
| ✅ | cache | 9 | 9 |
| ✅ | audit | 11 | 11 |
| ✅ | federation | 12 | 12 |
| ✅ | expiry | 8 | 8 |
| ✅ | clients | 11 | 11 |
| ✅ | grants | 9 | 9 |
| ✅ | device | 10 | 10 |
| ✅ | facade | 9 | 9 |
| ✅ | delegation | 8 | 8 |
| ✅ | session-mgmt | 8 | 8 |
| ✅ | exchange | 8 | 8 |
| ✅ | introspect | 9 | 9 |
| ✅ | par | 7 | 7 |
| ✅ | dynreg | 5 | 5 |
Generated by `lib/identity/conformance.sh`.

20
lib/identity/session.sx Normal file
View File

@@ -0,0 +1,20 @@
;; identity/session.sx — a session is an Erlang process.
;;
;; create = spawn a session process holding {subject, client, status}
;; lookup = a message; the live process answers {ok, ...} or {error, S}
;; expire = explicit message OR an idle timeout the process arms itself
;; revoke = explicit message; the grant tombstones immediately
;;
;; Expiry is the process's own `receive ... after Ttl` timeout, never a
;; global sweep. On timeout the process notifies its Owner and becomes a
;; tombstone that still answers lookups — with {error, expired}, never a
;; silent dead mailbox. A revoked or expired session is an explicit
;; negative state, not the absence of a positive one.
(define
identity-session-source
"-module(identity_session).\n\n start(SessionId, Subject, Client, Owner, Ttl) ->\n spawn(fun () -> active(SessionId, Subject, Client, Owner, Ttl) end).\n\n lookup(Pid) ->\n Pid ! {lookup, self()},\n receive {session_reply, R} -> R end.\n\n touch(Pid) ->\n Pid ! {touch, self()},\n receive {session_reply, R} -> R end.\n\n expire(Pid) ->\n Pid ! {expire, self()},\n receive {session_reply, R} -> R end.\n\n revoke(Pid) ->\n Pid ! {revoke, self()},\n receive {session_reply, R} -> R end.\n\n stop(Pid) ->\n Pid ! {stop, self()},\n receive {session_reply, R} -> R end.\n\n active(SessionId, Subject, Client, Owner, Ttl) ->\n receive\n {lookup, From} ->\n From ! {session_reply, {ok, {SessionId, Subject, Client, active}}},\n active(SessionId, Subject, Client, Owner, Ttl);\n {touch, From} ->\n From ! {session_reply, ok},\n active(SessionId, Subject, Client, Owner, Ttl);\n {expire, From} ->\n From ! {session_reply, ok},\n tombstone(SessionId, Subject, Client, expired);\n {revoke, From} ->\n From ! {session_reply, ok},\n tombstone(SessionId, Subject, Client, revoked);\n {stop, From} ->\n From ! {session_reply, ok}\n after Ttl ->\n Owner ! {session_expired, SessionId},\n tombstone(SessionId, Subject, Client, expired)\n end.\n\n tombstone(SessionId, Subject, Client, Status) ->\n receive\n {lookup, From} ->\n From ! {session_reply, {error, Status}},\n tombstone(SessionId, Subject, Client, Status);\n {touch, From} ->\n From ! {session_reply, {error, Status}},\n tombstone(SessionId, Subject, Client, Status);\n {expire, From} ->\n From ! {session_reply, ok},\n tombstone(SessionId, Subject, Client, Status);\n {revoke, From} ->\n From ! {session_reply, ok},\n tombstone(SessionId, Subject, Client, revoked);\n {stop, From} ->\n From ! {session_reply, ok}\n end.")
(define
identity-load-session!
(fn () (erlang-load-module identity-session-source)))

111
lib/identity/tests/api.sx Normal file
View File

@@ -0,0 +1,111 @@
;; identity/tests/api.sx — the service facade end-to-end: login issues a
;; session + token, verify proves identity, revoke and logout take effect
;; immediately. Exercises session + token + registry through one door.
(define id-api-test-count 0)
(define id-api-test-pass 0)
(define id-api-test-fails (list))
(define
id-api-test
(fn
(name actual expected)
(set! id-api-test-count (+ id-api-test-count 1))
(if
(= actual expected)
(set! id-api-test-pass (+ id-api-test-pass 1))
(append! id-api-test-fails {:name name :expected expected :actual actual}))))
(define ida-ev erlang-eval-ast)
(define idanm (fn (v) (get v :name)))
(identity-load-all!)
;; ── login + verify (happy path) ──────────────────────────────────
(id-api-test
"login then verify is active"
(idanm
(ida-ev
"Svc = identity:start(),\n {ok, _Sid, Tok} = identity:login(Svc, alice, web, read),\n case identity:verify(Svc, Tok) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"active")
(id-api-test
"verify returns the logged-in subject"
(idanm
(ida-ev
"Svc = identity:start(),\n {ok, _Sid, Tok} = identity:login(Svc, alice, web, read),\n case identity:verify(Svc, Tok) of\n {active, Subject, _, _} -> Subject\n end"))
"alice")
(id-api-test
"verify returns the granted scope"
(idanm
(ida-ev
"Svc = identity:start(),\n {ok, _Sid, Tok} = identity:login(Svc, bob, cli, write),\n case identity:verify(Svc, Tok) of\n {active, _, _, Scope} -> Scope\n end"))
"write")
;; ── revoke is real through the facade ────────────────────────────
(id-api-test
"revoked token verifies inactive immediately"
(idanm
(ida-ev
"Svc = identity:start(),\n {ok, _Sid, Tok} = identity:login(Svc, alice, web, read),\n identity:revoke(Svc, Tok),\n case identity:verify(Svc, Tok) of\n {active, _, _, _} -> still_valid;\n {inactive} -> inactive\n end"))
"inactive")
;; ── session lifecycle through the facade ─────────────────────────
(id-api-test
"fresh session reports active"
(idanm
(ida-ev
"Svc = identity:start(),\n {ok, Sid, _Tok} = identity:login(Svc, alice, web, read),\n identity:session_status(Svc, Sid)"))
"active")
(id-api-test
"logout makes the session gone"
(idanm
(ida-ev
"Svc = identity:start(),\n {ok, Sid, _Tok} = identity:login(Svc, alice, web, read),\n identity:logout(Svc, Sid),\n identity:session_status(Svc, Sid)"))
"gone")
(id-api-test
"status of an unknown session is gone"
(idanm
(ida-ev "Svc = identity:start(),\n identity:session_status(Svc, 999)"))
"gone")
;; ── independence: logins do not bleed into each other ────────────
(id-api-test
"revoking one login leaves the other active"
(idanm
(ida-ev
"Svc = identity:start(),\n {ok, _S1, T1} = identity:login(Svc, alice, web, read),\n {ok, _S2, T2} = identity:login(Svc, bob, cli, write),\n identity:revoke(Svc, T1),\n case identity:verify(Svc, T2) of\n {active, Subject, _, _} -> Subject;\n {inactive} -> inactive\n end"))
"bob")
(id-api-test
"logging out one session leaves the other active"
(idanm
(ida-ev
"Svc = identity:start(),\n {ok, S1, _T1} = identity:login(Svc, alice, web, read),\n {ok, S2, _T2} = identity:login(Svc, alice, cli, read),\n identity:logout(Svc, S1),\n identity:session_status(Svc, S2)"))
"active")
;; ── coordinator deregisters on a session_expired notification ────
;; A live idle session fires its own `after` timeout and notifies its
;; owner (the coordinator), which then deregisters it — timeout-driven,
;; never swept. The owner-internal path can't be observed by driving the
;; scheduler idle from the test's main process, so we assert the handler
;; directly: the mailbox is FIFO, so the expiry notification is processed
;; before the following status query.
(id-api-test
"session_expired notification deregisters the session"
(idanm
(ida-ev
"Svc = identity:start(),\n {ok, Sid, _Tok} = identity:login(Svc, alice, web, read, 50),\n active = identity:session_status(Svc, Sid),\n Svc ! {session_expired, Sid},\n identity:session_status(Svc, Sid)"))
"gone")
(define
id-api-test-summary
(str "api " id-api-test-pass "/" id-api-test-count))

117
lib/identity/tests/audit.sx Normal file
View File

@@ -0,0 +1,117 @@
;; 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))

102
lib/identity/tests/cache.sx Normal file
View File

@@ -0,0 +1,102 @@
;; identity/tests/cache.sx — delegated grant-verification cache. Proves
;; the cache is live (hits/misses) AND that revocation stays real: a
;; revoked token never reads valid out of the cache, because any revoke
;; bumps the generation and forces re-validation.
(define id-cache-test-count 0)
(define id-cache-test-pass 0)
(define id-cache-test-fails (list))
(define
id-cache-test
(fn
(name actual expected)
(set! id-cache-test-count (+ id-cache-test-count 1))
(if
(= actual expected)
(set! id-cache-test-pass (+ id-cache-test-pass 1))
(append! id-cache-test-fails {:name name :expected expected :actual actual}))))
(define idc-ev erlang-eval-ast)
(define idcnm (fn (v) (get v :name)))
(identity-load-token!)
(identity-load-cache!)
;; ── delegation: cache forwards to the registry ───────────────────
(id-cache-test
"introspect through the cache returns active"
(idcnm
(idc-ev
"C = identity_grant_cache:start(),\n {ok, T} = identity_grant_cache:issue(C, alice, web, read),\n case identity_grant_cache:introspect(C, T) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"active")
;; ── the cache is actually caching ────────────────────────────────
(id-cache-test
"a repeated introspect is a cache hit"
(idc-ev
"C = identity_grant_cache:start(),\n {ok, T} = identity_grant_cache:issue(C, alice, web, read),\n identity_grant_cache:introspect(C, T),\n identity_grant_cache:introspect(C, T),\n case identity_grant_cache:stats(C) of {H, _} -> H end")
1)
(id-cache-test
"the first introspect of a token is a miss"
(idc-ev
"C = identity_grant_cache:start(),\n {ok, T} = identity_grant_cache:issue(C, alice, web, read),\n identity_grant_cache:introspect(C, T),\n identity_grant_cache:introspect(C, T),\n case identity_grant_cache:stats(C) of {_, M} -> M end")
1)
;; ── revocation stays real through the cache (the centrepiece) ─────
(id-cache-test
"a revoked token introspects inactive through the cache"
(idcnm
(idc-ev
"C = identity_grant_cache:start(),\n {ok, T} = identity_grant_cache:issue(C, alice, web, read),\n identity_grant_cache:introspect(C, T),\n identity_grant_cache:revoke(C, T),\n case identity_grant_cache:introspect(C, T) of\n {active, _, _, _} -> still_valid;\n {inactive} -> inactive\n end"))
"inactive")
(id-cache-test
"revoke invalidates the cache (post-revoke read re-validates)"
(idc-ev
"C = identity_grant_cache:start(),\n {ok, T} = identity_grant_cache:issue(C, alice, web, read),\n identity_grant_cache:introspect(C, T),\n identity_grant_cache:revoke(C, T),\n identity_grant_cache:introspect(C, T),\n case identity_grant_cache:stats(C) of {_, M} -> M end")
2)
;; ── cascade visibility through the cache ──────────────────────────
(id-cache-test
"cascade revocation is visible through the cache"
(idcnm
(idc-ev
"C = identity_grant_cache:start(),\n {ok, A, R} = identity_grant_cache:issue_grant(C, alice, web, read),\n identity_grant_cache:introspect(C, A),\n identity_grant_cache:revoke(C, R),\n case identity_grant_cache:introspect(C, A) of\n {active, _, _, _} -> still_valid;\n {inactive} -> inactive\n end"))
"inactive")
;; ── a sibling token re-validates correctly after a revoke ────────
(id-cache-test
"revoking one token leaves an independent token valid"
(idcnm
(idc-ev
"C = identity_grant_cache:start(),\n {ok, A} = identity_grant_cache:issue(C, alice, web, read),\n {ok, B} = identity_grant_cache:issue(C, bob, cli, write),\n identity_grant_cache:introspect(C, A),\n identity_grant_cache:introspect(C, B),\n identity_grant_cache:revoke(C, A),\n case identity_grant_cache:introspect(C, B) of\n {active, Subject, _, _} -> Subject;\n {inactive} -> inactive\n end"))
"bob")
;; ── refresh flows through the cache and stays correct ────────────
(id-cache-test
"a refreshed token introspects active through the cache"
(idcnm
(idc-ev
"C = identity_grant_cache:start(),\n {ok, _A, R} = identity_grant_cache:issue_grant(C, alice, web, read),\n {ok, A2, _R2} = identity_grant_cache:refresh(C, R),\n case identity_grant_cache:introspect(C, A2) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"active")
;; ── unknown token is inactive, and cached as such ────────────────
(id-cache-test
"an unknown token introspects inactive through the cache"
(idcnm
(idc-ev
"C = identity_grant_cache:start(),\n Bogus = make_ref(),\n case identity_grant_cache:introspect(C, Bogus) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"inactive")
(define
id-cache-test-summary
(str "cache " id-cache-test-pass "/" id-cache-test-count))

View File

@@ -0,0 +1,108 @@
;; identity/tests/clients.sx — OAuth client registry: registration,
;; public vs confidential authentication, and redirect_uri allow-listing.
(define id-clients-test-count 0)
(define id-clients-test-pass 0)
(define id-clients-test-fails (list))
(define
id-clients-test
(fn
(name actual expected)
(set! id-clients-test-count (+ id-clients-test-count 1))
(if
(= actual expected)
(set! id-clients-test-pass (+ id-clients-test-pass 1))
(append! id-clients-test-fails {:name name :expected expected :actual actual}))))
(define idc-ev erlang-eval-ast)
(define idcnm (fn (v) (get v :name)))
(identity-load-clients!)
;; ── registration + lookup ────────────────────────────────────────
(id-clients-test
"a registered client looks up its type"
(idcnm
(idc-ev
"C = identity_clients:start(),\n identity_clients:register(C, app1, confidential, s3cret, [uri1]),\n case identity_clients:lookup(C, app1) of\n {ok, Type, _} -> Type;\n {error, W} -> W\n end"))
"confidential")
(id-clients-test
"registering the same client twice is an error"
(idcnm
(idc-ev
"C = identity_clients:start(),\n identity_clients:register(C, app1, confidential, s3cret, [uri1]),\n case identity_clients:register(C, app1, public, none, [uri1]) of\n ok -> ok;\n {error, W} -> W\n end"))
"exists")
(id-clients-test
"looking up an unregistered client is unknown_client"
(idcnm
(idc-ev
"C = identity_clients:start(),\n case identity_clients:lookup(C, ghost) of\n {ok, _, _} -> found;\n {error, W} -> W\n end"))
"unknown_client")
;; ── confidential client authentication ───────────────────────────
(id-clients-test
"a confidential client authenticates with the right secret"
(idcnm
(idc-ev
"C = identity_clients:start(),\n identity_clients:register(C, app1, confidential, s3cret, [uri1]),\n case identity_clients:authenticate(C, app1, s3cret) of\n {ok, Kind} -> Kind;\n {error, W} -> W\n end"))
"confidential")
(id-clients-test
"a confidential client with the wrong secret is invalid_client"
(idcnm
(idc-ev
"C = identity_clients:start(),\n identity_clients:register(C, app1, confidential, s3cret, [uri1]),\n case identity_clients:authenticate(C, app1, wrongsecret) of\n {ok, _} -> accepted;\n {error, W} -> W\n end"))
"invalid_client")
(id-clients-test
"a public client needs no secret to authenticate"
(idcnm
(idc-ev
"C = identity_clients:start(),\n identity_clients:register(C, spa, public, none, [uri1]),\n case identity_clients:authenticate(C, spa, anything) of\n {ok, Kind} -> Kind;\n {error, W} -> W\n end"))
"public")
(id-clients-test
"authenticating an unknown client is unknown_client"
(idcnm
(idc-ev
"C = identity_clients:start(),\n case identity_clients:authenticate(C, ghost, x) of\n {ok, _} -> accepted;\n {error, W} -> W\n end"))
"unknown_client")
;; ── redirect_uri allow-listing ───────────────────────────────────
(id-clients-test
"a registered redirect_uri is valid"
(idcnm
(idc-ev
"C = identity_clients:start(),\n identity_clients:register(C, app1, confidential, s3cret, [uri1, uri2]),\n case identity_clients:valid_redirect(C, app1, uri1) of\n true -> yes;\n false -> no\n end"))
"yes")
(id-clients-test
"a second registered redirect_uri is also valid"
(idcnm
(idc-ev
"C = identity_clients:start(),\n identity_clients:register(C, app1, confidential, s3cret, [uri1, uri2]),\n case identity_clients:valid_redirect(C, app1, uri2) of\n true -> yes;\n false -> no\n end"))
"yes")
(id-clients-test
"an unregistered redirect_uri is rejected"
(idcnm
(idc-ev
"C = identity_clients:start(),\n identity_clients:register(C, app1, confidential, s3cret, [uri1]),\n case identity_clients:valid_redirect(C, app1, evil_uri) of\n true -> yes;\n false -> no\n end"))
"no")
(id-clients-test
"redirect validation for an unknown client is rejected"
(idcnm
(idc-ev
"C = identity_clients:start(),\n case identity_clients:valid_redirect(C, ghost, uri1) of\n true -> yes;\n false -> no\n end"))
"no")
(define
id-clients-test-summary
(str "clients " id-clients-test-pass "/" id-clients-test-count))

View File

@@ -0,0 +1,102 @@
;; identity/tests/delegation.sx — the identity -> acl boundary.
;; Authentication (identity) gates BEFORE authorization (acl): an inactive
;; token is unauthenticated (401) and acl is never consulted; only an
;; authenticated subject's request is delegated to acl for permit/deny.
(define id-deleg-test-count 0)
(define id-deleg-test-pass 0)
(define id-deleg-test-fails (list))
(define
id-deleg-test
(fn
(name actual expected)
(set! id-deleg-test-count (+ id-deleg-test-count 1))
(if
(= actual expected)
(set! id-deleg-test-pass (+ id-deleg-test-pass 1))
(append! id-deleg-test-fails {:name name :expected expected :actual actual}))))
(define idl-ev erlang-eval-ast)
(define idlnm (fn (v) (get v :name)))
(identity-load-delegation!)
;; Shared prelude: a token registry, a stub acl, and a token granting
;; [read, write] to alice, all bound.
(define
idl-setup
"R = identity_tokens:start(),\n A = identity_delegation:stub_acl(),\n {ok, T} = identity_tokens:issue(R, alice, web, [read, write])")
;; ── authenticated + acl permits ──────────────────────────────────
(id-deleg-test
"an authenticated, permitted request returns the subject"
(idlnm
(idl-ev
(str
idl-setup
", case identity_delegation:check(R, A, T, read, doc1) of\n {ok, S} -> S;\n {error, W} -> W\n end")))
"alice")
;; ── authenticated + acl denies → 403 ─────────────────────────────
(id-deleg-test
"an authenticated but unpermitted request is forbidden"
(idlnm
(idl-ev
"R = identity_tokens:start(),\n A = identity_delegation:stub_acl(),\n {ok, T} = identity_tokens:issue(R, alice, web, [read]),\n case identity_delegation:check(R, A, T, write, doc1) of\n {ok, _} -> permitted;\n {error, W} -> W\n end"))
"forbidden")
;; ── unauthenticated → 401, acl never consulted ───────────────────
(id-deleg-test
"a revoked token is unauthenticated, not forbidden"
(idlnm
(idl-ev
(str
idl-setup
", identity_tokens:revoke(R, T),\n case identity_delegation:check(R, A, T, read, doc1) of\n {ok, _} -> permitted;\n {error, W} -> W\n end")))
"unauthenticated")
(id-deleg-test
"an unknown token is unauthenticated"
(idlnm
(idl-ev
"R = identity_tokens:start(),\n A = identity_delegation:stub_acl(),\n Bogus = make_ref(),\n case identity_delegation:check(R, A, Bogus, read, doc1) of\n {ok, _} -> permitted;\n {error, W} -> W\n end"))
"unauthenticated")
(id-deleg-test
"an expired token is unauthenticated"
(idlnm
(idl-ev
"R = identity_tokens:start(),\n A = identity_delegation:stub_acl(),\n {ok, T} = identity_tokens:issue(R, alice, web, [read], 100),\n identity_tokens:advance(R, 100),\n case identity_delegation:check(R, A, T, read, doc1) of\n {ok, _} -> permitted;\n {error, W} -> W\n end"))
"unauthenticated")
;; ── 401 takes precedence over 403 (identity gates first) ─────────
(id-deleg-test
"a revoked token with no matching scope is still unauthenticated"
(idlnm
(idl-ev
"R = identity_tokens:start(),\n A = identity_delegation:stub_acl(),\n {ok, T} = identity_tokens:issue(R, alice, web, [admin]),\n identity_tokens:revoke(R, T),\n case identity_delegation:check(R, A, T, read, doc1) of\n {ok, _} -> permitted;\n {error, W} -> W\n end"))
"unauthenticated")
;; ── acl is what decides for an authenticated subject ─────────────
(id-deleg-test
"the same subject is permitted one action and denied another"
(idl-ev
"R = identity_tokens:start(),\n A = identity_delegation:stub_acl(),\n {ok, T} = identity_tokens:issue(R, alice, web, [read]),\n Allowed = case identity_delegation:check(R, A, T, read, doc1) of\n {ok, _} -> 1; {error, _} -> 0 end,\n Denied = case identity_delegation:check(R, A, T, write, doc1) of\n {ok, _} -> 1; {error, _} -> 0 end,\n Allowed - Denied")
1)
(id-deleg-test
"identity does not widen permission beyond the token scope"
(idlnm
(idl-ev
"R = identity_tokens:start(),\n A = identity_delegation:stub_acl(),\n {ok, T} = identity_tokens:issue(R, alice, web, [read, write]),\n case identity_delegation:check(R, A, T, delete, doc1) of\n {ok, _} -> permitted;\n {error, W} -> W\n end"))
"forbidden")
(define
id-deleg-test-summary
(str "delegation " id-deleg-test-pass "/" id-deleg-test-count))

View File

@@ -0,0 +1,109 @@
;; identity/tests/device.sx — device authorization grant (RFC 8628):
;; authorize → poll(pending) → approve/deny out-of-band → poll(token/denied).
(define id-device-test-count 0)
(define id-device-test-pass 0)
(define id-device-test-fails (list))
(define
id-device-test
(fn
(name actual expected)
(set! id-device-test-count (+ id-device-test-count 1))
(if
(= actual expected)
(set! id-device-test-pass (+ id-device-test-pass 1))
(append! id-device-test-fails {:name name :expected expected :actual actual}))))
(define idd-ev erlang-eval-ast)
(define iddnm (fn (v) (get v :name)))
(identity-load-device!)
;; ── polling before approval ──────────────────────────────────────
(id-device-test
"polling a pending device code is authorization_pending"
(iddnm
(idd-ev
"D = identity_device:start(),\n {ok, Dc, _Uc} = identity_device:authorize(D, tv, watch),\n case identity_device:poll(D, Dc) of\n {ok, _} -> got;\n {error, W} -> W\n end"))
"authorization_pending")
;; ── approve → token ──────────────────────────────────────────────
(id-device-test
"after approval, polling yields a working token"
(iddnm
(idd-ev
"D = identity_device:start(),\n {ok, Dc, Uc} = identity_device:authorize(D, tv, watch),\n identity_device:approve(D, Uc, alice),\n {ok, T} = identity_device:poll(D, Dc),\n case identity_device:introspect(D, T) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"active")
(id-device-test
"the device token carries the approving subject"
(iddnm
(idd-ev
"D = identity_device:start(),\n {ok, Dc, Uc} = identity_device:authorize(D, tv, watch),\n identity_device:approve(D, Uc, alice),\n {ok, T} = identity_device:poll(D, Dc),\n case identity_device:introspect(D, T) of\n {active, Subject, _, _} -> Subject\n end"))
"alice")
(id-device-test
"the device token carries the requested scope"
(iddnm
(idd-ev
"D = identity_device:start(),\n {ok, Dc, Uc} = identity_device:authorize(D, tv, stream),\n identity_device:approve(D, Uc, alice),\n {ok, T} = identity_device:poll(D, Dc),\n case identity_device:introspect(D, T) of\n {active, _, _, Scope} -> Scope\n end"))
"stream")
;; ── deny ─────────────────────────────────────────────────────────
(id-device-test
"after denial, polling is access_denied"
(iddnm
(idd-ev
"D = identity_device:start(),\n {ok, Dc, Uc} = identity_device:authorize(D, tv, watch),\n identity_device:deny(D, Uc),\n case identity_device:poll(D, Dc) of\n {ok, _} -> got;\n {error, W} -> W\n end"))
"access_denied")
;; ── unknown codes ────────────────────────────────────────────────
(id-device-test
"polling an unknown device code is invalid_grant"
(iddnm
(idd-ev
"D = identity_device:start(),\n Bogus = make_ref(),\n case identity_device:poll(D, Bogus) of\n {ok, _} -> got;\n {error, W} -> W\n end"))
"invalid_grant")
(id-device-test
"approving an unknown user code is unknown_code"
(iddnm
(idd-ev
"D = identity_device:start(),\n Bogus = make_ref(),\n case identity_device:approve(D, Bogus, alice) of\n ok -> ok;\n {error, W} -> W\n end"))
"unknown_code")
;; ── single-use device code ───────────────────────────────────────
(id-device-test
"the device code is single-use after issuing a token"
(iddnm
(idd-ev
"D = identity_device:start(),\n {ok, Dc, Uc} = identity_device:authorize(D, tv, watch),\n identity_device:approve(D, Uc, alice),\n identity_device:poll(D, Dc),\n case identity_device:poll(D, Dc) of\n {ok, _} -> got;\n {error, W} -> W\n end"))
"invalid_grant")
;; ── guarded transitions ──────────────────────────────────────────
(id-device-test
"approving an already-denied request is rejected"
(iddnm
(idd-ev
"D = identity_device:start(),\n {ok, _Dc, Uc} = identity_device:authorize(D, tv, watch),\n identity_device:deny(D, Uc),\n case identity_device:approve(D, Uc, alice) of\n ok -> ok;\n {error, W} -> W\n end"))
"denied")
;; ── independence ─────────────────────────────────────────────────
(id-device-test
"two device requests are independent"
(iddnm
(idd-ev
"D = identity_device:start(),\n {ok, Dc1, Uc1} = identity_device:authorize(D, tv, watch),\n {ok, Dc2, _Uc2} = identity_device:authorize(D, cli, deploy),\n identity_device:approve(D, Uc1, alice),\n case identity_device:poll(D, Dc2) of\n {ok, _} -> got;\n {error, W} -> W\n end"))
"authorization_pending")
(define
id-device-test-summary
(str "device " id-device-test-pass "/" id-device-test-count))

View File

@@ -0,0 +1,68 @@
;; identity/tests/dynreg.sx — dynamic client registration (RFC 7591): the
;; server generates the client_id + secret for self-service onboarding.
(define id-dyn-test-count 0)
(define id-dyn-test-pass 0)
(define id-dyn-test-fails (list))
(define
id-dyn-test
(fn
(name actual expected)
(set! id-dyn-test-count (+ id-dyn-test-count 1))
(if
(= actual expected)
(set! id-dyn-test-pass (+ id-dyn-test-pass 1))
(append! id-dyn-test-fails {:name name :expected expected :actual actual}))))
(define idd-ev erlang-eval-ast)
(define iddnm (fn (v) (get v :name)))
(identity-load-oauth!)
;; ── self-service registration yields usable credentials ──────────
(id-dyn-test
"a dynamically registered confidential client can get a token"
(iddnm
(idd-ev
"O = identity_oauth:start(),\n {ok, Cid, Sec} = identity_oauth:register_dynamic(O, confidential, [uri1]),\n {ok, T} = identity_oauth:client_credentials(O, Cid, Sec, batch),\n case identity_oauth:introspect(O, T) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"active")
(id-dyn-test
"the token's subject is the generated client id"
(iddnm
(idd-ev
"O = identity_oauth:start(),\n {ok, Cid, Sec} = identity_oauth:register_dynamic(O, confidential, [uri1]),\n {ok, T} = identity_oauth:client_credentials(O, Cid, Sec, batch),\n case identity_oauth:introspect(O, T) of\n {active, Sub, _, _} ->\n case Sub =:= Cid of true -> matches; false -> mismatch end;\n {inactive} -> inactive\n end"))
"matches")
;; ── the generated secret is required ─────────────────────────────
(id-dyn-test
"a wrong secret for a dynamic client is invalid_client"
(iddnm
(idd-ev
"O = identity_oauth:start(),\n {ok, Cid, _Sec} = identity_oauth:register_dynamic(O, confidential, [uri1]),\n case identity_oauth:client_credentials(O, Cid, wrongsecret, batch) of\n {ok, _} -> issued;\n {error, W} -> W\n end"))
"invalid_client")
;; ── uniqueness ───────────────────────────────────────────────────
(id-dyn-test
"two registrations yield distinct client ids"
(iddnm
(idd-ev
"O = identity_oauth:start(),\n {ok, C1, _} = identity_oauth:register_dynamic(O, confidential, [uri1]),\n {ok, C2, _} = identity_oauth:register_dynamic(O, confidential, [uri1]),\n case C1 =:= C2 of true -> collision; false -> distinct end"))
"distinct")
;; ── a dynamic public client still cannot use client-credentials ──
(id-dyn-test
"a dynamic public client is unauthorized for client-credentials"
(iddnm
(idd-ev
"O = identity_oauth:start(),\n {ok, Cid, Sec} = identity_oauth:register_dynamic(O, public, [uri1]),\n case identity_oauth:client_credentials(O, Cid, Sec, batch) of\n {ok, _} -> issued;\n {error, W} -> W\n end"))
"unauthorized_client")
(define
id-dyn-test-summary
(str "dynreg " id-dyn-test-pass "/" id-dyn-test-count))

View File

@@ -0,0 +1,110 @@
;; identity/tests/exchange.sx — token exchange (RFC 8693 §2.1): downscope a
;; valid access token into a new independent token for a downstream service.
(define id-xchg-test-count 0)
(define id-xchg-test-pass 0)
(define id-xchg-test-fails (list))
(define
id-xchg-test
(fn
(name actual expected)
(set! id-xchg-test-count (+ id-xchg-test-count 1))
(if
(= actual expected)
(set! id-xchg-test-pass (+ id-xchg-test-pass 1))
(append! id-xchg-test-fails {:name name :expected expected :actual actual}))))
(define idx-ev erlang-eval-ast)
(define idxnm (fn (v) (get v :name)))
(identity-load-oauth!)
;; Shared prelude: an access token A for alice with scope [read, write].
(define
idx-token
"O = identity_oauth:start(),\n {consent_required, Rq} = identity_oauth:authorize(O, web, uri1, [read, write], alice, v),\n {code, Cd} = identity_oauth:consent(O, Rq, allow),\n {ok, A, _R} = identity_oauth:exchange(O, Cd, web, uri1, v)")
;; ── downscoping ──────────────────────────────────────────────────
(id-xchg-test
"exchange downscopes to a subset"
(idxnm
(idx-ev
(str
idx-token
", {ok, X} = identity_oauth:token_exchange(O, A, [read]),\n case identity_oauth:introspect(O, X) of\n {active, _, _, [read]} -> downscoped;\n {active, _, _, _} -> other;\n {inactive} -> inactive\n end")))
"downscoped")
(id-xchg-test
"the exchanged token keeps the subject"
(idxnm
(idx-ev
(str
idx-token
", {ok, X} = identity_oauth:token_exchange(O, A, [read]),\n case identity_oauth:introspect(O, X) of\n {active, Subject, _, _} -> Subject\n end")))
"alice")
(id-xchg-test
"exchange to the same scope is allowed"
(idxnm
(idx-ev
(str
idx-token
", {ok, X} = identity_oauth:token_exchange(O, A, [read, write]),\n case identity_oauth:introspect(O, X) of\n {active, _, _, [read, write]} -> full;\n {active, _, _, _} -> other;\n {inactive} -> inactive\n end")))
"full")
;; ── scope cannot be widened ──────────────────────────────────────
(id-xchg-test
"exchange cannot widen beyond the subject token's scope"
(idxnm
(idx-ev
"O = identity_oauth:start(),\n {consent_required, Rq} = identity_oauth:authorize(O, web, uri1, [read], alice, v),\n {code, Cd} = identity_oauth:consent(O, Rq, allow),\n {ok, A, _R} = identity_oauth:exchange(O, Cd, web, uri1, v),\n case identity_oauth:token_exchange(O, A, [read, write]) of\n {ok, _} -> widened;\n {error, W} -> W\n end"))
"invalid_scope")
;; ── inactive subject token cannot be exchanged ───────────────────
(id-xchg-test
"exchanging a revoked subject token is invalid_grant"
(idxnm
(idx-ev
(str
idx-token
", identity_oauth:revoke(O, A),\n case identity_oauth:token_exchange(O, A, [read]) of\n {ok, _} -> issued;\n {error, W} -> W\n end")))
"invalid_grant")
;; ── independent lifecycles ───────────────────────────────────────
(id-xchg-test
"revoking the subject token does not revoke the exchanged token"
(idxnm
(idx-ev
(str
idx-token
", {ok, X} = identity_oauth:token_exchange(O, A, [read]),\n identity_oauth:revoke(O, A),\n case identity_oauth:introspect(O, X) of\n {active, _, _, _} -> still_active;\n {inactive} -> inactive\n end")))
"still_active")
(id-xchg-test
"revoking the exchanged token does not revoke the subject token"
(idxnm
(idx-ev
(str
idx-token
", {ok, X} = identity_oauth:token_exchange(O, A, [read]),\n identity_oauth:revoke(O, X),\n case identity_oauth:introspect(O, A) of\n {active, _, _, _} -> still_active;\n {inactive} -> inactive\n end")))
"still_active")
;; ── chained downscoping ──────────────────────────────────────────
(id-xchg-test
"an exchanged token can itself be exchanged (chain)"
(idxnm
(idx-ev
(str
idx-token
", {ok, X1} = identity_oauth:token_exchange(O, A, [read, write]),\n {ok, X2} = identity_oauth:token_exchange(O, X1, [read]),\n case identity_oauth:introspect(O, X2) of\n {active, _, _, [read]} -> chained;\n {active, _, _, _} -> other;\n {inactive} -> inactive\n end")))
"chained")
(define
id-xchg-test-summary
(str "exchange " id-xchg-test-pass "/" id-xchg-test-count))

View File

@@ -0,0 +1,92 @@
;; identity/tests/expiry.sx — access-token expiry on a logical clock
;; (RFC 6749 §4.2.2 expires_in). `advance` stands in for time passing;
;; introspect returns inactive once the clock reaches a token's expiry.
;; Refresh mints a fresh short-lived access token — the point of refresh.
(define id-expiry-test-count 0)
(define id-expiry-test-pass 0)
(define id-expiry-test-fails (list))
(define
id-expiry-test
(fn
(name actual expected)
(set! id-expiry-test-count (+ id-expiry-test-count 1))
(if
(= actual expected)
(set! id-expiry-test-pass (+ id-expiry-test-pass 1))
(append! id-expiry-test-fails {:name name :expected expected :actual actual}))))
(define ide-ev erlang-eval-ast)
(define idenm (fn (v) (get v :name)))
(identity-load-token!)
;; ── within TTL is active; past TTL is inactive ───────────────────
(id-expiry-test
"a token within its TTL is active"
(idenm
(ide-ev
"R = identity_tokens:start(),\n {ok, T} = identity_tokens:issue(R, alice, web, read, 100),\n identity_tokens:advance(R, 50),\n case identity_tokens:introspect(R, T) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"active")
(id-expiry-test
"a token at its TTL boundary is expired"
(idenm
(ide-ev
"R = identity_tokens:start(),\n {ok, T} = identity_tokens:issue(R, alice, web, read, 100),\n identity_tokens:advance(R, 100),\n case identity_tokens:introspect(R, T) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"inactive")
(id-expiry-test
"a token just before its TTL is still active"
(idenm
(ide-ev
"R = identity_tokens:start(),\n {ok, T} = identity_tokens:issue(R, alice, web, read, 100),\n identity_tokens:advance(R, 99),\n case identity_tokens:introspect(R, T) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"active")
;; ── no TTL (infinity) never expires ──────────────────────────────
(id-expiry-test
"a token issued without a TTL never expires"
(idenm
(ide-ev
"R = identity_tokens:start(),\n {ok, T} = identity_tokens:issue(R, alice, web, read),\n identity_tokens:advance(R, 100000),\n case identity_tokens:introspect(R, T) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"active")
;; ── refresh mints a fresh short-lived token ──────────────────────
(id-expiry-test
"refresh renews access after the old token expired"
(idenm
(ide-ev
"R = identity_tokens:start(),\n {ok, A, Rt} = identity_tokens:issue_grant(R, alice, web, read, 100),\n identity_tokens:advance(R, 100),\n inactive = case identity_tokens:introspect(R, A) of\n {active, _, _, _} -> active; {inactive} -> inactive end,\n {ok, A2, _R2} = identity_tokens:refresh(R, Rt),\n case identity_tokens:introspect(R, A2) of\n {active, _, _, _} -> renewed;\n {inactive} -> inactive\n end"))
"renewed")
(id-expiry-test
"the renewed token also expires after its own TTL"
(idenm
(ide-ev
"R = identity_tokens:start(),\n {ok, _A, Rt} = identity_tokens:issue_grant(R, alice, web, read, 100),\n identity_tokens:advance(R, 100),\n {ok, A2, _R2} = identity_tokens:refresh(R, Rt),\n identity_tokens:advance(R, 100),\n case identity_tokens:introspect(R, A2) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"inactive")
;; ── the logical clock ────────────────────────────────────────────
(id-expiry-test
"the clock starts at zero and advances"
(ide-ev
"R = identity_tokens:start(),\n identity_tokens:advance(R, 7),\n identity_tokens:advance(R, 35),\n identity_tokens:now(R)")
42)
;; ── expiry composes with revocation ──────────────────────────────
(id-expiry-test
"an expired token is also inactive after revoke (no contradiction)"
(idenm
(ide-ev
"R = identity_tokens:start(),\n {ok, T} = identity_tokens:issue(R, alice, web, read, 100),\n identity_tokens:advance(R, 200),\n identity_tokens:revoke(R, T),\n case identity_tokens:introspect(R, T) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"inactive")
(define
id-expiry-test-summary
(str "expiry " id-expiry-test-pass "/" id-expiry-test-count))

View File

@@ -0,0 +1,97 @@
;; identity/tests/facade.sx — the unified facade: one coordinator wiring
;; sessions+tokens, the audit ledger, and membership. Exercises the
;; cross-module integration (login/logout auditing, audit history, member
;; enrollment + projection) through the single `identity` door.
(define id-facade-test-count 0)
(define id-facade-test-pass 0)
(define id-facade-test-fails (list))
(define
id-facade-test
(fn
(name actual expected)
(set! id-facade-test-count (+ id-facade-test-count 1))
(if
(= actual expected)
(set! id-facade-test-pass (+ id-facade-test-pass 1))
(append! id-facade-test-fails {:name name :expected expected :actual actual}))))
(define idfc-ev erlang-eval-ast)
(define idfcnm (fn (v) (get v :name)))
(identity-load-all!)
;; ── login + logout are audited through the ledger ────────────────
(id-facade-test
"login then logout records login, issue, logout in order"
(idfcnm
(idfc-ev
"Svc = identity:start(),\n {ok, Sid, _Tok} = identity:login(Svc, alice, web, read),\n identity:logout(Svc, Sid),\n case identity:history(Svc, alice) of\n [login, issue, logout] -> ordered;\n Other -> Other\n end"))
"ordered")
(id-facade-test
"revoking a token is audited"
(idfcnm
(idfc-ev
"Svc = identity:start(),\n {ok, _Sid, Tok} = identity:login(Svc, alice, web, read),\n identity:revoke(Svc, Tok),\n case identity:history(Svc, alice) of\n [login, issue, revoke] -> ordered;\n Other -> Other\n end"))
"ordered")
(id-facade-test
"history is per-subject"
(idfc-ev
"Svc = identity:start(),\n identity:login(Svc, alice, web, read),\n identity:login(Svc, bob, cli, read),\n identity:login(Svc, alice, mobile, read),\n length(identity:history(Svc, alice))")
4)
;; ── membership through the facade ────────────────────────────────
(id-facade-test
"enroll makes the subject an active member"
(idfcnm
(idfc-ev
"Svc = identity:start(),\n identity:enroll(Svc, alice, supporter),\n case identity:member_status(Svc, alice) of\n {ok, St, _} -> St;\n {none} -> none\n end"))
"active")
(id-facade-test
"enroll keeps the tier"
(idfcnm
(idfc-ev
"Svc = identity:start(),\n identity:enroll(Svc, alice, supporter),\n case identity:member_status(Svc, alice) of\n {ok, _, Tier} -> Tier\n end"))
"supporter")
(id-facade-test
"an enrolled member projects per-app"
(idfcnm
(idfc-ev
"Svc = identity:start(),\n identity:enroll(Svc, alice, basic),\n case identity:member_project(Svc, alice, market) of\n {member, _, App} -> App;\n {Tag, _} -> Tag\n end"))
"market")
(id-facade-test
"a non-member projects as non_member"
(idfcnm
(idfc-ev
"Svc = identity:start(),\n case identity:member_project(Svc, stranger, blog) of\n {member, _, _} -> member;\n {Tag, _} -> Tag\n end"))
"non_member")
;; ── the facade still proves identity ─────────────────────────────
(id-facade-test
"verify still returns the subject after login"
(idfcnm
(idfc-ev
"Svc = identity:start(),\n {ok, _Sid, Tok} = identity:login(Svc, alice, web, read),\n case identity:verify(Svc, Tok) of\n {active, Subject, _, _} -> Subject;\n {inactive} -> inactive\n end"))
"alice")
;; ── identity and membership are distinct axes ────────────────────
(id-facade-test
"logging in does not enroll membership"
(idfcnm
(idfc-ev
"Svc = identity:start(),\n identity:login(Svc, alice, web, read),\n case identity:member_status(Svc, alice) of\n {ok, St, _} -> St;\n {none} -> none\n end"))
"none")
(define
id-facade-test-summary
(str "facade " id-facade-test-pass "/" id-facade-test-count))

View File

@@ -0,0 +1,115 @@
;; identity/tests/federation.sx — federated identity: trust-gated,
;; advisory peer assertions + cross-instance subject mapping.
(define id-fed-test-count 0)
(define id-fed-test-pass 0)
(define id-fed-test-fails (list))
(define
id-fed-test
(fn
(name actual expected)
(set! id-fed-test-count (+ id-fed-test-count 1))
(if
(= actual expected)
(set! id-fed-test-pass (+ id-fed-test-pass 1))
(append! id-fed-test-fails {:name name :expected expected :actual actual}))))
(define idf-ev erlang-eval-ast)
(define idfnm (fn (v) (get v :name)))
(identity-load-federation!)
;; ── trust gating ─────────────────────────────────────────────────
(id-fed-test
"an assertion from an untrusted peer is rejected"
(idfnm
(idf-ev
"F = identity_federation:start(),\n case identity_federation:assert_id(F, peer1, alice) of\n {ok, _} -> accepted;\n {error, Why} -> Why\n end"))
"untrusted")
(id-fed-test
"a trusted peer's assertion is accepted"
(idfnm
(idf-ev
"F = identity_federation:start(),\n identity_federation:trust(F, peer1),\n case identity_federation:assert_id(F, peer1, alice) of\n {ok, _} -> accepted;\n {error, Why} -> Why\n end"))
"accepted")
(id-fed-test
"untrust closes the door to future assertions"
(idfnm
(idf-ev
"F = identity_federation:start(),\n identity_federation:trust(F, peer1),\n identity_federation:untrust(F, peer1),\n case identity_federation:assert_id(F, peer1, alice) of\n {ok, _} -> accepted;\n {error, Why} -> Why\n end"))
"untrusted")
(id-fed-test
"trusted? is true for a trusted peer"
(idfnm
(idf-ev
"F = identity_federation:start(),\n identity_federation:trust(F, peer1),\n case identity_federation:trusted(F, peer1) of\n true -> yes;\n false -> no\n end"))
"yes")
(id-fed-test
"trusted? is false for an unknown peer"
(idfnm
(idf-ev
"F = identity_federation:start(),\n identity_federation:trust(F, peer1),\n case identity_federation:trusted(F, peer2) of\n true -> yes;\n false -> no\n end"))
"no")
;; ── advisory provenance ──────────────────────────────────────────
(id-fed-test
"an asserted identity is flagged peer_asserted with its origin"
(idfnm
(idf-ev
"F = identity_federation:start(),\n identity_federation:trust(F, peer1),\n {ok, L} = identity_federation:assert_id(F, peer1, alice),\n case identity_federation:provenance(F, L) of\n {peer_asserted, P} -> P;\n {local} -> local\n end"))
"peer1")
(id-fed-test
"a non-federated subject has local provenance"
(idfnm
(idf-ev
"F = identity_federation:start(),\n case identity_federation:provenance(F, alice) of\n {peer_asserted, _} -> peer_asserted;\n {local} -> local\n end"))
"local")
;; ── cross-instance subject mapping ───────────────────────────────
(id-fed-test
"remote subjects are namespaced by peer by default"
(idfnm
(idf-ev
"F = identity_federation:start(),\n case identity_federation:resolve(F, peer1, alice) of\n {ok, {federated, _, Remote}} -> Remote;\n _ -> other\n end"))
"alice")
(id-fed-test
"the same remote name from two peers maps to distinct subjects"
(idfnm
(idf-ev
"F = identity_federation:start(),\n {ok, L1} = identity_federation:resolve(F, peer1, alice),\n {ok, L2} = identity_federation:resolve(F, peer2, alice),\n case L1 =:= L2 of\n true -> collision;\n false -> distinct\n end"))
"distinct")
(id-fed-test
"an explicit map aliases a remote subject to a local one"
(idfnm
(idf-ev
"F = identity_federation:start(),\n identity_federation:trust(F, peer1),\n identity_federation:map(F, peer1, alice, alice_local),\n case identity_federation:assert_id(F, peer1, alice) of\n {ok, alice_local} -> mapped;\n {ok, _} -> unmapped;\n {error, W} -> W\n end"))
"mapped")
(id-fed-test
"a mapped subject keeps peer_asserted provenance"
(idfnm
(idf-ev
"F = identity_federation:start(),\n identity_federation:trust(F, peer1),\n identity_federation:map(F, peer1, alice, alice_local),\n identity_federation:assert_id(F, peer1, alice),\n case identity_federation:provenance(F, alice_local) of\n {peer_asserted, P} -> P;\n {local} -> local\n end"))
"peer1")
(id-fed-test
"two peers asserting same name keep separate provenance"
(idfnm
(idf-ev
"F = identity_federation:start(),\n identity_federation:trust(F, peer1),\n identity_federation:trust(F, peer2),\n {ok, L1} = identity_federation:assert_id(F, peer1, alice),\n {ok, _L2} = identity_federation:assert_id(F, peer2, alice),\n case identity_federation:provenance(F, L1) of\n {peer_asserted, P} -> P;\n {local} -> local\n end"))
"peer1")
(define
id-fed-test-summary
(str "federation " id-fed-test-pass "/" id-fed-test-count))

View File

@@ -0,0 +1,96 @@
;; identity/tests/grants.sx — the client-credentials grant (RFC 6749
;; §4.4): a confidential client authenticates and gets a token acting on
;; its own behalf — no end-user, no refresh token (§4.4.3). Public clients
;; cannot use it.
(define id-grants-test-count 0)
(define id-grants-test-pass 0)
(define id-grants-test-fails (list))
(define
id-grants-test
(fn
(name actual expected)
(set! id-grants-test-count (+ id-grants-test-count 1))
(if
(= actual expected)
(set! id-grants-test-pass (+ id-grants-test-pass 1))
(append! id-grants-test-fails {:name name :expected expected :actual actual}))))
(define idg-ev erlang-eval-ast)
(define idgnm (fn (v) (get v :name)))
(identity-load-oauth!)
;; ── confidential client-credentials happy path ───────────────────
(id-grants-test
"a confidential client obtains a working token"
(idgnm
(idg-ev
"O = identity_oauth:start(),\n identity_oauth:register_client(O, svc, confidential, sk, [uri1]),\n {ok, T} = identity_oauth:client_credentials(O, svc, sk, batch),\n case identity_oauth:introspect(O, T) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"active")
(id-grants-test
"the client-credentials token's subject is the client itself"
(idgnm
(idg-ev
"O = identity_oauth:start(),\n identity_oauth:register_client(O, svc, confidential, sk, [uri1]),\n {ok, T} = identity_oauth:client_credentials(O, svc, sk, batch),\n case identity_oauth:introspect(O, T) of\n {active, Subject, _, _} -> Subject\n end"))
"svc")
(id-grants-test
"the client-credentials token carries the requested scope"
(idgnm
(idg-ev
"O = identity_oauth:start(),\n identity_oauth:register_client(O, svc, confidential, sk, [uri1]),\n {ok, T} = identity_oauth:client_credentials(O, svc, sk, reports),\n case identity_oauth:introspect(O, T) of\n {active, _, _, Scope} -> Scope\n end"))
"reports")
(id-grants-test
"client-credentials issues no refresh token (single value)"
(idgnm
(idg-ev
"O = identity_oauth:start(),\n identity_oauth:register_client(O, svc, confidential, sk, [uri1]),\n case identity_oauth:client_credentials(O, svc, sk, batch) of\n {ok, _, _} -> pair;\n {ok, _} -> single;\n {error, W} -> W\n end"))
"single")
;; ── authentication failures ──────────────────────────────────────
(id-grants-test
"a wrong client secret is invalid_client"
(idgnm
(idg-ev
"O = identity_oauth:start(),\n identity_oauth:register_client(O, svc, confidential, sk, [uri1]),\n case identity_oauth:client_credentials(O, svc, wrong, batch) of\n {ok, _} -> issued;\n {error, W} -> W\n end"))
"invalid_client")
(id-grants-test
"a public client cannot use client-credentials"
(idgnm
(idg-ev
"O = identity_oauth:start(),\n identity_oauth:register_client(O, spa, public, none, [uri1]),\n case identity_oauth:client_credentials(O, spa, none, batch) of\n {ok, _} -> issued;\n {error, W} -> W\n end"))
"unauthorized_client")
(id-grants-test
"an unregistered client cannot use client-credentials"
(idgnm
(idg-ev
"O = identity_oauth:start(),\n case identity_oauth:client_credentials(O, ghost, x, batch) of\n {ok, _} -> issued;\n {error, W} -> W\n end"))
"invalid_client")
;; ── independence + real revocation for client tokens ─────────────
(id-grants-test
"two confidential clients get independent tokens"
(idgnm
(idg-ev
"O = identity_oauth:start(),\n identity_oauth:register_client(O, svc1, confidential, k1, [uri1]),\n identity_oauth:register_client(O, svc2, confidential, k2, [uri1]),\n {ok, _T1} = identity_oauth:client_credentials(O, svc1, k1, batch),\n {ok, T2} = identity_oauth:client_credentials(O, svc2, k2, batch),\n case identity_oauth:introspect(O, T2) of\n {active, Subject, _, _} -> Subject\n end"))
"svc2")
(id-grants-test
"a client-credentials token can be revoked"
(idgnm
(idg-ev
"O = identity_oauth:start(),\n identity_oauth:register_client(O, svc, confidential, sk, [uri1]),\n {ok, T} = identity_oauth:client_credentials(O, svc, sk, batch),\n identity_oauth:revoke(O, T),\n case identity_oauth:introspect(O, T) of\n {active, _, _, _} -> still_valid;\n {inactive} -> inactive\n end"))
"inactive")
(define
id-grants-test-summary
(str "grants " id-grants-test-pass "/" id-grants-test-count))

View File

@@ -0,0 +1,93 @@
;; identity/tests/introspect.sx — RFC 7662 §2.2 full introspection metadata
;; (sub, client_id, scope, exp, iat, token_type) alongside the live-lookup
;; active/inactive semantics.
(define id-intr-test-count 0)
(define id-intr-test-pass 0)
(define id-intr-test-fails (list))
(define
id-intr-test
(fn
(name actual expected)
(set! id-intr-test-count (+ id-intr-test-count 1))
(if
(= actual expected)
(set! id-intr-test-pass (+ id-intr-test-pass 1))
(append! id-intr-test-fails {:name name :expected expected :actual actual}))))
(define idi-ev erlang-eval-ast)
(define idinm (fn (v) (get v :name)))
(identity-load-token!)
;; ── metadata fields ──────────────────────────────────────────────
(id-intr-test
"introspect_full reports token_type bearer"
(idinm
(idi-ev
"R = identity_tokens:start(),\n {ok, T} = identity_tokens:issue(R, alice, web, read, 100),\n case identity_tokens:introspect_full(R, T) of\n {active, _, _, _, _, _, Tt} -> Tt;\n {inactive} -> inactive\n end"))
"bearer")
(id-intr-test
"introspect_full reports the subject"
(idinm
(idi-ev
"R = identity_tokens:start(),\n {ok, T} = identity_tokens:issue(R, alice, web, read, 100),\n case identity_tokens:introspect_full(R, T) of\n {active, Sub, _, _, _, _, _} -> Sub\n end"))
"alice")
(id-intr-test
"introspect_full reports the client_id"
(idinm
(idi-ev
"R = identity_tokens:start(),\n {ok, T} = identity_tokens:issue(R, alice, mobile, read, 100),\n case identity_tokens:introspect_full(R, T) of\n {active, _, Cl, _, _, _, _} -> Cl\n end"))
"mobile")
(id-intr-test
"introspect_full reports the scope"
(idinm
(idi-ev
"R = identity_tokens:start(),\n {ok, T} = identity_tokens:issue(R, alice, web, write, 100),\n case identity_tokens:introspect_full(R, T) of\n {active, _, _, Sc, _, _, _} -> Sc\n end"))
"write")
;; ── exp / iat reflect the logical clock ──────────────────────────
(id-intr-test
"iat is the clock value at issue"
(idi-ev
"R = identity_tokens:start(),\n identity_tokens:advance(R, 7),\n {ok, T} = identity_tokens:issue(R, alice, web, read, 100),\n case identity_tokens:introspect_full(R, T) of\n {active, _, _, _, _, Iat, _} -> Iat\n end")
7)
(id-intr-test
"exp is iat plus the ttl"
(idi-ev
"R = identity_tokens:start(),\n identity_tokens:advance(R, 7),\n {ok, T} = identity_tokens:issue(R, alice, web, read, 100),\n case identity_tokens:introspect_full(R, T) of\n {active, _, _, _, Exp, Iat, _} -> Exp - Iat\n end")
100)
;; ── inactive / expired / revoked ─────────────────────────────────
(id-intr-test
"an expired token introspects inactive in full mode too"
(idinm
(idi-ev
"R = identity_tokens:start(),\n {ok, T} = identity_tokens:issue(R, alice, web, read, 100),\n identity_tokens:advance(R, 100),\n case identity_tokens:introspect_full(R, T) of\n {active, _, _, _, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"inactive")
(id-intr-test
"a revoked token introspects inactive in full mode"
(idinm
(idi-ev
"R = identity_tokens:start(),\n {ok, T} = identity_tokens:issue(R, alice, web, read),\n identity_tokens:revoke(R, T),\n case identity_tokens:introspect_full(R, T) of\n {active, _, _, _, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"inactive")
(id-intr-test
"an unknown token introspects inactive in full mode"
(idinm
(idi-ev
"R = identity_tokens:start(),\n Bogus = make_ref(),\n case identity_tokens:introspect_full(R, Bogus) of\n {active, _, _, _, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"inactive")
(define
id-intr-test-summary
(str "introspect " id-intr-test-pass "/" id-intr-test-count))

View File

@@ -0,0 +1,155 @@
;; identity/tests/membership.sx — membership state machine + per-app
;; grant projection. Valid transitions advance state; invalid ones are
;; explicit errors. The projection renders one canonical state per app.
(define id-membership-test-count 0)
(define id-membership-test-pass 0)
(define id-membership-test-fails (list))
(define
id-membership-test
(fn
(name actual expected)
(set! id-membership-test-count (+ id-membership-test-count 1))
(if
(= actual expected)
(set! id-membership-test-pass (+ id-membership-test-pass 1))
(append! id-membership-test-fails {:name name :expected expected :actual actual}))))
(define idm-ev erlang-eval-ast)
(define idmnm (fn (v) (get v :name)))
(identity-load-membership!)
;; ── request → pending → approve → active ─────────────────────────
(id-membership-test
"request leaves the subject pending"
(idmnm
(idm-ev
"M = identity_membership:start(),\n identity_membership:request(M, alice, basic),\n case identity_membership:status(M, alice) of\n {ok, St, _} -> St;\n {none} -> none\n end"))
"pending")
(id-membership-test
"approve activates a pending membership"
(idmnm
(idm-ev
"M = identity_membership:start(),\n identity_membership:request(M, alice, basic),\n identity_membership:approve(M, alice),\n case identity_membership:status(M, alice) of\n {ok, St, _} -> St;\n {none} -> none\n end"))
"active")
(id-membership-test
"status keeps the requested tier"
(idmnm
(idm-ev
"M = identity_membership:start(),\n identity_membership:request(M, alice, supporter),\n identity_membership:approve(M, alice),\n case identity_membership:status(M, alice) of\n {ok, _, Tier} -> Tier\n end"))
"supporter")
;; ── guarded transitions: invalid moves are explicit errors ───────
(id-membership-test
"requesting twice is an error"
(idmnm
(idm-ev
"M = identity_membership:start(),\n identity_membership:request(M, alice, basic),\n case identity_membership:request(M, alice, basic) of\n ok -> ok;\n {error, Why} -> Why\n end"))
"exists")
(id-membership-test
"approving an unknown subject is not_found"
(idmnm
(idm-ev
"M = identity_membership:start(),\n case identity_membership:approve(M, ghost) of\n ok -> ok;\n {error, Why} -> Why\n end"))
"not_found")
(id-membership-test
"approving an already-active membership is an error"
(idmnm
(idm-ev
"M = identity_membership:start(),\n identity_membership:request(M, alice, basic),\n identity_membership:approve(M, alice),\n case identity_membership:approve(M, alice) of\n ok -> ok;\n {error, Why} -> Why\n end"))
"active")
;; ── lapse / reinstate ────────────────────────────────────────────
(id-membership-test
"active member can lapse"
(idmnm
(idm-ev
"M = identity_membership:start(),\n identity_membership:request(M, alice, basic),\n identity_membership:approve(M, alice),\n identity_membership:lapse(M, alice),\n case identity_membership:status(M, alice) of\n {ok, St, _} -> St\n end"))
"lapsed")
(id-membership-test
"lapsing a pending membership is an error"
(idmnm
(idm-ev
"M = identity_membership:start(),\n identity_membership:request(M, alice, basic),\n case identity_membership:lapse(M, alice) of\n ok -> ok;\n {error, Why} -> Why\n end"))
"pending")
(id-membership-test
"lapsed member can reinstate to active"
(idmnm
(idm-ev
"M = identity_membership:start(),\n identity_membership:request(M, alice, basic),\n identity_membership:approve(M, alice),\n identity_membership:lapse(M, alice),\n identity_membership:reinstate(M, alice),\n case identity_membership:status(M, alice) of\n {ok, St, _} -> St\n end"))
"active")
;; ── revoke is terminal ───────────────────────────────────────────
(id-membership-test
"any member can be revoked"
(idmnm
(idm-ev
"M = identity_membership:start(),\n identity_membership:request(M, alice, basic),\n identity_membership:approve(M, alice),\n identity_membership:revoke(M, alice),\n case identity_membership:status(M, alice) of\n {ok, St, _} -> St\n end"))
"revoked")
(id-membership-test
"a revoked membership cannot be reinstated"
(idmnm
(idm-ev
"M = identity_membership:start(),\n identity_membership:request(M, alice, basic),\n identity_membership:approve(M, alice),\n identity_membership:revoke(M, alice),\n case identity_membership:reinstate(M, alice) of\n ok -> ok;\n {error, Why} -> Why\n end"))
"revoked")
;; ── per-app grant projection ─────────────────────────────────────
(id-membership-test
"active member projects as member"
(idmnm
(idm-ev
"M = identity_membership:start(),\n identity_membership:request(M, alice, basic),\n identity_membership:approve(M, alice),\n case identity_membership:project(M, alice, blog) of\n {member, _, _} -> member;\n {Tag, _} -> Tag\n end"))
"member")
(id-membership-test
"projection carries the requesting app"
(idmnm
(idm-ev
"M = identity_membership:start(),\n identity_membership:request(M, alice, basic),\n identity_membership:approve(M, alice),\n case identity_membership:project(M, alice, market) of\n {member, _, App} -> App\n end"))
"market")
(id-membership-test
"the same subject projects consistently across apps"
(idmnm
(idm-ev
"M = identity_membership:start(),\n identity_membership:request(M, alice, supporter),\n identity_membership:approve(M, alice),\n {member, T1, blog} = identity_membership:project(M, alice, blog),\n {member, T2, events} = identity_membership:project(M, alice, events),\n case T1 =:= T2 of\n true -> T1;\n false -> mismatch\n end"))
"supporter")
(id-membership-test
"unknown subject projects as non_member"
(idmnm
(idm-ev
"M = identity_membership:start(),\n case identity_membership:project(M, ghost, blog) of\n {Tag, _} -> Tag;\n {Tag, _, _} -> Tag\n end"))
"non_member")
(id-membership-test
"lapsed member projects as lapsed"
(idmnm
(idm-ev
"M = identity_membership:start(),\n identity_membership:request(M, alice, basic),\n identity_membership:approve(M, alice),\n identity_membership:lapse(M, alice),\n case identity_membership:project(M, alice, blog) of\n {Tag, _} -> Tag;\n {Tag, _, _} -> Tag\n end"))
"lapsed")
(id-membership-test
"revoked member projects as denied"
(idmnm
(idm-ev
"M = identity_membership:start(),\n identity_membership:request(M, alice, basic),\n identity_membership:approve(M, alice),\n identity_membership:revoke(M, alice),\n case identity_membership:project(M, alice, blog) of\n {Tag, _} -> Tag;\n {Tag, _, _} -> Tag\n end"))
"denied")
(define
id-membership-test-summary
(str "membership " id-membership-test-pass "/" id-membership-test-count))

192
lib/identity/tests/oauth.sx Normal file
View File

@@ -0,0 +1,192 @@
;; identity/tests/oauth.sx — OAuth2 authorization-code flow (RFC 6749
;; §4.1) + PKCE (RFC 7636) + refresh grant (§6). Covers the full happy
;; path end-to-end (code exchange → access+refresh → refresh rotation) and
;; every rejection: denied consent, single-use codes, client/redirect
;; binding, PKCE mismatch, unknown code/request, refresh-token reuse, and
;; revoke-then-use (which must fail).
(define id-oauth-test-count 0)
(define id-oauth-test-pass 0)
(define id-oauth-test-fails (list))
(define
id-oauth-test
(fn
(name actual expected)
(set! id-oauth-test-count (+ id-oauth-test-count 1))
(if
(= actual expected)
(set! id-oauth-test-pass (+ id-oauth-test-pass 1))
(append! id-oauth-test-fails {:name name :expected expected :actual actual}))))
(define ido-ev erlang-eval-ast)
(define idonm (fn (v) (get v :name)))
(identity-load-token!)
(identity-load-oauth!)
;; Shared prelude: authorize + consent(allow) leaving Code bound.
(define
ido-granted
"O = identity_oauth:start(),\n {consent_required, ReqId} =\n identity_oauth:authorize(O, webapp, uri1, read, alice, verif1),\n {code, Code} = identity_oauth:consent(O, ReqId, allow)")
;; ── full happy path ──────────────────────────────────────────────
(id-oauth-test
"authorize asks for consent"
(idonm
(ido-ev
"O = identity_oauth:start(),\n case identity_oauth:authorize(O, webapp, uri1, read, alice, verif1) of\n {consent_required, _} -> consent_required;\n Other -> Other\n end"))
"consent_required")
(id-oauth-test
"consent(allow) returns a code"
(idonm (ido-ev (str ido-granted ", case Code of _ -> issued end")))
"issued")
(id-oauth-test
"exchanged access token introspects active"
(idonm
(ido-ev
(str
ido-granted
", {ok, Tok, _R} = identity_oauth:exchange(O, Code, webapp, uri1, verif1),\n case identity_oauth:introspect(O, Tok) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end")))
"active")
(id-oauth-test
"exchanged token carries the authorized subject"
(idonm
(ido-ev
(str
ido-granted
", {ok, Tok, _R} = identity_oauth:exchange(O, Code, webapp, uri1, verif1),\n case identity_oauth:introspect(O, Tok) of\n {active, Subject, _, _} -> Subject\n end")))
"alice")
(id-oauth-test
"exchanged token carries the authorized scope"
(idonm
(ido-ev
(str
ido-granted
", {ok, Tok, _R} = identity_oauth:exchange(O, Code, webapp, uri1, verif1),\n case identity_oauth:introspect(O, Tok) of\n {active, _, _, Scope} -> Scope\n end")))
"read")
;; ── refresh grant (RFC 6749 §6) end-to-end ───────────────────────
(id-oauth-test
"refresh after exchange yields a working access token"
(idonm
(ido-ev
(str
ido-granted
", {ok, _A, R} = identity_oauth:exchange(O, Code, webapp, uri1, verif1),\n {ok, A2, _R2} = identity_oauth:refresh(O, R),\n case identity_oauth:introspect(O, A2) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end")))
"active")
(id-oauth-test
"reusing a rotated refresh token is invalid_grant"
(idonm
(ido-ev
(str
ido-granted
", {ok, _A, R} = identity_oauth:exchange(O, Code, webapp, uri1, verif1),\n {ok, _A2, _R2} = identity_oauth:refresh(O, R),\n case identity_oauth:refresh(O, R) of\n {ok, _, _} -> rotated;\n {error, Why} -> Why\n end")))
"invalid_grant")
;; ── consent denied (§4.1.2.1) ────────────────────────────────────
(id-oauth-test
"denied consent yields access_denied"
(idonm
(ido-ev
"O = identity_oauth:start(),\n {consent_required, ReqId} =\n identity_oauth:authorize(O, webapp, uri1, read, alice, verif1),\n case identity_oauth:consent(O, ReqId, deny) of\n {error, Why} -> Why;\n {code, _} -> issued\n end"))
"access_denied")
;; ── single-use codes (§10.5) ─────────────────────────────────────
(id-oauth-test
"code cannot be exchanged twice"
(idonm
(ido-ev
(str
ido-granted
", identity_oauth:exchange(O, Code, webapp, uri1, verif1),\n case identity_oauth:exchange(O, Code, webapp, uri1, verif1) of\n {ok, _, _} -> replayed;\n {error, Why} -> Why\n end")))
"invalid_grant")
;; ── code binding to client + redirect_uri (§4.1.3) ───────────────
(id-oauth-test
"exchange with wrong client is invalid_grant"
(idonm
(ido-ev
(str
ido-granted
", case identity_oauth:exchange(O, Code, attacker, uri1, verif1) of\n {ok, _, _} -> ok;\n {error, Why} -> Why\n end")))
"invalid_grant")
(id-oauth-test
"exchange with wrong redirect_uri is invalid_grant"
(idonm
(ido-ev
(str
ido-granted
", case identity_oauth:exchange(O, Code, webapp, evil_uri, verif1) of\n {ok, _, _} -> ok;\n {error, Why} -> Why\n end")))
"invalid_grant")
;; ── PKCE verifier mismatch (RFC 7636) ────────────────────────────
(id-oauth-test
"exchange with wrong PKCE verifier is invalid_grant"
(idonm
(ido-ev
(str
ido-granted
", case identity_oauth:exchange(O, Code, webapp, uri1, badverif) of\n {ok, _, _} -> ok;\n {error, Why} -> Why\n end")))
"invalid_grant")
;; ── unknown code / request ───────────────────────────────────────
(id-oauth-test
"exchanging an unknown code is invalid_grant"
(idonm
(ido-ev
"O = identity_oauth:start(),\n Bogus = make_ref(),\n case identity_oauth:exchange(O, Bogus, webapp, uri1, verif1) of\n {ok, _, _} -> ok;\n {error, Why} -> Why\n end"))
"invalid_grant")
(id-oauth-test
"consent on an unknown request is unknown_request"
(idonm
(ido-ev
"O = identity_oauth:start(),\n Bogus = make_ref(),\n case identity_oauth:consent(O, Bogus, allow) of\n {code, _} -> issued;\n {error, Why} -> Why\n end"))
"unknown_request")
;; ── revoke-then-use must fail (RFC 7009) ─────────────────────────
(id-oauth-test
"revoked exchanged token introspects inactive"
(idonm
(ido-ev
(str
ido-granted
", {ok, Tok, _R} = identity_oauth:exchange(O, Code, webapp, uri1, verif1),\n identity_oauth:revoke(O, Tok),\n case identity_oauth:introspect(O, Tok) of\n {active, _, _, _} -> still_valid;\n {inactive} -> inactive\n end")))
"inactive")
(id-oauth-test
"revoking the access token blocks a later refresh (cascade)"
(idonm
(ido-ev
(str
ido-granted
", {ok, A, R} = identity_oauth:exchange(O, Code, webapp, uri1, verif1),\n identity_oauth:revoke(O, A),\n case identity_oauth:refresh(O, R) of\n {ok, _, _} -> refreshed;\n {error, Why} -> Why\n end")))
"invalid_grant")
;; ── independence: two concurrent authorizations don't collide ────
(id-oauth-test
"two authorizations issue independent grants"
(idonm
(ido-ev
"O = identity_oauth:start(),\n {consent_required, R1} =\n identity_oauth:authorize(O, webapp, uri1, read, alice, va),\n {consent_required, R2} =\n identity_oauth:authorize(O, cli, uri2, write, bob, vb),\n {code, C1} = identity_oauth:consent(O, R1, allow),\n {code, C2} = identity_oauth:consent(O, R2, allow),\n {ok, _A1, _RR1} = identity_oauth:exchange(O, C1, webapp, uri1, va),\n {ok, A2, _RR2} = identity_oauth:exchange(O, C2, cli, uri2, vb),\n case identity_oauth:introspect(O, A2) of\n {active, Subject, _, _} -> Subject\n end"))
"bob")
(define
id-oauth-test-summary
(str "oauth " id-oauth-test-pass "/" id-oauth-test-count))

84
lib/identity/tests/par.sx Normal file
View File

@@ -0,0 +1,84 @@
;; identity/tests/par.sx — pushed authorization requests (PAR, RFC 9126):
;; lodge the authorization params up front under a single-use request_uri,
;; then redeem it into the normal consent flow. The binding (client,
;; redirect, PKCE) carried by the pushed request is enforced at exchange.
(define id-par-test-count 0)
(define id-par-test-pass 0)
(define id-par-test-fails (list))
(define
id-par-test
(fn
(name actual expected)
(set! id-par-test-count (+ id-par-test-count 1))
(if
(= actual expected)
(set! id-par-test-pass (+ id-par-test-pass 1))
(append! id-par-test-fails {:name name :expected expected :actual actual}))))
(define idp-ev erlang-eval-ast)
(define idpnm (fn (v) (get v :name)))
(identity-load-oauth!)
;; ── pushed request redeems into consent ──────────────────────────
(id-par-test
"authorize_pushed on a fresh request_uri asks for consent"
(idpnm
(idp-ev
"O = identity_oauth:start(),\n {ok, Ru} = identity_oauth:push_authorization_request(O, web, uri1, read, alice, v),\n case identity_oauth:authorize_pushed(O, Ru) of\n {consent_required, _} -> consent_required;\n {error, W} -> W\n end"))
"consent_required")
;; ── full PAR flow ────────────────────────────────────────────────
(id-par-test
"the full PAR flow yields a working token"
(idpnm
(idp-ev
"O = identity_oauth:start(),\n {ok, Ru} = identity_oauth:push_authorization_request(O, web, uri1, read, alice, v),\n {consent_required, Rq} = identity_oauth:authorize_pushed(O, Ru),\n {code, Cd} = identity_oauth:consent(O, Rq, allow),\n {ok, A, _R} = identity_oauth:exchange(O, Cd, web, uri1, v),\n case identity_oauth:introspect(O, A) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"active")
(id-par-test
"the PAR token carries the pushed subject"
(idpnm
(idp-ev
"O = identity_oauth:start(),\n {ok, Ru} = identity_oauth:push_authorization_request(O, web, uri1, read, alice, v),\n {consent_required, Rq} = identity_oauth:authorize_pushed(O, Ru),\n {code, Cd} = identity_oauth:consent(O, Rq, allow),\n {ok, A, _R} = identity_oauth:exchange(O, Cd, web, uri1, v),\n case identity_oauth:introspect(O, A) of\n {active, Subject, _, _} -> Subject\n end"))
"alice")
;; ── request_uri is single-use ────────────────────────────────────
(id-par-test
"a request_uri cannot be redeemed twice"
(idpnm
(idp-ev
"O = identity_oauth:start(),\n {ok, Ru} = identity_oauth:push_authorization_request(O, web, uri1, read, alice, v),\n identity_oauth:authorize_pushed(O, Ru),\n case identity_oauth:authorize_pushed(O, Ru) of\n {consent_required, _} -> reused;\n {error, W} -> W\n end"))
"invalid_request_uri")
(id-par-test
"an unknown request_uri is rejected"
(idpnm
(idp-ev
"O = identity_oauth:start(),\n Bogus = make_ref(),\n case identity_oauth:authorize_pushed(O, Bogus) of\n {consent_required, _} -> ok;\n {error, W} -> W\n end"))
"invalid_request_uri")
;; ── the pushed binding is still enforced at exchange ─────────────
(id-par-test
"a PAR-issued code still enforces PKCE"
(idpnm
(idp-ev
"O = identity_oauth:start(),\n {ok, Ru} = identity_oauth:push_authorization_request(O, web, uri1, read, alice, v),\n {consent_required, Rq} = identity_oauth:authorize_pushed(O, Ru),\n {code, Cd} = identity_oauth:consent(O, Rq, allow),\n case identity_oauth:exchange(O, Cd, web, uri1, wrongverif) of\n {ok, _, _} -> ok;\n {error, W} -> W\n end"))
"invalid_grant")
(id-par-test
"a PAR-issued code still enforces client binding"
(idpnm
(idp-ev
"O = identity_oauth:start(),\n {ok, Ru} = identity_oauth:push_authorization_request(O, web, uri1, read, alice, v),\n {consent_required, Rq} = identity_oauth:authorize_pushed(O, Ru),\n {code, Cd} = identity_oauth:consent(O, Rq, allow),\n case identity_oauth:exchange(O, Cd, attacker, uri1, v) of\n {ok, _, _} -> ok;\n {error, W} -> W\n end"))
"invalid_grant")
(define
id-par-test-summary
(str "par " id-par-test-pass "/" id-par-test-count))

View File

@@ -0,0 +1,99 @@
;; identity/tests/registry.sx — routing by id and by (subject, client),
;; SSO fan-out (one subject, many clients), and integration with live
;; session processes routed through the registry.
(define id-registry-test-count 0)
(define id-registry-test-pass 0)
(define id-registry-test-fails (list))
(define
id-registry-test
(fn
(name actual expected)
(set! id-registry-test-count (+ id-registry-test-count 1))
(if
(= actual expected)
(set! id-registry-test-pass (+ id-registry-test-pass 1))
(append! id-registry-test-fails {:name name :expected expected :actual actual}))))
(define idr-ev erlang-eval-ast)
(define idrnm (fn (v) (get v :name)))
(identity-load-session!)
(identity-load-registry!)
;; ── whereis by session id ────────────────────────────────────────
(id-registry-test
"registered session is found by id"
(idrnm
(idr-ev
"Me = self(),\n Reg = identity_registry:start(),\n identity_registry:register(Reg, s1, alice, web, Me),\n case identity_registry:whereis_session(Reg, s1) of\n {ok, _} -> found;\n {error, _} -> missing\n end"))
"found")
(id-registry-test
"unknown session id is not_found, not a crash"
(idrnm
(idr-ev
"Reg = identity_registry:start(),\n case identity_registry:whereis_session(Reg, nope) of\n {ok, _} -> found;\n {error, Why} -> Why\n end"))
"not_found")
;; ── lookup by (subject, client) — the SSO probe ──────────────────
(id-registry-test
"lookup finds a session for subject+client"
(idrnm
(idr-ev
"Me = self(),\n Reg = identity_registry:start(),\n identity_registry:register(Reg, s1, alice, web, Me),\n case identity_registry:lookup(Reg, alice, web) of\n {ok, _} -> found;\n {error, _} -> missing\n end"))
"found")
(id-registry-test
"lookup is precise: right subject, wrong client misses"
(idrnm
(idr-ev
"Me = self(),\n Reg = identity_registry:start(),\n identity_registry:register(Reg, s1, alice, web, Me),\n case identity_registry:lookup(Reg, alice, cli) of\n {ok, _} -> found;\n {error, _} -> missing\n end"))
"missing")
;; ── SSO fan-out: one subject, many clients ───────────────────────
(id-registry-test
"sessions_for returns all of a subject's sessions"
(idr-ev
"Me = self(),\n Reg = identity_registry:start(),\n identity_registry:register(Reg, s1, alice, web, Me),\n identity_registry:register(Reg, s2, alice, cli, Me),\n identity_registry:register(Reg, s3, bob, web, Me),\n case identity_registry:sessions_for(Reg, alice) of\n {ok, L} -> length(L)\n end")
2)
(id-registry-test
"sessions_for an unknown subject is empty"
(idr-ev
"Reg = identity_registry:start(),\n case identity_registry:sessions_for(Reg, ghost) of\n {ok, L} -> length(L)\n end")
0)
;; ── re-register replaces the row for that id (no duplicates) ──────
(id-registry-test
"re-registering an id does not duplicate it"
(idr-ev
"Me = self(),\n Reg = identity_registry:start(),\n identity_registry:register(Reg, s1, alice, web, Me),\n identity_registry:register(Reg, s1, alice, web, Me),\n case identity_registry:sessions_for(Reg, alice) of\n {ok, L} -> length(L)\n end")
1)
;; ── deregister removes routing ───────────────────────────────────
(id-registry-test
"deregistered session is no longer found"
(idrnm
(idr-ev
"Me = self(),\n Reg = identity_registry:start(),\n identity_registry:register(Reg, s1, alice, web, Me),\n identity_registry:deregister(Reg, s1),\n case identity_registry:whereis_session(Reg, s1) of\n {ok, _} -> found;\n {error, _} -> missing\n end"))
"missing")
;; ── integration: route to a live session and look it up ──────────
(id-registry-test
"routed-to session answers lookup as active"
(idrnm
(idr-ev
"Me = self(),\n Reg = identity_registry:start(),\n S = identity_session:start(s1, alice, web, Me, infinity),\n identity_registry:register(Reg, s1, alice, web, S),\n {ok, Pid} = identity_registry:lookup(Reg, alice, web),\n case identity_session:lookup(Pid) of\n {ok, {_,_,_,St}} -> St;\n {error, St} -> St\n end"))
"active")
(define
id-registry-test-summary
(str "registry " id-registry-test-pass "/" id-registry-test-count))

View File

@@ -0,0 +1,118 @@
;; identity/tests/session.sx — session-as-process: create, lookup,
;; touch, explicit expire, revoke, and idle-timeout self-expiry.
;; Negative paths are tested as first-class: a tombstoned session
;; answers {error, Status}, it does not go silent.
(define id-session-test-count 0)
(define id-session-test-pass 0)
(define id-session-test-fails (list))
(define
id-session-test
(fn
(name actual expected)
(set! id-session-test-count (+ id-session-test-count 1))
(if
(= actual expected)
(set! id-session-test-pass (+ id-session-test-pass 1))
(append! id-session-test-fails {:name name :expected expected :actual actual}))))
(define id-ev erlang-eval-ast)
(define idnm (fn (v) (get v :name)))
(identity-load-session!)
;; ── create + lookup ──────────────────────────────────────────────
(id-session-test
"lookup of live session is active"
(idnm
(id-ev
"Me = self(),\n S = identity_session:start(s1, alice, web, Me, infinity),\n case identity_session:lookup(S) of {ok, {_,_,_,St}} -> St end"))
"active")
(id-session-test
"lookup preserves subject"
(idnm
(id-ev
"Me = self(),\n S = identity_session:start(s1, alice, web, Me, infinity),\n case identity_session:lookup(S) of {ok, {_,Subject,_,_}} -> Subject end"))
"alice")
(id-session-test
"lookup preserves client"
(idnm
(id-ev
"Me = self(),\n S = identity_session:start(s1, alice, web, Me, infinity),\n case identity_session:lookup(S) of {ok, {_,_,Client,_}} -> Client end"))
"web")
;; ── touch keeps a live session ───────────────────────────────────
(id-session-test
"touch on live session is ok"
(idnm
(id-ev
"Me = self(),\n S = identity_session:start(s1, alice, web, Me, infinity),\n identity_session:touch(S)"))
"ok")
;; ── explicit expire ──────────────────────────────────────────────
(id-session-test
"expire then lookup is error expired"
(idnm
(id-ev
"Me = self(),\n S = identity_session:start(s1, alice, web, Me, infinity),\n identity_session:expire(S),\n case identity_session:lookup(S) of {error, St} -> St end"))
"expired")
(id-session-test
"touch on expired session is error"
(idnm
(id-ev
"Me = self(),\n S = identity_session:start(s1, alice, web, Me, infinity),\n identity_session:expire(S),\n case identity_session:touch(S) of {error, St} -> St end"))
"expired")
;; ── revoke is immediate ──────────────────────────────────────────
(id-session-test
"revoke then lookup is error revoked"
(idnm
(id-ev
"Me = self(),\n S = identity_session:start(s1, alice, web, Me, infinity),\n identity_session:revoke(S),\n case identity_session:lookup(S) of {error, St} -> St end"))
"revoked")
;; ── idle-timeout self-expiry ─────────────────────────────────────
(id-session-test
"idle timeout notifies owner"
(idnm
(id-ev
"Me = self(),\n S = identity_session:start(s1, alice, web, Me, 50),\n _ = identity_session:lookup(S),\n receive {session_expired, Sid} -> Sid end"))
"s1")
(id-session-test
"lookup after idle timeout is error expired"
(idnm
(id-ev
"Me = self(),\n S = identity_session:start(s1, alice, web, Me, 50),\n _ = identity_session:lookup(S),\n receive {session_expired, _} -> ok end,\n case identity_session:lookup(S) of {error, St} -> St end"))
"expired")
;; ── isolation: sessions are independent processes ────────────────
(id-session-test
"expiring one session leaves the other active"
(idnm
(id-ev
"Me = self(),\n A = identity_session:start(s1, alice, web, Me, infinity),\n B = identity_session:start(s2, bob, web, Me, infinity),\n identity_session:expire(A),\n case identity_session:lookup(B) of {ok, {_,_,_,St}} -> St end"))
"active")
;; ── clean stop ───────────────────────────────────────────────────
(id-session-test
"stop returns ok"
(idnm
(id-ev
"Me = self(),\n S = identity_session:start(s1, alice, web, Me, infinity),\n identity_session:stop(S)"))
"ok")
(define
id-session-test-summary
(str "session " id-session-test-pass "/" id-session-test-count))

View File

@@ -0,0 +1,81 @@
;; identity/tests/session_mgmt.sx — subject-wide session management:
;; enumerate a subject's sessions and \"log out everywhere\".
(define id-smgmt-test-count 0)
(define id-smgmt-test-pass 0)
(define id-smgmt-test-fails (list))
(define
id-smgmt-test
(fn
(name actual expected)
(set! id-smgmt-test-count (+ id-smgmt-test-count 1))
(if
(= actual expected)
(set! id-smgmt-test-pass (+ id-smgmt-test-pass 1))
(append! id-smgmt-test-fails {:name name :expected expected :actual actual}))))
(define idsm-ev erlang-eval-ast)
(define idsmnm (fn (v) (get v :name)))
(identity-load-all!)
;; ── enumerate a subject's sessions ───────────────────────────────
(id-smgmt-test
"sessions lists all of a subject's sessions"
(idsm-ev
"Svc = identity:start(),\n identity:login(Svc, alice, web, read),\n identity:login(Svc, alice, cli, read),\n length(identity:sessions(Svc, alice))")
2)
(id-smgmt-test
"sessions is empty for a subject with none"
(idsm-ev
"Svc = identity:start(),\n length(identity:sessions(Svc, stranger))")
0)
;; ── log out everywhere ───────────────────────────────────────────
(id-smgmt-test
"logout_all ends every session of the subject"
(idsmnm
(idsm-ev
"Svc = identity:start(),\n {ok, S1, _} = identity:login(Svc, alice, web, read),\n {ok, S2, _} = identity:login(Svc, alice, cli, read),\n identity:logout_all(Svc, alice),\n case {identity:session_status(Svc, S1), identity:session_status(Svc, S2)} of\n {gone, gone} -> both_gone;\n _ -> some_left\n end"))
"both_gone")
(id-smgmt-test
"after logout_all the subject has no sessions"
(idsm-ev
"Svc = identity:start(),\n identity:login(Svc, alice, web, read),\n identity:login(Svc, alice, cli, read),\n identity:logout_all(Svc, alice),\n length(identity:sessions(Svc, alice))")
0)
(id-smgmt-test
"logout_all leaves other subjects' sessions intact"
(idsm-ev
"Svc = identity:start(),\n identity:login(Svc, alice, web, read),\n identity:login(Svc, bob, web, read),\n identity:logout_all(Svc, alice),\n length(identity:sessions(Svc, bob))")
1)
(id-smgmt-test
"logout_all on an unknown subject is ok, not a crash"
(idsmnm
(idsm-ev "Svc = identity:start(),\n identity:logout_all(Svc, ghost)"))
"ok")
;; ── logout_all is audited ────────────────────────────────────────
(id-smgmt-test
"logout_all records a logout event"
(idsmnm
(idsm-ev
"Svc = identity:start(),\n identity:login(Svc, alice, web, read),\n identity:logout_all(Svc, alice),\n case identity:history(Svc, alice) of\n [login, issue, logout] -> audited;\n Other -> Other\n end"))
"audited")
(id-smgmt-test
"logout_all audits each of several sessions"
(idsm-ev
"Svc = identity:start(),\n identity:login(Svc, alice, web, read),\n identity:login(Svc, alice, cli, read),\n identity:logout_all(Svc, alice),\n length(identity:history(Svc, alice))")
6)
(define
id-smgmt-test-summary
(str "session-mgmt " id-smgmt-test-pass "/" id-smgmt-test-count))

115
lib/identity/tests/sso.sx Normal file
View File

@@ -0,0 +1,115 @@
;; identity/tests/sso.sx — silent SSO (prompt=none, OIDC §3.1.2.1) as a
;; fast-path through the authorization-code machine. One subject session,
;; many client apps; no session → login_required (a negative state, not a
;; redirect). Silently-issued codes carry the same client/redirect/PKCE
;; binding as consented codes.
(define id-sso-test-count 0)
(define id-sso-test-pass 0)
(define id-sso-test-fails (list))
(define
id-sso-test
(fn
(name actual expected)
(set! id-sso-test-count (+ id-sso-test-count 1))
(if
(= actual expected)
(set! id-sso-test-pass (+ id-sso-test-pass 1))
(append! id-sso-test-fails {:name name :expected expected :actual actual}))))
(define ids-ev erlang-eval-ast)
(define idsnm (fn (v) (get v :name)))
(identity-load-token!)
(identity-load-session!)
(identity-load-registry!)
(identity-load-oauth!)
;; ── no session → login_required ──────────────────────────────────
(id-sso-test
"silent authorize without a session is login_required"
(idsnm
(ids-ev
"O = identity_oauth:start(),\n case identity_oauth:silent_authorize(O, dashboard, uri2, read, alice, vv) of\n {code, _} -> got_code;\n {error, Why} -> Why\n end"))
"login_required")
;; ── established session → silent code ────────────────────────────
(id-sso-test
"silent authorize for the same client returns a code"
(idsnm
(ids-ev
"O = identity_oauth:start(),\n {ok, _Sid} = identity_oauth:establish(O, alice, web),\n case identity_oauth:silent_authorize(O, web, uri1, read, alice, vv) of\n {code, _} -> got_code;\n {error, Why} -> Why\n end"))
"got_code")
;; ── one session, many clients ────────────────────────────────────
(id-sso-test
"a different client gets a silent code off the same session"
(idsnm
(ids-ev
"O = identity_oauth:start(),\n {ok, _Sid} = identity_oauth:establish(O, alice, web),\n case identity_oauth:silent_authorize(O, dashboard, uri2, read, alice, vv) of\n {code, _} -> got_code;\n {error, Why} -> Why\n end"))
"got_code")
(id-sso-test
"many clients all silently authorize off one session"
(idsnm
(ids-ev
"O = identity_oauth:start(),\n {ok, _Sid} = identity_oauth:establish(O, alice, web),\n {code, _C1} = identity_oauth:silent_authorize(O, dashboard, uri2, read, alice, vv),\n {code, _C2} = identity_oauth:silent_authorize(O, mobile, uri3, read, alice, vv),\n case identity_oauth:silent_authorize(O, billing, uri4, read, alice, vv) of\n {code, _} -> got_code;\n {error, Why} -> Why\n end"))
"got_code")
;; ── full SSO → token ─────────────────────────────────────────────
(id-sso-test
"silent code exchanges to a working token"
(idsnm
(ids-ev
"O = identity_oauth:start(),\n {ok, _Sid} = identity_oauth:establish(O, alice, web),\n {code, C} = identity_oauth:silent_authorize(O, dashboard, uri2, read, alice, vv),\n {ok, A, _R} = identity_oauth:exchange(O, C, dashboard, uri2, vv),\n case identity_oauth:introspect(O, A) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"active")
(id-sso-test
"SSO token carries the subject"
(idsnm
(ids-ev
"O = identity_oauth:start(),\n {ok, _Sid} = identity_oauth:establish(O, alice, web),\n {code, C} = identity_oauth:silent_authorize(O, dashboard, uri2, read, alice, vv),\n {ok, A, _R} = identity_oauth:exchange(O, C, dashboard, uri2, vv),\n case identity_oauth:introspect(O, A) of\n {active, Subject, _, _} -> Subject\n end"))
"alice")
;; ── silent codes keep the full binding ───────────────────────────
(id-sso-test
"silent code still enforces PKCE at exchange"
(idsnm
(ids-ev
"O = identity_oauth:start(),\n {ok, _Sid} = identity_oauth:establish(O, alice, web),\n {code, C} = identity_oauth:silent_authorize(O, dashboard, uri2, read, alice, vv),\n case identity_oauth:exchange(O, C, dashboard, uri2, wrongverif) of\n {ok, _, _} -> ok;\n {error, Why} -> Why\n end"))
"invalid_grant")
(id-sso-test
"silent code still enforces client binding at exchange"
(idsnm
(ids-ev
"O = identity_oauth:start(),\n {ok, _Sid} = identity_oauth:establish(O, alice, web),\n {code, C} = identity_oauth:silent_authorize(O, dashboard, uri2, read, alice, vv),\n case identity_oauth:exchange(O, C, attacker, uri2, vv) of\n {ok, _, _} -> ok;\n {error, Why} -> Why\n end"))
"invalid_grant")
;; ── subject scoping: SSO is per subject ──────────────────────────
(id-sso-test
"another subject is still login_required"
(idsnm
(ids-ev
"O = identity_oauth:start(),\n {ok, _Sid} = identity_oauth:establish(O, alice, web),\n case identity_oauth:silent_authorize(O, dashboard, uri2, read, bob, vv) of\n {code, _} -> got_code;\n {error, Why} -> Why\n end"))
"login_required")
;; ── ending the session closes the SSO fast-path ──────────────────
(id-sso-test
"after end_session, silent authorize is login_required"
(idsnm
(ids-ev
"O = identity_oauth:start(),\n {ok, Sid} = identity_oauth:establish(O, alice, web),\n identity_oauth:end_session(O, Sid),\n case identity_oauth:silent_authorize(O, dashboard, uri2, read, alice, vv) of\n {code, _} -> got_code;\n {error, Why} -> Why\n end"))
"login_required")
(define
id-sso-test-summary
(str "sso " id-sso-test-pass "/" id-sso-test-count))

215
lib/identity/tests/token.sx Normal file
View File

@@ -0,0 +1,215 @@
;; identity/tests/token.sx — opaque tokens, grant-backed lookup, real
;; revocation, refresh-token rotation, cascading revocation, and scope
;; narrowing on refresh. The revoke-then-introspect and refresh-reuse
;; paths are the security centrepieces.
(define id-token-test-count 0)
(define id-token-test-pass 0)
(define id-token-test-fails (list))
(define
id-token-test
(fn
(name actual expected)
(set! id-token-test-count (+ id-token-test-count 1))
(if
(= actual expected)
(set! id-token-test-pass (+ id-token-test-pass 1))
(append! id-token-test-fails {:name name :expected expected :actual actual}))))
(define idt-ev erlang-eval-ast)
(define idtnm (fn (v) (get v :name)))
(identity-load-token!)
;; ── issue + introspect (happy path) ──────────────────────────────
(id-token-test
"fresh token introspects active"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n {ok, Tok} = identity_tokens:issue(Reg, alice, web, read),\n case identity_tokens:introspect(Reg, Tok) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"active")
(id-token-test
"introspect returns the granted subject"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n {ok, Tok} = identity_tokens:issue(Reg, alice, web, read),\n case identity_tokens:introspect(Reg, Tok) of\n {active, Subject, _, _} -> Subject\n end"))
"alice")
(id-token-test
"introspect returns the granted scope"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n {ok, Tok} = identity_tokens:issue(Reg, alice, web, write),\n case identity_tokens:introspect(Reg, Tok) of\n {active, _, _, Scope} -> Scope\n end"))
"write")
;; ── opacity: distinct tokens, no cross-talk ──────────────────────
(id-token-test
"two issues yield independent grants"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n {ok, A} = identity_tokens:issue(Reg, alice, web, read),\n {ok, B} = identity_tokens:issue(Reg, bob, cli, write),\n identity_tokens:revoke(Reg, A),\n case identity_tokens:introspect(Reg, B) of\n {active, Subject, _, _} -> Subject;\n {inactive} -> inactive\n end"))
"bob")
;; ── revocation is real (RFC 7009) ────────────────────────────────
(id-token-test
"revoked token introspects inactive immediately"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n {ok, Tok} = identity_tokens:issue(Reg, alice, web, read),\n active = case identity_tokens:introspect(Reg, Tok) of\n {active, _, _, _} -> active end,\n identity_tokens:revoke(Reg, Tok),\n case identity_tokens:introspect(Reg, Tok) of\n {active, _, _, _} -> still_valid;\n {inactive} -> inactive\n end"))
"inactive")
(id-token-test
"revoke is idempotent"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n {ok, Tok} = identity_tokens:issue(Reg, alice, web, read),\n identity_tokens:revoke(Reg, Tok),\n identity_tokens:revoke(Reg, Tok)"))
"ok")
;; ── unknown tokens are inactive, never an error/crash ────────────
(id-token-test
"introspecting an unknown token is inactive"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n Bogus = make_ref(),\n case identity_tokens:introspect(Reg, Bogus) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"inactive")
(id-token-test
"revoking an unknown token is ok, not a crash"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n Bogus = make_ref(),\n identity_tokens:revoke(Reg, Bogus)"))
"ok")
;; ── one revocation does not affect a sibling token ───────────────
(id-token-test
"revoking one token leaves the other active"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n {ok, A} = identity_tokens:issue(Reg, alice, web, read),\n {ok, B} = identity_tokens:issue(Reg, alice, cli, read),\n identity_tokens:revoke(Reg, A),\n case identity_tokens:introspect(Reg, B) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"active")
;; ── issue_grant: access + refresh pair (RFC 6749 §4.1.4 / §5.1) ───
(id-token-test
"issue_grant access token introspects active"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n {ok, A, _R} = identity_tokens:issue_grant(Reg, alice, web, read),\n case identity_tokens:introspect(Reg, A) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"active")
;; ── refresh rotation (RFC 6749 §6) ───────────────────────────────
(id-token-test
"refresh mints a working new access token"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n {ok, _A, R} = identity_tokens:issue_grant(Reg, alice, web, read),\n {ok, A2, _R2} = identity_tokens:refresh(Reg, R),\n case identity_tokens:introspect(Reg, A2) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"active")
(id-token-test
"rotated token keeps the grant's subject"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n {ok, _A, R} = identity_tokens:issue_grant(Reg, alice, web, read),\n {ok, A2, _R2} = identity_tokens:refresh(Reg, R),\n case identity_tokens:introspect(Reg, A2) of\n {active, Subject, _, _} -> Subject\n end"))
"alice")
(id-token-test
"refresh chains across rotations"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n {ok, _A, R} = identity_tokens:issue_grant(Reg, alice, web, read),\n {ok, _A2, R2} = identity_tokens:refresh(Reg, R),\n {ok, A3, _R3} = identity_tokens:refresh(Reg, R2),\n case identity_tokens:introspect(Reg, A3) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"active")
(id-token-test
"refreshing an unknown token is invalid_grant"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n Bogus = make_ref(),\n case identity_tokens:refresh(Reg, Bogus) of\n {ok, _, _} -> rotated;\n {error, Why} -> Why\n end"))
"invalid_grant")
;; ── refresh-token reuse = theft → revoke the family (RFC 6819) ────
(id-token-test
"reusing a superseded refresh token is invalid_grant"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n {ok, _A, R} = identity_tokens:issue_grant(Reg, alice, web, read),\n {ok, _A2, _R2} = identity_tokens:refresh(Reg, R),\n case identity_tokens:refresh(Reg, R) of\n {ok, _, _} -> rotated;\n {error, Why} -> Why\n end"))
"invalid_grant")
(id-token-test
"refresh reuse revokes the live descendant too"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n {ok, _A, R} = identity_tokens:issue_grant(Reg, alice, web, read),\n {ok, A2, _R2} = identity_tokens:refresh(Reg, R),\n identity_tokens:refresh(Reg, R),\n case identity_tokens:introspect(Reg, A2) of\n {active, _, _, _} -> still_valid;\n {inactive} -> inactive\n end"))
"inactive")
;; ── cascading revocation: revoke any token, the grant dies ───────
(id-token-test
"revoking the access token blocks refresh"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n {ok, A, R} = identity_tokens:issue_grant(Reg, alice, web, read),\n identity_tokens:revoke(Reg, A),\n case identity_tokens:refresh(Reg, R) of\n {ok, _, _} -> refreshed;\n {error, Why} -> Why\n end"))
"invalid_grant")
(id-token-test
"revoking the refresh token deactivates the access token"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n {ok, A, R} = identity_tokens:issue_grant(Reg, alice, web, read),\n identity_tokens:revoke(Reg, R),\n case identity_tokens:introspect(Reg, A) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
"inactive")
;; ── scope as a set + narrowing on refresh (RFC 6749 §6 / §3.3) ───
(id-token-test
"a list scope round-trips through introspect"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n {ok, A, _R} = identity_tokens:issue_grant(Reg, alice, web, [read, write]),\n case identity_tokens:introspect(Reg, A) of\n {active, _, _, [read, write]} -> matched;\n {active, _, _, _} -> other;\n {inactive} -> inactive\n end"))
"matched")
(id-token-test
"refresh can narrow the scope to a subset"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n {ok, _A, R} = identity_tokens:issue_grant(Reg, alice, web, [read, write]),\n {ok, A2, _R2} = identity_tokens:refresh(Reg, R, [read]),\n case identity_tokens:introspect(Reg, A2) of\n {active, _, _, [read]} -> narrowed;\n {active, _, _, _} -> other;\n {inactive} -> inactive\n end"))
"narrowed")
(id-token-test
"refresh cannot widen scope beyond the grant"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n {ok, _A, R} = identity_tokens:issue_grant(Reg, alice, web, [read]),\n case identity_tokens:refresh(Reg, R, [read, write]) of\n {ok, _, _} -> widened;\n {error, Why} -> Why\n end"))
"invalid_scope")
(id-token-test
"an invalid_scope refresh does not consume the refresh token"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n {ok, _A, R} = identity_tokens:issue_grant(Reg, alice, web, [read, write]),\n identity_tokens:refresh(Reg, R, [admin]),\n case identity_tokens:refresh(Reg, R, [read]) of\n {ok, _, _} -> still_usable;\n {error, Why} -> Why\n end"))
"still_usable")
(id-token-test
"plain refresh keeps the full grant scope"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n {ok, _A, R} = identity_tokens:issue_grant(Reg, alice, web, [read, write]),\n {ok, A2, _R2} = identity_tokens:refresh(Reg, R),\n case identity_tokens:introspect(Reg, A2) of\n {active, _, _, [read, write]} -> full;\n {active, _, _, _} -> other;\n {inactive} -> inactive\n end"))
"full")
(id-token-test
"a narrowed token still cascades on revoke"
(idtnm
(idt-ev
"Reg = identity_tokens:start(),\n {ok, _A, R} = identity_tokens:issue_grant(Reg, alice, web, [read, write]),\n {ok, A2, _R2} = identity_tokens:refresh(Reg, R, [read]),\n identity_tokens:revoke(Reg, A2),\n case identity_tokens:introspect(Reg, A2) of\n {active, _, _, _} -> still_valid;\n {inactive} -> inactive\n end"))
"inactive")
(define
id-token-test-summary
(str "token " id-token-test-pass "/" id-token-test-count))

37
lib/identity/token.sx Normal file

File diff suppressed because one or more lines are too long

View File

@@ -19,7 +19,7 @@ through the event log, all authorization questions delegated to `acl-on-sx`.
## Status (rolling)
`bash lib/identity/conformance.sh`**0/0** (not yet started)
`bash lib/identity/conformance.sh`**222/222** (4 phases + 13 ext) — needs `timeout 580`
## Ground rules
@@ -57,28 +57,221 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke)
```
## Phase 1 — Sessions + tokens
- [ ] `session.sx` — session process, create/lookup/expire
- [ ] `token.sx` — issue/introspect/revoke (opaque, grant-backed)
- [ ] `registry.sx` — route by subject/client
- [ ] `api.sx` + tests + scoreboard + conformance.sh
- [x] `session.sx` — session process, create/lookup/expire
- [x] `token.sx` — issue/introspect/revoke (opaque, grant-backed)
- [x] `registry.sx` — route by subject/client
- [x] `api.sx` + tests + scoreboard + conformance.sh
## Phase 2 — OAuth2 flows
- [ ] authorization-code flow as a message protocol
- [ ] refresh + rotation; revocation cascades to issued tokens
- [ ] tests: full code exchange, refresh, revoke-then-use (must fail)
- [x] authorization-code flow as a message protocol
- [x] refresh + rotation; revocation cascades to issued tokens
- [x] tests: full code exchange, refresh, revoke-then-use (must fail)
## Phase 3 — Silent SSO + membership
- [ ] `prompt=none` cross-app login (one session, many clients)
- [ ] membership state + per-app grant projection
- [ ] grant verification delegated cache (mirror Redis-cache pattern)
- [x] `prompt=none` cross-app login (one session, many clients)
- [x] membership state + per-app grant projection
- [x] grant verification delegated cache (mirror Redis-cache pattern)
## Phase 4 — Audit + federation
- [ ] every issue/refresh/revoke is a `persist` event; `(identity/audit subject)`
- [ ] federated identity (peer-asserted subject) — advisory, trust-gated stub
- [ ] tests: audit completeness, cross-instance subject mapping
- [x] every issue/refresh/revoke is a `persist` event; `(identity/audit subject)`
- [x] federated identity (peer-asserted subject) — advisory, trust-gated stub
- [x] tests: audit completeness, cross-instance subject mapping
## Extensions (base roadmap complete; deepen the engine)
- [~] PKCE S256 method (RFC 7636 §4.2) — BLOCKED on erlang substrate (see Blockers)
- [x] access-token TTL / `expires_in` — logical-clock expiry, introspect honours it
- [x] scope as a set + scope narrowing on refresh (RFC 6749 §6)
- [x] client registry: public vs confidential clients, client authentication (RFC 6749 §2)
- [x] client-credentials grant (RFC 6749 §4.4) + device grant (RFC 8628)
- [x] acl-on-sx delegation: identity-gates-before-acl boundary (401 vs 403), stub decider (live Datalog bridge is cross-substrate)
- [~] OAuth `state`/OIDC `nonce` — low value in this server-centric model (client-side echo); skipped
- [x] pushed authorization requests (PAR, RFC 9126): single-use request_uri → consent
- [x] dynamic client registration (RFC 7591): server-generated client_id + secret
- [x] unify `api.sx` over membership + audit (one facade, audited login/logout)
- [x] subject-wide session management: `sessions(Subject)` + `logout_all` (log out everywhere)
- [x] token exchange (RFC 8693): downscope a token into a new independent token
- [x] RFC 7662 full introspection metadata (`introspect_full`: sub/client_id/scope/exp/iat/token_type)
## Progress log
(loop fills this in)
- 2026-06-07 — dynamic client registration (ext, RFC 7591): `register_dynamic`
generates a client_id + secret server-side (make_ref each) and registers the
client, returning {ok, ClientId, Secret} — self-service onboarding distinct
from the manual register_client. A dynamic confidential client can then use
client_credentials; a dynamic public client stays unauthorized_client. New
tests/dynreg.sx (5). 217→222.
- 2026-06-07 — PAR (ext, RFC 9126): `push_authorization_request` lodges the
authorization params under a single-use `request_uri`; `authorize_pushed`
redeems it into the normal consent flow. Pushed requests reuse the pending
store (`{pushed, Rec}` keyed by the request_uri ref — distinct from consent
req_ids, no collision), so no new loop state. The pushed binding (client +
redirect + PKCE) is enforced at exchange. New tests/par.sx (7). 210→217.
- 2026-06-07 — full introspection (ext, RFC 7662 §2.2): `introspect_full`
returns {active, Subject, Client, Scope, Exp, Iat, bearer} for live tokens,
{inactive} otherwise — deepening the opaque-token/live-lookup model the
whole design rests on. Access tokens now carry `Iat` (clock-at-issue);
exp = iat + ttl. Simple `introspect` unchanged. New tests/introspect.sx (9).
201→210. NOTE: conformance now needs an explicit long timeout (>120s, 19
suites) — run with `timeout 580`.
- 2026-06-07 — token exchange (ext, RFC 8693 §2.1): `oauth.sx` gains
`token_exchange(SubjectToken, RequestedScope)` — a valid access token is
downscoped into a NEW independent grant for the same subject (subset only,
else invalid_scope; inactive subject token → invalid_grant). The new token's
lifecycle is independent (revoking either leaves the other active);
exchanges chain. Least-privilege handoff to downstream services. New
tests/exchange.sx (8). 193→201.
- 2026-06-07 — subject-wide session management (ext): `api.sx` gains
`sessions(Subject)` (enumerate) and `logout_all(Subject)` ("log out
everywhere") — revokes + deregisters every session a subject holds,
auditing a logout per session, leaving other subjects untouched. Builds on
registry.sessions_for. New tests/session_mgmt.sx (8). 185→193.
- 2026-06-07 — `delegation.sx` (ext): the identity→acl boundary made concrete.
`check` introspects the token first: inactive → `{error, unauthenticated}`
(401, acl never consulted); active → constructs {Subject, Scope, Action,
Resource} and hands off to acl, which returns permit/deny (`forbidden` =
403). 401 strictly precedes 403 (a revoked token with no scope is still
unauthenticated). acl-on-sx (Datalog) is a different SX guest language —
wired at the integration layer — so the decider here is a labelled stub
(permits when Action ∈ Scope); swap the pid, boundary unchanged. New
tests/delegation.sx (8). 177→185. **Extensions backlog clear.**
- 2026-06-07 — unified facade (ext): `api.sx` coordinator now owns an audit
ledger + a membership registry alongside its token table (started with the
ledger) and session registry. login/logout are audited; new ops
`history`/`enroll`/`member_status`/`member_project` expose the audit +
membership axes through the one `identity` door. identity proves who +
reports membership; acl still decides permission. Existing api behaviour
unchanged (10/10). New tests/facade.sx (9). 168→177.
- 2026-06-07 — `device.sx` (ext, RFC 8628): device authorization grant for
input-constrained devices. authorize → {device_code, user_code}; the human
approve/deny out-of-band by user_code; the device polls by device_code
through the §3.5 status machine (authorization_pending → access_denied /
{ok,Token}). Device code is single-use once a token issues; guarded
transitions (approve-after-deny rejected). Tokens grant-backed. Device-code
expiry + slow_down deferred (no wall clock). New tests/device.sx (10). 158→168.
- 2026-06-07 — client-credentials grant (ext, RFC 6749 §4.4): `oauth.sx` now
owns a client registry (loop/6); `register_client` + `client_credentials`.
A confidential client authenticates and gets a token acting on its own
behalf (subject = the client), no refresh token (§4.4.3). A public client is
`unauthorized_client`; any auth failure (unknown client OR wrong secret) is
`invalid_client` — no client-existence oracle (§5.2). `identity-load-oauth!`
now pulls its deps (token/session/registry/clients). New tests/grants.sx (9).
149→158.
- 2026-06-07 — `clients.sx` (ext): OAuth client registry (RFC 6749 §2). public
vs confidential clients; confidential clients MUST present the right secret
(wrong → invalid_client), public clients are identified but not
authenticated; redirect_uris are allow-listed with exact-match
`valid_redirect` (§3.1.2.2 + Security BCP). Standalone module (no oauth
wiring yet — that's a follow-up). New tests/clients.sx (11). 138→149.
- 2026-06-07 — access-token expiry (ext): logical clock in the token registry
(`advance`/`now`; no wall clock in substrate). Grants carry a Ttl; each
access token carries an Expires (Now-at-issue + Ttl, or infinity); introspect
returns inactive once `Now` reaches it. Refresh mints a fresh short-lived
access token (new Expires) — short access tokens, long refresh tokens. issue/4
+ issue_grant/4 default to infinity, so all prior tests unchanged. New
tests/expiry.sx (8). token loop/6. 130→138.
- 2026-06-07 — scope narrowing (ext): each access token now carries its own
EFFECTIVE scope (<= the grant's max). `refresh/3` requests a narrower scope;
the request must be a subset of the grant scope (RFC 6749 §6) else
`{error, invalid_scope}` and the refresh token is NOT consumed (client may
retry, §5.2). `refresh/2` keeps full scope; scope stays opaque (atom or list)
for issue, so all prior atom-scope tests pass unchanged. token 18→24, 130/130.
Also filed Blocker: PKCE S256 needs SHA256+binary compare, both broken in the
erlang substrate (binary `=:=` always true; crypto:hash ignores binary
content) — deferred, plain method stays.
- 2026-06-07 — `federation.sx`: trust-gated, advisory federated identity.
A peer 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 it may do. Cross-instance
subject mapping namespaces remote subjects by peer (`{federated, Peer,
Remote}`) so two peers' "alice" never collide, with optional explicit
aliasing. Added an audit-completeness test (mixed transition stream → no
event dropped). New tests/federation.sx (12). **Phase 4 complete — all four
phases done.** +13 → 124/124.
- 2026-06-07 — `audit.sx`: append-only grant audit ledger (an Erlang
process). `token.sx` gains `start/1(Audit)` and emits issue/refresh/revoke
events (incl. reuse-triggered revoke); `start/0` stays unaudited (no
regression — token.sx has no compile-time dep on the audit module, just
sends to a pid). Ledger queryable per subject — `audit`/`actions`/`count`/
`all`, chronological. In-memory event stream (persist-backing is a future
Erlang↔persist bridge, out of scope per loop allowance). New
tests/audit.sx (10). +10 → 111/111.
- 2026-06-07 — `cache.sx`: delegated grant-verification cache (Redis-cache
pattern) wrapping the token registry. introspect memoised; generation
invalidation keeps revocation real — any revoke/refresh bumps a generation
counter so every cached positive instantly becomes a miss and re-validates
against the live registry. A revoked token never reads valid from cache.
stats() exposes hits/misses. New tests/cache.sx (9). **Phase 3 complete.**
+9 → 101/101.
- 2026-06-07 — `membership.sx`: coop membership as a guarded state machine
(none→pending→active→lapsed⇄active, any→revoked terminal); invalid
transitions are explicit `{error, CurrentStatus}`. `project(Subject, App)`
renders the one canonical state into a per-app claim
({member,Tier,App}/{pending,App}/{lapsed,App}/{denied,App}/{non_member,App})
— identity reports what; acl decides whether. New tests/membership.sx (17).
+17 → 92/92.
- 2026-06-07 — silent SSO (`prompt=none`, OIDC §3.1.2.1): `oauth.sx` now owns
a session registry; `establish` creates a subject session, `silent_authorize`
asks "does this subject have a live session?" → mints a code (skipping
consent) bound to client+redirect+PKCE, else `login_required`. Same machine,
fast-path — one session, many clients; `end_session` closes the path.
New `tests/sso.sx` (10). +10 → 75/75.
- 2026-06-07 — `oauth.sx` refresh wiring + e2e: exchange now issues an
access+refresh pair (RFC 6749 §4.1.4/§5.1) via token.sx issue_grant; added
the refresh grant (§6) delegating to token rotation. End-to-end tests:
code-exchange→refresh→introspect, refresh-reuse rejected, and
revoke-then-refresh blocked by cascade. **Phase 2 complete.** +3 → oauth 17,
65/65.
- 2026-06-07 — `token.sx` grant-centric rewrite: refresh-token rotation
(RFC 6749 §6) + cascading revocation. The grant {Subject,Client,Scope,
Status} is the cascade unit; access + refresh tokens reference it.
`issue_grant` → {ok, Access, Refresh}; `refresh` supersedes the old
refresh + mints a new pair; reusing a superseded refresh token revokes
the whole family (RFC 6819 §5.2.2.3), killing the live descendant.
`revoke` of ANY token (access or refresh) cascades to the grant. All
prior issue/introspect/revoke behaviour preserved. +9 → token 18, 62/62.
- 2026-06-07 — `oauth.sx`: OAuth2 authorization-code flow as a message
protocol (RFC 6749 §4.1) + PKCE (RFC 7636, plain). State machine on one
authz-server process: authorize → {consent_required} → consent →
{code} → exchange → {ok, Token}. Exchange enforces single-use codes
(§10.5; removed on first attempt, replay → invalid_grant), client_id +
redirect_uri binding (§4.1.3), and PKCE verifier match. Issued tokens are
grant-backed so revocation stays real. +14 → 53/53.
- 2026-06-06 — `api.sx`: service facade. `identity:start()` spawns one
coordinator owning the token table + session registry; exposes
login/verify/revoke/logout/session_status. Coordinator is the sessions'
owner, so an expired session deregisters itself (timeout-driven, no
sweep). `verify` answers IDENTITY only ({active, Subject, Client, Scope});
permission is acl's job — explicit delegation boundary. **Phase 1 complete.**
+10 → 39/39.
- 2026-06-06 — `registry.sx`: directory process routing sessions by id and
by (subject, client). Answers the SSO probe `lookup(Subject, Client)` and
the fan-out `sessions_for(Subject)` (one subject, many clients). Routes
only — holds no grant state. Integration-tested end-to-end: register a live
session, route to it, confirm it answers active. +9 → 29/29.
- 2026-06-06 — `token.sx`: opaque grant-backed tokens. Token = `make_ref`
(carries no info); the token table is a process; `introspect` is a live
lookup every time so revocation is real (RFC 7009) — a revoked token reads
`{inactive}` on the next introspection, no validity window. Reply shapes
follow RFC 7662 §2.2 (`{active,...}` / `{inactive}`, never says why). +9 → 20/20.
- 2026-06-06 — `session.sx`: session-as-Erlang-process. create/lookup/touch/
explicit-expire/revoke as messages; idle-timeout self-expiry via
`receive ... after Ttl` notifying the owner then tombstoning. Tombstones
answer lookups with `{error, expired|revoked}` — never a silent dead
mailbox. Established the conformance harness (`conformance.sh`, scoreboard,
`tests/session.sx`). 11/11.
## Blockers
(loop fills this in)
- 2026-06-07 — **PKCE S256 blocked: erlang binary bugs.** Two substrate bugs
in `lib/erlang` make a correct/secure S256 impossible (S256 needs
`BASE64URL(SHA256(verifier))` compared against the stored challenge):
1. **Binary `=:=` always true.** `<<"v1">> =:= <<"v2">>``true`;
`<<"abc">> =:= <<"abd">>``true`. So a hash comparison can't reject a
wrong verifier.
2. **`crypto:hash` ignores binary-literal content.**
`crypto:hash(sha256, <<"v1">>)` and `crypto:hash(sha256, <<"v2">>)` return
the *identical* 32-byte digest (`6e 34 0b 9c …`), which is also ≠ the
correct SX-level `(crypto-sha256 "abc")` (`ba 78 16 bf …`). The binary
payload isn't reaching the hash. (Atom input → badarg→nil, separate issue.)
Minimal repro (epoch protocol, after loading lib/erlang/runtime.sx):
`(erlang-eval-ast "case <<\"a\">> =:= <<\"b\">> of true -> bug; false -> ok end")`
`bug`. Not in scope to fix (lib/erlang is a substrate). PKCE `plain`
remains correct and in use; S256 deferred until the binary path is fixed.