rose-ash/lib/identity/tests/oauth.sx

;; identity/tests/oauth.sx — OAuth2 authorization-code flow (RFC 6749
;; §4.1) + PKCE (RFC 7636) + refresh grant (§6). Covers the full happy
;; path end-to-end (code exchange → access+refresh → refresh rotation) and
;; every rejection: denied consent, single-use codes, client/redirect
;; binding, PKCE mismatch, unknown code/request, refresh-token reuse, and
;; revoke-then-use (which must fail).

(define id-oauth-test-count 0)
(define id-oauth-test-pass 0)
(define id-oauth-test-fails (list))

(define
  id-oauth-test
  (fn
    (name actual expected)
    (set! id-oauth-test-count (+ id-oauth-test-count 1))
    (if
      (= actual expected)
      (set! id-oauth-test-pass (+ id-oauth-test-pass 1))
      (append! id-oauth-test-fails {:name name :expected expected :actual actual}))))

(define ido-ev erlang-eval-ast)
(define idonm (fn (v) (get v :name)))

(identity-load-token!)
(identity-load-oauth!)

;; Shared prelude: authorize + consent(allow) leaving Code bound.
(define
  ido-granted
  "O = identity_oauth:start(),\n   {consent_required, ReqId} =\n     identity_oauth:authorize(O, webapp, uri1, read, alice, verif1),\n   {code, Code} = identity_oauth:consent(O, ReqId, allow)")

;; ── full happy path ──────────────────────────────────────────────

(id-oauth-test
  "authorize asks for consent"
  (idonm
    (ido-ev
      "O = identity_oauth:start(),\n       case identity_oauth:authorize(O, webapp, uri1, read, alice, verif1) of\n         {consent_required, _} -> consent_required;\n         Other -> Other\n       end"))
  "consent_required")

(id-oauth-test
  "consent(allow) returns a code"
  (idonm (ido-ev (str ido-granted ", case Code of _ -> issued end")))
  "issued")

(id-oauth-test
  "exchanged access token introspects active"
  (idonm
    (ido-ev
      (str
        ido-granted
        ", {ok, Tok, _R} = identity_oauth:exchange(O, Code, webapp, uri1, verif1),\n           case identity_oauth:introspect(O, Tok) of\n             {active, _, _, _} -> active;\n             {inactive} -> inactive\n           end")))
  "active")

(id-oauth-test
  "exchanged token carries the authorized subject"
  (idonm
    (ido-ev
      (str
        ido-granted
        ", {ok, Tok, _R} = identity_oauth:exchange(O, Code, webapp, uri1, verif1),\n           case identity_oauth:introspect(O, Tok) of\n             {active, Subject, _, _} -> Subject\n           end")))
  "alice")

(id-oauth-test
  "exchanged token carries the authorized scope"
  (idonm
    (ido-ev
      (str
        ido-granted
        ", {ok, Tok, _R} = identity_oauth:exchange(O, Code, webapp, uri1, verif1),\n           case identity_oauth:introspect(O, Tok) of\n             {active, _, _, Scope} -> Scope\n           end")))
  "read")

;; ── refresh grant (RFC 6749 §6) end-to-end ───────────────────────

(id-oauth-test
  "refresh after exchange yields a working access token"
  (idonm
    (ido-ev
      (str
        ido-granted
        ", {ok, _A, R} = identity_oauth:exchange(O, Code, webapp, uri1, verif1),\n           {ok, A2, _R2} = identity_oauth:refresh(O, R),\n           case identity_oauth:introspect(O, A2) of\n             {active, _, _, _} -> active;\n             {inactive} -> inactive\n           end")))
  "active")

(id-oauth-test
  "reusing a rotated refresh token is invalid_grant"
  (idonm
    (ido-ev
      (str
        ido-granted
        ", {ok, _A, R} = identity_oauth:exchange(O, Code, webapp, uri1, verif1),\n           {ok, _A2, _R2} = identity_oauth:refresh(O, R),\n           case identity_oauth:refresh(O, R) of\n             {ok, _, _} -> rotated;\n             {error, Why} -> Why\n           end")))
  "invalid_grant")

;; ── consent denied (§4.1.2.1) ────────────────────────────────────

(id-oauth-test
  "denied consent yields access_denied"
  (idonm
    (ido-ev
      "O = identity_oauth:start(),\n       {consent_required, ReqId} =\n         identity_oauth:authorize(O, webapp, uri1, read, alice, verif1),\n       case identity_oauth:consent(O, ReqId, deny) of\n         {error, Why} -> Why;\n         {code, _} -> issued\n       end"))
  "access_denied")

