add validation and unified schemas

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