giles
ac63501266
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 33s
Token table is a process; the token is an opaque make_ref carrying no
information. introspect() is a live table lookup every time, so
revocation is real (RFC 7009 §2): a revoked token reads {inactive} on
the next introspection with no validity window. Reply shapes follow
RFC 7662 §2.2 ({active, Subject, Client, Scope} / {inactive}).
Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
100 lines
4.4 KiB
Plaintext
100 lines
4.4 KiB
Plaintext
;; identity/tests/token.sx — opaque tokens, grant-backed lookup, and
|
|
;; real revocation. The revoke-then-introspect path is the security
|
|
;; centrepiece: a revoked token must read inactive immediately.
|
|
|
|
(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")
|
|
|
|
(define
|
|
id-token-test-summary
|
|
(str "token " id-token-test-pass "/" id-token-test-count))
|