From 1c6b80404ec867299252bf5e9039ff46b2939c06 Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 6 Jun 2026 23:45:50 +0000 Subject: [PATCH 01/27] =?UTF-8?q?identity:=20session-as-process=20?= =?UTF-8?q?=E2=80=94=20create/lookup/expire/revoke=20+=20idle=20timeout=20?= =?UTF-8?q?(11=20tests)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Session is an Erlang process holding {subject, client, status}. lookup/ touch/expire/revoke are messages; expiry is the process's own `receive ... after Ttl` timeout (RFC-agnostic; no global sweep), which notifies the owner and tombstones. Tombstoned sessions answer lookups with an explicit {error, expired|revoked}, never a silent dead mailbox. Adds the conformance harness + scoreboard. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/conformance.sh | 120 ++++++++++++++++++++++++++++++++++ lib/identity/scoreboard.json | 8 +++ lib/identity/scoreboard.md | 10 +++ lib/identity/session.sx | 20 ++++++ lib/identity/tests/session.sx | 118 +++++++++++++++++++++++++++++++++ plans/identity-on-sx.md | 11 +++- 6 files changed, 284 insertions(+), 3 deletions(-) create mode 100755 lib/identity/conformance.sh create mode 100644 lib/identity/scoreboard.json create mode 100644 lib/identity/scoreboard.md create mode 100644 lib/identity/session.sx create mode 100644 lib/identity/tests/session.sx diff --git a/lib/identity/conformance.sh b/lib/identity/conformance.sh new file mode 100755 index 00000000..6baf4266 --- /dev/null +++ b/lib/identity/conformance.sh @@ -0,0 +1,120 @@ +#!/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" +) + +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/tests/session.sx") +(epoch 100) +(eval "(list id-session-test-pass id-session-test-count)") +EPOCHS + +timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 + +parse_pair() { + local epoch="$1" + local line + line=$(grep -A1 "^(ok-len $epoch " "$OUTFILE" | tail -1) + echo "$line" | sed -E 's/[()]//g' +} + +TOTAL_PASS=0 +TOTAL_COUNT=0 +JSON_SUITES="" +MD_ROWS="" + +idx=0 +for entry in "${SUITES[@]}"; do + name="${entry%%|*}" + epoch=$((100 + idx)) + pair=$(parse_pair "$epoch") + pass=$(echo "$pair" | awk '{print $1}') + count=$(echo "$pair" | awk '{print $2}') + if [ -z "$pass" ] || [ -z "$count" ]; then + pass=0 + count=0 + fi + TOTAL_PASS=$((TOTAL_PASS + pass)) + TOTAL_COUNT=$((TOTAL_COUNT + count)) + status="ok" + marker="✅" + if [ "$pass" != "$count" ]; then + status="fail" + marker="❌" + fi + if [ "$VERBOSE" = "-v" ]; then + printf " %-12s %s/%s\n" "$name" "$pass" "$count" + fi + if [ -n "$JSON_SUITES" ]; then JSON_SUITES+=","; fi + JSON_SUITES+=$'\n ' + JSON_SUITES+="{\"name\":\"$name\",\"pass\":$pass,\"total\":$count,\"status\":\"$status\"}" + MD_ROWS+="| $marker | $name | $pass | $count |"$'\n' + idx=$((idx + 1)) +done + +printf '\nidentity-on-sx conformance: %d / %d\n' "$TOTAL_PASS" "$TOTAL_COUNT" + +cat > lib/identity/scoreboard.json < lib/identity/scoreboard.md <\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/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/plans/identity-on-sx.md b/plans/identity-on-sx.md index f28f7095..1095b1cf 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` → **11/11** (Phase 1: session) ## Ground rules @@ -57,7 +57,7 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) ``` ## Phase 1 — Sessions + tokens -- [ ] `session.sx` — session process, create/lookup/expire +- [x] `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 @@ -78,7 +78,12 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [ ] tests: audit completeness, cross-instance subject mapping ## Progress log -(loop fills this in) +- 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) From ac635012661654cb46e80ad4de36605e4cf0b7d8 Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 6 Jun 2026 23:48:30 +0000 Subject: [PATCH 02/27] =?UTF-8?q?identity:=20opaque=20grant-backed=20token?= =?UTF-8?q?s=20=E2=80=94=20issue/introspect/revoke=20(9=20tests)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Token table is a process; the token is an opaque make_ref carrying no information. introspect() is a live table lookup every time, so revocation is real (RFC 7009 §2): a revoked token reads {inactive} on the next introspection with no validity window. Reply shapes follow RFC 7662 §2.2 ({active, Subject, Client, Scope} / {inactive}). Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/conformance.sh | 5 ++ lib/identity/scoreboard.json | 7 +-- lib/identity/scoreboard.md | 3 +- lib/identity/tests/token.sx | 99 ++++++++++++++++++++++++++++++++++++ lib/identity/token.sx | 23 +++++++++ plans/identity-on-sx.md | 9 +++- 6 files changed, 140 insertions(+), 6 deletions(-) create mode 100644 lib/identity/tests/token.sx create mode 100644 lib/identity/token.sx diff --git a/lib/identity/conformance.sh b/lib/identity/conformance.sh index 6baf4266..6af6b22f 100755 --- a/lib/identity/conformance.sh +++ b/lib/identity/conformance.sh @@ -29,6 +29,7 @@ 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" ) cat > "$TMPFILE" << 'EPOCHS' @@ -41,9 +42,13 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/erlang/transpile.sx") (load "lib/erlang/runtime.sx") (load "lib/identity/session.sx") +(load "lib/identity/token.sx") (load "lib/identity/tests/session.sx") +(load "lib/identity/tests/token.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)") EPOCHS timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json index 264e6ef8..53135b39 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,8 +1,9 @@ { "language": "identity", - "total_pass": 11, - "total": 11, + "total_pass": 20, + "total": 20, "suites": [ - {"name":"session","pass":11,"total":11,"status":"ok"} + {"name":"session","pass":11,"total":11,"status":"ok"}, + {"name":"token","pass":9,"total":9,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index 8f0ace9b..94067fbd 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,10 +1,11 @@ # identity-on-sx Scoreboard -**Total: 11 / 11 tests passing** +**Total: 20 / 20 tests passing** | | Suite | Pass | Total | |---|---|---|---| | ✅ | session | 11 | 11 | +| ✅ | token | 9 | 9 | Generated by `lib/identity/conformance.sh`. diff --git a/lib/identity/tests/token.sx b/lib/identity/tests/token.sx new file mode 100644 index 00000000..b6acb94e --- /dev/null +++ b/lib/identity/tests/token.sx @@ -0,0 +1,99 @@ +;; identity/tests/token.sx — opaque tokens, grant-backed lookup, and +;; real revocation. The revoke-then-introspect path is the security +;; centrepiece: a revoked token must read inactive immediately. + +(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") + +(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..952e6ef8 --- /dev/null +++ b/lib/identity/token.sx @@ -0,0 +1,23 @@ +;; identity/token.sx — opaque, grant-backed tokens (RFC 7662 / 7009). +;; +;; The token table is a process; the token itself is an opaque handle +;; (make_ref) that carries NO information. introspect(Token) is a live +;; lookup against the table every time — the token is never decoded. +;; Because every introspection consults the live table, revocation is +;; real: a revoked token reads inactive on the very next introspection, +;; with no window where it still validates (RFC 7009 §2). +;; +;; introspect replies model RFC 7662 §2.2: +;; {active, Subject, Client, Scope} — token is currently valid +;; {inactive} — unknown OR revoked; never says why +;; +;; Authorization is NOT decided here. {active, ...} states WHO and WHAT +;; was granted; whether that subject may do a thing is acl's question. + +(define + identity-token-source + "-module(identity_tokens).\n\n start() ->\n spawn(fun () -> loop([]) end).\n\n issue(Reg, Subject, Client, Scope) ->\n Reg ! {issue, Subject, Client, 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 revoke(Reg, Token) ->\n Reg ! {revoke, Token, 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(Tokens) ->\n receive\n {issue, Subject, Client, Scope, From} ->\n Token = make_ref(),\n From ! {token_reply, {ok, Token}},\n loop([{Token, {Subject, Client, Scope, active}} | Tokens]);\n {introspect, Token, From} ->\n From ! {token_reply, find(Token, Tokens)},\n loop(Tokens);\n {revoke, Token, From} ->\n From ! {token_reply, ok},\n loop(revoke_token(Token, Tokens));\n {stop, From} ->\n From ! {token_reply, ok}\n end.\n\n find(_, []) -> {inactive};\n find(Token, [{T, {Subject, Client, Scope, active}} | Rest]) ->\n case T =:= Token of\n true -> {active, Subject, Client, Scope};\n false -> find(Token, Rest)\n end;\n find(Token, [{T, {_, _, _, revoked}} | Rest]) ->\n case T =:= Token of\n true -> {inactive};\n false -> find(Token, Rest)\n end.\n\n revoke_token(_, []) -> [];\n revoke_token(Token, [{T, {Su, Cl, Sc, St}} | Rest]) ->\n case T =:= Token of\n true -> [{T, {Su, Cl, Sc, revoked}} | Rest];\n false -> [{T, {Su, Cl, Sc, St}} | revoke_token(Token, 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 1095b1cf..c816ede6 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` → **11/11** (Phase 1: session) +`bash lib/identity/conformance.sh` → **20/20** (Phase 1: session, token) ## Ground rules @@ -58,7 +58,7 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) ## Phase 1 — Sessions + tokens - [x] `session.sx` — session process, create/lookup/expire -- [ ] `token.sx` — issue/introspect/revoke (opaque, grant-backed) +- [x] `token.sx` — issue/introspect/revoke (opaque, grant-backed) - [ ] `registry.sx` — route by subject/client - [ ] `api.sx` + tests + scoreboard + conformance.sh @@ -78,6 +78,11 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [ ] tests: audit completeness, cross-instance subject mapping ## Progress log +- 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 From 938e90455ded5244bf1e1983f0038946d42691df Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 6 Jun 2026 23:55:34 +0000 Subject: [PATCH 03/27] =?UTF-8?q?identity:=20session=20registry=20?= =?UTF-8?q?=E2=80=94=20route=20by=20id=20and=20(subject,=20client)=20+=20S?= =?UTF-8?q?SO=20fan-out=20(9=20tests)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Directory process holding (SessionId, Subject, Client, Pid) rows. Answers the SSO probe lookup(Subject, Client) and the fan-out sessions_for(Subject) (one subject, many clients). Routes only — no grant state, decides nothing. Integration-tested: register a live session, route to it, confirm active. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/conformance.sh | 5 ++ lib/identity/registry.sx | 22 ++++++++ lib/identity/scoreboard.json | 7 +-- lib/identity/scoreboard.md | 3 +- lib/identity/tests/registry.sx | 99 ++++++++++++++++++++++++++++++++++ plans/identity-on-sx.md | 9 +++- 6 files changed, 139 insertions(+), 6 deletions(-) create mode 100644 lib/identity/registry.sx create mode 100644 lib/identity/tests/registry.sx diff --git a/lib/identity/conformance.sh b/lib/identity/conformance.sh index 6af6b22f..e9a047c0 100755 --- a/lib/identity/conformance.sh +++ b/lib/identity/conformance.sh @@ -30,6 +30,7 @@ trap "rm -f $TMPFILE $OUTFILE" EXIT 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" ) cat > "$TMPFILE" << 'EPOCHS' @@ -43,12 +44,16 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/erlang/runtime.sx") (load "lib/identity/session.sx") (load "lib/identity/token.sx") +(load "lib/identity/registry.sx") (load "lib/identity/tests/session.sx") (load "lib/identity/tests/token.sx") +(load "lib/identity/tests/registry.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)") EPOCHS timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 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 index 53135b39..ad6a7aaf 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,9 +1,10 @@ { "language": "identity", - "total_pass": 20, - "total": 20, + "total_pass": 29, + "total": 29, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, - {"name":"token","pass":9,"total":9,"status":"ok"} + {"name":"token","pass":9,"total":9,"status":"ok"}, + {"name":"registry","pass":9,"total":9,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index 94067fbd..21014c1b 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,11 +1,12 @@ # identity-on-sx Scoreboard -**Total: 20 / 20 tests passing** +**Total: 29 / 29 tests passing** | | Suite | Pass | Total | |---|---|---|---| | ✅ | session | 11 | 11 | | ✅ | token | 9 | 9 | +| ✅ | registry | 9 | 9 | Generated by `lib/identity/conformance.sh`. 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/plans/identity-on-sx.md b/plans/identity-on-sx.md index c816ede6..c3319474 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` → **20/20** (Phase 1: session, token) +`bash lib/identity/conformance.sh` → **29/29** (Phase 1: session, token, registry) ## Ground rules @@ -59,7 +59,7 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) ## Phase 1 — Sessions + tokens - [x] `session.sx` — session process, create/lookup/expire - [x] `token.sx` — issue/introspect/revoke (opaque, grant-backed) -- [ ] `registry.sx` — route by subject/client +- [x] `registry.sx` — route by subject/client - [ ] `api.sx` + tests + scoreboard + conformance.sh ## Phase 2 — OAuth2 flows @@ -78,6 +78,11 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [ ] tests: audit completeness, cross-instance subject mapping ## Progress log +- 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 From 064bbf18b3f67ac0f48da2d0b4cb947fbaa1b698 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 00:00:05 +0000 Subject: [PATCH 04/27] =?UTF-8?q?identity:=20service=20facade=20api.sx=20?= =?UTF-8?q?=E2=80=94=20login/verify/revoke/logout=20(10=20tests,=20Phase?= =?UTF-8?q?=201=20complete)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit identity:start() spawns one coordinator owning the token table + session registry and exposes the whole-domain ops. The coordinator is the owner sessions notify on idle timeout, so an expired session deregisters itself — timeout-driven, never swept. verify/2 answers identity only ({active, Subject, Client, Scope}); permission is delegated to acl. 39/39. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/api.sx | 35 +++++++++++ lib/identity/conformance.sh | 5 ++ lib/identity/scoreboard.json | 7 ++- lib/identity/scoreboard.md | 3 +- lib/identity/tests/api.sx | 111 +++++++++++++++++++++++++++++++++++ plans/identity-on-sx.md | 11 +++- 6 files changed, 166 insertions(+), 6 deletions(-) create mode 100644 lib/identity/api.sx create mode 100644 lib/identity/tests/api.sx diff --git a/lib/identity/api.sx b/lib/identity/api.sx new file mode 100644 index 00000000..ea3fec2d --- /dev/null +++ b/lib/identity/api.sx @@ -0,0 +1,35 @@ +;; identity/api.sx — the identity service facade. +;; +;; `identity:start()` spawns one coordinator process that owns a token +;; table and a session registry and ties them together. It exposes the +;; whole-domain operations the architecture sketch names: +;; +;; login(Svc, Subject, Client, Scope[, Ttl]) -> {ok, SessionId, Token} +;; verify(Svc, Token) -> {active, Subject, Client, Scope} | {inactive} +;; revoke(Svc, Token) -> ok (revokes the token; real, immediate) +;; logout(Svc, SessionId) -> ok (tombstones + deregisters a session) +;; session_status(Svc, Sid) -> active | expired | revoked | gone +;; +;; The coordinator is also the Owner the sessions notify on idle timeout, +;; so an expired session deregisters itself from the directory — the +;; timeout is the only liveness driver; nothing sweeps. +;; +;; Delegation boundary: verify/2 answers IDENTITY only — who the token +;; belongs to and what scope was granted. It deliberately does NOT answer +;; \"may they do X\"; that question belongs to acl-on-sx, which keys off the +;; {active, Subject, Client, Scope} this returns. + +(define + identity-api-source + "-module(identity).\n\n start() ->\n spawn(fun () ->\n TokReg = identity_tokens:start(),\n SessReg = identity_registry:start(),\n loop(TokReg, SessReg, 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 session_status(Svc, SessionId) ->\n Svc ! {session_status, SessionId, self()},\n receive {identity_reply, R} -> R end.\n\n loop(TokReg, SessReg, 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 {ok, Token} = identity_tokens:issue(TokReg, Subject, Client, Scope),\n From ! {identity_reply, {ok, SessionId, Token}},\n loop(TokReg, SessReg, NextId + 1);\n {verify, Token, From} ->\n From ! {identity_reply, identity_tokens:introspect(TokReg, Token)},\n loop(TokReg, SessReg, NextId);\n {revoke, Token, From} ->\n identity_tokens:revoke(TokReg, Token),\n From ! {identity_reply, ok},\n loop(TokReg, SessReg, NextId);\n {logout, SessionId, From} ->\n case identity_registry:whereis_session(SessReg, SessionId) of\n {ok, Pid} -> identity_session:revoke(Pid);\n {error, _} -> ok\n end,\n identity_registry:deregister(SessReg, SessionId),\n From ! {identity_reply, ok},\n loop(TokReg, SessReg, 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, NextId);\n {session_expired, SessionId} ->\n identity_registry:deregister(SessReg, SessionId),\n loop(TokReg, SessReg, NextId)\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-api!))) diff --git a/lib/identity/conformance.sh b/lib/identity/conformance.sh index e9a047c0..71df9186 100755 --- a/lib/identity/conformance.sh +++ b/lib/identity/conformance.sh @@ -31,6 +31,7 @@ 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" ) cat > "$TMPFILE" << 'EPOCHS' @@ -45,15 +46,19 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/identity/session.sx") (load "lib/identity/token.sx") (load "lib/identity/registry.sx") +(load "lib/identity/api.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") (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)") EPOCHS timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json index ad6a7aaf..81e54f3d 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,10 +1,11 @@ { "language": "identity", - "total_pass": 29, - "total": 29, + "total_pass": 39, + "total": 39, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, {"name":"token","pass":9,"total":9,"status":"ok"}, - {"name":"registry","pass":9,"total":9,"status":"ok"} + {"name":"registry","pass":9,"total":9,"status":"ok"}, + {"name":"api","pass":10,"total":10,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index 21014c1b..7891a135 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,12 +1,13 @@ # identity-on-sx Scoreboard -**Total: 29 / 29 tests passing** +**Total: 39 / 39 tests passing** | | Suite | Pass | Total | |---|---|---|---| | ✅ | session | 11 | 11 | | ✅ | token | 9 | 9 | | ✅ | registry | 9 | 9 | +| ✅ | api | 10 | 10 | Generated by `lib/identity/conformance.sh`. 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/plans/identity-on-sx.md b/plans/identity-on-sx.md index c3319474..253ed76a 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` → **29/29** (Phase 1: session, token, registry) +`bash lib/identity/conformance.sh` → **39/39** (Phase 1 complete: session, token, registry, api) ## Ground rules @@ -60,7 +60,7 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [x] `session.sx` — session process, create/lookup/expire - [x] `token.sx` — issue/introspect/revoke (opaque, grant-backed) - [x] `registry.sx` — route by subject/client -- [ ] `api.sx` + tests + scoreboard + conformance.sh +- [x] `api.sx` + tests + scoreboard + conformance.sh ## Phase 2 — OAuth2 flows - [ ] authorization-code flow as a message protocol @@ -78,6 +78,13 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [ ] tests: audit completeness, cross-instance subject mapping ## Progress log +- 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 From 27f43dbf10d3735fb79f76b0ba76b20596c30d3c Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 00:11:18 +0000 Subject: [PATCH 05/27] identity: OAuth2 authorization-code flow as message protocol + PKCE (14 tests) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit oauth.sx — RFC 6749 §4.1 as a state machine on one authz-server process: authorize → {consent_required} → consent(allow|deny) → {code} → exchange → {ok, Token}. Exchange enforces single-use codes (§10.5, replay → invalid_grant), client_id + redirect_uri binding (§4.1.3), and PKCE (RFC 7636 plain) verifier match. Issued tokens are grant-backed via token.sx so revocation stays real. 53/53. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/conformance.sh | 5 ++ lib/identity/oauth.sx | 29 +++++++ lib/identity/scoreboard.json | 7 +- lib/identity/scoreboard.md | 3 +- lib/identity/tests/oauth.sx | 162 +++++++++++++++++++++++++++++++++++ plans/identity-on-sx.md | 11 ++- 6 files changed, 211 insertions(+), 6 deletions(-) create mode 100644 lib/identity/oauth.sx create mode 100644 lib/identity/tests/oauth.sx diff --git a/lib/identity/conformance.sh b/lib/identity/conformance.sh index 71df9186..a02693ce 100755 --- a/lib/identity/conformance.sh +++ b/lib/identity/conformance.sh @@ -32,6 +32,7 @@ SUITES=( "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" ) cat > "$TMPFILE" << 'EPOCHS' @@ -47,10 +48,12 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/identity/token.sx") (load "lib/identity/registry.sx") (load "lib/identity/api.sx") +(load "lib/identity/oauth.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") (epoch 100) (eval "(list id-session-test-pass id-session-test-count)") (epoch 101) @@ -59,6 +62,8 @@ cat > "$TMPFILE" << 'EPOCHS' (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)") EPOCHS timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 diff --git a/lib/identity/oauth.sx b/lib/identity/oauth.sx new file mode 100644 index 00000000..8c2008f0 --- /dev/null +++ b/lib/identity/oauth.sx @@ -0,0 +1,29 @@ +;; identity/oauth.sx — the OAuth2 authorization-code flow as a message +;; protocol (RFC 6749 §4.1), with PKCE (RFC 7636, `plain` method). +;; +;; The flow is a state machine threaded through one authorization-server +;; process, never a single function: +;; +;; authorize -> {consent_required, ReqId} (§4.1.1 request stored) +;; consent -> {code, Code} | {error, access_denied} (§4.1.2 grant/deny) +;; exchange -> {ok, Token} | {error, invalid_grant} (§4.1.3 / §5.2) +;; +;; Security invariants enforced at exchange (§4.1.3, §10.5): +;; - the code is single-use: it is removed on the FIRST exchange attempt, +;; so replay yields invalid_grant; +;; - the code is bound to its client_id and redirect_uri; a mismatch is +;; invalid_grant; +;; - PKCE: the presented verifier must match the stored challenge +;; (plain method: challenge == verifier), else invalid_grant. +;; +;; On success a token is issued into a grant-backed table (token.sx), so +;; revocation stays real. The server proves identity; it does not decide +;; permission — that is acl's job, keyed off the issued grant. + +(define + identity-oauth-source + "-module(identity_oauth).\n\n start() ->\n spawn(fun () ->\n TokReg = identity_tokens:start(),\n loop(TokReg, [], [])\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 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 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, Pending, Codes) ->\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, [{ReqId, Rec} | Pending], Codes);\n {consent, ReqId, Decision, From} ->\n case find(ReqId, Pending) of\n none ->\n From ! {oauth_reply, {error, unknown_request}},\n loop(TokReg, Pending, Codes);\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, Pending2, [{Code, Rec} | Codes]);\n deny ->\n From ! {oauth_reply, {error, access_denied}},\n loop(TokReg, Pending2, Codes)\n end\n end;\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, Pending, Codes);\n {ok, Rec} ->\n Codes2 = remove(Code, Codes),\n From ! {oauth_reply, redeem(TokReg, Rec, ClientId, RedirectUri, Verifier)},\n loop(TokReg, Pending, Codes2)\n end;\n {introspect, Token, From} ->\n From ! {oauth_reply, identity_tokens:introspect(TokReg, Token)},\n loop(TokReg, Pending, Codes);\n {revoke, Token, From} ->\n identity_tokens:revoke(TokReg, Token),\n From ! {oauth_reply, ok},\n loop(TokReg, Pending, Codes)\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 ->\n {ok, Token} = identity_tokens:issue(TokReg, Subject, ClientId, Scope),\n {ok, Token}\n end\n end\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 () (erlang-load-module identity-oauth-source))) diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json index 81e54f3d..0b9850cf 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,11 +1,12 @@ { "language": "identity", - "total_pass": 39, - "total": 39, + "total_pass": 53, + "total": 53, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, {"name":"token","pass":9,"total":9,"status":"ok"}, {"name":"registry","pass":9,"total":9,"status":"ok"}, - {"name":"api","pass":10,"total":10,"status":"ok"} + {"name":"api","pass":10,"total":10,"status":"ok"}, + {"name":"oauth","pass":14,"total":14,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index 7891a135..bee1db94 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,6 +1,6 @@ # identity-on-sx Scoreboard -**Total: 39 / 39 tests passing** +**Total: 53 / 53 tests passing** | | Suite | Pass | Total | |---|---|---|---| @@ -8,6 +8,7 @@ | ✅ | token | 9 | 9 | | ✅ | registry | 9 | 9 | | ✅ | api | 10 | 10 | +| ✅ | oauth | 14 | 14 | Generated by `lib/identity/conformance.sh`. diff --git a/lib/identity/tests/oauth.sx b/lib/identity/tests/oauth.sx new file mode 100644 index 00000000..69f02867 --- /dev/null +++ b/lib/identity/tests/oauth.sx @@ -0,0 +1,162 @@ +;; identity/tests/oauth.sx — OAuth2 authorization-code flow (RFC 6749 +;; §4.1) + PKCE (RFC 7636). Covers the full happy path and every +;; rejection: denied consent, single-use codes, client/redirect binding, +;; PKCE verifier mismatch, unknown code/request, and real revocation of +;; an exchanged token. + +(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 token introspects active" + (idonm + (ido-ev + (str + ido-granted + ", {ok, Tok} = 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} = 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} = identity_oauth:exchange(O, Code, webapp, uri1, verif1),\n case identity_oauth:introspect(O, Tok) of\n {active, _, _, Scope} -> Scope\n end"))) + "read") + +;; ── 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") + +;; ── revocation is real on an exchanged token (RFC 7009) ────────── + +(id-oauth-test + "revoked exchanged token introspects inactive" + (idonm + (ido-ev + (str + ido-granted + ", {ok, Tok} = 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") + +;; ── 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, _T1} = identity_oauth:exchange(O, C1, webapp, uri1, va),\n {ok, T2} = identity_oauth:exchange(O, C2, cli, uri2, vb),\n case identity_oauth:introspect(O, T2) 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/plans/identity-on-sx.md b/plans/identity-on-sx.md index 253ed76a..aaef9c2a 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` → **39/39** (Phase 1 complete: session, token, registry, api) +`bash lib/identity/conformance.sh` → **53/53** (Phase 1 + authz-code flow) ## Ground rules @@ -63,7 +63,7 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [x] `api.sx` + tests + scoreboard + conformance.sh ## Phase 2 — OAuth2 flows -- [ ] authorization-code flow as a message protocol +- [x] authorization-code flow as a message protocol - [ ] refresh + rotation; revocation cascades to issued tokens - [ ] tests: full code exchange, refresh, revoke-then-use (must fail) @@ -78,6 +78,13 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [ ] tests: audit completeness, cross-instance subject mapping ## Progress log +- 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' From baee67f5610869a1c3de1dcf31372aadf2f89688 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 00:26:05 +0000 Subject: [PATCH 06/27] identity: refresh-token rotation + cascading revocation (token.sx grant-centric, +9 tests) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The grant {Subject,Client,Scope,Status} becomes the unit of authorization and cascade; access + refresh tokens reference it. issue_grant returns an access+refresh pair; refresh (RFC 6749 §6) supersedes the presented refresh token and mints a fresh pair; reusing a superseded refresh token is treated as theft (RFC 6819 §5.2.2.3) and revokes the whole family, killing the live descendant. revoke of any token cascades to the grant. All prior token behaviour preserved. token 18/18, 62/62. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/scoreboard.json | 6 +-- lib/identity/scoreboard.md | 4 +- lib/identity/tests/token.sx | 78 ++++++++++++++++++++++++++++++++++-- lib/identity/token.sx | 35 ++++++++++------ plans/identity-on-sx.md | 12 +++++- 5 files changed, 112 insertions(+), 23 deletions(-) diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json index 0b9850cf..5d763cf7 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,10 +1,10 @@ { "language": "identity", - "total_pass": 53, - "total": 53, + "total_pass": 62, + "total": 62, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, - {"name":"token","pass":9,"total":9,"status":"ok"}, + {"name":"token","pass":18,"total":18,"status":"ok"}, {"name":"registry","pass":9,"total":9,"status":"ok"}, {"name":"api","pass":10,"total":10,"status":"ok"}, {"name":"oauth","pass":14,"total":14,"status":"ok"} diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index bee1db94..e03b1c5d 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,11 +1,11 @@ # identity-on-sx Scoreboard -**Total: 53 / 53 tests passing** +**Total: 62 / 62 tests passing** | | Suite | Pass | Total | |---|---|---|---| | ✅ | session | 11 | 11 | -| ✅ | token | 9 | 9 | +| ✅ | token | 18 | 18 | | ✅ | registry | 9 | 9 | | ✅ | api | 10 | 10 | | ✅ | oauth | 14 | 14 | diff --git a/lib/identity/tests/token.sx b/lib/identity/tests/token.sx index b6acb94e..7c9d1edc 100644 --- a/lib/identity/tests/token.sx +++ b/lib/identity/tests/token.sx @@ -1,6 +1,7 @@ -;; identity/tests/token.sx — opaque tokens, grant-backed lookup, and -;; real revocation. The revoke-then-introspect path is the security -;; centrepiece: a revoked token must read inactive immediately. +;; identity/tests/token.sx — opaque tokens, grant-backed lookup, real +;; revocation, refresh-token rotation, and cascading revocation. The +;; revoke-then-introspect and refresh-reuse paths are the security +;; centrepieces. (define id-token-test-count 0) (define id-token-test-pass 0) @@ -94,6 +95,77 @@ "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") + (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 index 952e6ef8..9c4cb58c 100644 --- a/lib/identity/token.sx +++ b/lib/identity/token.sx @@ -1,22 +1,31 @@ -;; identity/token.sx — opaque, grant-backed tokens (RFC 7662 / 7009). +;; identity/token.sx — opaque, grant-backed tokens with refresh-token +;; rotation (RFC 6749 §6, RFC 6819 §5.2.2.3) and cascading revocation. ;; -;; The token table is a process; the token itself is an opaque handle -;; (make_ref) that carries NO information. introspect(Token) is a live -;; lookup against the table every time — the token is never decoded. -;; Because every introspection consults the live table, revocation is -;; real: a revoked token reads inactive on the very next introspection, -;; with no window where it still validates (RFC 7009 §2). +;; 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}. Tokens are opaque handles (make_ref) carrying +;; no information; every introspection is a live lookup against the grant, +;; so revocation is real (RFC 7009): once a grant is revoked, every token +;; ever issued under it — access AND refresh, including rotated +;; descendants — reads inactive on the next call. Revoking ANY token of a +;; grant (access or refresh) cascades to the whole grant. ;; -;; introspect replies model RFC 7662 §2.2: -;; {active, Subject, Client, Scope} — token is currently valid -;; {inactive} — unknown OR revoked; never says why +;; Refresh rotation: refreshing supersedes the presented refresh token and +;; mints a fresh access+refresh pair under the same grant. Re-presenting a +;; superseded refresh token is treated as token theft (RFC 6819 §5.2.2.3): +;; the entire grant is revoked, killing the legitimate descendant too. ;; -;; Authorization is NOT decided here. {active, ...} states WHO and WHAT -;; was granted; whether that subject may do a thing is acl's question. +;; introspect reply shapes (RFC 7662 §2.2): +;; {active, Subject, Client, Scope} | {inactive} +;; +;; State threaded through loop/4: +;; Grants : [{Gid, {Subject, Client, Scope, active|revoked}}] +;; Access : [{AccessTok, Gid}] +;; Refresh : [{RefreshTok, {Gid, current|superseded}}] (define identity-token-source - "-module(identity_tokens).\n\n start() ->\n spawn(fun () -> loop([]) end).\n\n issue(Reg, Subject, Client, Scope) ->\n Reg ! {issue, Subject, Client, 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 revoke(Reg, Token) ->\n Reg ! {revoke, Token, 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(Tokens) ->\n receive\n {issue, Subject, Client, Scope, From} ->\n Token = make_ref(),\n From ! {token_reply, {ok, Token}},\n loop([{Token, {Subject, Client, Scope, active}} | Tokens]);\n {introspect, Token, From} ->\n From ! {token_reply, find(Token, Tokens)},\n loop(Tokens);\n {revoke, Token, From} ->\n From ! {token_reply, ok},\n loop(revoke_token(Token, Tokens));\n {stop, From} ->\n From ! {token_reply, ok}\n end.\n\n find(_, []) -> {inactive};\n find(Token, [{T, {Subject, Client, Scope, active}} | Rest]) ->\n case T =:= Token of\n true -> {active, Subject, Client, Scope};\n false -> find(Token, Rest)\n end;\n find(Token, [{T, {_, _, _, revoked}} | Rest]) ->\n case T =:= Token of\n true -> {inactive};\n false -> find(Token, Rest)\n end.\n\n revoke_token(_, []) -> [];\n revoke_token(Token, [{T, {Su, Cl, Sc, St}} | Rest]) ->\n case T =:= Token of\n true -> [{T, {Su, Cl, Sc, revoked}} | Rest];\n false -> [{T, {Su, Cl, Sc, St}} | revoke_token(Token, Rest)]\n end.") + "-module(identity_tokens).\n\n start() ->\n spawn(fun () -> loop([], [], [], 1) end).\n\n issue(Reg, Subject, Client, Scope) ->\n Reg ! {issue, Subject, Client, Scope, self()},\n receive {token_reply, R} -> R end.\n\n issue_grant(Reg, Subject, Client, Scope) ->\n Reg ! {issue_grant, Subject, Client, Scope, 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 introspect(Reg, Token) ->\n Reg ! {introspect, Token, 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 stop(Reg) ->\n Reg ! {stop, self()},\n receive {token_reply, R} -> R end.\n\n loop(Grants, Access, Refresh, NextGid) ->\n receive\n {issue, Subject, Client, Scope, From} ->\n Gid = NextGid,\n Tok = make_ref(),\n From ! {token_reply, {ok, Tok}},\n loop([{Gid, {Subject, Client, Scope, active}} | Grants],\n [{Tok, Gid} | Access], Refresh, NextGid + 1);\n {issue_grant, Subject, Client, Scope, From} ->\n Gid = NextGid,\n A = make_ref(),\n R = make_ref(),\n From ! {token_reply, {ok, A, R}},\n loop([{Gid, {Subject, Client, Scope, active}} | Grants],\n [{A, Gid} | Access],\n [{R, {Gid, current}} | Refresh],\n NextGid + 1);\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);\n {ok, {Gid, superseded}} ->\n From ! {token_reply, {error, invalid_grant}},\n loop(set_status(Gid, revoked, Grants), Access, Refresh, NextGid);\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);\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 loop(Grants,\n [{A2, Gid} | Access],\n [{R2, {Gid, current}} | supersede(RTok, Refresh)],\n NextGid)\n end\n end;\n {introspect, Tok, From} ->\n From ! {token_reply, introspect_access(Tok, Access, Grants)},\n loop(Grants, Access, Refresh, NextGid);\n {revoke, Tok, From} ->\n From ! {token_reply, ok},\n case find_gid(Tok, Access, Refresh) of\n none -> loop(Grants, Access, Refresh, NextGid);\n {ok, Gid} -> loop(set_status(Gid, revoked, Grants), Access, Refresh, NextGid)\n end;\n {stop, From} ->\n From ! {token_reply, ok}\n end.\n\n introspect_access(Tok, Access, Grants) ->\n case find(Tok, Access) of\n none -> {inactive};\n {ok, Gid} ->\n case find(Gid, Grants) of\n none -> {inactive};\n {ok, {Su, Cl, Sc, active}} -> {active, Su, Cl, Sc};\n {ok, {_, _, _, revoked}} -> {inactive}\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 set_status(_, _, []) -> [];\n set_status(Gid, St, [{G, {Su, Cl, Sc, Old}} | Rest]) ->\n case G =:= Gid of\n true -> [{G, {Su, Cl, Sc, St}} | Rest];\n false -> [{G, {Su, Cl, Sc, Old}} | 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 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! diff --git a/plans/identity-on-sx.md b/plans/identity-on-sx.md index aaef9c2a..4384e697 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` → **53/53** (Phase 1 + authz-code flow) +`bash lib/identity/conformance.sh` → **62/62** (Phase 1 + authz-code + refresh/rotation/cascade) ## Ground rules @@ -64,7 +64,7 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) ## Phase 2 — OAuth2 flows - [x] authorization-code flow as a message protocol -- [ ] refresh + rotation; revocation cascades to issued tokens +- [x] refresh + rotation; revocation cascades to issued tokens - [ ] tests: full code exchange, refresh, revoke-then-use (must fail) ## Phase 3 — Silent SSO + membership @@ -78,6 +78,14 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [ ] tests: audit completeness, cross-instance subject mapping ## Progress log +- 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 → From 20ba152e36bde704f0c5048178d61a7872a68379 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 00:35:10 +0000 Subject: [PATCH 07/27] identity: wire refresh into oauth + e2e flow tests (Phase 2 complete, +3 tests) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit exchange now issues an access+refresh pair (RFC 6749 §4.1.4/§5.1) via token.sx issue_grant; added the refresh grant (§6) delegating to token rotation. End-to-end: code-exchange → refresh → introspect (active), refresh-token reuse rejected (invalid_grant), and revoke-then-refresh blocked by grant cascade. oauth 17/17, 65/65. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/oauth.sx | 13 +++++--- lib/identity/scoreboard.json | 6 ++-- lib/identity/scoreboard.md | 4 +-- lib/identity/tests/oauth.sx | 62 ++++++++++++++++++++++++++---------- plans/identity-on-sx.md | 10 ++++-- 5 files changed, 67 insertions(+), 28 deletions(-) diff --git a/lib/identity/oauth.sx b/lib/identity/oauth.sx index 8c2008f0..aee0eac7 100644 --- a/lib/identity/oauth.sx +++ b/lib/identity/oauth.sx @@ -1,12 +1,14 @@ ;; identity/oauth.sx — the OAuth2 authorization-code flow as a message -;; protocol (RFC 6749 §4.1), with PKCE (RFC 7636, `plain` method). +;; protocol (RFC 6749 §4.1), with PKCE (RFC 7636, `plain` method) and the +;; refresh-token grant (RFC 6749 §6). ;; ;; The flow is a state machine threaded through one authorization-server ;; process, never a single function: ;; ;; authorize -> {consent_required, ReqId} (§4.1.1 request stored) ;; consent -> {code, Code} | {error, access_denied} (§4.1.2 grant/deny) -;; exchange -> {ok, Token} | {error, invalid_grant} (§4.1.3 / §5.2) +;; exchange -> {ok, Access, Refresh} | {error, invalid_grant} (§4.1.3/§5.1) +;; refresh -> {ok, Access, Refresh} | {error, invalid_grant} (§6) ;; ;; Security invariants enforced at exchange (§4.1.3, §10.5): ;; - the code is single-use: it is removed on the FIRST exchange attempt, @@ -16,13 +18,14 @@ ;; - PKCE: the presented verifier must match the stored challenge ;; (plain method: challenge == verifier), else invalid_grant. ;; -;; On success a token is issued into a grant-backed table (token.sx), so -;; revocation stays real. The server proves identity; it does not decide +;; Tokens are grant-backed (token.sx): exchange issues an access+refresh +;; pair, refresh rotates it, and revoking any token cascades to the grant — +;; so revocation is real. The server proves identity; it does not decide ;; permission — that is acl's job, keyed off the issued grant. (define identity-oauth-source - "-module(identity_oauth).\n\n start() ->\n spawn(fun () ->\n TokReg = identity_tokens:start(),\n loop(TokReg, [], [])\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 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 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, Pending, Codes) ->\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, [{ReqId, Rec} | Pending], Codes);\n {consent, ReqId, Decision, From} ->\n case find(ReqId, Pending) of\n none ->\n From ! {oauth_reply, {error, unknown_request}},\n loop(TokReg, Pending, Codes);\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, Pending2, [{Code, Rec} | Codes]);\n deny ->\n From ! {oauth_reply, {error, access_denied}},\n loop(TokReg, Pending2, Codes)\n end\n end;\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, Pending, Codes);\n {ok, Rec} ->\n Codes2 = remove(Code, Codes),\n From ! {oauth_reply, redeem(TokReg, Rec, ClientId, RedirectUri, Verifier)},\n loop(TokReg, Pending, Codes2)\n end;\n {introspect, Token, From} ->\n From ! {oauth_reply, identity_tokens:introspect(TokReg, Token)},\n loop(TokReg, Pending, Codes);\n {revoke, Token, From} ->\n identity_tokens:revoke(TokReg, Token),\n From ! {oauth_reply, ok},\n loop(TokReg, Pending, Codes)\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 ->\n {ok, Token} = identity_tokens:issue(TokReg, Subject, ClientId, Scope),\n {ok, Token}\n end\n end\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.") + "-module(identity_oauth).\n\n start() ->\n spawn(fun () ->\n TokReg = identity_tokens:start(),\n loop(TokReg, [], [])\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 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 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, Pending, Codes) ->\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, [{ReqId, Rec} | Pending], Codes);\n {consent, ReqId, Decision, From} ->\n case find(ReqId, Pending) of\n none ->\n From ! {oauth_reply, {error, unknown_request}},\n loop(TokReg, Pending, Codes);\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, Pending2, [{Code, Rec} | Codes]);\n deny ->\n From ! {oauth_reply, {error, access_denied}},\n loop(TokReg, Pending2, Codes)\n end\n end;\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, Pending, Codes);\n {ok, Rec} ->\n Codes2 = remove(Code, Codes),\n From ! {oauth_reply, redeem(TokReg, Rec, ClientId, RedirectUri, Verifier)},\n loop(TokReg, Pending, Codes2)\n end;\n {refresh, RTok, From} ->\n From ! {oauth_reply, identity_tokens:refresh(TokReg, RTok)},\n loop(TokReg, Pending, Codes);\n {introspect, Token, From} ->\n From ! {oauth_reply, identity_tokens:introspect(TokReg, Token)},\n loop(TokReg, Pending, Codes);\n {revoke, Token, From} ->\n identity_tokens:revoke(TokReg, Token),\n From ! {oauth_reply, ok},\n loop(TokReg, Pending, Codes)\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 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! diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json index 5d763cf7..b5f2f020 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,12 +1,12 @@ { "language": "identity", - "total_pass": 62, - "total": 62, + "total_pass": 65, + "total": 65, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, {"name":"token","pass":18,"total":18,"status":"ok"}, {"name":"registry","pass":9,"total":9,"status":"ok"}, {"name":"api","pass":10,"total":10,"status":"ok"}, - {"name":"oauth","pass":14,"total":14,"status":"ok"} + {"name":"oauth","pass":17,"total":17,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index e03b1c5d..3803b034 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,6 +1,6 @@ # identity-on-sx Scoreboard -**Total: 62 / 62 tests passing** +**Total: 65 / 65 tests passing** | | Suite | Pass | Total | |---|---|---|---| @@ -8,7 +8,7 @@ | ✅ | token | 18 | 18 | | ✅ | registry | 9 | 9 | | ✅ | api | 10 | 10 | -| ✅ | oauth | 14 | 14 | +| ✅ | oauth | 17 | 17 | Generated by `lib/identity/conformance.sh`. diff --git a/lib/identity/tests/oauth.sx b/lib/identity/tests/oauth.sx index 69f02867..6160331e 100644 --- a/lib/identity/tests/oauth.sx +++ b/lib/identity/tests/oauth.sx @@ -1,8 +1,9 @@ ;; identity/tests/oauth.sx — OAuth2 authorization-code flow (RFC 6749 -;; §4.1) + PKCE (RFC 7636). Covers the full happy path and every -;; rejection: denied consent, single-use codes, client/redirect binding, -;; PKCE verifier mismatch, unknown code/request, and real revocation of -;; an exchanged token. +;; §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) @@ -44,12 +45,12 @@ "issued") (id-oauth-test - "exchanged token introspects active" + "exchanged access token introspects active" (idonm (ido-ev (str ido-granted - ", {ok, Tok} = identity_oauth:exchange(O, Code, webapp, uri1, verif1),\n case identity_oauth:introspect(O, Tok) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))) + ", {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 @@ -58,7 +59,7 @@ (ido-ev (str ido-granted - ", {ok, Tok} = identity_oauth:exchange(O, Code, webapp, uri1, verif1),\n case identity_oauth:introspect(O, Tok) of\n {active, Subject, _, _} -> Subject\n end"))) + ", {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 @@ -67,9 +68,29 @@ (ido-ev (str ido-granted - ", {ok, Tok} = identity_oauth:exchange(O, Code, webapp, uri1, verif1),\n case identity_oauth:introspect(O, Tok) of\n {active, _, _, Scope} -> Scope\n end"))) + ", {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 @@ -87,7 +108,7 @@ (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"))) + ", 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) ─────────────── @@ -98,7 +119,7 @@ (ido-ev (str ido-granted - ", case identity_oauth:exchange(O, Code, attacker, uri1, verif1) of\n {ok, _} -> ok;\n {error, Why} -> Why\n end"))) + ", case identity_oauth:exchange(O, Code, attacker, uri1, verif1) of\n {ok, _, _} -> ok;\n {error, Why} -> Why\n end"))) "invalid_grant") (id-oauth-test @@ -107,7 +128,7 @@ (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"))) + ", 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) ──────────────────────────── @@ -118,7 +139,7 @@ (ido-ev (str ido-granted - ", case identity_oauth:exchange(O, Code, webapp, uri1, badverif) of\n {ok, _} -> ok;\n {error, Why} -> Why\n end"))) + ", case identity_oauth:exchange(O, Code, webapp, uri1, badverif) of\n {ok, _, _} -> ok;\n {error, Why} -> Why\n end"))) "invalid_grant") ;; ── unknown code / request ─────────────────────────────────────── @@ -127,7 +148,7 @@ "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")) + "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 @@ -137,7 +158,7 @@ "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") -;; ── revocation is real on an exchanged token (RFC 7009) ────────── +;; ── revoke-then-use must fail (RFC 7009) ───────────────────────── (id-oauth-test "revoked exchanged token introspects inactive" @@ -145,16 +166,25 @@ (ido-ev (str ido-granted - ", {ok, Tok} = 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"))) + ", {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, _T1} = identity_oauth:exchange(O, C1, webapp, uri1, va),\n {ok, T2} = identity_oauth:exchange(O, C2, cli, uri2, vb),\n case identity_oauth:introspect(O, T2) of\n {active, Subject, _, _} -> Subject\n end")) + "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 diff --git a/plans/identity-on-sx.md b/plans/identity-on-sx.md index 4384e697..6f34fb29 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` → **62/62** (Phase 1 + authz-code + refresh/rotation/cascade) +`bash lib/identity/conformance.sh` → **65/65** (Phases 1–2 complete) ## Ground rules @@ -65,7 +65,7 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) ## Phase 2 — OAuth2 flows - [x] authorization-code flow as a message protocol - [x] refresh + rotation; revocation cascades to issued tokens -- [ ] tests: full code exchange, refresh, revoke-then-use (must fail) +- [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) @@ -78,6 +78,12 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [ ] tests: audit completeness, cross-instance subject mapping ## Progress log +- 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. From 56cf920041d0c6bcf5be923997849fe6a2d64661 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 00:45:15 +0000 Subject: [PATCH 08/27] =?UTF-8?q?identity:=20silent=20SSO=20prompt=3Dnone?= =?UTF-8?q?=20fast-path=20=E2=80=94=20one=20session,=20many=20clients=20(1?= =?UTF-8?q?0=20tests)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit oauth.sx now owns a session registry. establish creates a subject session; silent_authorize (OIDC prompt=none §3.1.2.1) asks "does this subject have a live session?" — if yes it mints a code skipping consent, bound to client + redirect_uri + PKCE exactly like a consented code; if no it returns login_required (a negative state, not a login redirect). One session serves many clients; end_session closes the fast-path. New tests/sso.sx. 75/75. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/conformance.sh | 4 ++ lib/identity/oauth.sx | 37 +++++------ lib/identity/scoreboard.json | 7 ++- lib/identity/scoreboard.md | 3 +- lib/identity/tests/sso.sx | 115 +++++++++++++++++++++++++++++++++++ plans/identity-on-sx.md | 10 ++- 6 files changed, 152 insertions(+), 24 deletions(-) create mode 100644 lib/identity/tests/sso.sx diff --git a/lib/identity/conformance.sh b/lib/identity/conformance.sh index a02693ce..d5221849 100755 --- a/lib/identity/conformance.sh +++ b/lib/identity/conformance.sh @@ -33,6 +33,7 @@ SUITES=( "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" ) cat > "$TMPFILE" << 'EPOCHS' @@ -54,6 +55,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/identity/tests/registry.sx") (load "lib/identity/tests/api.sx") (load "lib/identity/tests/oauth.sx") +(load "lib/identity/tests/sso.sx") (epoch 100) (eval "(list id-session-test-pass id-session-test-count)") (epoch 101) @@ -64,6 +66,8 @@ cat > "$TMPFILE" << 'EPOCHS' (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)") EPOCHS timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 diff --git a/lib/identity/oauth.sx b/lib/identity/oauth.sx index aee0eac7..672a5413 100644 --- a/lib/identity/oauth.sx +++ b/lib/identity/oauth.sx @@ -1,31 +1,32 @@ ;; identity/oauth.sx — the OAuth2 authorization-code flow as a message -;; protocol (RFC 6749 §4.1), with PKCE (RFC 7636, `plain` method) and the -;; refresh-token grant (RFC 6749 §6). +;; protocol (RFC 6749 §4.1), with PKCE (RFC 7636, `plain`), the refresh +;; grant (§6), and the silent `prompt=none` fast-path (OIDC §3.1.2.1). ;; ;; The flow is a state machine threaded through one authorization-server ;; process, never a single function: ;; -;; authorize -> {consent_required, ReqId} (§4.1.1 request stored) -;; consent -> {code, Code} | {error, access_denied} (§4.1.2 grant/deny) -;; exchange -> {ok, Access, Refresh} | {error, invalid_grant} (§4.1.3/§5.1) -;; refresh -> {ok, Access, Refresh} | {error, invalid_grant} (§6) +;; authorize -> {consent_required, ReqId} (§4.1.1) +;; 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} ;; -;; Security invariants enforced at exchange (§4.1.3, §10.5): -;; - the code is single-use: it is removed on the FIRST exchange attempt, -;; so replay yields invalid_grant; -;; - the code is bound to its client_id and redirect_uri; a mismatch is -;; invalid_grant; -;; - PKCE: the presented verifier must match the stored challenge -;; (plain method: challenge == verifier), else invalid_grant. +;; Silent SSO is the SAME machine on a fast-path, not a second +;; implementation: silent_authorize asks the session registry \"does this +;; subject have a live session?\". If yes it skips consent and mints a code +;; bound to the client + redirect_uri + PKCE challenge, exactly like a +;; consented code, so exchange is unchanged. If no, it returns +;; login_required — a negative state, NOT a redirect to a login page (that +;; is the client's UX problem). One session, many clients: every client +;; that asks silently against the same subject session gets its own code. ;; -;; Tokens are grant-backed (token.sx): exchange issues an access+refresh -;; pair, refresh rotates it, and revoking any token cascades to the grant — -;; so revocation is real. The server proves identity; it does not decide -;; permission — that is acl's job, keyed off the issued grant. +;; Tokens are grant-backed (token.sx); revocation cascades; the server +;; proves identity and delegates permission to acl. (define identity-oauth-source - "-module(identity_oauth).\n\n start() ->\n spawn(fun () ->\n TokReg = identity_tokens:start(),\n loop(TokReg, [], [])\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 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 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, Pending, Codes) ->\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, [{ReqId, Rec} | Pending], Codes);\n {consent, ReqId, Decision, From} ->\n case find(ReqId, Pending) of\n none ->\n From ! {oauth_reply, {error, unknown_request}},\n loop(TokReg, Pending, Codes);\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, Pending2, [{Code, Rec} | Codes]);\n deny ->\n From ! {oauth_reply, {error, access_denied}},\n loop(TokReg, Pending2, Codes)\n end\n end;\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, Pending, Codes);\n {ok, Rec} ->\n Codes2 = remove(Code, Codes),\n From ! {oauth_reply, redeem(TokReg, Rec, ClientId, RedirectUri, Verifier)},\n loop(TokReg, Pending, Codes2)\n end;\n {refresh, RTok, From} ->\n From ! {oauth_reply, identity_tokens:refresh(TokReg, RTok)},\n loop(TokReg, Pending, Codes);\n {introspect, Token, From} ->\n From ! {oauth_reply, identity_tokens:introspect(TokReg, Token)},\n loop(TokReg, Pending, Codes);\n {revoke, Token, From} ->\n identity_tokens:revoke(TokReg, Token),\n From ! {oauth_reply, ok},\n loop(TokReg, Pending, Codes)\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 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.") + "-module(identity_oauth).\n\n start() ->\n spawn(fun () ->\n TokReg = identity_tokens:start(),\n SessReg = identity_registry:start(),\n loop(TokReg, SessReg, [], [], 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 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 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, 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, [{ReqId, Rec} | Pending], Codes, NextSid);\n {consent, ReqId, Decision, From} ->\n case find(ReqId, Pending) of\n none ->\n From ! {oauth_reply, {error, unknown_request}},\n loop(TokReg, SessReg, 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, Pending2, [{Code, Rec} | Codes], NextSid);\n deny ->\n From ! {oauth_reply, {error, access_denied}},\n loop(TokReg, SessReg, 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, 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, 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, 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, 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, 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, Pending, Codes2, NextSid)\n end;\n {refresh, RTok, From} ->\n From ! {oauth_reply, identity_tokens:refresh(TokReg, RTok)},\n loop(TokReg, SessReg, Pending, Codes, NextSid);\n {introspect, Token, From} ->\n From ! {oauth_reply, identity_tokens:introspect(TokReg, Token)},\n loop(TokReg, SessReg, Pending, Codes, NextSid);\n {revoke, Token, From} ->\n identity_tokens:revoke(TokReg, Token),\n From ! {oauth_reply, ok},\n loop(TokReg, SessReg, Pending, Codes, NextSid);\n {session_expired, _Sid} ->\n loop(TokReg, SessReg, 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 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! diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json index b5f2f020..b1a4783b 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,12 +1,13 @@ { "language": "identity", - "total_pass": 65, - "total": 65, + "total_pass": 75, + "total": 75, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, {"name":"token","pass":18,"total":18,"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":"oauth","pass":17,"total":17,"status":"ok"}, + {"name":"sso","pass":10,"total":10,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index 3803b034..8cbd8a33 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,6 +1,6 @@ # identity-on-sx Scoreboard -**Total: 65 / 65 tests passing** +**Total: 75 / 75 tests passing** | | Suite | Pass | Total | |---|---|---|---| @@ -9,6 +9,7 @@ | ✅ | registry | 9 | 9 | | ✅ | api | 10 | 10 | | ✅ | oauth | 17 | 17 | +| ✅ | sso | 10 | 10 | Generated by `lib/identity/conformance.sh`. 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/plans/identity-on-sx.md b/plans/identity-on-sx.md index 6f34fb29..76a93595 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` → **65/65** (Phases 1–2 complete) +`bash lib/identity/conformance.sh` → **75/75** (Phases 1–2 + silent SSO) ## Ground rules @@ -68,7 +68,7 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [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) +- [x] `prompt=none` cross-app login (one session, many clients) - [ ] membership state + per-app grant projection - [ ] grant verification delegated cache (mirror Redis-cache pattern) @@ -78,6 +78,12 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [ ] tests: audit completeness, cross-instance subject mapping ## Progress log +- 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: From dc00ed9786642ab21680a261ba51ac7aa2e51c53 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 00:54:51 +0000 Subject: [PATCH 09/27] identity: membership state machine + per-app grant projection (17 tests) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit membership.sx — coop membership as a guarded state machine (none→pending→active→lapsed⇄active, any→revoked terminal); invalid transitions return explicit {error, CurrentStatus}, never silent no-ops. project(Subject, App) renders the one canonical state into a per-app claim ({member,Tier,App} / {pending,App} / {lapsed,App} / {denied,App} / {non_member,App}) — identity reports what the membership is; acl decides whether the app should honour it. New tests/membership.sx. 92/92. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/conformance.sh | 5 + lib/identity/membership.sx | 31 +++++++ lib/identity/scoreboard.json | 7 +- lib/identity/scoreboard.md | 3 +- lib/identity/tests/membership.sx | 155 +++++++++++++++++++++++++++++++ plans/identity-on-sx.md | 11 ++- 6 files changed, 206 insertions(+), 6 deletions(-) create mode 100644 lib/identity/membership.sx create mode 100644 lib/identity/tests/membership.sx diff --git a/lib/identity/conformance.sh b/lib/identity/conformance.sh index d5221849..d891a225 100755 --- a/lib/identity/conformance.sh +++ b/lib/identity/conformance.sh @@ -34,6 +34,7 @@ SUITES=( "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" ) cat > "$TMPFILE" << 'EPOCHS' @@ -50,12 +51,14 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/identity/registry.sx") (load "lib/identity/api.sx") (load "lib/identity/oauth.sx") +(load "lib/identity/membership.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") (epoch 100) (eval "(list id-session-test-pass id-session-test-count)") (epoch 101) @@ -68,6 +71,8 @@ cat > "$TMPFILE" << 'EPOCHS' (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)") EPOCHS timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 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/scoreboard.json b/lib/identity/scoreboard.json index b1a4783b..4ca9768d 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,13 +1,14 @@ { "language": "identity", - "total_pass": 75, - "total": 75, + "total_pass": 92, + "total": 92, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, {"name":"token","pass":18,"total":18,"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":"sso","pass":10,"total":10,"status":"ok"}, + {"name":"membership","pass":17,"total":17,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index 8cbd8a33..151ce467 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,6 +1,6 @@ # identity-on-sx Scoreboard -**Total: 75 / 75 tests passing** +**Total: 92 / 92 tests passing** | | Suite | Pass | Total | |---|---|---|---| @@ -10,6 +10,7 @@ | ✅ | api | 10 | 10 | | ✅ | oauth | 17 | 17 | | ✅ | sso | 10 | 10 | +| ✅ | membership | 17 | 17 | Generated by `lib/identity/conformance.sh`. 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/plans/identity-on-sx.md b/plans/identity-on-sx.md index 76a93595..4c05b1aa 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` → **75/75** (Phases 1–2 + silent SSO) +`bash lib/identity/conformance.sh` → **92/92** (Phases 1–2 + SSO + membership) ## Ground rules @@ -69,7 +69,7 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) ## Phase 3 — Silent SSO + membership - [x] `prompt=none` cross-app login (one session, many clients) -- [ ] membership state + per-app grant projection +- [x] membership state + per-app grant projection - [ ] grant verification delegated cache (mirror Redis-cache pattern) ## Phase 4 — Audit + federation @@ -78,6 +78,13 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [ ] tests: audit completeness, cross-instance subject mapping ## Progress log +- 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 From 785faf24418c3b559df818b6b2f28877273b7a4c Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 01:03:57 +0000 Subject: [PATCH 10/27] identity: delegated grant-verification cache with generation invalidation (Phase 3 complete, +9) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit cache.sx — a process wrapping the token registry, memoising introspect. Revocation stays real via generation invalidation: any revoke/refresh bumps a generation counter, so every cached positive instantly becomes a miss and re-validates against the live registry. A revoked token never reads valid out of cache, not for a millisecond. stats() exposes hits/misses. New tests/cache.sx. 101/101. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/cache.sx | 29 ++++++++++ lib/identity/conformance.sh | 5 ++ lib/identity/scoreboard.json | 7 +-- lib/identity/scoreboard.md | 3 +- lib/identity/tests/cache.sx | 102 +++++++++++++++++++++++++++++++++++ plans/identity-on-sx.md | 11 +++- 6 files changed, 151 insertions(+), 6 deletions(-) create mode 100644 lib/identity/cache.sx create mode 100644 lib/identity/tests/cache.sx 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/conformance.sh b/lib/identity/conformance.sh index d891a225..db90c03e 100755 --- a/lib/identity/conformance.sh +++ b/lib/identity/conformance.sh @@ -35,6 +35,7 @@ SUITES=( "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" ) cat > "$TMPFILE" << 'EPOCHS' @@ -52,6 +53,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/identity/api.sx") (load "lib/identity/oauth.sx") (load "lib/identity/membership.sx") +(load "lib/identity/cache.sx") (load "lib/identity/tests/session.sx") (load "lib/identity/tests/token.sx") (load "lib/identity/tests/registry.sx") @@ -59,6 +61,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/identity/tests/oauth.sx") (load "lib/identity/tests/sso.sx") (load "lib/identity/tests/membership.sx") +(load "lib/identity/tests/cache.sx") (epoch 100) (eval "(list id-session-test-pass id-session-test-count)") (epoch 101) @@ -73,6 +76,8 @@ cat > "$TMPFILE" << 'EPOCHS' (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)") EPOCHS timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json index 4ca9768d..750ae4b8 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,7 +1,7 @@ { "language": "identity", - "total_pass": 92, - "total": 92, + "total_pass": 101, + "total": 101, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, {"name":"token","pass":18,"total":18,"status":"ok"}, @@ -9,6 +9,7 @@ {"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":"membership","pass":17,"total":17,"status":"ok"}, + {"name":"cache","pass":9,"total":9,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index 151ce467..b5be1538 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,6 +1,6 @@ # identity-on-sx Scoreboard -**Total: 92 / 92 tests passing** +**Total: 101 / 101 tests passing** | | Suite | Pass | Total | |---|---|---|---| @@ -11,6 +11,7 @@ | ✅ | oauth | 17 | 17 | | ✅ | sso | 10 | 10 | | ✅ | membership | 17 | 17 | +| ✅ | cache | 9 | 9 | Generated by `lib/identity/conformance.sh`. 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/plans/identity-on-sx.md b/plans/identity-on-sx.md index 4c05b1aa..7ac033e0 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` → **92/92** (Phases 1–2 + SSO + membership) +`bash lib/identity/conformance.sh` → **101/101** (Phases 1–3 complete) ## Ground rules @@ -70,7 +70,7 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) ## Phase 3 — Silent SSO + membership - [x] `prompt=none` cross-app login (one session, many clients) - [x] membership state + per-app grant projection -- [ ] grant verification delegated cache (mirror Redis-cache pattern) +- [x] grant verification delegated cache (mirror Redis-cache pattern) ## Phase 4 — Audit + federation - [ ] every issue/refresh/revoke is a `persist` event; `(identity/audit subject)` @@ -78,6 +78,13 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [ ] tests: audit completeness, cross-instance subject mapping ## Progress log +- 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)` From a5c22c5a013527a019ce5786e9ecb48712b50458 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 01:16:18 +0000 Subject: [PATCH 11/27] =?UTF-8?q?identity:=20grant=20audit=20ledger=20?= =?UTF-8?q?=E2=80=94=20issue/refresh/revoke=20events,=20queryable=20per=20?= =?UTF-8?q?subject=20(10=20tests)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit audit.sx is an append-only ledger process. token.sx gains start/1(Audit) and emits an event on every grant transition (issue, refresh, revoke — including reuse-triggered revoke); start/0 stays unaudited so existing use is unchanged (token.sx has no compile-time dep on the audit module, it just sends to a pid). The ledger answers (identity/audit subject) via audit/actions/count/all, chronological. In-memory event stream; persist backing is a later Erlang<->persist bridge, out of scope. 111/111. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/audit.sx | 27 +++++++++ lib/identity/conformance.sh | 5 ++ lib/identity/scoreboard.json | 7 ++- lib/identity/scoreboard.md | 3 +- lib/identity/tests/audit.sx | 109 +++++++++++++++++++++++++++++++++++ lib/identity/token.sx | 10 +++- plans/identity-on-sx.md | 12 +++- 7 files changed, 165 insertions(+), 8 deletions(-) create mode 100644 lib/identity/audit.sx create mode 100644 lib/identity/tests/audit.sx 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/conformance.sh b/lib/identity/conformance.sh index db90c03e..c8610af2 100755 --- a/lib/identity/conformance.sh +++ b/lib/identity/conformance.sh @@ -36,6 +36,7 @@ SUITES=( "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" ) cat > "$TMPFILE" << 'EPOCHS' @@ -54,6 +55,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/identity/oauth.sx") (load "lib/identity/membership.sx") (load "lib/identity/cache.sx") +(load "lib/identity/audit.sx") (load "lib/identity/tests/session.sx") (load "lib/identity/tests/token.sx") (load "lib/identity/tests/registry.sx") @@ -62,6 +64,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/identity/tests/sso.sx") (load "lib/identity/tests/membership.sx") (load "lib/identity/tests/cache.sx") +(load "lib/identity/tests/audit.sx") (epoch 100) (eval "(list id-session-test-pass id-session-test-count)") (epoch 101) @@ -78,6 +81,8 @@ cat > "$TMPFILE" << 'EPOCHS' (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)") EPOCHS timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json index 750ae4b8..ff952f8b 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,7 +1,7 @@ { "language": "identity", - "total_pass": 101, - "total": 101, + "total_pass": 111, + "total": 111, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, {"name":"token","pass":18,"total":18,"status":"ok"}, @@ -10,6 +10,7 @@ {"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":"cache","pass":9,"total":9,"status":"ok"}, + {"name":"audit","pass":10,"total":10,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index b5be1538..8206db67 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,6 +1,6 @@ # identity-on-sx Scoreboard -**Total: 101 / 101 tests passing** +**Total: 111 / 111 tests passing** | | Suite | Pass | Total | |---|---|---|---| @@ -12,6 +12,7 @@ | ✅ | sso | 10 | 10 | | ✅ | membership | 17 | 17 | | ✅ | cache | 9 | 9 | +| ✅ | audit | 10 | 10 | Generated by `lib/identity/conformance.sh`. diff --git a/lib/identity/tests/audit.sx b/lib/identity/tests/audit.sx new file mode 100644 index 00000000..4d8652a4 --- /dev/null +++ b/lib/identity/tests/audit.sx @@ -0,0 +1,109 @@ +;; 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, 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) + +;; ── 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/token.sx b/lib/identity/token.sx index 9c4cb58c..f41f5dd3 100644 --- a/lib/identity/token.sx +++ b/lib/identity/token.sx @@ -15,17 +15,23 @@ ;; superseded refresh token is treated as token theft (RFC 6819 §5.2.2.3): ;; the entire grant is revoked, killing the legitimate descendant too. ;; +;; Auditing: start/1 takes an audit ledger (identity_audit); every grant +;; transition (issue, refresh, revoke — including a reuse-triggered +;; revoke) appends an event. start/0 passes `none` and audits nothing, so +;; standalone use is unchanged. +;; ;; introspect reply shapes (RFC 7662 §2.2): ;; {active, Subject, Client, Scope} | {inactive} ;; -;; State threaded through loop/4: +;; State threaded through loop/5: ;; Grants : [{Gid, {Subject, Client, Scope, active|revoked}}] ;; Access : [{AccessTok, Gid}] ;; Refresh : [{RefreshTok, {Gid, current|superseded}}] +;; Audit : an identity_audit pid, or the atom none (define identity-token-source - "-module(identity_tokens).\n\n start() ->\n spawn(fun () -> loop([], [], [], 1) end).\n\n issue(Reg, Subject, Client, Scope) ->\n Reg ! {issue, Subject, Client, Scope, self()},\n receive {token_reply, R} -> R end.\n\n issue_grant(Reg, Subject, Client, Scope) ->\n Reg ! {issue_grant, Subject, Client, Scope, 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 introspect(Reg, Token) ->\n Reg ! {introspect, Token, 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 stop(Reg) ->\n Reg ! {stop, self()},\n receive {token_reply, R} -> R end.\n\n loop(Grants, Access, Refresh, NextGid) ->\n receive\n {issue, Subject, Client, Scope, From} ->\n Gid = NextGid,\n Tok = make_ref(),\n From ! {token_reply, {ok, Tok}},\n loop([{Gid, {Subject, Client, Scope, active}} | Grants],\n [{Tok, Gid} | Access], Refresh, NextGid + 1);\n {issue_grant, Subject, Client, Scope, From} ->\n Gid = NextGid,\n A = make_ref(),\n R = make_ref(),\n From ! {token_reply, {ok, A, R}},\n loop([{Gid, {Subject, Client, Scope, active}} | Grants],\n [{A, Gid} | Access],\n [{R, {Gid, current}} | Refresh],\n NextGid + 1);\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);\n {ok, {Gid, superseded}} ->\n From ! {token_reply, {error, invalid_grant}},\n loop(set_status(Gid, revoked, Grants), Access, Refresh, NextGid);\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);\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 loop(Grants,\n [{A2, Gid} | Access],\n [{R2, {Gid, current}} | supersede(RTok, Refresh)],\n NextGid)\n end\n end;\n {introspect, Tok, From} ->\n From ! {token_reply, introspect_access(Tok, Access, Grants)},\n loop(Grants, Access, Refresh, NextGid);\n {revoke, Tok, From} ->\n From ! {token_reply, ok},\n case find_gid(Tok, Access, Refresh) of\n none -> loop(Grants, Access, Refresh, NextGid);\n {ok, Gid} -> loop(set_status(Gid, revoked, Grants), Access, Refresh, NextGid)\n end;\n {stop, From} ->\n From ! {token_reply, ok}\n end.\n\n introspect_access(Tok, Access, Grants) ->\n case find(Tok, Access) of\n none -> {inactive};\n {ok, Gid} ->\n case find(Gid, Grants) of\n none -> {inactive};\n {ok, {Su, Cl, Sc, active}} -> {active, Su, Cl, Sc};\n {ok, {_, _, _, revoked}} -> {inactive}\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 set_status(_, _, []) -> [];\n set_status(Gid, St, [{G, {Su, Cl, Sc, Old}} | Rest]) ->\n case G =:= Gid of\n true -> [{G, {Su, Cl, Sc, St}} | Rest];\n false -> [{G, {Su, Cl, Sc, Old}} | 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 find(_, []) -> none;\n find(Key, [{K, V} | Rest]) ->\n case K =:= Key of\n true -> {ok, V};\n false -> find(Key, Rest)\n end.") + "-module(identity_tokens).\n\n start() ->\n start(none).\n\n start(Audit) ->\n spawn(fun () -> loop([], [], [], 1, Audit) end).\n\n issue(Reg, Subject, Client, Scope) ->\n Reg ! {issue, Subject, Client, Scope, self()},\n receive {token_reply, R} -> R end.\n\n issue_grant(Reg, Subject, Client, Scope) ->\n Reg ! {issue_grant, Subject, Client, Scope, 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 introspect(Reg, Token) ->\n Reg ! {introspect, Token, 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 stop(Reg) ->\n Reg ! {stop, self()},\n receive {token_reply, R} -> R end.\n\n loop(Grants, Access, Refresh, NextGid, Audit) ->\n receive\n {issue, Subject, Client, Scope, 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}} | Grants],\n [{Tok, Gid} | Access], Refresh, NextGid + 1, Audit);\n {issue_grant, Subject, Client, Scope, 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}} | Grants],\n [{A, Gid} | Access],\n [{R, {Gid, current}} | Refresh],\n NextGid + 1, 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, 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, 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, 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} | Access],\n [{R2, {Gid, current}} | supersede(RTok, Refresh)],\n NextGid, Audit)\n end\n end;\n {introspect, Tok, From} ->\n From ! {token_reply, introspect_access(Tok, Access, Grants)},\n loop(Grants, Access, Refresh, NextGid, 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, Audit);\n {ok, Gid} ->\n audit_grant(Audit, Gid, Grants, revoke),\n loop(set_status(Gid, revoked, Grants), Access, Refresh, NextGid, Audit)\n end;\n {stop, From} ->\n From ! {token_reply, ok}\n end.\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 introspect_access(Tok, Access, Grants) ->\n case find(Tok, Access) of\n none -> {inactive};\n {ok, Gid} ->\n case find(Gid, Grants) of\n none -> {inactive};\n {ok, {Su, Cl, Sc, active}} -> {active, Su, Cl, Sc};\n {ok, {_, _, _, revoked}} -> {inactive}\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 set_status(_, _, []) -> [];\n set_status(Gid, St, [{G, {Su, Cl, Sc, Old}} | Rest]) ->\n case G =:= Gid of\n true -> [{G, {Su, Cl, Sc, St}} | Rest];\n false -> [{G, {Su, Cl, Sc, Old}} | 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 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! diff --git a/plans/identity-on-sx.md b/plans/identity-on-sx.md index 7ac033e0..dd3ce2fb 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` → **101/101** (Phases 1–3 complete) +`bash lib/identity/conformance.sh` → **111/111** (Phases 1–3 + audit ledger) ## Ground rules @@ -73,11 +73,19 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [x] grant verification delegated cache (mirror Redis-cache pattern) ## Phase 4 — Audit + federation -- [ ] every issue/refresh/revoke is a `persist` event; `(identity/audit subject)` +- [x] 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 ## Progress log +- 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 From e448220b334edce107249a1ffb3f78f8407cb5bb Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 01:29:08 +0000 Subject: [PATCH 12/27] identity: trust-gated federated identity + cross-instance mapping (Phase 4 complete, +13) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit federation.sx — peer-asserted subjects, advisory and trust-gated. An assertion is accepted only from an explicitly trusted peer (else {error, untrusted}) and is flagged {peer_asserted, Peer}, never promoted to local authority; acl decides what a peer-asserted identity may do. Cross- instance subject mapping namespaces remote subjects by peer ({federated, Peer, Remote}) so two peers' "alice" never collide, with optional explicit aliasing. Adds an audit-completeness test. New tests/federation.sx. All four phases done — 124/124. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/conformance.sh | 5 ++ lib/identity/federation.sx | 30 ++++++++ lib/identity/scoreboard.json | 7 +- lib/identity/scoreboard.md | 5 +- lib/identity/tests/audit.sx | 12 +++- lib/identity/tests/federation.sx | 115 +++++++++++++++++++++++++++++++ plans/identity-on-sx.md | 15 +++- 7 files changed, 179 insertions(+), 10 deletions(-) create mode 100644 lib/identity/federation.sx create mode 100644 lib/identity/tests/federation.sx diff --git a/lib/identity/conformance.sh b/lib/identity/conformance.sh index c8610af2..fa2857d1 100755 --- a/lib/identity/conformance.sh +++ b/lib/identity/conformance.sh @@ -37,6 +37,7 @@ SUITES=( "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" ) cat > "$TMPFILE" << 'EPOCHS' @@ -56,6 +57,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/identity/membership.sx") (load "lib/identity/cache.sx") (load "lib/identity/audit.sx") +(load "lib/identity/federation.sx") (load "lib/identity/tests/session.sx") (load "lib/identity/tests/token.sx") (load "lib/identity/tests/registry.sx") @@ -65,6 +67,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/identity/tests/membership.sx") (load "lib/identity/tests/cache.sx") (load "lib/identity/tests/audit.sx") +(load "lib/identity/tests/federation.sx") (epoch 100) (eval "(list id-session-test-pass id-session-test-count)") (epoch 101) @@ -83,6 +86,8 @@ cat > "$TMPFILE" << 'EPOCHS' (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)") EPOCHS timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 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/scoreboard.json b/lib/identity/scoreboard.json index ff952f8b..a7d4497e 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,7 +1,7 @@ { "language": "identity", - "total_pass": 111, - "total": 111, + "total_pass": 124, + "total": 124, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, {"name":"token","pass":18,"total":18,"status":"ok"}, @@ -11,6 +11,7 @@ {"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":10,"total":10,"status":"ok"} + {"name":"audit","pass":11,"total":11,"status":"ok"}, + {"name":"federation","pass":12,"total":12,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index 8206db67..2094f5ce 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,6 +1,6 @@ # identity-on-sx Scoreboard -**Total: 111 / 111 tests passing** +**Total: 124 / 124 tests passing** | | Suite | Pass | Total | |---|---|---|---| @@ -12,7 +12,8 @@ | ✅ | sso | 10 | 10 | | ✅ | membership | 17 | 17 | | ✅ | cache | 9 | 9 | -| ✅ | audit | 10 | 10 | +| ✅ | audit | 11 | 11 | +| ✅ | federation | 12 | 12 | Generated by `lib/identity/conformance.sh`. diff --git a/lib/identity/tests/audit.sx b/lib/identity/tests/audit.sx index 4d8652a4..b246f1af 100644 --- a/lib/identity/tests/audit.sx +++ b/lib/identity/tests/audit.sx @@ -1,8 +1,8 @@ ;; 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, and direct -;; ledger use. +;; registry, reuse-triggered revoke, per-subject isolation, completeness, +;; and direct ledger use. (define id-audit-test-count 0) (define id-audit-test-pass 0) @@ -79,6 +79,14 @@ "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 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/plans/identity-on-sx.md b/plans/identity-on-sx.md index dd3ce2fb..3ed3f930 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` → **111/111** (Phases 1–3 + audit ledger) +`bash lib/identity/conformance.sh` → **124/124** (all four phases complete) ## Ground rules @@ -74,10 +74,19 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) ## Phase 4 — Audit + federation - [x] 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] federated identity (peer-asserted subject) — advisory, trust-gated stub +- [x] tests: audit completeness, cross-instance subject mapping ## Progress log +- 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 From 21673b67318bc663d14a4ef0edcdfc9e4eb418e9 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 01:29:47 +0000 Subject: [PATCH 13/27] identity: mark base roadmap complete (124/124); add extensions backlog All four phases done. Records an extensions queue (PKCE S256, token TTL, scope sets/narrowing, client registry, client-credentials/device grants, acl delegation, state/nonce, unified facade) to keep deepening the engine. Co-Authored-By: Claude Opus 4.8 (1M context) --- plans/identity-on-sx.md | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/plans/identity-on-sx.md b/plans/identity-on-sx.md index 3ed3f930..e5a1107a 100644 --- a/plans/identity-on-sx.md +++ b/plans/identity-on-sx.md @@ -77,6 +77,16 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [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) — SHA256 challenge derivation, not just `plain` +- [ ] access-token TTL / `expires_in` — tokens expire as a grant timeout, introspect honours it +- [ ] scope as a set + scope narrowing on refresh (RFC 6749 §6) +- [ ] client registry: public vs confidential clients, client authentication (RFC 6749 §2) +- [ ] client-credentials grant (RFC 6749 §4.4) and device grant (RFC 8628) +- [ ] acl-on-sx delegation: wire `verify`/membership projection → an acl decision, integration test +- [ ] OAuth `state` (CSRF) + OIDC `nonce` threaded through authorize→exchange +- [ ] unify `api.sx` over oauth + membership + audit (one facade, audited login/consent) + ## Progress log - 2026-06-07 — `federation.sx`: trust-gated, advisory federated identity. A peer assertion is accepted only from an explicitly trusted peer From e951f23f14b1666cf328b13c290a16426ae99143 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 01:43:16 +0000 Subject: [PATCH 14/27] =?UTF-8?q?identity:=20scope-as-set=20+=20scope=20na?= =?UTF-8?q?rrowing=20on=20refresh=20(RFC=206749=20=C2=A76,=20+6=20tests)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Each access token now carries its own effective scope (<= the grant's max). refresh/3 requests a narrower scope; the request must be a subset of the grant scope, else {error, invalid_scope} and the refresh token is NOT consumed (client may retry, §5.2). refresh/2 keeps full scope; scope stays opaque (atom or list) for issue so all prior atom-scope tests are unchanged. Also files a Blocker: PKCE S256 is blocked on erlang substrate bugs (binary =:= always true; crypto:hash ignores binary content). token 24/24, 130/130. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/scoreboard.json | 6 ++--- lib/identity/scoreboard.md | 4 +-- lib/identity/tests/token.sx | 50 +++++++++++++++++++++++++++++++++--- lib/identity/token.sx | 21 ++++++++++----- plans/identity-on-sx.md | 31 +++++++++++++++++++--- 5 files changed, 93 insertions(+), 19 deletions(-) diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json index a7d4497e..d206d258 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,10 +1,10 @@ { "language": "identity", - "total_pass": 124, - "total": 124, + "total_pass": 130, + "total": 130, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, - {"name":"token","pass":18,"total":18,"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"}, diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index 2094f5ce..7488a197 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,11 +1,11 @@ # identity-on-sx Scoreboard -**Total: 124 / 124 tests passing** +**Total: 130 / 130 tests passing** | | Suite | Pass | Total | |---|---|---|---| | ✅ | session | 11 | 11 | -| ✅ | token | 18 | 18 | +| ✅ | token | 24 | 24 | | ✅ | registry | 9 | 9 | | ✅ | api | 10 | 10 | | ✅ | oauth | 17 | 17 | diff --git a/lib/identity/tests/token.sx b/lib/identity/tests/token.sx index 7c9d1edc..caf85612 100644 --- a/lib/identity/tests/token.sx +++ b/lib/identity/tests/token.sx @@ -1,7 +1,7 @@ ;; identity/tests/token.sx — opaque tokens, grant-backed lookup, real -;; revocation, refresh-token rotation, and cascading revocation. The -;; revoke-then-introspect and refresh-reuse paths are the security -;; centrepieces. +;; 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) @@ -166,6 +166,50 @@ "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 index f41f5dd3..199515eb 100644 --- a/lib/identity/token.sx +++ b/lib/identity/token.sx @@ -1,5 +1,6 @@ ;; identity/token.sx — opaque, grant-backed tokens with refresh-token -;; rotation (RFC 6749 §6, RFC 6819 §5.2.2.3) and cascading revocation. +;; rotation (RFC 6749 §6, RFC 6819 §5.2.2.3), cascading revocation, and +;; scope narrowing on refresh (RFC 6749 §6 / §3.3). ;; ;; The grant is the unit of authorization and the unit of cascade: an ;; access token and a refresh token both reference a grant {Subject, @@ -15,23 +16,29 @@ ;; superseded refresh token is treated as token theft (RFC 6819 §5.2.2.3): ;; the entire grant is revoked, killing the legitimate descendant too. ;; -;; Auditing: start/1 takes an audit ledger (identity_audit); every grant -;; transition (issue, refresh, revoke — including a reuse-triggered -;; revoke) appends an event. start/0 passes `none` and audits nothing, so -;; standalone use is unchanged. +;; Scope: a grant records the maximum scope granted. Each access token +;; carries its own EFFECTIVE scope (<= the grant's). refresh/2 keeps the +;; grant scope; 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 (the client may retry). Scope is +;; treated opaquely for issue/refresh-2 (atom or list); narrowing in +;; refresh/3 treats it as a set (list of scope atoms). +;; +;; Auditing: start/1 takes an audit ledger; every grant transition +;; (issue, refresh, revoke) appends an event. start/0 audits nothing. ;; ;; introspect reply shapes (RFC 7662 §2.2): ;; {active, Subject, Client, Scope} | {inactive} ;; ;; State threaded through loop/5: ;; Grants : [{Gid, {Subject, Client, Scope, active|revoked}}] -;; Access : [{AccessTok, Gid}] +;; Access : [{AccessTok, {Gid, EffectiveScope}}] ;; Refresh : [{RefreshTok, {Gid, current|superseded}}] ;; 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, Audit) end).\n\n issue(Reg, Subject, Client, Scope) ->\n Reg ! {issue, Subject, Client, Scope, self()},\n receive {token_reply, R} -> R end.\n\n issue_grant(Reg, Subject, Client, Scope) ->\n Reg ! {issue_grant, Subject, Client, Scope, 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 introspect(Reg, Token) ->\n Reg ! {introspect, Token, 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 stop(Reg) ->\n Reg ! {stop, self()},\n receive {token_reply, R} -> R end.\n\n loop(Grants, Access, Refresh, NextGid, Audit) ->\n receive\n {issue, Subject, Client, Scope, 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}} | Grants],\n [{Tok, Gid} | Access], Refresh, NextGid + 1, Audit);\n {issue_grant, Subject, Client, Scope, 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}} | Grants],\n [{A, Gid} | Access],\n [{R, {Gid, current}} | Refresh],\n NextGid + 1, 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, 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, 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, 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} | Access],\n [{R2, {Gid, current}} | supersede(RTok, Refresh)],\n NextGid, Audit)\n end\n end;\n {introspect, Tok, From} ->\n From ! {token_reply, introspect_access(Tok, Access, Grants)},\n loop(Grants, Access, Refresh, NextGid, 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, Audit);\n {ok, Gid} ->\n audit_grant(Audit, Gid, Grants, revoke),\n loop(set_status(Gid, revoked, Grants), Access, Refresh, NextGid, Audit)\n end;\n {stop, From} ->\n From ! {token_reply, ok}\n end.\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 introspect_access(Tok, Access, Grants) ->\n case find(Tok, Access) of\n none -> {inactive};\n {ok, Gid} ->\n case find(Gid, Grants) of\n none -> {inactive};\n {ok, {Su, Cl, Sc, active}} -> {active, Su, Cl, Sc};\n {ok, {_, _, _, revoked}} -> {inactive}\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 set_status(_, _, []) -> [];\n set_status(Gid, St, [{G, {Su, Cl, Sc, Old}} | Rest]) ->\n case G =:= Gid of\n true -> [{G, {Su, Cl, Sc, St}} | Rest];\n false -> [{G, {Su, Cl, Sc, Old}} | 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 find(_, []) -> none;\n find(Key, [{K, V} | Rest]) ->\n case K =:= Key of\n true -> {ok, V};\n false -> find(Key, Rest)\n end.") + "-module(identity_tokens).\n\n start() ->\n start(none).\n\n start(Audit) ->\n spawn(fun () -> loop([], [], [], 1, Audit) end).\n\n issue(Reg, Subject, Client, Scope) ->\n Reg ! {issue, Subject, Client, Scope, self()},\n receive {token_reply, R} -> R end.\n\n issue_grant(Reg, Subject, Client, Scope) ->\n Reg ! {issue_grant, Subject, Client, Scope, 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 revoke(Reg, Token) ->\n Reg ! {revoke, Token, 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, Audit) ->\n receive\n {issue, Subject, Client, Scope, 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}} | Grants],\n [{Tok, {Gid, Scope}} | Access], Refresh, NextGid + 1, Audit);\n {issue_grant, Subject, Client, Scope, 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}} | Grants],\n [{A, {Gid, Scope}} | Access],\n [{R, {Gid, current}} | Refresh],\n NextGid + 1, 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, 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, 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, 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}} | Access],\n [{R2, {Gid, current}} | supersede(RTok, Refresh)],\n NextGid, 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, 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, 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, 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, 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}} | Access],\n [{R2, {Gid, current}} | supersede(RTok, Refresh)],\n NextGid, Audit)\n end\n end\n end;\n {introspect, Tok, From} ->\n From ! {token_reply, introspect_access(Tok, Access, Grants)},\n loop(Grants, Access, Refresh, NextGid, 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, Audit);\n {ok, Gid} ->\n audit_grant(Audit, Gid, Grants, revoke),\n loop(set_status(Gid, revoked, Grants), Access, Refresh, NextGid, Audit)\n end;\n {stop, From} ->\n From ! {token_reply, ok}\n end.\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 introspect_access(Tok, Access, Grants) ->\n case find(Tok, Access) of\n none -> {inactive};\n {ok, {Gid, Scope}} ->\n case find(Gid, Grants) of\n none -> {inactive};\n {ok, {Su, Cl, _, active}} -> {active, Su, Cl, Scope};\n {ok, {_, _, _, revoked}} -> {inactive}\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 set_status(_, _, []) -> [];\n set_status(Gid, St, [{G, {Su, Cl, Sc, Old}} | Rest]) ->\n case G =:= Gid of\n true -> [{G, {Su, Cl, Sc, St}} | Rest];\n false -> [{G, {Su, Cl, Sc, Old}} | 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! diff --git a/plans/identity-on-sx.md b/plans/identity-on-sx.md index e5a1107a..2a3f13b6 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` → **124/124** (all four phases complete) +`bash lib/identity/conformance.sh` → **130/130** (4 phases + ext: scope narrowing) ## Ground rules @@ -78,9 +78,9 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [x] tests: audit completeness, cross-instance subject mapping ## Extensions (base roadmap complete; deepen the engine) -- [ ] PKCE S256 method (RFC 7636 §4.2) — SHA256 challenge derivation, not just `plain` +- [~] PKCE S256 method (RFC 7636 §4.2) — BLOCKED on erlang substrate (see Blockers) - [ ] access-token TTL / `expires_in` — tokens expire as a grant timeout, introspect honours it -- [ ] scope as a set + scope narrowing on refresh (RFC 6749 §6) +- [x] scope as a set + scope narrowing on refresh (RFC 6749 §6) - [ ] client registry: public vs confidential clients, client authentication (RFC 6749 §2) - [ ] client-credentials grant (RFC 6749 §4.4) and device grant (RFC 8628) - [ ] acl-on-sx delegation: wire `verify`/membership projection → an acl decision, integration test @@ -88,6 +88,15 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [ ] unify `api.sx` over oauth + membership + audit (one facade, audited login/consent) ## Progress log +- 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 @@ -171,4 +180,18 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) `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. From a43825f25fd3440b7d516f9ed6f7ebca558e4c52 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 01:53:19 +0000 Subject: [PATCH 15/27] =?UTF-8?q?identity:=20access-token=20TTL=20via=20lo?= =?UTF-8?q?gical=20clock=20=E2=80=94=20expires=5Fin=20(RFC=206749=20=C2=A7?= =?UTF-8?q?4.2.2,=20+8=20tests)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The token registry holds a logical clock (advance/now; the substrate has no wall clock). Grants carry a Ttl; each access token carries an Expires (Now-at-issue + Ttl, or infinity); introspect returns inactive once Now reaches it. Refresh mints a fresh short-lived access token — short access tokens, long refresh tokens. issue/4 and issue_grant/4 default to infinity so all prior behaviour is unchanged. New tests/expiry.sx. token loop/6. 138/138. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/conformance.sh | 4 ++ lib/identity/scoreboard.json | 7 +-- lib/identity/scoreboard.md | 3 +- lib/identity/tests/expiry.sx | 92 ++++++++++++++++++++++++++++++++++++ lib/identity/token.sx | 50 ++++++++++---------- plans/identity-on-sx.md | 11 ++++- 6 files changed, 137 insertions(+), 30 deletions(-) create mode 100644 lib/identity/tests/expiry.sx diff --git a/lib/identity/conformance.sh b/lib/identity/conformance.sh index fa2857d1..3a5328f1 100755 --- a/lib/identity/conformance.sh +++ b/lib/identity/conformance.sh @@ -38,6 +38,7 @@ SUITES=( "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" ) cat > "$TMPFILE" << 'EPOCHS' @@ -68,6 +69,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/identity/tests/cache.sx") (load "lib/identity/tests/audit.sx") (load "lib/identity/tests/federation.sx") +(load "lib/identity/tests/expiry.sx") (epoch 100) (eval "(list id-session-test-pass id-session-test-count)") (epoch 101) @@ -88,6 +90,8 @@ cat > "$TMPFILE" << 'EPOCHS' (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)") EPOCHS timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json index d206d258..97e4e5a4 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,7 +1,7 @@ { "language": "identity", - "total_pass": 130, - "total": 130, + "total_pass": 138, + "total": 138, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, {"name":"token","pass":24,"total":24,"status":"ok"}, @@ -12,6 +12,7 @@ {"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":"federation","pass":12,"total":12,"status":"ok"}, + {"name":"expiry","pass":8,"total":8,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index 7488a197..48af5476 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,6 +1,6 @@ # identity-on-sx Scoreboard -**Total: 130 / 130 tests passing** +**Total: 138 / 138 tests passing** | | Suite | Pass | Total | |---|---|---|---| @@ -14,6 +14,7 @@ | ✅ | cache | 9 | 9 | | ✅ | audit | 11 | 11 | | ✅ | federation | 12 | 12 | +| ✅ | expiry | 8 | 8 | Generated by `lib/identity/conformance.sh`. 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/token.sx b/lib/identity/token.sx index 199515eb..24d62373 100644 --- a/lib/identity/token.sx +++ b/lib/identity/token.sx @@ -1,44 +1,46 @@ ;; identity/token.sx — opaque, grant-backed tokens with refresh-token -;; rotation (RFC 6749 §6, RFC 6819 §5.2.2.3), cascading revocation, and -;; scope narrowing on refresh (RFC 6749 §6 / §3.3). +;; rotation (RFC 6749 §6, RFC 6819 §5.2.2.3), cascading revocation, scope +;; narrowing (RFC 6749 §6 / §3.3), and access-token expiry (§4.2.2 / +;; §5.1 expires_in). ;; ;; 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}. Tokens are opaque handles (make_ref) carrying -;; no information; every introspection is a live lookup against the grant, -;; so revocation is real (RFC 7009): once a grant is revoked, every token -;; ever issued under it — access AND refresh, including rotated -;; descendants — reads inactive on the next call. Revoking ANY token of a -;; grant (access or refresh) cascades to the whole grant. +;; 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. +;; +;; Expiry uses a LOGICAL clock — the substrate has no wall clock. The +;; registry holds `Now`; `advance(Reg, N)` moves it forward (this stands in +;; for time passing). Each access token carries `Expires` (Now-at-issue + +;; grant Ttl, or `infinity`); introspect returns inactive once Now reaches +;; it. Refresh mints a FRESH short-lived access token (a new Expires from +;; the current Now) — the whole point of refresh: short access tokens, long +;; refresh tokens. ;; ;; Refresh rotation: refreshing supersedes the presented refresh token and -;; mints a fresh access+refresh pair under the same grant. Re-presenting a -;; superseded refresh token is treated as token theft (RFC 6819 §5.2.2.3): -;; the entire grant is revoked, killing the legitimate descendant too. +;; mints a fresh pair; re-presenting a superseded refresh token is theft +;; (RFC 6819 §5.2.2.3) and revokes the whole grant. ;; -;; Scope: a grant records the maximum scope granted. Each access token -;; carries its own EFFECTIVE scope (<= the grant's). refresh/2 keeps the -;; grant scope; 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 (the client may retry). Scope is -;; treated opaquely for issue/refresh-2 (atom or list); narrowing in -;; refresh/3 treats it as a set (list of scope atoms). +;; Scope: a grant records the max scope; each access token its effective +;; scope (<= the grant's). refresh/3 narrows (subset, else invalid_scope, +;; token not consumed). Scope is opaque (atom or list) for issue/refresh-2. ;; -;; Auditing: start/1 takes an audit ledger; every grant transition -;; (issue, refresh, revoke) appends an event. start/0 audits nothing. +;; Auditing: start/1 takes an audit ledger; issue/refresh/revoke append. ;; ;; introspect reply shapes (RFC 7662 §2.2): ;; {active, Subject, Client, Scope} | {inactive} ;; -;; State threaded through loop/5: -;; Grants : [{Gid, {Subject, Client, Scope, active|revoked}}] -;; Access : [{AccessTok, {Gid, EffectiveScope}}] +;; State threaded through loop/6: +;; Grants : [{Gid, {Subject, Client, Scope, active|revoked, Ttl}}] +;; Access : [{AccessTok, {Gid, EffectiveScope, Expires}}] ;; 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, Audit) end).\n\n issue(Reg, Subject, Client, Scope) ->\n Reg ! {issue, Subject, Client, Scope, self()},\n receive {token_reply, R} -> R end.\n\n issue_grant(Reg, Subject, Client, Scope) ->\n Reg ! {issue_grant, Subject, Client, Scope, 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 revoke(Reg, Token) ->\n Reg ! {revoke, Token, 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, Audit) ->\n receive\n {issue, Subject, Client, Scope, 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}} | Grants],\n [{Tok, {Gid, Scope}} | Access], Refresh, NextGid + 1, Audit);\n {issue_grant, Subject, Client, Scope, 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}} | Grants],\n [{A, {Gid, Scope}} | Access],\n [{R, {Gid, current}} | Refresh],\n NextGid + 1, 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, 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, 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, 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}} | Access],\n [{R2, {Gid, current}} | supersede(RTok, Refresh)],\n NextGid, 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, 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, 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, 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, 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}} | Access],\n [{R2, {Gid, current}} | supersede(RTok, Refresh)],\n NextGid, Audit)\n end\n end\n end;\n {introspect, Tok, From} ->\n From ! {token_reply, introspect_access(Tok, Access, Grants)},\n loop(Grants, Access, Refresh, NextGid, 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, Audit);\n {ok, Gid} ->\n audit_grant(Audit, Gid, Grants, revoke),\n loop(set_status(Gid, revoked, Grants), Access, Refresh, NextGid, Audit)\n end;\n {stop, From} ->\n From ! {token_reply, ok}\n end.\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 introspect_access(Tok, Access, Grants) ->\n case find(Tok, Access) of\n none -> {inactive};\n {ok, {Gid, Scope}} ->\n case find(Gid, Grants) of\n none -> {inactive};\n {ok, {Su, Cl, _, active}} -> {active, Su, Cl, Scope};\n {ok, {_, _, _, revoked}} -> {inactive}\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 set_status(_, _, []) -> [];\n set_status(Gid, St, [{G, {Su, Cl, Sc, Old}} | Rest]) ->\n case G =:= Gid of\n true -> [{G, {Su, Cl, Sc, St}} | Rest];\n false -> [{G, {Su, Cl, Sc, Old}} | 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.") + "-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 revoke(Reg, Token) ->\n Reg ! {revoke, Token, 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)}} | 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)}} | 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))}} | 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))}} | 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 {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 {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 introspect_access(Tok, Access, Grants, Now) ->\n case find(Tok, Access) of\n none -> {inactive};\n {ok, {Gid, Scope, Expires}} ->\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 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! diff --git a/plans/identity-on-sx.md b/plans/identity-on-sx.md index 2a3f13b6..b576a6eb 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` → **130/130** (4 phases + ext: scope narrowing) +`bash lib/identity/conformance.sh` → **138/138** (4 phases + ext: scope narrowing, token TTL) ## Ground rules @@ -79,7 +79,7 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) ## Extensions (base roadmap complete; deepen the engine) - [~] PKCE S256 method (RFC 7636 §4.2) — BLOCKED on erlang substrate (see Blockers) -- [ ] access-token TTL / `expires_in` — tokens expire as a grant timeout, introspect honours it +- [x] access-token TTL / `expires_in` — logical-clock expiry, introspect honours it - [x] scope as a set + scope narrowing on refresh (RFC 6749 §6) - [ ] client registry: public vs confidential clients, client authentication (RFC 6749 §2) - [ ] client-credentials grant (RFC 6749 §4.4) and device grant (RFC 8628) @@ -88,6 +88,13 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [ ] unify `api.sx` over oauth + membership + audit (one facade, audited login/consent) ## Progress log +- 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 From 9860582b4ab4e87491c6ed47b702c5a5a01fdde2 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 02:03:44 +0000 Subject: [PATCH 16/27] =?UTF-8?q?identity:=20OAuth=20client=20registry=20?= =?UTF-8?q?=E2=80=94=20public/confidential=20clients=20+=20redirect=20allo?= =?UTF-8?q?w-list=20(11=20tests)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit clients.sx (RFC 6749 §2) — confidential clients must present the correct secret at the token endpoint (wrong → invalid_client); public clients are identified but not authenticated; redirect_uris are pre-registered and checked by exact-match valid_redirect (§3.1.2.2 + Security BCP). Standalone module for now; wiring confidential-client auth into oauth exchange is a follow-up. New tests/clients.sx. 149/149. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/clients.sx | 28 +++++++++ lib/identity/conformance.sh | 5 ++ lib/identity/scoreboard.json | 7 ++- lib/identity/scoreboard.md | 3 +- lib/identity/tests/clients.sx | 108 ++++++++++++++++++++++++++++++++++ plans/identity-on-sx.md | 10 +++- 6 files changed, 155 insertions(+), 6 deletions(-) create mode 100644 lib/identity/clients.sx create mode 100644 lib/identity/tests/clients.sx 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 index 3a5328f1..bf71703a 100755 --- a/lib/identity/conformance.sh +++ b/lib/identity/conformance.sh @@ -39,6 +39,7 @@ SUITES=( "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" ) cat > "$TMPFILE" << 'EPOCHS' @@ -59,6 +60,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/identity/cache.sx") (load "lib/identity/audit.sx") (load "lib/identity/federation.sx") +(load "lib/identity/clients.sx") (load "lib/identity/tests/session.sx") (load "lib/identity/tests/token.sx") (load "lib/identity/tests/registry.sx") @@ -70,6 +72,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/identity/tests/audit.sx") (load "lib/identity/tests/federation.sx") (load "lib/identity/tests/expiry.sx") +(load "lib/identity/tests/clients.sx") (epoch 100) (eval "(list id-session-test-pass id-session-test-count)") (epoch 101) @@ -92,6 +95,8 @@ cat > "$TMPFILE" << 'EPOCHS' (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)") EPOCHS timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json index 97e4e5a4..7676bf1b 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,7 +1,7 @@ { "language": "identity", - "total_pass": 138, - "total": 138, + "total_pass": 149, + "total": 149, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, {"name":"token","pass":24,"total":24,"status":"ok"}, @@ -13,6 +13,7 @@ {"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":"expiry","pass":8,"total":8,"status":"ok"}, + {"name":"clients","pass":11,"total":11,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index 48af5476..0c4d98e4 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,6 +1,6 @@ # identity-on-sx Scoreboard -**Total: 138 / 138 tests passing** +**Total: 149 / 149 tests passing** | | Suite | Pass | Total | |---|---|---|---| @@ -15,6 +15,7 @@ | ✅ | audit | 11 | 11 | | ✅ | federation | 12 | 12 | | ✅ | expiry | 8 | 8 | +| ✅ | clients | 11 | 11 | Generated by `lib/identity/conformance.sh`. 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/plans/identity-on-sx.md b/plans/identity-on-sx.md index b576a6eb..86d6a9c7 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` → **138/138** (4 phases + ext: scope narrowing, token TTL) +`bash lib/identity/conformance.sh` → **149/149** (4 phases + ext: scope, TTL, client registry) ## Ground rules @@ -81,13 +81,19 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [~] 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) -- [ ] client registry: public vs confidential clients, client authentication (RFC 6749 §2) +- [x] client registry: public vs confidential clients, client authentication (RFC 6749 §2) - [ ] client-credentials grant (RFC 6749 §4.4) and device grant (RFC 8628) - [ ] acl-on-sx delegation: wire `verify`/membership projection → an acl decision, integration test - [ ] OAuth `state` (CSRF) + OIDC `nonce` threaded through authorize→exchange - [ ] unify `api.sx` over oauth + membership + audit (one facade, audited login/consent) ## Progress log +- 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 From 3f3459d1294e8a6edf6db3b6bf52f15139eee85c Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 02:22:26 +0000 Subject: [PATCH 17/27] =?UTF-8?q?identity:=20client-credentials=20grant=20?= =?UTF-8?q?(RFC=206749=20=C2=A74.4,=20+9=20tests)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit oauth.sx now owns a client registry (loop/6) with register_client and the client_credentials grant. A confidential client authenticates and gets a token acting on its own behalf (subject = the client), no refresh token (§4.4.3). A public client is unauthorized_client; any auth failure (unknown client or wrong secret) is invalid_client — no client-existence oracle (§5.2). identity-load-oauth! now pulls its deps. New tests/grants.sx. 158/158. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/conformance.sh | 4 ++ lib/identity/oauth.sx | 42 +++++++++------- lib/identity/scoreboard.json | 7 +-- lib/identity/scoreboard.md | 3 +- lib/identity/tests/grants.sx | 96 ++++++++++++++++++++++++++++++++++++ plans/identity-on-sx.md | 12 ++++- 6 files changed, 139 insertions(+), 25 deletions(-) create mode 100644 lib/identity/tests/grants.sx diff --git a/lib/identity/conformance.sh b/lib/identity/conformance.sh index bf71703a..99705a64 100755 --- a/lib/identity/conformance.sh +++ b/lib/identity/conformance.sh @@ -40,6 +40,7 @@ SUITES=( "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" ) cat > "$TMPFILE" << 'EPOCHS' @@ -73,6 +74,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/identity/tests/federation.sx") (load "lib/identity/tests/expiry.sx") (load "lib/identity/tests/clients.sx") +(load "lib/identity/tests/grants.sx") (epoch 100) (eval "(list id-session-test-pass id-session-test-count)") (epoch 101) @@ -97,6 +99,8 @@ cat > "$TMPFILE" << 'EPOCHS' (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)") EPOCHS timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 diff --git a/lib/identity/oauth.sx b/lib/identity/oauth.sx index 672a5413..08744343 100644 --- a/lib/identity/oauth.sx +++ b/lib/identity/oauth.sx @@ -1,33 +1,37 @@ -;; identity/oauth.sx — the OAuth2 authorization-code flow as a message -;; protocol (RFC 6749 §4.1), with PKCE (RFC 7636, `plain`), the refresh -;; grant (§6), and the silent `prompt=none` fast-path (OIDC §3.1.2.1). -;; -;; The flow is a state machine threaded through one authorization-server -;; process, never a single function: +;; 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), and +;; client-credentials (§4.4). ;; +;; The authz-code flow is a state machine on one process: ;; authorize -> {consent_required, ReqId} (§4.1.1) ;; 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} +;; client_credentials -> {ok, Token} | {error, invalid_client|unauthorized_client} ;; -;; Silent SSO is the SAME machine on a fast-path, not a second -;; implementation: silent_authorize asks the session registry \"does this -;; subject have a live session?\". If yes it skips consent and mints a code -;; bound to the client + redirect_uri + PKCE challenge, exactly like a -;; consented code, so exchange is unchanged. If no, it returns -;; login_required — a negative state, NOT a redirect to a login page (that -;; is the client's UX problem). One session, many clients: every client -;; that asks silently against the same subject session gets its own code. -;; -;; Tokens are grant-backed (token.sx); revocation cascades; the server -;; proves identity and delegates permission to acl. +;; Exchange enforces single-use codes (§10.5), client+redirect binding +;; (§4.1.3), PKCE. Silent SSO reuses the same machine. Tokens are +;; grant-backed (token.sx); revocation cascades. Client-credentials +;; authenticates a CONFIDENTIAL client (clients.sx) acting on its own +;; behalf — no end-user, no refresh token (§4.4.3); a public client is +;; unauthorized_client, and any auth failure (unknown client or wrong +;; secret) is invalid_client — never a client-existence oracle (§5.2). 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 loop(TokReg, SessReg, [], [], 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 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 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, 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, [{ReqId, Rec} | Pending], Codes, NextSid);\n {consent, ReqId, Decision, From} ->\n case find(ReqId, Pending) of\n none ->\n From ! {oauth_reply, {error, unknown_request}},\n loop(TokReg, SessReg, 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, Pending2, [{Code, Rec} | Codes], NextSid);\n deny ->\n From ! {oauth_reply, {error, access_denied}},\n loop(TokReg, SessReg, 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, 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, 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, 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, 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, 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, Pending, Codes2, NextSid)\n end;\n {refresh, RTok, From} ->\n From ! {oauth_reply, identity_tokens:refresh(TokReg, RTok)},\n loop(TokReg, SessReg, Pending, Codes, NextSid);\n {introspect, Token, From} ->\n From ! {oauth_reply, identity_tokens:introspect(TokReg, Token)},\n loop(TokReg, SessReg, Pending, Codes, NextSid);\n {revoke, Token, From} ->\n identity_tokens:revoke(TokReg, Token),\n From ! {oauth_reply, ok},\n loop(TokReg, SessReg, Pending, Codes, NextSid);\n {session_expired, _Sid} ->\n loop(TokReg, SessReg, 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 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.") + "-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 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 client_credentials(O, ClientId, Secret, Scope) ->\n O ! {client_credentials, ClientId, Secret, Scope, 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 {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 {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 {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 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 () (erlang-load-module identity-oauth-source))) + (fn + () + (identity-load-token!) + (identity-load-session!) + (identity-load-registry!) + (identity-load-clients!) + (erlang-load-module identity-oauth-source))) diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json index 7676bf1b..894e7a32 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,7 +1,7 @@ { "language": "identity", - "total_pass": 149, - "total": 149, + "total_pass": 158, + "total": 158, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, {"name":"token","pass":24,"total":24,"status":"ok"}, @@ -14,6 +14,7 @@ {"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":"clients","pass":11,"total":11,"status":"ok"}, + {"name":"grants","pass":9,"total":9,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index 0c4d98e4..dc6fe7a7 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,6 +1,6 @@ # identity-on-sx Scoreboard -**Total: 149 / 149 tests passing** +**Total: 158 / 158 tests passing** | | Suite | Pass | Total | |---|---|---|---| @@ -16,6 +16,7 @@ | ✅ | federation | 12 | 12 | | ✅ | expiry | 8 | 8 | | ✅ | clients | 11 | 11 | +| ✅ | grants | 9 | 9 | Generated by `lib/identity/conformance.sh`. 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/plans/identity-on-sx.md b/plans/identity-on-sx.md index 86d6a9c7..43f73023 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` → **149/149** (4 phases + ext: scope, TTL, client registry) +`bash lib/identity/conformance.sh` → **158/158** (4 phases + ext: scope, TTL, clients, client-creds) ## Ground rules @@ -82,12 +82,20 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [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) -- [ ] client-credentials grant (RFC 6749 §4.4) and device grant (RFC 8628) +- [~] client-credentials grant (RFC 6749 §4.4) DONE; device grant (RFC 8628) pending - [ ] acl-on-sx delegation: wire `verify`/membership projection → an acl decision, integration test - [ ] OAuth `state` (CSRF) + OIDC `nonce` threaded through authorize→exchange - [ ] unify `api.sx` over oauth + membership + audit (one facade, audited login/consent) ## Progress log +- 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 From 226d755b57d64cd2978d6cec0dda47206f1ab86a Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 02:39:03 +0000 Subject: [PATCH 18/27] identity: device authorization grant (RFC 8628, +10 tests) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit device.sx — for input-constrained devices. authorize → {device_code, user_code}; the human approves/denies out-of-band by user_code; the device polls by device_code through the §3.5 status machine (authorization_pending → access_denied / {ok, Token}). Device code is single-use once a token issues; approve-after-deny is rejected. Tokens grant-backed via token.sx. Device-code expiry + slow_down deferred (no wall clock). New tests/device.sx. 168/168. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/conformance.sh | 5 ++ lib/identity/device.sx | 33 +++++++++++ lib/identity/scoreboard.json | 7 ++- lib/identity/scoreboard.md | 3 +- lib/identity/tests/device.sx | 109 +++++++++++++++++++++++++++++++++++ plans/identity-on-sx.md | 11 +++- 6 files changed, 162 insertions(+), 6 deletions(-) create mode 100644 lib/identity/device.sx create mode 100644 lib/identity/tests/device.sx diff --git a/lib/identity/conformance.sh b/lib/identity/conformance.sh index 99705a64..51aac252 100755 --- a/lib/identity/conformance.sh +++ b/lib/identity/conformance.sh @@ -41,6 +41,7 @@ SUITES=( "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" ) cat > "$TMPFILE" << 'EPOCHS' @@ -62,6 +63,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/identity/audit.sx") (load "lib/identity/federation.sx") (load "lib/identity/clients.sx") +(load "lib/identity/device.sx") (load "lib/identity/tests/session.sx") (load "lib/identity/tests/token.sx") (load "lib/identity/tests/registry.sx") @@ -75,6 +77,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/identity/tests/expiry.sx") (load "lib/identity/tests/clients.sx") (load "lib/identity/tests/grants.sx") +(load "lib/identity/tests/device.sx") (epoch 100) (eval "(list id-session-test-pass id-session-test-count)") (epoch 101) @@ -101,6 +104,8 @@ cat > "$TMPFILE" << 'EPOCHS' (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)") EPOCHS timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 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/scoreboard.json b/lib/identity/scoreboard.json index 894e7a32..25a76068 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,7 +1,7 @@ { "language": "identity", - "total_pass": 158, - "total": 158, + "total_pass": 168, + "total": 168, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, {"name":"token","pass":24,"total":24,"status":"ok"}, @@ -15,6 +15,7 @@ {"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":"grants","pass":9,"total":9,"status":"ok"}, + {"name":"device","pass":10,"total":10,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index dc6fe7a7..2dd083ed 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,6 +1,6 @@ # identity-on-sx Scoreboard -**Total: 158 / 158 tests passing** +**Total: 168 / 168 tests passing** | | Suite | Pass | Total | |---|---|---|---| @@ -17,6 +17,7 @@ | ✅ | expiry | 8 | 8 | | ✅ | clients | 11 | 11 | | ✅ | grants | 9 | 9 | +| ✅ | device | 10 | 10 | Generated by `lib/identity/conformance.sh`. 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/plans/identity-on-sx.md b/plans/identity-on-sx.md index 43f73023..1a854821 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` → **158/158** (4 phases + ext: scope, TTL, clients, client-creds) +`bash lib/identity/conformance.sh` → **168/168** (4 phases + 6 ext incl device grant) ## Ground rules @@ -82,12 +82,19 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [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) -- [~] client-credentials grant (RFC 6749 §4.4) DONE; device grant (RFC 8628) pending +- [x] client-credentials grant (RFC 6749 §4.4) + device grant (RFC 8628) - [ ] acl-on-sx delegation: wire `verify`/membership projection → an acl decision, integration test - [ ] OAuth `state` (CSRF) + OIDC `nonce` threaded through authorize→exchange - [ ] unify `api.sx` over oauth + membership + audit (one facade, audited login/consent) ## Progress log +- 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 From d2f5b49d3f9fbc09d498e098ffe5c3d895ab40d5 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 02:51:48 +0000 Subject: [PATCH 19/27] identity: unify api.sx facade over audit + membership (+9 tests) The identity coordinator now owns an audit ledger and a membership registry alongside its token table (started with the ledger) and session registry. login/logout are audited; new ops history/enroll/member_status/member_project surface the audit and membership axes through the one `identity` door. Identity proves who and reports membership; acl still decides permission. Existing api behaviour unchanged. New tests/facade.sx. 177/177. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/api.sx | 35 +++++++------ lib/identity/conformance.sh | 4 ++ lib/identity/scoreboard.json | 7 +-- lib/identity/scoreboard.md | 3 +- lib/identity/tests/facade.sx | 97 ++++++++++++++++++++++++++++++++++++ plans/identity-on-sx.md | 11 +++- 6 files changed, 133 insertions(+), 24 deletions(-) create mode 100644 lib/identity/tests/facade.sx diff --git a/lib/identity/api.sx b/lib/identity/api.sx index ea3fec2d..b93eb924 100644 --- a/lib/identity/api.sx +++ b/lib/identity/api.sx @@ -1,27 +1,24 @@ -;; identity/api.sx — the identity service facade. +;; identity/api.sx — the unified identity service facade. ;; -;; `identity:start()` spawns one coordinator process that owns a token -;; table and a session registry and ties them together. It exposes the -;; whole-domain operations the architecture sketch names: +;; `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(Svc, Subject, Client, Scope[, Ttl]) -> {ok, SessionId, Token} -;; verify(Svc, Token) -> {active, Subject, Client, Scope} | {inactive} -;; revoke(Svc, Token) -> ok (revokes the token; real, immediate) -;; logout(Svc, SessionId) -> ok (tombstones + deregisters a session) -;; session_status(Svc, Sid) -> active | expired | revoked | gone +;; login / verify / revoke / logout / session_status (sessions + tokens) +;; history(Subject) (audit ledger) +;; enroll / member_status / member_project (membership) ;; -;; The coordinator is also the Owner the sessions notify on idle timeout, -;; so an expired session deregisters itself from the directory — the -;; timeout is the only liveness driver; nothing sweeps. -;; -;; Delegation boundary: verify/2 answers IDENTITY only — who the token -;; belongs to and what scope was granted. It deliberately does NOT answer -;; \"may they do X\"; that question belongs to acl-on-sx, which keys off the -;; {active, Subject, Client, Scope} this returns. +;; Every grant transition is audited: login records `login`, logout records +;; `logout`, and the token table (started with the ledger) records +;; issue/revoke. The coordinator owns the sessions, so an idle session +;; deregisters itself. verify answers IDENTITY only ({active, Subject, +;; Client, Scope}); 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 TokReg = identity_tokens:start(),\n SessReg = identity_registry:start(),\n loop(TokReg, SessReg, 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 session_status(Svc, SessionId) ->\n Svc ! {session_status, SessionId, self()},\n receive {identity_reply, R} -> R end.\n\n loop(TokReg, SessReg, 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 {ok, Token} = identity_tokens:issue(TokReg, Subject, Client, Scope),\n From ! {identity_reply, {ok, SessionId, Token}},\n loop(TokReg, SessReg, NextId + 1);\n {verify, Token, From} ->\n From ! {identity_reply, identity_tokens:introspect(TokReg, Token)},\n loop(TokReg, SessReg, NextId);\n {revoke, Token, From} ->\n identity_tokens:revoke(TokReg, Token),\n From ! {identity_reply, ok},\n loop(TokReg, SessReg, NextId);\n {logout, SessionId, From} ->\n case identity_registry:whereis_session(SessReg, SessionId) of\n {ok, Pid} -> identity_session:revoke(Pid);\n {error, _} -> ok\n end,\n identity_registry:deregister(SessReg, SessionId),\n From ! {identity_reply, ok},\n loop(TokReg, SessReg, 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, NextId);\n {session_expired, SessionId} ->\n identity_registry:deregister(SessReg, SessionId),\n loop(TokReg, SessReg, NextId)\n end.") + "-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 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 {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 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))) @@ -32,4 +29,6 @@ (identity-load-session!) (identity-load-token!) (identity-load-registry!) + (identity-load-audit!) + (identity-load-membership!) (identity-load-api!))) diff --git a/lib/identity/conformance.sh b/lib/identity/conformance.sh index 51aac252..f9cda2f9 100755 --- a/lib/identity/conformance.sh +++ b/lib/identity/conformance.sh @@ -42,6 +42,7 @@ SUITES=( "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" ) cat > "$TMPFILE" << 'EPOCHS' @@ -78,6 +79,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/identity/tests/clients.sx") (load "lib/identity/tests/grants.sx") (load "lib/identity/tests/device.sx") +(load "lib/identity/tests/facade.sx") (epoch 100) (eval "(list id-session-test-pass id-session-test-count)") (epoch 101) @@ -106,6 +108,8 @@ cat > "$TMPFILE" << 'EPOCHS' (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)") EPOCHS timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json index 25a76068..17d348a0 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,7 +1,7 @@ { "language": "identity", - "total_pass": 168, - "total": 168, + "total_pass": 177, + "total": 177, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, {"name":"token","pass":24,"total":24,"status":"ok"}, @@ -16,6 +16,7 @@ {"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":"device","pass":10,"total":10,"status":"ok"}, + {"name":"facade","pass":9,"total":9,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index 2dd083ed..7656001a 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,6 +1,6 @@ # identity-on-sx Scoreboard -**Total: 168 / 168 tests passing** +**Total: 177 / 177 tests passing** | | Suite | Pass | Total | |---|---|---|---| @@ -18,6 +18,7 @@ | ✅ | clients | 11 | 11 | | ✅ | grants | 9 | 9 | | ✅ | device | 10 | 10 | +| ✅ | facade | 9 | 9 | Generated by `lib/identity/conformance.sh`. 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/plans/identity-on-sx.md b/plans/identity-on-sx.md index 1a854821..51eb0ca4 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` → **168/168** (4 phases + 6 ext incl device grant) +`bash lib/identity/conformance.sh` → **177/177** (4 phases + 7 ext incl unified facade) ## Ground rules @@ -85,9 +85,16 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [x] client-credentials grant (RFC 6749 §4.4) + device grant (RFC 8628) - [ ] acl-on-sx delegation: wire `verify`/membership projection → an acl decision, integration test - [ ] OAuth `state` (CSRF) + OIDC `nonce` threaded through authorize→exchange -- [ ] unify `api.sx` over oauth + membership + audit (one facade, audited login/consent) +- [x] unify `api.sx` over membership + audit (one facade, audited login/logout) ## Progress log +- 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 From db885e15bcf16bbe7d5ebc686cda610cb05e945a Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 03:05:12 +0000 Subject: [PATCH 20/27] =?UTF-8?q?identity:=20identity->acl=20delegation=20?= =?UTF-8?q?boundary=20=E2=80=94=20401=20gates=20before=20403=20(+8=20tests?= =?UTF-8?q?)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit delegation.sx makes the loop's central rule concrete: check() introspects the token first — inactive → {error, unauthenticated} (401), acl never consulted — and only an authenticated subject's request is delegated to acl, which returns permit/deny ({error, forbidden} = 403). 401 strictly precedes 403. acl-on-sx (Datalog) is a different SX guest wired at the integration layer, so the decider here is a labelled stub (permits when Action in Scope); swap the pid and the boundary is unchanged. New tests/delegation.sx. 185/185 — extensions backlog clear. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/conformance.sh | 5 ++ lib/identity/delegation.sx | 34 +++++++++++ lib/identity/scoreboard.json | 7 ++- lib/identity/scoreboard.md | 3 +- lib/identity/tests/delegation.sx | 102 +++++++++++++++++++++++++++++++ plans/identity-on-sx.md | 13 +++- 6 files changed, 158 insertions(+), 6 deletions(-) create mode 100644 lib/identity/delegation.sx create mode 100644 lib/identity/tests/delegation.sx diff --git a/lib/identity/conformance.sh b/lib/identity/conformance.sh index f9cda2f9..21235753 100755 --- a/lib/identity/conformance.sh +++ b/lib/identity/conformance.sh @@ -43,6 +43,7 @@ SUITES=( "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" ) cat > "$TMPFILE" << 'EPOCHS' @@ -65,6 +66,7 @@ cat > "$TMPFILE" << 'EPOCHS' (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") @@ -80,6 +82,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/identity/tests/grants.sx") (load "lib/identity/tests/device.sx") (load "lib/identity/tests/facade.sx") +(load "lib/identity/tests/delegation.sx") (epoch 100) (eval "(list id-session-test-pass id-session-test-count)") (epoch 101) @@ -110,6 +113,8 @@ cat > "$TMPFILE" << 'EPOCHS' (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)") EPOCHS timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 diff --git a/lib/identity/delegation.sx b/lib/identity/delegation.sx new file mode 100644 index 00000000..2e96343e --- /dev/null +++ b/lib/identity/delegation.sx @@ -0,0 +1,34 @@ +;; identity/delegation.sx — the identity -> acl delegation boundary. +;; +;; This is the loop's central architectural rule made concrete: +;; AUTHENTICATION is identity's job; AUTHORIZATION is acl's. A request is +;; checked in two stages, and the order matters: +;; +;; 1. identity proves WHO via the opaque token (introspect). If the token +;; is inactive, the answer is {error, unauthenticated} — a 401. acl is +;; NEVER consulted; \"I don't know who you are\" is not a permission +;; question. +;; 2. only for an authenticated subject does identity construct the +;; permission query {Subject, Scope, Action, Resource} and HAND IT OFF +;; to acl. acl returns permit | deny; deny is {error, forbidden} — a +;; 403. identity itself never decides permission. +;; +;; The real decider is acl-on-sx (Datalog), which runs as a different +;; guest language on SX and is wired in at the integration layer. Here the +;; acl side is a labelled STUB process so the boundary is exercised: it +;; permits when the Action is within the token's granted Scope. Swap the +;; stub pid for the acl adapter and the boundary is unchanged. +;; +;; check(TokReg, Acl, Token, Action, Resource) -> +;; {ok, Subject} | {error, unauthenticated} | {error, forbidden} + +(define + identity-delegation-source + "-module(identity_delegation).\n\n check(TokReg, Acl, Token, Action, Resource) ->\n case identity_tokens:introspect(TokReg, Token) of\n {inactive} ->\n {error, unauthenticated};\n {active, Subject, _Client, Scope} ->\n Acl ! {acl_query, Subject, Scope, Action, Resource, self()},\n receive {acl_verdict, V} ->\n case V of\n permit -> {ok, Subject};\n deny -> {error, forbidden}\n end\n end\n end.\n\n %% --- stub acl decider (stands in for acl-on-sx / Datalog) ---\n %% Permits iff the Action is one of the token's granted scopes. The real\n %% acl decides on rules + facts; this only exercises the handoff shape.\n stub_acl() ->\n spawn(fun () -> acl_loop() end).\n\n acl_loop() ->\n receive\n {acl_query, _Subject, Scope, Action, _Resource, From} ->\n From ! {acl_verdict, decide(Action, Scope)},\n acl_loop();\n stop ->\n ok\n end.\n\n decide(Action, Scope) ->\n case member(Action, Scope) of\n true -> permit;\n false -> deny\n end.\n\n member(_, []) -> false;\n member(X, [Y | Rest]) ->\n case X =:= Y of\n true -> true;\n false -> member(X, Rest)\n end.") + +(define + identity-load-delegation! + (fn + () + (identity-load-token!) + (erlang-load-module identity-delegation-source))) diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json index 17d348a0..bb2185e4 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,7 +1,7 @@ { "language": "identity", - "total_pass": 177, - "total": 177, + "total_pass": 185, + "total": 185, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, {"name":"token","pass":24,"total":24,"status":"ok"}, @@ -17,6 +17,7 @@ {"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":"facade","pass":9,"total":9,"status":"ok"}, + {"name":"delegation","pass":8,"total":8,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index 7656001a..1dafb17c 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,6 +1,6 @@ # identity-on-sx Scoreboard -**Total: 177 / 177 tests passing** +**Total: 185 / 185 tests passing** | | Suite | Pass | Total | |---|---|---|---| @@ -19,6 +19,7 @@ | ✅ | grants | 9 | 9 | | ✅ | device | 10 | 10 | | ✅ | facade | 9 | 9 | +| ✅ | delegation | 8 | 8 | Generated by `lib/identity/conformance.sh`. 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/plans/identity-on-sx.md b/plans/identity-on-sx.md index 51eb0ca4..401ed562 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` → **177/177** (4 phases + 7 ext incl unified facade) +`bash lib/identity/conformance.sh` → **185/185** (4 phases + 8 ext; backlog clear) ## Ground rules @@ -83,11 +83,20 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [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) -- [ ] acl-on-sx delegation: wire `verify`/membership projection → an acl decision, integration test +- [x] acl-on-sx delegation: identity-gates-before-acl boundary (401 vs 403), stub decider (live Datalog bridge is cross-substrate) - [ ] OAuth `state` (CSRF) + OIDC `nonce` threaded through authorize→exchange - [x] unify `api.sx` over membership + audit (one facade, audited login/logout) ## Progress log +- 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 From b1f9c6bef0cbe0af34fd492a0ceec9f7613ae8ba Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 03:16:21 +0000 Subject: [PATCH 21/27] =?UTF-8?q?identity:=20subject-wide=20session=20mana?= =?UTF-8?q?gement=20=E2=80=94=20sessions=20+=20logout=5Fall=20(+8=20tests)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit api.sx gains sessions(Subject) (enumerate a subject's live sessions) and logout_all(Subject) ("log out everywhere") — revokes and deregisters every session the subject holds, auditing a logout per session, leaving other subjects' sessions untouched. Builds on registry.sessions_for. New tests/session_mgmt.sx. 193/193. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/api.sx | 16 +++--- lib/identity/conformance.sh | 4 ++ lib/identity/scoreboard.json | 7 +-- lib/identity/scoreboard.md | 3 +- lib/identity/tests/session_mgmt.sx | 81 ++++++++++++++++++++++++++++++ plans/identity-on-sx.md | 8 ++- 6 files changed, 107 insertions(+), 12 deletions(-) create mode 100644 lib/identity/tests/session_mgmt.sx diff --git a/lib/identity/api.sx b/lib/identity/api.sx index b93eb924..d743efdb 100644 --- a/lib/identity/api.sx +++ b/lib/identity/api.sx @@ -6,19 +6,21 @@ ;; whole-domain operations through one door: ;; ;; login / verify / revoke / logout / session_status (sessions + tokens) +;; sessions(Subject) / logout_all(Subject) (subject-wide mgmt) ;; history(Subject) (audit ledger) ;; enroll / member_status / member_project (membership) ;; -;; Every grant transition is audited: login records `login`, logout records -;; `logout`, and the token table (started with the ledger) records -;; issue/revoke. The coordinator owns the sessions, so an idle session -;; deregisters itself. verify answers IDENTITY only ({active, Subject, -;; Client, Scope}); membership projection reports WHAT a subject is for an -;; app; whether either may do a thing is acl's call. +;; Every grant transition is audited: login records `login`, logout (and +;; each logout under logout_all) records `logout`, and the token table +;; records issue/revoke. logout_all is \"log out everywhere\": it revokes and +;; deregisters every session a subject holds, leaving other subjects' +;; sessions untouched. The coordinator owns the sessions, so an idle +;; session deregisters itself. verify answers IDENTITY only; membership +;; projection reports WHAT a subject is for an app; permission is acl's. (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 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 {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 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.") + "-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 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 {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))) diff --git a/lib/identity/conformance.sh b/lib/identity/conformance.sh index 21235753..806ce8a5 100755 --- a/lib/identity/conformance.sh +++ b/lib/identity/conformance.sh @@ -44,6 +44,7 @@ SUITES=( "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" ) cat > "$TMPFILE" << 'EPOCHS' @@ -83,6 +84,7 @@ cat > "$TMPFILE" << 'EPOCHS' (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") (epoch 100) (eval "(list id-session-test-pass id-session-test-count)") (epoch 101) @@ -115,6 +117,8 @@ cat > "$TMPFILE" << 'EPOCHS' (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)") EPOCHS timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json index bb2185e4..0e52bebe 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,7 +1,7 @@ { "language": "identity", - "total_pass": 185, - "total": 185, + "total_pass": 193, + "total": 193, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, {"name":"token","pass":24,"total":24,"status":"ok"}, @@ -18,6 +18,7 @@ {"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":"delegation","pass":8,"total":8,"status":"ok"}, + {"name":"session-mgmt","pass":8,"total":8,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index 1dafb17c..b2eba5aa 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,6 +1,6 @@ # identity-on-sx Scoreboard -**Total: 185 / 185 tests passing** +**Total: 193 / 193 tests passing** | | Suite | Pass | Total | |---|---|---|---| @@ -20,6 +20,7 @@ | ✅ | device | 10 | 10 | | ✅ | facade | 9 | 9 | | ✅ | delegation | 8 | 8 | +| ✅ | session-mgmt | 8 | 8 | Generated by `lib/identity/conformance.sh`. 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/plans/identity-on-sx.md b/plans/identity-on-sx.md index 401ed562..2b5c7d52 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` → **185/185** (4 phases + 8 ext; backlog clear) +`bash lib/identity/conformance.sh` → **193/193** (4 phases + 9 ext) ## Ground rules @@ -86,8 +86,14 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [x] acl-on-sx delegation: identity-gates-before-acl boundary (401 vs 403), stub decider (live Datalog bridge is cross-substrate) - [ ] OAuth `state` (CSRF) + OIDC `nonce` threaded through authorize→exchange - [x] unify `api.sx` over membership + audit (one facade, audited login/logout) +- [x] subject-wide session management: `sessions(Subject)` + `logout_all` (log out everywhere) ## Progress log +- 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, From ded71705404c3105689daa39e209a6a40d2b51be Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 03:31:14 +0000 Subject: [PATCH 22/27] =?UTF-8?q?identity:=20token=20exchange=20=E2=80=94?= =?UTF-8?q?=20downscope=20into=20an=20independent=20token=20(RFC=208693,?= =?UTF-8?q?=20+8=20tests)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit oauth.sx gains token_exchange(SubjectToken, RequestedScope): a valid access token is downscoped into a NEW independent grant for the same subject (subset only, else invalid_scope; inactive subject token → invalid_grant). The exchanged token's lifecycle is independent of the subject token (revoking either leaves the other active); exchanges chain. Least-privilege handoff to downstream services. New tests/exchange.sx. 201/201. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/conformance.sh | 4 ++ lib/identity/oauth.sx | 21 +++---- lib/identity/scoreboard.json | 7 ++- lib/identity/scoreboard.md | 3 +- lib/identity/tests/exchange.sx | 110 +++++++++++++++++++++++++++++++++ plans/identity-on-sx.md | 10 ++- 6 files changed, 139 insertions(+), 16 deletions(-) create mode 100644 lib/identity/tests/exchange.sx diff --git a/lib/identity/conformance.sh b/lib/identity/conformance.sh index 806ce8a5..ab6d7fc5 100755 --- a/lib/identity/conformance.sh +++ b/lib/identity/conformance.sh @@ -45,6 +45,7 @@ SUITES=( "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" ) cat > "$TMPFILE" << 'EPOCHS' @@ -85,6 +86,7 @@ cat > "$TMPFILE" << 'EPOCHS' (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") (epoch 100) (eval "(list id-session-test-pass id-session-test-count)") (epoch 101) @@ -119,6 +121,8 @@ cat > "$TMPFILE" << 'EPOCHS' (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)") EPOCHS timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 diff --git a/lib/identity/oauth.sx b/lib/identity/oauth.sx index 08744343..6bbf608f 100644 --- a/lib/identity/oauth.sx +++ b/lib/identity/oauth.sx @@ -1,7 +1,7 @@ ;; 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), and -;; client-credentials (§4.4). +;; 7636, `plain`), refresh (§6), silent `prompt=none` (OIDC §3.1.2.1), +;; client-credentials (§4.4), and token exchange (RFC 8693). ;; ;; The authz-code flow is a state machine on one process: ;; authorize -> {consent_required, ReqId} (§4.1.1) @@ -12,19 +12,18 @@ ;; silent_authorize -> {code, Code} | {error, login_required} ;; register_client -> ok | {error, exists} ;; client_credentials -> {ok, Token} | {error, invalid_client|unauthorized_client} +;; token_exchange -> {ok, Token} | {error, invalid_grant|invalid_scope} ;; -;; Exchange enforces single-use codes (§10.5), client+redirect binding -;; (§4.1.3), PKCE. Silent SSO reuses the same machine. Tokens are -;; grant-backed (token.sx); revocation cascades. Client-credentials -;; authenticates a CONFIDENTIAL client (clients.sx) acting on its own -;; behalf — no end-user, no refresh token (§4.4.3); a public client is -;; unauthorized_client, and any auth failure (unknown client or wrong -;; secret) is invalid_client — never a client-existence oracle (§5.2). The -;; server proves identity; acl decides permission. +;; Token exchange (RFC 8693 §2.1) downscopes: a valid access token is +;; exchanged for a NEW independent grant for the same subject with a subset +;; of its scope — least-privilege handoff to a downstream service. The new +;; token's lifecycle is independent of the subject token (revoking one does +;; not revoke the other). 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 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 client_credentials(O, ClientId, Secret, Scope) ->\n O ! {client_credentials, ClientId, Secret, Scope, 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 {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 {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 {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 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.") + "-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 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 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 {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 {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! diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json index 0e52bebe..ab9ec2c4 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,7 +1,7 @@ { "language": "identity", - "total_pass": 193, - "total": 193, + "total_pass": 201, + "total": 201, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, {"name":"token","pass":24,"total":24,"status":"ok"}, @@ -19,6 +19,7 @@ {"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":"session-mgmt","pass":8,"total":8,"status":"ok"}, + {"name":"exchange","pass":8,"total":8,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index b2eba5aa..b2791e71 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,6 +1,6 @@ # identity-on-sx Scoreboard -**Total: 193 / 193 tests passing** +**Total: 201 / 201 tests passing** | | Suite | Pass | Total | |---|---|---|---| @@ -21,6 +21,7 @@ | ✅ | facade | 9 | 9 | | ✅ | delegation | 8 | 8 | | ✅ | session-mgmt | 8 | 8 | +| ✅ | exchange | 8 | 8 | Generated by `lib/identity/conformance.sh`. 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/plans/identity-on-sx.md b/plans/identity-on-sx.md index 2b5c7d52..a16b2e93 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` → **193/193** (4 phases + 9 ext) +`bash lib/identity/conformance.sh` → **201/201** (4 phases + 10 ext) ## Ground rules @@ -87,8 +87,16 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [ ] OAuth `state` (CSRF) + OIDC `nonce` threaded through authorize→exchange - [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 ## Progress log +- 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, From 3c3b09688a0059ef1344eee95d74ea726af884bb Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 03:56:16 +0000 Subject: [PATCH 23/27] =?UTF-8?q?identity:=20RFC=207662=20full=20introspec?= =?UTF-8?q?tion=20metadata=20=E2=80=94=20introspect=5Ffull=20(+9=20tests)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit introspect_full returns {active, Subject, Client, Scope, Exp, Iat, bearer} for live tokens and {inactive} otherwise — deepening the opaque-token / live-lookup model. Access tokens now carry Iat (clock-at-issue); exp = iat + ttl. Simple introspect is unchanged (all prior suites green). New tests/introspect.sx. 210/210. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/conformance.sh | 4 ++ lib/identity/scoreboard.json | 7 +-- lib/identity/scoreboard.md | 3 +- lib/identity/tests/introspect.sx | 93 ++++++++++++++++++++++++++++++++ lib/identity/token.sx | 32 ++++------- plans/identity-on-sx.md | 10 +++- 6 files changed, 123 insertions(+), 26 deletions(-) create mode 100644 lib/identity/tests/introspect.sx diff --git a/lib/identity/conformance.sh b/lib/identity/conformance.sh index ab6d7fc5..8035fde2 100755 --- a/lib/identity/conformance.sh +++ b/lib/identity/conformance.sh @@ -46,6 +46,7 @@ SUITES=( "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" ) cat > "$TMPFILE" << 'EPOCHS' @@ -87,6 +88,7 @@ cat > "$TMPFILE" << 'EPOCHS' (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") (epoch 100) (eval "(list id-session-test-pass id-session-test-count)") (epoch 101) @@ -123,6 +125,8 @@ cat > "$TMPFILE" << 'EPOCHS' (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)") EPOCHS timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json index ab9ec2c4..b0122f62 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,7 +1,7 @@ { "language": "identity", - "total_pass": 201, - "total": 201, + "total_pass": 210, + "total": 210, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, {"name":"token","pass":24,"total":24,"status":"ok"}, @@ -20,6 +20,7 @@ {"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":"exchange","pass":8,"total":8,"status":"ok"}, + {"name":"introspect","pass":9,"total":9,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index b2791e71..49045fae 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,6 +1,6 @@ # identity-on-sx Scoreboard -**Total: 201 / 201 tests passing** +**Total: 210 / 210 tests passing** | | Suite | Pass | Total | |---|---|---|---| @@ -22,6 +22,7 @@ | ✅ | delegation | 8 | 8 | | ✅ | session-mgmt | 8 | 8 | | ✅ | exchange | 8 | 8 | +| ✅ | introspect | 9 | 9 | Generated by `lib/identity/conformance.sh`. 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/token.sx b/lib/identity/token.sx index 24d62373..0b443dc6 100644 --- a/lib/identity/token.sx +++ b/lib/identity/token.sx @@ -1,7 +1,7 @@ ;; 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), and access-token expiry (§4.2.2 / -;; §5.1 expires_in). +;; narrowing (RFC 6749 §6 / §3.3), access-token expiry (§4.2.2 expires_in), +;; and full introspection metadata (RFC 7662 §2.2). ;; ;; The grant is the unit of authorization and the unit of cascade: an ;; access token and a refresh token both reference a grant {Subject, @@ -11,36 +11,26 @@ ;; inactive. Revoking ANY token of a grant cascades to the whole grant. ;; ;; Expiry uses a LOGICAL clock — the substrate has no wall clock. The -;; registry holds `Now`; `advance(Reg, N)` moves it forward (this stands in -;; for time passing). Each access token carries `Expires` (Now-at-issue + -;; grant Ttl, or `infinity`); introspect returns inactive once Now reaches -;; it. Refresh mints a FRESH short-lived access token (a new Expires from -;; the current Now) — the whole point of refresh: short access tokens, long -;; refresh tokens. -;; -;; Refresh rotation: refreshing supersedes the presented refresh token and -;; mints a fresh pair; re-presenting a superseded refresh token is theft -;; (RFC 6819 §5.2.2.3) and revokes the whole grant. -;; -;; Scope: a grant records the max scope; each access token its effective -;; scope (<= the grant's). refresh/3 narrows (subset, else invalid_scope, -;; token not consumed). Scope is opaque (atom or list) for issue/refresh-2. -;; -;; Auditing: start/1 takes an audit ledger; issue/refresh/revoke append. +;; registry holds `Now`; `advance(Reg, N)` moves it forward. Each access +;; token carries `Expires` (Now-at-issue + grant Ttl, or `infinity`) and +;; `Iat` (Now-at-issue). introspect returns inactive once Now reaches +;; Expires; refresh mints a fresh access token with new Iat/Expires. ;; ;; introspect reply shapes (RFC 7662 §2.2): -;; {active, Subject, Client, Scope} | {inactive} +;; introspect(Tok) -> {active, Subject, Client, Scope} | {inactive} +;; introspect_full(Tok) -> {active, Subject, Client, Scope, Exp, Iat, bearer} +;; | {inactive} ;; ;; State threaded through loop/6: ;; Grants : [{Gid, {Subject, Client, Scope, active|revoked, Ttl}}] -;; Access : [{AccessTok, {Gid, EffectiveScope, Expires}}] +;; 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 revoke(Reg, Token) ->\n Reg ! {revoke, Token, 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)}} | 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)}} | 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))}} | 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))}} | 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 {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 {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 introspect_access(Tok, Access, Grants, Now) ->\n case find(Tok, Access) of\n none -> {inactive};\n {ok, {Gid, Scope, Expires}} ->\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 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.") + "-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 revoke(Reg, Token) ->\n Reg ! {revoke, Token, 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 {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 {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 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 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! diff --git a/plans/identity-on-sx.md b/plans/identity-on-sx.md index a16b2e93..56551593 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` → **201/201** (4 phases + 10 ext) +`bash lib/identity/conformance.sh` → **210/210** (4 phases + 11 ext) ## Ground rules @@ -88,8 +88,16 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [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 +- 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, From 398209d4844c180597ef1f59be7af88a57d1a1da Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 04:09:55 +0000 Subject: [PATCH 24/27] identity: pushed authorization requests (PAR, RFC 9126, +7 tests) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit push_authorization_request lodges the authorization params under a single-use request_uri; authorize_pushed redeems it into the normal consent flow. Pushed requests reuse the pending store ({pushed, Rec} keyed by the request_uri ref — distinct from consent req_ids, so no collision and no new loop state). The pushed binding (client + redirect + PKCE) is still enforced at exchange. New tests/par.sx. 217/217. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/conformance.sh | 4 ++ lib/identity/oauth.sx | 20 +++++---- lib/identity/scoreboard.json | 7 +-- lib/identity/scoreboard.md | 3 +- lib/identity/tests/par.sx | 84 ++++++++++++++++++++++++++++++++++++ plans/identity-on-sx.md | 11 ++++- 6 files changed, 115 insertions(+), 14 deletions(-) create mode 100644 lib/identity/tests/par.sx diff --git a/lib/identity/conformance.sh b/lib/identity/conformance.sh index 8035fde2..a4889068 100755 --- a/lib/identity/conformance.sh +++ b/lib/identity/conformance.sh @@ -47,6 +47,7 @@ SUITES=( "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" ) cat > "$TMPFILE" << 'EPOCHS' @@ -89,6 +90,7 @@ cat > "$TMPFILE" << 'EPOCHS' (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") (epoch 100) (eval "(list id-session-test-pass id-session-test-count)") (epoch 101) @@ -127,6 +129,8 @@ cat > "$TMPFILE" << 'EPOCHS' (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)") EPOCHS timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 diff --git a/lib/identity/oauth.sx b/lib/identity/oauth.sx index 6bbf608f..4905fd2f 100644 --- a/lib/identity/oauth.sx +++ b/lib/identity/oauth.sx @@ -1,10 +1,13 @@ ;; 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), and token exchange (RFC 8693). +;; client-credentials (§4.4), token exchange (RFC 8693), and pushed +;; authorization requests (PAR, RFC 9126). ;; ;; 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} @@ -14,16 +17,17 @@ ;; client_credentials -> {ok, Token} | {error, invalid_client|unauthorized_client} ;; token_exchange -> {ok, Token} | {error, invalid_grant|invalid_scope} ;; -;; Token exchange (RFC 8693 §2.1) downscopes: a valid access token is -;; exchanged for a NEW independent grant for the same subject with a subset -;; of its scope — least-privilege handoff to a downstream service. The new -;; token's lifecycle is independent of the subject token (revoking one does -;; not revoke the other). Tokens are grant-backed (token.sx); revocation -;; cascades. The server proves identity; acl decides permission. +;; PAR lodges the authorization parameters up front under a single-use +;; request_uri, so they cannot be tampered with between request and +;; consent; authorize_pushed redeems it into a normal consent flow. Pushed +;; requests share the pending store (a {pushed, Rec} value, keyed by the +;; request_uri ref — distinct from consent req_ids, so the two never +;; collide). 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 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 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 {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 {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.") + "-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 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 {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! diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json index b0122f62..3aef5969 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,7 +1,7 @@ { "language": "identity", - "total_pass": 210, - "total": 210, + "total_pass": 217, + "total": 217, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, {"name":"token","pass":24,"total":24,"status":"ok"}, @@ -21,6 +21,7 @@ {"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":"introspect","pass":9,"total":9,"status":"ok"}, + {"name":"par","pass":7,"total":7,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index 49045fae..05d642aa 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,6 +1,6 @@ # identity-on-sx Scoreboard -**Total: 210 / 210 tests passing** +**Total: 217 / 217 tests passing** | | Suite | Pass | Total | |---|---|---|---| @@ -23,6 +23,7 @@ | ✅ | session-mgmt | 8 | 8 | | ✅ | exchange | 8 | 8 | | ✅ | introspect | 9 | 9 | +| ✅ | par | 7 | 7 | Generated by `lib/identity/conformance.sh`. 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/plans/identity-on-sx.md b/plans/identity-on-sx.md index 56551593..303a15b6 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` → **210/210** (4 phases + 11 ext) +`bash lib/identity/conformance.sh` → **217/217** (4 phases + 12 ext) — needs `timeout 580` ## Ground rules @@ -84,13 +84,20 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [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` (CSRF) + OIDC `nonce` threaded through authorize→exchange +- [~] 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] 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 +- 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 From 8130521f02f23b845b95971e6cdeaaae1fb95a42 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 04:48:45 +0000 Subject: [PATCH 25/27] identity: dynamic client registration (RFC 7591, +5 tests) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit register_dynamic generates a client_id + secret server-side and registers the client, returning {ok, ClientId, Secret} — self-service onboarding distinct from the manual register_client. A dynamic confidential client can then use client_credentials; a dynamic public client stays unauthorized_client. New tests/dynreg.sx. 222/222. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/conformance.sh | 4 +++ lib/identity/oauth.sx | 17 ++++----- lib/identity/scoreboard.json | 7 ++-- lib/identity/scoreboard.md | 3 +- lib/identity/tests/dynreg.sx | 68 ++++++++++++++++++++++++++++++++++++ plans/identity-on-sx.md | 9 ++++- 6 files changed, 93 insertions(+), 15 deletions(-) create mode 100644 lib/identity/tests/dynreg.sx diff --git a/lib/identity/conformance.sh b/lib/identity/conformance.sh index a4889068..a814e6a0 100755 --- a/lib/identity/conformance.sh +++ b/lib/identity/conformance.sh @@ -48,6 +48,7 @@ SUITES=( "exchange|id-xchg-test-pass|id-xchg-test-count" "introspect|id-intr-test-pass|id-intr-test-count" "par|id-par-test-pass|id-par-test-count" + "dynreg|id-dyn-test-pass|id-dyn-test-count" ) cat > "$TMPFILE" << 'EPOCHS' @@ -91,6 +92,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/identity/tests/exchange.sx") (load "lib/identity/tests/introspect.sx") (load "lib/identity/tests/par.sx") +(load "lib/identity/tests/dynreg.sx") (epoch 100) (eval "(list id-session-test-pass id-session-test-count)") (epoch 101) @@ -131,6 +133,8 @@ cat > "$TMPFILE" << 'EPOCHS' (eval "(list id-intr-test-pass id-intr-test-count)") (epoch 119) (eval "(list id-par-test-pass id-par-test-count)") +(epoch 120) +(eval "(list id-dyn-test-pass id-dyn-test-count)") EPOCHS timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 diff --git a/lib/identity/oauth.sx b/lib/identity/oauth.sx index 4905fd2f..8ae4c487 100644 --- a/lib/identity/oauth.sx +++ b/lib/identity/oauth.sx @@ -2,7 +2,8 @@ ;; 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). +;; 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) @@ -13,21 +14,17 @@ ;; 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} +;; 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} ;; -;; PAR lodges the authorization parameters up front under a single-use -;; request_uri, so they cannot be tampered with between request and -;; consent; authorize_pushed redeems it into a normal consent flow. Pushed -;; requests share the pending store (a {pushed, Rec} value, keyed by the -;; request_uri ref — distinct from consent req_ids, so the two never -;; collide). Tokens are grant-backed (token.sx); revocation cascades. The -;; server proves identity; acl decides permission. +;; 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 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 {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.") + "-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! diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json index 3aef5969..3f3692d8 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,7 +1,7 @@ { "language": "identity", - "total_pass": 217, - "total": 217, + "total_pass": 222, + "total": 222, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, {"name":"token","pass":24,"total":24,"status":"ok"}, @@ -22,6 +22,7 @@ {"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":"par","pass":7,"total":7,"status":"ok"}, + {"name":"dynreg","pass":5,"total":5,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index 05d642aa..7a36485d 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,6 +1,6 @@ # identity-on-sx Scoreboard -**Total: 217 / 217 tests passing** +**Total: 222 / 222 tests passing** | | Suite | Pass | Total | |---|---|---|---| @@ -24,6 +24,7 @@ | ✅ | exchange | 8 | 8 | | ✅ | introspect | 9 | 9 | | ✅ | par | 7 | 7 | +| ✅ | dynreg | 5 | 5 | Generated by `lib/identity/conformance.sh`. 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/plans/identity-on-sx.md b/plans/identity-on-sx.md index 303a15b6..ee4259a9 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` → **217/217** (4 phases + 12 ext) — needs `timeout 580` +`bash lib/identity/conformance.sh` → **222/222** (4 phases + 13 ext) — needs `timeout 580` ## Ground rules @@ -86,12 +86,19 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [x] acl-on-sx delegation: identity-gates-before-acl boundary (401 vs 403), stub decider (live Datalog bridge is cross-substrate) - [~] OAuth `state`/OIDC `nonce` — low value in this server-centric model (client-side echo); skipped - [x] pushed authorization requests (PAR, RFC 9126): single-use request_uri → consent +- [x] dynamic client registration (RFC 7591): server-generated client_id + secret - [x] unify `api.sx` over membership + audit (one facade, audited login/logout) - [x] subject-wide session management: `sessions(Subject)` + `logout_all` (log out everywhere) - [x] token exchange (RFC 8693): downscope a token into a new independent token - [x] RFC 7662 full introspection metadata (`introspect_full`: sub/client_id/scope/exp/iat/token_type) ## Progress log +- 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 From 3b782eba8aa46be009e9f22bfbac691d9063b295 Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 05:45:46 +0000 Subject: [PATCH 26/27] =?UTF-8?q?identity:=20"apps=20with=20access"=20?= =?UTF-8?q?=E2=80=94=20per-subject=20active-grant=20listing=20(+7=20tests)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 logged in), grants (which apps have access), history (what happened). New tests/account.sx. Conformance internal timeout raised to 1200s (22 suites, ~10min — run in background). 229/229. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/api.sx | 19 +++++---- lib/identity/conformance.sh | 6 ++- lib/identity/scoreboard.json | 7 ++-- lib/identity/scoreboard.md | 3 +- lib/identity/tests/account.sx | 74 +++++++++++++++++++++++++++++++++++ lib/identity/token.sx | 11 +++--- plans/identity-on-sx.md | 11 +++++- 7 files changed, 110 insertions(+), 21 deletions(-) create mode 100644 lib/identity/tests/account.sx diff --git a/lib/identity/api.sx b/lib/identity/api.sx index d743efdb..b96ea5c9 100644 --- a/lib/identity/api.sx +++ b/lib/identity/api.sx @@ -7,20 +7,19 @@ ;; ;; login / verify / revoke / logout / session_status (sessions + tokens) ;; sessions(Subject) / logout_all(Subject) (subject-wide mgmt) -;; history(Subject) (audit ledger) -;; enroll / member_status / member_project (membership) +;; grants(Subject) (apps with access) +;; history(Subject) (audit ledger) +;; enroll / member_status / member_project (membership) ;; -;; Every grant transition is audited: login records `login`, logout (and -;; each logout under logout_all) records `logout`, and the token table -;; records issue/revoke. logout_all is \"log out everywhere\": it revokes and -;; deregisters every session a subject holds, leaving other subjects' -;; sessions untouched. The coordinator owns the sessions, so an idle -;; session deregisters itself. verify answers IDENTITY only; membership -;; projection reports WHAT a subject is for an app; permission is acl's. +;; Per subject, three views answer \"what does this account look like\": +;; sessions (where it is logged in), grants (which apps have access), and +;; history (what happened). 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 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 {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.") + "-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 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 {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))) diff --git a/lib/identity/conformance.sh b/lib/identity/conformance.sh index a814e6a0..f247cf76 100755 --- a/lib/identity/conformance.sh +++ b/lib/identity/conformance.sh @@ -49,6 +49,7 @@ SUITES=( "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' @@ -93,6 +94,7 @@ cat > "$TMPFILE" << 'EPOCHS' (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) @@ -135,9 +137,11 @@ cat > "$TMPFILE" << 'EPOCHS' (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 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 +timeout 1200 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 parse_pair() { local epoch="$1" diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json index 3f3692d8..8571a3f2 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,7 +1,7 @@ { "language": "identity", - "total_pass": 222, - "total": 222, + "total_pass": 229, + "total": 229, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, {"name":"token","pass":24,"total":24,"status":"ok"}, @@ -23,6 +23,7 @@ {"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":"dynreg","pass":5,"total":5,"status":"ok"}, + {"name":"account","pass":7,"total":7,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index 7a36485d..867d4552 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,6 +1,6 @@ # identity-on-sx Scoreboard -**Total: 222 / 222 tests passing** +**Total: 229 / 229 tests passing** | | Suite | Pass | Total | |---|---|---|---| @@ -25,6 +25,7 @@ | ✅ | introspect | 9 | 9 | | ✅ | par | 7 | 7 | | ✅ | dynreg | 5 | 5 | +| ✅ | account | 7 | 7 | Generated by `lib/identity/conformance.sh`. diff --git a/lib/identity/tests/account.sx b/lib/identity/tests/account.sx new file mode 100644 index 00000000..056d3f9a --- /dev/null +++ b/lib/identity/tests/account.sx @@ -0,0 +1,74 @@ +;; identity/tests/account.sx — \"apps with access\": per-subject active-grant +;; listing, at the token registry (grants_for) and through the facade +;; (identity:grants). Completes the per-subject security trio with 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") + +;; ── facade-level grants ────────────────────────────────────────── + +(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 + "revoking a token drops it from identity:grants" + (ida-ev + "Svc = identity:start(),\n {ok, _S1, T1} = identity:login(Svc, alice, web, read),\n identity:login(Svc, alice, mobile, read),\n identity:revoke(Svc, T1),\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) + +(define + id-acct-test-summary + (str "account " id-acct-test-pass "/" id-acct-test-count)) diff --git a/lib/identity/token.sx b/lib/identity/token.sx index 0b443dc6..c9f84b98 100644 --- a/lib/identity/token.sx +++ b/lib/identity/token.sx @@ -1,7 +1,8 @@ ;; 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), -;; and full introspection metadata (RFC 7662 §2.2). +;; full introspection metadata (RFC 7662 §2.2), and per-subject grant +;; listing (the \"apps with access\" view). ;; ;; The grant is the unit of authorization and the unit of cascade: an ;; access token and a refresh token both reference a grant {Subject, @@ -12,14 +13,14 @@ ;; ;; 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` (Now-at-issue + grant Ttl, or `infinity`) and -;; `Iat` (Now-at-issue). introspect returns inactive once Now reaches -;; Expires; refresh mints a fresh access token with new Iat/Expires. +;; 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}}] @@ -30,7 +31,7 @@ (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 revoke(Reg, Token) ->\n Reg ! {revoke, Token, 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 {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 {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 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 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.") + "-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 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 {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 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 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! diff --git a/plans/identity-on-sx.md b/plans/identity-on-sx.md index ee4259a9..5d160281 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` → **222/222** (4 phases + 13 ext) — needs `timeout 580` +`bash lib/identity/conformance.sh` → **229/229** (4 phases + 14 ext) — slow (~10min, run in background; internal timeout 1200) ## Ground rules @@ -87,12 +87,21 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [~] 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] 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 +- 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 d466ca3414b1c6cd2734555ab7d83f394a67e92f Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 07:59:13 +0000 Subject: [PATCH 27/27] =?UTF-8?q?identity:=20"disconnect=20app"=20?= =?UTF-8?q?=E2=80=94=20revoke=5Fapp(Subject,=20Client)=20(+4=20tests)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 — completing the account-security view+action pairs (sessions/logout_all, grants/revoke_app, history). Other subjects' same-client grants are untouched. account 11/11, 233/233. Co-Authored-By: Claude Opus 4.8 (1M context) --- lib/identity/api.sx | 19 ++++++++-------- lib/identity/scoreboard.json | 6 ++--- lib/identity/scoreboard.md | 4 ++-- lib/identity/tests/account.sx | 42 +++++++++++++++++++++++++++++------ lib/identity/token.sx | 10 +++++---- plans/identity-on-sx.md | 9 +++++++- 6 files changed, 64 insertions(+), 26 deletions(-) diff --git a/lib/identity/api.sx b/lib/identity/api.sx index b96ea5c9..c4e0326b 100644 --- a/lib/identity/api.sx +++ b/lib/identity/api.sx @@ -7,19 +7,20 @@ ;; ;; login / verify / revoke / logout / session_status (sessions + tokens) ;; sessions(Subject) / logout_all(Subject) (subject-wide mgmt) -;; grants(Subject) (apps with access) -;; history(Subject) (audit ledger) -;; enroll / member_status / member_project (membership) +;; grants(Subject) / revoke_app(Subject, Client) (apps with access) +;; history(Subject) (audit ledger) +;; enroll / member_status / member_project (membership) ;; -;; Per subject, three views answer \"what does this account look like\": -;; sessions (where it is logged in), grants (which apps have access), and -;; history (what happened). 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. +;; 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 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 {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.") + "-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))) diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json index 8571a3f2..65954b0f 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,7 +1,7 @@ { "language": "identity", - "total_pass": 229, - "total": 229, + "total_pass": 233, + "total": 233, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, {"name":"token","pass":24,"total":24,"status":"ok"}, @@ -24,6 +24,6 @@ {"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":7,"total":7,"status":"ok"} + {"name":"account","pass":11,"total":11,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index 867d4552..f2713aef 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,6 +1,6 @@ # identity-on-sx Scoreboard -**Total: 229 / 229 tests passing** +**Total: 233 / 233 tests passing** | | Suite | Pass | Total | |---|---|---|---| @@ -25,7 +25,7 @@ | ✅ | introspect | 9 | 9 | | ✅ | par | 7 | 7 | | ✅ | dynreg | 5 | 5 | -| ✅ | account | 7 | 7 | +| ✅ | account | 11 | 11 | Generated by `lib/identity/conformance.sh`. diff --git a/lib/identity/tests/account.sx b/lib/identity/tests/account.sx index 056d3f9a..6facaefd 100644 --- a/lib/identity/tests/account.sx +++ b/lib/identity/tests/account.sx @@ -1,7 +1,7 @@ -;; identity/tests/account.sx — \"apps with access\": per-subject active-grant -;; listing, at the token registry (grants_for) and through the facade -;; (identity:grants). Completes the per-subject security trio with sessions -;; and history. +;; 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) @@ -49,7 +49,28 @@ "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") -;; ── facade-level grants ────────────────────────────────────────── +;; ── 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" @@ -58,9 +79,9 @@ 2) (id-acct-test - "revoking a token drops it from identity:grants" + "identity:revoke_app disconnects one app, leaving the rest" (ida-ev - "Svc = identity:start(),\n {ok, _S1, T1} = identity:login(Svc, alice, web, read),\n identity:login(Svc, alice, mobile, read),\n identity:revoke(Svc, T1),\n length(identity:grants(Svc, alice))") + "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 @@ -69,6 +90,13 @@ "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/token.sx b/lib/identity/token.sx index c9f84b98..dbeda3ec 100644 --- a/lib/identity/token.sx +++ b/lib/identity/token.sx @@ -1,15 +1,17 @@ ;; 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), and per-subject grant -;; listing (the \"apps with access\" view). +;; 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. +;; 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 @@ -31,7 +33,7 @@ (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 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 {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 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 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.") + "-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! diff --git a/plans/identity-on-sx.md b/plans/identity-on-sx.md index 5d160281..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` → **229/229** (4 phases + 14 ext) — slow (~10min, run in background; internal timeout 1200) +`bash lib/identity/conformance.sh` → **233/233** (4 phases + 15 ext) — slow (~10min, run in background; internal timeout 1200) ## Ground rules @@ -88,12 +88,19 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [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 +- 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