From 226d755b57d64cd2978d6cec0dda47206f1ab86a Mon Sep 17 00:00:00 2001 From: giles Date: Sun, 7 Jun 2026 02:39:03 +0000 Subject: [PATCH] identity: device authorization grant (RFC 8628, +10 tests) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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) --- lib/identity/conformance.sh | 5 ++ lib/identity/device.sx | 33 +++++++++++ lib/identity/scoreboard.json | 7 ++- lib/identity/scoreboard.md | 3 +- lib/identity/tests/device.sx | 109 +++++++++++++++++++++++++++++++++++ plans/identity-on-sx.md | 11 +++- 6 files changed, 162 insertions(+), 6 deletions(-) create mode 100644 lib/identity/device.sx create mode 100644 lib/identity/tests/device.sx diff --git a/lib/identity/conformance.sh b/lib/identity/conformance.sh index 99705a64..51aac252 100755 --- a/lib/identity/conformance.sh +++ b/lib/identity/conformance.sh @@ -41,6 +41,7 @@ SUITES=( "expiry|id-expiry-test-pass|id-expiry-test-count" "clients|id-clients-test-pass|id-clients-test-count" "grants|id-grants-test-pass|id-grants-test-count" + "device|id-device-test-pass|id-device-test-count" ) cat > "$TMPFILE" << 'EPOCHS' @@ -62,6 +63,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/identity/audit.sx") (load "lib/identity/federation.sx") (load "lib/identity/clients.sx") +(load "lib/identity/device.sx") (load "lib/identity/tests/session.sx") (load "lib/identity/tests/token.sx") (load "lib/identity/tests/registry.sx") @@ -75,6 +77,7 @@ cat > "$TMPFILE" << 'EPOCHS' (load "lib/identity/tests/expiry.sx") (load "lib/identity/tests/clients.sx") (load "lib/identity/tests/grants.sx") +(load "lib/identity/tests/device.sx") (epoch 100) (eval "(list id-session-test-pass id-session-test-count)") (epoch 101) @@ -101,6 +104,8 @@ cat > "$TMPFILE" << 'EPOCHS' (eval "(list id-clients-test-pass id-clients-test-count)") (epoch 112) (eval "(list id-grants-test-pass id-grants-test-count)") +(epoch 113) +(eval "(list id-device-test-pass id-device-test-count)") EPOCHS timeout 600 "$SX_SERVER" < "$TMPFILE" > "$OUTFILE" 2>&1 diff --git a/lib/identity/device.sx b/lib/identity/device.sx new file mode 100644 index 00000000..7202d8f3 --- /dev/null +++ b/lib/identity/device.sx @@ -0,0 +1,33 @@ +;; 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))) diff --git a/lib/identity/scoreboard.json b/lib/identity/scoreboard.json index 894e7a32..25a76068 100644 --- a/lib/identity/scoreboard.json +++ b/lib/identity/scoreboard.json @@ -1,7 +1,7 @@ { "language": "identity", - "total_pass": 158, - "total": 158, + "total_pass": 168, + "total": 168, "suites": [ {"name":"session","pass":11,"total":11,"status":"ok"}, {"name":"token","pass":24,"total":24,"status":"ok"}, @@ -15,6 +15,7 @@ {"name":"federation","pass":12,"total":12,"status":"ok"}, {"name":"expiry","pass":8,"total":8,"status":"ok"}, {"name":"clients","pass":11,"total":11,"status":"ok"}, - {"name":"grants","pass":9,"total":9,"status":"ok"} + {"name":"grants","pass":9,"total":9,"status":"ok"}, + {"name":"device","pass":10,"total":10,"status":"ok"} ] } diff --git a/lib/identity/scoreboard.md b/lib/identity/scoreboard.md index dc6fe7a7..2dd083ed 100644 --- a/lib/identity/scoreboard.md +++ b/lib/identity/scoreboard.md @@ -1,6 +1,6 @@ # identity-on-sx Scoreboard -**Total: 158 / 158 tests passing** +**Total: 168 / 168 tests passing** | | Suite | Pass | Total | |---|---|---|---| @@ -17,6 +17,7 @@ | ✅ | expiry | 8 | 8 | | ✅ | clients | 11 | 11 | | ✅ | grants | 9 | 9 | +| ✅ | device | 10 | 10 | Generated by `lib/identity/conformance.sh`. diff --git a/lib/identity/tests/device.sx b/lib/identity/tests/device.sx new file mode 100644 index 00000000..46728de4 --- /dev/null +++ b/lib/identity/tests/device.sx @@ -0,0 +1,109 @@ +;; identity/tests/device.sx — device authorization grant (RFC 8628): +;; authorize → poll(pending) → approve/deny out-of-band → poll(token/denied). + +(define id-device-test-count 0) +(define id-device-test-pass 0) +(define id-device-test-fails (list)) + +(define + id-device-test + (fn + (name actual expected) + (set! id-device-test-count (+ id-device-test-count 1)) + (if + (= actual expected) + (set! id-device-test-pass (+ id-device-test-pass 1)) + (append! id-device-test-fails {:name name :expected expected :actual actual})))) + +(define idd-ev erlang-eval-ast) +(define iddnm (fn (v) (get v :name))) + +(identity-load-device!) + +;; ── polling before approval ────────────────────────────────────── + +(id-device-test + "polling a pending device code is authorization_pending" + (iddnm + (idd-ev + "D = identity_device:start(),\n {ok, Dc, _Uc} = identity_device:authorize(D, tv, watch),\n case identity_device:poll(D, Dc) of\n {ok, _} -> got;\n {error, W} -> W\n end")) + "authorization_pending") + +;; ── approve → token ────────────────────────────────────────────── + +(id-device-test + "after approval, polling yields a working token" + (iddnm + (idd-ev + "D = identity_device:start(),\n {ok, Dc, Uc} = identity_device:authorize(D, tv, watch),\n identity_device:approve(D, Uc, alice),\n {ok, T} = identity_device:poll(D, Dc),\n case identity_device:introspect(D, T) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end")) + "active") + +(id-device-test + "the device token carries the approving subject" + (iddnm + (idd-ev + "D = identity_device:start(),\n {ok, Dc, Uc} = identity_device:authorize(D, tv, watch),\n identity_device:approve(D, Uc, alice),\n {ok, T} = identity_device:poll(D, Dc),\n case identity_device:introspect(D, T) of\n {active, Subject, _, _} -> Subject\n end")) + "alice") + +(id-device-test + "the device token carries the requested scope" + (iddnm + (idd-ev + "D = identity_device:start(),\n {ok, Dc, Uc} = identity_device:authorize(D, tv, stream),\n identity_device:approve(D, Uc, alice),\n {ok, T} = identity_device:poll(D, Dc),\n case identity_device:introspect(D, T) of\n {active, _, _, Scope} -> Scope\n end")) + "stream") + +;; ── deny ───────────────────────────────────────────────────────── + +(id-device-test + "after denial, polling is access_denied" + (iddnm + (idd-ev + "D = identity_device:start(),\n {ok, Dc, Uc} = identity_device:authorize(D, tv, watch),\n identity_device:deny(D, Uc),\n case identity_device:poll(D, Dc) of\n {ok, _} -> got;\n {error, W} -> W\n end")) + "access_denied") + +;; ── unknown codes ──────────────────────────────────────────────── + +(id-device-test + "polling an unknown device code is invalid_grant" + (iddnm + (idd-ev + "D = identity_device:start(),\n Bogus = make_ref(),\n case identity_device:poll(D, Bogus) of\n {ok, _} -> got;\n {error, W} -> W\n end")) + "invalid_grant") + +(id-device-test + "approving an unknown user code is unknown_code" + (iddnm + (idd-ev + "D = identity_device:start(),\n Bogus = make_ref(),\n case identity_device:approve(D, Bogus, alice) of\n ok -> ok;\n {error, W} -> W\n end")) + "unknown_code") + +;; ── single-use device code ─────────────────────────────────────── + +(id-device-test + "the device code is single-use after issuing a token" + (iddnm + (idd-ev + "D = identity_device:start(),\n {ok, Dc, Uc} = identity_device:authorize(D, tv, watch),\n identity_device:approve(D, Uc, alice),\n identity_device:poll(D, Dc),\n case identity_device:poll(D, Dc) of\n {ok, _} -> got;\n {error, W} -> W\n end")) + "invalid_grant") + +;; ── guarded transitions ────────────────────────────────────────── + +(id-device-test + "approving an already-denied request is rejected" + (iddnm + (idd-ev + "D = identity_device:start(),\n {ok, _Dc, Uc} = identity_device:authorize(D, tv, watch),\n identity_device:deny(D, Uc),\n case identity_device:approve(D, Uc, alice) of\n ok -> ok;\n {error, W} -> W\n end")) + "denied") + +;; ── independence ───────────────────────────────────────────────── + +(id-device-test + "two device requests are independent" + (iddnm + (idd-ev + "D = identity_device:start(),\n {ok, Dc1, Uc1} = identity_device:authorize(D, tv, watch),\n {ok, Dc2, _Uc2} = identity_device:authorize(D, cli, deploy),\n identity_device:approve(D, Uc1, alice),\n case identity_device:poll(D, Dc2) of\n {ok, _} -> got;\n {error, W} -> W\n end")) + "authorization_pending") + +(define + id-device-test-summary + (str "device " id-device-test-pass "/" id-device-test-count)) diff --git a/plans/identity-on-sx.md b/plans/identity-on-sx.md index 43f73023..1a854821 100644 --- a/plans/identity-on-sx.md +++ b/plans/identity-on-sx.md @@ -19,7 +19,7 @@ through the event log, all authorization questions delegated to `acl-on-sx`. ## Status (rolling) -`bash lib/identity/conformance.sh` → **158/158** (4 phases + ext: scope, TTL, clients, client-creds) +`bash lib/identity/conformance.sh` → **168/168** (4 phases + 6 ext incl device grant) ## Ground rules @@ -82,12 +82,19 @@ lib/identity/api.sx ── (identity/login) (identity/grant?) (identity/revoke) - [x] access-token TTL / `expires_in` — logical-clock expiry, introspect honours it - [x] scope as a set + scope narrowing on refresh (RFC 6749 §6) - [x] client registry: public vs confidential clients, client authentication (RFC 6749 §2) -- [~] client-credentials grant (RFC 6749 §4.4) DONE; device grant (RFC 8628) pending +- [x] client-credentials grant (RFC 6749 §4.4) + device grant (RFC 8628) - [ ] acl-on-sx delegation: wire `verify`/membership projection → an acl decision, integration test - [ ] OAuth `state` (CSRF) + OIDC `nonce` threaded through authorize→exchange - [ ] unify `api.sx` over oauth + membership + audit (one facade, audited login/consent) ## Progress log +- 2026-06-07 — `device.sx` (ext, RFC 8628): device authorization grant for + input-constrained devices. authorize → {device_code, user_code}; the human + approve/deny 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; guarded + transitions (approve-after-deny rejected). Tokens grant-backed. Device-code + expiry + slow_down deferred (no wall clock). New tests/device.sx (10). 158→168. - 2026-06-07 — client-credentials grant (ext, RFC 6749 §4.4): `oauth.sx` now owns a client registry (loop/6); `register_client` + `client_credentials`. A confidential client authenticates and gets a token acting on its own