rose-ash/lib/identity/token.sx

;; 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).
;;
;; 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.
;;
;; 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, 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   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!
  (fn () (erlang-load-module identity-token-source)))