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