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, 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)))