rose-ash/lib/identity/oauth.sx

;; identity/oauth.sx — the OAuth2 authorization server as a message
;; protocol. Grants: authorization-code (RFC 6749 §4.1) with PKCE (RFC
;; 7636, `plain`), refresh (§6), silent `prompt=none` (OIDC §3.1.2.1),
;; client-credentials (§4.4), and token exchange (RFC 8693).
;;
;; The authz-code flow is a state machine on one process:
;;   authorize        -> {consent_required, ReqId}          (§4.1.1)
;;   consent          -> {code, Code} | {error, access_denied}
;;   exchange         -> {ok, Access, Refresh} | {error, invalid_grant}
;;   refresh          -> {ok, Access, Refresh} | {error, invalid_grant}
;;   establish        -> {ok, SessionId}    (interactive login = a session)
;;   silent_authorize -> {code, Code} | {error, login_required}
;;   register_client  -> ok | {error, exists}
;;   client_credentials -> {ok, Token} | {error, invalid_client|unauthorized_client}
;;   token_exchange   -> {ok, Token} | {error, invalid_grant|invalid_scope}
;;
;; Token exchange (RFC 8693 §2.1) downscopes: a valid access token is
;; exchanged for a NEW independent grant for the same subject with a subset
;; of its scope — least-privilege handoff to a downstream service. The new
;; token's lifecycle is independent of the subject token (revoking one does
;; not revoke the other). Tokens are grant-backed (token.sx); revocation
;; cascades. The server proves identity; acl decides permission.

