add validation and unified schemas

.env-template

@@ -30,6 +30,12 @@ ADMIN_USERS=
 # volume here or the todos vanish with the container.
 # TODO_DB_PATH=data/todo.db
 
+# --- MCP OAuth database -----------------------------------------------------
+# SQLite file for the MCP server's OAuth state: registered clients, and the tokens (hashed)
+# of every client a user has approved. In Docker, mount a volume here too, or every MCP client
+# has to be approved again after a restart. BASE_URL (above) must be the address MCP clients use.
+# OAUTH_DB_PATH=data/oauth.db
+
 # --- nREPL debug server (POST /nrepl) -----------------------------------------
 # nREPL has no authentication and evaluates arbitrary code, so it listens on loopback
 # only by default. Changing NREPL_BIND to 0.0.0.0 exposes it to the network: only do that

.gitignore

@@ -5,7 +5,7 @@ node_modules
 # Compiled UI (script/ui-build)
 resources/public/js
 .nrepl-port
-# Local SQLite database for the todo group (TODO_DB_PATH)
+# Local SQLite databases (TODO_DB_PATH, OAUTH_DB_PATH)
 data
 # Local secrets (copy .env-template to .env)
 .env

Dockerfile

@@ -18,13 +18,10 @@ COPY ui/src ./src
 RUN npx shadow-cljs release app
 
 # Stage 2: the server.
-FROM clojure:openjdk-11-tools-deps
+# JDK 21+ is required by the MCP server (plumcp runs on virtual threads).
+FROM clojure:temurin-21-tools-deps
 
