diff --git a/.env-template b/.env-template index 8c354cb..dc63caa 100644 --- a/.env-template +++ b/.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 diff --git a/.gitignore b/.gitignore index 536c805..78b8473 100644 --- a/.gitignore +++ b/.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 diff --git a/Dockerfile b/Dockerfile index fa23f7d..82352bf 100644 --- a/Dockerfile +++ b/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 diff --git a/README.md b/README.md index 9a51ebc..460158e 100644 --- a/README.md +++ b/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 # /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//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="/.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 (`/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 /routes.clj Each route group (health, math, ...) owns its route subtree /core.clj Business logic for the group, with no HTTP concerns + /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) diff --git a/deps.edn b/deps.edn index c2ff839..8da50ed 100644 --- a/deps.edn +++ b/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 diff --git a/integration-test/integration_test.bb b/integration-test/integration_test.bb index f90fa40..523160b 100755 --- a/integration-test/integration_test.bb +++ b/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 "================================") diff --git a/src/tbd/auth/core.clj b/src/tbd/auth/core.clj index 4f432b6..d733854 100644 --- a/src/tbd/auth/core.clj +++ b/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; /auth/callback is the redirect URI to register in Gitea + BASE_URL public URL of this app; /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 diff --git a/src/tbd/auth/routes.clj b/src/tbd/auth/routes.clj index c61ee5b..9ae8c27 100644 --- a/src/tbd/auth/routes.clj +++ b/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] diff --git a/src/tbd/core.clj b/src/tbd/core.clj index 2953791..290430d 100644 --- a/src/tbd/core.clj +++ b/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..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]) diff --git a/src/tbd/math/routes.clj b/src/tbd/math/routes.clj index c89beb1..1013696 100644 --- a/src/tbd/math/routes.clj +++ b/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}}]) diff --git a/src/tbd/math/schema.clj b/src/tbd/math/schema.clj new file mode 100644 index 0000000..757bfdc --- /dev/null +++ b/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")]]) diff --git a/src/tbd/mcp/routes.clj b/src/tbd/mcp/routes.clj new file mode 100644 index 0000000..8fe624c --- /dev/null +++ b/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 /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}}])) diff --git a/src/tbd/mcp/schema.clj b/src/tbd/mcp/schema.clj new file mode 100644 index 0000000..8d49bf5 --- /dev/null +++ b/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..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)) diff --git a/src/tbd/mcp/tools.clj b/src/tbd/mcp/tools.clj new file mode 100644 index 0000000..dbf647e --- /dev/null +++ b/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..core) + and storage; it has no rules of its own. Its arguments are described by the group's Malli schema + (tbd..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"))]}) diff --git a/src/tbd/oauth/core.clj b/src/tbd/oauth/core.clj new file mode 100644 index 0000000..8f082dd --- /dev/null +++ b/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))) diff --git a/src/tbd/oauth/db.clj b/src/tbd/oauth/db.clj new file mode 100644 index 0000000..59958e7 --- /dev/null +++ b/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])) diff --git a/src/tbd/oauth/middleware.clj b/src/tbd/oauth/middleware.clj new file mode 100644 index 0000000..52be31d --- /dev/null +++ b/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))))) diff --git a/src/tbd/oauth/routes.clj b/src/tbd/oauth/routes.clj new file mode 100644 index 0000000..9ac63c9 --- /dev/null +++ b/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 "&" "&") (str/replace "<" "<") (str/replace ">" ">") + (str/replace "\"" """) (str/replace "'" "'"))) + +(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 "" + "" + "" (esc title) "

" (esc title) "

" (apply str body) "
")}) + +(defn- error-page [status message] + (html status "Can't connect this application" "

" (esc message) "

")) + +(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 "")))] + (html 200 "Connect an application" + "

" (esc (:name client)) " wants to use the tbd MCP server as " + "" (esc (:login user)) ": it will be able to call every tool the server offers, " + "with your access.

" + "

If you approve, your browser goes back to " (esc redirect-uri) ". " + "Only approve if you started this from that application.

" + "
" + (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) + "" + "" + "
"))) + +(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))}}]])) diff --git a/src/tbd/todo/routes.clj b/src/tbd/todo/routes.clj index ea12f35..9d2d1a3 100644 --- a/src/tbd/todo/routes.clj +++ b/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 diff --git a/src/tbd/todo/schema.clj b/src/tbd/todo/schema.clj new file mode 100644 index 0000000..b0efc5d --- /dev/null +++ b/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)) diff --git a/test/tbd/auth/core_test.clj b/test/tbd/auth/core_test.clj index d984311..33f2405 100644 --- a/test/tbd/auth/core_test.clj +++ b/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?")) diff --git a/test/tbd/auth/routes_test.clj b/test/tbd/auth/routes_test.clj index 4c3e828..afd1a51 100644 --- a/test/tbd/auth/routes_test.clj +++ b/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)))] diff --git a/test/tbd/mcp/routes_test.clj b/test/tbd/mcp/routes_test.clj new file mode 100644 index 0000000..ff6a991 --- /dev/null +++ b/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})))))) diff --git a/test/tbd/oauth/core_test.clj b/test/tbd/oauth/core_test.clj new file mode 100644 index 0000000..78db462 --- /dev/null +++ b/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"]))))) diff --git a/test/tbd/oauth/db_test.clj b/test/tbd/oauth/db_test.clj new file mode 100644 index 0000000..949e57c --- /dev/null +++ b/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"))))) diff --git a/test/tbd/oauth/routes_test.clj b/test/tbd/oauth/routes_test.clj new file mode 100644 index 0000000..09ceff7 --- /dev/null +++ b/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 ""}) + {: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) "<script>alert(1)</script>")) + (is (not (str/includes? (:body page) "