giles
e951f23f14
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 44s
Each access token now carries its own effective scope (<= the grant's max).
refresh/3 requests a narrower scope; the request must be a subset of the
grant scope, else {error, invalid_scope} and the refresh token is NOT
consumed (client may retry, §5.2). refresh/2 keeps full scope; scope stays
opaque (atom or list) for issue so all prior atom-scope tests are unchanged.
Also files a Blocker: PKCE S256 is blocked on erlang substrate bugs (binary
=:= always true; crypto:hash ignores binary content). token 24/24, 130/130.
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
216 lines
11 KiB
Plaintext
216 lines
11 KiB
Plaintext
;; identity/tests/token.sx — opaque tokens, grant-backed lookup, real
|
|
;; revocation, refresh-token rotation, cascading revocation, and scope
|
|
;; narrowing on refresh. The revoke-then-introspect and refresh-reuse
|
|
;; paths are the security centrepieces.
|
|
|
|
(define id-token-test-count 0)
|
|
(define id-token-test-pass 0)
|
|
(define id-token-test-fails (list))
|
|
|
|
(define
|
|
id-token-test
|
|
(fn
|
|
(name actual expected)
|
|
(set! id-token-test-count (+ id-token-test-count 1))
|
|
(if
|
|
(= actual expected)
|
|
(set! id-token-test-pass (+ id-token-test-pass 1))
|
|
(append! id-token-test-fails {:name name :expected expected :actual actual}))))
|
|
|
|
(define idt-ev erlang-eval-ast)
|
|
(define idtnm (fn (v) (get v :name)))
|
|
|
|
(identity-load-token!)
|
|
|
|
;; ── issue + introspect (happy path) ──────────────────────────────
|
|
|
|
(id-token-test
|
|
"fresh token introspects active"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n {ok, Tok} = identity_tokens:issue(Reg, alice, web, read),\n case identity_tokens:introspect(Reg, Tok) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
|
|
"active")
|
|
|
|
(id-token-test
|
|
"introspect returns the granted subject"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n {ok, Tok} = identity_tokens:issue(Reg, alice, web, read),\n case identity_tokens:introspect(Reg, Tok) of\n {active, Subject, _, _} -> Subject\n end"))
|
|
"alice")
|
|
|
|
(id-token-test
|
|
"introspect returns the granted scope"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n {ok, Tok} = identity_tokens:issue(Reg, alice, web, write),\n case identity_tokens:introspect(Reg, Tok) of\n {active, _, _, Scope} -> Scope\n end"))
|
|
"write")
|
|
|
|
;; ── opacity: distinct tokens, no cross-talk ──────────────────────
|
|
|
|
(id-token-test
|
|
"two issues yield independent grants"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n {ok, A} = identity_tokens:issue(Reg, alice, web, read),\n {ok, B} = identity_tokens:issue(Reg, bob, cli, write),\n identity_tokens:revoke(Reg, A),\n case identity_tokens:introspect(Reg, B) of\n {active, Subject, _, _} -> Subject;\n {inactive} -> inactive\n end"))
|
|
"bob")
|
|
|
|
;; ── revocation is real (RFC 7009) ────────────────────────────────
|
|
|
|
(id-token-test
|
|
"revoked token introspects inactive immediately"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n {ok, Tok} = identity_tokens:issue(Reg, alice, web, read),\n active = case identity_tokens:introspect(Reg, Tok) of\n {active, _, _, _} -> active end,\n identity_tokens:revoke(Reg, Tok),\n case identity_tokens:introspect(Reg, Tok) of\n {active, _, _, _} -> still_valid;\n {inactive} -> inactive\n end"))
|
|
"inactive")
|
|
|
|
(id-token-test
|
|
"revoke is idempotent"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n {ok, Tok} = identity_tokens:issue(Reg, alice, web, read),\n identity_tokens:revoke(Reg, Tok),\n identity_tokens:revoke(Reg, Tok)"))
|
|
"ok")
|
|
|
|
;; ── unknown tokens are inactive, never an error/crash ────────────
|
|
|
|
(id-token-test
|
|
"introspecting an unknown token is inactive"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n Bogus = make_ref(),\n case identity_tokens:introspect(Reg, Bogus) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
|
|
"inactive")
|
|
|
|
(id-token-test
|
|
"revoking an unknown token is ok, not a crash"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n Bogus = make_ref(),\n identity_tokens:revoke(Reg, Bogus)"))
|
|
"ok")
|
|
|
|
;; ── one revocation does not affect a sibling token ───────────────
|
|
|
|
(id-token-test
|
|
"revoking one token leaves the other active"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n {ok, A} = identity_tokens:issue(Reg, alice, web, read),\n {ok, B} = identity_tokens:issue(Reg, alice, cli, read),\n identity_tokens:revoke(Reg, A),\n case identity_tokens:introspect(Reg, B) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
|
|
"active")
|
|
|
|
;; ── issue_grant: access + refresh pair (RFC 6749 §4.1.4 / §5.1) ───
|
|
|
|
(id-token-test
|
|
"issue_grant access token introspects active"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n {ok, A, _R} = identity_tokens:issue_grant(Reg, alice, web, read),\n case identity_tokens:introspect(Reg, A) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
|
|
"active")
|
|
|
|
;; ── refresh rotation (RFC 6749 §6) ───────────────────────────────
|
|
|
|
(id-token-test
|
|
"refresh mints a working new access token"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n {ok, _A, R} = identity_tokens:issue_grant(Reg, alice, web, read),\n {ok, A2, _R2} = identity_tokens:refresh(Reg, R),\n case identity_tokens:introspect(Reg, A2) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
|
|
"active")
|
|
|
|
(id-token-test
|
|
"rotated token keeps the grant's subject"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n {ok, _A, R} = identity_tokens:issue_grant(Reg, alice, web, read),\n {ok, A2, _R2} = identity_tokens:refresh(Reg, R),\n case identity_tokens:introspect(Reg, A2) of\n {active, Subject, _, _} -> Subject\n end"))
|
|
"alice")
|
|
|
|
(id-token-test
|
|
"refresh chains across rotations"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n {ok, _A, R} = identity_tokens:issue_grant(Reg, alice, web, read),\n {ok, _A2, R2} = identity_tokens:refresh(Reg, R),\n {ok, A3, _R3} = identity_tokens:refresh(Reg, R2),\n case identity_tokens:introspect(Reg, A3) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
|
|
"active")
|
|
|
|
(id-token-test
|
|
"refreshing an unknown token is invalid_grant"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n Bogus = make_ref(),\n case identity_tokens:refresh(Reg, Bogus) of\n {ok, _, _} -> rotated;\n {error, Why} -> Why\n end"))
|
|
"invalid_grant")
|
|
|
|
;; ── refresh-token reuse = theft → revoke the family (RFC 6819) ────
|
|
|
|
(id-token-test
|
|
"reusing a superseded refresh token is invalid_grant"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n {ok, _A, R} = identity_tokens:issue_grant(Reg, alice, web, read),\n {ok, _A2, _R2} = identity_tokens:refresh(Reg, R),\n case identity_tokens:refresh(Reg, R) of\n {ok, _, _} -> rotated;\n {error, Why} -> Why\n end"))
|
|
"invalid_grant")
|
|
|
|
(id-token-test
|
|
"refresh reuse revokes the live descendant too"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n {ok, _A, R} = identity_tokens:issue_grant(Reg, alice, web, read),\n {ok, A2, _R2} = identity_tokens:refresh(Reg, R),\n identity_tokens:refresh(Reg, R),\n case identity_tokens:introspect(Reg, A2) of\n {active, _, _, _} -> still_valid;\n {inactive} -> inactive\n end"))
|
|
"inactive")
|
|
|
|
;; ── cascading revocation: revoke any token, the grant dies ───────
|
|
|
|
(id-token-test
|
|
"revoking the access token blocks refresh"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n {ok, A, R} = identity_tokens:issue_grant(Reg, alice, web, read),\n identity_tokens:revoke(Reg, A),\n case identity_tokens:refresh(Reg, R) of\n {ok, _, _} -> refreshed;\n {error, Why} -> Why\n end"))
|
|
"invalid_grant")
|
|
|
|
(id-token-test
|
|
"revoking the refresh token deactivates the access token"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n {ok, A, R} = identity_tokens:issue_grant(Reg, alice, web, read),\n identity_tokens:revoke(Reg, R),\n case identity_tokens:introspect(Reg, A) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
|
|
"inactive")
|
|
|
|
;; ── scope as a set + narrowing on refresh (RFC 6749 §6 / §3.3) ───
|
|
|
|
(id-token-test
|
|
"a list scope round-trips through introspect"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n {ok, A, _R} = identity_tokens:issue_grant(Reg, alice, web, [read, write]),\n case identity_tokens:introspect(Reg, A) of\n {active, _, _, [read, write]} -> matched;\n {active, _, _, _} -> other;\n {inactive} -> inactive\n end"))
|
|
"matched")
|
|
|
|
(id-token-test
|
|
"refresh can narrow the scope to a subset"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n {ok, _A, R} = identity_tokens:issue_grant(Reg, alice, web, [read, write]),\n {ok, A2, _R2} = identity_tokens:refresh(Reg, R, [read]),\n case identity_tokens:introspect(Reg, A2) of\n {active, _, _, [read]} -> narrowed;\n {active, _, _, _} -> other;\n {inactive} -> inactive\n end"))
|
|
"narrowed")
|
|
|
|
(id-token-test
|
|
"refresh cannot widen scope beyond the grant"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n {ok, _A, R} = identity_tokens:issue_grant(Reg, alice, web, [read]),\n case identity_tokens:refresh(Reg, R, [read, write]) of\n {ok, _, _} -> widened;\n {error, Why} -> Why\n end"))
|
|
"invalid_scope")
|
|
|
|
(id-token-test
|
|
"an invalid_scope refresh does not consume the refresh token"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n {ok, _A, R} = identity_tokens:issue_grant(Reg, alice, web, [read, write]),\n identity_tokens:refresh(Reg, R, [admin]),\n case identity_tokens:refresh(Reg, R, [read]) of\n {ok, _, _} -> still_usable;\n {error, Why} -> Why\n end"))
|
|
"still_usable")
|
|
|
|
(id-token-test
|
|
"plain refresh keeps the full grant scope"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n {ok, _A, R} = identity_tokens:issue_grant(Reg, alice, web, [read, write]),\n {ok, A2, _R2} = identity_tokens:refresh(Reg, R),\n case identity_tokens:introspect(Reg, A2) of\n {active, _, _, [read, write]} -> full;\n {active, _, _, _} -> other;\n {inactive} -> inactive\n end"))
|
|
"full")
|
|
|
|
(id-token-test
|
|
"a narrowed token still cascades on revoke"
|
|
(idtnm
|
|
(idt-ev
|
|
"Reg = identity_tokens:start(),\n {ok, _A, R} = identity_tokens:issue_grant(Reg, alice, web, [read, write]),\n {ok, A2, _R2} = identity_tokens:refresh(Reg, R, [read]),\n identity_tokens:revoke(Reg, A2),\n case identity_tokens:introspect(Reg, A2) of\n {active, _, _, _} -> still_valid;\n {inactive} -> inactive\n end"))
|
|
"inactive")
|
|
|
|
(define
|
|
id-token-test-summary
|
|
(str "token " id-token-test-pass "/" id-token-test-count))
|