;; 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), access-token expiry (§4.2.2 expires_in),
;; full introspection metadata (RFC 7662 §2.2), per-subject grant listing
;; (\"apps with access\"), and per-app revocation (\"disconnect this app\").
;;
;; 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;
;; `revoke_app(Subject, Client)` revokes every grant a subject holds for a
;; given client at once.
;;
;; Expiry uses a LOGICAL clock — the substrate has no wall clock. The
;; registry holds `Now`; `advance(Reg, N)` moves it forward. Each access
;; token carries `Expires` and `Iat`. introspect returns inactive once Now
;; reaches Expires; refresh mints a fresh access token with new Iat/Expires.
;;
;; introspect reply shapes (RFC 7662 §2.2):
;;   introspect(Tok)      -> {active, Subject, Client, Scope} | {inactive}
;;   introspect_full(Tok) -> {active, Subject, Client, Scope, Exp, Iat, bearer}
;;                         | {inactive}
;;   grants_for(Subject)  -> [{Client, Scope}, ...]   (active grants only)
;;
;; State threaded through loop/6:
;;   Grants  : [{Gid, {Subject, Client, Scope, active|revoked, Ttl}}]
;;   Access  : [{AccessTok, {Gid, EffectiveScope, Expires, Iat}}]
;;   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   introspect_full(Reg, Token) ->\n     Reg ! {introspect_full, Token, self()},\n     receive {token_reply, R} -> R end.\n\n   grants_for(Reg, Subject) ->\n     Reg ! {grants_for, Subject, 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   revoke_app(Reg, Subject, Client) ->\n     Reg ! {revoke_app, Subject, Client, 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), Now}} | 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), Now}} | 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)), Now}} | 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)), Now}} | 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       {introspect_full, Tok, From} ->\n         From ! {token_reply, introspect_meta(Tok, Access, Grants, Now)},\n         loop(Grants, Access, Refresh, NextGid, Now, Audit);\n       {grants_for, Subject, From} ->\n         From ! {token_reply, collect_grants(Subject, Grants, [])},\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       {revoke_app, Subject, Client, From} ->\n         audit_app(Audit, Subject, Client, Grants),\n         From ! {token_reply, ok},\n         loop(revoke_matching(Subject, Client, Grants), Access, Refresh, NextGid, Now, Audit);\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   audit_app(none, _, _, _) -> ok;\n   audit_app(_, _, _, []) -> ok;\n   audit_app(Audit, Subject, Client, [{_, {Su, Cl, _, St, _}} | Rest]) ->\n     case match_app(Su, Subject, Cl, Client, St) of\n       true ->\n         Audit ! {event, Subject, revoke},\n         audit_app(Audit, Subject, Client, Rest);\n       false ->\n         audit_app(Audit, Subject, Client, Rest)\n     end.\n\n   introspect_access(Tok, Access, Grants, Now) ->\n     case find(Tok, Access) of\n       none -> {inactive};\n       {ok, {Gid, Scope, Expires, _Iat}} ->\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   introspect_meta(Tok, Access, Grants, Now) ->\n     case find(Tok, Access) of\n       none -> {inactive};\n       {ok, {Gid, Scope, Expires, Iat}} ->\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, Expires, Iat, bearer};\n               false -> {inactive}\n             end;\n           {ok, {_, _, _, revoked, _}} -> {inactive}\n         end\n     end.\n\n   collect_grants(_, [], Acc) -> Acc;\n   collect_grants(Subject, [{_Gid, {Su, Cl, Sc, active, _Ttl}} | Rest], Acc) ->\n     case Su =:= Subject of\n       true -> collect_grants(Subject, Rest, [{Cl, Sc} | Acc]);\n       false -> collect_grants(Subject, Rest, Acc)\n     end;\n   collect_grants(Subject, [{_Gid, {_, _, _, revoked, _}} | Rest], Acc) ->\n     collect_grants(Subject, Rest, Acc).\n\n   revoke_matching(_, _, []) -> [];\n   revoke_matching(Subject, Client, [{Gid, {Su, Cl, Sc, St, Ttl}} | Rest]) ->\n     case match_app(Su, Subject, Cl, Client, St) of\n       true -> [{Gid, {Su, Cl, Sc, revoked, Ttl}} | revoke_matching(Subject, Client, Rest)];\n       false -> [{Gid, {Su, Cl, Sc, St, Ttl}} | revoke_matching(Subject, Client, Rest)]\n     end.\n\n   match_app(Su, Subject, Cl, Client, St) ->\n     case Su =:= Subject of\n       false -> false;\n       true ->\n         case Cl =:= Client of\n           false -> false;\n           true -> St =:= active\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)))
