diff --git a/lib/identity/api.sx b/lib/identity/api.sx new file mode 100644 index 00000000..c4e0326b --- /dev/null +++ b/lib/identity/api.sx @@ -0,0 +1,36 @@ +;; identity/api.sx — the unified identity service facade. +;; +;; `identity:start()` spawns one coordinator that owns the whole domain: +;; an audit ledger, a grant-backed token table (wired to that ledger), a +;; session registry, and a membership registry. It exposes the +;; whole-domain operations through one door: +;; +;; login / verify / revoke / logout / session_status (sessions + tokens) +;; sessions(Subject) / logout_all(Subject) (subject-wide mgmt) +;; grants(Subject) / revoke_app(Subject, Client) (apps with access) +;; history(Subject) (audit ledger) +;; enroll / member_status / member_project (membership) +;; +;; Account-security surface, per subject: list where you're logged in +;; (sessions) and log out everywhere (logout_all); list which apps have +;; access (grants) and disconnect one (revoke_app); see what happened +;; (history). Every grant transition is audited. verify answers IDENTITY +;; only; membership projection reports WHAT a subject is for an app; +;; whether either may do a thing is acl's call. + +(define + identity-api-source + "-module(identity).\n\n start() ->\n spawn(fun () ->\n Audit = identity_audit:start(),\n TokReg = identity_tokens:start(Audit),\n SessReg = identity_registry:start(),\n Members = identity_membership:start(),\n loop(TokReg, SessReg, Audit, Members, 1)\n end).\n\n login(Svc, Subject, Client, Scope) ->\n login(Svc, Subject, Client, Scope, infinity).\n\n login(Svc, Subject, Client, Scope, Ttl) ->\n Svc ! {login, Subject, Client, Scope, Ttl, self()},\n receive {identity_reply, R} -> R end.\n\n verify(Svc, Token) ->\n Svc ! {verify, Token, self()},\n receive {identity_reply, R} -> R end.\n\n revoke(Svc, Token) ->\n Svc ! {revoke, Token, self()},\n receive {identity_reply, R} -> R end.\n\n logout(Svc, SessionId) ->\n Svc ! {logout, SessionId, self()},\n receive {identity_reply, R} -> R end.\n\n logout_all(Svc, Subject) ->\n Svc ! {logout_all, Subject, self()},\n receive {identity_reply, R} -> R end.\n\n sessions(Svc, Subject) ->\n Svc ! {sessions, Subject, self()},\n receive {identity_reply, R} -> R end.\n\n grants(Svc, Subject) ->\n Svc ! {grants, Subject, self()},\n receive {identity_reply, R} -> R end.\n\n revoke_app(Svc, Subject, Client) ->\n Svc ! {revoke_app, Subject, Client, self()},\n receive {identity_reply, R} -> R end.\n\n session_status(Svc, SessionId) ->\n Svc ! {session_status, SessionId, self()},\n receive {identity_reply, R} -> R end.\n\n history(Svc, Subject) ->\n Svc ! {history, Subject, self()},\n receive {identity_reply, R} -> R end.\n\n enroll(Svc, Subject, Tier) ->\n Svc ! {enroll, Subject, Tier, self()},\n receive {identity_reply, R} -> R end.\n\n member_status(Svc, Subject) ->\n Svc ! {member_status, Subject, self()},\n receive {identity_reply, R} -> R end.\n\n member_project(Svc, Subject, App) ->\n Svc ! {member_project, Subject, App, self()},\n receive {identity_reply, R} -> R end.\n\n loop(TokReg, SessReg, Audit, Members, NextId) ->\n receive\n {login, Subject, Client, Scope, Ttl, From} ->\n SessionId = NextId,\n Self = self(),\n S = identity_session:start(SessionId, Subject, Client, Self, Ttl),\n identity_registry:register(SessReg, SessionId, Subject, Client, S),\n identity_audit:record(Audit, Subject, login),\n {ok, Token} = identity_tokens:issue(TokReg, Subject, Client, Scope),\n From ! {identity_reply, {ok, SessionId, Token}},\n loop(TokReg, SessReg, Audit, Members, NextId + 1);\n {verify, Token, From} ->\n From ! {identity_reply, identity_tokens:introspect(TokReg, Token)},\n loop(TokReg, SessReg, Audit, Members, NextId);\n {revoke, Token, From} ->\n identity_tokens:revoke(TokReg, Token),\n From ! {identity_reply, ok},\n loop(TokReg, SessReg, Audit, Members, NextId);\n {logout, SessionId, From} ->\n case identity_registry:whereis_session(SessReg, SessionId) of\n {ok, Pid} ->\n audit_logout(Audit, Pid),\n identity_session:revoke(Pid);\n {error, _} -> ok\n end,\n identity_registry:deregister(SessReg, SessionId),\n From ! {identity_reply, ok},\n loop(TokReg, SessReg, Audit, Members, NextId);\n {logout_all, Subject, From} ->\n case identity_registry:sessions_for(SessReg, Subject) of\n {ok, Ids} -> logout_each(SessReg, Audit, Ids)\n end,\n From ! {identity_reply, ok},\n loop(TokReg, SessReg, Audit, Members, NextId);\n {sessions, Subject, From} ->\n case identity_registry:sessions_for(SessReg, Subject) of\n {ok, Ids} -> From ! {identity_reply, Ids}\n end,\n loop(TokReg, SessReg, Audit, Members, NextId);\n {grants, Subject, From} ->\n From ! {identity_reply, identity_tokens:grants_for(TokReg, Subject)},\n loop(TokReg, SessReg, Audit, Members, NextId);\n {revoke_app, Subject, Client, From} ->\n identity_tokens:revoke_app(TokReg, Subject, Client),\n From ! {identity_reply, ok},\n loop(TokReg, SessReg, Audit, Members, NextId);\n {session_status, SessionId, From} ->\n R = case identity_registry:whereis_session(SessReg, SessionId) of\n {ok, Pid} ->\n case identity_session:lookup(Pid) of\n {ok, {_, _, _, St}} -> St;\n {error, St} -> St\n end;\n {error, _} -> gone\n end,\n From ! {identity_reply, R},\n loop(TokReg, SessReg, Audit, Members, NextId);\n {history, Subject, From} ->\n From ! {identity_reply, identity_audit:actions(Audit, Subject)},\n loop(TokReg, SessReg, Audit, Members, NextId);\n {enroll, Subject, Tier, From} ->\n identity_membership:request(Members, Subject, Tier),\n identity_membership:approve(Members, Subject),\n From ! {identity_reply, ok},\n loop(TokReg, SessReg, Audit, Members, NextId);\n {member_status, Subject, From} ->\n From ! {identity_reply, identity_membership:status(Members, Subject)},\n loop(TokReg, SessReg, Audit, Members, NextId);\n {member_project, Subject, App, From} ->\n From ! {identity_reply, identity_membership:project(Members, Subject, App)},\n loop(TokReg, SessReg, Audit, Members, NextId);\n {session_expired, SessionId} ->\n identity_registry:deregister(SessReg, SessionId),\n loop(TokReg, SessReg, Audit, Members, NextId)\n end.\n\n logout_each(_, _, []) -> ok;\n logout_each(SessReg, Audit, [Sid | Rest]) ->\n case identity_registry:whereis_session(SessReg, Sid) of\n {ok, Pid} ->\n audit_logout(Audit, Pid),\n identity_session:revoke(Pid);\n {error, _} -> ok\n end,\n identity_registry:deregister(SessReg, Sid),\n logout_each(SessReg, Audit, Rest).\n\n audit_logout(Audit, Pid) ->\n case identity_session:lookup(Pid) of\n {ok, {_, Subject, _, _}} -> identity_audit:record(Audit, Subject, logout);\n {error, _} -> ok\n end.") + +(define identity-load-api! (fn () (erlang-load-module identity-api-source))) + +(define + identity-load-all! + (fn + () + (identity-load-session!) + (identity-load-token!) + (identity-load-registry!) + (identity-load-audit!) + (identity-load-membership!) + (identity-load-api!))) diff --git a/lib/identity/audit.sx b/lib/identity/audit.sx new file mode 100644 index 00000000..2e0f25b5 --- /dev/null +++ b/lib/identity/audit.sx @@ -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))) diff --git a/lib/identity/cache.sx b/lib/identity/cache.sx new file mode 100644 index 00000000..4ccc59fd --- /dev/null +++ b/lib/identity/cache.sx @@ -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))) diff --git a/lib/identity/clients.sx b/lib/identity/clients.sx new file mode 100644 index 00000000..5bf41408 --- /dev/null +++ b/lib/identity/clients.sx @@ -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))) diff --git a/lib/identity/conformance.sh b/lib/identity/conformance.sh new file mode 100755 index 00000000..f247cf76 --- /dev/null +++ b/lib/identity/conformance.sh @@ -0,0 +1,215 @@ +#!/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" + "account|id-acct-test-pass|id-acct-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") +(load "lib/identity/tests/account.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)") +(epoch 121) +(eval "(list id-acct-test-pass id-acct-test-count)") +EPOCHS + +timeout 1200 "$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 < lib/identity/scoreboard.md < 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))) diff --git a/lib/identity/device.sx b/lib/identity/device.sx new file mode 100644 index 00000000..7202d8f3 --- /dev/null +++ b/lib/identity/device.sx @@ -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))) diff --git a/lib/identity/federation.sx b/lib/identity/federation.sx new file mode 100644 index 00000000..d6ac9bda --- /dev/null +++ b/lib/identity/federation.sx @@ -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))) diff --git a/lib/identity/membership.sx b/lib/identity/membership.sx new file mode 100644 index 00000000..3c249b2f --- /dev/null +++ b/lib/identity/membership.sx @@ -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))) diff --git a/lib/identity/oauth.sx b/lib/identity/oauth.sx new file mode 100644 index 00000000..8ae4c487 --- /dev/null +++ b/lib/identity/oauth.sx @@ -0,0 +1,37 @@ +;; identity/oauth.sx — the OAuth2 authorization server as a message +;; protocol. Grants: authorization-code (RFC 6749 §4.1) with PKCE (RFC +;; 7636, `plain`), refresh (§6), silent `prompt=none` (OIDC §3.1.2.1), +;; client-credentials (§4.4), token exchange (RFC 8693), and pushed +;; authorization requests (PAR, RFC 9126). Clients may be registered +;; manually or self-service (dynamic client registration, RFC 7591). +;; +;; The authz-code flow is a state machine on one process: +;; authorize -> {consent_required, ReqId} (§4.1.1) +;; push_authorization_request -> {ok, RequestUri} (PAR §2.1) +;; authorize_pushed -> {consent_required, ReqId} | {error, invalid_request_uri} +;; consent -> {code, Code} | {error, access_denied} +;; exchange -> {ok, Access, Refresh} | {error, invalid_grant} +;; refresh -> {ok, Access, Refresh} | {error, invalid_grant} +;; establish -> {ok, SessionId} (interactive login = a session) +;; silent_authorize -> {code, Code} | {error, login_required} +;; register_client -> ok | {error, exists} (manual) +;; register_dynamic -> {ok, ClientId, Secret} (RFC 7591) +;; client_credentials -> {ok, Token} | {error, invalid_client|unauthorized_client} +;; token_exchange -> {ok, Token} | {error, invalid_grant|invalid_scope} +;; +;; Tokens are grant-backed (token.sx); revocation cascades. The server +;; proves identity; acl decides permission. + +(define + identity-oauth-source + "-module(identity_oauth).\n\n start() ->\n spawn(fun () ->\n TokReg = identity_tokens:start(),\n SessReg = identity_registry:start(),\n ClientReg = identity_clients:start(),\n loop(TokReg, SessReg, ClientReg, [], [], 1)\n end).\n\n authorize(O, ClientId, RedirectUri, Scope, Subject, Challenge) ->\n O ! {authorize, ClientId, RedirectUri, Scope, Subject, Challenge, self()},\n receive {oauth_reply, R} -> R end.\n\n push_authorization_request(O, ClientId, RedirectUri, Scope, Subject, Challenge) ->\n O ! {par_push, ClientId, RedirectUri, Scope, Subject, Challenge, self()},\n receive {oauth_reply, R} -> R end.\n\n authorize_pushed(O, RequestUri) ->\n O ! {par_authorize, RequestUri, self()},\n receive {oauth_reply, R} -> R end.\n\n consent(O, ReqId, Decision) ->\n O ! {consent, ReqId, Decision, self()},\n receive {oauth_reply, R} -> R end.\n\n exchange(O, Code, ClientId, RedirectUri, Verifier) ->\n O ! {exchange, Code, ClientId, RedirectUri, Verifier, self()},\n receive {oauth_reply, R} -> R end.\n\n refresh(O, RefreshTok) ->\n O ! {refresh, RefreshTok, self()},\n receive {oauth_reply, R} -> R end.\n\n establish(O, Subject, Client) ->\n O ! {establish, Subject, Client, self()},\n receive {oauth_reply, R} -> R end.\n\n silent_authorize(O, ClientId, RedirectUri, Scope, Subject, Challenge) ->\n O ! {silent_authorize, ClientId, RedirectUri, Scope, Subject, Challenge, self()},\n receive {oauth_reply, R} -> R end.\n\n end_session(O, SessionId) ->\n O ! {end_session, SessionId, self()},\n receive {oauth_reply, R} -> R end.\n\n register_client(O, ClientId, Type, Secret, RedirectUris) ->\n O ! {register_client, ClientId, Type, Secret, RedirectUris, self()},\n receive {oauth_reply, R} -> R end.\n\n register_dynamic(O, Type, RedirectUris) ->\n O ! {register_dynamic, Type, RedirectUris, self()},\n receive {oauth_reply, R} -> R end.\n\n client_credentials(O, ClientId, Secret, Scope) ->\n O ! {client_credentials, ClientId, Secret, Scope, self()},\n receive {oauth_reply, R} -> R end.\n\n token_exchange(O, SubjectToken, RequestedScope) ->\n O ! {token_exchange, SubjectToken, RequestedScope, self()},\n receive {oauth_reply, R} -> R end.\n\n introspect(O, Token) ->\n O ! {introspect, Token, self()},\n receive {oauth_reply, R} -> R end.\n\n revoke(O, Token) ->\n O ! {revoke, Token, self()},\n receive {oauth_reply, R} -> R end.\n\n loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid) ->\n receive\n {authorize, ClientId, RedirectUri, Scope, Subject, Challenge, From} ->\n ReqId = make_ref(),\n Rec = {ClientId, RedirectUri, Scope, Subject, Challenge},\n From ! {oauth_reply, {consent_required, ReqId}},\n loop(TokReg, SessReg, ClientReg, [{ReqId, Rec} | Pending], Codes, NextSid);\n {par_push, ClientId, RedirectUri, Scope, Subject, Challenge, From} ->\n RequestUri = make_ref(),\n Rec = {ClientId, RedirectUri, Scope, Subject, Challenge},\n From ! {oauth_reply, {ok, RequestUri}},\n loop(TokReg, SessReg, ClientReg, [{RequestUri, {pushed, Rec}} | Pending], Codes, NextSid);\n {par_authorize, RequestUri, From} ->\n case find(RequestUri, Pending) of\n {ok, {pushed, Rec}} ->\n ReqId = make_ref(),\n From ! {oauth_reply, {consent_required, ReqId}},\n loop(TokReg, SessReg, ClientReg,\n [{ReqId, Rec} | remove(RequestUri, Pending)], Codes, NextSid);\n Other ->\n From ! {oauth_reply, {error, invalid_request_uri}},\n loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid)\n end;\n {consent, ReqId, Decision, From} ->\n case find(ReqId, Pending) of\n none ->\n From ! {oauth_reply, {error, unknown_request}},\n loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid);\n {ok, Rec} ->\n Pending2 = remove(ReqId, Pending),\n case Decision of\n allow ->\n Code = make_ref(),\n From ! {oauth_reply, {code, Code}},\n loop(TokReg, SessReg, ClientReg, Pending2, [{Code, Rec} | Codes], NextSid);\n deny ->\n From ! {oauth_reply, {error, access_denied}},\n loop(TokReg, SessReg, ClientReg, Pending2, Codes, NextSid)\n end\n end;\n {establish, Subject, Client, From} ->\n Sid = NextSid,\n Self = self(),\n S = identity_session:start(Sid, Subject, Client, Self, infinity),\n identity_registry:register(SessReg, Sid, Subject, Client, S),\n From ! {oauth_reply, {ok, Sid}},\n loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid + 1);\n {silent_authorize, ClientId, RedirectUri, Scope, Subject, Challenge, From} ->\n case subject_active(SessReg, Subject) of\n false ->\n From ! {oauth_reply, {error, login_required}},\n loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid);\n true ->\n Code = make_ref(),\n Rec = {ClientId, RedirectUri, Scope, Subject, Challenge},\n From ! {oauth_reply, {code, Code}},\n loop(TokReg, SessReg, ClientReg, Pending, [{Code, Rec} | Codes], NextSid)\n end;\n {end_session, Sid, From} ->\n case identity_registry:whereis_session(SessReg, Sid) of\n {ok, Pid} -> identity_session:revoke(Pid);\n {error, _} -> ok\n end,\n identity_registry:deregister(SessReg, Sid),\n From ! {oauth_reply, ok},\n loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid);\n {register_client, ClientId, Type, Secret, RedirectUris, From} ->\n From ! {oauth_reply, identity_clients:register(ClientReg, ClientId, Type, Secret, RedirectUris)},\n loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid);\n {register_dynamic, Type, RedirectUris, From} ->\n ClientId = make_ref(),\n Secret = make_ref(),\n identity_clients:register(ClientReg, ClientId, Type, Secret, RedirectUris),\n From ! {oauth_reply, {ok, ClientId, Secret}},\n loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid);\n {client_credentials, ClientId, Secret, Scope, From} ->\n case identity_clients:authenticate(ClientReg, ClientId, Secret) of\n {ok, confidential} ->\n {ok, Token} = identity_tokens:issue(TokReg, ClientId, ClientId, Scope),\n From ! {oauth_reply, {ok, Token}};\n {ok, public} ->\n From ! {oauth_reply, {error, unauthorized_client}};\n {error, _} ->\n From ! {oauth_reply, {error, invalid_client}}\n end,\n loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid);\n {token_exchange, SubjectToken, RequestedScope, From} ->\n case identity_tokens:introspect(TokReg, SubjectToken) of\n {inactive} ->\n From ! {oauth_reply, {error, invalid_grant}};\n {active, Subject, Client, Scope} ->\n case subset(RequestedScope, Scope) of\n true ->\n {ok, NewTok} = identity_tokens:issue(TokReg, Subject, Client, RequestedScope),\n From ! {oauth_reply, {ok, NewTok}};\n false ->\n From ! {oauth_reply, {error, invalid_scope}}\n end\n end,\n loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid);\n {exchange, Code, ClientId, RedirectUri, Verifier, From} ->\n case find(Code, Codes) of\n none ->\n From ! {oauth_reply, {error, invalid_grant}},\n loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid);\n {ok, Rec} ->\n Codes2 = remove(Code, Codes),\n From ! {oauth_reply, redeem(TokReg, Rec, ClientId, RedirectUri, Verifier)},\n loop(TokReg, SessReg, ClientReg, Pending, Codes2, NextSid)\n end;\n {refresh, RTok, From} ->\n From ! {oauth_reply, identity_tokens:refresh(TokReg, RTok)},\n loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid);\n {introspect, Token, From} ->\n From ! {oauth_reply, identity_tokens:introspect(TokReg, Token)},\n loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid);\n {revoke, Token, From} ->\n identity_tokens:revoke(TokReg, Token),\n From ! {oauth_reply, ok},\n loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid)\n end.\n\n subject_active(SessReg, Subject) ->\n case identity_registry:sessions_for(SessReg, Subject) of\n {ok, Ids} -> any_active(SessReg, Ids)\n end.\n\n any_active(_, []) -> false;\n any_active(SessReg, [Id | Rest]) ->\n case identity_registry:whereis_session(SessReg, Id) of\n {ok, Pid} ->\n case identity_session:lookup(Pid) of\n {ok, _} -> true;\n {error, _} -> any_active(SessReg, Rest)\n end;\n {error, _} -> any_active(SessReg, Rest)\n end.\n\n redeem(TokReg, {CCid, CRedir, Scope, Subject, Challenge}, ClientId, RedirectUri, Verifier) ->\n case CCid =:= ClientId of\n false -> {error, invalid_grant};\n true ->\n case CRedir =:= RedirectUri of\n false -> {error, invalid_grant};\n true ->\n case Challenge =:= Verifier of\n false -> {error, invalid_grant};\n true -> identity_tokens:issue_grant(TokReg, Subject, ClientId, Scope)\n end\n end\n end.\n\n subset([], _) -> true;\n subset([X | Rest], Granted) ->\n case member(X, Granted) of\n true -> subset(Rest, Granted);\n false -> false\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, Rec} | Rest]) ->\n case K =:= Key of\n true -> {ok, Rec};\n false -> find(Key, Rest)\n end.\n\n remove(_, []) -> [];\n remove(Key, [{K, Rec} | Rest]) ->\n case K =:= Key of\n true -> remove(Key, Rest);\n false -> [{K, Rec} | remove(Key, Rest)]\n end.") + +(define + identity-load-oauth! + (fn + () + (identity-load-token!) + (identity-load-session!) + (identity-load-registry!) + (identity-load-clients!) + (erlang-load-module identity-oauth-source))) diff --git a/lib/identity/registry.sx b/lib/identity/registry.sx new file mode 100644 index 00000000..60313f4d --- /dev/null +++ b/lib/identity/registry.sx @@ -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))) diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json new file mode 100644 index 00000000..65954b0f --- /dev/null +++ b/lib/identity/scoreboard.json @@ -0,0 +1,29 @@ +{ + "language": "identity", + "total_pass": 233, + "total": 233, + "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"}, + {"name":"account","pass":11,"total":11,"status":"ok"} + ] +} diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md new file mode 100644 index 00000000..f2713aef --- /dev/null +++ b/lib/identity/scoreboard.md @@ -0,0 +1,31 @@ +# identity-on-sx Scoreboard + +**Total: 233 / 233 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 | +| ✅ | account | 11 | 11 | + + +Generated by `lib/identity/conformance.sh`. diff --git a/lib/identity/session.sx b/lib/identity/session.sx new file mode 100644 index 00000000..38265c6e --- /dev/null +++ b/lib/identity/session.sx @@ -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))) diff --git a/lib/identity/tests/account.sx b/lib/identity/tests/account.sx new file mode 100644 index 00000000..6facaefd --- /dev/null +++ b/lib/identity/tests/account.sx @@ -0,0 +1,102 @@ +;; identity/tests/account.sx — the account-security surface: \"apps with +;; access\" (grants_for / identity:grants) plus \"disconnect this app\" +;; (revoke_app / identity:revoke_app). Completes the per-subject view+action +;; pair alongside sessions and history. + +(define id-acct-test-count 0) +(define id-acct-test-pass 0) +(define id-acct-test-fails (list)) + +(define + id-acct-test + (fn + (name actual expected) + (set! id-acct-test-count (+ id-acct-test-count 1)) + (if + (= actual expected) + (set! id-acct-test-pass (+ id-acct-test-pass 1)) + (append! id-acct-test-fails {:name name :expected expected :actual actual})))) + +(define ida-ev erlang-eval-ast) +(define idanm (fn (v) (get v :name))) + +(identity-load-all!) + +;; ── token-level grants_for ─────────────────────────────────────── + +(id-acct-test + "grants_for lists a subject's active grants" + (ida-ev + "R = identity_tokens:start(),\n identity_tokens:issue(R, alice, web, read),\n identity_tokens:issue(R, alice, cli, write),\n identity_tokens:issue(R, bob, web, read),\n length(identity_tokens:grants_for(R, alice))") + 2) + +(id-acct-test + "grants_for excludes revoked grants" + (ida-ev + "R = identity_tokens:start(),\n {ok, A} = identity_tokens:issue(R, alice, web, read),\n identity_tokens:issue(R, alice, cli, write),\n identity_tokens:revoke(R, A),\n length(identity_tokens:grants_for(R, alice))") + 1) + +(id-acct-test + "grants_for is empty for a subject with none" + (ida-ev + "R = identity_tokens:start(),\n identity_tokens:issue(R, alice, web, read),\n length(identity_tokens:grants_for(R, ghost))") + 0) + +(id-acct-test + "each grant entry carries the client" + (idanm + (ida-ev + "R = identity_tokens:start(),\n identity_tokens:issue(R, alice, web, read),\n case identity_tokens:grants_for(R, alice) of\n [{Client, _Scope}] -> Client;\n _ -> other\n end")) + "web") + +;; ── token-level revoke_app (\"disconnect this app\") ──────────────── + +(id-acct-test + "revoke_app revokes all of a subject's grants for one client" + (ida-ev + "R = identity_tokens:start(),\n identity_tokens:issue(R, alice, web, read),\n identity_tokens:issue(R, alice, web, write),\n identity_tokens:issue(R, alice, cli, read),\n identity_tokens:revoke_app(R, alice, web),\n length(identity_tokens:grants_for(R, alice))") + 1) + +(id-acct-test + "revoke_app deactivates that client's tokens" + (idanm + (ida-ev + "R = identity_tokens:start(),\n {ok, T} = identity_tokens:issue(R, alice, web, read),\n identity_tokens:revoke_app(R, alice, web),\n case identity_tokens:introspect(R, T) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end")) + "inactive") + +(id-acct-test + "revoke_app leaves another subject's same-client grant intact" + (ida-ev + "R = identity_tokens:start(),\n identity_tokens:issue(R, alice, web, read),\n identity_tokens:issue(R, bob, web, read),\n identity_tokens:revoke_app(R, alice, web),\n length(identity_tokens:grants_for(R, bob))") + 1) + +;; ── facade-level grants + revoke_app ───────────────────────────── + +(id-acct-test + "identity:grants lists apps a subject has logged into" + (ida-ev + "Svc = identity:start(),\n identity:login(Svc, alice, web, read),\n identity:login(Svc, alice, mobile, read),\n length(identity:grants(Svc, alice))") + 2) + +(id-acct-test + "identity:revoke_app disconnects one app, leaving the rest" + (ida-ev + "Svc = identity:start(),\n identity:login(Svc, alice, web, read),\n identity:login(Svc, alice, mobile, read),\n identity:revoke_app(Svc, alice, web),\n length(identity:grants(Svc, alice))") + 1) + +(id-acct-test + "identity:grants is per-subject" + (ida-ev + "Svc = identity:start(),\n identity:login(Svc, alice, web, read),\n identity:login(Svc, bob, web, read),\n length(identity:grants(Svc, bob))") + 1) + +(id-acct-test + "revoke_app is audited as a revoke" + (idanm + (ida-ev + "Svc = identity:start(),\n identity:login(Svc, alice, web, read),\n identity:revoke_app(Svc, alice, web),\n case identity:history(Svc, alice) of\n [login, issue, revoke] -> audited;\n Other -> Other\n end")) + "audited") + +(define + id-acct-test-summary + (str "account " id-acct-test-pass "/" id-acct-test-count)) diff --git a/lib/identity/tests/api.sx b/lib/identity/tests/api.sx new file mode 100644 index 00000000..e16a9d10 --- /dev/null +++ b/lib/identity/tests/api.sx @@ -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)) diff --git a/lib/identity/tests/audit.sx b/lib/identity/tests/audit.sx new file mode 100644 index 00000000..b246f1af --- /dev/null +++ b/lib/identity/tests/audit.sx @@ -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)) diff --git a/lib/identity/tests/cache.sx b/lib/identity/tests/cache.sx new file mode 100644 index 00000000..12092387 --- /dev/null +++ b/lib/identity/tests/cache.sx @@ -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)) diff --git a/lib/identity/tests/clients.sx b/lib/identity/tests/clients.sx new file mode 100644 index 00000000..e071446d --- /dev/null +++ b/lib/identity/tests/clients.sx @@ -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)) diff --git a/lib/identity/tests/delegation.sx b/lib/identity/tests/delegation.sx new file mode 100644 index 00000000..9665bb0b --- /dev/null +++ b/lib/identity/tests/delegation.sx @@ -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)) diff --git a/lib/identity/tests/device.sx b/lib/identity/tests/device.sx new file mode 100644 index 00000000..46728de4 --- /dev/null +++ b/lib/identity/tests/device.sx @@ -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)) diff --git a/lib/identity/tests/dynreg.sx b/lib/identity/tests/dynreg.sx new file mode 100644 index 00000000..065efcf7 --- /dev/null +++ b/lib/identity/tests/dynreg.sx @@ -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)) diff --git a/lib/identity/tests/exchange.sx b/lib/identity/tests/exchange.sx new file mode 100644 index 00000000..28faee37 --- /dev/null +++ b/lib/identity/tests/exchange.sx @@ -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)) diff --git a/lib/identity/tests/expiry.sx b/lib/identity/tests/expiry.sx new file mode 100644 index 00000000..8f16de04 --- /dev/null +++ b/lib/identity/tests/expiry.sx @@ -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)) diff --git a/lib/identity/tests/facade.sx b/lib/identity/tests/facade.sx new file mode 100644 index 00000000..cf5bcc06 --- /dev/null +++ b/lib/identity/tests/facade.sx @@ -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)) diff --git a/lib/identity/tests/federation.sx b/lib/identity/tests/federation.sx new file mode 100644 index 00000000..3ffddb1f --- /dev/null +++ b/lib/identity/tests/federation.sx @@ -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)) diff --git a/lib/identity/tests/grants.sx b/lib/identity/tests/grants.sx new file mode 100644 index 00000000..ff64afd1 --- /dev/null +++ b/lib/identity/tests/grants.sx @@ -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)) diff --git a/lib/identity/tests/introspect.sx b/lib/identity/tests/introspect.sx new file mode 100644 index 00000000..8cfbe545 --- /dev/null +++ b/lib/identity/tests/introspect.sx @@ -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)) diff --git a/lib/identity/tests/membership.sx b/lib/identity/tests/membership.sx new file mode 100644 index 00000000..7c70ef9e --- /dev/null +++ b/lib/identity/tests/membership.sx @@ -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)) diff --git a/lib/identity/tests/oauth.sx b/lib/identity/tests/oauth.sx new file mode 100644 index 00000000..6160331e --- /dev/null +++ b/lib/identity/tests/oauth.sx @@ -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)) diff --git a/lib/identity/tests/par.sx b/lib/identity/tests/par.sx new file mode 100644 index 00000000..4923cae1 --- /dev/null +++ b/lib/identity/tests/par.sx @@ -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)) diff --git a/lib/identity/tests/registry.sx b/lib/identity/tests/registry.sx new file mode 100644 index 00000000..27dabd7a --- /dev/null +++ b/lib/identity/tests/registry.sx @@ -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)) diff --git a/lib/identity/tests/session.sx b/lib/identity/tests/session.sx new file mode 100644 index 00000000..b30bfeb5 --- /dev/null +++ b/lib/identity/tests/session.sx @@ -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)) diff --git a/lib/identity/tests/session_mgmt.sx b/lib/identity/tests/session_mgmt.sx new file mode 100644 index 00000000..4631eb7e --- /dev/null +++ b/lib/identity/tests/session_mgmt.sx @@ -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)) diff --git a/lib/identity/tests/sso.sx b/lib/identity/tests/sso.sx new file mode 100644 index 00000000..0f8d3a61 --- /dev/null +++ b/lib/identity/tests/sso.sx @@ -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)) diff --git a/lib/identity/tests/token.sx b/lib/identity/tests/token.sx new file mode 100644 index 00000000..caf85612 --- /dev/null +++ b/lib/identity/tests/token.sx @@ -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)) diff --git a/lib/identity/token.sx b/lib/identity/token.sx new file mode 100644 index 00000000..dbeda3ec --- /dev/null +++ b/lib/identity/token.sx @@ -0,0 +1,40 @@ +;; identity/token.sx — opaque, grant-backed tokens with refresh-token +;; rotation (RFC 6749 §6, RFC 6819 §5.2.2.3), cascading revocation, scope +;; narrowing (RFC 6749 §6 / §3.3), access-token expiry (§4.2.2 expires_in), +;; full introspection metadata (RFC 7662 §2.2), per-subject grant listing +;; (\"apps with access\"), and per-app revocation (\"disconnect this app\"). +;; +;; The grant is the unit of authorization and the unit of cascade: an +;; access token and a refresh token both reference a grant {Subject, +;; Client, Scope, Status, Ttl}. Tokens are opaque handles (make_ref); every +;; introspection is a live lookup against the grant AND the access token's +;; own expiry, so revocation is real (RFC 7009) and an expired token reads +;; inactive. Revoking ANY token of a grant cascades to the whole grant; +;; `revoke_app(Subject, Client)` revokes every grant a subject holds for a +;; given client at once. +;; +;; Expiry uses a LOGICAL clock — the substrate has no wall clock. The +;; registry holds `Now`; `advance(Reg, N)` moves it forward. Each access +;; token carries `Expires` and `Iat`. introspect returns inactive once Now +;; reaches Expires; refresh mints a fresh access token with new Iat/Expires. +;; +;; introspect reply shapes (RFC 7662 §2.2): +;; introspect(Tok) -> {active, Subject, Client, Scope} | {inactive} +;; introspect_full(Tok) -> {active, Subject, Client, Scope, Exp, Iat, bearer} +;; | {inactive} +;; grants_for(Subject) -> [{Client, Scope}, ...] (active grants only) +;; +;; State threaded through loop/6: +;; Grants : [{Gid, {Subject, Client, Scope, active|revoked, Ttl}}] +;; Access : [{AccessTok, {Gid, EffectiveScope, Expires, Iat}}] +;; Refresh : [{RefreshTok, {Gid, current|superseded}}] +;; Now : logical clock (integer) +;; Audit : an identity_audit pid, or the atom none + +(define + identity-token-source + "-module(identity_tokens).\n\n start() ->\n start(none).\n\n start(Audit) ->\n spawn(fun () -> loop([], [], [], 1, 0, Audit) end).\n\n issue(Reg, Subject, Client, Scope) ->\n issue(Reg, Subject, Client, Scope, infinity).\n\n issue(Reg, Subject, Client, Scope, Ttl) ->\n Reg ! {issue, Subject, Client, Scope, Ttl, self()},\n receive {token_reply, R} -> R end.\n\n issue_grant(Reg, Subject, Client, Scope) ->\n issue_grant(Reg, Subject, Client, Scope, infinity).\n\n issue_grant(Reg, Subject, Client, Scope, Ttl) ->\n Reg ! {issue_grant, Subject, Client, Scope, Ttl, self()},\n receive {token_reply, R} -> R end.\n\n refresh(Reg, RefreshTok) ->\n Reg ! {refresh, RefreshTok, self()},\n receive {token_reply, R} -> R end.\n\n refresh(Reg, RefreshTok, Scope) ->\n Reg ! {refresh_scoped, RefreshTok, Scope, self()},\n receive {token_reply, R} -> R end.\n\n introspect(Reg, Token) ->\n Reg ! {introspect, Token, self()},\n receive {token_reply, R} -> R end.\n\n introspect_full(Reg, Token) ->\n Reg ! {introspect_full, Token, self()},\n receive {token_reply, R} -> R end.\n\n grants_for(Reg, Subject) ->\n Reg ! {grants_for, Subject, self()},\n receive {token_reply, R} -> R end.\n\n revoke(Reg, Token) ->\n Reg ! {revoke, Token, self()},\n receive {token_reply, R} -> R end.\n\n revoke_app(Reg, Subject, Client) ->\n Reg ! {revoke_app, Subject, Client, self()},\n receive {token_reply, R} -> R end.\n\n advance(Reg, N) ->\n Reg ! {advance, N, self()},\n receive {token_reply, R} -> R end.\n\n now(Reg) ->\n Reg ! {now, self()},\n receive {token_reply, R} -> R end.\n\n stop(Reg) ->\n Reg ! {stop, self()},\n receive {token_reply, R} -> R end.\n\n loop(Grants, Access, Refresh, NextGid, Now, Audit) ->\n receive\n {issue, Subject, Client, Scope, Ttl, From} ->\n Gid = NextGid,\n Tok = make_ref(),\n From ! {token_reply, {ok, Tok}},\n audit_event(Audit, Subject, issue),\n loop([{Gid, {Subject, Client, Scope, active, Ttl}} | Grants],\n [{Tok, {Gid, Scope, exp(Now, Ttl), Now}} | Access],\n Refresh, NextGid + 1, Now, Audit);\n {issue_grant, Subject, Client, Scope, Ttl, From} ->\n Gid = NextGid,\n A = make_ref(),\n R = make_ref(),\n From ! {token_reply, {ok, A, R}},\n audit_event(Audit, Subject, issue),\n loop([{Gid, {Subject, Client, Scope, active, Ttl}} | Grants],\n [{A, {Gid, Scope, exp(Now, Ttl), Now}} | Access],\n [{R, {Gid, current}} | Refresh],\n NextGid + 1, Now, Audit);\n {refresh, RTok, From} ->\n case find(RTok, Refresh) of\n none ->\n From ! {token_reply, {error, invalid_grant}},\n loop(Grants, Access, Refresh, NextGid, Now, Audit);\n {ok, {Gid, superseded}} ->\n From ! {token_reply, {error, invalid_grant}},\n audit_grant(Audit, Gid, Grants, revoke),\n loop(set_status(Gid, revoked, Grants), Access, Refresh, NextGid, Now, Audit);\n {ok, {Gid, current}} ->\n case grant_active(Gid, Grants) of\n false ->\n From ! {token_reply, {error, invalid_grant}},\n loop(Grants, Access, Refresh, NextGid, Now, Audit);\n true ->\n {Su, Cl, Sc} = grant_info(Gid, Grants),\n A2 = make_ref(),\n R2 = make_ref(),\n From ! {token_reply, {ok, A2, R2}},\n audit_event(Audit, Su, refresh),\n loop(Grants,\n [{A2, {Gid, Sc, exp(Now, grant_ttl(Gid, Grants)), Now}} | Access],\n [{R2, {Gid, current}} | supersede(RTok, Refresh)],\n NextGid, Now, Audit)\n end\n end;\n {refresh_scoped, RTok, Requested, From} ->\n case find(RTok, Refresh) of\n none ->\n From ! {token_reply, {error, invalid_grant}},\n loop(Grants, Access, Refresh, NextGid, Now, Audit);\n {ok, {Gid, superseded}} ->\n From ! {token_reply, {error, invalid_grant}},\n audit_grant(Audit, Gid, Grants, revoke),\n loop(set_status(Gid, revoked, Grants), Access, Refresh, NextGid, Now, Audit);\n {ok, {Gid, current}} ->\n case grant_active(Gid, Grants) of\n false ->\n From ! {token_reply, {error, invalid_grant}},\n loop(Grants, Access, Refresh, NextGid, Now, Audit);\n true ->\n {Su, Cl, Sc} = grant_info(Gid, Grants),\n case subset(Requested, Sc) of\n false ->\n From ! {token_reply, {error, invalid_scope}},\n loop(Grants, Access, Refresh, NextGid, Now, Audit);\n true ->\n A2 = make_ref(),\n R2 = make_ref(),\n From ! {token_reply, {ok, A2, R2}},\n audit_event(Audit, Su, refresh),\n loop(Grants,\n [{A2, {Gid, Requested, exp(Now, grant_ttl(Gid, Grants)), Now}} | Access],\n [{R2, {Gid, current}} | supersede(RTok, Refresh)],\n NextGid, Now, Audit)\n end\n end\n end;\n {introspect, Tok, From} ->\n From ! {token_reply, introspect_access(Tok, Access, Grants, Now)},\n loop(Grants, Access, Refresh, NextGid, Now, Audit);\n {introspect_full, Tok, From} ->\n From ! {token_reply, introspect_meta(Tok, Access, Grants, Now)},\n loop(Grants, Access, Refresh, NextGid, Now, Audit);\n {grants_for, Subject, From} ->\n From ! {token_reply, collect_grants(Subject, Grants, [])},\n loop(Grants, Access, Refresh, NextGid, Now, Audit);\n {revoke, Tok, From} ->\n From ! {token_reply, ok},\n case find_gid(Tok, Access, Refresh) of\n none -> loop(Grants, Access, Refresh, NextGid, Now, Audit);\n {ok, Gid} ->\n audit_grant(Audit, Gid, Grants, revoke),\n loop(set_status(Gid, revoked, Grants), Access, Refresh, NextGid, Now, Audit)\n end;\n {revoke_app, Subject, Client, From} ->\n audit_app(Audit, Subject, Client, Grants),\n From ! {token_reply, ok},\n loop(revoke_matching(Subject, Client, Grants), Access, Refresh, NextGid, Now, Audit);\n {advance, N, From} ->\n From ! {token_reply, ok},\n loop(Grants, Access, Refresh, NextGid, Now + N, Audit);\n {now, From} ->\n From ! {token_reply, Now},\n loop(Grants, Access, Refresh, NextGid, Now, Audit);\n {stop, From} ->\n From ! {token_reply, ok}\n end.\n\n exp(_, infinity) -> infinity;\n exp(Now, Ttl) -> Now + Ttl.\n\n not_expired(_, infinity) -> true;\n not_expired(Now, Expires) -> Now < Expires.\n\n audit_event(none, _, _) -> ok;\n audit_event(Audit, Subject, Action) ->\n Audit ! {event, Subject, Action},\n ok.\n\n audit_grant(none, _, _, _) -> ok;\n audit_grant(Audit, Gid, Grants, Action) ->\n {Su, _, _} = grant_info(Gid, Grants),\n Audit ! {event, Su, Action},\n ok.\n\n audit_app(none, _, _, _) -> ok;\n audit_app(_, _, _, []) -> ok;\n audit_app(Audit, Subject, Client, [{_, {Su, Cl, _, St, _}} | Rest]) ->\n case match_app(Su, Subject, Cl, Client, St) of\n true ->\n Audit ! {event, Subject, revoke},\n audit_app(Audit, Subject, Client, Rest);\n false ->\n audit_app(Audit, Subject, Client, Rest)\n end.\n\n introspect_access(Tok, Access, Grants, Now) ->\n case find(Tok, Access) of\n none -> {inactive};\n {ok, {Gid, Scope, Expires, _Iat}} ->\n case find(Gid, Grants) of\n none -> {inactive};\n {ok, {Su, Cl, _, active, _}} ->\n case not_expired(Now, Expires) of\n true -> {active, Su, Cl, Scope};\n false -> {inactive}\n end;\n {ok, {_, _, _, revoked, _}} -> {inactive}\n end\n end.\n\n introspect_meta(Tok, Access, Grants, Now) ->\n case find(Tok, Access) of\n none -> {inactive};\n {ok, {Gid, Scope, Expires, Iat}} ->\n case find(Gid, Grants) of\n none -> {inactive};\n {ok, {Su, Cl, _, active, _}} ->\n case not_expired(Now, Expires) of\n true -> {active, Su, Cl, Scope, Expires, Iat, bearer};\n false -> {inactive}\n end;\n {ok, {_, _, _, revoked, _}} -> {inactive}\n end\n end.\n\n collect_grants(_, [], Acc) -> Acc;\n collect_grants(Subject, [{_Gid, {Su, Cl, Sc, active, _Ttl}} | Rest], Acc) ->\n case Su =:= Subject of\n true -> collect_grants(Subject, Rest, [{Cl, Sc} | Acc]);\n false -> collect_grants(Subject, Rest, Acc)\n end;\n collect_grants(Subject, [{_Gid, {_, _, _, revoked, _}} | Rest], Acc) ->\n collect_grants(Subject, Rest, Acc).\n\n revoke_matching(_, _, []) -> [];\n revoke_matching(Subject, Client, [{Gid, {Su, Cl, Sc, St, Ttl}} | Rest]) ->\n case match_app(Su, Subject, Cl, Client, St) of\n true -> [{Gid, {Su, Cl, Sc, revoked, Ttl}} | revoke_matching(Subject, Client, Rest)];\n false -> [{Gid, {Su, Cl, Sc, St, Ttl}} | revoke_matching(Subject, Client, Rest)]\n end.\n\n match_app(Su, Subject, Cl, Client, St) ->\n case Su =:= Subject of\n false -> false;\n true ->\n case Cl =:= Client of\n false -> false;\n true -> St =:= active\n end\n end.\n\n find_gid(Tok, Access, Refresh) ->\n case find(Tok, Access) of\n {ok, {Gid, _, _, _}} -> {ok, Gid};\n none ->\n case find(Tok, Refresh) of\n {ok, {Gid, _}} -> {ok, Gid};\n none -> none\n end\n end.\n\n grant_active(Gid, Grants) ->\n case find(Gid, Grants) of\n {ok, {_, _, _, active, _}} -> true;\n Other -> false\n end.\n\n grant_info(Gid, Grants) ->\n case find(Gid, Grants) of\n {ok, {Su, Cl, Sc, _, _}} -> {Su, Cl, Sc}\n end.\n\n grant_ttl(Gid, Grants) ->\n case find(Gid, Grants) of\n {ok, {_, _, _, _, Ttl}} -> Ttl\n end.\n\n set_status(_, _, []) -> [];\n set_status(Gid, St, [{G, {Su, Cl, Sc, Old, Ttl}} | Rest]) ->\n case G =:= Gid of\n true -> [{G, {Su, Cl, Sc, St, Ttl}} | Rest];\n false -> [{G, {Su, Cl, Sc, Old, Ttl}} | set_status(Gid, St, Rest)]\n end.\n\n supersede(_, []) -> [];\n supersede(RTok, [{T, {Gid, St}} | Rest]) ->\n case T =:= RTok of\n true -> [{T, {Gid, superseded}} | Rest];\n false -> [{T, {Gid, St}} | supersede(RTok, Rest)]\n end.\n\n subset([], _) -> true;\n subset([X | Rest], Granted) ->\n case member(X, Granted) of\n true -> subset(Rest, Granted);\n false -> false\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-token! + (fn () (erlang-load-module identity-token-source))) diff --git a/plans/identity-on-sx.md b/plans/identity-on-sx.md index f28f7095..fe6da4e6 100644 --- a/plans/identity-on-sx.md +++ b/plans/identity-on-sx.md @@ -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` → **233/233** (4 phases + 15 ext) — slow (~10min, run in background; internal timeout 1200) ## Ground rules @@ -57,28 +57,237 @@ 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] "apps with access": `grants_for(Subject)` / `identity:grants` (per-subject active grants) +- [x] "disconnect app": `revoke_app(Subject, Client)` — revoke all of a subject's grants for a client +- [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 — "disconnect app" (ext): `identity_tokens:revoke_app(Subject, + Client)` revokes every grant a subject holds for one client at once (audited + one revoke per grant), exposed at the facade as `identity:revoke_app`. The + action counterpart to the `grants` view — completes the account-security + view+action pairs: sessions/logout_all, grants/revoke_app, history. Other + subjects' same-client grants are untouched. +4 → account 11, 233/233. +- 2026-06-07 — "apps with access" (ext): `identity_tokens:grants_for(Subject)` + lists a subject's ACTIVE grants as `[{Client, Scope}]` (revoked excluded), + exposed through the facade as `identity:grants(Subject)`. Completes the + per-subject account-security trio: sessions (where), grants (which apps), + history (what happened). New tests/account.sx (7). 222→229. NOTE: conformance + is now slow (~10 min, 22 suites); run it in the background — internal + sx_server timeout raised to 1200s. The suite is at its monolithic-runtime + ceiling; further test growth should consider splitting the harness. +- 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.