Files
rose-ash/lib/identity/token.sx
giles baee67f561
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 37s
identity: refresh-token rotation + cascading revocation (token.sx grant-centric, +9 tests)
The grant {Subject,Client,Scope,Status} becomes the unit of authorization
and cascade; access + refresh tokens reference it. issue_grant returns an
access+refresh pair; refresh (RFC 6749 §6) supersedes the presented refresh
token and mints a fresh pair; reusing a superseded refresh token is treated
as theft (RFC 6819 §5.2.2.3) and revokes the whole family, killing the live
descendant. revoke of any token cascades to the grant. All prior token
behaviour preserved. token 18/18, 62/62.

Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
2026-06-07 00:26:05 +00:00

33 lines
5.8 KiB
Plaintext

;; identity/token.sx — opaque, grant-backed tokens with refresh-token
;; rotation (RFC 6749 §6, RFC 6819 §5.2.2.3) and cascading revocation.
;;
;; 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.
;;
;; 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.
;;
;; 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([], [], [], 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!
(fn () (erlang-load-module identity-token-source)))