;; 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))