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>
110 lines
5.5 KiB
Plaintext
110 lines
5.5 KiB
Plaintext
;; 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))
|