;; identity/device.sx — the device authorization grant (RFC 8628). ;; ;; For input-constrained devices (TVs, CLIs): the device gets a device_code ;; + user_code, the user approves out-of-band on another device, and the ;; device polls the token endpoint until it flips. The poll status machine ;; is RFC 8628 §3.5: ;; ;; authorize(ClientId, Scope) -> {ok, DeviceCode, UserCode} ;; approve(UserCode, Subject) -> ok | {error, ...} (the human's browser) ;; deny(UserCode) -> ok | {error, ...} ;; poll(DeviceCode) -> ;; pending -> {error, authorization_pending} ;; denied -> {error, access_denied} ;; approved -> {ok, Token} (device code is then single-use) ;; consumed -> {error, invalid_grant} ;; unknown -> {error, invalid_grant} ;; ;; Tokens are grant-backed (token.sx) so revocation stays real. Device-code ;; expiry and slow_down (poll-rate limiting) are deferred — the substrate ;; has no wall clock and the core status machine is the security-relevant ;; part; introspect via token.sx already honours token TTL. ;; ;; State: loop(TokReg, Requests) where Requests is ;; [{DeviceCode, UserCode, ClientId, Scope, Status}] ;; Status :: pending | {approved, Subject} | denied | consumed (define identity-device-source "-module(identity_device).\n\n start() ->\n spawn(fun () ->\n TokReg = identity_tokens:start(),\n loop(TokReg, [])\n end).\n\n authorize(D, ClientId, Scope) ->\n D ! {authorize, ClientId, Scope, self()},\n receive {device_reply, R} -> R end.\n\n approve(D, UserCode, Subject) ->\n D ! {approve, UserCode, Subject, self()},\n receive {device_reply, R} -> R end.\n\n deny(D, UserCode) ->\n D ! {deny, UserCode, self()},\n receive {device_reply, R} -> R end.\n\n poll(D, DeviceCode) ->\n D ! {poll, DeviceCode, self()},\n receive {device_reply, R} -> R end.\n\n introspect(D, Token) ->\n D ! {introspect, Token, self()},\n receive {device_reply, R} -> R end.\n\n loop(TokReg, Requests) ->\n receive\n {authorize, ClientId, Scope, From} ->\n DeviceCode = make_ref(),\n UserCode = make_ref(),\n From ! {device_reply, {ok, DeviceCode, UserCode}},\n loop(TokReg, [{DeviceCode, UserCode, ClientId, Scope, pending} | Requests]);\n {approve, UserCode, Subject, From} ->\n case find_user(UserCode, Requests) of\n none ->\n From ! {device_reply, {error, unknown_code}},\n loop(TokReg, Requests);\n {ok, {_, _, _, _, pending}} ->\n From ! {device_reply, ok},\n loop(TokReg, set_user(UserCode, {approved, Subject}, Requests));\n {ok, {_, _, _, _, St}} ->\n From ! {device_reply, {error, St}},\n loop(TokReg, Requests)\n end;\n {deny, UserCode, From} ->\n case find_user(UserCode, Requests) of\n none ->\n From ! {device_reply, {error, unknown_code}},\n loop(TokReg, Requests);\n {ok, {_, _, _, _, pending}} ->\n From ! {device_reply, ok},\n loop(TokReg, set_user(UserCode, denied, Requests));\n {ok, {_, _, _, _, St}} ->\n From ! {device_reply, {error, St}},\n loop(TokReg, Requests)\n end;\n {poll, DeviceCode, From} ->\n case find_device(DeviceCode, Requests) of\n none ->\n From ! {device_reply, {error, invalid_grant}},\n loop(TokReg, Requests);\n {ok, {_, _, _, _, pending}} ->\n From ! {device_reply, {error, authorization_pending}},\n loop(TokReg, Requests);\n {ok, {_, _, _, _, denied}} ->\n From ! {device_reply, {error, access_denied}},\n loop(TokReg, Requests);\n {ok, {_, _, _, _, consumed}} ->\n From ! {device_reply, {error, invalid_grant}},\n loop(TokReg, Requests);\n {ok, {_, _, ClientId, Scope, {approved, Subject}}} ->\n {ok, Token} = identity_tokens:issue(TokReg, Subject, ClientId, Scope),\n From ! {device_reply, {ok, Token}},\n loop(TokReg, set_device(DeviceCode, consumed, Requests))\n end;\n {introspect, Token, From} ->\n From ! {device_reply, identity_tokens:introspect(TokReg, Token)},\n loop(TokReg, Requests);\n {stop, From} ->\n From ! {device_reply, ok}\n end.\n\n find_device(_, []) -> none;\n find_device(DCode, [{D, U, C, S, St} | Rest]) ->\n case D =:= DCode of\n true -> {ok, {D, U, C, S, St}};\n false -> find_device(DCode, Rest)\n end.\n\n find_user(_, []) -> none;\n find_user(UCode, [{D, U, C, S, St} | Rest]) ->\n case U =:= UCode of\n true -> {ok, {D, U, C, S, St}};\n false -> find_user(UCode, Rest)\n end.\n\n set_device(_, _, []) -> [];\n set_device(DCode, NewSt, [{D, U, C, S, St} | Rest]) ->\n case D =:= DCode of\n true -> [{D, U, C, S, NewSt} | Rest];\n false -> [{D, U, C, S, St} | set_device(DCode, NewSt, Rest)]\n end.\n\n set_user(_, _, []) -> [];\n set_user(UCode, NewSt, [{D, U, C, S, St} | Rest]) ->\n case U =:= UCode of\n true -> [{D, U, C, S, NewSt} | Rest];\n false -> [{D, U, C, S, St} | set_user(UCode, NewSt, Rest)]\n end.") (define identity-load-device! (fn () (identity-load-token!) (erlang-load-module identity-device-source)))