giles
226d755b57
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 40s
device.sx — for input-constrained devices. authorize → {device_code,
user_code}; the human approves/denies out-of-band by user_code; the device
polls by device_code through the §3.5 status machine (authorization_pending
→ access_denied / {ok, Token}). Device code is single-use once a token
issues; approve-after-deny is rejected. Tokens grant-backed via token.sx.
Device-code expiry + slow_down deferred (no wall clock). New
tests/device.sx. 168/168.
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
34 lines
5.3 KiB
Plaintext
34 lines
5.3 KiB
Plaintext
;; 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)))
|