(define
  identity-oauth-source
  "-module(identity_oauth).\n\n   start() ->\n     spawn(fun () ->\n       TokReg = identity_tokens:start(),\n       SessReg = identity_registry:start(),\n       ClientReg = identity_clients:start(),\n       loop(TokReg, SessReg, ClientReg, [], [], 1)\n     end).\n\n   authorize(O, ClientId, RedirectUri, Scope, Subject, Challenge) ->\n     O ! {authorize, ClientId, RedirectUri, Scope, Subject, Challenge, self()},\n     receive {oauth_reply, R} -> R end.\n\n   consent(O, ReqId, Decision) ->\n     O ! {consent, ReqId, Decision, self()},\n     receive {oauth_reply, R} -> R end.\n\n   exchange(O, Code, ClientId, RedirectUri, Verifier) ->\n     O ! {exchange, Code, ClientId, RedirectUri, Verifier, self()},\n     receive {oauth_reply, R} -> R end.\n\n   refresh(O, RefreshTok) ->\n     O ! {refresh, RefreshTok, self()},\n     receive {oauth_reply, R} -> R end.\n\n   establish(O, Subject, Client) ->\n     O ! {establish, Subject, Client, self()},\n     receive {oauth_reply, R} -> R end.\n\n   silent_authorize(O, ClientId, RedirectUri, Scope, Subject, Challenge) ->\n     O ! {silent_authorize, ClientId, RedirectUri, Scope, Subject, Challenge, self()},\n     receive {oauth_reply, R} -> R end.\n\n   end_session(O, SessionId) ->\n     O ! {end_session, SessionId, self()},\n     receive {oauth_reply, R} -> R end.\n\n   register_client(O, ClientId, Type, Secret, RedirectUris) ->\n     O ! {register_client, ClientId, Type, Secret, RedirectUris, self()},\n     receive {oauth_reply, R} -> R end.\n\n   client_credentials(O, ClientId, Secret, Scope) ->\n     O ! {client_credentials, ClientId, Secret, Scope, self()},\n     receive {oauth_reply, R} -> R end.\n\n   token_exchange(O, SubjectToken, RequestedScope) ->\n     O ! {token_exchange, SubjectToken, RequestedScope, self()},\n     receive {oauth_reply, R} -> R end.\n\n   introspect(O, Token) ->\n     O ! {introspect, Token, self()},\n     receive {oauth_reply, R} -> R end.\n\n   revoke(O, Token) ->\n     O ! {revoke, Token, self()},\n     receive {oauth_reply, R} -> R end.\n\n   loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid) ->\n     receive\n       {authorize, ClientId, RedirectUri, Scope, Subject, Challenge, From} ->\n         ReqId = make_ref(),\n         Rec = {ClientId, RedirectUri, Scope, Subject, Challenge},\n         From ! {oauth_reply, {consent_required, ReqId}},\n         loop(TokReg, SessReg, ClientReg, [{ReqId, Rec} | Pending], Codes, NextSid);\n       {consent, ReqId, Decision, From} ->\n         case find(ReqId, Pending) of\n           none ->\n             From ! {oauth_reply, {error, unknown_request}},\n             loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid);\n           {ok, Rec} ->\n             Pending2 = remove(ReqId, Pending),\n             case Decision of\n               allow ->\n                 Code = make_ref(),\n                 From ! {oauth_reply, {code, Code}},\n                 loop(TokReg, SessReg, ClientReg, Pending2, [{Code, Rec} | Codes], NextSid);\n               deny ->\n                 From ! {oauth_reply, {error, access_denied}},\n                 loop(TokReg, SessReg, ClientReg, Pending2, Codes, NextSid)\n             end\n         end;\n       {establish, Subject, Client, From} ->\n         Sid = NextSid,\n         Self = self(),\n         S = identity_session:start(Sid, Subject, Client, Self, infinity),\n         identity_registry:register(SessReg, Sid, Subject, Client, S),\n         From ! {oauth_reply, {ok, Sid}},\n         loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid + 1);\n       {silent_authorize, ClientId, RedirectUri, Scope, Subject, Challenge, From} ->\n         case subject_active(SessReg, Subject) of\n           false ->\n             From ! {oauth_reply, {error, login_required}},\n             loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid);\n           true ->\n             Code = make_ref(),\n             Rec = {ClientId, RedirectUri, Scope, Subject, Challenge},\n             From ! {oauth_reply, {code, Code}},\n             loop(TokReg, SessReg, ClientReg, Pending, [{Code, Rec} | Codes], NextSid)\n         end;\n       {end_session, Sid, From} ->\n         case identity_registry:whereis_session(SessReg, Sid) of\n           {ok, Pid} -> identity_session:revoke(Pid);\n           {error, _} -> ok\n         end,\n         identity_registry:deregister(SessReg, Sid),\n         From ! {oauth_reply, ok},\n         loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid);\n       {register_client, ClientId, Type, Secret, RedirectUris, From} ->\n         From ! {oauth_reply, identity_clients:register(ClientReg, ClientId, Type, Secret, RedirectUris)},\n         loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid);\n       {client_credentials, ClientId, Secret, Scope, From} ->\n         case identity_clients:authenticate(ClientReg, ClientId, Secret) of\n           {ok, confidential} ->\n             {ok, Token} = identity_tokens:issue(TokReg, ClientId, ClientId, Scope),\n             From ! {oauth_reply, {ok, Token}};\n           {ok, public} ->\n             From ! {oauth_reply, {error, unauthorized_client}};\n           {error, _} ->\n             From ! {oauth_reply, {error, invalid_client}}\n         end,\n         loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid);\n       {token_exchange, SubjectToken, RequestedScope, From} ->\n         case identity_tokens:introspect(TokReg, SubjectToken) of\n           {inactive} ->\n             From ! {oauth_reply, {error, invalid_grant}};\n           {active, Subject, Client, Scope} ->\n             case subset(RequestedScope, Scope) of\n               true ->\n                 {ok, NewTok} = identity_tokens:issue(TokReg, Subject, Client, RequestedScope),\n                 From ! {oauth_reply, {ok, NewTok}};\n               false ->\n                 From ! {oauth_reply, {error, invalid_scope}}\n             end\n         end,\n         loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid);\n       {exchange, Code, ClientId, RedirectUri, Verifier, From} ->\n         case find(Code, Codes) of\n           none ->\n             From ! {oauth_reply, {error, invalid_grant}},\n             loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid);\n           {ok, Rec} ->\n             Codes2 = remove(Code, Codes),\n             From ! {oauth_reply, redeem(TokReg, Rec, ClientId, RedirectUri, Verifier)},\n             loop(TokReg, SessReg, ClientReg, Pending, Codes2, NextSid)\n         end;\n       {refresh, RTok, From} ->\n         From ! {oauth_reply, identity_tokens:refresh(TokReg, RTok)},\n         loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid);\n       {introspect, Token, From} ->\n         From ! {oauth_reply, identity_tokens:introspect(TokReg, Token)},\n         loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid);\n       {revoke, Token, From} ->\n         identity_tokens:revoke(TokReg, Token),\n         From ! {oauth_reply, ok},\n         loop(TokReg, SessReg, ClientReg, Pending, Codes, NextSid)\n     end.\n\n   subject_active(SessReg, Subject) ->\n     case identity_registry:sessions_for(SessReg, Subject) of\n       {ok, Ids} -> any_active(SessReg, Ids)\n     end.\n\n   any_active(_, []) -> false;\n   any_active(SessReg, [Id | Rest]) ->\n     case identity_registry:whereis_session(SessReg, Id) of\n       {ok, Pid} ->\n         case identity_session:lookup(Pid) of\n           {ok, _} -> true;\n           {error, _} -> any_active(SessReg, Rest)\n         end;\n       {error, _} -> any_active(SessReg, Rest)\n     end.\n\n   redeem(TokReg, {CCid, CRedir, Scope, Subject, Challenge}, ClientId, RedirectUri, Verifier) ->\n     case CCid =:= ClientId of\n       false -> {error, invalid_grant};\n       true ->\n         case CRedir =:= RedirectUri of\n           false -> {error, invalid_grant};\n           true ->\n             case Challenge =:= Verifier of\n               false -> {error, invalid_grant};\n               true -> identity_tokens:issue_grant(TokReg, Subject, ClientId, Scope)\n             end\n         end\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, Rec} | Rest]) ->\n     case K =:= Key of\n       true -> {ok, Rec};\n       false -> find(Key, Rest)\n     end.\n\n   remove(_, []) -> [];\n   remove(Key, [{K, Rec} | Rest]) ->\n     case K =:= Key of\n       true -> remove(Key, Rest);\n       false -> [{K, Rec} | remove(Key, Rest)]\n     end.")

(define
  identity-load-oauth!
  (fn
    ()
    (identity-load-token!)
    (identity-load-session!)
    (identity-load-registry!)
    (identity-load-clients!)
    (erlang-load-module identity-oauth-source)))