giles
785faf2441
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 55s
cache.sx — a process wrapping the token registry, memoising introspect. Revocation stays real via generation invalidation: any revoke/refresh bumps a generation counter, so every cached positive instantly becomes a miss and re-validates against the live registry. A revoked token never reads valid out of cache, not for a millisecond. stats() exposes hits/misses. New tests/cache.sx. 101/101. Co-Authored-By: Claude Opus 4.8 (1M context) <noreply@anthropic.com>
103 lines
5.1 KiB
Plaintext
103 lines
5.1 KiB
Plaintext
;; identity/tests/cache.sx — delegated grant-verification cache. Proves
|
|
;; the cache is live (hits/misses) AND that revocation stays real: a
|
|
;; revoked token never reads valid out of the cache, because any revoke
|
|
;; bumps the generation and forces re-validation.
|
|
|
|
(define id-cache-test-count 0)
|
|
(define id-cache-test-pass 0)
|
|
(define id-cache-test-fails (list))
|
|
|
|
(define
|
|
id-cache-test
|
|
(fn
|
|
(name actual expected)
|
|
(set! id-cache-test-count (+ id-cache-test-count 1))
|
|
(if
|
|
(= actual expected)
|
|
(set! id-cache-test-pass (+ id-cache-test-pass 1))
|
|
(append! id-cache-test-fails {:name name :expected expected :actual actual}))))
|
|
|
|
(define idc-ev erlang-eval-ast)
|
|
(define idcnm (fn (v) (get v :name)))
|
|
|
|
(identity-load-token!)
|
|
(identity-load-cache!)
|
|
|
|
;; ── delegation: cache forwards to the registry ───────────────────
|
|
|
|
(id-cache-test
|
|
"introspect through the cache returns active"
|
|
(idcnm
|
|
(idc-ev
|
|
"C = identity_grant_cache:start(),\n {ok, T} = identity_grant_cache:issue(C, alice, web, read),\n case identity_grant_cache:introspect(C, T) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
|
|
"active")
|
|
|
|
;; ── the cache is actually caching ────────────────────────────────
|
|
|
|
(id-cache-test
|
|
"a repeated introspect is a cache hit"
|
|
(idc-ev
|
|
"C = identity_grant_cache:start(),\n {ok, T} = identity_grant_cache:issue(C, alice, web, read),\n identity_grant_cache:introspect(C, T),\n identity_grant_cache:introspect(C, T),\n case identity_grant_cache:stats(C) of {H, _} -> H end")
|
|
1)
|
|
|
|
(id-cache-test
|
|
"the first introspect of a token is a miss"
|
|
(idc-ev
|
|
"C = identity_grant_cache:start(),\n {ok, T} = identity_grant_cache:issue(C, alice, web, read),\n identity_grant_cache:introspect(C, T),\n identity_grant_cache:introspect(C, T),\n case identity_grant_cache:stats(C) of {_, M} -> M end")
|
|
1)
|
|
|
|
;; ── revocation stays real through the cache (the centrepiece) ─────
|
|
|
|
(id-cache-test
|
|
"a revoked token introspects inactive through the cache"
|
|
(idcnm
|
|
(idc-ev
|
|
"C = identity_grant_cache:start(),\n {ok, T} = identity_grant_cache:issue(C, alice, web, read),\n identity_grant_cache:introspect(C, T),\n identity_grant_cache:revoke(C, T),\n case identity_grant_cache:introspect(C, T) of\n {active, _, _, _} -> still_valid;\n {inactive} -> inactive\n end"))
|
|
"inactive")
|
|
|
|
(id-cache-test
|
|
"revoke invalidates the cache (post-revoke read re-validates)"
|
|
(idc-ev
|
|
"C = identity_grant_cache:start(),\n {ok, T} = identity_grant_cache:issue(C, alice, web, read),\n identity_grant_cache:introspect(C, T),\n identity_grant_cache:revoke(C, T),\n identity_grant_cache:introspect(C, T),\n case identity_grant_cache:stats(C) of {_, M} -> M end")
|
|
2)
|
|
|
|
;; ── cascade visibility through the cache ──────────────────────────
|
|
|
|
(id-cache-test
|
|
"cascade revocation is visible through the cache"
|
|
(idcnm
|
|
(idc-ev
|
|
"C = identity_grant_cache:start(),\n {ok, A, R} = identity_grant_cache:issue_grant(C, alice, web, read),\n identity_grant_cache:introspect(C, A),\n identity_grant_cache:revoke(C, R),\n case identity_grant_cache:introspect(C, A) of\n {active, _, _, _} -> still_valid;\n {inactive} -> inactive\n end"))
|
|
"inactive")
|
|
|
|
;; ── a sibling token re-validates correctly after a revoke ────────
|
|
|
|
(id-cache-test
|
|
"revoking one token leaves an independent token valid"
|
|
(idcnm
|
|
(idc-ev
|
|
"C = identity_grant_cache:start(),\n {ok, A} = identity_grant_cache:issue(C, alice, web, read),\n {ok, B} = identity_grant_cache:issue(C, bob, cli, write),\n identity_grant_cache:introspect(C, A),\n identity_grant_cache:introspect(C, B),\n identity_grant_cache:revoke(C, A),\n case identity_grant_cache:introspect(C, B) of\n {active, Subject, _, _} -> Subject;\n {inactive} -> inactive\n end"))
|
|
"bob")
|
|
|
|
;; ── refresh flows through the cache and stays correct ────────────
|
|
|
|
(id-cache-test
|
|
"a refreshed token introspects active through the cache"
|
|
(idcnm
|
|
(idc-ev
|
|
"C = identity_grant_cache:start(),\n {ok, _A, R} = identity_grant_cache:issue_grant(C, alice, web, read),\n {ok, A2, _R2} = identity_grant_cache:refresh(C, R),\n case identity_grant_cache:introspect(C, A2) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
|
|
"active")
|
|
|
|
;; ── unknown token is inactive, and cached as such ────────────────
|
|
|
|
(id-cache-test
|
|
"an unknown token introspects inactive through the cache"
|
|
(idcnm
|
|
(idc-ev
|
|
"C = identity_grant_cache:start(),\n Bogus = make_ref(),\n case identity_grant_cache:introspect(C, Bogus) of\n {active, _, _, _} -> active;\n {inactive} -> inactive\n end"))
|
|
"inactive")
|
|
|
|
(define
|
|
id-cache-test-summary
|
|
(str "cache " id-cache-test-pass "/" id-cache-test-count))
|