;; 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). ;; ;; 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. ;; ;; 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. ;; ;; introspect reply shapes (RFC 7662 §2.2): ;; {active, Subject, Client, Scope} | {inactive} ;; ;; 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, 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! (fn () (erlang-load-module identity-token-source)))