identity: device authorization grant (RFC 8628, +10 tests)

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>

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

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)))

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"}
   ]
 }

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`.

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))

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