-RUN sed -i \
-    -e 's|deb.debian.org/debian|archive.debian.org/debian|g' \
-    -e '/security.debian.org/d' \
-    /etc/apt/sources.list \
-    && apt-get update && apt-get install -y --no-install-recommends curl \
+RUN apt-get update && apt-get install -y --no-install-recommends curl \
     && rm -rf /var/lib/apt/lists/*
 
 WORKDIR /app

README.md

@@ -8,7 +8,7 @@ dockerized integration tests, and joint line coverage.
 ## Requirements
 
 - Docker, for the integration tests and the `script/docker-*` tasks (all CI needs)
-- For running tasks natively (optional): [Clojure CLI](https://clojure.org/guides/install_clojure) (tools.deps) with JDK 11+, [Node](https://nodejs.org/) 20+ (with a JDK) for the UI build, and [Babashka](https://babashka.org/) for `script/coverage-report`
+- For running tasks natively (optional): [Clojure CLI](https://clojure.org/guides/install_clojure) (tools.deps) with JDK 21+, [Node](https://nodejs.org/) 20+ (with a JDK) for the UI build, and [Babashka](https://babashka.org/) for `script/coverage-report`
 
 ## Running
 
@@ -43,6 +43,11 @@ docker run --rm -p 3000:3000 tbd
 | `GET` | `/` | The UI: an HTML shell that loads the compiled ClojureScript from `/js/main.js` |
 | `GET` | `/api/ping` | Health check, returns `pong` |
 | `GET` | `/api/add?x=2&y=3` | Adds two numbers: `{:result 5}` (EDN by default, see [Formats](#formats)) (400 if either is missing or not a number) |
+| `POST`, `DELETE` | `/mcp` | The [MCP server](#mcp-server) (JSON-RPC over Streamable HTTP; `DELETE` ends a session; `GET` is `405`). **Needs an OAuth access token** (`401` without one) |
+| `GET` | `/.well-known/oauth-protected-resource`, `/.well-known/oauth-authorization-server` | The [MCP OAuth](#connecting-an-mcp-client) discovery documents (RFC 9728 and 8414) |
+| `POST` | `/oauth/register` | Dynamic client registration (RFC 7591) for MCP clients |
+| `GET`, `POST` | `/oauth/authorize` | Where an MCP client sends the user's browser: Gitea login if needed, then a consent page |
+| `POST` | `/oauth/token` | Trades an authorization code (with its PKCE verifier) or a refresh token for tokens |
 | `GET` | `/api-docs` | Swagger UI |
 | `GET` | `/swagger.json` | OpenAPI/Swagger spec |
 | `GET` | `/auth/login` | Starts the Gitea OAuth login (redirects to Gitea) |
@@ -92,6 +97,65 @@ curl -XPOST localhost:3000/api/todos -H 'Cookie: tbd-session=...' \
 curl localhost:3000/api/todos -H 'Cookie: tbd-session=...'
 ```
 
+## MCP server
+
+The server also speaks [MCP](https://modelcontextprotocol.io/) (Model Context Protocol) at `/mcp`,
+built on [PluMCP](https://github.com/plumce/plumcp) and running inside this same process; there is
+nothing extra to start. It uses the Streamable HTTP transport, and, like the todo API, it acts **as
+the logged-in user**: a client has to be approved by a user first (see below), and from then on
+every tool call knows who is calling.
+
+```bash
+claude mcp add --transport http tbd https://tbd.example.com/mcp   # <BASE_URL>/mcp
+```
+
+The first time the client connects it gets a `401`, opens your browser, you log in with Gitea
+as usual and approve the client, and the client keeps its tokens from then on. It needs the
+[Gitea login](#authentication-and-the-admin-api) to be configured, including `BASE_URL` (which must
+be the address the client uses; without them `/mcp` answers `503` rather than being open).
+
+It offers these tools: `ping`, `add` (the same logic as `/api/add`), `whoami` (which user this
+connection acts as, and whether they are an admin), and, on the caller's own todos (the same ones
+as `/api/todos`), `list_todos`, `get_todo`, `create_todo`, `update_todo` and `delete_todo`. To add a
+tool, add a `tool` to `src/tbd/mcp/tools.clj`. Its arguments are described by the group's
+[Malli](https://github.com/metosin/malli) schema in `src/tbd/<group>/schema.clj`, the same schema the
+HTTP routes use for their parameters, so a shape of data is written down once: the tool's
+input schema is generated from it, and the arguments a client sends are coerced and validated against
+it (plumcp only checks that required ones are present). A tool that touches a user's data or does
+something admin-only gets the caller from `current-user` there (`{:login :id :admin? :client-id}`),
+and must not trust anything else about who is asking.
+
+Sessions are kept in memory, so they end when the server restarts (clients just re-initialize; their
+tokens are in the database and keep working). Server-to-client streaming (`GET /mcp`) is deliberately
+off: nothing here pushes messages, and the response would hang under Jetty. PluMCP needs JDK 21+.
+
+### Connecting an MCP client
+
+tbd is its own OAuth 2.1 authorization server for `/mcp` (in `src/tbd/oauth/`), with the Gitea login
+as the way a user proves who they are. Gitea's own tokens never reach an MCP client, and the tokens
+tbd issues are worth nothing anywhere else. The flow is the one the
+[MCP authorization spec](https://modelcontextprotocol.io/specification/2025-06-18/basic/authorization)
+describes, so any compliant client does it by itself:
+
+1. `POST /mcp` with no token gets `401` and `WWW-Authenticate: Bearer resource_metadata="<BASE_URL>/.well-known/oauth-protected-resource/mcp"`.
+2. The client reads that document, then `/.well-known/oauth-authorization-server`, and registers itself at
+   `/oauth/register` (dynamic client registration, public clients only).
+3. It opens `/oauth/authorize` in the browser (authorization-code flow, PKCE `S256` required). If you aren't
+   logged in you go through the Gitea login first and come back; then a consent page names the client and
+   the address you'll be sent back to, and asks you to **Approve** or **Deny**.
+4. The client trades the code at `/oauth/token` for an access token (1 hour) and a refresh token (30 days,
+   rotated on every use), and sends `Authorization: Bearer ...` on every `/mcp` request.
+
+The consent page is what stops a stranger's client (anyone can register one) from getting a token by
+sending you a link: nothing is issued without your click. Redirect URIs must be `https`, `http` on
+`localhost`/`127.0.0.1`/`[::1]` (the port may vary), or an app's own scheme (`cursor://...`).
+
+What's stored is in `OAUTH_DB_PATH`: registered clients, and for each approval the user and a *hash* of the
+current access and refresh tokens. To cut a client off, delete its row from `grants`. Admin-ness isn't in
+the token: it is looked up in `ADMIN_USERS` on every request, so removing someone from the list takes
+effect at once. A Gitea account that is disabled keeps working until its refresh token expires (up to 30
+days without use) or its grant is deleted, since Gitea isn't asked again after the login.
+
 ## Authentication and the admin API
 
 Login is OAuth2 (authorization-code flow) against a [Gitea](https://about.gitea.com/) instance.
@@ -107,10 +171,11 @@ login, **403** for a logged-in non-admin. With no allowlist, nobody is an admin.
 | Variable | Purpose |
 |----------|---------|
 | `GITEA_URL`, `GITEA_CLIENT_ID`, `GITEA_CLIENT_SECRET` | The Gitea OAuth2 application. Without all three (and `BASE_URL`), `/auth/login` answers 503 |
-| `BASE_URL` | Public URL of this app; an `https://` one also marks the session cookie `Secure` |
+| `BASE_URL` | Public URL of this app; an `https://` one also marks the session cookie `Secure`. It is also the address of the MCP server: the OAuth issuer, and what MCP clients are told to use (`<BASE_URL>/mcp`) |
 | `ADMIN_USERS` | Comma-separated Gitea usernames (case-insensitive) allowed to use the admin API |
 | `SESSION_SECRET` | Signs and encrypts session cookies. Unset = a random key per start, so logins don't survive a restart |
 | `TODO_DB_PATH` | SQLite file for the todo group (default `data/todo.db`) |
+| `OAUTH_DB_PATH` | SQLite file for the MCP OAuth server: registered clients, codes and tokens (default `data/oauth.db`). Mount a volume for it in Docker too, or every MCP client has to be approved again after each restart |
 | `NREPL_PORT`, `NREPL_BIND` | Where the debug nREPL listens (default `7888` on `127.0.0.1`) |
 
 Sessions live in an encrypted, signed, `HttpOnly`, `SameSite=Lax` cookie and expire after 8 hours
@@ -138,7 +203,9 @@ restarts), so switch it off when you're done.
 [Reagent](https://reagent-project.github.io/)) built with [shadow-cljs](https://github.com/thheller/shadow-cljs).
 It's a small calculator form that calls `GET /api/add` and shows the sum (or the server's
 validation error). Below it, once you're logged in, is a todo list (add, tick off, delete) backed by
-`/api/todos`; it stays hidden when you're not. A "Log in" / "Log out" link sits in the footer row
+`/api/todos`; it stays hidden when you're not. At the bottom is a section with the
+`claude mcp add ...` command to copy (with this page's own address in it) and the steps to sign in, for
+adding the [MCP server](#mcp-server) to Claude Code. A "Log in" / "Log out" link sits in the footer row
 next to the API docs links.
 
 shadow-cljs compiles it into `resources/public/js/` (git-ignored). The server serves that
@@ -192,9 +259,12 @@ src/tbd/
   core.clj            Router, Ring app, and server startup
   <group>/routes.clj  Each route group (health, math, ...) owns its route subtree
   <group>/core.clj    Business logic for the group, with no HTTP concerns
+  <group>/schema.clj  Malli schemas of the group's input, shared by its routes and the MCP tools
   auth/               Gitea OAuth (core), session + admin middleware (middleware), /auth routes
+  mcp/                MCP server (PluMCP) mounted at `/mcp`: tools (tools.clj), Malli-to-tool glue (schema.clj) and the Ring handler (routes.clj)
+  oauth/              tbd as the OAuth authorization server for MCP clients: rules (core), SQLite storage (db), `/oauth` + discovery routes, and the bearer-token middleware guarding `/mcp` (middleware)
   nrepl/              On-demand nREPL server (core) and the admin-only `/nrepl` routes
-  todo/               Per-user todos: pure rules (core), SQLite storage (db), `/api/todos` routes
+  todo/               Per-user todos: pure rules (core), Malli schemas of the input (schema), SQLite storage (db), `/api/todos` routes
 ui/                   ClojureScript re-frame app (shadow-cljs project); ui/src/tbd/ui/{db,events,subs,views,core}.cljs
 .env-template         Settings the server reads from the environment; copy to .env (git-ignored)
 resources/public/     index.html (the shell served at /) and js/ (compiled UI output, git-ignored)

deps.edn

@@ -8,7 +8,11 @@
   nrepl/nrepl {:mvn/version "1.2.0"}
   ;; The todo group's storage (see tbd.todo.db): a local SQLite file.
   com.github.seancorfield/next.jdbc {:mvn/version "1.3.1002"}
-  org.xerial/sqlite-jdbc {:mvn/version "3.46.1.3"}}
+  org.xerial/sqlite-jdbc {:mvn/version "3.46.1.3"}
+  ;; The MCP server, mounted at /mcp (see tbd.mcp.routes). Needs JDK 21+ (virtual threads).
+  ;; plumcp needs exactly one JSON module; jsonista is already on the classpath via muuntaja.
+  io.github.plumce/plumcp.core {:mvn/version "0.3.0-beta2"}
+  io.github.plumce/plumcp.core-json-jsonista {:mvn/version "0.3.0-beta2"}}
 
  :aliases
  {:dev

integration-test/integration_test.bb

@@ -2,6 +2,7 @@
 
 (ns integration-test
   (:require [babashka.http-client :as http]
+            [cheshire.core :as json]
             [clojure.edn :as edn]
             [clojure.string :as str]))
 
@@ -29,6 +30,15 @@
                   :headers {"Content-Type" "application/json"}
                   :body body}))
 
+(defn post-form* [url params]
+  (http/post url {:throw false
+                  :client no-redirect-client
+                  :headers {"Content-Type" "application/x-www-form-urlencoded"}
+                  :form-params params}))
+
+(defn json* [url]
+  (json/parse-string (:body (http/get url))))
+
 (defn wait-for-server [{:keys [base-url max-retries retry-delay-ms]}]
   (println (str "=== Waiting for server at " base-url " ==="))
   (loop [i 1]
@@ -174,6 +184,56 @@
       (assert-eq "GET one" 401 (:status (get* (str base-url "/api/todos/1"))))
       (println)
 
+      (println "Test 16: POST /mcp without a token returns 401 pointing at the OAuth metadata")
+      (let [resp (http/post (str base-url "/mcp")
+                            {:throw false
+                             :headers {"Content-Type" "application/json"
+                                       "Accept" "application/json, text/event-stream"}
+                             :body "{\"jsonrpc\":\"2.0\",\"id\":1,\"method\":\"initialize\"}"})
+            challenge (get (:headers resp) "www-authenticate" "")]
+        (assert-eq "HTTP status" 401 (:status resp))
+        (assert-contains "WWW-Authenticate" "Bearer resource_metadata=" challenge)
+        (assert-contains "WWW-Authenticate names the metadata document" "/.well-known/oauth-protected-resource/mcp" challenge))
+      (assert-eq "A bogus token is refused too" 401
+                 (:status (http/post (str base-url "/mcp")
+                                     {:throw false
+                                      :headers {"Content-Type" "application/json" "Authorization" "Bearer nope"}
+                                      :body "{}"})))
+      (println)
+
+      (println "Test 17: MCP OAuth discovery, registration and the authorize/token endpoints")
+      (let [resource (json* (str base-url "/.well-known/oauth-protected-resource/mcp"))
+            server (json* (str base-url "/.well-known/oauth-authorization-server"))]
+        (assert-contains "Resource metadata names the MCP endpoint" "/mcp" (get resource "resource"))
+        (assert-eq "PKCE S256 only" ["S256"] (get server "code_challenge_methods_supported"))
+        (assert-contains "Registration endpoint" "/oauth/register" (get server "registration_endpoint")))
+      (let [reg (http/post (str base-url "/oauth/register")
+                           {:throw false
+                            :headers {"Content-Type" "application/json"}
+                            :body "{\"redirect_uris\":[\"http://localhost:8123/callback\"],\"client_name\":\"integration\"}"})
+            client-id (get (json/parse-string (:body reg)) "client_id")]
+        (assert-eq "Registering a client" 201 (:status reg))
+        (assert-eq "Registering a web redirect over plain http is refused" 400
+                   (:status (http/post (str base-url "/oauth/register")
+                                       {:throw false
+                                        :headers {"Content-Type" "application/json"}
+                                        :body "{\"redirect_uris\":[\"http://evil.example.com/cb\"]}"})))
+        (let [resp (get-no-redirect* (str base-url "/oauth/authorize?client_id=" client-id
+                                          "&redirect_uri=http%3A%2F%2Flocalhost%3A8123%2Fcallback&response_type=code"
+                                          "&code_challenge=E9Melhoa2OwvFrEMTJguCHaoeK1t8URWbuGJSstw-cM&code_challenge_method=S256"))]
+          (assert-eq "Authorize while logged out sends the user to log in" 302 (:status resp))
+          (assert-contains "Location" "/auth/login?return_to=" (get (:headers resp) "location" "")))
+        (assert-eq "Authorize with an unregistered redirect URI is an error page, not a redirect" 400
+                   (:status (get-no-redirect* (str base-url "/oauth/authorize?client_id=" client-id
+                                                   "&redirect_uri=https%3A%2F%2Fevil.example.com%2Fcb&response_type=code"))))
+        (assert-eq "A bad code is invalid_grant" "invalid_grant"
+                   (get (json/parse-string (:body (post-form* (str base-url "/oauth/token")
+                                                              {"grant_type" "authorization_code" "code" "nope" "client_id" client-id
+                                                               "redirect_uri" "http://localhost:8123/callback"
+                                                               "code_verifier" (apply str (repeat 43 "a"))})))
+                        "error")))
+      (println)
+
       (println "================================")
       (println (format "  Results: %d passed, %d failed" @pass @fail))
       (println "================================")

src/tbd/auth/core.clj

@@ -35,13 +35,15 @@
 (defn env-config
   "Auth config from environment variables:
     GITEA_URL, GITEA_CLIENT_ID, GITEA_CLIENT_SECRET  the Gitea OAuth2 application
-    BASE_URL       public URL of this app; <BASE_URL>/auth/callback is the redirect URI to register in Gitea
+    BASE_URL       public URL of this app; <BASE_URL>/auth/callback is the redirect URI to register in Gitea,
+                   and it is the issuer/resource URL the MCP OAuth endpoints advertise
     ADMIN_USERS    comma-separated Gitea usernames allowed to use the admin API (none by default)
     SESSION_SECRET signs/encrypts session cookies (random per start when unset, so logins don't survive restarts)"
   ([] (env-config (System/getenv)))
   ([env]
    (let [base-url (strip-trailing-slashes (env-val env "BASE_URL"))]
-     {:gitea-url (strip-trailing-slashes (env-val env "GITEA_URL"))
+     {:base-url base-url
+      :gitea-url (strip-trailing-slashes (env-val env "GITEA_URL"))
       :client-id (env-val env "GITEA_CLIENT_ID")
       :client-secret (env-val env "GITEA_CLIENT_SECRET")
       :redirect-uri (some-> base-url (str "/auth/callback"))
@@ -87,12 +89,23 @@
        (MessageDigest/isEqual (.getBytes ^String expected StandardCharsets/UTF_8)
                               (.getBytes ^String actual StandardCharsets/UTF_8))))
 
-(defn- form-encode [params]
+(defn form-encode
+  "Params as an `application/x-www-form-urlencoded` string (also the format of a URL query)."
+  [params]
   (str/join "&" (map (fn [[k v]]
                        (str (URLEncoder/encode (name k) StandardCharsets/UTF_8) "="
                             (URLEncoder/encode (str v) StandardCharsets/UTF_8)))
                      params)))
 
+(defn safe-return-to
+  "`path` if it is a local path a login can send the browser back to, else nil. It must start
+  with a single `/` (so not `//host` or `/\\host`, which browsers read as another site)."
+  [path]
+  (when (and (string? path)
+             (<= (count path) 2000)
+             (re-matches #"/(?:[^/\\\s][^\\\s]*)?" path))
+    path))
+
 (defn authorize-url [{:keys [gitea-url client-id redirect-uri]} state]
   (str gitea-url "/login/oauth/authorize?"
        (form-encode {:client_id client-id

src/tbd/auth/routes.clj

@@ -8,12 +8,14 @@
   (respond 503 {:error "OAuth is not configured (set GITEA_URL, GITEA_CLIENT_ID, GITEA_CLIENT_SECRET, BASE_URL)"}))
 
 (defn- login-handler [config]
-  (fn [{:keys [session]}]
+  (fn [{:keys [session parameters]}]
     (if-not (auth/configured? config)
       not-configured
-      (let [state (auth/new-state)]
+      (let [state (auth/new-state)
+            return-to (auth/safe-return-to (get-in parameters [:query :return_to]))]
         (-> (response/redirect (auth/authorize-url config state))
-            (assoc :session (assoc session :oauth-state state)))))))
+            (assoc :session (cond-> (assoc session :oauth-state state)
+                              return-to (assoc :return-to return-to))))))))
 
 (defn- callback-handler [config]
   (fn [{:keys [session parameters]}]
@@ -28,7 +30,7 @@
           (let [user (some->> (auth/exchange-code config code) (auth/fetch-user config))]
             (if user
               ;; A fresh session (not the old one plus a user) so nothing from before login carries over.
-              (-> (response/redirect "/")
+              (-> (response/redirect (or (auth/safe-return-to (:return-to session)) "/"))
                   (assoc :session {:user (assoc user :expires-at (+ (System/currentTimeMillis)
                                                                      mw/session-ttl-ms))}))
               (respond 401 {:error "login failed"})))
@@ -45,10 +47,11 @@
 (defn routes [config]
   ["/auth"
    ["/login" {:get {:tags ["auth"]
-                    :summary "Start the Gitea OAuth login (redirects to Gitea)"
+                    :summary "Start the Gitea OAuth login (redirects to Gitea); afterwards the browser goes to `return_to` (a local path) or /"
+                    :parameters {:query [:map [:return_to {:optional true} :string]]}
                     :handler (login-handler config)}}]
    ["/callback" {:get {:tags ["auth"]
-                       :summary "OAuth redirect target; completes the login and redirects to /"
+                       :summary "OAuth redirect target; completes the login and redirects to / (or the login's return_to)"
                        :parameters {:query [:map
                                             [:code {:optional true} :string]
                                             [:state {:optional true} :string]

src/tbd/core.clj

@@ -19,8 +19,11 @@
             [tbd.health.routes :as health]
             [tbd.http :as http]
             [tbd.math.routes :as math]
+            [tbd.mcp.routes :as mcp-routes]
             [tbd.nrepl.core :as nrepl]
             [tbd.nrepl.routes :as nrepl-routes]
+            [tbd.oauth.db :as oauth-db]
+            [tbd.oauth.routes :as oauth-routes]
             [tbd.todo.db :as todo-db]
             [tbd.todo.routes :as todo-routes]))
 
@@ -60,37 +63,42 @@
 
 ;; Each logical group (health, users, orders, ...) owns a `tbd.<group>.routes`
 ;; namespace that returns its own route subtree; they're concatenated here.
-(defn make-router [{:keys [auth nrepl todo]}]
-  (ring/router
-    [["/swagger.json"
-      ;; The spec is JSON, whatever the API default is (Swagger UI can't read EDN).
-      {:muuntaja m/instance
-       :get {:no-doc true
-             :swagger {:info {:title "tbd API" :version "1.0.0"}}
-             :handler (swagger-handler)}}]
-     ["/" {:get {:no-doc true
-                 :handler index-handler}}]
-     (health/routes)
-     (math/routes)
-     (auth-routes/routes auth)
-     (nrepl-routes/routes nrepl)
-     (todo-routes/routes todo)]
-    {:data {:muuntaja http/muuntaja
-            :coercion malli/coercion
-            ;; Handlers (and the auth/error middleware) return plain data; the muuntaja
-            ;; middleware encodes it as the Accept header asks, so it wraps everything else.
-            ;; Auth comes next, so unauthenticated callers to `:admin? true` / `:login? true`
-            ;; routes are turned away before any body parsing or coercion runs. The request
-            ;; half of muuntaja is split off below the exception middleware (rather than using the
-            ;; combined format-middleware) so a malformed request body is caught and answered with a 400.
-            :middleware [muuntaja-middleware/format-negotiate-middleware
-                         muuntaja-middleware/format-response-middleware
-                         (auth-mw/admin-middleware auth)
-                         auth-mw/login-middleware
-                         parameters/parameters-middleware
-                         exception-middleware
-                         muuntaja-middleware/format-request-middleware
-                         coercion/coerce-request-middleware]}}))
+(defn make-router [{:keys [auth nrepl todo oauth]}]
+  (let [oauth-ds (delay (oauth-db/open (:db-path oauth)))
+        ;; Opened (and migrated) on first use, not when the app loads.
+        todo-ds (delay (todo-db/open (:db-path todo)))]
+    (ring/router
+      [["/swagger.json"
+        ;; The spec is JSON, whatever the API default is (Swagger UI can't read EDN).
+        {:muuntaja m/instance
+         :get {:no-doc true
+               :swagger {:info {:title "tbd API" :version "1.0.0"}}
+               :handler (swagger-handler)}}]
+       ["/" {:get {:no-doc true
+                   :handler index-handler}}]
+       (health/routes)
+       (math/routes)
+       (mcp-routes/routes auth oauth-ds todo-ds)
+       (oauth-routes/routes auth oauth-ds)
+       (auth-routes/routes auth)
+       (nrepl-routes/routes nrepl)
+       (todo-routes/routes todo-ds)]
+      {:data {:muuntaja http/muuntaja
+              :coercion malli/coercion
+              ;; Handlers (and the auth/error middleware) return plain data; the muuntaja
+              ;; middleware encodes it as the Accept header asks, so it wraps everything else.
+              ;; Auth comes next, so unauthenticated callers to `:admin? true` / `:login? true`
+              ;; routes are turned away before any body parsing or coercion runs. The request
+              ;; half of muuntaja is split off below the exception middleware (rather than using the
+              ;; combined format-middleware) so a malformed request body is caught and answered with a 400.
+              :middleware [muuntaja-middleware/format-negotiate-middleware
+                           muuntaja-middleware/format-response-middleware
+                           (auth-mw/admin-middleware auth)
+                           auth-mw/login-middleware
+                           parameters/parameters-middleware
+                           exception-middleware
+                           muuntaja-middleware/format-request-middleware
+                           coercion/coerce-request-middleware]}})))
 
 (defn make-app [{:keys [auth] :as config}]
   (-> (ring/ring-handler
@@ -107,7 +115,8 @@
 (def config
   {:auth (auth/env-config)
    :nrepl (nrepl/env-config)
-   :todo (todo-db/env-config)})
+   :todo (todo-db/env-config)
+   :oauth (oauth-db/env-config)})
 
 (def app (make-app config))
 
@@ -121,7 +130,7 @@
                                          (get opts :port 3000))))]
     (println (format "[tbd] starting server on port %d..." port))
     (when-not (auth/configured? (:auth config))
-      (println "[tbd] WARNING: Gitea OAuth is not configured; login and the admin API are unavailable"))
+      (println "[tbd] WARNING: Gitea OAuth is not configured; login, the admin API and the MCP endpoint are unavailable"))
     (when (empty? (get-in config [:auth :admin-users]))
       (println "[tbd] WARNING: ADMIN_USERS is empty; nobody can use the admin API"))
     (when-not (get-in config [:auth :session-secret])

src/tbd/math/routes.clj

@@ -1,11 +1,7 @@
 (ns tbd.math.routes
   (:require [tbd.http :as http]
-            [tbd.math.core :as math]))
-
-;; :int first so "2" stays a long (a bare `number?` or :double would decode it to 2.0).
-;; The :swagger/* props make the spec say plain `number` instead of the first :or branch.
-(def ^:private number-schema
-  [:or {:swagger/type "number" :swagger/format "double"} :int :double])
+            [tbd.math.core :as math]
+            [tbd.math.schema :as schema]))
 
 (defn- add-handler [{{{:keys [x y]} :query} :parameters}]
   (http/respond 200 {:result (math/add x y)}))
@@ -14,7 +10,5 @@
   ["/api/add"
    {:get {:tags ["math"]
           :summary "Add two numbers (?x=2&y=3 => {:result 5})"
-          :parameters {:query [:map
-                               [:x {:description "First addend"} number-schema]
-                               [:y {:description "Second addend"} number-schema]]}
+          :parameters {:query schema/Add}
           :handler add-handler}}])

src/tbd/math/schema.clj

@@ -0,0 +1,19 @@
+(ns tbd.math.schema
+  "The shapes of the math group's data, as Malli schemas. This is the one definition of them:
+  the HTTP routes coerce and validate requests with it (tbd.math.routes), and the MCP tools
+  derive their input schema and validate their arguments from it (tbd.mcp.tools).")
+
+(defn- number [description]
+  ;; :int first so \"2\" stays a long (a bare `number?` or :double would decode it to 2.0).
+  ;; The :swagger/* and :json-schema/* props make the generated specs say plain `number`
+  ;; instead of the first :or branch.
+  [:or {:description description
+        :swagger/type "number" :swagger/format "double"
+        :json-schema/type "number" :json-schema/format "double"}
+   :int :double])
+
+(def Add
+  "The two addends."
+  [:map
+   [:x (number "First addend")]
+   [:y (number "Second addend")]])

src/tbd/mcp/routes.clj

@@ -0,0 +1,51 @@
+(ns tbd.mcp.routes
+  "The MCP server, run as part of this server: plumcp's Streamable HTTP transport as a Ring
+  handler mounted at `/mcp`. Point an MCP client at <BASE_URL>/mcp. The tools it offers are in
+  tbd.mcp.tools. Every request needs an OAuth access token from tbd's own authorization server
+  (tbd.oauth.routes); tbd.oauth.middleware checks it and tells the tools who is calling."
+  (:require [plumcp.core.api.entity-support :as es]
+            [plumcp.core.deps.runtime :as rt]
+            [plumcp.core.server.http-ring :as mcp-http]
+            [plumcp.core.server.server-support :as mcp-server]
+            [plumcp.core.support.traffic-logger :as traffic-logger]
+            [tbd.mcp.tools :as tools]
+            [tbd.oauth.middleware :as oauth-mw]))
+
+(defn- wrap-runtime
+  "`handler` with `bindings` added to the plumcp runtime bag of every request, for the tools to use."
+  [handler bindings]
+  (fn [req] (handler (rt/upsert-runtime req bindings))))
+
+(defn make-handler
+  "A Ring handler speaking MCP over Streamable HTTP, for callers with a valid access token
+  (`auth` is the auth config, `ds` a delay of the OAuth database, `todo-ds` one of the todo database). It keeps its MCP sessions in
+  memory, so each handler is its own server: sessions don't outlive it, and aren't shared between nodes."
+  [auth ds todo-ds]
+  (let [{:keys [runtime jsonrpc-handler] :as options}
+        (mcp-server/make-server-options
+          {:info (es/make-info "tbd" "1.0.0" "tbd MCP server")
+           :primitives tools/primitives
+           ;; The default logs every MCP message to stderr; it's noise (and tool arguments).
+           :traffic-logger traffic-logger/nop-traffic-logger})]
+    (-> (mcp-http/make-ring-handler runtime jsonrpc-handler options)
+        ;; What the tools that touch todos need besides the caller (see tbd.mcp.tools).
+        (wrap-runtime {tools/todo-ds-key todo-ds})
+        ;; Jetty hands over the body as a stream; plumcp reads the message through `:on-msg`.
+        mcp-http/wrap-request-body-reader
+        ;; Outermost, so a request without a token is turned away before its body is read.
+        (oauth-mw/wrap-bearer-auth auth ds))))
+
+(defn routes [auth ds todo-ds]
+  (let [handler (make-handler auth ds todo-ds)]
+    ["/mcp"
+     ;; plumcp does its own content negotiation, JSON parsing and (via the wrapper above) body
+     ;; reading, so it must not sit behind the API's muuntaja/coercion middleware chain. ^:replace
+     ;; drops the router-wide :middleware for this route instead of adding to it.
+     {:middleware ^:replace []
+      :no-doc true
+      ;; No :get on purpose. That is MCP's optional server-to-client SSE stream, and the spec lets
+      ;; a server answer it with 405. Under Jetty it would also hang: the response headers aren't
+      ;; sent until the first event, and every open stream holds a thread. None of the tools push
+      ;; anything, so nothing is lost. Add :get here if one ever needs to (and test it against Jetty).
+      :post {:handler handler}
+      :delete {:handler handler}}]))

src/tbd/mcp/schema.clj

@@ -0,0 +1,40 @@
+(ns tbd.mcp.schema
+  "MCP tools defined from Malli schemas, the same ones the HTTP routes use (tbd.<group>.schema),
+  so a shape of data is written down once. A schema gives the tool its JSON-Schema input schema
+  (what clients and models see) and coerces and validates the arguments it is called with. plumcp
+  itself only checks that required arguments are present."
+  (:require [malli.core :as m]
+            [malli.error :as me]
+            [malli.json-schema :as json-schema]
+            [malli.transform :as mt]
+            [plumcp.core.api.capability :as cap]
+            [plumcp.core.deps.runtime :as rt]))
+
+(def ^:private transformer
+  ;; Unknown arguments are dropped, and JSON values become what the schema says (keywords, ...).
+  (mt/transformer mt/strip-extra-keys-transformer mt/json-transformer))
+
+(defn coerce!
+  "`args` decoded for `schema`, or an exception whose message says what is wrong with them
+  (an exception in a tool is an error result the model can read)."
+  [schema args]
+  (let [decoded (m/decode schema args transformer)]
+    (if (m/validate schema decoded)
+      decoded
+      (throw (ex-info (str "invalid arguments: " (pr-str (me/humanize (m/explain schema decoded))))
+                      {})))))
+
+(defn tool
+  "A tool for plumcp's `:primitives` `:tools`. `schema` is a `:map` schema of its arguments; `f` is
+  called with them, coerced and validated, and with the request's plumcp runtime bag (`ctx`, where
+  tbd.mcp.routes and tbd.oauth.middleware put what tools need: read it with `ctx-get`). It returns a
+  string, number, boolean or vector of content, or throws."
+  [tool-name description schema f]
+  (cap/make-tool-item tool-name (json-schema/transform schema)
+                      (fn [args] (f (coerce! schema (dissoc args rt/k-runtime)) args))
+                      :description description))
+
+(defn ctx-get
+  "`k` from the runtime bag `ctx`; throws if it is missing (a bug, not something to run without)."
+  [ctx k]
+  (rt/!>get ctx k))

src/tbd/mcp/tools.clj

@@ -0,0 +1,84 @@
+(ns tbd.mcp.tools
+  "The MCP tools the server offers, in the shape plumcp's server options take as `:primitives`.
+  Like the HTTP handlers, a tool is a thin adapter over a group's business logic (tbd.<group>.core)
+  and storage; it has no rules of its own. Its arguments are described by the group's Malli schema
+  (tbd.<group>.schema), the same one the HTTP routes use, so shapes are defined once and every tool
+  gets its input schema and argument validation from them (see tbd.mcp.schema).
+
+  A tool function takes the coerced arguments and the request context, and returns a string,
+  number, boolean or vector of content, or throws: an exception becomes an error result the model
+  can read, not a failed request."
+  (:require [muuntaja.core :as m]
+            [tbd.math.core :as math]
+            [tbd.math.schema :as math-schema]
+            [tbd.mcp.schema :refer [tool ctx-get]]
+            [tbd.oauth.middleware :as oauth-mw]
+            [tbd.todo.core :as todo]
+            [tbd.todo.db :as todo-db]
+            [tbd.todo.schema :as todo-schema]))
+
+(def todo-ds-key
+  "Where the todo database (a delay, as for the HTTP routes) is in the request's plumcp runtime
+  bag; tbd.mcp.routes puts it there."
+  :tbd/todo-ds)
+
+(defn- current-user
+  "Who is calling: {:login :id :admin? :client-id}, the user whose access token the request
+  carried (see tbd.oauth.middleware). Tools that touch a user's data go through this, and
+  check `:admin?` for anything admin-only. Throws if there is none (the transport never lets
+  such a request through, so that would be a bug, and no tool should run as nobody)."
+  [ctx]
+  (ctx-get ctx (oauth-mw/user-key)))
+
+(defn- ->json [data] (slurp (m/encode "application/json" data)))
+
+(defn- ok!
+  "The value of a todo.core result, or throws its error."
+  [{:keys [ok error]}]
+  (or ok (throw (ex-info error {}))))
+
+(defn- now [] (System/currentTimeMillis))
+
+;; Todos belong to the caller. Someone else's is reported exactly like a missing one.
+(defn- todo-ds [ctx] @(ctx-get ctx todo-ds-key))
+
+(defn- owner-id [ctx] (:id (current-user ctx)))
+
+(defn- find-todo! [ctx id]
+  (or (todo-db/find-todo (todo-ds ctx) (owner-id ctx) id)
+      (throw (ex-info "todo not found" {:id id}))))
+
+(def primitives
+  {:tools
+   [(tool "ping" "Health check: returns pong" [:map]
+          (fn [_ _] "pong"))
+
+    (tool "add" "Add two numbers" math-schema/Add
+          (fn [{:keys [x y]} _] (math/add x y)))
+
+    (tool "whoami" "Says which user this connection acts as, and whether they are an admin" [:map]
+          (fn [_ ctx]
+            (let [{:keys [login id admin?]} (current-user ctx)]
+              (format "%s (Gitea user %d)%s" login id (if admin? ", admin" "")))))
+
+    (tool "list_todos" "Lists your todos (JSON: id, title, done, created-at, updated-at), oldest first" [:map]
+          (fn [_ ctx] (->json (todo-db/list-todos (todo-ds ctx) (owner-id ctx)))))
+
+    (tool "get_todo" "Gets one of your todos by id (JSON)" todo-schema/IdParam
+          (fn [{:keys [id]} ctx] (->json (find-todo! ctx id))))
+
+    (tool "create_todo" "Creates a todo for you and returns it (JSON)" todo-schema/NewTodo
+          (fn [{:keys [title]} ctx]
+            (->json (todo-db/insert! (todo-ds ctx) (ok! (todo/new-todo (owner-id ctx) title (now)))))))
+
+    (tool "update_todo" "Changes the title and/or done flag of one of your todos and returns it (JSON)"
+          todo-schema/UpdateTodo
+          (fn [{:keys [id] :as input} ctx]
+            (let [changed (ok! (todo/apply-changes (find-todo! ctx id) (dissoc input :id) (now)))]
+              (->json (todo-db/update! (todo-ds ctx) (owner-id ctx) changed)))))
+
+    (tool "delete_todo" "Deletes one of your todos" todo-schema/IdParam
+          (fn [{:keys [id]} ctx]
+            (find-todo! ctx id)
+            (todo-db/delete! (todo-ds ctx) (owner-id ctx) id)
+            "deleted"))]})

src/tbd/oauth/core.clj

@@ -0,0 +1,144 @@
+(ns tbd.oauth.core
+  "The rules of tbd's own OAuth 2.1 authorization server, which is how MCP clients get a token
+  for /mcp: PKCE, redirect URI checks, scopes, the metadata documents clients discover it by,
+  and token generation. No Ring and no SQL here; tbd.oauth.routes and tbd.oauth.db own those.
+  Users prove who they are with the Gitea login (tbd.auth); the tokens issued here are tbd's
+  own, and Gitea's never leave the login step."
+  (:require [clojure.string :as str]
+            [tbd.auth.core :as auth])
+  (:import (java.net URI URISyntaxException)
+           (java.nio.charset StandardCharsets)
+           (java.security MessageDigest SecureRandom)
+           (java.util Base64 HexFormat)))
+
+(def scope "The only scope: use the MCP server as yourself." "mcp")
+
+(def code-ttl-ms "An authorization code must be traded for tokens within a minute." (* 60 1000))
+(def access-ttl-ms (* 60 60 1000))
+(def refresh-ttl-ms (* 30 24 60 60 1000))
+
+(defn resource-url
+  "The MCP endpoint, which is the OAuth `resource` tokens are issued for."
+  [base-url]
+  (str base-url "/mcp"))
+
+(defn protected-resource-metadata
+  "RFC 9728: tells a client that /mcp wants tokens and which authorization server issues them."
+  [base-url]
+  {:resource (resource-url base-url)
+   :authorization_servers [base-url]
+   :scopes_supported [scope]
+   :bearer_methods_supported ["header"]
+   :resource_name "tbd MCP server"})
+
+(defn authorization-server-metadata
+  "RFC 8414: where a client registers, sends the user, and trades codes for tokens."
+  [base-url]
+  {:issuer base-url
+   :authorization_endpoint (str base-url "/oauth/authorize")
+   :token_endpoint (str base-url "/oauth/token")
+   :registration_endpoint (str base-url "/oauth/register")
+   :scopes_supported [scope]
+   :response_types_supported ["code"]
+   :grant_types_supported ["authorization_code" "refresh_token"]
+   :code_challenge_methods_supported ["S256"]
+   :token_endpoint_auth_methods_supported ["none"]
+   :authorization_response_iss_parameter_supported true})
+
+(def ^:private secure-random (SecureRandom.))
+
+(defn random-token
+  "256 random bits, URL-safe: an authorization code, access token, refresh token or CSRF token."
+  []
+  (let [bytes (byte-array 32)]
+    (.nextBytes secure-random bytes)
+    (.encodeToString (.withoutPadding (Base64/getUrlEncoder)) bytes)))
+
+(defn- sha-256 ^bytes [^String s]
+  (.digest (MessageDigest/getInstance "SHA-256") (.getBytes s StandardCharsets/UTF_8)))
+
+(defn hash-token
+  "What is stored in place of a code or token, so a copy of the database can't be used to act
+  as anyone. The tokens are 256 random bits, so a plain fast hash is enough."
+  [token]
+  (.formatHex (HexFormat/of) (sha-256 token)))
+
+;; --- PKCE (RFC 7636); only S256 is accepted ---
+
+(defn pkce-challenge [verifier]
+  (.encodeToString (.withoutPadding (Base64/getUrlEncoder)) (sha-256 verifier)))
+
+(defn challenge-format?
+  "A S256 challenge is a SHA-256 digest, base64url without padding: always 43 characters."
+  [challenge]
+  (boolean (and (string? challenge) (re-matches #"[A-Za-z0-9_-]{43}" challenge))))
+
+(defn pkce-valid? [challenge verifier]
+  (and (string? verifier)
+       (boolean (re-matches #"[A-Za-z0-9._~-]{43,128}" verifier))
+       (auth/state-matches? challenge (pkce-challenge verifier))))
+
+;; --- Redirect URIs ---
+
+(def ^:private forbidden-schemes
+  "Schemes that would run or read something in the browser instead of handing the code to an app."
+  #{"javascript" "data" "file" "vbscript" "about" "blob" "ftp"})
+
+(defn- parse-uri [s]
+  (when (and (string? s) (<= (count s) 2048))
+    (try (URI. s) (catch URISyntaxException _ nil))))
+
+(defn- loopback? [^URI uri]
+  (and (= "http" (.getScheme uri))
+       (contains? #{"localhost" "127.0.0.1" "[::1]"} (.getHost uri))))
+
+(defn valid-redirect-uri?
+  "What a client may register: https, http to the local machine (a CLI listening on a port),
+  or an app's own scheme (`cursor://...`). No fragment, no credentials in the URL."
+  [s]
+  (if-let [uri (parse-uri s)]
+    (let [scheme (some-> (.getScheme uri) str/lower-case)]
+      (boolean
+        (and scheme
+             (nil? (.getRawFragment uri))
+             (nil? (.getUserInfo uri))
+             (not (contains? forbidden-schemes scheme))
+             (case scheme
+               "https" (some? (.getHost uri))
+               "http" (loopback? uri)
+               true))))
+    false))
+
+(defn redirect-uri-matches?
+  "Exact match with a registered URI, except that a client on the local machine may pick its
+  port each time (RFC 8252), so loopback URIs are compared without it."
+  [registered actual]
+  (boolean
+    (or (= registered actual)
+        (let [r (parse-uri registered), a (parse-uri actual)]
+          (and r a (loopback? r) (loopback? a)
+               (= (.getHost r) (.getHost a))
+               (= (.getRawPath r) (.getRawPath a))
+               (= (.getRawQuery r) (.getRawQuery a)))))))
+
+(defn redirect-with
+  "`uri` with `params` (nil values dropped) added to its query."
+  [uri params]
+  (str uri (if (str/includes? uri "?") "&" "?")
+       (auth/form-encode (remove (comp nil? val) params))))
+
+;; --- Scopes and resources ---
+
+(defn parse-scope
+  "The scope a request asks for: `scope` when unspecified, or nil when it asks for anything else."
+  [requested]
+  (if (str/blank? requested)
+    scope
+    (when (= [scope] (str/split (str/trim requested) #"\s+"))
+      scope)))
+
+(defn resource-ok?
+  "The RFC 8707 `resource` a request names (a string, several, or nothing) must be this MCP server."
+  [base-url resource]
+  (every? #(= (resource-url base-url) (str/replace % #"/+$" ""))
+          (if (string? resource) [resource] resource)))

src/tbd/oauth/db.clj

@@ -0,0 +1,137 @@
+(ns tbd.oauth.db
+  "SQLite persistence for the MCP OAuth server, in a local file. Storage only: what is valid, and
+  when, lives in tbd.oauth.core and tbd.oauth.routes. Codes and tokens are stored as hashes
+  (see tbd.oauth.core/hash-token), so callers pass hashes here, never the secrets themselves."
+  (:require [clojure.edn :as edn]
+            [clojure.java.io :as io]
+            [clojure.string :as str]
+            [next.jdbc :as jdbc]
+            [next.jdbc.result-set :as rs]))
+
+(def default-path "data/oauth.db")
+
+(defn env-config
+  "OAUTH_DB_PATH: where the SQLite file lives (default data/oauth.db; its directory is created)."
+  ([] (env-config (System/getenv)))
+  ([env]
+   (let [path (get env "OAUTH_DB_PATH")]
+     {:db-path (if (str/blank? path) default-path (str/trim path))})))
+
+(defn- migrate! [ds]
+  ;; Clients register themselves (RFC 7591), so a row here says nothing about who the user is.
+  (jdbc/execute! ds ["CREATE TABLE IF NOT EXISTS clients (
+                        id            TEXT    PRIMARY KEY,
+                        name          TEXT    NOT NULL,
+                        redirect_uris TEXT    NOT NULL,
+                        created_at    INTEGER NOT NULL)"])
+  ;; One-time authorization codes, deleted when used.
+  (jdbc/execute! ds ["CREATE TABLE IF NOT EXISTS codes (
+                        hash           TEXT    PRIMARY KEY,
+                        client_id      TEXT    NOT NULL,
+                        user_id        INTEGER NOT NULL,
+                        login          TEXT    NOT NULL,
+                        redirect_uri   TEXT    NOT NULL,
+                        code_challenge TEXT    NOT NULL,
+                        scope          TEXT    NOT NULL,
+                        expires_at     INTEGER NOT NULL)"])
+  ;; A user's approval of a client: the current access and refresh token (hashed), replaced
+  ;; together when the refresh token is used. Deleting the row revokes the approval.
+  (jdbc/execute! ds ["CREATE TABLE IF NOT EXISTS grants (
+                        id                 INTEGER PRIMARY KEY AUTOINCREMENT,
+                        client_id          TEXT    NOT NULL,
+                        user_id            INTEGER NOT NULL,
+                        login              TEXT    NOT NULL,
+                        scope              TEXT    NOT NULL,
+                        access_hash        TEXT    NOT NULL UNIQUE,
+                        access_expires_at  INTEGER NOT NULL,
+                        refresh_hash       TEXT    NOT NULL UNIQUE,
+                        refresh_expires_at INTEGER NOT NULL,
+                        created_at         INTEGER NOT NULL)"])
+  (jdbc/execute! ds ["CREATE INDEX IF NOT EXISTS grants_by_client ON grants (client_id)"]))
+
+(defn open
+  "A datasource for the database file at `path`, created and migrated if need be; connections
+  and locking work as in tbd.todo.db."
+  [path]
+  (when (str/blank? path)
+    (throw (ex-info "no OAuth database path configured (set OAUTH_DB_PATH)" {})))
+  (some-> (io/file path) .getAbsoluteFile .getParentFile .mkdirs)
+  (doto (jdbc/get-datasource {:dbtype "sqlite" :dbname path
+                              :journal_mode "WAL" :busy_timeout 5000})
+    migrate!))
+
+(def ^:private opts {:builder-fn rs/as-unqualified-kebab-maps})
+
+;; --- clients ---
+
+(defn insert-client!
+  [ds {:keys [id name redirect-uris created-at]}]
+  (jdbc/execute! ds ["INSERT INTO clients (id, name, redirect_uris, created_at) VALUES (?, ?, ?, ?)"
+                     id name (pr-str redirect-uris) created-at]))
+
+(defn find-client
+  "The registered client as {:id :name :redirect-uris :created-at}, or nil."
+  [ds id]
+  (some-> (jdbc/execute-one! ds ["SELECT * FROM clients WHERE id = ?" id] opts)
+          (update :redirect-uris edn/read-string)))
+
+(defn prune!
+  "Registration is open to anyone, so drop what nobody is using: expired codes, grants whose
+  refresh token has expired (nothing can renew them), and clients registered before
+  `unused-before` that were never approved by anyone."
+  [ds now unused-before]
+  (jdbc/execute! ds ["DELETE FROM codes WHERE expires_at <= ?" now])
+  (jdbc/execute! ds ["DELETE FROM grants WHERE refresh_expires_at <= ?" now])
+  (jdbc/execute! ds ["DELETE FROM clients WHERE created_at < ?
+                        AND id NOT IN (SELECT client_id FROM grants)
+                        AND id NOT IN (SELECT client_id FROM codes)"
+                     unused-before]))
+
+;; --- authorization codes ---
+
+(defn insert-code!
+  [ds {:keys [hash client-id user-id login redirect-uri code-challenge scope expires-at]}]
+  (jdbc/execute! ds ["INSERT INTO codes (hash, client_id, user_id, login, redirect_uri,
+                                         code_challenge, scope, expires_at)
+                      VALUES (?, ?, ?, ?, ?, ?, ?, ?)"
+                     hash client-id user-id login redirect-uri code-challenge scope expires-at]))
+
+(defn take-code!
+  "Removes and returns the code, or nil if there is none. Whoever gets a row is the only one who
+  ever will, so a code can't be used twice, even by two requests at once."
+  [ds hash]
+  (jdbc/execute-one! ds ["DELETE FROM codes WHERE hash = ? RETURNING *" hash] opts))
+
+;; --- grants ---
+
+(defn insert-grant!
+  [ds {:keys [client-id user-id login scope access-hash access-expires-at
+              refresh-hash refresh-expires-at created-at]}]
+  (jdbc/execute! ds ["INSERT INTO grants (client_id, user_id, login, scope, access_hash, access_expires_at,
+                                          refresh_hash, refresh_expires_at, created_at)
+                      VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?)"
+                     client-id user-id login scope access-hash access-expires-at
+                     refresh-hash refresh-expires-at created-at]))
+
+(defn find-grant-by-access
+  "The grant whose current access token has this hash and hasn't expired at `now`, or nil."
+  [ds hash now]
+  (jdbc/execute-one! ds ["SELECT * FROM grants WHERE access_hash = ? AND access_expires_at > ?" hash now] opts))
+
+(defn find-grant-by-refresh
+  "The grant whose current refresh token has this hash, or nil (expiry is for the caller to judge)."
+  [ds hash]
+  (jdbc/execute-one! ds ["SELECT * FROM grants WHERE refresh_hash = ?" hash] opts))
+
+(defn rotate-grant!
+  "Swaps in a new access and refresh token for the grant, but only while `old-refresh-hash` is
+  still its refresh token, so a refresh token works once. Returns the grant, or nil if it lost."
+  [ds id old-refresh-hash {:keys [access-hash access-expires-at refresh-hash refresh-expires-at]}]
+  (jdbc/execute-one! ds ["UPDATE grants SET access_hash = ?, access_expires_at = ?,
+                                            refresh_hash = ?, refresh_expires_at = ?
+                          WHERE id = ? AND refresh_hash = ? RETURNING *"
+                         access-hash access-expires-at refresh-hash refresh-expires-at id old-refresh-hash]
+                     opts))
+
+(defn delete-grant! [ds id]
+  (jdbc/execute! ds ["DELETE FROM grants WHERE id = ?" id]))

src/tbd/oauth/middleware.clj

@@ -0,0 +1,59 @@
+(ns tbd.oauth.middleware
+  "The resource-server half of MCP OAuth: `wrap-bearer-auth` guards /mcp, accepting only the
+  access tokens tbd.oauth.routes issued. It is plain Ring (like /mcp itself), not reitit
+  middleware, because /mcp sits outside the router's middleware chain."
+  (:require [muuntaja.core :as m]
+            [plumcp.core.deps.runtime :as rt]
+            [tbd.auth.core :as auth]
+            [tbd.oauth.core :as oauth]
+            [tbd.oauth.db :as db]))
+
+(defn- bearer-token [req]
+  (some->> (get-in req [:headers "authorization"])
+           (re-matches #"(?i)Bearer\s+(\S+)")
+           second))
+
+(defn- json [status headers body]
+  {:status status
+   :headers (merge {"Content-Type" "application/json" "Cache-Control" "no-store"} headers)
+   :body (m/encode "application/json" body)})
+
+(defn- unauthorized
+  "A 401 that tells the client where to start the OAuth flow (RFC 9728 / RFC 6750): the
+  `resource_metadata` URL is how an MCP client discovers the authorization server. `error` is
+  only given when a token was presented and rejected."
+  [base-url error]
+  (json 401
+        {"WWW-Authenticate" (str "Bearer resource_metadata=\"" base-url "/.well-known/oauth-protected-resource/mcp\""
+                                 ", scope=\"" oauth/scope "\""
+                                 (when error (str ", error=\"" error "\"")))}
+        {:error (or error "unauthorized")
+         :error_description (if error "the access token is invalid or expired" "a bearer access token is required")}))
+
+(defn user-key
+  "Where the caller is in the request's plumcp runtime bag, which is what MCP tools get (see
+  tbd.mcp.tools): a map of :login, :id, :admin? and :client-id."
+  []
+  :tbd/user)
+
+(defn wrap-bearer-auth
+  "401 (pointing at the OAuth metadata) unless the request carries a valid access token. The
+  caller goes on as `:user` ({:login :id :admin? :client-id}), also in the plumcp runtime bag
+  so tools can see it. Admin-ness is decided per request from the allowlist, not baked into the
+  token, so taking someone off ADMIN_USERS takes effect at once. `ds` is a delay: the database
+  isn't opened for requests that carry no token."
+  [handler config ds]
+  (fn [req]
+    (if-not (auth/configured? config)
+      (json 503 {} {:error "OAuth is not configured (set GITEA_URL, GITEA_CLIENT_ID, GITEA_CLIENT_SECRET, BASE_URL)"})
+      (if-let [token (bearer-token req)]
+        (if-let [grant (db/find-grant-by-access @ds (oauth/hash-token token) (System/currentTimeMillis))]
+          (let [user {:login (:login grant)
+                      :id (:user-id grant)
+                      :admin? (auth/admin? config (:login grant))
+                      :client-id (:client-id grant)}]
+            (handler (-> req
+                         (assoc :user user)
+                         (rt/upsert-runtime {(user-key) user}))))
+          (unauthorized (:base-url config) "invalid_token"))
+        (unauthorized (:base-url config) nil)))))

src/tbd/oauth/routes.clj

@@ -0,0 +1,323 @@
+(ns tbd.oauth.routes
+  "The OAuth endpoints MCP clients use to get a token for /mcp (RFC 9728 / 8414 discovery,
+  RFC 7591 registration, authorization-code flow with PKCE). The user logs in with Gitea as
+  usual (tbd.auth.routes) and approves the client on a consent page; the token the client gets
+  is tbd's own, checked by tbd.oauth.middleware. What is valid is decided in tbd.oauth.core.
+
+  These endpoints speak the formats RFC 6749 requires (JSON, and forms in), whatever the
+  request's Accept header says, so like /mcp they sit outside the API's muuntaja/coercion chain."
+  (:require [clojure.string :as str]
+            [muuntaja.core :as m]
+            [reitit.ring.middleware.parameters :as parameters]
+            [ring.util.response :as response]
+            [tbd.auth.core :as auth]
+            [tbd.auth.middleware :as auth-mw]
+            [tbd.oauth.core :as oauth]
+            [tbd.oauth.db :as db])
+  (:import (java.io InputStream)))
+
+(defn- now [] (System/currentTimeMillis))
+
+(defn- json [status body]
+  {:status status
+   :headers {"Content-Type" "application/json" "Cache-Control" "no-store"}
+   :body (m/encode "application/json" body)})
+
+(defn- only-when-configured
+  "Without the Gitea login there is nobody to approve a client, and no base URL to name in metadata."
+  [config handler]
+  (fn [req]
+    (if (auth/configured? config)
+      (handler req)
+      (json 503 {:error "OAuth is not configured (set GITEA_URL, GITEA_CLIENT_ID, GITEA_CLIENT_SECRET, BASE_URL)"}))))
+
+(defn- param
+  "A form or query parameter's value when it was given exactly once."
+  [params k]
+  (let [v (get params k)]
+    (when (string? v) v)))
+
+;; --- discovery ---
+
+(defn- metadata-handler [f config]
+  (fn [_req] (json 200 (f (:base-url config)))))
+
+;; --- dynamic client registration (RFC 7591) ---
+
+(def ^:private max-registration-bytes 16384)
+(def ^:private max-redirect-uris 10)
+(def ^:private max-name-length 100)
+(def ^:private unused-client-ttl-ms (* 7 24 60 60 1000))
+
+(defn- read-json-object
+  "The request body as a map, or nil if it is missing, too big, or not a JSON object. The size
+  is capped because anyone can call this."
+  [^InputStream body]
+  (when body
+    (let [bytes (.readNBytes body (inc max-registration-bytes))]
+      (when (<= (alength bytes) max-registration-bytes)
+        (try
+          (let [v (m/decode "application/json" bytes)]
+            (when (map? v) v))
+          (catch Exception _ nil))))))
+
+(defn- invalid-metadata [description]
+  (json 400 {:error "invalid_client_metadata" :error_description description}))
+
+(defn- register-handler [ds]
+  (fn [{:keys [body]}]
+    (let [{:keys [redirect_uris client_name token_endpoint_auth_method grant_types response_types] :as metadata}
+          (read-json-object body)
+          subset-of? (fn [allowed v] (or (nil? v) (and (sequential? v) (every? allowed v))))]
+      (cond
+        (nil? metadata) (invalid-metadata "the body must be a JSON object of at most 16 KB")
+        (not (and (vector? redirect_uris) (<= 1 (count redirect_uris) max-redirect-uris) (every? string? redirect_uris)))
+        (invalid-metadata (str "redirect_uris must list 1 to " max-redirect-uris " URIs"))
+        (not (every? oauth/valid-redirect-uri? redirect_uris))
+        (json 400 {:error "invalid_redirect_uri"
+                   :error_description "redirect URIs must be https, http on localhost, or an app's own scheme, with no fragment"})
+        (not (contains? #{nil "none"} token_endpoint_auth_method))
+        (invalid-metadata "only public clients are supported (token_endpoint_auth_method none)")
+        (not (subset-of? #{"authorization_code" "refresh_token"} grant_types))
+        (invalid-metadata "grant_types can be authorization_code and refresh_token")
+        (not (subset-of? #{"code"} response_types))
+        (invalid-metadata "response_types can be code")
+        :else
+        (let [t (now)
+              client {:id (str (random-uuid))
+                      :name (if (and (string? client_name) (not (str/blank? client_name)))
+                              (let [n (str/trim client_name)] (subs n 0 (min (count n) max-name-length)))
+                              "Unnamed application")
+                      :redirect-uris redirect_uris
+                      :created-at t}]
+          (db/prune! @ds t (- t unused-client-ttl-ms))
+          (db/insert-client! @ds client)
+          (json 201 {:client_id (:id client)
+                     :client_id_issued_at (quot t 1000)
+                     :client_name (:name client)
+                     :redirect_uris redirect_uris
+                     :grant_types ["authorization_code" "refresh_token"]
+                     :response_types ["code"]
+                     :token_endpoint_auth_method "none"}))))))
+
+;; --- authorization endpoint ---
+
+(defn- esc [s]
+  (-> (str s)
+      (str/replace "&" "&amp;") (str/replace "<" "&lt;") (str/replace ">" "&gt;")
+      (str/replace "\"" "&quot;") (str/replace "'" "&#39;")))
+
+(defn- html
+  "A page that can't be framed (it is a consent screen) or cached. `form-action` is left out of
+  the policy on purpose: approving redirects to the client's own address, which may be any
+  scheme, and browsers apply that directive to the redirect too."
+  [status title & body]
+  {:status status
+   :headers {"Content-Type" "text/html; charset=utf-8"
+             "Cache-Control" "no-store"
+             "X-Frame-Options" "DENY"
+             "Content-Security-Policy" "default-src 'none'; style-src 'unsafe-inline'; frame-ancestors 'none'; base-uri 'none'"}
+   :body (str "<!doctype html><html lang=\"en\"><head><meta charset=\"utf-8\">"
+              "<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">"
+              "<title>" (esc title) "</title><style>"
+              ":root{color-scheme:light dark}"
+              "body{font:16px/1.5 system-ui,sans-serif;margin:0;padding:16px}"
+              "main{max-width:32rem;margin:8vh auto 0}"
+              "code{word-break:break-all}"
+              "button{font:inherit;padding:.5em 1.2em;margin-right:.5em;cursor:pointer}"
+              "</style></head><body><main><h1>" (esc title) "</h1>" (apply str body) "</main></body></html>")})
+
+(defn- error-page [status message]
+  (html status "Can't connect this application" "<p>" (esc message) "</p>"))
+
+(defn- validate-authorization
+  "Checks an authorization request's parameters (query or form). One of:
+    {:request {...}}                    good
+    {:page-error \"...\"}                 the client or redirect URI can't be trusted, so don't redirect
+    {:error :description :redirect-uri :state}  anything else, to be reported to the client's redirect URI"
+  [config ds params]
+  (let [client (some->> (param params "client_id") (db/find-client @ds))
+        redirect-uri (param params "redirect_uri")
+        state (param params "state")
+        challenge (param params "code_challenge")
+        scope (oauth/parse-scope (param params "scope"))
+        fail (fn [error description]
+               {:error error :description description :redirect-uri redirect-uri :state state})]
+    (cond
+      (nil? client) {:page-error "This link names an application tbd doesn't know. Start the connection again from your MCP client."}
+      (not (some #(oauth/redirect-uri-matches? % redirect-uri) (:redirect-uris client)))
+      {:page-error "This link's return address isn't one the application registered. Start the connection again from your MCP client."}
+      (not= "code" (param params "response_type")) (fail "unsupported_response_type" "response_type must be code")
+      (not (oauth/challenge-format? challenge)) (fail "invalid_request" "code_challenge is required (PKCE, S256)")
+      (not= "S256" (param params "code_challenge_method")) (fail "invalid_request" "code_challenge_method must be S256")
+      (nil? scope) (fail "invalid_scope" (str "the only scope is " oauth/scope))
+      (not (oauth/resource-ok? (:base-url config) (get params "resource"))) (fail "invalid_target" "resource must be the MCP server")
+      :else {:request {:client client :redirect-uri redirect-uri :state state
+                       :code-challenge challenge :scope scope
+                       :resource (param params "resource")}})))
+
+(defn- redirect-error [config {:keys [redirect-uri state error description]}]
+  (response/redirect (oauth/redirect-with redirect-uri {:error error
+                                                        :error_description description
+                                                        :state state
+                                                        :iss (:base-url config)})
+                     :see-other))
+
+(defn- consent-page [{:keys [client redirect-uri state code-challenge scope resource]} user csrf]
+  (let [hidden (fn [k v] (when v (str "<input type=\"hidden\" name=\"" k "\" value=\"" (esc v) "\">")))]
+    (html 200 "Connect an application"
+          "<p><strong>" (esc (:name client)) "</strong> wants to use the tbd MCP server as "
+          "<strong>" (esc (:login user)) "</strong>: it will be able to call every tool the server offers, "
+          "with your access.</p>"
+          "<p>If you approve, your browser goes back to <code>" (esc redirect-uri) "</code>. "
+          "Only approve if you started this from that application.</p>"
+          "<form method=\"post\" action=\"/oauth/authorize\">"
+          (hidden "csrf" csrf)
+          (hidden "client_id" (:id client))
+          (hidden "redirect_uri" redirect-uri)
+          (hidden "response_type" "code")
+          (hidden "code_challenge" code-challenge)
+          (hidden "code_challenge_method" "S256")
+          (hidden "scope" scope)
+          (hidden "state" state)
+          (hidden "resource" resource)
+          "<button type=\"submit\" name=\"decision\" value=\"approve\">Approve</button>"
+          "<button type=\"submit\" name=\"decision\" value=\"deny\">Deny</button>"
+          "</form>")))
+
+(defn- authorize-get-handler [config ds]
+  (fn [{:keys [query-params query-string session] :as req}]
+    (let [result (validate-authorization config ds query-params)]
+      (cond
+        (:page-error result) (error-page 400 (:page-error result))
+        (:error result) (redirect-error config result)
+        ;; Not logged in: do that first (Gitea), which then sends the browser back here.
+        (nil? (auth-mw/current-user req))
+        (response/redirect (str "/auth/login?" (auth/form-encode {:return_to (str "/oauth/authorize?" query-string)})))
+        :else
+        (let [csrf (oauth/random-token)]
+          (-> (consent-page (:request result) (auth-mw/current-user req) csrf)
+              (assoc :session (assoc session :oauth-csrf csrf))))))))
+
+(defn- approve [config ds {:keys [client redirect-uri state code-challenge scope]} user]
+  (let [code (oauth/random-token)]
+    (db/insert-code! @ds {:hash (oauth/hash-token code)
+                          :client-id (:id client)
+                          :user-id (:id user)
+                          :login (:login user)
+                          :redirect-uri redirect-uri
+                          :code-challenge code-challenge
+                          :scope scope
+                          :expires-at (+ (now) oauth/code-ttl-ms)})
+    (response/redirect (oauth/redirect-with redirect-uri {:code code :state state :iss (:base-url config)})
+                       :see-other)))
+
+(defn- authorize-post-handler
+  "The consent form. The CSRF token (kept in the session when the form was shown) is what makes
+  it the user's own click, not another site posting for them."
+  [config ds]
+  (fn [{:keys [form-params session] :as req}]
+    (let [user (auth-mw/current-user req)]
+      (cond
+        (nil? user) (error-page 401 "You are signed out. Start the connection again from your MCP client.")
+        (not (auth/state-matches? (:oauth-csrf session) (param form-params "csrf")))
+        (error-page 400 "This form expired. Start the connection again from your MCP client.")
+        :else
+        (let [result (validate-authorization config ds form-params)]
+          (-> (cond
+                (:page-error result) (error-page 400 (:page-error result))
+                (:error result) (redirect-error config result)
+                (= "approve" (param form-params "decision")) (approve config ds (:request result) user)
+                :else (redirect-error config {:redirect-uri (get-in result [:request :redirect-uri])
+                                              :state (get-in result [:request :state])
+                                              :error "access_denied"
+                                              :description "the user denied the request"}))
+              (assoc :session (dissoc session :oauth-csrf))))))))
+
+;; --- token endpoint ---
+
+(defn- token-error [error description]
+  (json 400 {:error error :error_description description}))
+
+(defn- new-tokens
+  "A fresh access and refresh token: [the grant's new columns, the token response]."
+  [t scope]
+  (let [access (oauth/random-token)
+        refresh (oauth/random-token)]
+    [{:access-hash (oauth/hash-token access)
+      :access-expires-at (+ t oauth/access-ttl-ms)
+      :refresh-hash (oauth/hash-token refresh)
+      :refresh-expires-at (+ t oauth/refresh-ttl-ms)}
+     {:access_token access
+      :token_type "Bearer"
+      :expires_in (quot oauth/access-ttl-ms 1000)
+      :refresh_token refresh
+      :scope scope}]))
+
+(defn- code-grant [ds form]
+  (let [t (now)
+        [code verifier redirect-uri client-id] (map #(param form %) ["code" "code_verifier" "redirect_uri" "client_id"])]
+    (cond
+      (some str/blank? [code verifier redirect-uri client-id])
+      (token-error "invalid_request" "code, code_verifier, redirect_uri and client_id are required")
+      (nil? (db/find-client @ds client-id)) (token-error "invalid_client" "unknown client_id")
+      :else
+      ;; A code is used up by the first attempt, right or wrong, so it can't be guessed at.
+      (let [row (db/take-code! @ds (oauth/hash-token code))]
+        (if (and row
+                 (= client-id (:client-id row))
+                 (= redirect-uri (:redirect-uri row))
+                 (< t (:expires-at row))
+                 (oauth/pkce-valid? (:code-challenge row) verifier))
+          (let [[columns body] (new-tokens t (:scope row))]
+            (db/insert-grant! @ds (assoc columns
+                                         :client-id client-id :user-id (:user-id row) :login (:login row)
+                                         :scope (:scope row) :created-at t))
+            (json 200 body))
+          (token-error "invalid_grant" "the code is invalid, expired, or was already used"))))))
+
+(defn- refresh-grant [ds form]
+  (let [t (now)
+        refresh (param form "refresh_token")
+        client-id (param form "client_id")]
+    (if (or (str/blank? refresh) (str/blank? client-id))
+      (token-error "invalid_request" "refresh_token and client_id are required")
+      (let [old-hash (oauth/hash-token refresh)
+            grant (db/find-grant-by-refresh @ds old-hash)
+            invalid (token-error "invalid_grant" "the refresh token is invalid or expired")]
+        (cond
+          (or (nil? grant) (not= client-id (:client-id grant))) invalid
+          (>= t (:refresh-expires-at grant)) (do (db/delete-grant! @ds (:id grant)) invalid)
+          :else
+          ;; The old refresh token stops working with this: a token is good for one refresh.
+          (let [[columns body] (new-tokens t (:scope grant))]
+            (if (db/rotate-grant! @ds (:id grant) old-hash columns)
+              (json 200 body)
+              invalid)))))))
+
+(defn- token-handler [ds]
+  (fn [{:keys [form-params]}]
+    (case (param form-params "grant_type")
+      "authorization_code" (code-grant ds form-params)
+      "refresh_token" (refresh-grant ds form-params)
+      (token-error "unsupported_grant_type" "grant_type must be authorization_code or refresh_token"))))
+
+(defn routes
+  "`ds` is a delay of the datasource (see tbd.oauth.db/open), so the database isn't touched until needed."
+  [config ds]
+  (let [guarded #(only-when-configured config %)]
+    ["" {:no-doc true
+         ;; ^:replace: not the API's muuntaja/coercion chain (see the namespace docstring); just
+         ;; the query and form parameters.
+         :middleware ^:replace [parameters/parameters-middleware]}
+     ["/.well-known/oauth-protected-resource"
+      {:get {:handler (guarded (metadata-handler oauth/protected-resource-metadata config))}}]
+     ;; RFC 9728 puts the resource's path after the well-known prefix; clients try this one first.
+     ["/.well-known/oauth-protected-resource/mcp"
+      {:get {:handler (guarded (metadata-handler oauth/protected-resource-metadata config))}}]
+     ["/.well-known/oauth-authorization-server"
+      {:get {:handler (guarded (metadata-handler oauth/authorization-server-metadata config))}}]
+     ["/oauth/register" {:post {:handler (guarded (register-handler ds))}}]
+     ["/oauth/authorize" {:get {:handler (guarded (authorize-get-handler config ds))}
+                          :post {:handler (guarded (authorize-post-handler config ds))}}]
+     ["/oauth/token" {:post {:handler (guarded (token-handler ds))}}]]))

src/tbd/todo/routes.clj

@@ -1,7 +1,8 @@
 (ns tbd.todo.routes
   (:require [tbd.http :refer [respond]]
             [tbd.todo.core :as todo]
-            [tbd.todo.db :as db]))
+            [tbd.todo.db :as db]
+            [tbd.todo.schema :as schema]))
 
 (def ^:private not-found (respond 404 {:error "todo not found"}))
 
@@ -45,26 +46,23 @@
       not-found)))
 
 (defn routes
-  "`db-path` is opened (and migrated) on the first request, not when the app loads."
-  [{:keys [db-path]}]
-  (let [ds (delay (db/open db-path))
-        id-param {:path [:map [:id {:description "Todo id"} :int]]}]
+  "`ds` is a delay of the todo database (see tbd.todo.db/open), shared with the MCP tools."
+  [ds]
+  (let [id-param {:path schema/IdParam}]
     ["/api/todos"
      {:tags ["todo"] :login? true}
      [""
       {:get {:summary "List your todos (login required)"
              :handler (list-handler ds)}
        :post {:summary (format "Create a todo; the title is trimmed, non-blank, at most %d characters" todo/max-title-length)
-              :parameters {:body [:map [:title :string]]}
+              :parameters {:body schema/NewTodo}
               :handler (create-handler ds)}}]
      ["/:id"
       {:get {:summary "One of your todos (404 if it isn't yours)"
              :parameters id-param
              :handler (get-handler ds)}
        :patch {:summary "Change the title and/or done flag of one of your todos"
-               :parameters (assoc id-param :body [:map
-                                                  [:title {:optional true} :string]
-                                                  [:done {:optional true} :boolean]])
+               :parameters (assoc id-param :body schema/Changes)
                :handler (patch-handler ds)}
        :delete {:summary "Delete one of your todos"
                 :parameters id-param

src/tbd/todo/schema.clj

@@ -0,0 +1,28 @@
+(ns tbd.todo.schema
+  "The shapes of the todo group's input, as Malli schemas. This is the one definition of them:
+  the HTTP routes coerce and validate requests with it (tbd.todo.routes), and the MCP tools
+  derive their input schema and validate their arguments from it (tbd.mcp.tools). They describe
+  shape only (types, which keys may be missing); the rules on values (trimming, blank or too long
+  titles, an empty change) stay in tbd.todo.core, which both callers go through."
+  (:require [malli.util :as mu]
+            [tbd.todo.core :as todo]))
+
+(def Id [:int {:description "Todo id"}])
+
+(def Title
+  [:string {:description (format "What needs doing; trimmed, non-blank, at most %d characters"
+                                 todo/max-title-length)}])
+
+(def Done [:boolean {:description "Whether it is done"}])
+
+(def IdParam [:map [:id Id]])
+
+(def NewTodo [:map [:title Title]])
+
+(def Changes
+  "What may be changed on a todo; at least one of them has to be given (a rule, see tbd.todo.core)."
+  [:map
+   [:title {:optional true} Title]
+   [:done {:optional true} Done]])
+
+(def UpdateTodo (mu/merge IdParam Changes))

test/tbd/auth/core_test.clj

@@ -60,6 +60,13 @@
     (is (not (auth/state-matches? "abc" nil)))
     (is (not (auth/state-matches? nil "abc")))))
 
+(deftest safe-return-to-test
+  (doseq [ok ["/" "/oauth/authorize?client_id=a&state=b%2Fc" "/a/b#frag"]]
+    (is (= ok (auth/safe-return-to ok)) ok))
+  (doseq [bad [nil 42 "" "oauth/authorize" "//evil.example.com" "/\\evil.example.com" "/\\/evil.example.com"
+               "https://evil.example.com" "javascript:alert(1)" "/a b" "/a\nb" (str "/" (apply str (repeat 2000 "a")))]]
+    (is (nil? (auth/safe-return-to bad)) (pr-str bad))))
+
 (deftest authorize-url-test
   (let [url (auth/authorize-url (auth/env-config full-env) "st ate")]
     (is (str/starts-with? url "https://git.example.com/login/oauth/authorize?"))

test/tbd/auth/routes_test.clj

@@ -15,10 +15,12 @@
        (str/ends-with? url "/api/v1/user") {:status 200 :body (format "{\"login\":\"%s\",\"id\":%d}" login id)}))))
 
 (defn make-app
-  "The app against a Gitea stub. `:todo` (a todo config) is passed through; other overrides go into the auth config."
-  [http & {:keys [todo] :as overrides}]
+  "The app against a Gitea stub. `:todo` and `:oauth` (their configs) are passed through; other overrides go into the auth config."
+  [http & {:keys [todo oauth] :as overrides}]
   (core/make-app {:todo todo
-                  :auth (merge {:gitea-url "https://gitea.test"
+                  :oauth oauth
+                  :auth (merge {:base-url "http://tbd.test"
+                                :gitea-url "https://gitea.test"
                                 :client-id "cid"
                                 :client-secret "sec"
                                 :redirect-uri "http://tbd.test/auth/callback"
@@ -26,7 +28,7 @@
                                 :session-secret "test-secret"
                                 :secure-cookies? false
                                 :http http}
-                               (dissoc overrides :todo))
+                               (dissoc overrides :todo :oauth))
                   :nrepl {:port 0 :bind "127.0.0.1"}}))
 
 (defn request [app method uri & {:keys [cookie query]}]
@@ -66,6 +68,20 @@
       (is (re-find #"(?i)SameSite=Lax" cookie))
       (is (not (re-find #"(?i);\s*Secure" cookie)) "http base URL, so no Secure flag"))))
 
+(deftest return-to-test
+  (let [login-then-callback (fn [return-to]
+                              (let [app (make-app (gitea-stub "alice"))
+                                    start (request app :get "/auth/login" :query (when return-to (str "return_to=" return-to)))]
+                                (request app :get "/auth/callback" :cookie (set-cookie start)
+                                         :query (str "code=abc&state=" (location-state start)))))]
+    (testing "after logging in the browser goes back to where it came from"
+      (is (= "/oauth/authorize?a=b" (get-in (login-then-callback "%2Foauth%2Fauthorize%3Fa%3Db") [:headers "Location"]))))
+    (testing "and to / without a return_to"
+      (is (= "/" (get-in (login-then-callback nil) [:headers "Location"]))))
+    (testing "but never to another site"
+      (doseq [bad ["https%3A%2F%2Fevil.example.com" "%2F%2Fevil.example.com" "%2F%5Cevil.example.com" "javascript%3Aalert(1)"]]
+        (is (= "/" (get-in (login-then-callback bad) [:headers "Location"])) bad)))))
+
 (deftest secure-cookie-test
   (let [resp (request (make-app (gitea-stub "alice") :secure-cookies? true) :get "/auth/login")
         cookie (first (let [h (get-in resp [:headers "Set-Cookie"])] (if (string? h) [h] h)))]

test/tbd/mcp/routes_test.clj

@@ -0,0 +1,263 @@
+(ns tbd.mcp.routes-test
+  (:require [clojure.test :refer [deftest is testing]]
+            [muuntaja.core :as m]
+            [tbd.todo.schema :as todo-schema]
+            [malli.core :as malli]
+            [tbd.oauth.core :as oauth]
+            [tbd.oauth.db :as db]
+            [tbd.oauth.db-test :as db-test]
+            [tbd.oauth.routes-test :as o]
+            [tbd.auth.routes-test :as t])
+  (:import (java.io ByteArrayInputStream)))
+
+;; The MCP handler sits behind its own transport, so these go through the real app (tbd.core)
+;; and speak JSON-RPC to /mcp the way an MCP client does, with an OAuth access token.
+
+(defn- mint-token!
+  "Puts a grant for `login` into the database at `path` and returns its access token, for
+  tests that aren't about how a client gets one (that is tbd.oauth.routes-test)."
+  [path login id & {:keys [expires-at] :or {expires-at (+ (System/currentTimeMillis) 60000)}}]
+  (let [token (oauth/random-token)]
+    (db/insert-grant! (db/open path) {:client-id "test-client" :user-id id :login login :scope "mcp"
+                                      :access-hash (oauth/hash-token token) :access-expires-at expires-at
+                                      :refresh-hash (oauth/hash-token (oauth/random-token))
+                                      :refresh-expires-at expires-at :created-at 1})
+    token))
+
+(defn- rpc
+  "POST a JSON-RPC message (as data) to /mcp with `token` as the bearer token, optionally within
+  the MCP session `sid`. Returns the response with its JSON body decoded (nil when there is none)."
+  ([app token message] (rpc app token message nil))
+  ([app token message sid]
+   (let [body (m/encode "application/json" message)
+         resp (app {:request-method :post :uri "/mcp"
+                    :scheme :http :server-name "localhost" :server-port 3000
+                    :headers (cond-> {"content-type" "application/json"
+                                      "accept" "application/json, text/event-stream"}
+                               token (assoc "authorization" (str "Bearer " token))
+                               sid (assoc "mcp-session-id" sid))
+                    :body (ByteArrayInputStream. (.readAllBytes ^java.io.InputStream body))})]
+     (cond-> resp
+       (string? (:body resp)) (update :body #(m/decode "application/json" %))))))
+
+(defn- initialize
+  "Runs the MCP handshake; returns the session id."
+  [app token]
+  (let [resp (rpc app token {:jsonrpc "2.0" :id 1 :method "initialize"
+                             :params {:protocolVersion "2025-06-18" :capabilities {}
+                                      :clientInfo {:name "test" :version "1"}}})
+        sid (get-in resp [:headers "Mcp-Session-Id"])]
+    (is (= 200 (:status resp)))
+    (is (= {:name "tbd" :version "1.0.0"} (select-keys (get-in resp [:body :result :serverInfo]) [:name :version])))
+    (is (some? sid) "the server opens a session")
+    (is (= 202 (:status (rpc app token {:jsonrpc "2.0" :method "notifications/initialized"} sid))))
+    sid))
+
+(defn- call-tool [app token sid tool arguments]
+  (:body (rpc app token {:jsonrpc "2.0" :id 2 :method "tools/call"
+                         :params {:name tool :arguments arguments}}
+              sid)))
+
+(defn- text [result] (get-in result [:result :content 0 :text]))
+
+(defn- fixture
+  "An app on a fresh database, with the tokens of an admin (alice) and a regular user (bob)."
+  []
+  (let [path (db-test/temp-db-path)]
+    {:path path
+     :app (t/make-app (t/gitea-stub "alice" 7) :oauth {:db-path path} :todo {:db-path (db-test/temp-db-path)})
+     :alice (mint-token! path "alice" 7)
+     :bob (mint-token! path "bob" 8)}))
+
+(deftest list-tools-test
+  (let [{:keys [app alice]} (fixture)
+        sid (initialize app alice)
+        tools (get-in (rpc app alice {:jsonrpc "2.0" :id 2 :method "tools/list"} sid) [:body :result :tools])]
+    (is (= ["add" "create_todo" "delete_todo" "get_todo" "list_todos" "ping" "update_todo" "whoami"]
+           (sort (map :name tools))))
+    (let [input-schema (fn [tool] (:inputSchema (first (filter #(= tool (:name %)) tools))))]
+      (testing "a tool's input schema is generated from the Malli schema the HTTP API also uses"
+        (let [add (input-schema "add")]
+          (is (= ["x" "y"] (:required add)))
+          (is (= {:x "First addend" :y "Second addend"}
+                 (update-vals (:properties add) :description)))
+          (is (= ["number" "number"] (map :type (vals (:properties add))))))
+        (is (= {:type "object" :required ["id"] :properties {:id {:type "integer" :description "Todo id"}}}
+               (input-schema "get_todo")))
+        (is (= ["id"] (:required (input-schema "update_todo"))) "title and done are optional")
+        (is (= #{"id" "title" "done"} (set (map name (keys (:properties (input-schema "update_todo"))))))))
+      (testing "and ones with no arguments say so"
+        (is (= {:type "object" :properties {}} (input-schema "list_todos")))))))
+
+(deftest call-tool-test
+  (let [{:keys [app alice]} (fixture)
+        sid (initialize app alice)]
+    (testing "ping"
+      (is (= {:content [{:type "text" :text "pong"}] :isError false}
+             (:result (call-tool app alice sid "ping" {})))))
+    (testing "add goes through tbd.math.core"
+      (is (= {:content [{:type "text" :text "5"}] :isError false}
+             (:result (call-tool app alice sid "add" {:x 2 :y 3}))))
+      (is (= "3.5" (text (call-tool app alice sid "add" {:x 1.5 :y 2})))))
+    (testing "missing arguments are a tool error the model can read, not a failed request"
+      (let [result (:result (call-tool app alice sid "add" {:x 2}))]
+        (is (true? (:isError result)))
+        (is (re-find #"Missing tool param" (get-in result [:content 0 :text])))))
+    (testing "an unknown tool is a JSON-RPC error"
+      (is (contains? (call-tool app alice sid "nope" {}) :error)))))
+
+(deftest whoami-test
+  (let [{:keys [app alice bob]} (fixture)]
+    (testing "tools know which user the token belongs to, and whether they are an admin"
+      (is (= "alice (Gitea user 7), admin" (text (call-tool app alice (initialize app alice) "whoami" {}))))
+      (is (= "bob (Gitea user 8)" (text (call-tool app bob (initialize app bob) "whoami" {})))))))
+
+(deftest authentication-test
+  (let [{:keys [path app alice]} (fixture)
+        metadata "resource_metadata=\"http://tbd.test/.well-known/oauth-protected-resource/mcp\""
+        initialize-message {:jsonrpc "2.0" :id 1 :method "initialize"
+                            :params {:protocolVersion "2025-06-18" :capabilities {}
+                                     :clientInfo {:name "test" :version "1"}}}]
+    (testing "no token: 401 pointing the client at the OAuth metadata (that is how it finds where to log in)"
+      (let [resp (rpc app nil initialize-message)
+            challenge (get-in resp [:headers "WWW-Authenticate"])]
+        (is (= 401 (:status resp)))
+        (is (.startsWith ^String challenge "Bearer "))
+        (is (.contains ^String challenge metadata))
+        (is (not (.contains ^String challenge "error=")) "no token isn't an invalid one")
+        (is (nil? (get-in resp [:headers "Mcp-Session-Id"])) "no session is opened")))
+    (testing "the wrong kind of credentials"
+      (doseq [authorization ["Basic YWxpY2U6cHc=" "Bearer" "Bearer " alice "bearer"]]
+        (let [resp ((:app (fixture)) {:request-method :post :uri "/mcp"
+                                      :headers {"authorization" authorization}
+                                      :body (ByteArrayInputStream. (.getBytes "{}"))})]
+          (is (= 401 (:status resp)) authorization))))
+    (testing "an unknown token: 401 saying so"
+      (let [resp (rpc app "not-a-token" initialize-message)
+            challenge (get-in resp [:headers "WWW-Authenticate"])]
+        (is (= 401 (:status resp)))
+        (is (.contains ^String challenge "error=\"invalid_token\""))
+        (is (.contains ^String challenge metadata))))
+    (testing "a refresh token or a stored hash isn't an access token"
+      (let [{:keys [tokens]} (o/get-tokens! app)]
+        (is (= 401 (:status (rpc app (:refresh_token tokens) initialize-message))))
+        (is (= 401 (:status (rpc app (oauth/hash-token alice) initialize-message))))))
+    (testing "an expired token"
+      (is (= 401 (:status (rpc app (mint-token! path "alice" 7 :expires-at (- (System/currentTimeMillis) 1000))
+                               initialize-message)))))
+    (testing "the token is checked on every request, not only when the session is opened"
+      (let [sid (initialize app alice)]
+        (is (= 401 (:status (rpc app nil {:jsonrpc "2.0" :id 2 :method "tools/list"} sid))))
+        (is (= 401 (:status (rpc app "not-a-token" {:jsonrpc "2.0" :id 2 :method "tools/list"} sid))))
+        (is (= 401 (:status (app {:request-method :delete :uri "/mcp" :headers {"mcp-session-id" sid}}))))
+        (is (= 200 (:status (rpc app alice {:jsonrpc "2.0" :id 2 :method "tools/list"} sid))))))
+    (testing "and the body isn't read for a caller who isn't allowed in"
+      (let [resp (app {:request-method :post :uri "/mcp" :headers {}
+                       :body (proxy [java.io.InputStream] [] (read ([] (throw (ex-info "body was read" {})))))})]
+        (is (= 401 (:status resp)))))))
+
+(deftest admin-follows-the-allowlist-test
+  (let [path (db-test/temp-db-path)
+        token (mint-token! path "alice" 7)
+        app-with (fn [admins] (t/make-app (t/gitea-stub "alice") :oauth {:db-path path} :admin-users admins))]
+    (is (= "alice (Gitea user 7), admin" (text (call-tool (app-with #{"alice"}) token (initialize (app-with #{"alice"}) token) "whoami" {}))))
+    (testing "it is decided per request, not when the token was issued"
+      (let [app (app-with #{})]
+        (is (= "alice (Gitea user 7)" (text (call-tool app token (initialize app token) "whoami" {}))))))))
+
+(deftest unconfigured-test
+  (let [app (t/make-app (t/gitea-stub "alice") :oauth {:db-path (db-test/temp-db-path)} :gitea-url nil)
+        resp (rpc app "anything" {:jsonrpc "2.0" :id 1 :method "initialize"})]
+    (is (= 503 (:status resp)) "with no login there is no way to get a token, so /mcp isn't open instead")))
+
+(deftest end-to-end-test
+  (testing "a client that does the whole OAuth dance ends up as the user who approved it"
+    (let [app (o/app-for (db-test/temp-db-path) "carol" 9)
+          {:keys [client-id tokens]} (o/get-tokens! app)
+          whoami (fn [access-token] (text (call-tool app access-token (initialize app access-token) "whoami" {})))]
+      (is (= "carol (Gitea user 9)" (whoami (:access_token tokens))))
+      (testing "and after a refresh, when the first token no longer works"
+        (let [refreshed (:body (o/call app :post "/oauth/token"
+                                       :form {"grant_type" "refresh_token" "refresh_token" (:refresh_token tokens)
+                                              "client_id" client-id}))]
+          (is (= "carol (Gitea user 9)" (whoami (:access_token refreshed))))
+          (is (= 401 (:status (rpc app (:access_token tokens) {:jsonrpc "2.0" :id 1 :method "initialize"})))))))))
+
+(deftest session-required-test
+  (testing "tools can't be used before the handshake opens a session"
+    (let [{:keys [app alice]} (fixture)
+          resp (rpc app alice {:jsonrpc "2.0" :id 2 :method "tools/list"})]
+      (is (<= 400 (:status resp) 499)))))
+
+(deftest no-server-stream-test
+  (testing "GET /mcp (the optional server-to-client SSE stream) is a 405, which MCP clients accept"
+    (let [{:keys [app alice]} (fixture)
+          resp (app {:request-method :get :uri "/mcp"
+                     :headers {"accept" "text/event-stream" "authorization" (str "Bearer " alice)}})]
+      (is (= 405 (:status resp))))))
+
+(deftest close-session-test
+  (let [{:keys [app alice]} (fixture)
+        sid (initialize app alice)]
+    (is (= 202 (:status (app {:request-method :delete :uri "/mcp"
+                              :headers {"mcp-session-id" sid "authorization" (str "Bearer " alice)}}))))
+    (testing "a closed session is gone"
+      (is (= 404 (:status (rpc app alice {:jsonrpc "2.0" :id 2 :method "tools/list"} sid)))))))
+
+(deftest api-unaffected-test
+  (testing "the MCP route doesn't disturb the rest of the API (which it shares a router with)"
+    (let [{:keys [app]} (fixture)]
+      (is (= 200 (:status (app {:request-method :get :uri "/api/ping"}))))
+      (is (= 200 (:status (app {:request-method :get :uri "/api/add" :query-string "x=2&y=3"})))))))
+
+(deftest todo-tools-test
+  (let [{:keys [app alice bob]} (fixture)
+        alice-sid (initialize app alice)
+        bob-sid (initialize app bob)
+        call (fn [token sid tool arguments] (call-tool app token sid tool arguments))
+        as-alice (partial call alice alice-sid)
+        as-bob (partial call bob bob-sid)
+        result (fn [resp] (:result resp))
+        data (fn [resp] (m/decode "application/json" (text resp)))
+        error (fn [resp] (when (true? (get-in resp [:result :isError])) (text resp)))]
+    (testing "no todos yet"
+      (is (= [] (data (as-alice "list_todos" {})))))
+    (let [created (data (as-alice "create_todo" {:title "  write tests "}))
+          id (:id created)]
+      (testing "create trims the title, as the API does, and returns the todo"
+        (is (= {:title "write tests" :done false :owner-id 7} (select-keys created [:title :done :owner-id])))
+        (is (integer? id)))
+      (testing "get and list"
+        (is (= created (data (as-alice "get_todo" {:id id}))))
+        (is (= [created] (data (as-alice "list_todos" {})))))
+      (testing "update changes the title and/or done"
+        (is (= {:title "write tests" :done true} (select-keys (data (as-alice "update_todo" {:id id :done true})) [:title :done])))
+        (is (= {:title "ship it" :done true} (select-keys (data (as-alice "update_todo" {:id id :title "ship it"})) [:title :done]))))
+      (testing "todos are private to their owner, and someone else's is reported as missing"
+        (is (= [] (data (as-bob "list_todos" {}))))
+        (doseq [[tool args] [["get_todo" {:id id}] ["update_todo" {:id id :done false}] ["delete_todo" {:id id}]]]
+          (is (= "todo not found" (error (as-bob tool args))) tool))
+        (is (= "ship it" (:title (data (as-alice "get_todo" {:id id})))) "and bob's attempts changed nothing"))
+      (testing "the rules of tbd.todo.core apply here too"
+        (is (= "title must not be blank" (error (as-alice "create_todo" {:title "   "}))))
+        (is (= "nothing to change: give a title and/or done" (error (as-alice "update_todo" {:id id})))))
+      (testing "delete"
+        (is (= "deleted" (text (as-alice "delete_todo" {:id id}))))
+        (is (= "todo not found" (error (as-alice "get_todo" {:id id}))))
+        (is (= [] (data (as-alice "list_todos" {}))))))))
+
+(deftest tool-arguments-are-validated-test
+  (let [{:keys [app alice]} (fixture)
+        sid (initialize app alice)
+        error (fn [tool arguments]
+                (let [resp (call-tool app alice sid tool arguments)]
+                  (is (true? (get-in resp [:result :isError])) (str tool " " (pr-str arguments)))
+                  (text resp)))]
+    (testing "arguments of the wrong type are turned away, which plumcp alone doesn't do"
+      (is (= "invalid arguments: {:id [\"should be an integer\"]}" (error "get_todo" {:id "abc"})))
+      (is (= "invalid arguments: {:title [\"should be a string\"]}" (error "create_todo" {:title 5})))
+      (is (= "invalid arguments: {:done [\"should be a boolean\"]}" (error "update_todo" {:id 1 :done "yes"})))
+      (is (= "invalid arguments: {:x [\"should be an integer\" \"should be a double\"]}" (error "add" {:x "2" :y 3}))))
+    (testing "the tools and the HTTP API validate against the same schemas"
+      (is (false? (malli/validate todo-schema/UpdateTodo {:id 1 :done "yes"})))
+      (is (true? (malli/validate todo-schema/UpdateTodo {:id 1 :done true}))))))

test/tbd/oauth/core_test.clj

@@ -0,0 +1,101 @@
+(ns tbd.oauth.core-test
+  (:require [clojure.string :as str]
+            [clojure.test :refer [deftest is testing]]
+            [tbd.oauth.core :as oauth]))
+
+(deftest metadata-test
+  (let [base "https://tbd.example.com"]
+    (is (= {:resource "https://tbd.example.com/mcp"
+            :authorization_servers [base]}
+           (select-keys (oauth/protected-resource-metadata base) [:resource :authorization_servers])))
+    (let [m (oauth/authorization-server-metadata base)]
+      (is (= base (:issuer m)))
+      (is (= "https://tbd.example.com/oauth/authorize" (:authorization_endpoint m)))
+      (is (= "https://tbd.example.com/oauth/token" (:token_endpoint m)))
+      (is (= "https://tbd.example.com/oauth/register" (:registration_endpoint m)))
+      (is (= ["S256"] (:code_challenge_methods_supported m)) "PKCE is mandatory, and only S256")
+      (is (= ["none"] (:token_endpoint_auth_methods_supported m)) "public clients only"))))
+
+(deftest token-test
+  (let [a (oauth/random-token)]
+    (is (re-matches #"[A-Za-z0-9_-]{43}" a))
+    (is (not= a (oauth/random-token))))
+  (testing "stored form is a stable, different hex digest"
+    (is (= (oauth/hash-token "abc") (oauth/hash-token "abc")))
+    (is (re-matches #"[0-9a-f]{64}" (oauth/hash-token "abc")))
+    (is (not= "abc" (oauth/hash-token "abc")))
+    (is (not= (oauth/hash-token "abc") (oauth/hash-token "abd")))))
+
+(deftest pkce-test
+  ;; The example from RFC 7636 appendix B.
+  (let [verifier "dBjftJeZ4CVP-mB92K27uhbUJU1p1r_wW1gFWFOEjXk"
+        challenge "E9Melhoa2OwvFrEMTJguCHaoeK1t8URWbuGJSstw-cM"]
+    (is (= challenge (oauth/pkce-challenge verifier)))
+    (is (oauth/pkce-valid? challenge verifier))
+    (testing "a different verifier, or none, fails"
+      (is (not (oauth/pkce-valid? challenge (str/replace verifier "d" "e"))))
+      (is (not (oauth/pkce-valid? challenge nil))))
+    (testing "the challenge itself is not a verifier, and a too-short verifier is refused"
+      (is (not (oauth/pkce-valid? challenge challenge)))
+      (is (not (oauth/pkce-valid? (oauth/pkce-challenge "short") "short"))))
+    (is (oauth/challenge-format? challenge))
+    (is (not (oauth/challenge-format? "too-short")))
+    (is (not (oauth/challenge-format? nil)))))
+
+(deftest valid-redirect-uri-test
+  (doseq [ok ["https://client.example.com/callback"
+              "http://localhost:8080/callback"
+              "http://127.0.0.1/cb"
+              "http://[::1]:9000/cb"
+              "cursor://anysphere.cursor-retrieval/oauth/callback"]]
+    (is (oauth/valid-redirect-uri? ok) ok))
+  (doseq [bad ["http://client.example.com/callback"  ; plain http off the local machine
+               "http://localhost.evil.com/cb"
+               "javascript:alert(1)"
+               "data:text/html,hi"
+               "file:///etc/passwd"
+               "https://client.example.com/cb#frag"
+               "https://user:pw@client.example.com/cb"
+               "https:///nohost"
+               "/relative/path"
+               "not a uri"
+               ""
+               nil
+               42
+               (str "https://client.example.com/" (apply str (repeat 2100 "a")))]]
+    (is (not (oauth/valid-redirect-uri? bad)) (pr-str bad))))
+
+(deftest redirect-uri-matches-test
+  (is (oauth/redirect-uri-matches? "https://c.example.com/cb" "https://c.example.com/cb"))
+  (is (not (oauth/redirect-uri-matches? "https://c.example.com/cb" "https://c.example.com/cb2")))
+  (is (not (oauth/redirect-uri-matches? "https://c.example.com/cb" "https://c.example.com/cb/")))
+  (is (not (oauth/redirect-uri-matches? "https://c.example.com/cb" "https://c.example.com/cb?x=1")))
+  (is (not (oauth/redirect-uri-matches? "https://c.example.com/cb" nil)))
+  (testing "a client on the local machine picks its own port"
+    (is (oauth/redirect-uri-matches? "http://localhost/cb" "http://localhost:53682/cb"))
+    (is (oauth/redirect-uri-matches? "http://127.0.0.1:1/cb" "http://127.0.0.1:2/cb"))
+    (is (not (oauth/redirect-uri-matches? "http://localhost/cb" "http://localhost:53682/other")))
+    (is (not (oauth/redirect-uri-matches? "http://localhost/cb" "http://127.0.0.1:53682/cb")))
+    (is (not (oauth/redirect-uri-matches? "https://c.example.com/cb" "https://c.example.com:8443/cb")) "only loopback")))
+
+(deftest redirect-with-test
+  (is (= "https://c.example.com/cb?code=a+b&state=s"
+         (oauth/redirect-with "https://c.example.com/cb" {:code "a b" :state "s"})))
+  (is (= "https://c.example.com/cb?x=1&code=c"
+         (oauth/redirect-with "https://c.example.com/cb?x=1" {:code "c"})))
+  (is (= "https://c.example.com/cb?code=c" (oauth/redirect-with "https://c.example.com/cb" {:code "c" :state nil}))
+      "absent values are dropped"))
+
+(deftest scope-and-resource-test
+  (is (= "mcp" (oauth/parse-scope nil)))
+  (is (= "mcp" (oauth/parse-scope "")))
+  (is (= "mcp" (oauth/parse-scope " mcp ")))
+  (is (nil? (oauth/parse-scope "mcp admin")))
+  (is (nil? (oauth/parse-scope "admin")))
+  (let [base "https://tbd.example.com"]
+    (is (oauth/resource-ok? base nil) "the parameter is optional")
+    (is (oauth/resource-ok? base "https://tbd.example.com/mcp"))
+    (is (oauth/resource-ok? base "https://tbd.example.com/mcp/"))
+    (is (oauth/resource-ok? base ["https://tbd.example.com/mcp"]))
+    (is (not (oauth/resource-ok? base "https://other.example.com/mcp")))
+    (is (not (oauth/resource-ok? base ["https://tbd.example.com/mcp" "https://other.example.com/mcp"])))))

test/tbd/oauth/db_test.clj

@@ -0,0 +1,90 @@
+(ns tbd.oauth.db-test
+  (:require [clojure.java.io :as io]
+            [clojure.test :refer [deftest is testing]]
+            [tbd.oauth.db :as db])
+  (:import (java.nio.file Files)
+           (java.nio.file.attribute FileAttribute)))
+
+(defn temp-db-path []
+  (str (Files/createTempDirectory "tbd-oauth" (make-array FileAttribute 0)) "/data/oauth.db"))
+
+(defn client [id created-at]
+  {:id id :name "Test client" :redirect-uris ["https://c.example.com/cb" "http://localhost/cb"] :created-at created-at})
+
+(defn grant [n]
+  {:client-id "c1" :user-id 7 :login "alice" :scope "mcp"
+   :access-hash (str "access-" n) :access-expires-at 2000
+   :refresh-hash (str "refresh-" n) :refresh-expires-at 9000
+   :created-at 1000})
+
+(deftest env-config-test
+  (is (= {:db-path "data/oauth.db"} (db/env-config {})))
+  (is (= {:db-path "data/oauth.db"} (db/env-config {"OAUTH_DB_PATH" " "})))
+  (is (= {:db-path "/var/oauth.db"} (db/env-config {"OAUTH_DB_PATH" " /var/oauth.db "}))))
+
+(deftest open-test
+  (testing "creates the file and its directory"
+    (let [path (temp-db-path)]
+      (db/open path)
+      (is (.exists (io/file path)))))
+  (testing "no path is an error, not a database in the working directory"
+    (is (thrown? clojure.lang.ExceptionInfo (db/open nil)))))
+
+(deftest client-test
+  (let [ds (db/open (temp-db-path))]
+    (is (nil? (db/find-client ds "c1")))
+    (db/insert-client! ds (client "c1" 1000))
+    (is (= (client "c1" 1000) (db/find-client ds "c1")) "redirect URIs come back as a vector of strings")))
+
+(deftest code-test
+  (let [ds (db/open (temp-db-path))
+        code {:hash "h1" :client-id "c1" :user-id 7 :login "alice" :redirect-uri "https://c.example.com/cb"
+              :code-challenge "chal" :scope "mcp" :expires-at 5000}]
+    (db/insert-code! ds code)
+    (is (= code (db/take-code! ds "h1")) "the stored row comes back")
+    (testing "a code can be taken once"
+      (is (nil? (db/take-code! ds "h1"))))
+    (is (nil? (db/take-code! ds "unknown")))))
+
+(deftest grant-test
+  (let [ds (db/open (temp-db-path))]
+    (db/insert-grant! ds (grant 1))
+    (testing "found by access token until it expires"
+      (is (= "alice" (:login (db/find-grant-by-access ds "access-1" 1999))))
+      (is (nil? (db/find-grant-by-access ds "access-1" 2000)))
+      (is (nil? (db/find-grant-by-access ds "refresh-1" 1000)) "a refresh token isn't an access token"))
+    (testing "found by refresh token"
+      (is (= 7 (:user-id (db/find-grant-by-refresh ds "refresh-1"))))
+      (is (nil? (db/find-grant-by-refresh ds "access-1"))))
+    (testing "rotating replaces both tokens, and works once per refresh token"
+      (let [id (:id (db/find-grant-by-refresh ds "refresh-1"))
+            fresh {:access-hash "access-2" :access-expires-at 3000 :refresh-hash "refresh-2" :refresh-expires-at 9500}]
+        (is (= "access-2" (:access-hash (db/rotate-grant! ds id "refresh-1" fresh))))
+        (is (nil? (db/find-grant-by-access ds "access-1" 1000)))
+        (is (nil? (db/find-grant-by-refresh ds "refresh-1")))
+        (is (nil? (db/rotate-grant! ds id "refresh-1" (assoc fresh :access-hash "access-3" :refresh-hash "refresh-3")))
+            "the old refresh token can't rotate it again")
+        (is (some? (db/find-grant-by-access ds "access-2" 1000)))))
+    (testing "deleting revokes"
+      (db/delete-grant! ds (:id (db/find-grant-by-refresh ds "refresh-2")))
+      (is (nil? (db/find-grant-by-access ds "access-2" 1000))))))
+
+(deftest prune-test
+  (let [ds (db/open (temp-db-path))
+        code #(hash-map :hash %1 :client-id "used" :user-id 1 :login "a" :redirect-uri "x"
+                        :code-challenge "c" :scope "mcp" :expires-at %2)]
+    (doseq [c [(client "old-unused" 100) (client "new-unused" 900) (client "old-used" 100) (client "old-pending" 100)]]
+      (db/insert-client! ds c))
+    (db/insert-grant! ds (assoc (grant 1) :client-id "old-used"))
+    (db/insert-grant! ds (assoc (grant 2) :client-id "old-used" :refresh-expires-at 900))
+    (db/insert-code! ds (assoc (code "pending" 5000) :client-id "old-pending"))
+    (db/insert-code! ds (code "expired" 500))
+    (db/prune! ds 1000 500)
+    (is (nil? (db/find-client ds "old-unused")) "registered long ago and never approved")
+    (is (some? (db/find-client ds "new-unused")) "recent registrations get time to be used")
+    (is (some? (db/find-client ds "old-used")) "clients with a grant stay")
+    (is (some? (db/find-client ds "old-pending")) "clients with an outstanding code stay")
+    (is (some? (db/find-grant-by-refresh ds "refresh-1")) "a grant that can still be refreshed stays")
+    (is (nil? (db/find-grant-by-refresh ds "refresh-2")) "one that can't is dropped")
+    (is (nil? (db/take-code! ds "expired")))
+    (is (some? (db/take-code! ds "pending")))))

test/tbd/oauth/routes_test.clj

@@ -0,0 +1,379 @@
+(ns tbd.oauth.routes-test
+  (:require [clojure.string :as str]
+            [clojure.test :refer [deftest is testing]]
+            [muuntaja.core :as m]
+            [tbd.auth.core :as auth]
+            [tbd.auth.routes-test :as t]
+            [tbd.oauth.core :as oauth]
+            [tbd.oauth.db :as db]
+            [tbd.oauth.db-test :as db-test]
+            [tbd.test-util :as test-util])
+  (:import (java.io ByteArrayInputStream)
+           (java.net URLDecoder)))
+
+;; These go through the real app with Gitea stubbed out, the way an MCP client and a browser
+;; would: discovery, registration, login + consent in the browser, then the token endpoint.
+
+(def redirect-uri "http://localhost:8123/callback")
+(def verifier "dBjftJeZ4CVP-mB92K27uhbUJU1p1r_wW1gFWFOEjXk")
+(def challenge (oauth/pkce-challenge verifier))
+
+(defn json-str [data] (slurp (m/encode "application/json" data)))
+
+(defn app-for
+  "An app whose OAuth database is `path`; the Gitea user is alice (id 7), an admin, unless told otherwise."
+  ([path] (app-for path "alice" 7))
+  ([path login id] (t/make-app (t/gitea-stub login id) :oauth {:db-path path})))
+
+(defn call
+  "Runs a request through `app`. `:form` (a map) is sent as a urlencoded body, `:body` (a string) as JSON."
+  [app method uri & {:keys [cookie headers body form query]}]
+  (let [payload (or (some-> form auth/form-encode) body)
+        content-type (cond form "application/x-www-form-urlencoded" body "application/json")]
+    (test-util/decode-body
+      (app (cond-> {:request-method method :uri uri :query-string query :headers (or headers {})}
+             cookie (assoc-in [:headers "cookie"] cookie)
+             payload (assoc :body (ByteArrayInputStream. (.getBytes ^String payload "UTF-8")))
+             content-type (assoc-in [:headers "content-type"] content-type))))))
+
+(defn query-params
+  "The query parameters of a response's Location header, decoded."
+  [resp]
+  (let [location (get-in resp [:headers "Location"] "")]
+    (into {} (for [pair (str/split (or (second (str/split location #"\?" 2)) "") #"&")
+                   :when (seq pair)
+                   :let [[k v] (str/split pair #"=" 2)]]
+               [(URLDecoder/decode ^String k "UTF-8") (URLDecoder/decode ^String (or v "") "UTF-8")]))))
+
+(defn register!
+  "Registers a client; returns its client_id."
+  ([app] (register! app {}))
+  ([app metadata]
+   (:client_id (:body (call app :post "/oauth/register"
+                            :body (json-str (merge {:redirect_uris [redirect-uri] :client_name "Test client"} metadata)))))))
+
+(defn authorize-params [client-id & {:as overrides}]
+  (merge {"client_id" client-id "redirect_uri" redirect-uri "response_type" "code"
+          "code_challenge" challenge "code_challenge_method" "S256" "state" "st-1" "scope" "mcp"}
+         overrides))
+
+(defn consent!
+  "Opens the consent page as the logged-in `cookie`; returns {:page :cookie :csrf}."
+  [app cookie params]
+  (let [page (call app :get "/oauth/authorize" :cookie cookie :query (auth/form-encode params))]
+    {:page page
+     :cookie (or (t/set-cookie page) cookie)
+     :csrf (second (re-find #"name=\"csrf\" value=\"([^\"]+)\"" (str (:body page))))}))
+
+(defn decide!
+  "Submits the consent form (`decision` approve or deny); returns the response."
+  [app {:keys [cookie csrf]} params decision]
+  (call app :post "/oauth/authorize" :cookie cookie :form (assoc params "csrf" csrf "decision" decision)))
+
+(defn token!
+  "Exchanges an authorization code (with the right verifier and redirect URI unless overridden)."
+  [app client-id code & {:as overrides}]
+  (call app :post "/oauth/token"
+        :form (merge {"grant_type" "authorization_code" "code" code "client_id" client-id
+                      "redirect_uri" redirect-uri "code_verifier" verifier}
+                     overrides)))
+
+(defn authorize-code!
+  "The whole browser half for a logged-in user: consent page, then Approve. Returns the code."
+  [app cookie client-id]
+  (let [params (authorize-params client-id)
+        resp (decide! app (consent! app cookie params) params "approve")]
+    (get (query-params resp) "code")))
+
+(defn get-tokens!
+  "The whole flow, from an empty database to a token response body. Returns {:client-id :tokens :cookie}."
+  [app]
+  (let [client-id (register! app)
+        cookie (t/login! app)
+        code (authorize-code! app cookie client-id)]
+    {:client-id client-id :cookie cookie :tokens (:body (token! app client-id code))}))
+
+(deftest discovery-test
+  (let [app (app-for (db-test/temp-db-path))]
+    (testing "protected resource metadata, at the root and at the resource's own path"
+      (doseq [uri ["/.well-known/oauth-protected-resource" "/.well-known/oauth-protected-resource/mcp"]]
+        (let [resp (call app :get uri)]
+          (is (= 200 (:status resp)) uri)
+          (is (= {:resource "http://tbd.test/mcp" :authorization_servers ["http://tbd.test"]}
+                 (select-keys (:body resp) [:resource :authorization_servers]))))))
+    (testing "authorization server metadata"
+      (let [resp (call app :get "/.well-known/oauth-authorization-server")]
+        (is (= 200 (:status resp)))
+        (is (= "http://tbd.test" (get-in resp [:body :issuer])))
+        (is (= "http://tbd.test/oauth/register" (get-in resp [:body :registration_endpoint])))))
+    (testing "JSON whatever the Accept header says (the API default is EDN)"
+      (is (= "application/json" (get-in (call app :get "/.well-known/oauth-authorization-server"
+                                              :headers {"accept" "application/edn"})
+                                        [:headers "Content-Type"]))))))
+
+(deftest unconfigured-test
+  (let [path (db-test/temp-db-path)
+        app (t/make-app (t/gitea-stub "alice") :oauth {:db-path path} :gitea-url nil)]
+    (doseq [[method uri] [[:get "/.well-known/oauth-protected-resource"]
+                          [:get "/.well-known/oauth-authorization-server"]
+                          [:post "/oauth/register"]
+                          [:get "/oauth/authorize"]
+                          [:post "/oauth/authorize"]
+                          [:post "/oauth/token"]]]
+      (is (= 503 (:status (call app method uri))) (str method " " uri)))))
+
+(deftest register-test
+  (let [path (db-test/temp-db-path)
+        app (app-for path)]
+    (testing "a client is registered as a public client"
+      (let [resp (call app :post "/oauth/register"
+                       :body (json-str {:redirect_uris [redirect-uri "https://c.example.com/cb"] :client_name "Claude"
+                                        :grant_types ["authorization_code" "refresh_token"] :response_types ["code"]
+                                        :token_endpoint_auth_method "none" :scope "ignored"}))
+            client (:body resp)]
+        (is (= 201 (:status resp)))
+        (is (= "no-store" (get-in resp [:headers "Cache-Control"])))
+        (is (some? (:client_id client)))
+        (is (= "Claude" (:client_name client)))
+        (is (= [redirect-uri "https://c.example.com/cb"] (:redirect_uris client)))
+        (is (= "none" (:token_endpoint_auth_method client)))
+        (is (nil? (:client_secret client)))
+        (is (= "Claude" (:name (db/find-client (db/open path) (:client_id client)))) "and it is stored")))
+    (testing "the name is optional, trimmed and capped"
+      (is (= "Unnamed application" (get-in (call app :post "/oauth/register" :body (json-str {:redirect_uris [redirect-uri]}))
+                                           [:body :client_name])))
+      (is (= 100 (count (get-in (call app :post "/oauth/register"
+                                    :body (json-str {:redirect_uris [redirect-uri] :client_name (apply str (repeat 500 "x"))}))
+                                [:body :client_name])))))
+    (testing "bad registrations are refused with an RFC 7591 error"
+      (doseq [[why body error]
+              [["no body" nil "invalid_client_metadata"]
+               ["not JSON" "nope" "invalid_client_metadata"]
+               ["not an object" "[1]" "invalid_client_metadata"]
+               ["no redirect_uris" (json-str {:client_name "x"}) "invalid_client_metadata"]
+               ["empty redirect_uris" (json-str {:redirect_uris []}) "invalid_client_metadata"]
+               ["redirect_uris of the wrong type" (json-str {:redirect_uris [42]}) "invalid_client_metadata"]
+               ["too many redirect_uris" (json-str {:redirect_uris (repeat 11 redirect-uri)}) "invalid_client_metadata"]
+               ["http off the local machine" (json-str {:redirect_uris ["http://evil.example.com/cb"]}) "invalid_redirect_uri"]
+               ["javascript: URI" (json-str {:redirect_uris ["javascript:alert(1)"]}) "invalid_redirect_uri"]
+               ["one bad URI among good ones" (json-str {:redirect_uris [redirect-uri "http://evil.example.com/cb"]}) "invalid_redirect_uri"]
+               ["a confidential client" (json-str {:redirect_uris [redirect-uri] :token_endpoint_auth_method "client_secret_basic"})
+                "invalid_client_metadata"]
+               ["an unsupported grant type" (json-str {:redirect_uris [redirect-uri] :grant_types ["password"]}) "invalid_client_metadata"]
+               ["an unsupported response type" (json-str {:redirect_uris [redirect-uri] :response_types ["token"]}) "invalid_client_metadata"]
+               ["an oversized body" (json-str {:redirect_uris [redirect-uri] :client_name (apply str (repeat 20000 "x"))})
+                "invalid_client_metadata"]]]
+        (let [resp (call app :post "/oauth/register" :body body)]
+          (is (= 400 (:status resp)) why)
+          (is (= error (get-in resp [:body :error])) why))))))
+
+(deftest authorize-request-errors-test
+  (let [app (app-for (db-test/temp-db-path))
+        client-id (register! app)
+        cookie (t/login! app)
+        open (fn [params] (call app :get "/oauth/authorize" :cookie cookie :query (auth/form-encode params)))]
+    (testing "an unknown client or an unregistered redirect URI is shown to the user, never redirected to"
+      (doseq [params [(authorize-params "nope")
+                      (authorize-params nil)
+                      (authorize-params client-id "redirect_uri" "https://evil.example.com/cb")
+                      (authorize-params client-id "redirect_uri" "http://localhost:8123/other")
+                      (dissoc (authorize-params client-id) "redirect_uri")]]
+        (let [resp (open params)]
+          (is (= 400 (:status resp)) (pr-str params))
+          (is (nil? (get-in resp [:headers "Location"])))
+          (is (str/includes? (get-in resp [:headers "Content-Type"]) "text/html")))))
+    (testing "any other problem goes back to the client's redirect URI, with its state"
+      (doseq [[why params error]
+              [["response_type token" (authorize-params client-id "response_type" "token") "unsupported_response_type"]
+               ["no PKCE" (dissoc (authorize-params client-id) "code_challenge" "code_challenge_method") "invalid_request"]
+               ["plain PKCE" (authorize-params client-id "code_challenge_method" "plain") "invalid_request"]
+               ["a malformed challenge" (authorize-params client-id "code_challenge" "short") "invalid_request"]
+               ["an unknown scope" (authorize-params client-id "scope" "mcp admin") "invalid_scope"]
+               ["another resource" (authorize-params client-id "resource" "https://other.example.com/mcp") "invalid_target"]]]
+        (let [resp (open params)
+              back (query-params resp)]
+          (is (= 303 (:status resp)) why)
+          (is (str/starts-with? (get-in resp [:headers "Location"]) (str redirect-uri "?")) why)
+          (is (= error (get back "error")) why)
+          (is (= "st-1" (get back "state")) why)
+          (is (= "http://tbd.test" (get back "iss")) why))))
+    (testing "a loopback client may use a different port"
+      (is (= 200 (:status (open (authorize-params client-id "redirect_uri" "http://localhost:54321/callback"))))))
+    (testing "the resource parameter is accepted when it is this server"
+      (is (= 200 (:status (open (authorize-params client-id "resource" "http://tbd.test/mcp"))))))
+    (testing "repeated parameters aren't an error, they just don't count"
+      (is (= 400 (:status (call app :get "/oauth/authorize" :cookie cookie
+                                :query (str "client_id=" client-id "&client_id=" client-id))))))))
+
+(deftest login-then-consent-test
+  (let [app (app-for (db-test/temp-db-path))
+        client-id (register! app)
+        query (auth/form-encode (authorize-params client-id))]
+    (testing "a logged-out user is sent to log in first, and back afterwards"
+      (let [resp (call app :get "/oauth/authorize" :query query)
+            login (get-in resp [:headers "Location"])]
+        (is (= 302 (:status resp)))
+        (is (str/starts-with? login "/auth/login?return_to="))
+        (let [start (call app :get "/auth/login" :query (second (str/split login #"\?" 2)))
+              done (call app :get "/auth/callback" :cookie (t/set-cookie start)
+                         :query (str "code=abc&state=" (t/location-state start)))]
+          (is (= (str "/oauth/authorize?" query) (get-in done [:headers "Location"])))
+          (testing "where the consent page is now shown"
+            (let [page (call app :get "/oauth/authorize" :cookie (t/set-cookie done) :query query)]
+              (is (= 200 (:status page)))
+              (is (str/includes? (:body page) "Test client")))))))))
+
+(deftest consent-page-test
+  (let [app (app-for (db-test/temp-db-path))
+        client-id (register! app {:client_name "<script>alert(1)</script>"})
+        {:keys [page csrf]} (consent! app (t/login! app) (authorize-params client-id))]
+    (is (= 200 (:status page)))
+    (testing "shows who, what for and where to, escaping what the client chose"
+      (is (str/includes? (:body page) "&lt;script&gt;alert(1)&lt;/script&gt;"))
+      (is (not (str/includes? (:body page) "<script>")))
+      (is (str/includes? (:body page) "alice"))
+      (is (str/includes? (:body page) redirect-uri)))
+    (testing "carries a CSRF token, and the request it will approve"
+      (is (some? csrf))
+      (doseq [k ["client_id" "redirect_uri" "code_challenge" "state"]]
+        (is (str/includes? (:body page) (str "name=\"" k "\"")) k)))
+    (testing "can't be framed or cached"
+      (is (= "DENY" (get-in page [:headers "X-Frame-Options"])))
+      (is (str/includes? (get-in page [:headers "Content-Security-Policy"]) "frame-ancestors 'none'"))
+      (is (= "no-store" (get-in page [:headers "Cache-Control"]))))))
+
+(deftest consent-decision-test
+  (let [app (app-for (db-test/temp-db-path))
+        client-id (register! app)
+        params (authorize-params client-id)
+        cookie (t/login! app)]
+    (testing "approving redirects to the client with a code, the client's state, and the issuer"
+      (let [resp (decide! app (consent! app cookie params) params "approve")
+            back (query-params resp)]
+        (is (= 303 (:status resp)))
+        (is (str/starts-with? (get-in resp [:headers "Location"]) (str redirect-uri "?")))
+        (is (re-matches #"[A-Za-z0-9_-]{43}" (get back "code")))
+        (is (= "st-1" (get back "state")))
+        (is (= "http://tbd.test" (get back "iss")))))
+    (testing "denying redirects with access_denied and no code"
+      (let [back (query-params (decide! app (consent! app cookie params) params "deny"))]
+        (is (= "access_denied" (get back "error")))
+        (is (= "st-1" (get back "state")))
+        (is (nil? (get back "code")))))
+    (testing "anything but approve is a denial"
+      (is (= "access_denied" (get (query-params (decide! app (consent! app cookie params) params "whatever")) "error"))))
+    (testing "without the CSRF token, or with someone else's, nothing is approved"
+      (let [consent (consent! app cookie params)]
+        (doseq [csrf [nil "" "wrong"]]
+          (let [resp (decide! app (assoc consent :csrf csrf) params "approve")]
+            (is (= 400 (:status resp)) (pr-str csrf))
+            (is (nil? (get-in resp [:headers "Location"])))))
+        (testing "or when the form comes from a session that never saw the consent page"
+          (is (= 400 (:status (decide! app (assoc consent :cookie cookie) params "approve")))))))
+    (testing "logged out, the form does nothing"
+      (let [consent (consent! app cookie params)
+            resp (decide! app (assoc consent :cookie nil) params "approve")]
+        (is (= 401 (:status resp)))
+        (is (nil? (get-in resp [:headers "Location"])))))
+    (testing "the request is checked again: it can't be swapped for another after the page was shown"
+      (let [consent (consent! app cookie params)
+            resp (decide! app consent (assoc params "redirect_uri" "https://evil.example.com/cb") "approve")]
+        (is (= 400 (:status resp)))
+        (is (nil? (get-in resp [:headers "Location"])))))))
+
+(deftest code-exchange-test
+  (let [path (db-test/temp-db-path)
+        app (app-for path)
+        client-id (register! app)
+        other-client-id (register! app)
+        cookie (t/login! app)
+        fresh-code #(authorize-code! app cookie client-id)]
+    (testing "a good exchange returns tokens for the user who approved"
+      (let [resp (token! app client-id (fresh-code))
+            {:keys [access_token refresh_token token_type expires_in scope]} (:body resp)]
+        (is (= 200 (:status resp)))
+        (is (= "no-store" (get-in resp [:headers "Cache-Control"])))
+        (is (= "Bearer" token_type))
+        (is (= 3600 expires_in))
+        (is (= "mcp" scope))
+        (is (not= access_token refresh_token))
+        (let [grant (db/find-grant-by-access (db/open path) (oauth/hash-token access_token) (System/currentTimeMillis))]
+          (is (= {:login "alice" :user-id 7 :client-id client-id :scope "mcp"}
+                 (select-keys grant [:login :user-id :client-id :scope])))
+          (is (not (str/includes? (pr-str grant) access_token)) "only a hash is stored")
+          (is (not (str/includes? (pr-str grant) refresh_token))))))
+    (testing "a code works once"
+      (let [code (fresh-code)]
+        (is (= 200 (:status (token! app client-id code))))
+        (let [resp (token! app client-id code)]
+          (is (= 400 (:status resp)))
+          (is (= "invalid_grant" (get-in resp [:body :error]))))))
+    (testing "anything wrong with the request is invalid_grant, and burns the code"
+      (doseq [[why overrides] [["wrong verifier" {"code_verifier" (apply str (repeat 43 "a"))}]
+                               ["a too-short verifier" {"code_verifier" "short"}]
+                               ["wrong redirect_uri" {"redirect_uri" "http://localhost:8123/other"}]
+                               ["another client's id" {"client_id" other-client-id}]]]
+        (let [code (fresh-code)
+              resp (apply token! app (get overrides "client_id" client-id) code (mapcat identity (dissoc overrides "client_id")))]
+          (is (= 400 (:status resp)) why)
+          (is (= "invalid_grant" (get-in resp [:body :error])) why)
+          (is (= "invalid_grant" (get-in (token! app client-id code) [:body :error])) (str why ", then right")))))
+    (testing "an expired code"
+      (db/insert-code! (db/open path) {:hash (oauth/hash-token "old") :client-id client-id :user-id 7 :login "alice"
+                                       :redirect-uri redirect-uri :code-challenge challenge :scope "mcp" :expires-at 1})
+      (is (= "invalid_grant" (get-in (token! app client-id "old") [:body :error]))))
+    (testing "an unknown code"
+      (is (= "invalid_grant" (get-in (token! app client-id "nope") [:body :error]))))
+    (testing "an unknown client"
+      (is (= "invalid_client" (get-in (token! app "nope" (fresh-code)) [:body :error]))))
+    (testing "missing parameters"
+      (doseq [k ["code" "code_verifier" "redirect_uri" "client_id"]]
+        (let [resp (call app :post "/oauth/token"
+                         :form (dissoc {"grant_type" "authorization_code" "code" "c" "client_id" client-id
+                                        "redirect_uri" redirect-uri "code_verifier" verifier}
+                                       k))]
+          (is (= "invalid_request" (get-in resp [:body :error])) k))))
+    (testing "other grant types and formats"
+      (is (= "unsupported_grant_type" (get-in (call app :post "/oauth/token" :form {"grant_type" "password"}) [:body :error])))
+      (is (= "unsupported_grant_type" (get-in (call app :post "/oauth/token" :body (json-str {:grant_type "authorization_code"}))
+                                              [:body :error]))
+          "the token endpoint takes forms, as RFC 6749 says"))))
+
+(deftest refresh-test
+  (let [path (db-test/temp-db-path)
+        app (app-for path)
+        {:keys [client-id tokens]} (get-tokens! app)
+        refresh! (fn [refresh-token & {:as overrides}]
+                   (call app :post "/oauth/token"
+                         :form (merge {"grant_type" "refresh_token" "refresh_token" refresh-token "client_id" client-id}
+                                      overrides)))
+        live? (fn [access-token] (some? (db/find-grant-by-access (db/open path) (oauth/hash-token access-token)
+                                                                 (System/currentTimeMillis))))
+        resp (refresh! (:refresh_token tokens))
+        fresh (:body resp)]
+    (testing "a refresh token yields a new pair, and the old pair stops working"
+      (is (= 200 (:status resp)))
+      (is (= "Bearer" (:token_type fresh)))
+      (is (= "mcp" (:scope fresh)))
+      (is (not= (:access_token tokens) (:access_token fresh)))
+      (is (not= (:refresh_token tokens) (:refresh_token fresh)))
+      (is (live? (:access_token fresh)))
+      (is (not (live? (:access_token tokens)))))
+    (testing "the old refresh token is used up"
+      (let [reuse (refresh! (:refresh_token tokens))]
+        (is (= 400 (:status reuse)))
+        (is (= "invalid_grant" (get-in reuse [:body :error])))))
+    (testing "a refresh token is only good for the client it was issued to, and asking wrongly doesn't spend it"
+      (let [other (register! app)]
+        (is (= "invalid_grant" (get-in (refresh! (:refresh_token fresh) "client_id" other) [:body :error])))
+        (is (= 200 (:status (refresh! (:refresh_token fresh)))))))
+    (testing "an expired refresh token is refused, and the grant is gone"
+      (db/insert-grant! (db/open path) {:client-id client-id :user-id 7 :login "alice" :scope "mcp"
+                                        :access-hash "a" :access-expires-at 1
+                                        :refresh-hash (oauth/hash-token "stale") :refresh-expires-at 1 :created-at 1})
+      (is (= "invalid_grant" (get-in (refresh! "stale") [:body :error])))
+      (is (nil? (db/find-grant-by-refresh (db/open path) (oauth/hash-token "stale")))))
+    (testing "missing or unknown refresh tokens"
+      (is (= "invalid_request" (get-in (call app :post "/oauth/token" :form {"grant_type" "refresh_token" "client_id" client-id})
+                                       [:body :error])))
+      (is (= "invalid_grant" (get-in (refresh! "unknown") [:body :error]))))))

ui/src/tbd/ui/db.cljs

@@ -17,4 +17,7 @@
    :todos {:status :idle
            :items []
            :new-title ""
-           :error nil}})
+           :error nil}
+   ;; The "Add this MCP server to Claude Code" section: :copied? is true right after the
+   ;; command was copied to the clipboard.
+   :mcp {:copied? false}})

ui/src/tbd/ui/events.cljs

@@ -167,3 +167,24 @@
     (if ok?
       {:db (update-in db [:todos :items] (fn [items] (filterv #(not= id (:id %)) items)))}
       {:dispatch [::todo-failed resp]})))
+
+;; --- MCP setup section ---
+
+;; Effect: put `text` on the clipboard. The Clipboard API only exists on secure origins (https
+;; or localhost), so the view doesn't offer the button without it; failures are ignored.
+(rf/reg-fx
+  ::copy-to-clipboard
+  (fn [text]
+    (some-> js/navigator.clipboard (.writeText text) (.catch (fn [_] nil)))))
+
+(rf/reg-event-fx
+  ::copy-mcp-command
+  (fn [{:keys [db]} [_ command]]
+    {:db (assoc-in db [:mcp :copied?] true)
+     ::copy-to-clipboard command
+     :dispatch-later [{:ms 2000 :dispatch [::mcp-copied-timeout]}]}))
+
+(rf/reg-event-db
+  ::mcp-copied-timeout
+  (fn [db _]
+    (assoc-in db [:mcp :copied?] false)))

ui/src/tbd/ui/subs.cljs

@@ -5,3 +5,4 @@
 (rf/reg-sub ::result (fn [db _] (get-in db [:calc :result])))
 (rf/reg-sub ::user (fn [db _] (:user db)))
 (rf/reg-sub ::todos (fn [db _] (:todos db)))
+(rf/reg-sub ::mcp-copied? (fn [db _] (get-in db [:mcp :copied?])))

ui/src/tbd/ui/views.cljs

@@ -68,6 +68,35 @@
      (when error [:p {:role "alert" :style {:color "crimson"}} error])
      [todo-list state]]))
 
+(defn- mcp-command
+  "The command that adds this server to Claude Code, for the address the page was loaded from
+  (which is what BASE_URL has to be for the MCP login to work)."
+  []
+  (str "claude mcp add --transport http tbd " js/location.origin "/mcp"))
+
+(defn mcp-setup
+  "How to add this server to Claude Code: a command to copy, then signing in once."
+  []
+  (let [command (mcp-command)
+        copied? @(rf/subscribe [::subs/mcp-copied?])]
+    [:section {:style {:margin-top "2rem"}}
+     [:h2 "Add this MCP server to Claude Code"]
+     [:p "Run this in your terminal:"]
+     [:div {:style {:display "flex" :gap "0.5rem" :align-items "flex-start"}}
+      [:pre {:style {:flex 1 :margin 0 :padding "0.75rem" :overflow-x "auto"
+                     :border "1px solid GrayText" :border-radius "0.25rem"}}
+       [:code command]]
+      (when js/navigator.clipboard
+        [:button {:type "button" :aria-live "polite"
+                  :on-click #(rf/dispatch [::events/copy-mcp-command command])}
+         (if copied? "Copied" "Copy")])]
+     [:p "Then sign in, once:"]
+     [:ol
+      [:li "Start " [:code "claude"] " and type " [:code "/mcp"] "."]
+      [:li "Choose " [:code "tbd"] ", then " [:strong "Authenticate"]
+       ". Your browser opens: log in with Gitea if asked, and click " [:strong "Approve"] "."]
+      [:li "Back in Claude Code, try: " [:em "\"use the tbd whoami tool\""] "."]]]))
+
 (defn- link-button [props label]
   [:button (merge {:type "button"
                    :style {:background "none" :border 0 :padding 0 :font "inherit"
@@ -92,6 +121,7 @@
      [calculator]
      (when (= :logged-in (:status user))
        [todos])
+     [mcp-setup]
      [:p [:a {:href "/api-docs"} "API docs"] " · " [:a {:href "/swagger.json"} "swagger.json"]
       (when-let [link (auth-link user)]
         [:<> " · " link])]]))