This commit is contained in:
@@ -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
|
||||
|
||||
+1
-1
@@ -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
|
||||
|
||||
+3
-6
@@ -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
|
||||
|
||||
@@ -8,7 +8,7 @@ dockerized integration tests, and joint line coverage.
|
||||
## Requirements
|
||||
|
||||
- Docker, for the integration tests and the `script/docker-*` tasks (all CI needs)
|
||||
- For running tasks natively (optional): [Clojure CLI](https://clojure.org/guides/install_clojure) (tools.deps) with JDK 11+, [Node](https://nodejs.org/) 20+ (with a JDK) for the UI build, and [Babashka](https://babashka.org/) for `script/coverage-report`
|
||||
- For running tasks natively (optional): [Clojure CLI](https://clojure.org/guides/install_clojure) (tools.deps) with JDK 21+, [Node](https://nodejs.org/) 20+ (with a JDK) for the UI build, and [Babashka](https://babashka.org/) for `script/coverage-report`
|
||||
|
||||
## Running
|
||||
|
||||
@@ -43,6 +43,11 @@ docker run --rm -p 3000:3000 tbd
|
||||
| `GET` | `/` | The UI: an HTML shell that loads the compiled ClojureScript from `/js/main.js` |
|
||||
| `GET` | `/api/ping` | Health check, returns `pong` |
|
||||
| `GET` | `/api/add?x=2&y=3` | Adds two numbers: `{:result 5}` (EDN by default, see [Formats](#formats)) (400 if either is missing or not a number) |
|
||||
| `POST`, `DELETE` | `/mcp` | The [MCP server](#mcp-server) (JSON-RPC over Streamable HTTP; `DELETE` ends a session; `GET` is `405`). **Needs an OAuth access token** (`401` without one) |
|
||||
| `GET` | `/.well-known/oauth-protected-resource`, `/.well-known/oauth-authorization-server` | The [MCP OAuth](#connecting-an-mcp-client) discovery documents (RFC 9728 and 8414) |
|
||||
| `POST` | `/oauth/register` | Dynamic client registration (RFC 7591) for MCP clients |
|
||||
| `GET`, `POST` | `/oauth/authorize` | Where an MCP client sends the user's browser: Gitea login if needed, then a consent page |
|
||||
| `POST` | `/oauth/token` | Trades an authorization code (with its PKCE verifier) or a refresh token for tokens |
|
||||
| `GET` | `/api-docs` | Swagger UI |
|
||||
| `GET` | `/swagger.json` | OpenAPI/Swagger spec |
|
||||
| `GET` | `/auth/login` | Starts the Gitea OAuth login (redirects to Gitea) |
|
||||
@@ -92,6 +97,65 @@ curl -XPOST localhost:3000/api/todos -H 'Cookie: tbd-session=...' \
|
||||
curl localhost:3000/api/todos -H 'Cookie: tbd-session=...'
|
||||
```
|
||||
|
||||
## MCP server
|
||||
|
||||
The server also speaks [MCP](https://modelcontextprotocol.io/) (Model Context Protocol) at `/mcp`,
|
||||
built on [PluMCP](https://github.com/plumce/plumcp) and running inside this same process; there is
|
||||
nothing extra to start. It uses the Streamable HTTP transport, and, like the todo API, it acts **as
|
||||
the logged-in user**: a client has to be approved by a user first (see below), and from then on
|
||||
every tool call knows who is calling.
|
||||
|
||||
```bash
|
||||
claude mcp add --transport http tbd https://tbd.example.com/mcp # <BASE_URL>/mcp
|
||||
```
|
||||
|
||||
The first time the client connects it gets a `401`, opens your browser, you log in with Gitea
|
||||
as usual and approve the client, and the client keeps its tokens from then on. It needs the
|
||||
[Gitea login](#authentication-and-the-admin-api) to be configured, including `BASE_URL` (which must
|
||||
be the address the client uses; without them `/mcp` answers `503` rather than being open).
|
||||
|
||||
It offers these tools: `ping`, `add` (the same logic as `/api/add`), `whoami` (which user this
|
||||
connection acts as, and whether they are an admin), and, on the caller's own todos (the same ones
|
||||
as `/api/todos`), `list_todos`, `get_todo`, `create_todo`, `update_todo` and `delete_todo`. To add a
|
||||
tool, add a `tool` to `src/tbd/mcp/tools.clj`. Its arguments are described by the group's
|
||||
[Malli](https://github.com/metosin/malli) schema in `src/tbd/<group>/schema.clj`, the same schema the
|
||||
HTTP routes use for their parameters, so a shape of data is written down once: the tool's
|
||||
input schema is generated from it, and the arguments a client sends are coerced and validated against
|
||||
it (plumcp only checks that required ones are present). A tool that touches a user's data or does
|
||||
something admin-only gets the caller from `current-user` there (`{:login :id :admin? :client-id}`),
|
||||
and must not trust anything else about who is asking.
|
||||
|
||||
Sessions are kept in memory, so they end when the server restarts (clients just re-initialize; their
|
||||
tokens are in the database and keep working). Server-to-client streaming (`GET /mcp`) is deliberately
|
||||
off: nothing here pushes messages, and the response would hang under Jetty. PluMCP needs JDK 21+.
|
||||
|
||||
### Connecting an MCP client
|
||||
|
||||
tbd is its own OAuth 2.1 authorization server for `/mcp` (in `src/tbd/oauth/`), with the Gitea login
|
||||
as the way a user proves who they are. Gitea's own tokens never reach an MCP client, and the tokens
|
||||
tbd issues are worth nothing anywhere else. The flow is the one the
|
||||
[MCP authorization spec](https://modelcontextprotocol.io/specification/2025-06-18/basic/authorization)
|
||||
describes, so any compliant client does it by itself:
|
||||
|
||||
1. `POST /mcp` with no token gets `401` and `WWW-Authenticate: Bearer resource_metadata="<BASE_URL>/.well-known/oauth-protected-resource/mcp"`.
|
||||
2. The client reads that document, then `/.well-known/oauth-authorization-server`, and registers itself at
|
||||
`/oauth/register` (dynamic client registration, public clients only).
|
||||
3. It opens `/oauth/authorize` in the browser (authorization-code flow, PKCE `S256` required). If you aren't
|
||||
logged in you go through the Gitea login first and come back; then a consent page names the client and
|
||||
the address you'll be sent back to, and asks you to **Approve** or **Deny**.
|
||||
4. The client trades the code at `/oauth/token` for an access token (1 hour) and a refresh token (30 days,
|
||||
rotated on every use), and sends `Authorization: Bearer ...` on every `/mcp` request.
|
||||
|
||||
The consent page is what stops a stranger's client (anyone can register one) from getting a token by
|
||||
sending you a link: nothing is issued without your click. Redirect URIs must be `https`, `http` on
|
||||
`localhost`/`127.0.0.1`/`[::1]` (the port may vary), or an app's own scheme (`cursor://...`).
|
||||
|
||||
What's stored is in `OAUTH_DB_PATH`: registered clients, and for each approval the user and a *hash* of the
|
||||
current access and refresh tokens. To cut a client off, delete its row from `grants`. Admin-ness isn't in
|
||||
the token: it is looked up in `ADMIN_USERS` on every request, so removing someone from the list takes
|
||||
effect at once. A Gitea account that is disabled keeps working until its refresh token expires (up to 30
|
||||
days without use) or its grant is deleted, since Gitea isn't asked again after the login.
|
||||
|
||||
## Authentication and the admin API
|
||||
|
||||
Login is OAuth2 (authorization-code flow) against a [Gitea](https://about.gitea.com/) instance.
|
||||
@@ -107,10 +171,11 @@ login, **403** for a logged-in non-admin. With no allowlist, nobody is an admin.
|
||||
| Variable | Purpose |
|
||||
|----------|---------|
|
||||
| `GITEA_URL`, `GITEA_CLIENT_ID`, `GITEA_CLIENT_SECRET` | The Gitea OAuth2 application. Without all three (and `BASE_URL`), `/auth/login` answers 503 |
|
||||
| `BASE_URL` | Public URL of this app; an `https://` one also marks the session cookie `Secure` |
|
||||
| `BASE_URL` | Public URL of this app; an `https://` one also marks the session cookie `Secure`. It is also the address of the MCP server: the OAuth issuer, and what MCP clients are told to use (`<BASE_URL>/mcp`) |
|
||||
| `ADMIN_USERS` | Comma-separated Gitea usernames (case-insensitive) allowed to use the admin API |
|
||||
| `SESSION_SECRET` | Signs and encrypts session cookies. Unset = a random key per start, so logins don't survive a restart |
|
||||
| `TODO_DB_PATH` | SQLite file for the todo group (default `data/todo.db`) |
|
||||
| `OAUTH_DB_PATH` | SQLite file for the MCP OAuth server: registered clients, codes and tokens (default `data/oauth.db`). Mount a volume for it in Docker too, or every MCP client has to be approved again after each restart |
|
||||
| `NREPL_PORT`, `NREPL_BIND` | Where the debug nREPL listens (default `7888` on `127.0.0.1`) |
|
||||
|
||||
Sessions live in an encrypted, signed, `HttpOnly`, `SameSite=Lax` cookie and expire after 8 hours
|
||||
@@ -138,7 +203,9 @@ restarts), so switch it off when you're done.
|
||||
[Reagent](https://reagent-project.github.io/)) built with [shadow-cljs](https://github.com/thheller/shadow-cljs).
|
||||
It's a small calculator form that calls `GET /api/add` and shows the sum (or the server's
|
||||
validation error). Below it, once you're logged in, is a todo list (add, tick off, delete) backed by
|
||||
`/api/todos`; it stays hidden when you're not. A "Log in" / "Log out" link sits in the footer row
|
||||
`/api/todos`; it stays hidden when you're not. At the bottom is a section with the
|
||||
`claude mcp add ...` command to copy (with this page's own address in it) and the steps to sign in, for
|
||||
adding the [MCP server](#mcp-server) to Claude Code. A "Log in" / "Log out" link sits in the footer row
|
||||
next to the API docs links.
|
||||
|
||||
shadow-cljs compiles it into `resources/public/js/` (git-ignored). The server serves that
|
||||
@@ -192,9 +259,12 @@ src/tbd/
|
||||
core.clj Router, Ring app, and server startup
|
||||
<group>/routes.clj Each route group (health, math, ...) owns its route subtree
|
||||
<group>/core.clj Business logic for the group, with no HTTP concerns
|
||||
<group>/schema.clj Malli schemas of the group's input, shared by its routes and the MCP tools
|
||||
auth/ Gitea OAuth (core), session + admin middleware (middleware), /auth routes
|
||||
mcp/ MCP server (PluMCP) mounted at `/mcp`: tools (tools.clj), Malli-to-tool glue (schema.clj) and the Ring handler (routes.clj)
|
||||
oauth/ tbd as the OAuth authorization server for MCP clients: rules (core), SQLite storage (db), `/oauth` + discovery routes, and the bearer-token middleware guarding `/mcp` (middleware)
|
||||
nrepl/ On-demand nREPL server (core) and the admin-only `/nrepl` routes
|
||||
todo/ Per-user todos: pure rules (core), SQLite storage (db), `/api/todos` routes
|
||||
todo/ Per-user todos: pure rules (core), Malli schemas of the input (schema), SQLite storage (db), `/api/todos` routes
|
||||
ui/ ClojureScript re-frame app (shadow-cljs project); ui/src/tbd/ui/{db,events,subs,views,core}.cljs
|
||||
.env-template Settings the server reads from the environment; copy to .env (git-ignored)
|
||||
resources/public/ index.html (the shell served at /) and js/ (compiled UI output, git-ignored)
|
||||
|
||||
@@ -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
|
||||
|
||||
@@ -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 "================================")
|
||||
|
||||
+16
-3
@@ -35,13 +35,15 @@
|
||||
(defn env-config
|
||||
"Auth config from environment variables:
|
||||
GITEA_URL, GITEA_CLIENT_ID, GITEA_CLIENT_SECRET the Gitea OAuth2 application
|
||||
BASE_URL public URL of this app; <BASE_URL>/auth/callback is the redirect URI to register in Gitea
|
||||
BASE_URL public URL of this app; <BASE_URL>/auth/callback is the redirect URI to register in Gitea,
|
||||
and it is the issuer/resource URL the MCP OAuth endpoints advertise
|
||||
ADMIN_USERS comma-separated Gitea usernames allowed to use the admin API (none by default)
|
||||
SESSION_SECRET signs/encrypts session cookies (random per start when unset, so logins don't survive restarts)"
|
||||
([] (env-config (System/getenv)))
|
||||
([env]
|
||||
(let [base-url (strip-trailing-slashes (env-val env "BASE_URL"))]
|
||||
{:gitea-url (strip-trailing-slashes (env-val env "GITEA_URL"))
|
||||
{:base-url base-url
|
||||
:gitea-url (strip-trailing-slashes (env-val env "GITEA_URL"))
|
||||
:client-id (env-val env "GITEA_CLIENT_ID")
|
||||
:client-secret (env-val env "GITEA_CLIENT_SECRET")
|
||||
:redirect-uri (some-> base-url (str "/auth/callback"))
|
||||
@@ -87,12 +89,23 @@
|
||||
(MessageDigest/isEqual (.getBytes ^String expected StandardCharsets/UTF_8)
|
||||
(.getBytes ^String actual StandardCharsets/UTF_8))))
|
||||
|
||||
(defn- form-encode [params]
|
||||
(defn form-encode
|
||||
"Params as an `application/x-www-form-urlencoded` string (also the format of a URL query)."
|
||||
[params]
|
||||
(str/join "&" (map (fn [[k v]]
|
||||
(str (URLEncoder/encode (name k) StandardCharsets/UTF_8) "="
|
||||
(URLEncoder/encode (str v) StandardCharsets/UTF_8)))
|
||||
params)))
|
||||
|
||||
(defn safe-return-to
|
||||
"`path` if it is a local path a login can send the browser back to, else nil. It must start
|
||||
with a single `/` (so not `//host` or `/\\host`, which browsers read as another site)."
|
||||
[path]
|
||||
(when (and (string? path)
|
||||
(<= (count path) 2000)
|
||||
(re-matches #"/(?:[^/\\\s][^\\\s]*)?" path))
|
||||
path))
|
||||
|
||||
(defn authorize-url [{:keys [gitea-url client-id redirect-uri]} state]
|
||||
(str gitea-url "/login/oauth/authorize?"
|
||||
(form-encode {:client_id client-id
|
||||
|
||||
@@ -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]
|
||||
|
||||
+14
-5
@@ -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,7 +63,10 @@
|
||||
|
||||
;; Each logical group (health, users, orders, ...) owns a `tbd.<group>.routes`
|
||||
;; namespace that returns its own route subtree; they're concatenated here.
|
||||
(defn make-router [{:keys [auth nrepl todo]}]
|
||||
(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).
|
||||
@@ -72,9 +78,11 @@
|
||||
: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)]
|
||||
(todo-routes/routes todo-ds)]
|
||||
{:data {:muuntaja http/muuntaja
|
||||
:coercion malli/coercion
|
||||
;; Handlers (and the auth/error middleware) return plain data; the muuntaja
|
||||
@@ -90,7 +98,7 @@
|
||||
parameters/parameters-middleware
|
||||
exception-middleware
|
||||
muuntaja-middleware/format-request-middleware
|
||||
coercion/coerce-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])
|
||||
|
||||
@@ -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}}])
|
||||
|
||||
@@ -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")]])
|
||||
@@ -0,0 +1,51 @@
|
||||
(ns tbd.mcp.routes
|
||||
"The MCP server, run as part of this server: plumcp's Streamable HTTP transport as a Ring
|
||||
handler mounted at `/mcp`. Point an MCP client at <BASE_URL>/mcp. The tools it offers are in
|
||||
tbd.mcp.tools. Every request needs an OAuth access token from tbd's own authorization server
|
||||
(tbd.oauth.routes); tbd.oauth.middleware checks it and tells the tools who is calling."
|
||||
(:require [plumcp.core.api.entity-support :as es]
|
||||
[plumcp.core.deps.runtime :as rt]
|
||||
[plumcp.core.server.http-ring :as mcp-http]
|
||||
[plumcp.core.server.server-support :as mcp-server]
|
||||
[plumcp.core.support.traffic-logger :as traffic-logger]
|
||||
[tbd.mcp.tools :as tools]
|
||||
[tbd.oauth.middleware :as oauth-mw]))
|
||||
|
||||
(defn- wrap-runtime
|
||||
"`handler` with `bindings` added to the plumcp runtime bag of every request, for the tools to use."
|
||||
[handler bindings]
|
||||
(fn [req] (handler (rt/upsert-runtime req bindings))))
|
||||
|
||||
(defn make-handler
|
||||
"A Ring handler speaking MCP over Streamable HTTP, for callers with a valid access token
|
||||
(`auth` is the auth config, `ds` a delay of the OAuth database, `todo-ds` one of the todo database). It keeps its MCP sessions in
|
||||
memory, so each handler is its own server: sessions don't outlive it, and aren't shared between nodes."
|
||||
[auth ds todo-ds]
|
||||
(let [{:keys [runtime jsonrpc-handler] :as options}
|
||||
(mcp-server/make-server-options
|
||||
{:info (es/make-info "tbd" "1.0.0" "tbd MCP server")
|
||||
:primitives tools/primitives
|
||||
;; The default logs every MCP message to stderr; it's noise (and tool arguments).
|
||||
:traffic-logger traffic-logger/nop-traffic-logger})]
|
||||
(-> (mcp-http/make-ring-handler runtime jsonrpc-handler options)
|
||||
;; What the tools that touch todos need besides the caller (see tbd.mcp.tools).
|
||||
(wrap-runtime {tools/todo-ds-key todo-ds})
|
||||
;; Jetty hands over the body as a stream; plumcp reads the message through `:on-msg`.
|
||||
mcp-http/wrap-request-body-reader
|
||||
;; Outermost, so a request without a token is turned away before its body is read.
|
||||
(oauth-mw/wrap-bearer-auth auth ds))))
|
||||
|
||||
(defn routes [auth ds todo-ds]
|
||||
(let [handler (make-handler auth ds todo-ds)]
|
||||
["/mcp"
|
||||
;; plumcp does its own content negotiation, JSON parsing and (via the wrapper above) body
|
||||
;; reading, so it must not sit behind the API's muuntaja/coercion middleware chain. ^:replace
|
||||
;; drops the router-wide :middleware for this route instead of adding to it.
|
||||
{:middleware ^:replace []
|
||||
:no-doc true
|
||||
;; No :get on purpose. That is MCP's optional server-to-client SSE stream, and the spec lets
|
||||
;; a server answer it with 405. Under Jetty it would also hang: the response headers aren't
|
||||
;; sent until the first event, and every open stream holds a thread. None of the tools push
|
||||
;; anything, so nothing is lost. Add :get here if one ever needs to (and test it against Jetty).
|
||||
:post {:handler handler}
|
||||
:delete {:handler handler}}]))
|
||||
@@ -0,0 +1,40 @@
|
||||
(ns tbd.mcp.schema
|
||||
"MCP tools defined from Malli schemas, the same ones the HTTP routes use (tbd.<group>.schema),
|
||||
so a shape of data is written down once. A schema gives the tool its JSON-Schema input schema
|
||||
(what clients and models see) and coerces and validates the arguments it is called with. plumcp
|
||||
itself only checks that required arguments are present."
|
||||
(:require [malli.core :as m]
|
||||
[malli.error :as me]
|
||||
[malli.json-schema :as json-schema]
|
||||
[malli.transform :as mt]
|
||||
[plumcp.core.api.capability :as cap]
|
||||
[plumcp.core.deps.runtime :as rt]))
|
||||
|
||||
(def ^:private transformer
|
||||
;; Unknown arguments are dropped, and JSON values become what the schema says (keywords, ...).
|
||||
(mt/transformer mt/strip-extra-keys-transformer mt/json-transformer))
|
||||
|
||||
(defn coerce!
|
||||
"`args` decoded for `schema`, or an exception whose message says what is wrong with them
|
||||
(an exception in a tool is an error result the model can read)."
|
||||
[schema args]
|
||||
(let [decoded (m/decode schema args transformer)]
|
||||
(if (m/validate schema decoded)
|
||||
decoded
|
||||
(throw (ex-info (str "invalid arguments: " (pr-str (me/humanize (m/explain schema decoded))))
|
||||
{})))))
|
||||
|
||||
(defn tool
|
||||
"A tool for plumcp's `:primitives` `:tools`. `schema` is a `:map` schema of its arguments; `f` is
|
||||
called with them, coerced and validated, and with the request's plumcp runtime bag (`ctx`, where
|
||||
tbd.mcp.routes and tbd.oauth.middleware put what tools need: read it with `ctx-get`). It returns a
|
||||
string, number, boolean or vector of content, or throws."
|
||||
[tool-name description schema f]
|
||||
(cap/make-tool-item tool-name (json-schema/transform schema)
|
||||
(fn [args] (f (coerce! schema (dissoc args rt/k-runtime)) args))
|
||||
:description description))
|
||||
|
||||
(defn ctx-get
|
||||
"`k` from the runtime bag `ctx`; throws if it is missing (a bug, not something to run without)."
|
||||
[ctx k]
|
||||
(rt/!>get ctx k))
|
||||
@@ -0,0 +1,84 @@
|
||||
(ns tbd.mcp.tools
|
||||
"The MCP tools the server offers, in the shape plumcp's server options take as `:primitives`.
|
||||
Like the HTTP handlers, a tool is a thin adapter over a group's business logic (tbd.<group>.core)
|
||||
and storage; it has no rules of its own. Its arguments are described by the group's Malli schema
|
||||
(tbd.<group>.schema), the same one the HTTP routes use, so shapes are defined once and every tool
|
||||
gets its input schema and argument validation from them (see tbd.mcp.schema).
|
||||
|
||||
A tool function takes the coerced arguments and the request context, and returns a string,
|
||||
number, boolean or vector of content, or throws: an exception becomes an error result the model
|
||||
can read, not a failed request."
|
||||
(:require [muuntaja.core :as m]
|
||||
[tbd.math.core :as math]
|
||||
[tbd.math.schema :as math-schema]
|
||||
[tbd.mcp.schema :refer [tool ctx-get]]
|
||||
[tbd.oauth.middleware :as oauth-mw]
|
||||
[tbd.todo.core :as todo]
|
||||
[tbd.todo.db :as todo-db]
|
||||
[tbd.todo.schema :as todo-schema]))
|
||||
|
||||
(def todo-ds-key
|
||||
"Where the todo database (a delay, as for the HTTP routes) is in the request's plumcp runtime
|
||||
bag; tbd.mcp.routes puts it there."
|
||||
:tbd/todo-ds)
|
||||
|
||||
(defn- current-user
|
||||
"Who is calling: {:login :id :admin? :client-id}, the user whose access token the request
|
||||
carried (see tbd.oauth.middleware). Tools that touch a user's data go through this, and
|
||||
check `:admin?` for anything admin-only. Throws if there is none (the transport never lets
|
||||
such a request through, so that would be a bug, and no tool should run as nobody)."
|
||||
[ctx]
|
||||
(ctx-get ctx (oauth-mw/user-key)))
|
||||
|
||||
(defn- ->json [data] (slurp (m/encode "application/json" data)))
|
||||
|
||||
(defn- ok!
|
||||
"The value of a todo.core result, or throws its error."
|
||||
[{:keys [ok error]}]
|
||||
(or ok (throw (ex-info error {}))))
|
||||
|
||||
(defn- now [] (System/currentTimeMillis))
|
||||
|
||||
;; Todos belong to the caller. Someone else's is reported exactly like a missing one.
|
||||
(defn- todo-ds [ctx] @(ctx-get ctx todo-ds-key))
|
||||
|
||||
(defn- owner-id [ctx] (:id (current-user ctx)))
|
||||
|
||||
(defn- find-todo! [ctx id]
|
||||
(or (todo-db/find-todo (todo-ds ctx) (owner-id ctx) id)
|
||||
(throw (ex-info "todo not found" {:id id}))))
|
||||
|
||||
(def primitives
|
||||
{:tools
|
||||
[(tool "ping" "Health check: returns pong" [:map]
|
||||
(fn [_ _] "pong"))
|
||||
|
||||
(tool "add" "Add two numbers" math-schema/Add
|
||||
(fn [{:keys [x y]} _] (math/add x y)))
|
||||
|
||||
(tool "whoami" "Says which user this connection acts as, and whether they are an admin" [:map]
|
||||
(fn [_ ctx]
|
||||
(let [{:keys [login id admin?]} (current-user ctx)]
|
||||
(format "%s (Gitea user %d)%s" login id (if admin? ", admin" "")))))
|
||||
|
||||
(tool "list_todos" "Lists your todos (JSON: id, title, done, created-at, updated-at), oldest first" [:map]
|
||||
(fn [_ ctx] (->json (todo-db/list-todos (todo-ds ctx) (owner-id ctx)))))
|
||||
|
||||
(tool "get_todo" "Gets one of your todos by id (JSON)" todo-schema/IdParam
|
||||
(fn [{:keys [id]} ctx] (->json (find-todo! ctx id))))
|
||||
|
||||
(tool "create_todo" "Creates a todo for you and returns it (JSON)" todo-schema/NewTodo
|
||||
(fn [{:keys [title]} ctx]
|
||||
(->json (todo-db/insert! (todo-ds ctx) (ok! (todo/new-todo (owner-id ctx) title (now)))))))
|
||||
|
||||
(tool "update_todo" "Changes the title and/or done flag of one of your todos and returns it (JSON)"
|
||||
todo-schema/UpdateTodo
|
||||
(fn [{:keys [id] :as input} ctx]
|
||||
(let [changed (ok! (todo/apply-changes (find-todo! ctx id) (dissoc input :id) (now)))]
|
||||
(->json (todo-db/update! (todo-ds ctx) (owner-id ctx) changed)))))
|
||||
|
||||
(tool "delete_todo" "Deletes one of your todos" todo-schema/IdParam
|
||||
(fn [{:keys [id]} ctx]
|
||||
(find-todo! ctx id)
|
||||
(todo-db/delete! (todo-ds ctx) (owner-id ctx) id)
|
||||
"deleted"))]})
|
||||
@@ -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)))
|
||||
@@ -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]))
|
||||
@@ -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)))))
|
||||
@@ -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 "<!doctype html><html lang=\"en\"><head><meta charset=\"utf-8\">"
|
||||
"<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">"
|
||||
"<title>" (esc title) "</title><style>"
|
||||
":root{color-scheme:light dark}"
|
||||
"body{font:16px/1.5 system-ui,sans-serif;margin:0;padding:16px}"
|
||||
"main{max-width:32rem;margin:8vh auto 0}"
|
||||
"code{word-break:break-all}"
|
||||
"button{font:inherit;padding:.5em 1.2em;margin-right:.5em;cursor:pointer}"
|
||||
"</style></head><body><main><h1>" (esc title) "</h1>" (apply str body) "</main></body></html>")})
|
||||
|
||||
(defn- error-page [status message]
|
||||
(html status "Can't connect this application" "<p>" (esc message) "</p>"))
|
||||
|
||||
(defn- validate-authorization
|
||||
"Checks an authorization request's parameters (query or form). One of:
|
||||
{:request {...}} good
|
||||
{:page-error \"...\"} the client or redirect URI can't be trusted, so don't redirect
|
||||
{:error :description :redirect-uri :state} anything else, to be reported to the client's redirect URI"
|
||||
[config ds params]
|
||||
(let [client (some->> (param params "client_id") (db/find-client @ds))
|
||||
redirect-uri (param params "redirect_uri")
|
||||
state (param params "state")
|
||||
challenge (param params "code_challenge")
|
||||
scope (oauth/parse-scope (param params "scope"))
|
||||
fail (fn [error description]
|
||||
{:error error :description description :redirect-uri redirect-uri :state state})]
|
||||
(cond
|
||||
(nil? client) {:page-error "This link names an application tbd doesn't know. Start the connection again from your MCP client."}
|
||||
(not (some #(oauth/redirect-uri-matches? % redirect-uri) (:redirect-uris client)))
|
||||
{:page-error "This link's return address isn't one the application registered. Start the connection again from your MCP client."}
|
||||
(not= "code" (param params "response_type")) (fail "unsupported_response_type" "response_type must be code")
|
||||
(not (oauth/challenge-format? challenge)) (fail "invalid_request" "code_challenge is required (PKCE, S256)")
|
||||
(not= "S256" (param params "code_challenge_method")) (fail "invalid_request" "code_challenge_method must be S256")
|
||||
(nil? scope) (fail "invalid_scope" (str "the only scope is " oauth/scope))
|
||||
(not (oauth/resource-ok? (:base-url config) (get params "resource"))) (fail "invalid_target" "resource must be the MCP server")
|
||||
:else {:request {:client client :redirect-uri redirect-uri :state state
|
||||
:code-challenge challenge :scope scope
|
||||
:resource (param params "resource")}})))
|
||||
|
||||
(defn- redirect-error [config {:keys [redirect-uri state error description]}]
|
||||
(response/redirect (oauth/redirect-with redirect-uri {:error error
|
||||
:error_description description
|
||||
:state state
|
||||
:iss (:base-url config)})
|
||||
:see-other))
|
||||
|
||||
(defn- consent-page [{:keys [client redirect-uri state code-challenge scope resource]} user csrf]
|
||||
(let [hidden (fn [k v] (when v (str "<input type=\"hidden\" name=\"" k "\" value=\"" (esc v) "\">")))]
|
||||
(html 200 "Connect an application"
|
||||
"<p><strong>" (esc (:name client)) "</strong> wants to use the tbd MCP server as "
|
||||
"<strong>" (esc (:login user)) "</strong>: it will be able to call every tool the server offers, "
|
||||
"with your access.</p>"
|
||||
"<p>If you approve, your browser goes back to <code>" (esc redirect-uri) "</code>. "
|
||||
"Only approve if you started this from that application.</p>"
|
||||
"<form method=\"post\" action=\"/oauth/authorize\">"
|
||||
(hidden "csrf" csrf)
|
||||
(hidden "client_id" (:id client))
|
||||
(hidden "redirect_uri" redirect-uri)
|
||||
(hidden "response_type" "code")
|
||||
(hidden "code_challenge" code-challenge)
|
||||
(hidden "code_challenge_method" "S256")
|
||||
(hidden "scope" scope)
|
||||
(hidden "state" state)
|
||||
(hidden "resource" resource)
|
||||
"<button type=\"submit\" name=\"decision\" value=\"approve\">Approve</button>"
|
||||
"<button type=\"submit\" name=\"decision\" value=\"deny\">Deny</button>"
|
||||
"</form>")))
|
||||
|
||||
(defn- authorize-get-handler [config ds]
|
||||
(fn [{:keys [query-params query-string session] :as req}]
|
||||
(let [result (validate-authorization config ds query-params)]
|
||||
(cond
|
||||
(:page-error result) (error-page 400 (:page-error result))
|
||||
(:error result) (redirect-error config result)
|
||||
;; Not logged in: do that first (Gitea), which then sends the browser back here.
|
||||
(nil? (auth-mw/current-user req))
|
||||
(response/redirect (str "/auth/login?" (auth/form-encode {:return_to (str "/oauth/authorize?" query-string)})))
|
||||
:else
|
||||
(let [csrf (oauth/random-token)]
|
||||
(-> (consent-page (:request result) (auth-mw/current-user req) csrf)
|
||||
(assoc :session (assoc session :oauth-csrf csrf))))))))
|
||||
|
||||
(defn- approve [config ds {:keys [client redirect-uri state code-challenge scope]} user]
|
||||
(let [code (oauth/random-token)]
|
||||
(db/insert-code! @ds {:hash (oauth/hash-token code)
|
||||
:client-id (:id client)
|
||||
:user-id (:id user)
|
||||
:login (:login user)
|
||||
:redirect-uri redirect-uri
|
||||
:code-challenge code-challenge
|
||||
:scope scope
|
||||
:expires-at (+ (now) oauth/code-ttl-ms)})
|
||||
(response/redirect (oauth/redirect-with redirect-uri {:code code :state state :iss (:base-url config)})
|
||||
:see-other)))
|
||||
|
||||
(defn- authorize-post-handler
|
||||
"The consent form. The CSRF token (kept in the session when the form was shown) is what makes
|
||||
it the user's own click, not another site posting for them."
|
||||
[config ds]
|
||||
(fn [{:keys [form-params session] :as req}]
|
||||
(let [user (auth-mw/current-user req)]
|
||||
(cond
|
||||
(nil? user) (error-page 401 "You are signed out. Start the connection again from your MCP client.")
|
||||
(not (auth/state-matches? (:oauth-csrf session) (param form-params "csrf")))
|
||||
(error-page 400 "This form expired. Start the connection again from your MCP client.")
|
||||
:else
|
||||
(let [result (validate-authorization config ds form-params)]
|
||||
(-> (cond
|
||||
(:page-error result) (error-page 400 (:page-error result))
|
||||
(:error result) (redirect-error config result)
|
||||
(= "approve" (param form-params "decision")) (approve config ds (:request result) user)
|
||||
:else (redirect-error config {:redirect-uri (get-in result [:request :redirect-uri])
|
||||
:state (get-in result [:request :state])
|
||||
:error "access_denied"
|
||||
:description "the user denied the request"}))
|
||||
(assoc :session (dissoc session :oauth-csrf))))))))
|
||||
|
||||
;; --- token endpoint ---
|
||||
|
||||
(defn- token-error [error description]
|
||||
(json 400 {:error error :error_description description}))
|
||||
|
||||
(defn- new-tokens
|
||||
"A fresh access and refresh token: [the grant's new columns, the token response]."
|
||||
[t scope]
|
||||
(let [access (oauth/random-token)
|
||||
refresh (oauth/random-token)]
|
||||
[{:access-hash (oauth/hash-token access)
|
||||
:access-expires-at (+ t oauth/access-ttl-ms)
|
||||
:refresh-hash (oauth/hash-token refresh)
|
||||
:refresh-expires-at (+ t oauth/refresh-ttl-ms)}
|
||||
{:access_token access
|
||||
:token_type "Bearer"
|
||||
:expires_in (quot oauth/access-ttl-ms 1000)
|
||||
:refresh_token refresh
|
||||
:scope scope}]))
|
||||
|
||||
(defn- code-grant [ds form]
|
||||
(let [t (now)
|
||||
[code verifier redirect-uri client-id] (map #(param form %) ["code" "code_verifier" "redirect_uri" "client_id"])]
|
||||
(cond
|
||||
(some str/blank? [code verifier redirect-uri client-id])
|
||||
(token-error "invalid_request" "code, code_verifier, redirect_uri and client_id are required")
|
||||
(nil? (db/find-client @ds client-id)) (token-error "invalid_client" "unknown client_id")
|
||||
:else
|
||||
;; A code is used up by the first attempt, right or wrong, so it can't be guessed at.
|
||||
(let [row (db/take-code! @ds (oauth/hash-token code))]
|
||||
(if (and row
|
||||
(= client-id (:client-id row))
|
||||
(= redirect-uri (:redirect-uri row))
|
||||
(< t (:expires-at row))
|
||||
(oauth/pkce-valid? (:code-challenge row) verifier))
|
||||
(let [[columns body] (new-tokens t (:scope row))]
|
||||
(db/insert-grant! @ds (assoc columns
|
||||
:client-id client-id :user-id (:user-id row) :login (:login row)
|
||||
:scope (:scope row) :created-at t))
|
||||
(json 200 body))
|
||||
(token-error "invalid_grant" "the code is invalid, expired, or was already used"))))))
|
||||
|
||||
(defn- refresh-grant [ds form]
|
||||
(let [t (now)
|
||||
refresh (param form "refresh_token")
|
||||
client-id (param form "client_id")]
|
||||
(if (or (str/blank? refresh) (str/blank? client-id))
|
||||
(token-error "invalid_request" "refresh_token and client_id are required")
|
||||
(let [old-hash (oauth/hash-token refresh)
|
||||
grant (db/find-grant-by-refresh @ds old-hash)
|
||||
invalid (token-error "invalid_grant" "the refresh token is invalid or expired")]
|
||||
(cond
|
||||
(or (nil? grant) (not= client-id (:client-id grant))) invalid
|
||||
(>= t (:refresh-expires-at grant)) (do (db/delete-grant! @ds (:id grant)) invalid)
|
||||
:else
|
||||
;; The old refresh token stops working with this: a token is good for one refresh.
|
||||
(let [[columns body] (new-tokens t (:scope grant))]
|
||||
(if (db/rotate-grant! @ds (:id grant) old-hash columns)
|
||||
(json 200 body)
|
||||
invalid)))))))
|
||||
|
||||
(defn- token-handler [ds]
|
||||
(fn [{:keys [form-params]}]
|
||||
(case (param form-params "grant_type")
|
||||
"authorization_code" (code-grant ds form-params)
|
||||
"refresh_token" (refresh-grant ds form-params)
|
||||
(token-error "unsupported_grant_type" "grant_type must be authorization_code or refresh_token"))))
|
||||
|
||||
(defn routes
|
||||
"`ds` is a delay of the datasource (see tbd.oauth.db/open), so the database isn't touched until needed."
|
||||
[config ds]
|
||||
(let [guarded #(only-when-configured config %)]
|
||||
["" {:no-doc true
|
||||
;; ^:replace: not the API's muuntaja/coercion chain (see the namespace docstring); just
|
||||
;; the query and form parameters.
|
||||
:middleware ^:replace [parameters/parameters-middleware]}
|
||||
["/.well-known/oauth-protected-resource"
|
||||
{:get {:handler (guarded (metadata-handler oauth/protected-resource-metadata config))}}]
|
||||
;; RFC 9728 puts the resource's path after the well-known prefix; clients try this one first.
|
||||
["/.well-known/oauth-protected-resource/mcp"
|
||||
{:get {:handler (guarded (metadata-handler oauth/protected-resource-metadata config))}}]
|
||||
["/.well-known/oauth-authorization-server"
|
||||
{:get {:handler (guarded (metadata-handler oauth/authorization-server-metadata config))}}]
|
||||
["/oauth/register" {:post {:handler (guarded (register-handler ds))}}]
|
||||
["/oauth/authorize" {:get {:handler (guarded (authorize-get-handler config ds))}
|
||||
:post {:handler (guarded (authorize-post-handler config ds))}}]
|
||||
["/oauth/token" {:post {:handler (guarded (token-handler ds))}}]]))
|
||||
@@ -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
|
||||
|
||||
@@ -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))
|
||||
@@ -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?"))
|
||||
|
||||
@@ -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)))]
|
||||
|
||||
@@ -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}))))))
|
||||
@@ -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"])))))
|
||||
@@ -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")))))
|
||||
@@ -0,0 +1,379 @@
|
||||
(ns tbd.oauth.routes-test
|
||||
(:require [clojure.string :as str]
|
||||
[clojure.test :refer [deftest is testing]]
|
||||
[muuntaja.core :as m]
|
||||
[tbd.auth.core :as auth]
|
||||
[tbd.auth.routes-test :as t]
|
||||
[tbd.oauth.core :as oauth]
|
||||
[tbd.oauth.db :as db]
|
||||
[tbd.oauth.db-test :as db-test]
|
||||
[tbd.test-util :as test-util])
|
||||
(:import (java.io ByteArrayInputStream)
|
||||
(java.net URLDecoder)))
|
||||
|
||||
;; These go through the real app with Gitea stubbed out, the way an MCP client and a browser
|
||||
;; would: discovery, registration, login + consent in the browser, then the token endpoint.
|
||||
|
||||
(def redirect-uri "http://localhost:8123/callback")
|
||||
(def verifier "dBjftJeZ4CVP-mB92K27uhbUJU1p1r_wW1gFWFOEjXk")
|
||||
(def challenge (oauth/pkce-challenge verifier))
|
||||
|
||||
(defn json-str [data] (slurp (m/encode "application/json" data)))
|
||||
|
||||
(defn app-for
|
||||
"An app whose OAuth database is `path`; the Gitea user is alice (id 7), an admin, unless told otherwise."
|
||||
([path] (app-for path "alice" 7))
|
||||
([path login id] (t/make-app (t/gitea-stub login id) :oauth {:db-path path})))
|
||||
|
||||
(defn call
|
||||
"Runs a request through `app`. `:form` (a map) is sent as a urlencoded body, `:body` (a string) as JSON."
|
||||
[app method uri & {:keys [cookie headers body form query]}]
|
||||
(let [payload (or (some-> form auth/form-encode) body)
|
||||
content-type (cond form "application/x-www-form-urlencoded" body "application/json")]
|
||||
(test-util/decode-body
|
||||
(app (cond-> {:request-method method :uri uri :query-string query :headers (or headers {})}
|
||||
cookie (assoc-in [:headers "cookie"] cookie)
|
||||
payload (assoc :body (ByteArrayInputStream. (.getBytes ^String payload "UTF-8")))
|
||||
content-type (assoc-in [:headers "content-type"] content-type))))))
|
||||
|
||||
(defn query-params
|
||||
"The query parameters of a response's Location header, decoded."
|
||||
[resp]
|
||||
(let [location (get-in resp [:headers "Location"] "")]
|
||||
(into {} (for [pair (str/split (or (second (str/split location #"\?" 2)) "") #"&")
|
||||
:when (seq pair)
|
||||
:let [[k v] (str/split pair #"=" 2)]]
|
||||
[(URLDecoder/decode ^String k "UTF-8") (URLDecoder/decode ^String (or v "") "UTF-8")]))))
|
||||
|
||||
(defn register!
|
||||
"Registers a client; returns its client_id."
|
||||
([app] (register! app {}))
|
||||
([app metadata]
|
||||
(:client_id (:body (call app :post "/oauth/register"
|
||||
:body (json-str (merge {:redirect_uris [redirect-uri] :client_name "Test client"} metadata)))))))
|
||||
|
||||
(defn authorize-params [client-id & {:as overrides}]
|
||||
(merge {"client_id" client-id "redirect_uri" redirect-uri "response_type" "code"
|
||||
"code_challenge" challenge "code_challenge_method" "S256" "state" "st-1" "scope" "mcp"}
|
||||
overrides))
|
||||
|
||||
(defn consent!
|
||||
"Opens the consent page as the logged-in `cookie`; returns {:page :cookie :csrf}."
|
||||
[app cookie params]
|
||||
(let [page (call app :get "/oauth/authorize" :cookie cookie :query (auth/form-encode params))]
|
||||
{:page page
|
||||
:cookie (or (t/set-cookie page) cookie)
|
||||
:csrf (second (re-find #"name=\"csrf\" value=\"([^\"]+)\"" (str (:body page))))}))
|
||||
|
||||
(defn decide!
|
||||
"Submits the consent form (`decision` approve or deny); returns the response."
|
||||
[app {:keys [cookie csrf]} params decision]
|
||||
(call app :post "/oauth/authorize" :cookie cookie :form (assoc params "csrf" csrf "decision" decision)))
|
||||
|
||||
(defn token!
|
||||
"Exchanges an authorization code (with the right verifier and redirect URI unless overridden)."
|
||||
[app client-id code & {:as overrides}]
|
||||
(call app :post "/oauth/token"
|
||||
:form (merge {"grant_type" "authorization_code" "code" code "client_id" client-id
|
||||
"redirect_uri" redirect-uri "code_verifier" verifier}
|
||||
overrides)))
|
||||
|
||||
(defn authorize-code!
|
||||
"The whole browser half for a logged-in user: consent page, then Approve. Returns the code."
|
||||
[app cookie client-id]
|
||||
(let [params (authorize-params client-id)
|
||||
resp (decide! app (consent! app cookie params) params "approve")]
|
||||
(get (query-params resp) "code")))
|
||||
|
||||
(defn get-tokens!
|
||||
"The whole flow, from an empty database to a token response body. Returns {:client-id :tokens :cookie}."
|
||||
[app]
|
||||
(let [client-id (register! app)
|
||||
cookie (t/login! app)
|
||||
code (authorize-code! app cookie client-id)]
|
||||
{:client-id client-id :cookie cookie :tokens (:body (token! app client-id code))}))
|
||||
|
||||
(deftest discovery-test
|
||||
(let [app (app-for (db-test/temp-db-path))]
|
||||
(testing "protected resource metadata, at the root and at the resource's own path"
|
||||
(doseq [uri ["/.well-known/oauth-protected-resource" "/.well-known/oauth-protected-resource/mcp"]]
|
||||
(let [resp (call app :get uri)]
|
||||
(is (= 200 (:status resp)) uri)
|
||||
(is (= {:resource "http://tbd.test/mcp" :authorization_servers ["http://tbd.test"]}
|
||||
(select-keys (:body resp) [:resource :authorization_servers]))))))
|
||||
(testing "authorization server metadata"
|
||||
(let [resp (call app :get "/.well-known/oauth-authorization-server")]
|
||||
(is (= 200 (:status resp)))
|
||||
(is (= "http://tbd.test" (get-in resp [:body :issuer])))
|
||||
(is (= "http://tbd.test/oauth/register" (get-in resp [:body :registration_endpoint])))))
|
||||
(testing "JSON whatever the Accept header says (the API default is EDN)"
|
||||
(is (= "application/json" (get-in (call app :get "/.well-known/oauth-authorization-server"
|
||||
:headers {"accept" "application/edn"})
|
||||
[:headers "Content-Type"]))))))
|
||||
|
||||
(deftest unconfigured-test
|
||||
(let [path (db-test/temp-db-path)
|
||||
app (t/make-app (t/gitea-stub "alice") :oauth {:db-path path} :gitea-url nil)]
|
||||
(doseq [[method uri] [[:get "/.well-known/oauth-protected-resource"]
|
||||
[:get "/.well-known/oauth-authorization-server"]
|
||||
[:post "/oauth/register"]
|
||||
[:get "/oauth/authorize"]
|
||||
[:post "/oauth/authorize"]
|
||||
[:post "/oauth/token"]]]
|
||||
(is (= 503 (:status (call app method uri))) (str method " " uri)))))
|
||||
|
||||
(deftest register-test
|
||||
(let [path (db-test/temp-db-path)
|
||||
app (app-for path)]
|
||||
(testing "a client is registered as a public client"
|
||||
(let [resp (call app :post "/oauth/register"
|
||||
:body (json-str {:redirect_uris [redirect-uri "https://c.example.com/cb"] :client_name "Claude"
|
||||
:grant_types ["authorization_code" "refresh_token"] :response_types ["code"]
|
||||
:token_endpoint_auth_method "none" :scope "ignored"}))
|
||||
client (:body resp)]
|
||||
(is (= 201 (:status resp)))
|
||||
(is (= "no-store" (get-in resp [:headers "Cache-Control"])))
|
||||
(is (some? (:client_id client)))
|
||||
(is (= "Claude" (:client_name client)))
|
||||
(is (= [redirect-uri "https://c.example.com/cb"] (:redirect_uris client)))
|
||||
(is (= "none" (:token_endpoint_auth_method client)))
|
||||
(is (nil? (:client_secret client)))
|
||||
(is (= "Claude" (:name (db/find-client (db/open path) (:client_id client)))) "and it is stored")))
|
||||
(testing "the name is optional, trimmed and capped"
|
||||
(is (= "Unnamed application" (get-in (call app :post "/oauth/register" :body (json-str {:redirect_uris [redirect-uri]}))
|
||||
[:body :client_name])))
|
||||
(is (= 100 (count (get-in (call app :post "/oauth/register"
|
||||
:body (json-str {:redirect_uris [redirect-uri] :client_name (apply str (repeat 500 "x"))}))
|
||||
[:body :client_name])))))
|
||||
(testing "bad registrations are refused with an RFC 7591 error"
|
||||
(doseq [[why body error]
|
||||
[["no body" nil "invalid_client_metadata"]
|
||||
["not JSON" "nope" "invalid_client_metadata"]
|
||||
["not an object" "[1]" "invalid_client_metadata"]
|
||||
["no redirect_uris" (json-str {:client_name "x"}) "invalid_client_metadata"]
|
||||
["empty redirect_uris" (json-str {:redirect_uris []}) "invalid_client_metadata"]
|
||||
["redirect_uris of the wrong type" (json-str {:redirect_uris [42]}) "invalid_client_metadata"]
|
||||
["too many redirect_uris" (json-str {:redirect_uris (repeat 11 redirect-uri)}) "invalid_client_metadata"]
|
||||
["http off the local machine" (json-str {:redirect_uris ["http://evil.example.com/cb"]}) "invalid_redirect_uri"]
|
||||
["javascript: URI" (json-str {:redirect_uris ["javascript:alert(1)"]}) "invalid_redirect_uri"]
|
||||
["one bad URI among good ones" (json-str {:redirect_uris [redirect-uri "http://evil.example.com/cb"]}) "invalid_redirect_uri"]
|
||||
["a confidential client" (json-str {:redirect_uris [redirect-uri] :token_endpoint_auth_method "client_secret_basic"})
|
||||
"invalid_client_metadata"]
|
||||
["an unsupported grant type" (json-str {:redirect_uris [redirect-uri] :grant_types ["password"]}) "invalid_client_metadata"]
|
||||
["an unsupported response type" (json-str {:redirect_uris [redirect-uri] :response_types ["token"]}) "invalid_client_metadata"]
|
||||
["an oversized body" (json-str {:redirect_uris [redirect-uri] :client_name (apply str (repeat 20000 "x"))})
|
||||
"invalid_client_metadata"]]]
|
||||
(let [resp (call app :post "/oauth/register" :body body)]
|
||||
(is (= 400 (:status resp)) why)
|
||||
(is (= error (get-in resp [:body :error])) why))))))
|
||||
|
||||
(deftest authorize-request-errors-test
|
||||
(let [app (app-for (db-test/temp-db-path))
|
||||
client-id (register! app)
|
||||
cookie (t/login! app)
|
||||
open (fn [params] (call app :get "/oauth/authorize" :cookie cookie :query (auth/form-encode params)))]
|
||||
(testing "an unknown client or an unregistered redirect URI is shown to the user, never redirected to"
|
||||
(doseq [params [(authorize-params "nope")
|
||||
(authorize-params nil)
|
||||
(authorize-params client-id "redirect_uri" "https://evil.example.com/cb")
|
||||
(authorize-params client-id "redirect_uri" "http://localhost:8123/other")
|
||||
(dissoc (authorize-params client-id) "redirect_uri")]]
|
||||
(let [resp (open params)]
|
||||
(is (= 400 (:status resp)) (pr-str params))
|
||||
(is (nil? (get-in resp [:headers "Location"])))
|
||||
(is (str/includes? (get-in resp [:headers "Content-Type"]) "text/html")))))
|
||||
(testing "any other problem goes back to the client's redirect URI, with its state"
|
||||
(doseq [[why params error]
|
||||
[["response_type token" (authorize-params client-id "response_type" "token") "unsupported_response_type"]
|
||||
["no PKCE" (dissoc (authorize-params client-id) "code_challenge" "code_challenge_method") "invalid_request"]
|
||||
["plain PKCE" (authorize-params client-id "code_challenge_method" "plain") "invalid_request"]
|
||||
["a malformed challenge" (authorize-params client-id "code_challenge" "short") "invalid_request"]
|
||||
["an unknown scope" (authorize-params client-id "scope" "mcp admin") "invalid_scope"]
|
||||
["another resource" (authorize-params client-id "resource" "https://other.example.com/mcp") "invalid_target"]]]
|
||||
(let [resp (open params)
|
||||
back (query-params resp)]
|
||||
(is (= 303 (:status resp)) why)
|
||||
(is (str/starts-with? (get-in resp [:headers "Location"]) (str redirect-uri "?")) why)
|
||||
(is (= error (get back "error")) why)
|
||||
(is (= "st-1" (get back "state")) why)
|
||||
(is (= "http://tbd.test" (get back "iss")) why))))
|
||||
(testing "a loopback client may use a different port"
|
||||
(is (= 200 (:status (open (authorize-params client-id "redirect_uri" "http://localhost:54321/callback"))))))
|
||||
(testing "the resource parameter is accepted when it is this server"
|
||||
(is (= 200 (:status (open (authorize-params client-id "resource" "http://tbd.test/mcp"))))))
|
||||
(testing "repeated parameters aren't an error, they just don't count"
|
||||
(is (= 400 (:status (call app :get "/oauth/authorize" :cookie cookie
|
||||
:query (str "client_id=" client-id "&client_id=" client-id))))))))
|
||||
|
||||
(deftest login-then-consent-test
|
||||
(let [app (app-for (db-test/temp-db-path))
|
||||
client-id (register! app)
|
||||
query (auth/form-encode (authorize-params client-id))]
|
||||
(testing "a logged-out user is sent to log in first, and back afterwards"
|
||||
(let [resp (call app :get "/oauth/authorize" :query query)
|
||||
login (get-in resp [:headers "Location"])]
|
||||
(is (= 302 (:status resp)))
|
||||
(is (str/starts-with? login "/auth/login?return_to="))
|
||||
(let [start (call app :get "/auth/login" :query (second (str/split login #"\?" 2)))
|
||||
done (call app :get "/auth/callback" :cookie (t/set-cookie start)
|
||||
:query (str "code=abc&state=" (t/location-state start)))]
|
||||
(is (= (str "/oauth/authorize?" query) (get-in done [:headers "Location"])))
|
||||
(testing "where the consent page is now shown"
|
||||
(let [page (call app :get "/oauth/authorize" :cookie (t/set-cookie done) :query query)]
|
||||
(is (= 200 (:status page)))
|
||||
(is (str/includes? (:body page) "Test client")))))))))
|
||||
|
||||
(deftest consent-page-test
|
||||
(let [app (app-for (db-test/temp-db-path))
|
||||
client-id (register! app {:client_name "<script>alert(1)</script>"})
|
||||
{:keys [page csrf]} (consent! app (t/login! app) (authorize-params client-id))]
|
||||
(is (= 200 (:status page)))
|
||||
(testing "shows who, what for and where to, escaping what the client chose"
|
||||
(is (str/includes? (:body page) "<script>alert(1)</script>"))
|
||||
(is (not (str/includes? (:body page) "<script>")))
|
||||
(is (str/includes? (:body page) "alice"))
|
||||
(is (str/includes? (:body page) redirect-uri)))
|
||||
(testing "carries a CSRF token, and the request it will approve"
|
||||
(is (some? csrf))
|
||||
(doseq [k ["client_id" "redirect_uri" "code_challenge" "state"]]
|
||||
(is (str/includes? (:body page) (str "name=\"" k "\"")) k)))
|
||||
(testing "can't be framed or cached"
|
||||
(is (= "DENY" (get-in page [:headers "X-Frame-Options"])))
|
||||
(is (str/includes? (get-in page [:headers "Content-Security-Policy"]) "frame-ancestors 'none'"))
|
||||
(is (= "no-store" (get-in page [:headers "Cache-Control"]))))))
|
||||
|
||||
(deftest consent-decision-test
|
||||
(let [app (app-for (db-test/temp-db-path))
|
||||
client-id (register! app)
|
||||
params (authorize-params client-id)
|
||||
cookie (t/login! app)]
|
||||
(testing "approving redirects to the client with a code, the client's state, and the issuer"
|
||||
(let [resp (decide! app (consent! app cookie params) params "approve")
|
||||
back (query-params resp)]
|
||||
(is (= 303 (:status resp)))
|
||||
(is (str/starts-with? (get-in resp [:headers "Location"]) (str redirect-uri "?")))
|
||||
(is (re-matches #"[A-Za-z0-9_-]{43}" (get back "code")))
|
||||
(is (= "st-1" (get back "state")))
|
||||
(is (= "http://tbd.test" (get back "iss")))))
|
||||
(testing "denying redirects with access_denied and no code"
|
||||
(let [back (query-params (decide! app (consent! app cookie params) params "deny"))]
|
||||
(is (= "access_denied" (get back "error")))
|
||||
(is (= "st-1" (get back "state")))
|
||||
(is (nil? (get back "code")))))
|
||||
(testing "anything but approve is a denial"
|
||||
(is (= "access_denied" (get (query-params (decide! app (consent! app cookie params) params "whatever")) "error"))))
|
||||
(testing "without the CSRF token, or with someone else's, nothing is approved"
|
||||
(let [consent (consent! app cookie params)]
|
||||
(doseq [csrf [nil "" "wrong"]]
|
||||
(let [resp (decide! app (assoc consent :csrf csrf) params "approve")]
|
||||
(is (= 400 (:status resp)) (pr-str csrf))
|
||||
(is (nil? (get-in resp [:headers "Location"])))))
|
||||
(testing "or when the form comes from a session that never saw the consent page"
|
||||
(is (= 400 (:status (decide! app (assoc consent :cookie cookie) params "approve")))))))
|
||||
(testing "logged out, the form does nothing"
|
||||
(let [consent (consent! app cookie params)
|
||||
resp (decide! app (assoc consent :cookie nil) params "approve")]
|
||||
(is (= 401 (:status resp)))
|
||||
(is (nil? (get-in resp [:headers "Location"])))))
|
||||
(testing "the request is checked again: it can't be swapped for another after the page was shown"
|
||||
(let [consent (consent! app cookie params)
|
||||
resp (decide! app consent (assoc params "redirect_uri" "https://evil.example.com/cb") "approve")]
|
||||
(is (= 400 (:status resp)))
|
||||
(is (nil? (get-in resp [:headers "Location"])))))))
|
||||
|
||||
(deftest code-exchange-test
|
||||
(let [path (db-test/temp-db-path)
|
||||
app (app-for path)
|
||||
client-id (register! app)
|
||||
other-client-id (register! app)
|
||||
cookie (t/login! app)
|
||||
fresh-code #(authorize-code! app cookie client-id)]
|
||||
(testing "a good exchange returns tokens for the user who approved"
|
||||
(let [resp (token! app client-id (fresh-code))
|
||||
{:keys [access_token refresh_token token_type expires_in scope]} (:body resp)]
|
||||
(is (= 200 (:status resp)))
|
||||
(is (= "no-store" (get-in resp [:headers "Cache-Control"])))
|
||||
(is (= "Bearer" token_type))
|
||||
(is (= 3600 expires_in))
|
||||
(is (= "mcp" scope))
|
||||
(is (not= access_token refresh_token))
|
||||
(let [grant (db/find-grant-by-access (db/open path) (oauth/hash-token access_token) (System/currentTimeMillis))]
|
||||
(is (= {:login "alice" :user-id 7 :client-id client-id :scope "mcp"}
|
||||
(select-keys grant [:login :user-id :client-id :scope])))
|
||||
(is (not (str/includes? (pr-str grant) access_token)) "only a hash is stored")
|
||||
(is (not (str/includes? (pr-str grant) refresh_token))))))
|
||||
(testing "a code works once"
|
||||
(let [code (fresh-code)]
|
||||
(is (= 200 (:status (token! app client-id code))))
|
||||
(let [resp (token! app client-id code)]
|
||||
(is (= 400 (:status resp)))
|
||||
(is (= "invalid_grant" (get-in resp [:body :error]))))))
|
||||
(testing "anything wrong with the request is invalid_grant, and burns the code"
|
||||
(doseq [[why overrides] [["wrong verifier" {"code_verifier" (apply str (repeat 43 "a"))}]
|
||||
["a too-short verifier" {"code_verifier" "short"}]
|
||||
["wrong redirect_uri" {"redirect_uri" "http://localhost:8123/other"}]
|
||||
["another client's id" {"client_id" other-client-id}]]]
|
||||
(let [code (fresh-code)
|
||||
resp (apply token! app (get overrides "client_id" client-id) code (mapcat identity (dissoc overrides "client_id")))]
|
||||
(is (= 400 (:status resp)) why)
|
||||
(is (= "invalid_grant" (get-in resp [:body :error])) why)
|
||||
(is (= "invalid_grant" (get-in (token! app client-id code) [:body :error])) (str why ", then right")))))
|
||||
(testing "an expired code"
|
||||
(db/insert-code! (db/open path) {:hash (oauth/hash-token "old") :client-id client-id :user-id 7 :login "alice"
|
||||
:redirect-uri redirect-uri :code-challenge challenge :scope "mcp" :expires-at 1})
|
||||
(is (= "invalid_grant" (get-in (token! app client-id "old") [:body :error]))))
|
||||
(testing "an unknown code"
|
||||
(is (= "invalid_grant" (get-in (token! app client-id "nope") [:body :error]))))
|
||||
(testing "an unknown client"
|
||||
(is (= "invalid_client" (get-in (token! app "nope" (fresh-code)) [:body :error]))))
|
||||
(testing "missing parameters"
|
||||
(doseq [k ["code" "code_verifier" "redirect_uri" "client_id"]]
|
||||
(let [resp (call app :post "/oauth/token"
|
||||
:form (dissoc {"grant_type" "authorization_code" "code" "c" "client_id" client-id
|
||||
"redirect_uri" redirect-uri "code_verifier" verifier}
|
||||
k))]
|
||||
(is (= "invalid_request" (get-in resp [:body :error])) k))))
|
||||
(testing "other grant types and formats"
|
||||
(is (= "unsupported_grant_type" (get-in (call app :post "/oauth/token" :form {"grant_type" "password"}) [:body :error])))
|
||||
(is (= "unsupported_grant_type" (get-in (call app :post "/oauth/token" :body (json-str {:grant_type "authorization_code"}))
|
||||
[:body :error]))
|
||||
"the token endpoint takes forms, as RFC 6749 says"))))
|
||||
|
||||
(deftest refresh-test
|
||||
(let [path (db-test/temp-db-path)
|
||||
app (app-for path)
|
||||
{:keys [client-id tokens]} (get-tokens! app)
|
||||
refresh! (fn [refresh-token & {:as overrides}]
|
||||
(call app :post "/oauth/token"
|
||||
:form (merge {"grant_type" "refresh_token" "refresh_token" refresh-token "client_id" client-id}
|
||||
overrides)))
|
||||
live? (fn [access-token] (some? (db/find-grant-by-access (db/open path) (oauth/hash-token access-token)
|
||||
(System/currentTimeMillis))))
|
||||
resp (refresh! (:refresh_token tokens))
|
||||
fresh (:body resp)]
|
||||
(testing "a refresh token yields a new pair, and the old pair stops working"
|
||||
(is (= 200 (:status resp)))
|
||||
(is (= "Bearer" (:token_type fresh)))
|
||||
(is (= "mcp" (:scope fresh)))
|
||||
(is (not= (:access_token tokens) (:access_token fresh)))
|
||||
(is (not= (:refresh_token tokens) (:refresh_token fresh)))
|
||||
(is (live? (:access_token fresh)))
|
||||
(is (not (live? (:access_token tokens)))))
|
||||
(testing "the old refresh token is used up"
|
||||
(let [reuse (refresh! (:refresh_token tokens))]
|
||||
(is (= 400 (:status reuse)))
|
||||
(is (= "invalid_grant" (get-in reuse [:body :error])))))
|
||||
(testing "a refresh token is only good for the client it was issued to, and asking wrongly doesn't spend it"
|
||||
(let [other (register! app)]
|
||||
(is (= "invalid_grant" (get-in (refresh! (:refresh_token fresh) "client_id" other) [:body :error])))
|
||||
(is (= 200 (:status (refresh! (:refresh_token fresh)))))))
|
||||
(testing "an expired refresh token is refused, and the grant is gone"
|
||||
(db/insert-grant! (db/open path) {:client-id client-id :user-id 7 :login "alice" :scope "mcp"
|
||||
:access-hash "a" :access-expires-at 1
|
||||
:refresh-hash (oauth/hash-token "stale") :refresh-expires-at 1 :created-at 1})
|
||||
(is (= "invalid_grant" (get-in (refresh! "stale") [:body :error])))
|
||||
(is (nil? (db/find-grant-by-refresh (db/open path) (oauth/hash-token "stale")))))
|
||||
(testing "missing or unknown refresh tokens"
|
||||
(is (= "invalid_request" (get-in (call app :post "/oauth/token" :form {"grant_type" "refresh_token" "client_id" client-id})
|
||||
[:body :error])))
|
||||
(is (= "invalid_grant" (get-in (refresh! "unknown") [:body :error]))))))
|
||||
@@ -17,4 +17,7 @@
|
||||
:todos {:status :idle
|
||||
:items []
|
||||
:new-title ""
|
||||
:error nil}})
|
||||
:error nil}
|
||||
;; The "Add this MCP server to Claude Code" section: :copied? is true right after the
|
||||
;; command was copied to the clipboard.
|
||||
:mcp {:copied? false}})
|
||||
|
||||
@@ -167,3 +167,24 @@
|
||||
(if ok?
|
||||
{:db (update-in db [:todos :items] (fn [items] (filterv #(not= id (:id %)) items)))}
|
||||
{:dispatch [::todo-failed resp]})))
|
||||
|
||||
;; --- MCP setup section ---
|
||||
|
||||
;; Effect: put `text` on the clipboard. The Clipboard API only exists on secure origins (https
|
||||
;; or localhost), so the view doesn't offer the button without it; failures are ignored.
|
||||
(rf/reg-fx
|
||||
::copy-to-clipboard
|
||||
(fn [text]
|
||||
(some-> js/navigator.clipboard (.writeText text) (.catch (fn [_] nil)))))
|
||||
|
||||
(rf/reg-event-fx
|
||||
::copy-mcp-command
|
||||
(fn [{:keys [db]} [_ command]]
|
||||
{:db (assoc-in db [:mcp :copied?] true)
|
||||
::copy-to-clipboard command
|
||||
:dispatch-later [{:ms 2000 :dispatch [::mcp-copied-timeout]}]}))
|
||||
|
||||
(rf/reg-event-db
|
||||
::mcp-copied-timeout
|
||||
(fn [db _]
|
||||
(assoc-in db [:mcp :copied?] false)))
|
||||
|
||||
@@ -5,3 +5,4 @@
|
||||
(rf/reg-sub ::result (fn [db _] (get-in db [:calc :result])))
|
||||
(rf/reg-sub ::user (fn [db _] (:user db)))
|
||||
(rf/reg-sub ::todos (fn [db _] (:todos db)))
|
||||
(rf/reg-sub ::mcp-copied? (fn [db _] (get-in db [:mcp :copied?])))
|
||||
|
||||
@@ -68,6 +68,35 @@
|
||||
(when error [:p {:role "alert" :style {:color "crimson"}} error])
|
||||
[todo-list state]]))
|
||||
|
||||
(defn- mcp-command
|
||||
"The command that adds this server to Claude Code, for the address the page was loaded from
|
||||
(which is what BASE_URL has to be for the MCP login to work)."
|
||||
[]
|
||||
(str "claude mcp add --transport http tbd " js/location.origin "/mcp"))
|
||||
|
||||
(defn mcp-setup
|
||||
"How to add this server to Claude Code: a command to copy, then signing in once."
|
||||
[]
|
||||
(let [command (mcp-command)
|
||||
copied? @(rf/subscribe [::subs/mcp-copied?])]
|
||||
[:section {:style {:margin-top "2rem"}}
|
||||
[:h2 "Add this MCP server to Claude Code"]
|
||||
[:p "Run this in your terminal:"]
|
||||
[:div {:style {:display "flex" :gap "0.5rem" :align-items "flex-start"}}
|
||||
[:pre {:style {:flex 1 :margin 0 :padding "0.75rem" :overflow-x "auto"
|
||||
:border "1px solid GrayText" :border-radius "0.25rem"}}
|
||||
[:code command]]
|
||||
(when js/navigator.clipboard
|
||||
[:button {:type "button" :aria-live "polite"
|
||||
:on-click #(rf/dispatch [::events/copy-mcp-command command])}
|
||||
(if copied? "Copied" "Copy")])]
|
||||
[:p "Then sign in, once:"]
|
||||
[:ol
|
||||
[:li "Start " [:code "claude"] " and type " [:code "/mcp"] "."]
|
||||
[:li "Choose " [:code "tbd"] ", then " [:strong "Authenticate"]
|
||||
". Your browser opens: log in with Gitea if asked, and click " [:strong "Approve"] "."]
|
||||
[:li "Back in Claude Code, try: " [:em "\"use the tbd whoami tool\""] "."]]]))
|
||||
|
||||
(defn- link-button [props label]
|
||||
[:button (merge {:type "button"
|
||||
:style {:background "none" :border 0 :padding 0 :font "inherit"
|
||||
@@ -92,6 +121,7 @@
|
||||
[calculator]
|
||||
(when (= :logged-in (:status user))
|
||||
[todos])
|
||||
[mcp-setup]
|
||||
[:p [:a {:href "/api-docs"} "API docs"] " · " [:a {:href "/swagger.json"} "swagger.json"]
|
||||
(when-let [link (auth-link user)]
|
||||
[:<> " · " link])]]))
|
||||
|
||||
Reference in New Issue
Block a user