giles
baee67f561
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 37s
The grant {Subject,Client,Scope,Status} becomes the unit of authorization
and cascade; access + refresh tokens reference it. issue_grant returns an
access+refresh pair; refresh (RFC 6749 §6) supersedes the presented refresh
token and mints a fresh pair; reusing a superseded refresh token is treated
as theft (RFC 6819 §5.2.2.3) and revokes the whole family, killing the live
descendant. revoke of any token cascades to the grant. All prior token
behaviour preserved. token 18/18, 62/62.
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
172 lines
8.2 KiB
Plaintext
172 lines
8.2 KiB
Plaintext
;; identity/tests/token.sx — opaque tokens, grant-backed lookup, real
|
|
;; revocation, refresh-token rotation, and cascading revocation. 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")
|
|
|
|
(define
|
|
id-token-test-summary
|
|
(str "token " id-token-test-pass "/" id-token-test-count))
|