;; ── single-use codes (§10.5) ─────────────────────────────────────

(id-oauth-test
  "code cannot be exchanged twice"
  (idonm
    (ido-ev
      (str
        ido-granted
        ", identity_oauth:exchange(O, Code, webapp, uri1, verif1),\n           case identity_oauth:exchange(O, Code, webapp, uri1, verif1) of\n             {ok, _, _} -> replayed;\n             {error, Why} -> Why\n           end")))
  "invalid_grant")

;; ── code binding to client + redirect_uri (§4.1.3) ───────────────

(id-oauth-test
  "exchange with wrong client is invalid_grant"
  (idonm
    (ido-ev
      (str
        ido-granted
        ", case identity_oauth:exchange(O, Code, attacker, uri1, verif1) of\n             {ok, _, _} -> ok;\n             {error, Why} -> Why\n           end")))
  "invalid_grant")

(id-oauth-test
  "exchange with wrong redirect_uri is invalid_grant"
  (idonm
    (ido-ev
      (str
        ido-granted
        ", case identity_oauth:exchange(O, Code, webapp, evil_uri, verif1) of\n             {ok, _, _} -> ok;\n             {error, Why} -> Why\n           end")))
  "invalid_grant")

;; ── PKCE verifier mismatch (RFC 7636) ────────────────────────────

(id-oauth-test
  "exchange with wrong PKCE verifier is invalid_grant"
  (idonm
    (ido-ev
      (str
        ido-granted
        ", case identity_oauth:exchange(O, Code, webapp, uri1, badverif) of\n             {ok, _, _} -> ok;\n             {error, Why} -> Why\n           end")))
  "invalid_grant")

;; ── unknown code / request ───────────────────────────────────────

(id-oauth-test
  "exchanging an unknown code is invalid_grant"
  (idonm
    (ido-ev
      "O = identity_oauth:start(),\n       Bogus = make_ref(),\n       case identity_oauth:exchange(O, Bogus, webapp, uri1, verif1) of\n         {ok, _, _} -> ok;\n         {error, Why} -> Why\n       end"))
  "invalid_grant")

(id-oauth-test
  "consent on an unknown request is unknown_request"
  (idonm
    (ido-ev
      "O = identity_oauth:start(),\n       Bogus = make_ref(),\n       case identity_oauth:consent(O, Bogus, allow) of\n         {code, _} -> issued;\n         {error, Why} -> Why\n       end"))
  "unknown_request")

;; ── revoke-then-use must fail (RFC 7009) ─────────────────────────

(id-oauth-test
  "revoked exchanged token introspects inactive"
  (idonm
    (ido-ev
      (str
        ido-granted
        ", {ok, Tok, _R} = identity_oauth:exchange(O, Code, webapp, uri1, verif1),\n           identity_oauth:revoke(O, Tok),\n           case identity_oauth:introspect(O, Tok) of\n             {active, _, _, _} -> still_valid;\n             {inactive} -> inactive\n           end")))
  "inactive")

(id-oauth-test
  "revoking the access token blocks a later refresh (cascade)"
  (idonm
    (ido-ev
      (str
        ido-granted
        ", {ok, A, R} = identity_oauth:exchange(O, Code, webapp, uri1, verif1),\n           identity_oauth:revoke(O, A),\n           case identity_oauth:refresh(O, R) of\n             {ok, _, _} -> refreshed;\n             {error, Why} -> Why\n           end")))
  "invalid_grant")

;; ── independence: two concurrent authorizations don't collide ────

(id-oauth-test
  "two authorizations issue independent grants"
  (idonm
    (ido-ev
      "O = identity_oauth:start(),\n       {consent_required, R1} =\n         identity_oauth:authorize(O, webapp, uri1, read, alice, va),\n       {consent_required, R2} =\n         identity_oauth:authorize(O, cli, uri2, write, bob, vb),\n       {code, C1} = identity_oauth:consent(O, R1, allow),\n       {code, C2} = identity_oauth:consent(O, R2, allow),\n       {ok, _A1, _RR1} = identity_oauth:exchange(O, C1, webapp, uri1, va),\n       {ok, A2, _RR2} = identity_oauth:exchange(O, C2, cli, uri2, vb),\n       case identity_oauth:introspect(O, A2) of\n         {active, Subject, _, _} -> Subject\n       end"))
  "bob")

(define
  id-oauth-test-summary
  (str "oauth " id-oauth-test-pass "/" id-oauth-test-count))