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>
30 lines
3.9 KiB
Plaintext
30 lines
3.9 KiB
Plaintext
;; identity/cache.sx — a delegated grant-verification cache, mirroring the
|
|
;; Redis-cache pattern apps use in front of grant verification.
|
|
;;
|
|
;; The cache is a process wrapping a token registry. introspect() is
|
|
;; memoised; issue/issue_grant/refresh/revoke pass through. The danger
|
|
;; with any cache is staleness: a revoked token must NOT keep reading
|
|
;; valid out of the cache, not even for a millisecond (the loop's hard
|
|
;; rule). We get that for free with GENERATION invalidation:
|
|
;;
|
|
;; - each cache entry records the generation it was written at;
|
|
;; - a hit requires entry.generation == current generation;
|
|
;; - any state-changing op that can invalidate an existing token
|
|
;; (revoke — which cascades to a grant; refresh — whose reuse cascades)
|
|
;; bumps the generation.
|
|
;;
|
|
;; So a single revoke instantly invalidates every cached positive: the
|
|
;; next introspect is a miss and re-validates against the live registry,
|
|
;; which returns {inactive}. Revocation stays real; the cache only ever
|
|
;; accelerates the steady state, never overrides a revocation.
|
|
;;
|
|
;; stats() -> {Hits, Misses} so callers can see the cache is live.
|
|
|
|
(define
|
|
identity-cache-source
|
|
"-module(identity_grant_cache).\n\n start() ->\n spawn(fun () ->\n Reg = identity_tokens:start(),\n loop(Reg, 1, [], 0, 0)\n end).\n\n issue(C, Subject, Client, Scope) ->\n C ! {issue, Subject, Client, Scope, self()},\n receive {cache_reply, R} -> R end.\n\n issue_grant(C, Subject, Client, Scope) ->\n C ! {issue_grant, Subject, Client, Scope, self()},\n receive {cache_reply, R} -> R end.\n\n refresh(C, RefreshTok) ->\n C ! {refresh, RefreshTok, self()},\n receive {cache_reply, R} -> R end.\n\n introspect(C, Token) ->\n C ! {introspect, Token, self()},\n receive {cache_reply, R} -> R end.\n\n revoke(C, Token) ->\n C ! {revoke, Token, self()},\n receive {cache_reply, R} -> R end.\n\n stats(C) ->\n C ! {stats, self()},\n receive {cache_reply, R} -> R end.\n\n loop(Reg, Gen, Entries, Hits, Misses) ->\n receive\n {introspect, Tok, From} ->\n case lookup_fresh(Tok, Gen, Entries) of\n {hit, Result} ->\n From ! {cache_reply, Result},\n loop(Reg, Gen, Entries, Hits + 1, Misses);\n miss ->\n Result = identity_tokens:introspect(Reg, Tok),\n From ! {cache_reply, Result},\n loop(Reg, Gen, put_entry(Tok, Result, Gen, Entries), Hits, Misses + 1)\n end;\n {issue, Subject, Client, Scope, From} ->\n From ! {cache_reply, identity_tokens:issue(Reg, Subject, Client, Scope)},\n loop(Reg, Gen, Entries, Hits, Misses);\n {issue_grant, Subject, Client, Scope, From} ->\n From ! {cache_reply, identity_tokens:issue_grant(Reg, Subject, Client, Scope)},\n loop(Reg, Gen, Entries, Hits, Misses);\n {refresh, RTok, From} ->\n From ! {cache_reply, identity_tokens:refresh(Reg, RTok)},\n loop(Reg, Gen + 1, Entries, Hits, Misses);\n {revoke, Tok, From} ->\n identity_tokens:revoke(Reg, Tok),\n From ! {cache_reply, ok},\n loop(Reg, Gen + 1, Entries, Hits, Misses);\n {stats, From} ->\n From ! {cache_reply, {Hits, Misses}},\n loop(Reg, Gen, Entries, Hits, Misses)\n end.\n\n lookup_fresh(_, _, []) -> miss;\n lookup_fresh(Tok, Gen, [{T, {Result, G}} | Rest]) ->\n case T =:= Tok of\n true ->\n case G =:= Gen of\n true -> {hit, Result};\n false -> miss\n end;\n false -> lookup_fresh(Tok, Gen, Rest)\n end.\n\n put_entry(Tok, Result, Gen, Entries) ->\n [{Tok, {Result, Gen}} | remove(Tok, Entries)].\n\n remove(_, []) -> [];\n remove(Tok, [{T, V} | Rest]) ->\n case T =:= Tok of\n true -> remove(Tok, Rest);\n false -> [{T, V} | remove(Tok, Rest)]\n end.")
|
|
|
|
(define
|
|
identity-load-cache!
|
|
(fn () (erlang-load-module identity-cache-source)))
|