framework-ify. proper agent runtime + adopt ag-ui

.dockerignore

@@ -1,3 +1,8 @@
-target
+**/target
 .cpcache
 .git
+**/node_modules
+**/.shadow-cljs
+resources/public/js
+.env
+data

.env-template

@@ -0,0 +1,69 @@
+# Copy to .env and fill in:  cp .env-template .env
+# script/server loads .env automatically; with Docker pass it via `docker run --env-file .env`
+# (so keep values unquoted). .env is git-ignored and excluded from the image; never commit it.
+
+# --- Server ---------------------------------------------------------------
+# PORT=3000
+
+# --- Gitea OAuth login ------------------------------------------------------
+# Register an OAuth2 application in Gitea (Settings > Applications) as a confidential
+# client, with the redirect URI  <BASE_URL>/auth/callback
+GITEA_URL=https://gitea.example.com
+GITEA_CLIENT_ID=
+GITEA_CLIENT_SECRET=
+
+# Public URL of this app, as the browser reaches it. Use https in production: that also
+# marks the session cookie Secure.
+BASE_URL=http://localhost:3000
+
+# Signs and encrypts session cookies. Generate with: openssl rand -hex 32
+# Unset = a random key per start, so everyone is logged out on every restart.
+SESSION_SECRET=
+
+# --- Admin API --------------------------------------------------------------
+# Comma-separated Gitea usernames allowed to use the admin API (POST /nrepl).
+# Empty = nobody can.
+ADMIN_USERS=
+
+# --- Database -----------------------------------------------------------------
+# The one SQLite file the app keeps everything in: the todos, and the MCP server's OAuth state
+# (registered clients, and the hashed tokens of every client a user has approved). The directory
+# is created on first use. In Docker, mount a volume here or the todos vanish with the container
+# and every MCP client has to be approved again after a restart. BASE_URL (above) must be the
+# address MCP clients use.
+# DB_PATH=data/tbd.db
+
+# --- Agent (LM Studio, via LangChain4j) ---------------------------------------
+# The agent (tbd.agent.core, a LangChain4j streaming chat model) talks to an LM Studio server.
+# Two surfaces use it: the chat widget in the UI (the green square, bottom left; POST /api/chat, an
+# AG-UI run, logged-in users only) and the A2A server for other agents (POST /a2a, the same OAuth
+# access token as /mcp; see /.well-known/agent-card.json). Point it at your LM Studio instance:
+# server address, no /v1 (start its server, and enable "Serve on Local Network" for a remote one).
+# Unset LMSTUDIO_URL = both surfaces answer "not configured".
+# LMSTUDIO_URL=http://192.168.1.20:1234
+# Model id to ask for; empty = whichever model LM Studio has loaded.
+# LMSTUDIO_MODEL=
+# Only if the server requires an API key.
+# LMSTUDIO_API_KEY=
+# Seconds the LLM server may stay silent (before it starts answering, or between two pieces of the
+# reply) before giving up (default 120).
+# LMSTUDIO_TIMEOUT_SECONDS=120
+# Every turn (chat or A2A) is summarised in the server's log. To also keep the model's full
+# reasoning and replies, and the messages it was sent (for finding out why it loops), append a JSON
+# trace to this file. It holds what users typed, so keep it private.
+# CHAT_TRACE_FILE=data/chat-trace.jsonl
+
+# --- WebMCP origin trial ------------------------------------------------------
+# Chrome's WebMCP (the UI's browser tools) is in an origin trial. Register BASE_URL's origin at
+# https://developer.chrome.com/origintrials and paste the token here: the server then sends it
+# as an `Origin-Trial` header on the page, and Chrome turns WebMCP on for everyone who opens it.
+# The token is only good for that exact origin (scheme, host and port), and expires with the trial.
+# Empty = no header (in Chrome you can still enable chrome://flags/#enable-webmcp-testing).
+WEBMCP_ORIGIN_TRIAL_TOKEN=
+
+# --- 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
+# behind a firewall or an SSH tunnel.
+# NREPL_PORT=7888
+# NREPL_BIND=127.0.0.1

.gitea/workflows/ci.yml

@@ -24,8 +24,12 @@ jobs:
           docker compose version
           docker buildx version
 
-      # Each suite runs once, under Cloverage; the merged report is the dockerized
-      # equivalent of script/coverage.
+      # Each suite runs once, under a coverage tool. The Clojure reports (Cloverage) are merged
+      # below; the UI's (c8) stands on its own. Together this is the dockerized equivalent of
+      # script/coverage.
+      - name: UI tests (coverage)
+        run: script/docker-ui-coverage
+
       - name: Unit tests (coverage)
         run: script/docker-unit-coverage
 

.gitignore

@@ -1,3 +1,14 @@
 .cpcache
 target
-
+node_modules
+.shadow-cljs
+# Compiled UI (script/ui-build)
+resources/public/js
+.nrepl-port
+# clj-kondo / clojure-lsp caches
+.clj-kondo
+.lsp
+# Local SQLite database (DB_PATH)
+data
+# Local secrets (copy .env-template to .env)
+.env

Dockerfile

@@ -1,10 +1,41 @@
-FROM clojure:openjdk-11-tools-deps
+# Stage 1: compile the re-frame UI (ui/) to JS. shadow-cljs needs Node and a JVM. It writes
+# to ../resources/public/js (see ui/shadow-cljs.edn), i.e. /build/resources/public/js here.
+# trixie, not bookworm: its default-jre is Java 21, which shadow-cljs's Closure Compiler
+# requires (bookworm's is 17 -> UnsupportedClassVersionError).
+# ui-base holds what the UI's release build and its tests share: the toolchain and the deps.
+FROM node:22-trixie-slim AS ui-base
 
-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 default-jre-headless \
+    && rm -rf /var/lib/apt/lists/*
+
+WORKDIR /build/ui
+COPY ui/package.json ui/package-lock.json ./
+RUN npm ci
+# Resolve the ClojureScript deps in their own layer so source edits don't re-download them.
+COPY ui/shadow-cljs.edn ./
+RUN npx shadow-cljs classpath > /dev/null
+
+FROM ui-base AS ui
+COPY shared /build/shared
+COPY ui/src ./src
+RUN npx shadow-cljs release app
+
+# The UI's tests, not part of the server image: `docker build --target ui-test`
+# (script/docker-ui-test, script/docker-ui-coverage). Running the container runs the tests;
+# `npm run coverage` (script/docker-ui-coverage) also writes the report to /build/target/coverage/ui.
+FROM ui-base AS ui-test
+COPY ui/.c8rc.json ./
+COPY shared /build/shared
+COPY ui/src ./src
+COPY ui/test ./test
+CMD ["npm", "test"]
+
+# Stage 2: the server.
+# JDK 21+ is required by the MCP server (plumcp runs on virtual threads).
+FROM clojure:temurin-21-tools-deps
+
+RUN apt-get update && apt-get install -y --no-install-recommends curl \
     && rm -rf /var/lib/apt/lists/*
 
 WORKDIR /app
@@ -17,6 +48,7 @@ RUN clojure -P -X:${DEPS_ALIASES} \
     && echo "[build] cached jars: $(find /root/.m2 -name '*.jar' | wc -l)"
 
 COPY . .
+COPY --from=ui /build/resources/public/js resources/public/js
 
 EXPOSE 3000
 

README.md

@@ -1,17 +1,19 @@
 # tbd
 
 A small Clojure HTTP API built on [Ring](https://github.com/ring-clojure/ring) (Jetty) and
-[reitit](https://github.com/metosin/reitit), with Swagger UI docs, unit tests, dockerized
-integration tests, and joint line coverage.
+[reitit](https://github.com/metosin/reitit), with a ClojureScript
+[re-frame](https://github.com/day8/re-frame) front end (`ui/`), Swagger UI docs, unit tests,
+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+, 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+ (22.22+ for the UI tests; with a JDK) for the UI build, and [Babashka](https://babashka.org/) for `script/coverage-report`
 
 ## Running
 
 ```bash
+script/ui-build        # compile the UI (once, and after UI changes)
 script/server [port]
 ```
 
@@ -23,7 +25,9 @@ script/server 8080
 PORT=8080 script/server
 ```
 
-This is a thin wrapper around `clojure -X:run`, which also honors `PORT`.
+This is a thin wrapper around `clojure -X:run`, which also honors `PORT`. Then open
+http://localhost:3000 for the UI. Without `script/ui-build` the server still starts, but `/`
+shows a placeholder.
 
 Or build and run the container:
 
@@ -36,17 +40,426 @@ docker run --rm -p 3000:3000 tbd
 
 | Method | Path | Description |
 |--------|------|-------------|
-| `GET` | `/` | Plain-text landing message |
+| `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, returns EDN: `{:result 5}` (400 if either is missing or not a number) |
+| `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 |
+| `POST` | `/api/chat` | **Login required.** An [AG-UI](https://docs.ag-ui.com) run: body a `RunAgentInput` (`{"messages": [{"id": "m1", "role": "user", "content": "hi"}], ...}`, the conversation so far, 1 to 40 messages of up to 8000 characters, roles `user`, `assistant` or `tool`; optionally `"tools"`, the page's tools as AG-UI describes them: see [the chatbot's tools](#the-chatbots-tools), and `"context"`, ambient information for the run — the id of the UI page the user is on travels as `{"description": "page", "value": "tic-tac-toe"}`) sends it to the [chatbot's](#chatbot) agent and **streams the reply back** as AG-UI server-sent events (`text/event-stream`): `RUN_STARTED`, then `TEXT_MESSAGE_START`/`TEXT_MESSAGE_CONTENT`/`TEXT_MESSAGE_END` for the reply, `REASONING_MESSAGE_START`/`_CONTENT`/`_END` for the model's reasoning, `TOOL_CALL_START`/`_ARGS`/`_END` if it asks for tools to be called, and last `RUN_FINISHED` or `RUN_ERROR`. Failures before the run starts are ordinary errors: 400 for an invalid input, 502 if the LLM server can't be reached or refuses, 503 if `LMSTUDIO_URL` isn't set |
+| `POST` | `/a2a` | The [A2A server](#a2a-server): JSON-RPC 2.0, `message/send` only (no streaming; see below). **Needs an OAuth access token**, the same one an MCP client uses (`401` without one) |
+| `GET` | `/.well-known/agent-card.json` | The A2A server's [AgentCard](https://a2a-protocol.org): its name, url, capabilities and skills |
 | `GET` | `/api-docs` | Swagger UI |
 | `GET` | `/swagger.json` | OpenAPI/Swagger spec |
+| `GET` | `/auth/login` | Starts the Gitea OAuth login (redirects to Gitea) |
+| `GET` | `/auth/callback` | OAuth redirect target: completes the login, sets the session cookie, redirects to `/` |
+| `POST` | `/auth/logout` | Ends the session |
+| `GET` | `/auth/me` | The logged-in user, `{:login "alice" :id 7 :admin? true}` (401 if not logged in) |
+| `GET` | `/api/todos` | **Login required.** Your todos: `{:todos [{:id "3f2b8c1e-5a47-4d0e-9b6a-1c2d3e4f5a6b" :owner-id 7 :title "buy milk" :done false :created-at 1700000000000 :updated-at 1700000000000}]}` |
+| `POST` | `/api/todos` | **Login required.** Body `{"title": "buy milk"}` creates a todo and returns it with `201` (400 if the title is blank or over 200 characters) |
+| `GET` | `/api/todos/:id` | **Login required.** One todo (404 if it doesn't exist or isn't yours) |
+| `PATCH` | `/api/todos/:id` | **Login required.** Body with `title` and/or `done` (`{"done": true}`) updates the todo and returns it (400 for an empty or invalid change, 404 as above) |
+| `DELETE` | `/api/todos/:id` | **Login required.** Deletes the todo: `{:deleted true}` (404 as above) |
+| `GET` | `/nrepl` | **Admin only.** Whether the nREPL debug server is on: `{:enabled false}`, or `{:enabled true :bind "127.0.0.1" :port 7888}` |
+| `POST` | `/nrepl` | **Admin only.** Body `{"enabled": true}` (JSON or EDN) starts the nREPL debug server, `false` stops it; returns `{:enabled true :bind "127.0.0.1" :port 7888}` |
 
 ```bash
 curl localhost:3000/api/ping           # pong
 curl 'localhost:3000/api/add?x=2&y=3'  # {:result 5}
+curl 'localhost:3000/api/add?x=2&y=3' -H 'Accept: application/json'  # {"result":5}
 ```
 
+## Formats
+
+The API speaks EDN, JSON and Transit (`application/transit+json`, `application/transit+msgpack`).
+Responses follow the request's `Accept` header, and request bodies are read by their `Content-Type`.
+**EDN is the default**: with no `Accept` (or `*/*`, or a type the API can't produce) you get EDN, and a
+body sent with no `Content-Type` is read as EDN. Errors (400, 401, 403, ...) use the same format
+as everything else. Two exceptions: `/api/ping` is always `text/plain`, and `/swagger.json` is always JSON.
+
+Handlers return plain data (`(tbd.http/respond 200 {:result 5})`), and the muuntaja middleware in
+`tbd.core` encodes it; don't `pr-str` a body yourself.
+
+## Todos
+
+Each logged-in user has their own todo list, keyed by their Gitea user id. Every query is
+filtered by that id, so users can't see or change each other's todos; someone else's todo answers
+`404`, exactly like a missing one. Without a login the todo routes answer `401`. The operations
+themselves (ownership, validation, storage) live in `src/tbd/todo/service.clj`, which the HTTP routes
+and the [MCP tools](#mcp-server) both call, so they behave the same and are tested once; a route or
+tool only translates its request into a service call and the result into a response, and never
+touches the database.
+
+Everything the app stores (todos, and the MCP OAuth state) lives in one local
+[SQLite](https://www.sqlite.org/) file, `data/tbd.db` by default (git-ignored), which is created and
+migrated on first use. Each group owns its own tables (`tbd.todo.db`, `tbd.oauth.db`); `tbd.sqlite` opens the
+file and runs their migrations. Set `DB_PATH` to put it elsewhere. In Docker, mount a volume at that path
+(e.g. `docker run -v tbd-data:/app/data ...`), or the todos and MCP approvals are lost with the container.
+
+Every id the app issues (a todo's, an OAuth grant's) is a UUID, never a number: a model that reads `7` as a
+todo's id mixes it up with a 7 in a title. (`owner-id` is the user's id in Gitea, which it issues, so it stays
+a number.) A database from before that is migrated when it is opened: rows keep their order and get UUIDs, so
+the ids in URLs or notes from before no longer work.
+
+```bash
+# after logging in in a browser, copy the `tbd-session` cookie value:
+curl -XPOST localhost:3000/api/todos -H 'Cookie: tbd-session=...' \
+     -H 'Content-Type: application/json' -d '{"title": "buy milk"}'
+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`; it should call the group's service (or pure `core`
+functions), not a database, and if the group has no service yet, that is the thing to add, so the
+HTTP routes can share it. 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.
+
+(The UI has tools of its own for a browser agent, [see below](#browser-mcp-tools-webmcp); they are not part of this server.)
+
+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 the app's database (`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.
+
+## A2A server
+
+The server also speaks [A2A](https://a2a-protocol.org) (Agent2Agent) at `/a2a`, for other agents
+(Claude Code, Codex, ...) to call directly, the way `/mcp` lets an MCP client call its tools. It's a
+second face of the same agent as the chatbot (`tbd.agent.core`), but not tied to a browser page: an
+A2A caller has no page open, so `tbd.agent.a2a` gives it the app's *server-side* tools instead —
+todo CRUD and math, the same operations `tbd.mcp.tools` exposes to MCP clients, defined again over
+`tbd.todo.service`/`tbd.math.core` directly (this ns doesn't depend on plumcp). Its system prompt
+(`tbd.agent.instructions/a2a`) is framed for a caller with no page and no visual feedback, not the
+chatbot's in-page persona.
+
+```bash
+curl https://tbd.example.com/.well-known/agent-card.json   # <BASE_URL>/a2a, its capabilities and skills
+curl -H "Authorization: Bearer $TOKEN" -H 'Content-Type: application/json' \
+  -d '{"jsonrpc":"2.0","id":1,"method":"message/send","params":{"message":{"role":"user","kind":"message","messageId":"m1","parts":[{"kind":"text","text":"list my todos"}]}}}' \
+  https://tbd.example.com/a2a
+```
+
+`$TOKEN` is the same OAuth access token an MCP client gets ([above](#connecting-an-mcp-client)):
+`wrap-bearer-auth` verifies a token by looking it up, not by which `resource` it names, so a token
+minted for `/mcp` works here too. Only `message/send` is implemented — the AgentCard says so
+(`capabilities.streaming: false`) — so a call is synchronous: if the agent asks for a tool, this ns
+runs it itself immediately (server-side, no browser to hand it to) and asks the agent again, up to 8
+rounds, until it answers in text, which comes back as the JSON-RPC result (an A2A `Message`, role
+`"agent"`). Streaming for a browser-driven conversation is what [AG-UI](#chatbot) is for.
+
+## Authentication and the admin API
+
+Login is OAuth2 (authorization-code flow) against a [Gitea](https://about.gitea.com/) instance.
+Anyone with a Gitea account can log in, but routes marked `:admin? true` (currently
+`GET` and `POST /nrepl`) also require the user to be on the `ADMIN_USERS` allowlist: **401** without a
+login, **403** for a logged-in non-admin. With no allowlist, nobody is an admin.
+
+1. In Gitea (Settings > Applications) create an OAuth2 application, a confidential client, with
+   the redirect URI `<BASE_URL>/auth/callback`.
+2. `cp .env-template .env` and fill it in. `script/server` loads `.env`; for Docker use
+   `docker run --env-file .env`. `.env` is git-ignored and kept out of the image.
+
+| 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`. It is also the address of the MCP and A2A servers: the OAuth issuer, what MCP clients are told to use (`<BASE_URL>/mcp`), and the A2A AgentCard's `url` (`<BASE_URL>/a2a`) |
+| `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 |
+| `DB_PATH` | The app's SQLite file: todos, and the MCP OAuth server's registered clients, codes and tokens (default `data/tbd.db`). Mount a volume for it in Docker, or todos are lost and every MCP client has to be approved again after each restart |
+| `LMSTUDIO_URL`, `LMSTUDIO_MODEL`, `LMSTUDIO_API_KEY`, `LMSTUDIO_TIMEOUT_SECONDS` | The LM Studio server behind the [chatbot](#chatbot). Only the URL is needed |
+| `CHAT_TRACE_FILE` | Optional. A file to append a JSON trace of every chatbot turn to, [with the model's full reasoning and replies](#watching-the-chatbot-think). Off by default |
+| `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
+(enforced server-side). The cookie is stateless, so `POST /auth/logout` clears it in the browser but
+can't revoke a copy someone already captured; it just expires on its own.
+
+### The nREPL endpoint
+
+```bash
+# after logging in in a browser, copy the `tbd-session` cookie value:
+curl -XPOST localhost:3000/nrepl -H 'Cookie: tbd-session=...' \
+     -H 'Content-Type: application/json' -d '{"enabled": true}'
+clj -Sdeps '{:deps {nrepl/nrepl {:mvn/version "1.2.0"}}}' -M -m nrepl.cmdline --connect --host 127.0.0.1 --port 7888
+```
+
+nREPL has no authentication and evaluates arbitrary code, so enabling it is effectively remote code
+execution for whoever can reach the port. It therefore binds to loopback by default; reach it through
+an SSH tunnel (or `docker exec`) rather than setting `NREPL_BIND=0.0.0.0`. Each enable/disable is
+logged with the admin's Gitea username. It stays on until an admin disables it (or the server
+restarts), so switch it off when you're done.
+
+## UI
+
+`ui/` is a [re-frame](https://github.com/day8/re-frame) app (ClojureScript, React 19 via
+[Reagent](https://reagent-project.github.io/)) built with [shadow-cljs](https://github.com/thheller/shadow-cljs).
+It has four pages, as tabs across the top. Each has its own address in the URL's fragment (`/#/tic-tac-toe`,
+`/#/calculator`, `/#/todos`, `/#/ai-setup`), so the server only ever serves `/`, and a page can be bookmarked or reloaded.
+
+| Tab | What's on it |
+|-----|--------------|
+| Tic-tac-toe | Two players on one board, all client side |
+| Calculator | A small form that calls `GET /api/add` and shows the sum (or the server's validation error) |
+| Todos | Your todo list (add, tick off, delete), backed by `/api/todos`. The tab only shows once you're logged in; its address shows a "Log in" prompt otherwise |
+| AI setup | 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; and how to connect an MCP client to the page's own [browser tools](#browser-mcp-tools-webmcp) |
+
+A "Log in" / "Log out" link sits in the footer row next to the API docs links.
+
+A green square in the bottom left corner (on every page, opposite the blue WebMCP one) opens the
+[chatbot](#chatbot).
+
+shadow-cljs compiles it into `resources/public/js/` (git-ignored). The server serves that
+directory at `/js`, and serves `resources/public/index.html`, the shell that mounts the app, at `/`.
+
+| Task | What it does |
+|------|--------------|
+| `script/ui-build` | Optimized release build into `resources/public/js` |
+| `script/ui-watch` | Rebuilds on every change, with hot reload; run `script/server` alongside and refresh the page |
+
+The Docker image builds the UI in its own stage, so `docker build` needs no local Node. The UI's tests run
+in another stage of the same Dockerfile (`--target ui-test`), which the server image doesn't include.
+
+### Chatbot
+
+The green square opens a small chat panel. What you type goes to `POST /api/chat`, an
+[AG-UI](https://docs.ag-ui.com) run; the backend's agent (`tbd.agent.core`, a
+[LangChain4j](https://docs.langchain4j.dev/) streaming chat model) forwards the conversation to an
+[LM Studio](https://lmstudio.ai) server (its OpenAI-compatible `/v1/chat/completions`) and streams
+the reply back as AG-UI events. The browser never talks to the LLM directly, so the server's address
+(and key) stay on the backend. The panel shows "Thinking…" until the model's first word (a reasoning
+model can take a while), then the reply appears as it is generated. What the model reasons is never
+shown, only that it is thinking; the tool calls (see below) show as small grey lines between the
+replies, in full, however long, and the conversation scrolls. The conversation lives in the page only
+(a reload or logging out clears it), and the UI sends the last 40 messages of it. Chat needs a login,
+like the todos: every message costs the LLM server's time.
+
+The conversation scrolls. It follows the reply while you are at its end; scroll up to read back and it
+stays put until you send a message or scroll down again. Drag the panel's top right corner to make it
+wider or taller (the size is kept while the page is open, through Clear and closing the panel).
+
+`curl -N` shows the stream (`-N` turns off curl's own buffering; use your session cookie):
+
+```bash
+curl -N -H "Cookie: $COOKIE" -H 'Content-Type: application/json' \
+  -d '{"messages":[{"id":"m1","role":"user","content":"hi"}]}' http://localhost:3000/api/chat
+```
+
+#### The chatbot's tools
+
+The chatbot can use the page. The [browser tools](#browser-mcp-tools-webmcp) (the calculator, the todos,
+tic-tac-toe) are registered in the page's *model context*, `ui/src/tbd/ui/model_context.cljs`, which is
+what WebMCP's `navigator.modelContext` is to an agent outside the page. The chat is that agent, embedded,
+and this is exactly the shape of AG-UI's **frontend tools**: the agent asks, the browser runs them.
+
+1. Each `POST /api/chat` carries `"tools"`, the ones the page currently offers, as AG-UI describes them
+   (`{"name", "description", "parameters"}`, the schema being JSON Schema), and `"context"` naming the
+   page (`{"description": "page", "value": "tic-tac-toe"}`). The backend converts them to LangChain4j's
+   typed tool specifications for the LLM, and stays stateless. Only the tools of the page being shown are
+   listed: a tool registered with `:pages #{:calculator}` is offered on the Calculator page and nowhere
+   else (tic-tac-toe's tools are the Tic-tac-toe page's, the todos' are the Todos page's), and one with no
+   `:pages` (`ping`, `whoami`, `navigate`) on every page. The list follows the page the user is on each
+   time the conversation is sent (so does the page's name, which the backend's agent puts in the system
+   message ahead of the conversation, with the names of the tools it has), and a call for a tool the page
+   doesn't offer is refused with an error the LLM reads. The LLM can move between pages with `navigate`;
+   its next request then carries the new page and that page's tools. An agent outside the page, through
+   WebMCP, is still offered all of them.
+2. The LLM never runs anything. When it wants a tool, it says so: the reply ends with
+   `TOOL_CALL_START`/`TOOL_CALL_ARGS`/`TOOL_CALL_END` events, one triple per call (`TOOL_CALL_ARGS`'s
+   `delta` being the JSON text the model wrote). The backend only relays them.
+3. The page intercepts them and calls the tools right there (one after the other), through the same
+   handlers WebMCP uses, so they act on the page as a user would and you see it happen. The chat panel
+   shows each call and its result in small print between the messages.
+4. The results go back as messages with the role `tool` (`{"role": "tool", "toolCallId": "call_1",
+   "content": "..."}`, after the assistant message that asked, which carries `"toolCalls"`), in
+   another request with the conversation so far, for the LLM to go on from, until it answers with words.
+
+A call that can't be made (a tool that isn't there, arguments that aren't a JSON object, a tool that
+fails) is a result with the reason, for the model to read and try again from. To keep a model that never
+stops calling tools from acting on your page for ever, one message of yours gets it at most 12 calls;
+then the chat stops, and says so. Results are cut to the 8000 characters the server accepts.
+
+The chatbot is told to be an agent, not a conversationalist: its system prompt
+(`tbd.agent.instructions/chat`, in `src/tbd/agent/instructions.clj` — a JVM-only namespace, never on the
+UI's classpath, so the chatbot's own instructions are never bundled into the browser) says that what it
+does shows on your screen at once, so it should call a tool in the same turn rather than offer to, chain
+calls (navigate, list, then act), take obvious defaults instead of asking, and answer in one short
+sentence, since the call and its result are already shown. It reuses the wording that genuinely is shared
+with an outside agent (`act`, `work-it-out`, `tic-tac-toe-rules`, `examples`) from `tbd.agent.prompt` (the
+shared `.cljc`, [see below](#browser-mcp-tools-webmcp)) rather than duplicating it. If a model still
+answers requests with offers, that's what to tune for it; the tool descriptions in `webmcp.cljs` are the
+other lever.
+
+To try it, use a model that supports tool use in LM Studio, log in, and ask the chat something the page
+can do: *"add 2 and 3 with the calculator"*, *"add a todo to buy milk"*, *"play tic-tac-toe with me, you're O"*.
+
+A reverse proxy in front of tbd must not buffer responses, or the reply arrives all at once at the end
+(the server sends `X-Accel-Buffering: no`, which nginx obeys; for others, turn buffering off for `/api/chat`).
+The `REASONING_MESSAGE_CONTENT` events also keep the connection from looking idle to a proxy while the model reasons; the UI drops their text, only using them to show "Thinking…".
+Anything that goes wrong is logged on the server's stdout, with a `[tbd] chat:` prefix.
+
+Point the backend at your instance with environment variables (see [.env-template](.env-template)):
+
+```bash
+LMSTUDIO_URL=http://192.168.1.20:1234 script/server
+```
+
+Only `LMSTUDIO_URL` is required (the address of LM Studio's server, without `/v1`; for a remote instance
+turn on "Serve on Local Network" there). `LMSTUDIO_MODEL` picks a model by id (default: the one LM Studio
+has loaded), `LMSTUDIO_API_KEY` is sent as a bearer token if the server wants one, and
+`LMSTUDIO_TIMEOUT_SECONDS` (default 120) is how long the LLM server may stay silent, before it starts
+answering or between two pieces of it, before the server gives up. Without `LMSTUDIO_URL` the server
+still starts (it says so), and the chat panel shows "chat is not configured".
+
+#### Watching the chatbot think
+
+Every request to `/api/chat` is one turn of the model, and every turn is logged on stdout: one
+`turn-start` line when it goes out and one `turn-end` line when it ends. The tool loop runs in the browser,
+so the server sees each tool result as a fresh request; the turns of one loop are tied together by a `run`
+id (a hash of the user's last message), with `step` counting them from 0.
+
+```
+[tbd] chat turn-start req=9c1e4a07 run=d4a6cdb3 step=3 page=tic-tac-toe model=qwen messages=8 tools=6 prompt-chars=1180 run-calls=3
+[tbd] chat loop-suspect req=9c1e4a07 run=d4a6cdb3 step=3 kind=repeated-call tool=get_tic_tac_toe count=3 args={}
+[tbd] chat loop-suspect req=9c1e4a07 run=d4a6cdb3 step=3 kind=repeated-thinking count=8 text="Let me check the board again."
+[tbd] chat turn-end req=9c1e4a07 run=d4a6cdb3 step=3 outcome=tool-calls duration-ms=18040 ttft-ms=2210 think-ms=15100 events=1830 thinking-chars=9210 content-chars=0 calls="get_tic_tac_toe{}" flags=repeated-thinking
+```
+
+`turn-end` says how it ended (`outcome`: `done`, `tool-calls`, `error`, `upstream-error`, or `aborted` when the
+browser went away), how long it took (`ttft-ms` is the wait for the first piece, which includes the LLM
+reading the prompt; `think-ms` the time spent reasoning before answering), how much it wrote (`events` is
+close to a token count), and `finish-reason` and token counts when the LLM server sends them. `flags` is
+the grep handle for a stuck model, with a `loop-suspect` line for each trip as it happens:
+
+| Flag | Means |
+| --- | --- |
+| `repeated-call` | The same tool was called with the same arguments 3 or more times in one run (checked when the turn starts) |
+| `repeated-thinking` | The reasoning said the same sentence again, ignoring case and punctuation: at the 4th time, then the 8th, 16th, ... |
+| `long-reasoning` | The reasoning passed 8000 characters, then 16000, ... (only the ones without an answer yet are worrying) |
+| `truncated` | The LLM stopped with `finish_reason: length`: it ran out of tokens, typically in a reasoning loop |
+
+These are heuristics for where to look, not verdicts, and nothing is stopped: the server's timeout only
+counts *silence*, so a model that reasons forever, out loud, is never cut off by it.
+
+The log has no text of the conversation. To read what the model actually thought, set `CHAT_TRACE_FILE`
+(say `data/chat-trace.jsonl`, which git ignores): each turn's entries are appended there as JSON lines, with
+the full `reasoning`, `reply` and (in `turn-start`) the `input` messages of the run, the tool results the
+model was reacting to. It holds what the user typed, so treat it like the database.
+
+```bash
+# the runs that got stuck, and how
+jq -c 'select((.flags // []) | length > 0) | {run, step, flags, thinking_chars: ."thinking-chars"}' data/chat-trace.jsonl
+# what the model said in one turn
+jq -r 'select(.req == "9c1e4a07" and .event == "turn-end") | .reasoning' data/chat-trace.jsonl
+```
+
+### Browser MCP tools (WebMCP)
+
+The page also offers tools of its own to your MCP client (Claude), through [WebMCP](https://webmcp.dev):
+a small library that adds a widget to the page and lets the page register tools with it. They are the browser-side twin of the
+[server's MCP tools](#mcp-server): those work on your data on the server, these work *the page*, doing
+what you could do with the mouse and keyboard, so you see it happen. A tool that changes something opens the tab it acts on first (the todo tools open Todos, the game tools open Tic-tac-toe, the calculator tools open Calculator). They are in `ui/src/tbd/ui/webmcp.cljs`,
+registered with `registerTool` on a `WebMCP` instance (the `@jason.today/webmcp` npm package):
+
+| Tool | What it does |
+|------|--------------|
+| `ping`, `whoami` | Health check; who is logged in on the page, if anyone |
+| `navigate` | Opens a page (`tic-tac-toe`, `calculator`, `todos` or `ai-setup`) as a click on its tab would; `todos` needs a login, like its tab. The chatbot is then offered the new page's tools |
+| `get_calculator` | What the calculator form holds: its two fields and the result it shows |
+| `add` | Types `x` and `y` into the calculator, presses Add, and returns the sum the page shows |
+| `list_todos` | The todos the page shows (login required, like the todo list itself) |
+| `get_todo` | Reads todos by id (`todos`: a list of `{id}`) |
+| `create_todo` | Types each title into the new-todo field and presses Add (`todos`: a list of `{title}`), returns the new todos |
+| `set_todo_done` | Ticks or unticks the checkboxes of several todos in one call (`todos`: a list of `{id, done}`), so a bulk change is one tool call |
+| `delete_todo` | Presses the Delete button of several todos (`todos`: a list of `{id}`) |
+
+The todo tools take their work as a list, so a batch ("untick all of them") is one tool call: the chatbot
+is capped in the tool calls it may make in a turn. A batch is checked in full before its first change is made,
+and then made one todo at a time; if one fails part way, the error says how many were done.
+
+Each tool dispatches the same re-frame events the views do and waits for the result to show up in
+the app-db, so what the agent sees is what the page shows, server errors included. There is no
+`update_todo` with a title as on the server, because the page can't edit one.
+
+Next to the tools the page registers **prompts** and **resources** (`prompts` and `resources` in `webmcp.cljs`),
+so a client's lists of them are not empty. They carry the same prompt engineering as the chatbot, from
+`shared/tbd/agent/prompt.cljc` (a `.cljc`, on the classpath of both the server and the UI build): act instead
+of offering, chain the calls, take obvious defaults, report in a sentence, and play tic-tac-toe by the turn.
+The WebMCP bridge sends no server-level instructions, so this is how Claude or Codex learns them:
+
+| Prompt | What it is |
+|--------|-----------|
+| `drive_the_app` | The instructions, then the `task` you gave it (Claude Code lists it as a slash command). Without a task, the agent asks what you want |
+| `play_tic_tac_toe` | Plays a game with you, one move on its own turn, as `side` (`x` or `o`, default `o`) |
+
+| Resource | What it is |
+|----------|-----------|
+| `webmcp://app/guide` | The instructions, as Markdown: read this first |
+| `webmcp://app/state` | JSON: the page that is open, the pages (which need a login) and who is logged in |
+
+The bridge prefixes their names with the page's channel, like the tools'. A client does not read a
+resource on its own: mention it (`@`) or ask the agent to read the guide.
+
+To connect (the page's "Browser tools (WebMCP)" section says the same):
+
+1. Add the WebMCP server to your MCP client, once: `npx -y @jason.today/webmcp@latest --config claude`
+   (restart Claude Desktop afterwards).
+2. Ask the client to *make a webmcp token*.
+3. Click the blue square in the bottom right corner of the page, paste the token, and press Connect.
+   The token works once, and the page has no field for it: the widget is where it goes.
+4. The tools show up in the client, prefixed with the page's host.
+
 ## Development
 
 Every task is a bash script in `script/`. Start an nREPL server (with CIDER middleware) on the port in `.nrepl-port`, or `3000` if that
@@ -61,22 +474,35 @@ script/repl
 | Task | What it does |
 |------|--------------|
 | `script/unit-test` | Runs the Clojure tests in `test/` |
+| `script/ui-test` | Runs the ClojureScript tests in `ui/test/` under Node, in a [jsdom](https://github.com/jsdom/jsdom) window (needs Node and a JDK) |
 | `script/integration-test` | Builds the app image, starts it on a random port, runs the [integration suite](integration-test/README.md) against it, then tears it down |
-| `script/test` | Unit tests, then integration tests (stops at the first failure) |
+| `script/test` | UI tests, unit tests, then integration tests (stops at the first failure) |
 | `script/docker-unit-test` | Same as `script/unit-test`, but inside the app image (Docker only) |
+| `script/docker-ui-test` | Same as `script/ui-test`, but inside a Node + JDK image (Docker only) |
+
+The UI tests render the real app in jsdom against a fake server and drive it like a user (type, submit,
+click), next to plain tests of the re-frame events and subscriptions, the game rules and the WebMCP tools
+(`ui/test/tbd/ui/`; the shared fakes are in `test_util.cljs`). `ui/test/dom-setup.cjs` gives them a
+`window` and the real WebMCP library, and fails a run that hangs, rejects a promise nobody handles, or ends
+without a result (a test that never calls `done` would otherwise pass or stall silently). `npm test` in
+`ui/` preloads it, so use that (or the scripts) rather than running the build's output directly.
 
 ### Coverage
 
-Line coverage via [Cloverage](https://github.com/cloverage/cloverage):
+Line coverage of the Clojure code via [Cloverage](https://github.com/cloverage/cloverage), and of the UI via
+[c8](https://github.com/bcoe/c8):
 
 | Task | Output |
 |------|--------|
 | `script/unit-coverage` | `target/coverage/unit/` |
 | `script/integration-coverage` | `target/coverage/integration/` |
-| `script/coverage` | Runs both, then writes the merged report to `target/coverage/merged/` |
-| `script/docker-unit-coverage`, `script/docker-coverage-report` | Dockerized versions of the unit run and the merge step, so `script/docker-unit-coverage`, `script/integration-coverage`, `script/docker-coverage-report` is `script/coverage` with no local Clojure or Babashka (this is what CI runs) |
+| `script/ui-coverage` | `target/coverage/ui/` (V8 coverage of the compiled UI, mapped back to `ui/src/**/*.cljs` through the source maps) |
+| `script/coverage` | Runs all three, then writes the merged Clojure report to `target/coverage/merged/` (the UI's stays separate) |
+| `script/docker-unit-coverage`, `script/docker-ui-coverage`, `script/docker-coverage-report` | Dockerized versions of the unit run, the UI run and the merge step, so `script/docker-ui-coverage`, `script/docker-unit-coverage`, `script/integration-coverage`, `script/docker-coverage-report` is `script/coverage` with no local Clojure, Node or Babashka (this is what CI runs) |
 
-Each report directory has an `index.html` and an `lcov.info`. See
+Each report directory has an `index.html` and an `lcov.info`. The UI's numbers are approximate where one
+ClojureScript form compiles to several JavaScript blocks (a `case` or `cond`, say): a line can show as
+uncovered when only part of the form ran. See
 [integration-test/README.md](integration-test/README.md) for how integration coverage is
 collected.
 
@@ -88,10 +514,26 @@ 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 and A2A clients: rules (core), SQLite storage (db), `/oauth` + discovery routes, and the bearer-token middleware guarding `/mcp` and `/a2a` (middleware)
+  agent/              The agent: a LangChain4j streaming chat model (core), JSON-Schema translation for tool specs (json_schema), its system prompts (instructions), and the A2A server mounted at `/a2a` (a2a)
+  chat/               /api/chat: the AG-UI wire protocol (routes), the request's Malli schema (schema), per-turn logging and loop detection (trace) — the agent itself is agent/core.clj
+  nrepl/              On-demand nREPL server (core) and the admin-only `/nrepl` routes
+  todo/               Per-user todos: pure rules (core), Malli schemas of the input (schema), SQLite storage (db), `/api/todos` routes
+shared/                .cljc read by both the server and the UI (tbd.agent.prompt: the instructions an outside agent, through WebMCP, is given — the chatbot's own system prompt is server-only, in src/tbd/agent/instructions.clj)
+ui/                   ClojureScript re-frame app (shadow-cljs project); ui/src/tbd/ui/{db,events,subs,views,webmcp,model_context,core}.cljs, tests in ui/test/
+.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)
 test/                 Unit tests
 integration-test/     Dockerized integration tests and coverage harness
-script/               Bash entry points (test, coverage, repl, ...) and coverage helpers
+script/               Bash entry points (server, ui-build, ui-test, test, coverage, repl, ...) and coverage helpers
 ```
 
 To add a new group, create `tbd.<group>.routes` with a `routes` fn that returns a reitit route
-vector, then add it to the router in `src/tbd/core.clj`.
+vector, then add it to the router in `src/tbd/core.clj`. To make a route admin-only, put
+`:admin? true` in its route data (admin allowlist), or `:login? true` (any logged-in user; the user is
+passed to the handler as `:user`). A group with storage keeps it in its own `tbd.<group>.db`, apart
+from its business logic in `core.clj`, with a `migrate!` fn for its tables in the app's one database;
+add it to the `sqlite/open` call in `make-router`.

deps.edn

@@ -1,15 +1,27 @@
-{:paths ["src" "resources" "integration-test"]
+{:paths ["src" "shared" "resources" "integration-test"]
  :deps
  {org.clojure/clojure {:mvn/version "1.12.0"}
   ring/ring-jetty-adapter {:mvn/version "1.12.2"}
   ring/ring-defaults {:mvn/version "0.4.0"}
-  metosin/reitit {:mvn/version "0.7.2"}}
+  metosin/reitit {:mvn/version "0.7.2"}
+  ;; Runtime dep: POST /nrepl starts an nREPL server on demand (see tbd.nrepl.core).
+  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"}
+  ;; 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"}
+  ;; The agent (see tbd.agent.core): a LangChain4j streaming chat model talking to LM Studio's
+  ;; OpenAI-compatible server. Plain libraries, no Spring/Quarkus runtime pulled in.
+  dev.langchain4j/langchain4j {:mvn/version "1.20.0"}
+  dev.langchain4j/langchain4j-open-ai {:mvn/version "1.20.0"}}
 
  :aliases
  {:dev
   {:extra-deps
-   {nrepl/nrepl {:mvn/version "1.2.0"}
-    cider/cider-nrepl {:mvn/version "0.48.0"}
+   {cider/cider-nrepl {:mvn/version "0.48.0"}
     org.babashka/http-client {:mvn/version "0.4.25"}}}
   :test
   {:extra-paths ["test"]

integration-test/README.md

@@ -52,10 +52,25 @@ bb integration-test/integration_test.bb http://localhost:3000 --watch --interval
 | # | Test | Checks |
 |---|------|--------|
 | 1 | `GET /` returns 200 | HTTP status code |
-| 2 | `Content-Type` header | `text/plain` |
-| 3 | Response body | Contains expected Clojure/Ring content |
-| 4 | Not HTML | Confirms plain text response |
+| 2 | `Content-Type` header | `text/html` |
+| 3 | Response body | The HTML shell: mount point and `/js/main.js` script tag |
+| 4 | `GET /js/main.js` | 200, JavaScript, non-empty, contains the UI's `/api/add` call |
 | 5 | `HEAD /` works | HTTP 200 |
+| 6 | `GET /api/ping` | 200, body `pong` |
+| 7 | `GET /swagger.json` | 200, JSON, references `/api/ping` |
+| 8 | `GET /api-docs` | 200, `text/html` |
+| 9 | `GET /api/add?x=2&y=3` | 200, EDN `{:result 5}` |
+| 10 | `GET /api/add` with bad params | 400 for a missing or non-numeric param |
+| 11 | `GET /auth/login` | 302 to Gitea's authorize URL with the client id and a state; `HttpOnly` cookie |
+| 12 | `GET /auth/callback` with no login in progress | 400 |
+| 13 | `GET /auth/me` without a session | 401 |
+| 14 | `POST /nrepl` without a session | 401, even with an invalid body |
+
+The app container gets dummy Gitea settings from `docker-compose.yml`, so tests 11-14 cover the
+unauthenticated surface only; completing a login needs a real Gitea (the unit tests stub one).
+
+Test 4 needs the compiled UI, which the Docker image includes (`script/integration-test`
+builds it). Against a locally running server, run `script/ui-build` first.
 
 ## Line Coverage
 

integration-test/docker-compose.yml

@@ -10,6 +10,13 @@ services:
       - apparmor:unconfined
     environment:
       - PORT=${TBD_PORT:-3000}
+      # Dummy OAuth settings so /auth/login can be exercised; there's no Gitea to complete a login.
+      - BASE_URL=http://tbd-app:${TBD_PORT:-3000}
+      - GITEA_URL=http://gitea.invalid
+      - GITEA_CLIENT_ID=integration-client
+      - GITEA_CLIENT_SECRET=integration-secret
+      - ADMIN_USERS=integration-admin
+      - SESSION_SECRET=integration-session-secret
     # No container healthcheck: healthchecks run via `docker exec`, which hits the
     # same LXC/AppArmor runc bug (opencontainers/runc#5007) as image builds and
     # always fails here. integration_test.bb polls the server until it's ready.

integration-test/integration_test.bb

@@ -2,6 +2,7 @@
 
 (ns integration-test
   (:require [babashka.http-client :as http]
+            [cheshire.core :as json]
             [clojure.edn :as edn]
             [clojure.string :as str]))
 
@@ -18,6 +19,26 @@
 (defn head* [base-url]
   (http/head base-url {:throw false}))
 
+;; The login redirect points at Gitea; we want to see it, not follow it.
+(def no-redirect-client (http/client {:follow-redirects :never}))
+
+(defn get-no-redirect* [url]
+  (http/get url {:throw false :client no-redirect-client}))
+
+(defn post-json* [url body]
+  (http/post url {:throw false
+                  :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]
@@ -68,23 +89,22 @@
       (assert-eq "HTTP status" 200 (:status (get* base-url)))
       (println)
 
-      (println "Test 2: Content-Type is text/plain")
-      (assert-contains "Content-Type" "text/plain" (get (:headers (get* base-url)) "content-type" ""))
+      (println "Test 2: Content-Type is text/html")
+      (assert-contains "Content-Type" "text/html" (get (:headers (get* base-url)) "content-type" ""))
       (println)
 
-      (println "Test 3: Root response points at the API docs")
+      (println "Test 3: Root serves the HTML shell for the UI")
       (let [body (:body (get* base-url))]
-        (assert-contains "Body mentions /api-docs" "/api-docs" body)
-        (assert-not-empty "Body is non-empty" body)
-        (println)
+        (assert-contains "Body has the mount point" "<div id=\"app\"" body)
+        (assert-contains "Body loads the compiled UI" "<script src=\"/js/main.js\"" body))
+      (println)
 
-        (println "Test 4: Response is plain text, not HTML")
-        (if (and (not (str/includes? body "<!DOCTYPE"))
-                 (not (str/includes? body "<html")))
-          (do (println "  ✓ Response is not HTML") (swap! pass inc))
-          (do (println "  ✗ Response appears to be HTML")
-              (swap! fail inc)
-              (swap! errors conj "Response was HTML, expected plain text"))))
+      (println "Test 4: GET /js/main.js serves the compiled UI")
+      (let [resp (get* (str base-url "/js/main.js"))]
+        (assert-eq "HTTP status" 200 (:status resp))
+        (assert-contains "Content-Type" "javascript" (get (:headers resp) "content-type" ""))
+        (assert-not-empty "Body is non-empty" (:body resp))
+        (assert-contains "Bundle calls the add API" "/api/add" (:body resp)))
       (println)
 
       (println "Test 5: HEAD / returns 200")
@@ -118,11 +138,102 @@
         (assert-eq "Body" {:result 5} (edn/read-string (:body resp))))
       (println)
 
+      (println "Test 9b: the API answers in the format the Accept header asks for, EDN by default")
+      (let [json (http/get (str base-url "/api/add?x=2&y=3") {:throw false :headers {"Accept" "application/json"}})
+            any (http/get (str base-url "/api/add?x=2&y=3") {:throw false :headers {"Accept" "*/*"}})
+            err (http/get (str base-url "/api/todos") {:throw false :headers {"Accept" "application/json"}})]
+        (assert-contains "JSON Content-Type" "application/json" (get (:headers json) "content-type" ""))
+        (assert-eq "JSON body" "{\"result\":5}" (:body json))
+        (assert-contains "Accept */* is EDN" "application/edn" (get (:headers any) "content-type" ""))
+        (assert-contains "Errors are JSON too" "application/json" (get (:headers err) "content-type" ""))
+        (assert-eq "Error body" "{\"error\":\"login required\"}" (:body err)))
+      (println)
+
       (println "Test 10: GET /api/add with a missing or non-numeric param returns 400")
       (assert-eq "Missing y" 400 (:status (get* (str base-url "/api/add?x=2"))))
       (assert-eq "Non-numeric x" 400 (:status (get* (str base-url "/api/add?x=abc&y=3"))))
       (println)
 
+      (println "Test 11: GET /auth/login redirects to Gitea's authorize page")
+      (let [resp (get-no-redirect* (str base-url "/auth/login"))
+            location (get (:headers resp) "location" "")]
+        (assert-eq "HTTP status" 302 (:status resp))
+        (assert-contains "Location" "/login/oauth/authorize?" location)
+        (assert-contains "Location has the client id" "client_id=integration-client" location)
+        (assert-contains "Location has a state" "state=" location)
+        (assert-contains "Session cookie is HttpOnly" "HttpOnly" (str (get (:headers resp) "set-cookie" ""))))
+      (println)
+
+      (println "Test 12: GET /auth/callback with no login in progress returns 400")
+      (assert-eq "HTTP status" 400 (:status (get-no-redirect* (str base-url "/auth/callback?code=x&state=y"))))
+      (println)
+
+      (println "Test 13: GET /auth/me without a session returns 401")
+      (assert-eq "HTTP status" 401 (:status (get* (str base-url "/auth/me"))))
+      (println)
+
+      (println "Test 14: POST /nrepl without a session returns 401 and starts nothing")
+      (assert-eq "Valid body" 401 (:status (post-json* (str base-url "/nrepl") "{\"enabled\":true}")))
+      (assert-eq "Invalid body (auth is checked first)" 401 (:status (post-json* (str base-url "/nrepl") "nope")))
+      (assert-eq "A query-string admin flag is no bypass" 401 (:status (post-json* (str base-url "/nrepl?admin=true") "{\"enabled\":true}")))
+      (println)
+
+      (println "Test 15: the todo API without a session returns 401")
+      (assert-eq "GET list" 401 (:status (get* (str base-url "/api/todos"))))
+      (assert-eq "POST create" 401 (:status (post-json* (str base-url "/api/todos") "{\"title\":\"x\"}")))
+      (assert-eq "GET one" 401 (:status (get* (str base-url "/api/todos/3f2b8c1e-5a47-4d0e-9b6a-1c2d3e4f5a6b"))))
+      (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 "================================")

resources/public/index.html

@@ -0,0 +1,13 @@
+<!DOCTYPE html>
+<html lang="en">
+  <head>
+    <meta charset="utf-8">
+    <meta name="viewport" content="width=device-width, initial-scale=1">
+    <title>tbd</title>
+  </head>
+  <body>
+    <!-- The re-frame app (ui/) mounts here and replaces this placeholder. -->
+    <div id="app">Loading… (if this never goes away, the UI hasn't been built: run script/ui-build)</div>
+    <script src="/js/main.js"></script>
+  </body>
+</html>

script/coverage

@@ -1,9 +1,10 @@
 #!/usr/bin/env bash
-# Run the full suite (unit + integration) with line coverage and write the joint
-# report to target/coverage/merged.
+# Run the full suite (UI + unit + integration) with line coverage. The Clojure suites'
+# joint report goes to target/coverage/merged; the UI's is separate (target/coverage/ui).
 set -euo pipefail
 cd "$(dirname "$0")/.."
 
+script/ui-coverage
 script/unit-coverage
 script/integration-coverage
 script/coverage-report

script/docker-ui-coverage

@@ -0,0 +1,20 @@
+#!/usr/bin/env bash
+# Run the UI's tests under c8 inside a Node + JDK image; needs only Docker. The report is
+# copied out with `docker cp` (not a bind mount) so it works when this itself runs in a
+# job container. Output: target/coverage/ui.
+set -euo pipefail
+cd "$(dirname "$0")/.."
+source script/lib/docker.sh
+
+build_ui_test_image
+
+id=$(docker create --security-opt apparmor=unconfined tbd-ui-test npm run coverage)
+trap 'docker rm -f "$id" >/dev/null' EXIT
+
+status=0
+docker start -a "$id" || status=$?
+
+rm -rf target/coverage/ui
+mkdir -p target/coverage
+docker cp "$id:/build/target/coverage/ui" target/coverage/ || echo "[test] WARNING: no UI coverage report was produced"
+exit "$status"

script/docker-ui-test

@@ -0,0 +1,8 @@
+#!/usr/bin/env bash
+# Run the UI's (ClojureScript) tests inside a Node + JDK image; needs only Docker.
+set -euo pipefail
+cd "$(dirname "$0")/.."
+source script/lib/docker.sh
+
+build_ui_test_image
+exec docker run --rm --security-opt apparmor=unconfined tbd-ui-test

script/lib/docker.sh

@@ -18,3 +18,9 @@ build_unit_image() {
   use_builder
   docker buildx build --load --build-arg DEPS_ALIASES=test:cov -t tbd-unit .
 }
+
+# Builds the UI's test image (Node + JDK, the UI's deps, sources and tests), tagged tbd-ui-test.
+build_ui_test_image() {
+  use_builder
+  docker buildx build --load --target ui-test -t tbd-ui-test .
+}

script/server

@@ -1,13 +1,24 @@
 #!/usr/bin/env bash
 # Start the server. Usage: script/server [port]
-# The port defaults to $PORT, then 3000.
+# The port defaults to $PORT, then 3000. Settings in .env (see .env-template) are loaded first.
 set -euo pipefail
 cd "$(dirname "$0")/.."
 
+# Load local settings (Gitea OAuth, admin users, ...) from .env; see .env-template.
+if [[ -f .env ]]; then
+  set -a
+  source .env
+  set +a
+fi
+
 port=${1:-${PORT:-3000}}
 if [[ ! $port =~ ^[0-9]+$ ]] || (( port < 1 || port > 65535 )); then
   echo "usage: script/server [port]  (port must be 1-65535, got '$port')" >&2
   exit 2
 fi
 
+if [[ ! -f resources/public/js/main.js ]]; then
+  echo "note: the UI isn't built, so / will show a placeholder. Run script/ui-build first." >&2
+fi
+
 PORT=$port exec clojure -X:run

script/test

@@ -1,7 +1,8 @@
 #!/usr/bin/env bash
-# Run the unit tests, then the integration tests (stops at the first failure).
+# Run the UI tests, the unit tests, then the integration tests (stops at the first failure).
 set -euo pipefail
 cd "$(dirname "$0")/.."
 
+script/ui-test
 script/unit-test
 script/integration-test

script/ui-build

@@ -0,0 +1,8 @@
+#!/usr/bin/env bash
+# Compile the re-frame UI (ui/) to resources/public/js, which the server serves at /js.
+# Needs Node and a JDK. Run this before script/server; restart isn't required afterwards.
+set -euo pipefail
+cd "$(dirname "$0")/../ui"
+
+[[ -d node_modules ]] || npm ci
+exec npx shadow-cljs release app

script/ui-coverage

@@ -0,0 +1,8 @@
+#!/usr/bin/env bash
+# Run the UI's tests with line coverage (c8, mapped back to the ClojureScript); the report goes
+# to target/coverage/ui. Needs Node and a JDK, like script/ui-test.
+set -euo pipefail
+cd "$(dirname "$0")/../ui"
+
+[[ -d node_modules ]] || npm ci
+exec npm run coverage

script/ui-test

@@ -0,0 +1,8 @@
+#!/usr/bin/env bash
+# Run the UI's (ClojureScript) tests under Node, in a jsdom window. Needs Node and a JDK, like
+# script/ui-build. script/docker-ui-test does the same with only Docker.
+set -euo pipefail
+cd "$(dirname "$0")/../ui"
+
+[[ -d node_modules ]] || npm ci
+exec npm test

script/ui-watch

@@ -0,0 +1,8 @@
+#!/usr/bin/env bash
+# Rebuild the UI on every change (hot reload, also serves the shadow-cljs dashboard on :9630).
+# The output lands in resources/public/js, so run script/server alongside and refresh the page.
+set -euo pipefail
+cd "$(dirname "$0")/../ui"
+
+[[ -d node_modules ]] || npm ci
+exec npx shadow-cljs watch app

shared/tbd/agent/prompt.cljc

@@ -0,0 +1,113 @@
+(ns tbd.agent.prompt
+  "What an LLM is told about driving this app through the page's tools (tbd.ui.webmcp), for an
+  MCP client outside the page (Claude, Codex) connected through WebMCP: it gets this as the
+  prompts and resources the page registers (tbd.ui.webmcp, in the browser: `guide`, `task`,
+  `tic-tac-toe`). This is a .cljc (compiled into the browser bundle, see ui/shadow-cljs.edn's
+  `:source-paths`) because those are genuinely needed client-side.
+
+  The page's own chatbot's system prompt is a separate, server-only concern: it lives in
+  tbd.agent.instructions (`src/`, never on the UI's classpath), which reuses `act`,
+  `work-it-out`, `tic-tac-toe-rules` and `examples` from here rather than duplicating them, so the
+  wording stays shared without the chatbot's own instructions being bundled into the browser.
+
+  It is about acting. A model that is only asked to be helpful answers a request for action with
+  an offer of help, so the text says: call the tool in the same turn, chain the calls, say little
+  afterwards, and the few cases where not to. It is short and concrete on purpose, with examples:
+  the models behind LM Studio follow that better than a long list of rules."
+  (:require [clojure.string :as str]))
+
+(def act
+  "Shared with tbd.agent.instructions/chat, the in-page chatbot's own system prompt."
+  (str "Act, don't offer. When the user asks for something a tool can do, call the tool in this same\n"
+       "turn. Never say you are about to do something, never ask \"would you like me to\", never ask them\n"
+       "to confirm what they just asked for.\n"
+       "\n"))
+
+(defn work-it-out
+  "How to get on without asking: `chain` is the bullet about chaining calls, which is where the
+  two agents differ (the chatbot's tools follow the page it is on, an outside agent has them all).
+  Shared with tbd.agent.instructions/chat."
+  [chain]
+  (str "Work it out yourself:\n"
+       "- Detail missing: take the obvious default and go. Ask only when a required argument is genuinely\n"
+       "  unknowable (which of several todos they mean) or when you would delete or overwrite something\n"
+       "  and cannot tell what.\n"
+       chain
+       "- The page changes between messages: the user clicks and types too. A tool result is only what the\n"
+       "  page held when it ran, and results from an earlier message are marked out of date. Before you\n"
+       "  answer from the page or act on it (a board, a list, an id), read it again with a tool. When the\n"
+       "  user says it changed or that you are wrong, read it again first: never go by an earlier result\n"
+       "  or by what you said before.\n"
+       "- A call fails: read the error, fix the arguments or read the state, and try once more. No\n"
+       "  apologies, no explanation of what went wrong unless it still fails.\n"
+       "\n"))
+
+(def tic-tac-toe-rules
+  "Shared with tbd.agent.instructions/chat."
+  (str "Tic-tac-toe: check whose turn it is, move only for your own side, one move, then stop and let the\n"
+       "person play theirs.\n"
+       "\n"))
+
+(def examples
+  "Shared with tbd.agent.instructions/chat."
+  (str "Examples:\n"
+       "\"add a todo to buy milk\" -> create_todo{\"todos\":[{\"title\":\"buy milk\"}]} -> \"Added.\"\n"
+       "\"tick off the milk one\" -> list_todos -> set_todo_done{\"todos\":[{\"id\":\"3f2b8c1e-5a47-4d0e-9b6a-1c2d3e4f5a6b\",\"done\":true}]} -> \"Ticked off.\"\n"
+       "\"untick all my todos\" -> list_todos -> ONE set_todo_done with every todo in \"todos\" -> \"Unticked them all.\"\n"
+       "\"add milk and eggs\" -> ONE create_todo with both titles in \"todos\" -> \"Added both.\"\n"
+       "\"what's 19 and 4?\" -> add{\"x\":19,\"y\":4} -> \"23.\"\n"
+       "\"play tic tac toe, you're O\" -> get_tic_tac_toe -> it is X's turn -> \"You're up, X starts.\""))
+
+;; --- An MCP client outside the page (Claude, Codex) ---
+
+(def guide
+  "The instructions of an agent that drives the page from outside, through WebMCP: the resource
+  the page registers for it to read first, and what a prompt starts from. The WebMCP bridge sends
+  no `instructions` of its own, so this is where the agent learns that the tools are the page's
+  and what the user expects of them. Markdown, since a client shows it as a document."
+  (str "# Driving this web app\n"
+       "\n"
+       "You are connected to a web app the user has open in their browser. The tools you were given\n"
+       "type, click and read on that page, and every call shows on their screen the moment you make it:\n"
+       "they are watching, and what you do is done in front of them.\n"
+       "\n"
+       "The app has several pages, which the `navigate` tool lists. Every tool is on offer whichever page\n"
+       "is open, and a tool that changes something opens the page it acts on first; `navigate` is for when\n"
+       "the user only wants to look at a page. The `webmcp://app/state` resource says which page is open\n"
+       "and whether anyone is logged in.\n"
+       "\n"
+       act
+       (work-it-out (str "- Chain calls without stopping. You need an id: list first, then act. Never invent an id, a\n"
+                         "  title or the state of the page: read it with a tool.\n"))
+       "Then report in one short plain sentence, from the tool results: \"Added it.\" \"That's 23.\" The user\n"
+       "sees the page change, so don't describe what it now shows and don't paste JSON. Say something\n"
+       "was done only if a tool result says it was. Not being logged in is the user's to fix, on the page:\n"
+       "tell them so.\n"
+       "\n"
+       tic-tac-toe-rules
+       examples))
+
+(defn task
+  "The prompt that hands an outside agent a job on the page: `guide`, then the user's `request` if
+  they gave one (else the agent asks what they want)."
+  [request]
+  (str guide
+       "\n\n"
+       (if (and (string? request) (seq request))
+         (str "The user's request: " request)
+         "Ask the user what they want done in the app, in a sentence, and do that.")))
+
+(defn tic-tac-toe
+  "The prompt of a game of tic-tac-toe with the person at the page, for an outside agent playing
+  `side`: \"x\" or \"o\" (anything else is \"o\": X goes first, so the person, who has the board in
+  front of them, starts)."
+  [side]
+  (let [side (if (contains? #{"x" "o"} side) side "o")]
+    (str "You are playing tic-tac-toe on the app's page against the person who has it open, as "
+         (str/upper-case side) ". The tools are get_tic_tac_toe, move_tic_tac_toe and new_tic_tac_toe_game.\n"
+         "\n"
+         "Read the game with get_tic_tac_toe. If it is your side's turn, make one move with\n"
+         "move_tic_tac_toe and stop: never move for the other side, that is the person's, made on the\n"
+         "page. If it is not your side's turn, say so in a few words and wait for the person to tell\n"
+         "you they have moved; don't poll. Then read the game again and go on. When it is over, say\n"
+         "who won, or that it is a draw, and don't start another game unless asked.")))

src/tbd/agent/a2a.clj

@@ -0,0 +1,182 @@
+(ns tbd.agent.a2a
+  "The A2A (Agent2Agent, https://a2a-protocol.org) server, mounted at `/a2a`, with its discovery
+  document at `/.well-known/agent-card.json`. Unlike /api/chat (the in-page chatbot, driven by the
+  browser's own tools) an A2A caller has no page open, so this agent's tools are the app's
+  server-side ones — the same operations tbd.mcp.tools exposes to MCP clients, defined again here
+  directly over tbd.todo.service/tbd.math.core (not through plumcp's tool-item wrapper, which
+  tbd.mcp.tools builds for a different transport) so this ns has no plumcp dependency.
+
+  A2A calls are synchronous (`message/send` only: no `message/stream`, and the AgentCard says so
+  truthfully in `capabilities.streaming`) — /api/chat and the AG-UI protocol are where this app's
+  streaming surface is. Since there is no browser to run a tool and report back, this ns runs the
+  tool loop itself: ask the agent, and if it asks for tools, run them immediately and ask again,
+  until it answers in text or `max-turns` is reached.
+
+  Protected the same way /mcp is (tbd.oauth.middleware/wrap-bearer-auth): any access token this
+  server issued works here too, since verifying one doesn't check which `resource` it was minted
+  for (see tbd.oauth.middleware) — a client that has authorized for MCP can use A2A with the same
+  token."
+  (:require [clojure.string :as str]
+            [malli.json-schema :as json-schema]
+            [muuntaja.core :as m]
+            [tbd.agent.core :as agent]
+            [tbd.agent.instructions :as instructions]
+            [tbd.math.core :as math]
+            [tbd.math.schema :as math-schema]
+            [tbd.mcp.schema :refer [coerce!]]
+            [tbd.oauth.middleware :as oauth-mw]
+            [tbd.todo.schema :as todo-schema]
+            [tbd.todo.service :as todo]))
+
+(def ^:private max-turns
+  "How many rounds of tool calls the agent may make before answering, for one A2A message."
+  8)
+
+;; --- Tools: the same operations tbd.mcp.tools offers MCP clients, for a caller with no page ---
+
+(defn- ok! [{:keys [ok error]}]
+  (if error (throw (ex-info error {})) ok))
+
+(defn- ->json [data] (slurp (m/encode "application/json" data)))
+
+(defn- tool [name description schema handler]
+  {:name name :description description
+   :inputSchema (json-schema/transform schema)
+   :handler (fn [args {:keys [user ds]}] (str (handler (coerce! schema args) user ds)))})
+
+(def tools
+  [(tool "add" "Add two numbers" math-schema/Add
+         (fn [{:keys [x y]} _ _] (math/add x y)))
+   (tool "whoami" "Says which user this call acts as, and whether they are an admin" [:map]
+         (fn [_ {:keys [login id admin?]} _]
+           (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 [_ user ds] (->json (ok! (todo/list-todos ds user)))))
+   (tool "get_todo" "Gets one of your todos by id (JSON)" todo-schema/IdParam
+         (fn [{:keys [id]} user ds] (->json (ok! (todo/find-todo ds user id)))))
+   (tool "create_todo" "Creates a todo for you and returns it (JSON)" todo-schema/NewTodo
+         (fn [{:keys [title]} user ds] (->json (ok! (todo/create! ds user title)))))
+   (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} user ds] (->json (ok! (todo/update! ds user id (dissoc input :id))))))
+   (tool "delete_todo" "Deletes one of your todos" todo-schema/IdParam
+         (fn [{:keys [id]} user ds] (ok! (todo/delete! ds user id)) "deleted"))])
+
+(defn- execute-tool [ctx {:keys [name arguments]}]
+  (if-let [{:keys [handler]} (first (filter #(= name (:name %)) tools))]
+    (try (handler (m/decode "application/json" (or arguments "{}")) ctx)
+         (catch Exception e (str "error: " (ex-message e))))
+    (str "error: no such tool " (pr-str name))))
+
+;; --- Driving the agent, running its own tool loop (no browser here) ---
+
+(defn- collect
+  "Drains `pump` (see tbd.agent.core/start), returning {:text s} or {:tool-calls [...]} or
+  {:error s}: exactly one of them, whichever the turn ended with."
+  [pump]
+  (let [text (StringBuilder.) result (atom nil)]
+    (pump (fn [{:keys [content tool-calls done error]}]
+            (cond
+              content (.append text ^String content)
+              tool-calls (reset! result {:tool-calls tool-calls})
+              error (reset! result {:error error})
+              done (when-not @result (reset! result {:text (.toString text)})))))
+    @result))
+
+(defn- run-tools!
+  "Answers `messages` (tbd.agent.core's internal Message shape), running any tool calls the agent
+  makes itself, `ctx` ({:user :ds}) being what the tools need. {:text s} or {:error s :kind ...}."
+  [config ctx messages]
+  (loop [messages messages turn 0]
+    (if (>= turn max-turns)
+      {:error "the agent didn't reach an answer in time" :kind :upstream}
+      (let [{:keys [ok error kind]} (agent/start config (instructions/a2a) messages tools)]
+        (if error
+          {:error error :kind kind}
+          (let [{:keys [text tool-calls error]} (collect ok)]
+            (cond
+              error {:error error :kind :upstream}
+              (seq tool-calls)
+              (recur (into (conj (vec messages) {:role "assistant" :content "" :tool-calls tool-calls})
+                           (map (fn [{:keys [id name arguments]}]
+                                  {:role "tool" :tool-call-id id
+                                   :content (execute-tool ctx {:name name :arguments arguments})}))
+                           tool-calls)
+                     (inc turn))
+              :else {:text text})))))))
+
+(defn- message-text
+  "The plain text of an A2A Message's `parts` ([{kind: \"text\" text: \"...\"}, ...]), joined."
+  [parts]
+  (->> parts (filter #(= "text" (or (:kind %) (get % "kind")))) (map #(or (:text %) (get % "text"))) (str/join "\n")))
+
+(defn- agent-message
+  "A reply as an A2A Message: role \"agent\", one TextPart."
+  [text]
+  {:role "agent" :parts [{:kind "text" :text text}] :messageId (str (random-uuid)) :kind "message"})
+
+;; --- JSON-RPC over HTTP ---
+
+(defn- json [status body]
+  {:status status
+   :headers {"Content-Type" "application/json" "Cache-Control" "no-store"}
+   :body (m/encode "application/json" body)})
+
+(defn- rpc-result [id result] {:jsonrpc "2.0" :id id :result result})
+(defn- rpc-error [id code message] {:jsonrpc "2.0" :id id :error {:code code :message message}})
+
+(def ^:private error-status {:unavailable 503 :upstream 502})
+
+(defn- handle-message-send [config ctx {:keys [message]}]
+  (let [text (message-text (:parts message))]
+    (if (str/blank? text)
+      {:jsonrpc-error [-32602 "message has no text parts"]}
+      (let [{:keys [text error kind]} (run-tools! config ctx [{:role "user" :content text}])]
+        (if error
+          {:error [(get error-status kind 502) error]}
+          {:result (agent-message text)})))))
+
+(defn- handler [config ds]
+  (fn [{:keys [user body]}]
+    (let [{:keys [jsonrpc id method params]} (m/decode "application/json" (slurp body))]
+      (cond
+        (not= "2.0" jsonrpc)
+        (json 200 (rpc-error id -32600 "invalid JSON-RPC request"))
+
+        (= "message/send" method)
+        (let [{:keys [result jsonrpc-error error]} (handle-message-send config {:user user :ds ds} params)]
+          (cond
+            result (json 200 (rpc-result id result))
+            jsonrpc-error (json 200 (apply rpc-error id jsonrpc-error))
+            :else (let [[status text] error] (json status (rpc-error id -32000 text)))))
+
+        :else (json 200 (rpc-error id -32601 (str "method not found: " method)))))))
+
+(defn- agent-card [base-url]
+  {:name "tbd"
+   :description "tbd's agent: todo management and simple math, on behalf of the user who authorized this connection."
+   :url (str base-url "/a2a")
+   :version "1.0.0"
+   :protocolVersion "0.3.0"
+   :preferredTransport "JSONRPC"
+   :capabilities {:streaming false :pushNotifications false}
+   :defaultInputModes ["text/plain"]
+   :defaultOutputModes ["text/plain"]
+   :securitySchemes {"bearer" {:type "http" :scheme "bearer"
+                               :description "An OAuth access token from this server's own authorization server (see /.well-known/oauth-protected-resource/mcp; the same token works here)."}}
+   :security [{"bearer" []}]
+   :skills (mapv (fn [{:keys [name description]}]
+                   {:id name :name name :description description :tags ["tbd"]})
+                 tools)})
+
+(defn routes
+  "`auth` is the auth config (for `:base-url` and the OAuth check), `ds` a delay of the app's
+  database, `chat` the agent config (see tbd.agent.core/env-config)."
+  [auth ds chat]
+  ["" {:no-doc true}
+   ["/.well-known/agent-card.json"
+    {:middleware ^:replace []
+     :get {:handler (fn [_req] (json 200 (agent-card (:base-url auth))))}}]
+   ["/a2a"
+    {:middleware ^:replace []
+     :post {:handler (-> (handler chat ds) (oauth-mw/wrap-bearer-auth auth ds))}}]])

src/tbd/agent/core.clj

@@ -0,0 +1,299 @@
+(ns tbd.agent.core
+  "The chatbot's agent: a LangChain4j `StreamingChatModel` talking to the OpenAI-compatible LM
+  Studio server named by the environment. No Ring here; tbd.chat.routes owns that, tbd.agent.a2a
+  drives the same model for the A2A server.
+
+  `start` sends the request and gives {:ok pump} or {:error text :kind :unavailable|:upstream},
+  like tbd.todo.service's. `pump` forwards the reply, as it is generated, to a function that takes
+  events: {:thinking \"text\"} (a piece of the model's reasoning), {:content \"text\"} (a piece of
+  the reply), {:tool-calls [{:id :name :arguments}]} (the model wants these tools run, once its
+  reply is complete: `arguments` is the JSON text the model wrote), and finally {:done true} or
+  {:error \"text\"}. This event shape is internal (tbd.chat.routes and tbd.agent.a2a each translate
+  it to their own wire protocol — AG-UI events, A2A artifacts) and is what tbd.chat.trace watches.
+
+  The system prompt is the agent's own (tbd.agent.instructions), not something the caller supplies:
+  `start` takes `system-text` already composed (tbd.agent.instructions/chat-system-message for the
+  in-page chatbot, tbd.agent.instructions/a2a for the A2A server), and always sends it as the first
+  message. `tools` are MCP-style {:name :description :inputSchema}, converted to LangChain4j's
+  typed tool specifications (tbd.agent.json-schema) — the model only sees their metadata; running
+  them and reporting the result back (as a \"tool\" role message, see tbd.chat.schema/Message) is
+  the caller's job.
+
+  Every turn is traced (see tbd.chat.trace): what was asked, how the reply went, and whether the
+  model looks stuck in a loop. The config's `:trace` says where that goes."
+  (:require [clojure.string :as str]
+            [tbd.agent.json-schema :as json-schema]
+            [tbd.chat.trace :as trace])
+  (:import (dev.langchain4j.agent.tool ToolExecutionRequest ToolSpecification)
+           (dev.langchain4j.data.message AiMessage ChatMessage SystemMessage ToolExecutionResultMessage UserMessage)
+           (dev.langchain4j.http.client.jdk JdkHttpClientBuilder)
+           (dev.langchain4j.model.chat StreamingChatModel)
+           (dev.langchain4j.model.chat.request ChatRequest)
+           (dev.langchain4j.model.chat.response
+             ChatResponse CompleteToolCall PartialResponse PartialResponseContext
+             PartialThinking PartialThinkingContext PartialToolCallContext
+             StreamingChatResponseHandler StreamingHandle)
+           (dev.langchain4j.model.openai OpenAiStreamingChatModel)
+           (java.net.http HttpClient HttpClient$Version)
+           (java.time Duration)
+           (java.util.concurrent LinkedBlockingQueue ScheduledFuture ScheduledThreadPoolExecutor ThreadFactory TimeUnit)))
+
+(def default-timeout-seconds 120)
+
+(defn- env-val [env k]
+  (let [v (get env k)]
+    (when-not (str/blank? v) (str/trim v))))
+
+;; HTTP/1.1 on purpose, same reason as the old tbd.chat.core: the JDK client's default is to ask a
+;; plain-http server to upgrade to HTTP/2 (`Upgrade: h2c`), and LM Studio's server never answers
+;; that request, so the backend would wait out the whole timeout while the LLM sat idle.
+(defn- jdk-http-client-builder []
+  (-> (JdkHttpClientBuilder.)
+      (.httpClientBuilder (-> (HttpClient/newBuilder) (.version HttpClient$Version/HTTP_1_1)))))
+
+(defn- api-base-url
+  "`url` (the server's address, no path, see env-config) with the `/v1` LM Studio's OpenAI-compatible
+  endpoints live under: LangChain4j's OpenAI client posts straight to `<baseUrl>/chat/completions`,
+  it does not add this itself (its own default base url is `https://api.openai.com/v1`). Without
+  it, LM Studio answers 200 with a JSON error body langchain4j can't tell from an empty reply, so
+  every turn silently becomes \"the LLM server sent no reply\" instead of a clear error."
+  [url]
+  (if (str/ends-with? url "/v1") url (str url "/v1")))
+
+(defn- build-chat-model ^StreamingChatModel [{:keys [url model api-key timeout-seconds]}]
+  (let [builder (-> (OpenAiStreamingChatModel/builder)
+                    (.httpClientBuilder (jdk-http-client-builder))
+                    (.baseUrl (api-base-url url))
+                    (.apiKey (or api-key "not-needed"))
+                    (.timeout (Duration/ofSeconds timeout-seconds))
+                    ;; LM Studio's reasoning models send `reasoning_content`; this is what maps it
+                    ;; onto onPartialThinking instead of dropping it.
+                    (.returnThinking true))]
+    (when model (.modelName builder model))
+    (.build builder)))
+
+(defn env-config
+  "Chat config from environment variables:
+    LMSTUDIO_URL      where the LM Studio server is, e.g. http://192.168.1.20:1234 (chat is off without it)
+    LMSTUDIO_MODEL    the model id to ask for (optional: LM Studio uses the model that is loaded)
+    LMSTUDIO_API_KEY  sent as a bearer token, when the server wants one (optional)
+    LMSTUDIO_TIMEOUT_SECONDS  how long the server may stay silent before giving up (default 120)
+    CHAT_TRACE_FILE   a file to append a JSON trace of every turn to, with the model's full reasoning and
+                      replies and the messages it was sent (optional: without it, each turn is only
+                      summarised in the log)"
+  ([] (env-config (System/getenv)))
+  ([env]
+   (let [config {:url (some-> (env-val env "LMSTUDIO_URL") (str/replace #"/+$" ""))
+                 :model (env-val env "LMSTUDIO_MODEL")
+                 :api-key (env-val env "LMSTUDIO_API_KEY")
+                 :timeout-seconds (or (some-> (env-val env "LMSTUDIO_TIMEOUT_SECONDS") parse-long)
+                                      default-timeout-seconds)
+                 :trace (trace/config-for (env-val env "CHAT_TRACE_FILE"))}]
+     (assoc config :chat-model-delay (delay (build-chat-model config))))))
+
+(defn configured? [{:keys [url]}] (some? url))
+
+(defn- chat-model
+  "The config's `StreamingChatModel`: `:chat-model` directly, when a caller (a test) gives one, else
+  the one built from `:url`/`:model`/`:api-key`/`:timeout-seconds`, built once and reused."
+  ^StreamingChatModel [config]
+  (or (:chat-model config) (force (:chat-model-delay config))))
+
+;; --- Building the request ---
+
+(defn- llm-message
+  "One message of the conversation (see tbd.chat.schema/Message) as a LangChain4j ChatMessage."
+  ^ChatMessage [{:keys [role content tool-calls tool-call-id]}]
+  (case role
+    "user" (UserMessage/from ^String content)
+    "assistant" (if (seq tool-calls)
+                  (AiMessage/from (str content)
+                                  ^java.util.List
+                                  (mapv (fn [{:keys [id name arguments]}]
+                                          (-> (ToolExecutionRequest/builder)
+                                              (.id id) (.name name) (.arguments arguments)
+                                              .build))
+                                        tool-calls))
+                  (AiMessage/from ^String content))
+    "tool" (ToolExecutionResultMessage/toolExecutionResultMessage
+             ^String tool-call-id "" ^String content)))
+
+(defn- llm-tool
+  "An MCP tool's metadata as a function the LLM may call."
+  ^ToolSpecification [{:keys [name description inputSchema]}]
+  (let [builder (-> (ToolSpecification/builder)
+                    (.name name)
+                    (.parameters (json-schema/tool-parameters inputSchema)))]
+    (when description (.description builder description))
+    (.build builder)))
+
+(defn- chat-request ^ChatRequest [system-text messages tools]
+  (let [builder (-> (ChatRequest/builder)
+                    (.messages ^java.util.List (into [(SystemMessage/from ^String system-text)]
+                                                     (map llm-message) messages)))]
+    (when (seq tools)
+      (.toolSpecifications builder ^java.util.List (mapv llm-tool tools)))
+    (.build builder)))
+
+;; --- Reading the reply ---
+
+(def ^:private watchdog
+  (delay (doto (ScheduledThreadPoolExecutor.
+                 1 (reify ThreadFactory
+                     (newThread [_ r] (doto (Thread. ^Runnable r "chat-watchdog") (.setDaemon true)))))
+           (.setRemoveOnCancelPolicy true))))
+
+(defn- exception-detail [^Throwable e]
+  (str (class e) ": " (.getMessage e)))
+
+(defn- fail
+  ([text] (fail text nil))
+  ([text detail]
+   (println (cond-> (str "[tbd] chat: " text) detail (str " (" detail ")")))
+   text))
+
+(defn- streaming-handler
+  "A StreamingChatResponseHandler that pushes every callback onto `queue` as a map: {:content s},
+  {:thinking s}, {:tool-call {:id :name :arguments}} (once a call is fully assembled — LangChain4j
+  does the delta accumulation itself), {:complete response} or {:error throwable}. `handle!` is
+  called with the first StreamingHandle seen, so the caller can cancel a stuck stream."
+  ^StreamingChatResponseHandler [^LinkedBlockingQueue queue handle!]
+  (let [capture! (fn [^StreamingHandle h] (when h (handle! h)))]
+    ;; No type hints on the reify methods' params below: hinting an overloaded interface method's
+    ;; params (onPartialResponse/onPartialThinking/onPartialToolCall each have a 1- and a 2-arg
+    ;; overload) confuses Clojure's overload resolution (`NewInstanceMethod.parse`), which throws
+    ;; "Mismatched return type" instead of picking the right one. Arity alone disambiguates fine.
+    (reify StreamingChatResponseHandler
+      (onPartialResponse [_ partial ctx]
+        (capture! (.streamingHandle ^PartialResponseContext ctx))
+        (.put queue {:content (.text ^PartialResponse partial)})
+        nil)
+      (onPartialThinking [_ partial ctx]
+        (capture! (.streamingHandle ^PartialThinkingContext ctx))
+        (.put queue {:thinking (.text ^PartialThinking partial)})
+        nil)
+      (onPartialToolCall [_ _partial ctx]
+        (capture! (.streamingHandle ^PartialToolCallContext ctx))
+        nil)
+      (onCompleteToolCall [_ complete]
+        (let [req (.toolExecutionRequest ^CompleteToolCall complete)]
+          (.put queue {:tool-call {:id (.id req) :name (.name req) :arguments (.arguments req)}}))
+        nil)
+      (onCompleteResponse [_ response]
+        (.put queue {:complete response})
+        nil)
+      (onError [_ error]
+        (.put queue {:error error})
+        nil))))
+
+(defn- usage-of [^ChatResponse response]
+  (when-let [usage (.tokenUsage response)]
+    {:prompt_tokens (.inputTokenCount usage)
+     :completion_tokens (.outputTokenCount usage)
+     :total_tokens (.totalTokenCount usage)}))
+
+(defn- finish-reason-of [^ChatResponse response]
+  (some-> (.finishReason response) str str/lower-case))
+
+(defn- pump
+  "Drains `queue`, starting from the already-polled `first-item` (see `start`, which peeks one item
+  before deciding {:ok}/{:error}), calling `emit` with each event (see the ns docstring).
+  `timeout-seconds` of silence between items is an error, closing the stream via `handle-atom` (a
+  StreamingHandle, once one has arrived). An exception from `emit` (the client went away, say) ends
+  it too, closing the stream, and is rethrown. `tracer` (see tbd.chat.trace) sees everything the
+  LLM says, and how the turn ended, before the client is told."
+  [^LinkedBlockingQueue queue handle-atom timeout-seconds emit tracer first-item]
+  (let [timer (atom nil)
+        timed-out? (atom false)
+        cancel-stream! (fn []
+                         (when-let [^StreamingHandle h @handle-atom]
+                           (try (.cancel h) (catch Exception _ nil))))
+        arm! (fn []
+               (some-> ^ScheduledFuture @timer (.cancel false))
+               (reset! timer (.schedule ^ScheduledThreadPoolExecutor @watchdog
+                                        ^Runnable (fn [] (reset! timed-out? true) (cancel-stream!))
+                                        (long timeout-seconds) TimeUnit/SECONDS)))]
+    (arm!)
+    (try
+      (loop [item first-item
+             replied? false
+             calls []]
+        (cond
+          (:error item)
+          (let [^Throwable e (:error item)
+                text (if @timed-out?
+                       (fail "the LLM server took too long to answer" (str timeout-seconds "s of silence"))
+                       (fail "the LLM server can't be reached or refused" (exception-detail e)))]
+            (trace/finish! tracer {:outcome :error :error text :detail (exception-detail e)})
+            (emit {:error text}))
+
+          (:complete item)
+          (let [^ChatResponse response (:complete item)
+                ai (.aiMessage response)
+                calls (if (seq calls) calls
+                        (mapv (fn [^ToolExecutionRequest r]
+                                {:id (.id r) :name (.name r) :arguments (.arguments r)})
+                              (.toolExecutionRequests ai)))
+                ;; A provider that never streamed tokens (batched the whole reply) has its text
+                ;; only here, never through :content items above.
+                batched-text (when (and (not replied?) (empty? calls) (not (str/blank? (.text ai))))
+                               (.text ai))
+                event {:finish-reason (finish-reason-of response) :usage (usage-of response)}]
+            (trace/observe! tracer event)
+            (cond
+              (seq calls) (do (trace/finish! tracer {:outcome :tool-calls :calls calls})
+                              (emit {:tool-calls calls})
+                              (emit {:done true}))
+              batched-text (do (trace/finish! tracer {:outcome :done})
+                               (emit {:content batched-text})
+                               (emit {:done true}))
+              (or replied? (not (str/blank? (.text ai))))
+              (do (trace/finish! tracer {:outcome :done}) (emit {:done true}))
+              :else (let [text (fail "the LLM server sent no reply")]
+                      (trace/finish! tracer {:outcome :error :error text})
+                      (emit {:error text}))))
+
+          :else
+          (do (arm!)
+              (trace/observe! tracer (select-keys item [:content :thinking]))
+              (when-let [out (not-empty (select-keys item [:content :thinking]))] (emit out))
+              (recur (.take queue)
+                     (or replied? (contains? item :content))
+                     (cond-> calls (:tool-call item) (conj (:tool-call item)))))))
+      (finally
+        (trace/finish! tracer {:outcome :aborted})
+        (some-> ^ScheduledFuture @timer (.cancel false))
+        (cancel-stream!)))))
+
+(defn start
+  "Sends the LLM the conversation `messages` (see tbd.chat.schema/Message), and the `tools` it may
+  ask the caller to run (MCP's {:name :description :inputSchema}; none if nil), after `system-text`
+  (the agent's own system prompt, see tbd.agent.instructions — composed by the caller, not the
+  browser). Waits for the first sign of life from the model (a piece of its reply, or an error) so
+  that an LLM that is down or refuses is still a clean {:error text :kind :unavailable|:upstream},
+  not an error inside a stream that has already begun — the same contract the old hand-rolled HTTP
+  client gave, adapted to LangChain4j's async callbacks (which have no separate \"got the HTTP
+  response\" moment to block on the way a blocking HTTP client's `.send()` did). Otherwise {:ok
+  pump}: `(pump emit)` blocks until the reply is complete, calling `emit` with its events (see the
+  ns docstring). If `emit` throws, the request to the LLM is closed (which stops it generating) and
+  the exception is rethrown."
+  [{:keys [timeout-seconds trace] :as config} system-text messages tools]
+  (if-not (configured? config)
+    {:error "chat is not configured" :kind :unavailable}
+    (let [tracer (trace/begin! trace {:messages messages :tools tools :model (:model config)})
+          upstream-error (fn [text detail]
+                           (fail text detail)
+                           (trace/finish! tracer {:outcome :upstream-error :error text :detail detail})
+                           {:error text :kind :upstream})]
+      (try
+        (let [queue (LinkedBlockingQueue.)
+              handle-atom (atom nil)
+              handler (streaming-handler queue #(reset! handle-atom %))]
+          (.chat (chat-model config) (chat-request system-text messages tools) handler)
+          (if-let [first-item (.poll queue (long timeout-seconds) TimeUnit/SECONDS)]
+            (if (:error first-item)
+              (upstream-error "the LLM server can't be reached or refused" (exception-detail (:error first-item)))
+              {:ok (fn [emit] (pump queue handle-atom timeout-seconds emit tracer first-item))})
+            (upstream-error "the LLM server took too long to answer" (str timeout-seconds "s of silence"))))
+        (catch Exception e
+          (upstream-error "the LLM server can't be reached" (exception-detail e)))))))

src/tbd/agent/instructions.clj

@@ -0,0 +1,64 @@
+(ns tbd.agent.instructions
+  "The system prompts of the two agents tbd.agent.core drives: `chat`, for the in-page chatbot
+  behind /api/chat, and `a2a`, for the A2A server (tbd.agent.a2a) other agents call. Server-only
+  on purpose: unlike tbd.agent.prompt (a .cljc the browser bundle also needs, for WebMCP's
+  `guide`/`task`/`tic-tac-toe`), this ns is never on ui/shadow-cljs.edn's `:source-paths`, so the
+  chatbot's own instructions can never end up in the compiled UI. It reuses the wording that is
+  genuinely shared (`act`, `work-it-out`, `tic-tac-toe-rules`, `examples`) from tbd.agent.prompt
+  rather than duplicating it."
+  (:require [clojure.string :as str]
+            [tbd.agent.prompt :as prompt]))
+
+(defn chat
+  "The in-page chatbot's system prompt, the start of its system message: tbd.agent.core adds
+  where the user is and the tools it has. Its calls show under its message, so it answers in a
+  sentence and never repeats them."
+  []
+  (str "You are the assistant built into this web app. Your tools type, click and read on the page the\n"
+       "user is looking at, and every call shows on their screen the moment you make it.\n"
+       "\n"
+       prompt/act
+       (prompt/work-it-out (str "- Chain calls without stopping. The tool you need belongs to another page: navigate there, then\n"
+                                "  use it. You need an id: list first, then act. Never invent an id, a title or the state of the\n"
+                                "  page: read it with a tool.\n"))
+       "Then say one short plain sentence: \"Added it.\" \"That's 23.\" The call and its result are already\n"
+       "on screen under your message, so never repeat them, never paste JSON, never use markdown,\n"
+       "headings or bullet lists. Say something was done only if a tool result says it was.\n"
+       "\n"
+       "Some things are not tool work: greetings, questions about you, questions you can simply answer.\n"
+       "Answer those in a sentence or two, with no tool call. Asked what you can do, say it plainly from\n"
+       "the tools you have. Think briefly before you act.\n"
+       "\n"
+       prompt/tic-tac-toe-rules
+       prompt/examples))
+
+(defn chat-system-message
+  "`chat`'s prompt, with, last, where the user is (`page`) and the names of the `tools` on offer
+  there. The tools' names are in the request's `tools` too, but a model picks them more readily
+  when the instructions say them as well, and it can say what it can do without a call. One
+  message, and the first: several chat templates (Gemma's, Mistral's) refuse more than one system
+  message, or one that isn't first."
+  [page tools]
+  (cond-> (chat)
+    page (str "\n\nThe user is on the \"" page "\" page of the app: what it shows is what they can see.")
+    (seq tools) (str (if page " Its" "\n\nYour")
+                     " tools: " (str/join ", " (map :name tools))
+                     ". The tools of other pages are offered once you navigate there.")))
+
+(defn a2a
+  "The A2A server's system prompt: an outside agent calling this app directly, not through a
+  page, so it has no DOM to act on and no visual feedback to lean on. Its tools are the app's
+  server-side ones (tbd.mcp.tools, the same the MCP server offers), not a page's."
+  []
+  (str "You are tbd's agent, reachable over the Agent2Agent protocol. You act on behalf of the user\n"
+       "who authorized the caller, using the tools you were given: todo management and anything else\n"
+       "this server exposes as a tool. You have no page open and no visual feedback beyond what a tool\n"
+       "returns.\n"
+       "\n"
+       prompt/act
+       (prompt/work-it-out (str "- You need an id: list first, then act. Never invent an id, a title or the state of the data:\n"
+                                "  read it with a tool.\n"))
+       "Then report in one short plain sentence, from the tool results: \"Added it.\" \"That's 23.\" Don't\n"
+       "paste JSON, don't describe the tool call itself, just its outcome.\n"
+       "\n"
+       prompt/examples))

src/tbd/agent/json_schema.clj

@@ -0,0 +1,80 @@
+(ns tbd.agent.json-schema
+  "Translates a tool's `inputSchema` (plain JSON Schema, decoded to a Clojure map — see
+  tbd.chat.schema/Tool) into LangChain4j's typed `JsonSchemaElement` tree, which is what
+  `ToolSpecification.Builder/parameters` needs (dev.langchain4j.model.chat.request.json). The
+  browser is the one authoring these schemas (tbd.ui.webmcp), so this only has to cover the shapes
+  MCP-style tool schemas actually use: object/string/number/integer/boolean/array/enum, nested
+  arbitrarily. Anything else (a bare `:enum` without a `:type`, an unrecognized `:type`) falls back
+  to a permissive `JsonRawSchema` dump of the schema as JSON, rather than failing the request."
+  (:require [clojure.string :as str]
+            [muuntaja.core :as m])
+  (:import (dev.langchain4j.model.chat.request.json
+             JsonArraySchema JsonBooleanSchema JsonEnumSchema JsonIntegerSchema
+             JsonNumberSchema JsonObjectSchema JsonRawSchema JsonSchemaElement JsonStringSchema)))
+
+(defn- field
+  "`m`'s value at `k`, trying the keyword first (how muuntaja decodes JSON) then the string, so
+  this works whether or not something upstream keywordized the nested schema too."
+  [m k]
+  (or (get m (keyword k)) (get m (name k))))
+
+(defn- raw
+  "A schema element that isn't one of the shapes below: dumped as JSON and wrapped in
+  `JsonRawSchema` rather than dropped, so the LLM still sees it."
+  [schema]
+  (JsonRawSchema/from (slurp (m/encode "application/json" schema))))
+
+(declare of)
+
+(defn- object-schema ^JsonObjectSchema [schema]
+  (let [builder (JsonObjectSchema/builder)]
+    (doseq [[k v] (field schema :properties)]
+      (.addProperty builder (name k) (of v)))
+    (when-let [required (seq (field schema :required))]
+      (.required builder ^java.util.List (mapv name required)))
+    (when-let [d (field schema :description)]
+      (.description builder d))
+    (.build builder)))
+
+(defn- array-schema ^JsonArraySchema [schema]
+  (let [builder (JsonArraySchema/builder)]
+    (when-let [items (field schema :items)]
+      (.items builder (of items)))
+    (when-let [d (field schema :description)]
+      (.description builder d))
+    (.build builder)))
+
+(defn- enum-schema ^JsonEnumSchema [schema enum-values]
+  (let [builder (.enumValues (JsonEnumSchema/builder) ^java.util.List (mapv str enum-values))]
+    (when-let [d (field schema :description)]
+      (.description builder d))
+    (.build builder)))
+
+(defmacro ^:private simple-schema [ctor schema]
+  `(let [builder# (~ctor)]
+     (when-let [d# (field ~schema :description)]
+       (.description builder# d#))
+     (.build builder#)))
+
+(defn of
+  "`schema` (a JSON Schema map, keys keyword or string) as a `JsonSchemaElement`."
+  ^JsonSchemaElement [schema]
+  (if-not (map? schema)
+    (raw schema)
+    (let [type (some-> (field schema :type) name str/lower-case)
+          enum-values (field schema :enum)]
+      (cond
+        (and (seq enum-values) (or (nil? type) (= "string" type))) (enum-schema schema enum-values)
+        (= "object" type) (object-schema schema)
+        (= "array" type) (array-schema schema)
+        (= "string" type) (simple-schema #(JsonStringSchema/builder) schema)
+        (= "integer" type) (simple-schema #(JsonIntegerSchema/builder) schema)
+        (= "number" type) (simple-schema #(JsonNumberSchema/builder) schema)
+        (= "boolean" type) (simple-schema #(JsonBooleanSchema/builder) schema)
+        :else (raw schema)))))
+
+(defn tool-parameters
+  "A tool's MCP-style `inputSchema` (already validated as an object schema, see tbd.chat.schema/Tool)
+  as the `JsonObjectSchema` a `ToolSpecification` needs."
+  ^JsonObjectSchema [input-schema]
+  (object-schema input-schema))

src/tbd/auth/core.clj

@@ -0,0 +1,143 @@
+(ns tbd.auth.core
+  "Gitea OAuth2 (authorization-code flow) and the admin allowlist. No Ring here; the
+  routes and middleware own that."
+  (:require [clojure.string :as str]
+            [muuntaja.core :as m])
+  (:import (java.net URI URLEncoder)
+           (java.net.http HttpClient HttpRequest HttpResponse$BodyHandlers HttpRequest$BodyPublishers)
+           (java.nio.charset StandardCharsets)
+           (java.security MessageDigest SecureRandom)
+           (java.time Duration)
+           (java.util Base64)))
+
+(def ^:private http-client
+  (delay (-> (HttpClient/newBuilder) (.connectTimeout (Duration/ofSeconds 5)) .build)))
+
+(defn java-http
+  "Default `:http` fn: {:method :get|:post, :url, :headers, :body} -> {:status, :body}.
+  Configs can swap it out, which is how the tests stub Gitea."
+  [{:keys [method url headers body]}]
+  (let [builder (-> (HttpRequest/newBuilder (URI/create url)) (.timeout (Duration/ofSeconds 10)))]
+    (doseq [[k v] headers] (.header builder k v))
+    (case method
+      :get (.GET builder)
+      :post (.POST builder (HttpRequest$BodyPublishers/ofString body)))
+    (let [resp (.send ^HttpClient @http-client (.build builder) (HttpResponse$BodyHandlers/ofString))]
+      {:status (.statusCode resp) :body (.body resp)})))
+
+(defn- env-val [env k]
+  (let [v (get env k)]
+    (when-not (str/blank? v) (str/trim v))))
+
+(defn- strip-trailing-slashes [s]
+  (some-> s (str/replace #"/+$" "")))
+
+(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,
+                   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"))]
+     {: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"))
+      :secure-cookies? (boolean (some-> base-url (str/starts-with? "https://")))
+      :admin-users (->> (str/split (or (env-val env "ADMIN_USERS") "") #",")
+                        (map str/trim)
+                        (remove str/blank?)
+                        (map str/lower-case)
+                        set)
+      :session-secret (env-val env "SESSION_SECRET")
+      :http java-http})))
+
+(defn configured?
+  "True when everything needed to run the OAuth flow is set."
+  [config]
+  (every? config [:gitea-url :client-id :client-secret :redirect-uri]))
+
+(defn admin?
+  "Gitea usernames are case-insensitive, so the allowlist is compared lower-cased."
+  [config login]
+  (contains? (:admin-users config) (str/lower-case login)))
+
+(defn session-key
+  "Cookie stores need a 16-byte key; derive it from the secret, or make a throwaway one."
+  [secret]
+  (if secret
+    (byte-array (take 16 (.digest (MessageDigest/getInstance "SHA-256")
+                                  (.getBytes ^String secret StandardCharsets/UTF_8))))
+    (let [k (byte-array 16)]
+      (.nextBytes (SecureRandom.) k)
+      k)))
+
+(defn new-state
+  "Random OAuth `state`, tying the callback to the browser that started the login."
+  []
+  (let [bytes (byte-array 32)]
+    (.nextBytes (SecureRandom.) bytes)
+    (.encodeToString (.withoutPadding (Base64/getUrlEncoder)) bytes)))
+
+(defn state-matches? [expected actual]
+  (and (string? expected)
+       (string? actual)
+       (MessageDigest/isEqual (.getBytes ^String expected StandardCharsets/UTF_8)
+                              (.getBytes ^String actual StandardCharsets/UTF_8))))
+
+(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
+                     :redirect_uri redirect-uri
+                     :response_type "code"
+                     :state state})))
+
+(defn- parse-json [body]
+  (m/decode "application/json" body))
+
+(defn exchange-code
+  "Trades the authorization code for an access token; nil if Gitea refuses it."
+  [{:keys [gitea-url client-id client-secret redirect-uri http]} code]
+  (let [{:keys [status body]} (http {:method :post
+                                     :url (str gitea-url "/login/oauth/access_token")
+                                     :headers {"Content-Type" "application/x-www-form-urlencoded"
+                                               "Accept" "application/json"}
+                                     :body (form-encode {:grant_type "authorization_code"
+                                                         :client_id client-id
+                                                         :client_secret client-secret
+                                                         :redirect_uri redirect-uri
+                                                         :code code})})]
+    (when (= 200 status)
+      (:access_token (parse-json body)))))
+
+(defn fetch-user
+  "The Gitea user behind an access token as {:login :id}; nil if Gitea refuses the token."
+  [{:keys [gitea-url http]} token]
+  (let [{:keys [status body]} (http {:method :get
+                                     :url (str gitea-url "/api/v1/user")
+                                     :headers {"Authorization" (str "Bearer " token)
+                                               "Accept" "application/json"}})]
+    (when (= 200 status)
+      (let [{:keys [login id]} (parse-json body)]
+        (when login {:login login :id id})))))

src/tbd/auth/middleware.clj

@@ -0,0 +1,57 @@
+(ns tbd.auth.middleware
+  (:require [ring.middleware.session :refer [wrap-session]]
+            [ring.middleware.session.cookie :refer [cookie-store]]
+            [tbd.auth.core :as auth]
+            [tbd.http :refer [respond]]))
+
+(def session-ttl-ms (* 8 60 60 1000))
+
+(defn session-middleware
+  "Cookie-backed sessions (encrypted and signed, so nothing is stored server-side). Lax, not
+  Strict: the OAuth callback is a cross-site redirect from Gitea and must still carry the
+  cookie that holds the login `state`."
+  [handler config]
+  (wrap-session handler {:store (cookie-store {:key (auth/session-key (:session-secret config))})
+                         :cookie-name "tbd-session"
+                         :cookie-attrs {:http-only true
+                                        :same-site :lax
+                                        :secure (:secure-cookies? config)
+                                        :max-age (quot session-ttl-ms 1000)}}))
+
+(defn current-user
+  "The logged-in user from the session, or nil when there is none or it has expired. The
+  cookie is only a bearer of `:expires-at`, so the server enforces the lifetime here."
+  ([req] (current-user req (System/currentTimeMillis)))
+  ([req now]
+   (let [{:keys [expires-at] :as user} (get-in req [:session :user])]
+     (when (and user expires-at (< now expires-at))
+       user))))
+
+(defn admin-middleware
+  "Reitit middleware for routes whose data has `:admin? true`: 401 without a login, 403 when
+  the user isn't on the ADMIN_USERS allowlist. Passes the user on as `:user`. Mount it ahead
+  of the parsing/coercion middleware so unauthenticated callers never reach them."
+  [config]
+  {:name ::admin
+   :compile (fn [route-data _opts]
+              (when (:admin? route-data)
+                (fn [handler]
+                  (fn [req]
+                    (if-let [user (current-user req)]
+                      (if (auth/admin? config (:login user))
+                        (handler (assoc req :user user))
+                        (respond 403 {:error "admin access required"}))
+                      (respond 401 {:error "login required"}))))))})
+
+(def login-middleware
+  "Reitit middleware for routes whose data has `:login? true`: 401 without a login, otherwise
+  the user goes on as `:user` ({:login :id ...}). Like admin-middleware, mount it ahead of the
+  parsing/coercion middleware."
+  {:name ::login
+   :compile (fn [route-data _opts]
+              (when (:login? route-data)
+                (fn [handler]
+                  (fn [req]
+                    (if-let [user (current-user req)]
+                      (handler (assoc req :user user))
+                      (respond 401 {:error "login required"}))))))})

src/tbd/auth/routes.clj

@@ -0,0 +1,66 @@
+(ns tbd.auth.routes
+  (:require [ring.util.response :as response]
+            [tbd.auth.core :as auth]
+            [tbd.auth.middleware :as mw]
+            [tbd.http :refer [respond]]))
+
+(def ^:private not-configured
+  (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 parameters]}]
+    (if-not (auth/configured? config)
+      not-configured
+      (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 (cond-> (assoc session :oauth-state state)
+                              return-to (assoc :return-to return-to))))))))
+
+(defn- callback-handler [config]
+  (fn [{:keys [session parameters]}]
+    (let [{:keys [code state error]} (:query parameters)]
+      (cond
+        (not (auth/configured? config)) not-configured
+        (not (auth/state-matches? (:oauth-state session) state)) (respond 400 {:error "invalid OAuth state"})
+        error (respond 403 {:error "login was denied"})
+        (nil? code) (respond 400 {:error "missing authorization code"})
+        :else
+        (try
+          (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 (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"})))
+          (catch Exception e
+            (println "[tbd] Gitea login failed:" (.getMessage e))
+            (respond 502 {:error "could not complete login with Gitea"})))))))
+
+(defn- me-handler [config]
+  (fn [req]
+    (if-let [{:keys [login id]} (mw/current-user req)]
+      (respond 200 {:login login :id id :admin? (auth/admin? config login)})
+      (respond 401 {:error "login required"}))))
+
+(defn routes [config]
+  ["/auth"
+   ["/login" {:get {:tags ["auth"]
+                    :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 / (or the login's return_to)"
+                       :parameters {:query [:map
+                                            [:code {:optional true} :string]
+                                            [:state {:optional true} :string]
+                                            [:error {:optional true} :string]]}
+                       :handler (callback-handler config)}}]
+   ["/logout" {:post {:tags ["auth"]
+                      :summary "End the session"
+                      :handler (fn [_req]
+                                 (assoc (respond 200 {:logged-out true}) :session nil))}}]
+   ["/me" {:get {:tags ["auth"]
+                 :summary "The logged-in user (401 if not logged in)"
+                 :handler (me-handler config)}}]])

src/tbd/chat/routes.clj

@@ -0,0 +1,138 @@
+(ns tbd.chat.routes
+  "/api/chat: an AG-UI (Agent-User Interaction Protocol, https://docs.ag-ui.com) run. A caller
+  POSTs a RunAgentInput (tbd.chat.schema/RunAgentInput) and gets the agent's reply streamed back
+  as AG-UI's server-sent events: RUN_STARTED, then TEXT_MESSAGE_*/REASONING_MESSAGE_*/TOOL_CALL_*
+  as the model generates, then RUN_FINISHED or RUN_ERROR. The agent itself (its system prompt,
+  the LLM call, tool-call assembly) is tbd.agent.core; this ns only translates its internal event
+  shape ({:thinking}/{:content}/{:tool-calls}/{:done}/{:error}, see tbd.agent.core's ns docstring)
+  to and from AG-UI's wire format.
+
+  AG-UI's frontend-tool model — the agent asks for a call, the browser (tbd.ui.webmcp) runs it and
+  sends the result back as a `tool` message on the next run — is exactly the loop tbd.ui.events
+  already drove against the old bespoke SSE shape; nothing about that loop changes here."
+  (:require [muuntaja.core :as m]
+            [ring.core.protocols :as ring-protocols]
+            [tbd.agent.core :as agent]
+            [tbd.chat.schema :as schema]
+            [tbd.http :refer [respond]])
+  (:import (java.io IOException OutputStream)
+           (java.nio.charset StandardCharsets)))
+
+(def ^:private error-status {:unavailable 503 :upstream 502})
+
+(defn- sse-event
+  "One server-sent event: `event` (an AG-UI BaseEvent, a plain map with a `:type`) as JSON, on a
+  single line."
+  ^bytes [event]
+  (.getBytes (str "data: " (slurp (m/encode "application/json" event)) "\n\n") StandardCharsets/UTF_8))
+
+;; --- Internal pump events -> AG-UI events ---
+
+(defn- open-reasoning [{:keys [reasoning-id] :as state}]
+  (if (:reasoning-open? state)
+    [state []]
+    [(assoc state :reasoning-open? true)
+     [{:type "REASONING_START" :messageId reasoning-id}
+      {:type "REASONING_MESSAGE_START" :messageId reasoning-id :role "reasoning"}]]))
+
+(defn- close-reasoning [{:keys [reasoning-id] :as state}]
+  (if-not (:reasoning-open? state)
+    [state []]
+    [(assoc state :reasoning-open? false)
+     [{:type "REASONING_MESSAGE_END" :messageId reasoning-id}
+      {:type "REASONING_END" :messageId reasoning-id}]]))
+
+(defn- open-text [{:keys [text-id] :as state}]
+  (if (:text-open? state)
+    [state []]
+    [(assoc state :text-open? true)
+     [{:type "TEXT_MESSAGE_START" :messageId text-id :role "assistant"}]]))
+
+(defn- close-text [{:keys [text-id] :as state}]
+  (if-not (:text-open? state)
+    [state []]
+    [(assoc state :text-open? false)
+     [{:type "TEXT_MESSAGE_END" :messageId text-id}]]))
+
+(defn- close-all [state]
+  (let [[state text-events] (close-text state)
+        [state reasoning-events] (close-reasoning state)]
+    [state (into text-events reasoning-events)]))
+
+(defn- tool-call-events [{:keys [id name arguments]}]
+  [{:type "TOOL_CALL_START" :toolCallId id :toolCallName name}
+   {:type "TOOL_CALL_ARGS" :toolCallId id :delta (str arguments)}
+   {:type "TOOL_CALL_END" :toolCallId id}])
+
+(defn- ag-ui-events
+  "[state' events]: `state` ({:reasoning-id :text-id :reasoning-open? :text-open?}) and the AG-UI
+  events `event` (tbd.agent.core's internal shape) translates to, opening/closing the
+  reasoning/text message streams as the model switches between them."
+  [state {:keys [thinking content tool-calls done error]} thread-id run-id]
+  (cond
+    thinking (let [[state closed] (close-text state)
+                   [state opened] (open-reasoning state)]
+               [state (conj (into closed opened)
+                            {:type "REASONING_MESSAGE_CONTENT" :messageId (:reasoning-id state) :delta thinking})])
+
+    content (let [[state closed] (close-reasoning state)
+                  [state opened] (open-text state)]
+              [state (conj (into closed opened)
+                           {:type "TEXT_MESSAGE_CONTENT" :messageId (:text-id state) :delta content})])
+
+    tool-calls (let [[state closing] (close-all state)]
+                 [state (into closing (mapcat tool-call-events) tool-calls)])
+
+    done (let [[state closing] (close-all state)]
+           [state (conj closing {:type "RUN_FINISHED" :threadId thread-id :runId run-id})])
+
+    error (let [[state closing] (close-all state)]
+            [state (conj closing {:type "RUN_ERROR" :message error})])
+
+    :else [state []]))
+
+(defn- event-stream
+  "A response body that writes what `pump` (see tbd.agent.core/start) forwards, translated to AG-UI
+  events, flushing after every one so they arrive as they are generated. A browser that goes away
+  stops it, and the LLM's request with it."
+  [pump thread-id run-id]
+  (reify ring-protocols/StreamableResponseBody
+    (write-body-to-stream [_ _ out]
+      (let [state (atom {:reasoning-id (str (random-uuid)) :text-id (str (random-uuid))
+                         :reasoning-open? false :text-open? false})
+            write! (fn [event] (.write ^OutputStream out (sse-event event)) (.flush ^OutputStream out))]
+        (try
+          (write! {:type "RUN_STARTED" :threadId thread-id :runId run-id})
+          (pump (fn [internal-event]
+                  (let [[state' events] (ag-ui-events @state internal-event thread-id run-id)]
+                    (reset! state state')
+                    (run! write! events))))
+          (catch IOException _ nil))))))
+
+(defn- chat-handler [config]
+  (fn [{{{:keys [messages tools threadId runId] :as input} :body} :parameters}]
+    (let [thread-id (or threadId (str (random-uuid)))
+          run-id (or runId (str (random-uuid)))
+          system-text (schema/system-text input)
+          internal-messages (mapv schema/->internal-message messages)
+          internal-tools (mapv schema/->internal-tool tools)
+          {:keys [ok error kind]} (agent/start config system-text internal-messages internal-tools)]
+      (if error
+        (respond (error-status kind) {:error error})
+        {:status 200
+         :headers {"Content-Type" "text/event-stream; charset=utf-8"
+                   "Cache-Control" "no-cache"
+                   ;; nginx would otherwise hold the events back until the reply is over
+                   "X-Accel-Buffering" "no"}
+         :body (event-stream ok thread-id run-id)}))))
+
+(defn routes
+  "`config` is the agent config (see tbd.agent.core/env-config). Only logged-in users may chat:
+  every message costs the LLM server's time."
+  [config]
+  ["/api/chat"
+   {:post {:tags ["chat"]
+           :login? true
+           :summary "An AG-UI (https://docs.ag-ui.com) run: POST a RunAgentInput (the conversation so far, tools on offer, and `context` — the page the user is on travels as {\"description\":\"page\",\"value\":\"...\"}); the reply streams back as AG-UI server-sent events (RUN_STARTED, TEXT_MESSAGE_*/REASONING_MESSAGE_*/TOOL_CALL_* as the model generates, then RUN_FINISHED or RUN_ERROR). Failures before the run starts are ordinary errors: 400 for an invalid input, 502 if the LLM server can't be reached or refuses, 503 if the agent isn't configured"
+           :parameters {:body schema/RunAgentInput}
+           :handler (chat-handler config)}}])

src/tbd/chat/schema.clj

@@ -0,0 +1,124 @@
+(ns tbd.chat.schema
+  "The shape of /api/chat's request, as Malli schemas, coerced by tbd.chat.routes: an AG-UI
+  RunAgentInput (https://docs.ag-ui.com), the standard wire format for an agent↔frontend run. The
+  limits are what keeps the endpoint from being a free pipe to the LLM: a conversation is bounded
+  in length, and the UI (tbd.ui.events) sends no more than `max-messages` of it.
+
+  The conversation can hold the model's use of the page's tools (see tbd.ui.model-context): an
+  assistant message that asks for calls (`:toolCalls`), followed by one \"tool\" role message with
+  the result of each. Those are the browser's to say, so they are as bounded as the rest. Which
+  page the user is on travels as a `context` entry ({:description \"page\" :value \"todos\"}) rather
+  than a dedicated field — AG-UI's place for ambient, non-conversation information."
+  (:require [tbd.agent.instructions :as instructions]))
+
+(def max-messages 40)
+(def max-message-length 8000)
+
+(def max-tools 32)
+(def max-tool-calls 16)
+
+(def ^:private max-tool-schema-length
+  "How long a tool's metadata may be, printed: room for a tool of a dozen parameters."
+  5000)
+
+(defn- small? [tool]
+  (<= (count (pr-str tool)) max-tool-schema-length))
+
+(def Tool
+  "AG-UI's Tool: {name, description, parameters}. `parameters` is JSON Schema for the arguments,
+  which is the LLM's to read, so it is any (small) object."
+  [:and
+   [:map
+    [:name [:re #"^[a-zA-Z0-9_-]{1,64}$"]]
+    [:description {:optional true} [:string {:max 2000}]]
+    [:parameters {:optional true} [:map-of :keyword :any]]]
+   [:fn small?]])
+
+(def ^:private Id [:string {:min 1 :max 200}])
+
+(def FunctionCall
+  [:map
+   [:name [:string {:min 1 :max 200}]]
+   [:arguments [:string {:max 100000}]]])
+
+(def ToolCall
+  "AG-UI's ToolCall: a call the model asked for. Its name and arguments are the model's own
+  words: nothing says they are a tool of the page, or JSON, so they are only bounded, generously
+  (a conversation that the server refused would be stuck: the UI sends it again with the next
+  message)."
+  [:map
+   [:id Id]
+   [:type [:= "function"]]
+   [:function FunctionCall]])
+
+(def Message
+  "AG-UI's Message, narrowed to the roles this endpoint accepts from a caller: user, assistant
+  (optionally with `toolCalls`) and tool (answering one). `id` identifies the message within the
+  conversation (AG-UI requires it); this endpoint doesn't need it to be unique or stable, only
+  present."
+  [:multi {:dispatch :role}
+   ["user" [:map
+            [:id Id]
+            [:role [:= "user"]]
+            [:content [:string {:min 1 :max max-message-length}]]]]
+   ["assistant" [:and
+                 [:map
+                  [:id Id]
+                  [:role [:= "assistant"]]
+                  [:content {:optional true} [:string {:max max-message-length}]]
+                  [:toolCalls {:optional true} [:vector {:max max-tool-calls} ToolCall]]]
+                 [:fn (fn [{:keys [content toolCalls]}] (or (seq content) (seq toolCalls)))]]]
+   ["tool" [:map
+            [:id Id]
+            [:role [:= "tool"]]
+            [:toolCallId Id]
+            [:content [:string {:min 1 :max max-message-length}]]]]])
+
+(def Context
+  "AG-UI's Context: a named piece of ambient information for the run. The page the user is on is
+  sent as {:description \"page\" :value \"<page id>\"}."
+  [:map
+   [:description [:string {:max 200}]]
+   [:value [:string {:max 2000}]]])
+
+(def RunAgentInput
+  "AG-UI's RunAgentInput: the conversation so far, oldest first (`messages`), the tools on offer
+  for this run (`tools`), and ambient information (`context`, which is where `page` travels).
+  `threadId`/`runId` identify the run to the client; this server is stateless between turns (the
+  browser resends the whole conversation each time, see tbd.ui.events), so it only echoes them
+  back, never reads them."
+  [:map
+   [:threadId {:optional true} [:string {:max 200}]]
+   [:runId {:optional true} [:string {:max 200}]]
+   [:messages [:vector {:min 1 :max max-messages} Message]]
+   [:tools {:optional true} [:vector {:max max-tools} Tool]]
+   [:context {:optional true} [:vector {:max 8} Context]]])
+
+(defn page-of
+  "The `page` context entry's value, or nil."
+  [context]
+  (some #(when (= "page" (:description %)) (:value %)) context))
+
+(defn ->internal-tool
+  "An AG-UI Tool as the MCP-style {:name :description :inputSchema} tbd.agent.core and
+  tbd.agent.json-schema expect."
+  [{:keys [name description parameters]}]
+  (cond-> {:name name :inputSchema (or parameters {})}
+    description (assoc :description description)))
+
+(defn ->internal-message
+  "An AG-UI Message as tbd.agent.core's internal {:role :content :tool-calls :tool-call-id} (see
+  tbd.agent.core/llm-message)."
+  [{:keys [role content toolCalls toolCallId]}]
+  (cond-> {:role role :content content}
+    (seq toolCalls) (assoc :tool-calls
+                            (mapv (fn [{:keys [id function]}]
+                                    {:id id :name (:name function) :arguments (:arguments function)})
+                                  toolCalls))
+    toolCallId (assoc :tool-call-id toolCallId)))
+
+(defn system-text
+  "The agent's own system prompt for this run (see tbd.agent.instructions), never the caller's to
+  supply: only `page` (from `context`) and `tools` shape it."
+  [{:keys [tools context]}]
+  (instructions/chat-system-message (page-of context) tools))

src/tbd/chat/trace.clj

@@ -0,0 +1,284 @@
+(ns tbd.chat.trace
+  "Observability for the chatbot's LLM turns: what the model was asked, what it did with it, how long
+  it took, and whether it looks stuck. No Ring and no LLM here; tbd.agent.core (the chatbot's agent)
+  and tbd.agent.a2a (the A2A server) both call it.
+
+  One request to /api/chat, or one message to the A2A server, is one turn of the model. The loop that
+  runs the chatbot's tools lives in the browser
+  (tbd.ui.events): a tool's result comes back as a new request holding the conversation so far, so the
+  server keeps nothing between turns. A stuck agent shows up in two ways, and both are watched:
+
+  - within a turn, as reasoning that never ends (`:long-reasoning`) or that says the same sentence
+    again and again (`:repeated-thinking`);
+  - across turns, as the same tool call made over and over (`:repeated-call`), read off the
+    conversation each request carries.
+
+  Every turn is one `tracer`: `begin!` when the request goes out (logs `:turn-start`), `observe!` for
+  each event of the reply (logs a `:loop-suspect` when one of the above trips), `finish!` when it ends
+  (logs `:turn-end`, with the outcome, timings, sizes and flags). A tracer is for one thread, the one
+  that reads the reply.
+
+  Turns are correlated by `req` (one per turn) and `run` (a hash of the user's last message, the same
+  for every turn of the tool loop it started), with `step` counting the turns of the run from 0.
+
+  Entries are maps that go to a `sink`. `sink` prints each as one `[tbd] chat <event> k=v ...` line and,
+  if given a file, appends it there as JSON. Only the file has the text of the reasoning and the reply
+  (`:reasoning`, `:reply`) and the run's messages (`:input`): they are what you read to see why a
+  model is looping, and they are the user's words, so they are off unless a file is asked for
+  (CHAT_TRACE_FILE, see tbd.agent.core/env-config)."
+  (:require [clojure.java.io :as io]
+            [clojure.string :as str]
+            [muuntaja.core :as m])
+  (:import (java.time Instant)))
+
+(def reasoning-warn-chars
+  "Reasoning this long, without an answer or a call yet, is worth a look: a `:long-reasoning` entry
+  at this many characters, and again at each doubling."
+  8000)
+
+(def ^:private repeat-min-length
+  "Shorter sentences (\"Let me check.\") repeat in any reasoning; only longer ones say anything."
+  20)
+
+(def ^:private repeat-warn-count
+  "A sentence of the reasoning said this many times is a `:repeated-thinking`; and again at each doubling."
+  4)
+
+(def ^:private repeated-call-warn-count
+  "The same tool called with the same arguments this many times in one run is a `:repeated-call`."
+  3)
+
+(def ^:private max-distinct-sentences 5000)
+(def ^:private max-pending-chars 1000)
+(def ^:private max-args-length 500)
+(def ^:private sample-length 160)
+
+(defn- now-ms [] (quot (System/nanoTime) 1000000))
+
+(defn- truncate [s n]
+  (let [s (str s)]
+    (if (> (count s) n) (str (subs s 0 n) "…") s)))
+
+;; --- Reading the conversation ---
+
+(defn run-summary
+  "What the conversation `messages` (see tbd.chat.schema/Message) says about the tool loop it is in.
+  A run starts at the user's last message: `:run` is a short hash of it (the same for every turn of
+  the run, which is what ties their log lines together), `:step` how many assistant messages have
+  answered it so far (0 for the first turn), `:run-calls` how many tool calls those made,
+  `:top-call` {:tool :args :count} the call made most often (nil if none), and `:input` the messages
+  of the run, the user's first."
+  [messages]
+  (let [messages (vec messages)
+        user-at (last (keep-indexed (fn [i {:keys [role]}] (when (= "user" role) i)) messages))
+        input (if user-at (subvec messages user-at) messages)
+        answers (filter #(= "assistant" (:role %)) input)
+        calls (into [] (mapcat :tool-calls) answers)
+        [[tool args] n] (when (seq calls)
+                          (apply max-key val (frequencies (map (juxt :name :arguments) calls))))]
+    {:run (if user-at (format "%08x" (bit-and 0xffffffff (hash (:content (messages user-at))))) "-")
+     :step (count answers)
+     :run-calls (count calls)
+     :top-call (when tool {:tool tool :args args :count n})
+     :input input}))
+
+;; --- Watching the reply ---
+
+(defn- split-sentences
+  "[complete pending]: the sentences of `text` that are finished (a full stop, question or exclamation
+  mark, or a line break, ends one), and the rest, which the next piece of text may go on with."
+  [text]
+  (let [parts (str/split text #"(?<=[.!?])\s+|\n+" -1)
+        complete (pop parts)
+        pending (peek parts)]
+    (if (> (count pending) max-pending-chars)
+      [(conj complete pending) ""]
+      [complete pending])))
+
+(defn- repeat-milestone?
+  "True at the count that is worth a log line: `repeat-warn-count`, then each doubling of it."
+  [n]
+  (and (>= n repeat-warn-count)
+       (zero? (rem n repeat-warn-count))
+       (let [q (quot n repeat-warn-count)] (zero? (bit-and q (dec q))))))
+
+(defn- count-sentence
+  "[seen alerts], with `sentence` counted in `seen` ({normalized sentence count}); an alert if it
+  has now been said often enough. Case, spacing and the mark that ends it don't make a sentence
+  another: a model that loops varies those as it likes."
+  [[seen alerts] sentence]
+  (let [k (-> sentence str/trim str/lower-case (str/replace #"\s+" " ") (str/replace #"[.!?]+$" ""))]
+    (if (or (< (count k) repeat-min-length)
+            (and (not (contains? seen k)) (>= (count seen) max-distinct-sentences)))
+      [seen alerts]
+      (let [n (inc (get seen k 0))]
+        [(assoc seen k n)
+         (cond-> alerts
+           (repeat-milestone? n) (conj {:kind :repeated-thinking :count n
+                                        :text (truncate sentence sample-length)}))]))))
+
+(defn- think
+  "[state' alerts] after `text` of the model's reasoning."
+  [state text now full?]
+  (let [state (cond-> (-> state
+                          (update :thinking-events inc)
+                          (update :thinking-chars + (count text))
+                          (update :first-thinking-at #(or % now)))
+                full? (update :reasoning conj text))
+        [complete pending] (split-sentences (str (:pending state) text))
+        [seen alerts] (reduce count-sentence [(:seen state) []] complete)
+        chars (:thinking-chars state)
+        long? (>= chars (:next-long-warn state))]
+    [(cond-> (assoc state :pending pending :seen seen)
+       long? (update :next-long-warn * 2))
+     (cond-> alerts
+       long? (conj {:kind :long-reasoning :chars chars :elapsed-ms (- now (:t0 state))}))]))
+
+(defn- advance
+  "[state' alerts]: `state` after one event of the LLM's reply (the map tbd.agent.core/observe! is
+  called with: any of :content, :thinking, :finish-reason, :usage)."
+  [state {:keys [content thinking call-deltas finish-reason usage]} now full?]
+  (let [state (cond-> (-> state
+                          (update :events inc)
+                          (update :first-event-at #(or % now)))
+                content (-> (update :content-chars + (count content))
+                            (update :first-content-at #(or % now)))
+                (and content full?) (update :reply conj content)
+                (seq call-deltas) (update :first-call-at #(or % now))
+                finish-reason (assoc :finish-reason finish-reason)
+                usage (assoc :usage usage))]
+    (if (seq thinking)
+      (think state thinking now full?)
+      [state []])))
+
+;; --- Sinks: where entries go ---
+
+(def ^:private lock (Object.))
+
+(def ^:private field-order
+  [:req :run :step :kind :outcome :page :model :messages :tools :prompt-chars :run-calls :duration-ms
+   :ttft-ms :think-ms :events :thinking-chars :content-chars :finish-reason :prompt-tokens
+   :completion-tokens :count :chars :elapsed-ms :tool :args :text :calls :flags :error :detail])
+
+(def ^:private heavy-fields
+  "What only the trace file gets."
+  #{:reasoning :reply :input})
+
+(defn- render-field [k v]
+  (str (name k) "="
+       (cond
+         (keyword? v) (name v)
+         (= :calls k) (pr-str (str/join "; " (map (fn [{:keys [name args]}] (str name (truncate args 120))) v)))
+         (and (sequential? v) (every? keyword? v)) (str/join "," (map name v))
+         (and (string? v) (re-matches #"[\w./:@-]+" v)) v
+         :else (pr-str v))))
+
+(defn render
+  "An entry as the line the log gets: `[tbd] chat turn-end req=ab12cd34 outcome=done ...`. Without the
+  heavy fields (see the ns docstring), and without what is nil or empty."
+  [{:keys [event] :as entry}]
+  (let [order (zipmap field-order (range))
+        fields (->> (reduce dissoc entry (cons :event heavy-fields))
+                    (remove (fn [[_ v]] (or (nil? v) (and (coll? v) (empty? v)))))
+                    (sort-by (fn [[k _]] [(get order k (count field-order)) (name k)])))]
+    (str "[tbd] chat " (name event) (apply str (for [[k v] fields] (str " " (render-field k v)))))))
+
+(defn- json [data] (slurp (m/encode "application/json" data)))
+
+(defn sink
+  "A fn that takes entries: prints each with `render`, and appends it to `file`, if there is one, as a
+  line of JSON with a timestamp and all its fields. A file that can't be written to is complained
+  about, and never fails the chat."
+  [file]
+  (when file (io/make-parents (io/file file)))
+  (fn [entry]
+    (locking lock
+      (println (render entry))
+      (when file
+        (try (spit file (str (json (-> (into {} (remove (comp nil? val)) entry)
+                                       (assoc :ts (str (Instant/now)))))
+                             "\n")
+                   :append true)
+             (catch Exception e
+               (println "[tbd] chat: can't write the trace file" file (str "(" (.getMessage e) ")"))))))))
+
+(defn config-for
+  "The trace config (what `begin!` takes) for a trace file, or none if `file` is nil: the entries are
+  logged either way, and the text of the reasoning and the replies goes to the file only."
+  [file]
+  {:sink (sink file) :full-text? (some? file) :file file})
+
+(def default-config
+  "Log lines only."
+  (config-for nil))
+
+;; --- Tracing a turn ---
+
+(defn- log! [{:keys [sink ids]} event fields]
+  (try (sink (merge {:event event} ids fields))
+       (catch Throwable _ nil)))
+
+(defn begin!
+  "Starts tracing a turn, and logs `:turn-start`; `messages`, `tools` and `page` are the request's, and
+  `model` the LLM's, if the config names one. `trace` is a config of `config-for`, or nil for
+  `default-config`. Returns the tracer."
+  [trace {:keys [messages tools page model]}]
+  (let [{:keys [sink full-text?]} (or trace default-config)
+        {:keys [run step run-calls top-call input]} (run-summary messages)
+        tracer {:sink sink :full-text? full-text?
+                :ids {:req (subs (str (random-uuid)) 0 8) :run run :step step}
+                :state (atom {:t0 (now-ms) :events 0 :thinking-events 0 :thinking-chars 0
+                              :content-chars 0 :next-long-warn reasoning-warn-chars
+                              :seen {} :pending "" :reasoning [] :reply [] :flags #{}})}]
+    (log! tracer :turn-start
+          (cond-> {:page page :model model :messages (count messages) :tools (count tools)
+                   :prompt-chars (transduce (map #(count (:content %))) + 0 messages)
+                   :run-calls run-calls}
+            full-text? (assoc :input input)))
+    (when (and top-call (>= (:count top-call) repeated-call-warn-count))
+      (log! tracer :loop-suspect {:kind :repeated-call :tool (:tool top-call) :count (:count top-call)
+                                  :args (truncate (:args top-call) sample-length)}))
+    tracer))
+
+(defn observe!
+  "Takes one event of the LLM's reply (see tbd.agent.core, whose pump calls this: :content, :thinking,
+  or, at the end of a turn, :finish-reason and :usage), logging a `:loop-suspect` if the reasoning has
+  gone on for long, or is repeating itself."
+  [{:keys [state full-text?] :as tracer} event]
+  (let [[state' alerts] (advance @state event (now-ms) full-text?)]
+    (reset! state (update state' :flags into (map :kind) alerts))
+    (doseq [alert alerts]
+      (log! tracer :loop-suspect alert))))
+
+(defn finish!
+  "Ends the turn, logging `:turn-end`; only the first call does anything, so it is safe to call
+  again in a `finally`. `outcome` is a map: {:outcome :done | :tool-calls | :error | :upstream-error
+  | :aborted, :calls [{:name :arguments}] for :tool-calls, :error text and :detail text for the
+  failures}. :aborted is a turn that just stopped (the client went away, or something threw)."
+  [{:keys [state full-text?] :as tracer} {:keys [outcome calls error detail]}]
+  (let [s @state]
+    (when-not (:finished? s)
+      (swap! state assoc :finished? true)
+      (let [now (now-ms)
+            {:keys [t0 first-event-at first-thinking-at first-content-at first-call-at usage]} s
+            answered-at (or first-content-at first-call-at)
+            flags (cond-> (:flags s) (= "length" (:finish-reason s)) (conj :truncated))]
+        (log! tracer :turn-end
+              (cond-> {:outcome outcome
+                       :duration-ms (- now t0)
+                       :ttft-ms (some-> first-event-at (- t0))
+                       :think-ms (when first-thinking-at (- (or answered-at now) first-thinking-at))
+                       :events (:events s)
+                       :thinking-chars (:thinking-chars s)
+                       :content-chars (:content-chars s)
+                       :finish-reason (:finish-reason s)
+                       :prompt-tokens (:prompt_tokens usage)
+                       :completion-tokens (:completion_tokens usage)
+                       :calls (mapv (fn [{:keys [name arguments]}]
+                                      {:name name :args (truncate arguments max-args-length)})
+                                    calls)
+                       :error error
+                       :detail detail
+                       :flags (vec (sort flags))}
+                full-text? (assoc :reasoning (str/join (:reasoning s))
+                                  :reply (str/join (:reply s)))))))))

src/tbd/core.clj

@@ -1,14 +1,36 @@
 (ns tbd.core
-  (:require [ring.adapter.jetty :as jetty]
+  (:require [clojure.string :as str]
+            [ring.adapter.jetty :as jetty]
             [ring.middleware.defaults :refer [wrap-defaults api-defaults]]
             [ring.middleware.head :refer [wrap-head]]
             [reitit.ring :as ring]
             [reitit.swagger :as swagger]
             [reitit.swagger-ui :as swagger-ui]
+            [reitit.coercion]
+            [reitit.coercion.malli :as malli]
+            [reitit.ring.coercion :as coercion]
+            [reitit.ring.middleware.exception :as exception]
             [reitit.ring.middleware.muuntaja :as muuntaja-middleware]
+            [reitit.ring.middleware.parameters :as parameters]
             [muuntaja.core :as m]
+            [ring.util.response :as response]
+            [tbd.agent.a2a :as a2a]
+            [tbd.agent.core :as agent]
+            [tbd.auth.core :as auth]
+            [tbd.auth.middleware :as auth-mw]
+            [tbd.auth.routes :as auth-routes]
+            [tbd.chat.routes :as chat-routes]
             [tbd.health.routes :as health]
-            [tbd.math.routes :as math]))
+            [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.sqlite :as sqlite]
+            [tbd.todo.db :as todo-db]
+            [tbd.todo.routes :as todo-routes]))
 
 (defn- swagger-handler
   "reitit emits `\"definitions\": null` when no route declares a schema, which
@@ -21,31 +43,93 @@
           (and (map? (:body resp)) (nil? (:definitions (:body resp))))
           (update :body dissoc :definitions))))))
 
+(defn- coercion-error-handler
+  "Invalid request params -> 400, in the same shape (and format) the routes use."
+  [e _req]
+  (http/respond 400 {:error "invalid request parameters"
+                     :details (:humanized (reitit.coercion/encode-error (ex-data e)))}))
+
+(defn- index-handler
+  "The HTML shell for the re-frame UI (ui/); it loads the compiled JS from /js. With a WebMCP
+  origin-trial token it also sends it as an `Origin-Trial` header, which is how Chrome enables the
+  trial for this origin before any script runs."
+  [{:keys [origin-trial-token]}]
+  (fn [_req]
+    (cond-> (-> (response/resource-response "public/index.html")
+                (response/content-type "text/html; charset=utf-8"))
+      (seq origin-trial-token) (response/header "Origin-Trial" origin-trial-token))))
+
+(defn- decode-error-handler
+  "A request body that isn't valid for its Content-Type -> 400, in the same shape (and format) the routes use."
+  [_e _req]
+  (http/respond 400 {:error "malformed request body"}))
+
+(def ^:private exception-middleware
+  (exception/create-exception-middleware
+    (assoc exception/default-handlers
+           :reitit.coercion/request-coercion coercion-error-handler
+           :muuntaja/decode decode-error-handler)))
+
 ;; Each logical group (health, users, orders, ...) owns a `tbd.<group>.routes`
 ;; namespace that returns its own route subtree; they're concatenated here.
-(def router
-  (ring/router
-    [["/swagger.json"
-      {:get {:no-doc true
-             :swagger {:info {:title "tbd API" :version "1.0.0"}}
-             :handler (swagger-handler)}}]
-     ["/" {:get {:no-doc true
-                 :handler (fn [_req]
-                            {:status 200
-                             :headers {"Content-Type" "text/plain; charset=utf-8"}
-                             :body "tbd API — see /api-docs for documentation, /swagger.json for the spec"})}}]
-     (health/routes)
-     (math/routes)]
-    {:data {:muuntaja m/instance
-            :middleware [muuntaja-middleware/format-middleware]}}))
+(defn make-router [{:keys [auth nrepl db webmcp chat]}]
+  ;; One database for every group's tables, opened (and migrated) on first use, not when the app loads.
+  (let [ds (delay (sqlite/open (:db-path db) todo-db/migrate! oauth-db/migrate!))]
+    (ring/router
+      [["/swagger.json"
+        ;; The spec is JSON, whatever the API default is (Swagger UI can't read EDN).
+        {:muuntaja m/instance
+         :get {:no-doc true
+               :swagger {:info {:title "tbd API" :version "1.0.0"}}
+               :handler (swagger-handler)}}]
+       ["/" {:get {:no-doc true
+                   :handler (index-handler webmcp)}}]
+       (health/routes)
+       (math/routes)
+       (mcp-routes/routes auth ds)
+       (a2a/routes auth ds chat)
+       (oauth-routes/routes auth ds)
+       (auth-routes/routes auth)
+       (chat-routes/routes chat)
+       (nrepl-routes/routes nrepl)
+       (todo-routes/routes ds)]
+      {:data {:muuntaja http/muuntaja
+              :coercion malli/coercion
+              ;; Handlers (and the auth/error middleware) return plain data; the muuntaja
+              ;; middleware encodes it as the Accept header asks, so it wraps everything else.
+              ;; Auth comes next, so unauthenticated callers to `:admin? true` / `:login? true`
+              ;; routes are turned away before any body parsing or coercion runs. The request
+              ;; half of muuntaja is split off below the exception middleware (rather than using the
+              ;; combined format-middleware) so a malformed request body is caught and answered with a 400.
+              :middleware [muuntaja-middleware/format-negotiate-middleware
+                           muuntaja-middleware/format-response-middleware
+                           (auth-mw/admin-middleware auth)
+                           auth-mw/login-middleware
+                           parameters/parameters-middleware
+                           exception-middleware
+                           muuntaja-middleware/format-request-middleware
+                           coercion/coerce-request-middleware]}})))
 
-(def app
+(defn make-app [{:keys [auth] :as config}]
   (-> (ring/ring-handler
-        router
+        (make-router config)
         (ring/routes
           (swagger-ui/create-swagger-ui-handler {:path "/api-docs"})
+          ;; Compiled UI (script/ui-build writes resources/public/js).
+          (ring/create-resource-handler {:path "/js" :root "public/js"})
           (ring/create-default-handler)))
-      wrap-head))
+      wrap-head
+      http/wrap-browser-viewable-edn
+      (auth-mw/session-middleware auth)))
+
+(def config
+  {:auth (auth/env-config)
+   :nrepl (nrepl/env-config)
+   :chat (agent/env-config)
+   :db (sqlite/env-config)
+   :webmcp {:origin-trial-token (some-> (System/getenv "WEBMCP_ORIGIN_TRIAL_TOKEN") str/trim not-empty)}})
+
+(def app (make-app config))
 
 (defn add-shutdown-hook [server]
   (.addShutdownHook
@@ -56,6 +140,16 @@
   (let [port (Integer/parseInt (str (or (System/getenv "PORT")
                                          (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, 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])
+      (println "[tbd] WARNING: SESSION_SECRET is not set; logins won't survive a restart"))
+    (when-not (agent/configured? (:chat config))
+      (println "[tbd] LMSTUDIO_URL is not set; the chatbot is unavailable"))
+    (when-let [file (get-in config [:chat :trace :file])]
+      (println (str "[tbd] chat: tracing every turn, reasoning and replies included, to " file)))
     (try
       (let [server (jetty/run-jetty (wrap-defaults app api-defaults)
                                     {:port port

src/tbd/http.clj

@@ -0,0 +1,31 @@
+(ns tbd.http
+  (:require [muuntaja.core :as m]))
+
+(def muuntaja
+  "Content negotiation for the API. The request body is decoded by its Content-Type and the
+  response is encoded by the Accept header: JSON, EDN or Transit. When a request doesn't say
+  (no Content-Type, no Accept, or an Accept nothing here satisfies, like `*/*`) it is EDN."
+  (m/create
+    (-> m/default-options
+        (assoc :default-format "application/edn")
+        (assoc-in [:http :extract-content-type]
+                  #(or (m/extract-content-type-ring %) "application/edn")))))
+
+(defn respond
+  "A response whose `body` is plain data; the muuntaja middleware encodes it as the client asked."
+  [status body]
+  {:status status :body body})
+
+(defn wrap-browser-viewable-edn
+  "Browsers download `application/edn` instead of showing it. When the request comes from a
+  browser navigation (Accept includes text/html), relabel EDN responses as text/plain so they
+  render inline. Programmatic clients (fetch, curl, ...) still get `application/edn`."
+  [handler]
+  (fn [req]
+    (let [resp (handler req)
+          accept (get-in req [:headers "accept"] "")
+          content-type (get-in resp [:headers "Content-Type"] "")]
+      (if (and (re-find #"text/html" accept)
+               (.startsWith ^String content-type "application/edn"))
+        (assoc-in resp [:headers "Content-Type"] "text/plain; charset=utf-8")
+        resp))))

src/tbd/math/routes.clj

@@ -1,24 +1,14 @@
 (ns tbd.math.routes
-  (:require [tbd.math.core :as math]))
+  (:require [tbd.http :as http]
+            [tbd.math.core :as math]
+            [tbd.math.schema :as schema]))
 
-(defn- parse-num [s]
-  (when s
-    (or (parse-long s) (parse-double s))))
-
-(defn- edn-response [status body]
-  {:status status
-   :headers {"Content-Type" "application/edn; charset=utf-8"}
-   :body (pr-str body)})
-
-(defn- add-handler [{:keys [query-params]}]
-  (let [x (parse-num (get query-params "x"))
-        y (parse-num (get query-params "y"))]
-    (if (and x y)
-      (edn-response 200 {:result (math/add x y)})
-      (edn-response 400 {:error "x and y query params are required and must be numbers"}))))
+(defn- add-handler [{{{:keys [x y]} :query} :parameters}]
+  (http/respond 200 {:result (math/add x y)}))
 
 (defn routes []
   ["/api/add"
    {:get {:tags ["math"]
           :summary "Add two numbers (?x=2&y=3 => {:result 5})"
+          :parameters {:query schema/Add}
           :handler add-handler}}])

src/tbd/math/schema.clj

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

src/tbd/mcp/routes.clj

@@ -0,0 +1,51 @@
+(ns tbd.mcp.routes
+  "The MCP server, run as part of this server: plumcp's Streamable HTTP transport as a Ring
+  handler mounted at `/mcp`. Point an MCP client at <BASE_URL>/mcp. The tools it offers are in
+  tbd.mcp.tools. Every request needs an OAuth access token from tbd's own authorization server
+  (tbd.oauth.routes); tbd.oauth.middleware checks it and tells the tools who is calling."
+  (:require [plumcp.core.api.entity-support :as es]
+            [plumcp.core.deps.runtime :as rt]
+            [plumcp.core.server.http-ring :as mcp-http]
+            [plumcp.core.server.server-support :as mcp-server]
+            [plumcp.core.support.traffic-logger :as traffic-logger]
+            [tbd.mcp.tools :as tools]
+            [tbd.oauth.middleware :as oauth-mw]))
+
+(defn- wrap-runtime
+  "`handler` with `bindings` added to the plumcp runtime bag of every request, for the tools to use."
+  [handler bindings]
+  (fn [req] (handler (rt/upsert-runtime req bindings))))
+
+(defn make-handler
+  "A Ring handler speaking MCP over Streamable HTTP, for callers with a valid access token
+  (`auth` is the auth config, `ds` a delay of the app's 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]
+  (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/ds-key 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]
+  (let [handler (make-handler auth ds)]
+    ["/mcp"
+     ;; plumcp does its own content negotiation, JSON parsing and (via the wrapper above) body
+     ;; reading, so it must not sit behind the API's muuntaja/coercion middleware chain. ^:replace
+     ;; drops the router-wide :middleware for this route instead of adding to it.
+     {:middleware ^:replace []
+      :no-doc true
+      ;; No :get on purpose. That is MCP's optional server-to-client SSE stream, and the spec lets
+      ;; a server answer it with 405. Under Jetty it would also hang: the response headers aren't
+      ;; sent until the first event, and every open stream holds a thread. None of the tools push
+      ;; anything, so nothing is lost. Add :get here if one ever needs to (and test it against Jetty).
+      :post {:handler handler}
+      :delete {:handler handler}}]))

src/tbd/mcp/schema.clj

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

src/tbd/mcp/tools.clj

@@ -0,0 +1,74 @@
+(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: pure functions
+  (tbd.<group>.core) or, for a group with storage, its service (tbd.<group>.service), which the
+  HTTP routes call too. A tool has no rules of its own and never touches a database. 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.schema :as todo-schema]
+            [tbd.todo.service :as todo]))
+
+(def ds-key
+  "Where the database (a delay, as for the HTTP routes) is in the request's plumcp runtime bag;
+  tbd.mcp.routes puts it there."
+  :tbd/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 service result, or throws its error (which reaches the model as an error result)."
+  [{:keys [ok error]}]
+  (if error (throw (ex-info error {})) ok))
+
+;; Todos belong to the caller, and tbd.todo.service scopes every operation to them.
+(defn- ds [ctx] (ctx-get ctx ds-key))
+
+(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 (ok! (todo/list-todos (ds ctx) (current-user ctx))))))
+
+    (tool "get_todo" "Gets one of your todos by id (JSON)" todo-schema/IdParam
+          (fn [{:keys [id]} ctx] (->json (ok! (todo/find-todo (ds ctx) (current-user ctx) id)))))
+
+    (tool "create_todo" "Creates a todo for you and returns it (JSON)" todo-schema/NewTodo
+          (fn [{:keys [title]} ctx] (->json (ok! (todo/create! (ds ctx) (current-user ctx) title)))))
+
+    (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]
+            (->json (ok! (todo/update! (ds ctx) (current-user ctx) id (dissoc input :id))))))
+
+    (tool "delete_todo" "Deletes one of your todos" todo-schema/IdParam
+          (fn [{:keys [id]} ctx]
+            (ok! (todo/delete! (ds ctx) (current-user ctx) id))
+            "deleted"))]})

src/tbd/nrepl/core.clj

@@ -0,0 +1,67 @@
+(ns tbd.nrepl.core
+  "The on-demand nREPL debug server. No HTTP here."
+  (:require [clojure.string :as str]
+            [nrepl.server :as nrepl])
+  (:import (java.net InetAddress InetSocketAddress Socket)))
+
+(def default-port 7888)
+
+;; nREPL has no authentication and evaluates arbitrary code, so it only listens on loopback
+;; unless the operator explicitly opens it up.
+(def default-bind "127.0.0.1")
+
+(defn env-config
+  "NREPL_PORT (default 7888) and NREPL_BIND (default 127.0.0.1)."
+  ([] (env-config (System/getenv)))
+  ([env]
+   (let [port (get env "NREPL_PORT")
+         bind (get env "NREPL_BIND")]
+     {:port (if (str/blank? port) default-port (parse-long (str/trim port)))
+      :bind (if (str/blank? bind) default-bind (str/trim bind))})))
+
+(defonce ^:private state (atom nil))
+
+(defn status []
+  (if-let [{:keys [port bind]} @state]
+    {:enabled true :bind bind :port port}
+    {:enabled false}))
+
+(defn enable!
+  "Starts the server if it isn't running (a no-op otherwise); returns the status. Port 0
+  picks a free port, and the status reports the one actually bound."
+  [{:keys [port bind]}]
+  (locking state
+    (when-not @state
+      (let [server (nrepl/start-server :port port :bind bind)]
+        (reset! state {:server server :bind bind :port (:port server)})))
+    (status)))
+
+(defn- accepting?
+  "True if something takes connections on `bind`:`port` (a wildcard bind is probed via loopback)."
+  [bind port]
+  (let [addr (InetAddress/getByName bind)
+        addr (if (.isAnyLocalAddress addr) (InetAddress/getLoopbackAddress) addr)]
+    (try (with-open [s (Socket.)]
+           (.connect s (InetSocketAddress. addr (int port)) 200)
+           true)
+         (catch java.io.IOException _ false))))
+
+(defn- await-closed
+  "Blocks until `bind`:`port` refuses connections, for up to two seconds. Closing a server socket
+  doesn't stop the kernel queueing connections while the accept loop is still blocked in accept(),
+  so for a moment after `stop-server` the port can still be connected to."
+  [bind port]
+  (let [deadline (+ (System/nanoTime) 2000000000)]
+    (while (and (accepting? bind port) (< (System/nanoTime) deadline))
+      (Thread/sleep 5))))
+
+(defn disable!
+  "Stops the server if it's running, and returns once its port really refuses connections;
+  returns the status."
+  []
+  (locking state
+    (when-let [{:keys [server bind port]} @state]
+      (nrepl/stop-server server)
+      (await-closed bind port)
+      (reset! state nil))
+    (status)))

src/tbd/nrepl/routes.clj

@@ -0,0 +1,31 @@
+(ns tbd.nrepl.routes
+  (:require [tbd.http :refer [respond]]
+            [tbd.nrepl.core :as nrepl]))
+
+(defn- toggle-handler [config]
+  (fn [{{{:keys [enabled]} :body} :parameters {:keys [login]} :user}]
+    (try
+      (let [status (if enabled (nrepl/enable! config) (nrepl/disable!))]
+        (println (format "[tbd] nREPL %s by %s%s"
+                         (if enabled "enabled" "disabled")
+                         login
+                         (if enabled (format " on %s:%d" (:bind status) (:port status)) "")))
+        (respond 200 status))
+      (catch Exception e
+        (println "[tbd] nREPL toggle failed:" (.getMessage e))
+        (respond 500 {:error (str "could not change nREPL state: " (.getMessage e))})))))
+
+(defn- status-handler [_req]
+  (respond 200 (nrepl/status)))
+
+(defn routes [config]
+  ["/nrepl"
+   {:get {:tags ["admin"]
+          :summary "Read whether the nREPL debug server is on or off (admin only)"
+          :admin? true
+          :handler status-handler}
+    :post {:tags ["admin"]
+           :summary "Enable or disable the nREPL debug server (admin only)"
+           :admin? true
+           :parameters {:body [:map [:enabled {:description "true starts the server, false stops it"} :boolean]]}
+           :handler (toggle-handler config)}}])

src/tbd/oauth/core.clj

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

src/tbd/oauth/db.clj

@@ -0,0 +1,129 @@
+(ns tbd.oauth.db
+  "SQLite persistence for the MCP OAuth server, in the app's database (see tbd.sqlite). 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]
+            [next.jdbc :as jdbc]
+            [next.jdbc.result-set :as rs]
+            [tbd.sqlite :as sqlite]))
+
+;; 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. `id` is a
+;; UUID (see tbd.sqlite/new-id); `user_id` is the user's id in Gitea, which the app doesn't issue.
+(def ^:private create-grants
+  "CREATE TABLE IF NOT EXISTS grants (
+     id                 TEXT    PRIMARY KEY,
+     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)")
+
+(defn migrate!
+  "Creates the OAuth tables in the database `ds`, or brings them up to date."
+  [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)"])
+  (sqlite/migrate-integer-id! ds "grants" create-grants)
+  (jdbc/execute! ds [create-grants])
+  (jdbc/execute! ds ["CREATE INDEX IF NOT EXISTS grants_by_client ON grants (client_id)"]))
+
+(defn open
+  "A database with just the OAuth tables, at `path`; the app opens one with every group's tables
+  (see tbd.core), which this is for tests of the group on its own."
+  [path]
+  (sqlite/open path 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 (id, client_id, user_id, login, scope, access_hash, access_expires_at,
+                                          refresh_hash, refresh_expires_at, created_at)
+                      VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"
+                     (sqlite/new-id) client-id user-id login scope access-hash access-expires-at
+                     refresh-hash refresh-expires-at created-at]))
+
+(defn find-grant-by-access
+  "The grant whose current access token has this hash and hasn't expired at `now`, or nil."
+  [ds hash now]
+  (jdbc/execute-one! ds ["SELECT * FROM grants WHERE access_hash = ? AND access_expires_at > ?" hash now] opts))
+
+(defn find-grant-by-refresh
+  "The grant whose current refresh token has this hash, or nil (expiry is for the caller to judge)."
+  [ds hash]
+  (jdbc/execute-one! ds ["SELECT * FROM grants WHERE refresh_hash = ?" hash] opts))
+
+(defn rotate-grant!
+  "Swaps in a new access and refresh token for the grant, but only while `old-refresh-hash` is
+  still its refresh token, so a refresh token works once. Returns the grant, or nil if it lost."
+  [ds id old-refresh-hash {:keys [access-hash access-expires-at refresh-hash refresh-expires-at]}]
+  (jdbc/execute-one! ds ["UPDATE grants SET access_hash = ?, access_expires_at = ?,
+                                            refresh_hash = ?, refresh_expires_at = ?
+                          WHERE id = ? AND refresh_hash = ? RETURNING *"
+                         access-hash access-expires-at refresh-hash refresh-expires-at id old-refresh-hash]
+                     opts))
+
+(defn delete-grant! [ds id]
+  (jdbc/execute! ds ["DELETE FROM grants WHERE id = ?" id]))

src/tbd/oauth/middleware.clj

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

src/tbd/oauth/routes.clj

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

src/tbd/sqlite.clj

@@ -0,0 +1,62 @@
+(ns tbd.sqlite
+  "The app's one SQLite database, which every group with storage (tbd.todo.db, tbd.oauth.db)
+  keeps its tables in: where it lives, opening it, the ids of the rows the groups own, and
+  moving a table off the integer ids it used to have."
+  (:require [clojure.java.io :as io]
+            [clojure.string :as str]
+            [next.jdbc :as jdbc]
+            [next.jdbc.result-set :as rs]))
+
+(def default-path "data/tbd.db")
+
+(defn env-config
+  "DB_PATH: where the SQLite file lives (default data/tbd.db; its directory is created)."
+  ([] (env-config (System/getenv)))
+  ([env]
+   (let [path (get env "DB_PATH")]
+     {:db-path (if (str/blank? path) default-path (str/trim path))})))
+
+(defn open
+  "A datasource for the database file at `path`, created if need be and migrated by each of
+  `migrations` (fns of the datasource, each creating and updating a group's own tables). Each
+  query opens its own connection (cheap for a local file); WAL mode plus a busy timeout let
+  concurrent requests wait on each other's writes instead of failing."
+  [path & migrations]
+  (when (str/blank? path)
+    (throw (ex-info "no database path configured (set DB_PATH)" {})))
+  (some-> (io/file path) .getAbsoluteFile .getParentFile .mkdirs)
+  (let [ds (jdbc/get-datasource {:dbtype "sqlite" :dbname path
+                                 :journal_mode "WAL" :busy_timeout 5000})]
+    (run! #(% ds) migrations)
+    ds))
+
+(defn new-id
+  "An id for a row this app owns: a random UUID, as lowercase text. Never an integer: an LLM that
+  reads `7` as a todo's id confuses it with a 7 in a title, and a UUID is nothing else."
+  []
+  (str (random-uuid)))
+
+(defn- integer-id? [tx table]
+  (boolean
+    (some (fn [{:keys [name type]}] (and (= "id" name) (= "INTEGER" (str/upper-case type))))
+          (jdbc/execute! tx [(str "PRAGMA table_info(" table ")")]
+                         {:builder-fn rs/as-unqualified-maps}))))
+
+(defn migrate-integer-id!
+  "If `table` still has the INTEGER id it was first created with, recreates it with `create-sql`
+  (its current definition, an id TEXT PRIMARY KEY) and gives each row a UUID, keeping the
+  rows' order and everything else in them. Does nothing for a new database or one already
+  migrated. Runs in a transaction, so a failure leaves the old table as it was."
+  [ds table create-sql]
+  (jdbc/with-transaction [tx ds]
+    (when (integer-id? tx table)
+      (let [rows (jdbc/execute! tx [(str "SELECT * FROM " table " ORDER BY id")]
+                                {:builder-fn rs/as-unqualified-maps})]
+        (jdbc/execute! tx [(str "DROP TABLE " table)])
+        (jdbc/execute! tx [create-sql])
+        (doseq [row rows
+                :let [row (assoc row :id (new-id))
+                      columns (keys row)]]
+          (jdbc/execute! tx (into [(str "INSERT INTO " table " (" (str/join ", " (map name columns)) ")"
+                                        " VALUES (" (str/join ", " (repeat (count columns) "?")) ")")]
+                                  (map row columns))))))))

src/tbd/todo/core.clj

@@ -0,0 +1,40 @@
+(ns tbd.todo.core
+  "Business logic for the todo group: validation and state changes on plain maps. No HTTP and
+  no database (see tbd.todo.db); anything time-dependent takes `now` (epoch ms) as an argument.
+
+  Fallible fns return {:ok value} or {:error message}."
+  (:require [clojure.string :as str]))
+
+(def max-title-length 200)
+
+(defn validate-title
+  "Titles are trimmed, and must be non-blank and at most `max-title-length` characters."
+  [title]
+  (let [title (some-> title str/trim)]
+    (cond
+      (str/blank? title) {:error "title must not be blank"}
+      (> (count title) max-title-length) {:error (format "title must be at most %d characters" max-title-length)}
+      :else {:ok title})))
+
+(defn new-todo
+  "A todo for `owner-id`, not yet stored (so no :id)."
+  [owner-id title now]
+  (let [{:keys [ok error]} (validate-title title)]
+    (if error
+      {:error error}
+      {:ok {:owner-id owner-id :title ok :done false :created-at now :updated-at now}})))
+
+(defn apply-changes
+  "`todo` with `changes` (a map with :title and/or :done) applied. Anything else in `changes`
+  is ignored; a change with neither is an error."
+  [todo changes now]
+  (let [changes (select-keys changes [:title :done])
+        {:keys [ok error]} (if (contains? changes :title)
+                             (validate-title (:title changes))
+                             {:ok (:title todo)})]
+    (cond
+      (empty? changes) {:error "nothing to change: give a title and/or done"}
+      error {:error error}
+      :else {:ok (-> todo
+                     (assoc :title ok :updated-at now)
+                     (cond-> (contains? changes :done) (assoc :done (boolean (:done changes)))))})))

src/tbd/todo/db.clj

@@ -0,0 +1,73 @@
+(ns tbd.todo.db
+  "SQLite persistence for the todo group, in the app's database (see tbd.sqlite). Storage only: validation and other
+  rules live in tbd.todo.core. Every query takes an `owner-id` and filters on it, so one
+  user's todos can't be read or changed through another user's ids."
+  (:require [next.jdbc :as jdbc]
+            [next.jdbc.result-set :as rs]
+            [tbd.sqlite :as sqlite]))
+
+(def ^:private create-todos
+  ;; `id` is a UUID (see tbd.sqlite/new-id); `owner_id` is the user's id in Gitea, which the app
+  ;; doesn't issue, so it stays the integer Gitea gave.
+  "CREATE TABLE IF NOT EXISTS todos (
+     id         TEXT    PRIMARY KEY,
+     owner_id   INTEGER NOT NULL,
+     title      TEXT    NOT NULL,
+     done       INTEGER NOT NULL DEFAULT 0,
+     created_at INTEGER NOT NULL,
+     updated_at INTEGER NOT NULL)")
+
+(defn migrate!
+  "Creates the todo tables in the database `ds`, or brings them up to date."
+  [ds]
+  (sqlite/migrate-integer-id! ds "todos" create-todos)
+  (jdbc/execute! ds [create-todos])
+  (jdbc/execute! ds ["CREATE INDEX IF NOT EXISTS todos_by_owner ON todos (owner_id, created_at)"]))
+
+(defn open
+  "A database with just the todo tables, at `path`; the app opens one with every group's tables
+  (see tbd.core), which this is for tests of the group on its own."
+  [path]
+  (sqlite/open path migrate!))
+
+(def ^:private opts {:builder-fn rs/as-unqualified-kebab-maps})
+
+;; SQLite has no boolean type; `done` is stored as 0/1.
+(defn- row->todo [row]
+  (some-> row (update :done #(= 1 %))))
+
+(defn insert!
+  "Stores a todo (as built by tbd.todo.core/new-todo) and returns it with its new :id, a UUID."
+  [ds {:keys [owner-id title done created-at updated-at]}]
+  (row->todo
+    (jdbc/execute-one! ds ["INSERT INTO todos (id, owner_id, title, done, created_at, updated_at)
+                            VALUES (?, ?, ?, ?, ?, ?) RETURNING *"
+                           (sqlite/new-id) owner-id title (if done 1 0) created-at updated-at]
+                       opts)))
+
+(defn list-todos
+  "The owner's todos, oldest first (ids are random, so they say nothing of the order)."
+  [ds owner-id]
+  (mapv row->todo
+        (jdbc/execute! ds ["SELECT * FROM todos WHERE owner_id = ? ORDER BY created_at, rowid" owner-id] opts)))
+
+(defn find-todo
+  "The owner's todo with this id, or nil (including when it belongs to someone else)."
+  [ds owner-id id]
+  (row->todo
+    (jdbc/execute-one! ds ["SELECT * FROM todos WHERE owner_id = ? AND id = ?" owner-id id] opts)))
+
+(defn update!
+  "Writes the todo's :title, :done and :updated-at; returns the stored row, or nil if the owner has no such todo."
+  [ds owner-id {:keys [id title done updated-at]}]
+  (row->todo
+    (jdbc/execute-one! ds ["UPDATE todos SET title = ?, done = ?, updated_at = ?
+                            WHERE owner_id = ? AND id = ? RETURNING *"
+                           title (if done 1 0) updated-at owner-id id]
+                       opts)))
+
+(defn delete!
+  "True if the owner's todo existed and is now gone."
+  [ds owner-id id]
+  (pos? (::jdbc/update-count
+          (jdbc/execute-one! ds ["DELETE FROM todos WHERE owner_id = ? AND id = ?" owner-id id]))))

src/tbd/todo/routes.clj

@@ -0,0 +1,62 @@
+(ns tbd.todo.routes
+  (:require [tbd.http :refer [respond]]
+            [tbd.todo.core :as todo]
+            [tbd.todo.schema :as schema]
+            [tbd.todo.service :as service]))
+
+;; Todos belong to the logged-in user (:login? true puts them on the request as :user); the
+;; rules, and the scoping to that user, are tbd.todo.service's, shared with the MCP tools. These
+;; handlers only turn a service result into a response.
+(def ^:private error-status {:invalid 400 :not-found 404})
+
+(defn- reply
+  "The response for a service `result`: `status` and `(shape value)` when it is ok, else the
+  error's status and message."
+  ([status result] (reply status identity result))
+  ([status shape {:keys [ok error kind]}]
+   (if error
+     (respond (error-status kind) {:error error})
+     (respond status (shape ok)))))
+
+(defn- list-handler [ds]
+  (fn [{:keys [user]}]
+    (reply 200 (fn [todos] {:todos todos}) (service/list-todos ds user))))
+
+(defn- create-handler [ds]
+  (fn [{{{:keys [title]} :body} :parameters :keys [user]}]
+    (reply 201 (service/create! ds user title))))
+
+(defn- get-handler [ds]
+  (fn [{{{:keys [id]} :path} :parameters :keys [user]}]
+    (reply 200 (service/find-todo ds user id))))
+
+(defn- patch-handler [ds]
+  (fn [{{{:keys [id]} :path changes :body} :parameters :keys [user]}]
+    (reply 200 (service/update! ds user id changes))))
+
+(defn- delete-handler [ds]
+  (fn [{{{:keys [id]} :path} :parameters :keys [user]}]
+    (reply 200 (fn [_] {:deleted true}) (service/delete! ds user id))))
+
+(defn routes
+  "`ds` is a delay of the app's database (see tbd.sqlite/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 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 schema/Changes)
+               :handler (patch-handler ds)}
+       :delete {:summary "Delete one of your todos"
+                :parameters id-param
+                :handler (delete-handler ds)}}]]))

src/tbd/todo/schema.clj

@@ -0,0 +1,33 @@
+(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, applied by tbd.todo.service, which both callers
+  go through."
+  (:require [malli.util :as mu]
+            [tbd.todo.core :as todo]))
+
+(def Id
+  "A todo's id: a UUID, as lowercase text (see tbd.sqlite/new-id), kept a string all the way through."
+  [:re {:description "Todo id, a UUID such as 3f2b8c1e-5a47-4d0e-9b6a-1c2d3e4f5a6b"
+        :error/message "should be a UUID"}
+   #"^[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}$"])
+
+(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))

src/tbd/todo/service.clj

@@ -0,0 +1,65 @@
+(ns tbd.todo.service
+  "What a caller can do with todos: the one place that ties the rules (tbd.todo.core) to storage
+  (tbd.todo.db). Both front ends, the HTTP routes (tbd.todo.routes) and the MCP tools
+  (tbd.mcp.tools), call these and nothing lower, so ownership, not-found and validation behave the
+  same on both and are written (and tested) once. A front end only translates: its request into
+  arguments, and the result into a response.
+
+  `ds` is the delay of the database the app shares (opened on first use, so a caller who is
+  turned away earlier never opens it). `user` is the authenticated caller, {:id ...} at least
+  (however they proved who they are: a session or an access token); a todo is only ever reached
+  through its owner's id, and someone else's is reported exactly like a missing one.
+
+  Every fn returns {:ok value} or {:error message :kind kind}, where kind is :invalid (the
+  input is no good) or :not-found."
+  (:require [tbd.todo.core :as todo]
+            [tbd.todo.db :as db]))
+
+(defn- now [] (System/currentTimeMillis))
+
+(defn- owner-id [user] (:id user))
+
+(def ^:private not-found {:error "todo not found" :kind :not-found})
+
+(defn- invalid [{:keys [error]}] {:error error :kind :invalid})
+
+(defn list-todos
+  "The user's todos, oldest first."
+  [ds user]
+  {:ok (db/list-todos @ds (owner-id user))})
+
+(defn find-todo
+  "The user's todo with this id."
+  [ds user id]
+  (if-let [found (db/find-todo @ds (owner-id user) id)]
+    {:ok found}
+    not-found))
+
+(defn create!
+  "Stores a new todo for the user and returns it."
+  [ds user title]
+  (let [{:keys [ok] :as built} (todo/new-todo (owner-id user) title (now))]
+    (if ok
+      {:ok (db/insert! @ds ok)}
+      (invalid built))))
+
+(defn update!
+  "Applies `changes` (:title and/or :done) to the user's todo and returns it."
+  [ds user id changes]
+  (let [owner (owner-id user)]
+    (if-let [found (db/find-todo @ds owner id)]
+      (let [{:keys [ok] :as changed} (todo/apply-changes found changes (now))]
+        (if ok
+          ;; nil only if it was deleted since the lookup.
+          (if-let [stored (db/update! @ds owner ok)]
+            {:ok stored}
+            not-found)
+          (invalid changed)))
+      not-found)))
+
+(defn delete!
+  "Deletes the user's todo; {:ok true} once it is gone."
+  [ds user id]
+  (if (db/delete! @ds (owner-id user) id)
+    {:ok true}
+    not-found))

test/tbd/agent/a2a_test.clj

@@ -0,0 +1,94 @@
+(ns tbd.agent.a2a-test
+  (:require [clojure.test :refer [deftest is testing]]
+            [muuntaja.core :as m]
+            [tbd.agent.test-support :as ts]
+            [tbd.auth.routes-test :as t]
+            [tbd.oauth.core :as oauth]
+            [tbd.oauth.db :as db]
+            [tbd.sqlite-test :as sqlite-test])
+  (:import (java.io ByteArrayInputStream)))
+
+;; A2A sits behind its own transport, like /mcp, so these go through the real app (tbd.core) and
+;; speak JSON-RPC to /a2a the way an A2A client does, with an OAuth access token.
+
+(defn- mint-token!
+  [path login id]
+  (let [token (oauth/random-token)
+        expires-at (+ (System/currentTimeMillis) 60000)]
+    (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 [app token message]
+  (let [body (slurp (m/encode "application/json" message))
+        resp (app {:request-method :post :uri "/a2a"
+                   :headers (cond-> {"content-type" "application/json"}
+                              token (assoc "authorization" (str "Bearer " token)))
+                   :body (ByteArrayInputStream. (.getBytes ^String body))})]
+    (update resp :body #(when % (m/decode "application/json" %)))))
+
+(defn- app-with [chat & {:keys [db-path] :or {db-path (sqlite-test/temp-db-path)}}]
+  [(t/make-app (t/gitea-stub "alice") :chat chat :db {:db-path db-path}) db-path])
+
+(defn- send-message [text]
+  {:jsonrpc "2.0" :id 1 :method "message/send"
+   :params {:message {:role "user" :parts [{:kind "text" :text text}] :messageId "m1" :kind "message"}}})
+
+(deftest agent-card-test
+  (let [[app] (app-with (ts/config (ts/text-model "hi")))
+        resp (app {:request-method :get :uri "/.well-known/agent-card.json"})]
+    (is (= 200 (:status resp)))
+    (let [card (m/decode "application/json" (:body resp))]
+      (is (= "tbd" (:name card)))
+      (is (= "http://tbd.test/a2a" (:url card)))
+      (is (false? (get-in card [:capabilities :streaming])))
+      (is (contains? (:securitySchemes card) :bearer))
+      (is (some #(= "add" (:id %)) (:skills card))))))
+
+(deftest message-send-test
+  (let [[app path] (app-with (ts/config (ts/text-model "Hi there")))
+        token (mint-token! path "alice" 7)
+        resp (rpc app token (send-message "hi"))]
+    (is (= 200 (:status resp)))
+    (is (= "2.0" (get-in resp [:body :jsonrpc])))
+    (is (= 1 (get-in resp [:body :id])))
+    (is (= "agent" (get-in resp [:body :result :role])))
+    (is (= "Hi there" (get-in resp [:body :result :parts 0 :text])))))
+
+(deftest unauthorized-test
+  (let [[app] (app-with (ts/config (ts/text-model "x")))]
+    (is (= 401 (:status (rpc app nil (send-message "hi")))))
+    (is (= 401 (:status (rpc app "not-a-real-token" (send-message "hi")))))))
+
+(deftest tool-loop-test
+  (testing "the agent's own tool calls are run immediately, server-side, and the loop continues
+           until it answers in text"
+    (let [[app path] (app-with (ts/config (ts/tool-call-model {:id "c1" :name "add" :arguments "{\"x\":1,\"y\":2}"})))
+          token (mint-token! path "alice" 7)]
+      ;; tool-call-model always asks for the same call; run-tools! must give up rather than loop forever
+      (is (= 502 (:status (rpc app token (send-message "add 1 and 2"))))))))
+
+(deftest tool-loop-runs-a-real-tool-test
+  ;; A regression test for the tool handlers themselves (create_todo etc. return JSON via
+  ;; tbd.agent.a2a/->json): the first turn asks for a call, the second answers from its result.
+  (let [turn (atom 0)
+        first-model (ts/tool-call-model {:id "c1" :name "create_todo" :arguments "{\"title\":\"milk\"}"})
+        second-model (ts/text-model "Added it.")
+        model (ts/model-of
+                (fn [req handler]
+                  (if (zero? @turn)
+                    (do (swap! turn inc) (.doChat first-model req handler))
+                    (.doChat second-model req handler))))
+        [app path] (app-with (ts/config model))
+        token (mint-token! path "alice" 7)
+        resp (rpc app token (send-message "add a todo to buy milk"))]
+    (is (= 200 (:status resp)))
+    (is (= "Added it." (get-in resp [:body :result :parts 0 :text])))))
+
+(deftest invalid-jsonrpc-test
+  (let [[app path] (app-with (ts/config (ts/text-model "x")))
+        token (mint-token! path "alice" 7)]
+    (is (= "invalid JSON-RPC request" (get-in (rpc app token {:id 1 :method "message/send"}) [:body :error :message])))
+    (is (= "method not found: nope" (get-in (rpc app token {:jsonrpc "2.0" :id 1 :method "nope"}) [:body :error :message])))))

test/tbd/agent/core_test.clj

@@ -0,0 +1,63 @@
+(ns tbd.agent.core-test
+  (:require [clojure.test :refer [deftest is testing]]
+            [tbd.agent.core :as agent]
+            [tbd.agent.test-support :as ts]))
+
+(defn- turn! [config messages tools]
+  (let [{:keys [ok error kind]} (agent/start config "system prompt" messages tools)]
+    (if error
+      {:error error :kind kind}
+      (let [events (atom [])]
+        (ok (fn [e] (swap! events conj e)))
+        {:events @events}))))
+
+(deftest not-configured
+  (is (= {:error "chat is not configured" :kind :unavailable}
+         (agent/start {} "sys" [{:role "user" :content "hi"}] nil))))
+
+(deftest api-base-url-adds-v1
+  (testing "LM Studio's OpenAI-compatible endpoints live under /v1, which LangChain4j does not add
+           on its own (see tbd.agent.core/api-base-url); LMSTUDIO_URL is documented as the bare
+           server address, so this has to be added for every request to land"
+    (is (= "http://llm.test/v1" (#'agent/api-base-url "http://llm.test")))
+    (is (= "http://llm.test/v1" (#'agent/api-base-url "http://llm.test/v1")))))
+
+(deftest a-plain-reply
+  (is (= {:events [{:thinking "hm"} {:content "Hel"} {:content "lo"} {:done true}]}
+         (turn! (ts/config (ts/thinking-model "hm" "Hel" "lo")) [{:role "user" :content "hi"}] nil))))
+
+(deftest a-tool-call
+  (is (= {:events [{:tool-calls [{:id "call_1" :name "add" :arguments "{\"x\":1}"}]} {:done true}]}
+         (turn! (ts/config (ts/tool-call-model {:id "call_1" :name "add" :arguments "{\"x\":1}"}))
+               [{:role "user" :content "add 1"}]
+               [{:name "add" :description "adds" :inputSchema {:type "object" :properties {}}}]))))
+
+(deftest no-reply-is-an-error
+  (is (= {:events [{:error "the LLM server sent no reply"}]}
+         (turn! (ts/config (ts/no-reply-model)) [{:role "user" :content "hi"}] nil))))
+
+(deftest tools-optional
+  (is (= {:events [{:content "x"} {:done true}]}
+         (turn! (ts/config (ts/text-model "x")) [{:role "user" :content "hi"}] nil))))
+
+(deftest connection-failure-is-caught-before-the-stream-starts
+  (testing "the model errors before ever saying anything: {:error}, no {:ok}"
+    (is (= {:error "the LLM server can't be reached or refused" :kind :upstream}
+           (turn! (ts/config (ts/error-model "boom")) [{:role "user" :content "hi"}] nil))))
+  (testing "the fake model itself throws synchronously"
+    (let [config (ts/config (ts/model-of (fn [_ _] (throw (RuntimeException. "no such host")))))]
+      (is (= :upstream (:kind (turn! config [{:role "user" :content "hi"}] nil))))))
+  (testing ".chat is never called when chat isn't configured, whatever the model would have said"
+    (let [calls (atom 0)
+          config (assoc (ts/config (ts/model-of (fn [_ _] (swap! calls inc)))) :url nil)]
+      (is (= {:error "chat is not configured" :kind :unavailable} (turn! config [] nil)))
+      (is (zero? @calls)))))
+
+(deftest conversation-history-round-trips
+  (testing "assistant messages with tool calls, and their tool-role results, reach the model
+           without error (see tbd.agent.core/llm-message)"
+    (let [messages [{:role "user" :content "add 1 and 2"}
+                    {:role "assistant" :content "" :tool-calls [{:id "c1" :name "add" :arguments "{\"x\":1,\"y\":2}"}]}
+                    {:role "tool" :tool-call-id "c1" :content "3"}]]
+      (is (= {:events [{:content "3"} {:done true}]}
+             (turn! (ts/config (ts/text-model "3")) messages nil))))))

test/tbd/agent/instructions_test.clj

@@ -0,0 +1,38 @@
+(ns tbd.agent.instructions-test
+  (:require [clojure.string :as str]
+            [clojure.test :refer [deftest is]]
+            [tbd.agent.instructions :as instructions]
+            [tbd.agent.prompt :as prompt]))
+
+(defn- flat
+  "`text` on one line: the prompts are wrapped in the source, where they wrap is not the point."
+  [text]
+  (str/replace text #"\s+" " "))
+
+(deftest chat-and-guide-share-the-instructions
+  (doseq [text (map flat [(instructions/chat) prompt/guide])]
+    (is (str/includes? text "Act, don't offer"))
+    (is (str/includes? text "in this same turn"))
+    (is (str/includes? text "Work it out yourself:"))
+    (is (str/includes? text "Say something was done only if a tool result says it was"))
+    (is (str/includes? text "Tic-tac-toe: check whose turn it is"))
+    (is (str/includes? text "Examples: "))))
+
+(deftest chat-is-framed-as-the-in-page-chatbot
+  (let [text (instructions/chat)]
+    (is (str/includes? text "under your message"))
+    (is (str/includes? text "Chain calls without stopping"))
+    (is (str/includes? text "navigate there, then") "the chatbot's tools follow the page it is on")))
+
+(deftest chat-system-message-adds-page-and-tools
+  (is (= (instructions/chat) (instructions/chat-system-message nil nil)))
+  (let [text (instructions/chat-system-message "todos" [{:name "create_todo"} {:name "list_todos"}])]
+    (is (str/includes? text "on the \"todos\" page"))
+    (is (str/includes? text "Its tools: create_todo, list_todos"))))
+
+(deftest a2a-has-no-in-page-framing
+  (let [text (instructions/a2a)]
+    (is (str/includes? text "Act, don't offer"))
+    (is (str/includes? text "Agent2Agent protocol"))
+    (is (str/includes? text "no page open"))
+    (is (not (str/includes? text "under your message")))))

test/tbd/agent/prompt_test.clj

@@ -0,0 +1,36 @@
+(ns tbd.agent.prompt-test
+  (:require [clojure.string :as str]
+            [clojure.test :refer [deftest is]]
+            [tbd.agent.prompt :as prompt]))
+
+(defn- flat
+  "`text` on one line: the prompts are wrapped in the source, where they wrap is not the point."
+  [text]
+  (str/replace text #"\s+" " "))
+
+(deftest guide-tells-the-agent-to-act
+  (let [text (flat prompt/guide)]
+    (is (str/includes? text "Act, don't offer"))
+    (is (str/includes? text "in this same turn"))
+    (is (str/includes? text "Work it out yourself:"))
+    (is (str/includes? text "Chain calls without stopping"))
+    (is (str/includes? text "results from an earlier message are marked out of date"))
+    (is (str/includes? text "never go by an earlier result"))
+    (is (str/includes? text "Say something was done only if a tool result says it was"))
+    (is (str/includes? text "Tic-tac-toe: check whose turn it is"))
+    (is (str/includes? text "Examples: "))
+    (is (not (str/includes? text "navigate there, then")) "an outside agent is offered every tool")))
+
+(deftest task-prompt
+  (is (str/starts-with? (prompt/task "add a todo") prompt/guide))
+  (is (str/ends-with? (prompt/task "add a todo") "The user's request: add a todo"))
+  (doseq [none [nil "" 5]]
+    (is (str/includes? (prompt/task none) "Ask the user what they want") (pr-str none))
+    (is (not (str/includes? (prompt/task none) "The user's request")) (pr-str none))))
+
+(deftest tic-tac-toe-prompt
+  (is (str/includes? (prompt/tic-tac-toe "x") "as X."))
+  (is (str/includes? (prompt/tic-tac-toe "o") "as O."))
+  (doseq [other [nil "" "z" :x]]
+    (is (str/includes? (prompt/tic-tac-toe other) "as O.") (pr-str other)))
+  (is (str/includes? (prompt/tic-tac-toe "x") "never move for the other side")))

test/tbd/agent/test_support.clj

@@ -0,0 +1,78 @@
+(ns tbd.agent.test-support
+  "A fake LangChain4j StreamingChatModel for tests: no real network, no LM Studio. `model-of`
+  builds one from a script — a function of the ChatRequest that calls the handler's callbacks
+  directly, exactly as a real provider's client would, so tbd.agent.core's pump code is exercised
+  for real. `text-model`/`tool-call-model`/`error-model`/`thinking-model` cover the common cases."
+  (:require [tbd.agent.core :as agent])
+  (:import (dev.langchain4j.agent.tool ToolExecutionRequest)
+           (dev.langchain4j.data.message AiMessage)
+           (dev.langchain4j.model.chat StreamingChatModel)
+           (dev.langchain4j.model.chat.response
+             ChatResponse ChatResponseMetadata$Builder CompleteToolCall PartialResponse
+             PartialResponseContext PartialThinking PartialThinkingContext StreamingHandle)
+           (dev.langchain4j.model.output FinishReason TokenUsage)))
+
+(defn fake-handle
+  "A StreamingHandle whose `cancel` is observable through the atom `cancelled?`."
+  ([] (fake-handle (atom false)))
+  ([cancelled?]
+   (reify StreamingHandle
+     (cancel [_] (reset! cancelled? true))
+     (isCancelled [_] @cancelled?))))
+
+(defn model-of
+  "A StreamingChatModel whose `doChat` calls `(script req handler)`."
+  ^StreamingChatModel [script]
+  (reify StreamingChatModel
+    (doChat [_ req handler] (script req handler) nil)))
+
+(defn- complete [handler ai-message finish-reason usage]
+  (.onCompleteResponse handler
+                       (-> (ChatResponse/builder)
+                           (.aiMessage ai-message)
+                           (.metadata (cond-> (ChatResponseMetadata$Builder.)
+                                        finish-reason (.finishReason finish-reason)
+                                        usage (.tokenUsage (TokenUsage. (int (first usage)) (int (second usage))))
+                                        true .build))
+                           .build)))
+
+(defn text-model
+  "A model that streams `pieces` as :content, then finishes with their concatenation as the reply."
+  [& pieces]
+  (model-of (fn [_ handler]
+              (let [h (fake-handle)]
+                (doseq [p pieces] (.onPartialResponse handler (PartialResponse. ^String p) (PartialResponseContext. h)))
+                (complete handler (AiMessage/from (apply str pieces)) FinishReason/STOP [10 5])))))
+
+(defn thinking-model
+  "A model that streams `thinking`, then `pieces` as content."
+  [thinking & pieces]
+  (model-of (fn [_ handler]
+              (let [h (fake-handle)]
+                (.onPartialThinking handler (PartialThinking. ^String thinking) (PartialThinkingContext. h))
+                (doseq [p pieces] (.onPartialResponse handler (PartialResponse. ^String p) (PartialResponseContext. h)))
+                (complete handler (AiMessage/from (apply str pieces)) FinishReason/STOP [10 5])))))
+
+(defn tool-call-model
+  "A model that asks for one tool call: {:id :name :arguments}."
+  [{:keys [id name arguments]}]
+  (model-of (fn [_ handler]
+              (let [req (-> (ToolExecutionRequest/builder) (.id id) (.name name) (.arguments arguments) .build)]
+                (.onCompleteToolCall handler (CompleteToolCall. (int 0) req))
+                (complete handler (AiMessage/from "" [req]) FinishReason/TOOL_EXECUTION nil)))))
+
+(defn error-model
+  "A model whose call always fails with `message`."
+  [message]
+  (model-of (fn [_ handler] (.onError handler (RuntimeException. ^String message)))))
+
+(defn no-reply-model
+  "A model that ends the turn with nothing said and no calls (the LLM sent no reply)."
+  []
+  (model-of (fn [_ handler] (complete handler (AiMessage/from "") FinishReason/STOP nil))))
+
+(defn config
+  "A chat config (see tbd.agent.core/env-config) using `model` instead of a real LM Studio."
+  ([model] (config model {}))
+  ([model overrides]
+   (merge (agent/env-config {"LMSTUDIO_URL" "http://llm.test"}) {:chat-model model} overrides)))

test/tbd/auth/core_test.clj

@@ -0,0 +1,118 @@
+(ns tbd.auth.core-test
+  (:require [clojure.string :as str]
+            [clojure.test :refer [deftest is testing]]
+            [tbd.auth.core :as auth]))
+
+(def full-env
+  {"GITEA_URL" "https://git.example.com/"
+   "GITEA_CLIENT_ID" "cid"
+   "GITEA_CLIENT_SECRET" "sec"
+   "BASE_URL" "https://tbd.example.com/"
+   "ADMIN_USERS" " Alice, bob ,,"
+   "SESSION_SECRET" "s3cret"})
+
+(deftest env-config-test
+  (testing "a complete environment"
+    (let [config (auth/env-config full-env)]
+      (is (auth/configured? config))
+      (is (= "https://git.example.com" (:gitea-url config)) "trailing slash is dropped")
+      (is (= "https://tbd.example.com/auth/callback" (:redirect-uri config)))
+      (is (= #{"alice" "bob"} (:admin-users config)) "trimmed, lower-cased, blanks dropped")
+      (is (true? (:secure-cookies? config)) "https base URL => Secure cookies")
+      (is (= "s3cret" (:session-secret config)))))
+  (testing "plain http base URL does not mark cookies Secure"
+    (is (false? (:secure-cookies? (auth/env-config (assoc full-env "BASE_URL" "http://localhost:3000"))))))
+  (testing "an empty environment is unconfigured and has no admins"
+    (let [config (auth/env-config {})]
+      (is (not (auth/configured? config)))
+      (is (= #{} (:admin-users config)))
+      (is (nil? (:session-secret config)))))
+  (testing "blank values count as unset"
+    (is (not (auth/configured? (auth/env-config (assoc full-env "GITEA_CLIENT_SECRET" "  "))))))
+  (testing "each of the four settings is required"
+    (doseq [k ["GITEA_URL" "GITEA_CLIENT_ID" "GITEA_CLIENT_SECRET" "BASE_URL"]]
+      (is (not (auth/configured? (auth/env-config (dissoc full-env k)))) k))))
+
+(deftest admin-test
+  (let [config (auth/env-config full-env)]
+    (is (auth/admin? config "alice"))
+    (is (auth/admin? config "ALICE") "Gitea usernames are case-insensitive")
+    (is (not (auth/admin? config "mallory")))
+    (is (not (auth/admin? (auth/env-config {}) "alice")) "an empty allowlist admits nobody")))
+
+(deftest session-key-test
+  (is (= 16 (count (auth/session-key "s3cret"))))
+  (is (= (seq (auth/session-key "s3cret")) (seq (auth/session-key "s3cret"))))
+  (is (not= (seq (auth/session-key "a")) (seq (auth/session-key "b"))))
+  (testing "without a secret each call yields a fresh random key"
+    (is (= 16 (count (auth/session-key nil))))
+    (is (not= (seq (auth/session-key nil)) (seq (auth/session-key nil))))))
+
+(deftest state-test
+  (let [a (auth/new-state)]
+    (is (re-matches #"[A-Za-z0-9_-]{43}" a))
+    (is (not= a (auth/new-state))))
+  (is (auth/state-matches? "abc" "abc"))
+  (is (not (auth/state-matches? "abc" "abd")))
+  (is (not (auth/state-matches? "abc" "abcd")))
+  (testing "a missing state never matches, even against another missing one"
+    (is (not (auth/state-matches? nil nil)))
+    (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?"))
+    (is (str/includes? url "client_id=cid"))
+    (is (str/includes? url "response_type=code"))
+    (is (str/includes? url "redirect_uri=https%3A%2F%2Ftbd.example.com%2Fauth%2Fcallback"))
+    (is (str/includes? url "state=st+ate") "values are form-encoded")))
+
+(defn- recording-http
+  "An :http stub that records requests and answers with `responses` in order."
+  [calls & responses]
+  (let [responses (atom responses)]
+    (fn [req]
+      (swap! calls conj req)
+      (let [[r & more] @responses]
+        (reset! responses more)
+        (if (instance? Throwable r) (throw r) r)))))
+
+(deftest exchange-code-test
+  (let [calls (atom [])
+        config (assoc (auth/env-config full-env)
+                      :http (recording-http calls
+                                            {:status 200 :body "{\"access_token\":\"tok\",\"token_type\":\"bearer\"}"}
+                                            {:status 400 :body "{\"error\":\"invalid_grant\"}"}))]
+    (is (= "tok" (auth/exchange-code config "the-code")))
+    (let [{:keys [method url headers body]} (first @calls)]
+      (is (= :post method))
+      (is (= "https://git.example.com/login/oauth/access_token" url))
+      (is (= "application/json" (get headers "Accept")))
+      (is (= "application/x-www-form-urlencoded" (get headers "Content-Type")))
+      (doseq [part ["grant_type=authorization_code" "client_id=cid" "client_secret=sec" "code=the-code"
+                    "redirect_uri=https%3A%2F%2Ftbd.example.com%2Fauth%2Fcallback"]]
+        (is (str/includes? body part) part)))
+    (is (nil? (auth/exchange-code config "used-code")) "a refused code yields nil")))
+
+(deftest fetch-user-test
+  (let [calls (atom [])
+        config (assoc (auth/env-config full-env)
+                      :http (recording-http calls
+                                            {:status 200 :body "{\"login\":\"alice\",\"id\":7,\"email\":\"a@x\"}"}
+                                            {:status 401 :body "{}"}
+                                            {:status 200 :body "{\"id\":7}"}))]
+    (is (= {:login "alice" :id 7} (auth/fetch-user config "tok")))
+    (let [{:keys [method url headers]} (first @calls)]
+      (is (= :get method))
+      (is (= "https://git.example.com/api/v1/user" url))
+      (is (= "Bearer tok" (get headers "Authorization"))))
+    (is (nil? (auth/fetch-user config "bad")) "a refused token yields nil")
+    (is (nil? (auth/fetch-user config "odd")) "a response without a login yields nil")))

test/tbd/auth/routes_test.clj

@@ -0,0 +1,175 @@
+(ns tbd.auth.routes-test
+  (:require [clojure.string :as str]
+            [clojure.test :refer [deftest is testing]]
+            [tbd.auth.middleware :as mw]
+            [tbd.core :as core]
+            [tbd.test-util :as test-util]))
+
+(defn gitea-stub
+  "Stands in for Gitea: any code is exchanged for a token that resolves to `login` (with Gitea id 7, or `id`)."
+  ([login] (gitea-stub login 7))
+  ([login id]
+   (fn [{:keys [url]}]
+     (cond
+       (str/ends-with? url "/login/oauth/access_token") {:status 200 :body "{\"access_token\":\"tok\"}"}
+       (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. `:db` and `:chat` (their configs) are passed through; other overrides go into the auth config."
+  [http & {:keys [db chat] :as overrides}]
+  (core/make-app {:db db
+                  :chat chat
+                  :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"
+                                :admin-users #{"alice"}
+                                :session-secret "test-secret"
+                                :secure-cookies? false
+                                :http http}
+                               (dissoc overrides :db :chat))
+                  :nrepl {:port 0 :bind "127.0.0.1"}}))
+
+(defn request [app method uri & {:keys [cookie query]}]
+  (let [resp (app (cond-> {:request-method method :uri uri :query-string query :headers {}}
+                    cookie (assoc-in [:headers "cookie"] cookie)))]
+    (test-util/decode-body resp)))
+
+(defn set-cookie
+  "The `name=value` pair from a response's Set-Cookie header."
+  [resp]
+  (let [h (get-in resp [:headers "Set-Cookie"])]
+    (first (str/split (first (if (string? h) [h] h)) #";"))))
+
+(defn location-state [resp]
+  (second (re-find #"[?&]state=([^&]+)" (get-in resp [:headers "Location"]))))
+
+(defn login!
+  "Runs the whole login dance and returns the session cookie."
+  [app]
+  (let [start (request app :get "/auth/login")
+        done (request app :get "/auth/callback"
+                      :cookie (set-cookie start)
+                      :query (str "code=abc&state=" (location-state start)))]
+    (set-cookie done)))
+
+(deftest login-redirect-test
+  (let [resp (request (make-app (gitea-stub "alice")) :get "/auth/login")
+        location (get-in resp [:headers "Location"])]
+    (is (= 302 (:status resp)))
+    (is (str/starts-with? location "https://gitea.test/login/oauth/authorize?"))
+    (is (str/includes? location "client_id=cid"))
+    (is (some? (location-state resp)))
+    (let [cookie (get-in resp [:headers "Set-Cookie"])
+          cookie (first (if (string? cookie) [cookie] cookie))]
+      (is (str/starts-with? cookie "tbd-session="))
+      (is (re-find #"(?i)HttpOnly" cookie))
+      (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)))]
+    (is (re-find #"(?i);\s*Secure" cookie))))
+
+(deftest unconfigured-test
+  (let [app (make-app (gitea-stub "alice") :gitea-url nil)]
+    (is (= 503 (:status (request app :get "/auth/login"))))
+    (is (= 503 (:status (request app :get "/auth/callback" :query "code=x&state=y"))))))
+
+(deftest callback-test
+  (let [app (make-app (gitea-stub "Alice"))
+        start (request app :get "/auth/login")
+        cookie (set-cookie start)
+        state (location-state start)]
+    (testing "a successful login redirects home and sets a session"
+      (let [resp (request app :get "/auth/callback" :cookie cookie :query (str "code=abc&state=" state))]
+        (is (= 302 (:status resp)))
+        (is (= "/" (get-in resp [:headers "Location"])))
+        (is (some? (set-cookie resp)))))
+    (testing "no session cookie (the callback wasn't preceded by a login here)"
+      (is (= 400 (:status (request app :get "/auth/callback" :query (str "code=abc&state=" state))))))
+    (testing "wrong or missing state"
+      (is (= 400 (:status (request app :get "/auth/callback" :cookie cookie :query "code=abc&state=nope"))))
+      (is (= 400 (:status (request app :get "/auth/callback" :cookie cookie :query "code=abc")))))
+    (testing "the user denied access at Gitea"
+      (is (= 403 (:status (request app :get "/auth/callback" :cookie cookie
+                                   :query (str "error=access_denied&state=" state))))))
+    (testing "missing code"
+      (is (= 400 (:status (request app :get "/auth/callback" :cookie cookie :query (str "state=" state))))))))
+
+(deftest callback-gitea-failure-test
+  (let [login-with (fn [http]
+                     (let [app (make-app http)
+                           start (request app :get "/auth/login")
+                           resp (atom nil)]
+                       ;; the 502 path logs; keep it out of the test output
+                       (with-out-str
+                         (reset! resp (request app :get "/auth/callback" :cookie (set-cookie start)
+                                               :query (str "code=abc&state=" (location-state start)))))
+                       @resp))]
+    (testing "Gitea rejects the code"
+      (let [resp (login-with (fn [_] {:status 400 :body "{\"error\":\"invalid_grant\"}"}))]
+        (is (= 401 (:status resp)))
+        (is (nil? (get-in resp [:headers "Set-Cookie"])) "no session is created")))
+    (testing "Gitea rejects the token"
+      (is (= 401 (:status (login-with (fn [{:keys [url]}]
+                                        (if (str/ends-with? url "/access_token")
+                                          {:status 200 :body "{\"access_token\":\"tok\"}"}
+                                          {:status 401 :body "{}"})))))))
+    (testing "Gitea is unreachable or answers garbage"
+      (is (= 502 (:status (login-with (fn [_] (throw (java.net.ConnectException. "refused")))))))
+      (is (= 502 (:status (login-with (fn [_] {:status 200 :body "<html>not json</html>"}))))))))
+
+(deftest me-and-logout-test
+  (let [app (make-app (gitea-stub "Alice"))
+        cookie (login! app)]
+    (testing "anonymous"
+      (is (= 401 (:status (request app :get "/auth/me")))))
+    (testing "logged in"
+      (let [resp (request app :get "/auth/me" :cookie cookie)]
+        (is (= 200 (:status resp)))
+        (is (= {:login "Alice" :id 7 :admin? true} (:body resp)))))
+    (testing "logged in as a non-admin"
+      (let [app (make-app (gitea-stub "bob"))]
+        (is (= {:login "bob" :id 7 :admin? false}
+               (:body (request app :get "/auth/me" :cookie (login! app)))))))
+    (testing "logout replaces the session with an empty one"
+      (let [resp (request app :post "/auth/logout" :cookie cookie)]
+        (is (= 200 (:status resp)))
+        (is (= 401 (:status (request app :get "/auth/me" :cookie (set-cookie resp)))))))))
+
+(deftest forged-session-test
+  (let [app (make-app (gitea-stub "alice"))
+        cookie (login! app)]
+    (testing "a cookie tampered with is ignored"
+      (let [tampered (str (subs cookie 0 (- (count cookie) 4)) "AAAA")]
+        (is (= 401 (:status (request app :get "/auth/me" :cookie tampered))))))
+    (testing "a cookie minted under another SESSION_SECRET is ignored"
+      (let [other (make-app (gitea-stub "alice") :session-secret "other-secret")]
+        (is (= 401 (:status (request other :get "/auth/me" :cookie cookie))))))
+    (testing "garbage"
+      (is (= 401 (:status (request app :get "/auth/me" :cookie "tbd-session=not-a-real-cookie")))))))
+
+(deftest current-user-expiry-test
+  (let [req {:session {:user {:login "alice" :expires-at 1000}}}]
+    (is (= {:login "alice" :expires-at 1000} (mw/current-user req 999)))
+    (is (nil? (mw/current-user req 1000)) "expired exactly at expires-at")
+    (is (nil? (mw/current-user req 5000)))
+    (is (nil? (mw/current-user {:session {:user {:login "alice"}}} 0)) "a user with no expiry is not trusted")
+    (is (nil? (mw/current-user {} 0)))))

test/tbd/chat/routes_test.clj

@@ -0,0 +1,176 @@
+(ns tbd.chat.routes-test
+  (:require [clojure.string :as str]
+            [clojure.test :refer [deftest is testing]]
+            [muuntaja.core :as m]
+            [ring.core.protocols :as ring-protocols]
+            [tbd.agent.test-support :as ts]
+            [tbd.auth.routes-test :as t]
+            [tbd.test-util :as test-util])
+  (:import (java.io ByteArrayInputStream ByteArrayOutputStream IOException OutputStream)))
+
+(defn- json [data] (slurp (m/encode "application/json" data)))
+
+(defn- post-chat
+  "POST /api/chat with `body`, a JSON string (or nil for none)."
+  [app cookie body]
+  (test-util/decode-body
+   (app (cond-> {:request-method :post :uri "/api/chat"
+                :headers (cond-> {"content-type" "application/json"}
+                           cookie (assoc "cookie" cookie))}
+          body (assoc :body (ByteArrayInputStream. (.getBytes ^String body)))))))
+
+(defn- body-text
+  "What a response's streaming body writes, as the server would write it to the browser."
+  [resp]
+  (let [out (ByteArrayOutputStream.)]
+    (ring-protocols/write-body-to-stream (:body resp) resp out)
+    (.toString out "UTF-8")))
+
+(defn- events
+  "The AG-UI events of a chat response: the JSON of each `data:` line, `:type` and one message/call
+  id dropped (a random uuid, not what these tests are about) unless a test keeps it."
+  [resp]
+  (->> (str/split (body-text resp) #"\n\n")
+       (map #(m/decode "application/json" (str/replace-first % "data: " "")))))
+
+(defn- types [resp] (map :type (events resp)))
+
+(def ^:private hello (json {:messages [{:id "m1" :role "user" :content "hi"}]}))
+
+(defn- app-with [chat]
+  (t/make-app (t/gitea-stub "alice") :chat chat))
+
+(deftest anonymous-test
+  (let [app (app-with (ts/config (ts/text-model "x")))]
+    (doseq [body [hello "nope" nil]]
+      (let [resp (post-chat app nil body)]
+        (is (= 401 (:status resp)))
+        (is (= {:error "login required"} (:body resp)))))))
+
+(deftest chat-test
+  (let [app (app-with (ts/config (ts/text-model "Hello" ", Alice")))
+        cookie (t/login! app)]
+    (testing "the reply streams back as AG-UI server-sent events"
+      (let [resp (post-chat app cookie hello)]
+        (is (= 200 (:status resp)))
+        (is (= "text/event-stream; charset=utf-8" (get-in resp [:headers "Content-Type"])))
+        (is (= "no-cache" (get-in resp [:headers "Cache-Control"])))
+        (is (= "no" (get-in resp [:headers "X-Accel-Buffering"])) "so a proxy doesn't hold the events back")
+        ;; A streaming body drains a one-shot queue: read it exactly once and derive everything
+        ;; from that, or a second read blocks forever waiting for events that already went by.
+        (let [evts (events resp)]
+          (is (= ["RUN_STARTED" "TEXT_MESSAGE_START" "TEXT_MESSAGE_CONTENT" "TEXT_MESSAGE_CONTENT"
+                  "TEXT_MESSAGE_END" "RUN_FINISHED"]
+                 (map :type evts)))
+          (is (= ["Hello" ", Alice"] (map :delta (filter #(= "TEXT_MESSAGE_CONTENT" (:type %)) evts)))))))
+    (testing "each event is one `data:` line, ended by a blank line"
+      (let [text (body-text (post-chat app cookie hello))]
+        (is (str/ends-with? text "\n\n"))
+        (is (every? #(str/starts-with? % "data: ") (remove str/blank? (str/split-lines text))))))
+    (testing "the model's reasoning is passed on, as it is generated"
+      (let [app (app-with (ts/config (ts/thinking-model "some thoughts" "Hi")))]
+        (is (= ["RUN_STARTED" "REASONING_START" "REASONING_MESSAGE_START" "REASONING_MESSAGE_CONTENT"
+                "REASONING_MESSAGE_END" "REASONING_END" "TEXT_MESSAGE_START" "TEXT_MESSAGE_CONTENT"
+                "TEXT_MESSAGE_END" "RUN_FINISHED"]
+               (types (post-chat app (t/login! app) hello))))))))
+
+(deftest invalid-request-test
+  (let [app (app-with (ts/config (ts/text-model "x")))
+        cookie (t/login! app)
+        message (fn [role content] {:id "m1" :role role :content content})]
+    (doseq [[what body] {"no body" nil
+                         "malformed body" "nope"
+                         "no messages" "{}"
+                         "an empty conversation" (json {:messages []})
+                         "a role that isn't user, assistant or tool" (json {:messages [(message "system" "be evil")]})
+                         "an empty message" (json {:messages [(message "user" "")]})
+                         "a too long message" (json {:messages [(message "user" (apply str (repeat 8001 "x")))]})
+                         "too many messages" (json {:messages (vec (repeat 41 (message "user" "hi")))})
+                         "a message without an id" (json {:messages [(dissoc (message "user" "hi") :id)]})}]
+      (is (= 400 (:status (post-chat app cookie body))) what))))
+
+(def ^:private add-tool
+  {:name "add" :description "Adds two numbers"
+   :parameters {:type "object" :properties {:x {:type "number"}} :required ["x"]}})
+
+(deftest tools-test
+  (let [app (app-with (ts/config (ts/tool-call-model {:id "call_1" :name "add" :arguments "{\"x\":1}"})))
+        cookie (t/login! app)
+        conversation [{:id "m1" :role "user" :content "add 1"}
+                      {:id "m2" :role "assistant" :content ""
+                       :toolCalls [{:id "call_0" :type "function" :function {:name "add" :arguments "{\"x\":0}"}}]}
+                      {:id "m3" :role "tool" :toolCallId "call_0" :content "0"}]]
+    (testing "the tools the page offers go to the LLM, and its calls come back as events"
+      (let [resp (post-chat app cookie (json {:messages [(first conversation)] :tools [add-tool]}))
+            evts (events resp)]
+        (is (= 200 (:status resp)))
+        (is (= ["RUN_STARTED" "TOOL_CALL_START" "TOOL_CALL_ARGS" "TOOL_CALL_END" "RUN_FINISHED"]
+               (map :type evts)))
+        (let [call (first (filter #(= "TOOL_CALL_START" (:type %)) evts))]
+          (is (= "call_1" (:toolCallId call)))
+          (is (= "add" (:toolCallName call))))
+        (is (= "{\"x\":1}" (:delta (first (filter #(= "TOOL_CALL_ARGS" (:type %)) evts)))))))
+    (testing "the conversation may hold calls and their results, which the LLM gets"
+      (is (= 200 (:status (post-chat app cookie (json {:messages conversation :tools [add-tool]}))))))
+    (testing "tools are optional"
+      (is (= 200 (:status (post-chat app cookie hello)))))))
+
+(deftest page-test
+  (let [app (app-with (ts/config (ts/text-model "x")))
+        cookie (t/login! app)]
+    (testing "the page the user is on reaches the LLM"
+      (is (= 200 (:status (post-chat app cookie
+                                     (json {:messages [{:id "m1" :role "user" :content "hi"}]
+                                            :context [{:description "page" :value "ai-setup"}]}))))))
+    (testing "it is bounded like any other string, but nothing enforces a slug shape on the wire"
+      (is (= 200 (:status (post-chat app cookie
+                                     (json {:messages [{:id "m1" :role "user" :content "hi"}]
+                                            :context [{:description "page" :value "ai-setup"}]}))))))))
+
+(deftest invalid-tools-test
+  (let [app (app-with (ts/config (ts/text-model "x")))
+        cookie (t/login! app)
+        user [{:id "m1" :role "user" :content "hi"}]
+        call {:id "c" :type "function" :function {:name "add" :arguments "{}"}}]
+    (doseq [[what body] {"a tool without a name" {:messages user :tools [(dissoc add-tool :name)]}
+                         "a tool name that is no function name" {:messages user :tools [(assoc add-tool :name "add it!")]}
+                         "a huge schema" {:messages user :tools [(assoc add-tool :parameters {:type "object" :description (apply str (repeat 6000 "x"))})]}
+                         "too many tools" {:messages user :tools (vec (repeat 33 add-tool))}
+                         "tools that aren't a list" {:messages user :tools add-tool}
+                         "an empty assistant message" {:messages [{:id "m1" :role "assistant" :content ""}]}
+                         "a call without an id" {:messages [{:id "m1" :role "assistant" :content "" :toolCalls [(dissoc call :id)]}]}
+                         "too many calls" {:messages [{:id "m1" :role "assistant" :content "" :toolCalls (vec (repeat 17 call))}]}
+                         "a result without the call's id" {:messages [{:id "m1" :role "tool" :content "3"}]}
+                         "an empty result" {:messages [{:id "m1" :role "tool" :toolCallId "c" :content ""}]}
+                         "a too long result" {:messages [{:id "m1" :role "tool" :toolCallId "c" :content (apply str (repeat 8001 "x"))}]}}]
+      (is (= 400 (:status (post-chat app cookie (json body)))) what))))
+
+(deftest llm-failure-test
+  (testing "chat is off without an LLM server"
+    (let [app (app-with nil)
+          resp (post-chat app (t/login! app) hello)]
+      (is (= 503 (:status resp)))
+      (is (= {:error "chat is not configured"} (:body resp)))))
+  (testing "an LLM server that can't be reached: a bad gateway before any run starts"
+    (let [app (app-with (ts/config (ts/error-model "boom")))
+          resp (post-chat app (t/login! app) hello)]
+      (is (= 502 (:status resp)))
+      (is (= "the LLM server can't be reached or refused" (:error (:body resp))))))
+  (testing "the LLM sends no reply at all: it had already answered with something, even if empty,
+           so the run had already started"
+    (let [app (app-with (ts/config (ts/no-reply-model)))
+          resp (post-chat app (t/login! app) hello)]
+      (is (= 200 (:status resp)))
+      (is (= "RUN_ERROR" (:type (last (events resp))))))))
+
+(deftest browser-goes-away-test
+  (testing "a browser that leaves mid-reply ends the stream quietly"
+    (let [app (app-with (ts/config (ts/text-model "a" "b" "c")))
+          resp (post-chat app (t/login! app) hello)
+          writes (atom 0)
+          gone (proxy [OutputStream] []
+                 (write
+                   ([_] (swap! writes inc) (throw (IOException. "broken pipe")))
+                   ([_ _ _] (swap! writes inc) (throw (IOException. "broken pipe")))))]
+      (ring-protocols/write-body-to-stream (:body resp) resp gone)
+      (is (= 1 @writes) "it stops at the first write that fails"))))

test/tbd/chat/trace_test.clj

@@ -0,0 +1,222 @@
+(ns tbd.chat.trace-test
+  (:require [clojure.string :as str]
+            [clojure.test :refer [deftest is testing]]
+            [muuntaja.core :as m]
+            [tbd.chat.trace :as trace])
+  (:import (java.io File)))
+
+(defn- collecting
+  "A trace config that keeps its entries in `entries`, an atom."
+  [entries & {:as opts}]
+  (merge {:sink #(swap! entries conj %) :full-text? false} opts))
+
+(defn- suspects [entries] (filter #(= :loop-suspect (:event %)) entries))
+
+(defn- call [id name args] {:id id :name name :arguments args})
+
+(defn- assistant [& calls] {:role "assistant" :content "" :tool-calls (vec calls)})
+(defn- result [id] {:role "tool" :tool-call-id id :content "ok"})
+
+(deftest run-summary-test
+  (let [ask {:role "user" :content "add milk"}
+        list-call (call "1" "list_todos" "{}")]
+    (testing "a conversation that has just begun"
+      (is (= {:step 0 :run-calls 0 :top-call nil :input [ask]}
+             (dissoc (trace/run-summary [ask]) :run))))
+    (testing "the turns of a run count the assistant's messages since the user's, and their calls"
+      (let [s (trace/run-summary [ask (assistant list-call) (result "1") (assistant (call "2" "add" "{}") (call "3" "add" "{}"))
+                                  (result "2") (result "3")])]
+        (is (= {:step 2 :run-calls 3 :top-call {:tool "add" :args "{}" :count 2}}
+               (select-keys s [:step :run-calls :top-call])))
+        (is (= ask (first (:input s))))
+        (is (= 6 (count (:input s))))))
+    (testing "the run id is that of the user's last message: the same for every turn of a run"
+      (let [a (trace/run-summary [ask])
+            b (trace/run-summary [ask (assistant list-call) (result "1")])
+            c (trace/run-summary [{:role "user" :content "something else"}])]
+        (is (re-matches #"[0-9a-f]{8}" (:run a)))
+        (is (= (:run a) (:run b)))
+        (is (not= (:run a) (:run c)))))
+    (testing "an earlier run's calls are not this run's"
+      (let [s (trace/run-summary [ask (assistant list-call) (result "1") {:role "assistant" :content "Done."}
+                                  {:role "user" :content "again"}])]
+        (is (= {:step 0 :run-calls 0} (select-keys s [:step :run-calls])))))
+    (testing "the same tool with other arguments is another call"
+      (is (= 1 (:count (:top-call (trace/run-summary [ask (assistant (call "1" "add" "{\"x\":1}") (call "2" "add" "{\"x\":2}"))]))))))
+    (testing "a conversation with no user message, and none at all"
+      (is (= "-" (:run (trace/run-summary [{:role "assistant" :content "hi"}]))))
+      (is (= {:run "-" :step 0 :run-calls 0} (select-keys (trace/run-summary []) [:run :step :run-calls]))))))
+
+(deftest begin-test
+  (testing "the start of a turn says what it is about, without the words of the conversation"
+    (let [entries (atom [])]
+      (trace/begin! (collecting entries)
+                    {:messages [{:role "user" :content "hello"}] :tools [{:name "add"} {:name "sub"}]
+                     :page "todos" :model "qwen"})
+      (let [[start :as all] @entries]
+        (is (= 1 (count all)))
+        (is (= {:event :turn-start :page "todos" :model "qwen" :messages 1 :tools 2 :prompt-chars 5 :step 0}
+               (select-keys start [:event :page :model :messages :tools :prompt-chars :step])))
+        (is (re-matches #"[0-9a-f]{8}" (:req start)))
+        (is (not (contains? start :input))))))
+  (testing "with the full text on, it has the run's messages"
+    (let [entries (atom [])
+          messages [{:role "user" :content "old"} {:role "assistant" :content "reply"} {:role "user" :content "new"}]]
+      (trace/begin! (collecting entries :full-text? true) {:messages messages})
+      (is (= [{:role "user" :content "new"}] (:input (first @entries))))))
+  (testing "every turn has its own req id"
+    (let [entries (atom [])]
+      (dotimes [_ 3] (trace/begin! (collecting entries) {:messages [{:role "user" :content "x"}]}))
+      (is (= 3 (count (set (map :req @entries)))))))
+  (testing "a call made three times in a run is a suspect, twice is not"
+    (let [ask {:role "user" :content "go"}
+          messages (fn [n] (into [ask] (mapcat (fn [i] [(assistant (call (str i) "look" "{}")) (result (str i))])) (range n)))
+          entries (atom [])]
+      (trace/begin! (collecting entries) {:messages (messages 2)})
+      (is (empty? (suspects @entries)))
+      (trace/begin! (collecting entries) {:messages (messages 3)})
+      (is (= [{:kind :repeated-call :tool "look" :args "{}" :count 3}]
+             (map #(select-keys % [:kind :tool :args :count]) (suspects @entries)))))))
+
+(deftest observe-test
+  (testing "reasoning that says the same sentence over and over is a suspect, at 4 times and each doubling"
+    (let [entries (atom [])
+          t (trace/begin! (collecting entries) {:messages [{:role "user" :content "x"}]})]
+      (dotimes [_ 16]
+        (trace/observe! t {:thinking "Wait, let me check the board again. "}))
+      (is (= [4 8 16] (map :count (suspects @entries))))
+      (is (every? #(= :repeated-thinking (:kind %)) (suspects @entries)))
+      (is (= "Wait, let me check the board again." (:text (first (suspects @entries)))))))
+  (testing "a sentence is the same whatever its case and spacing, and however the pieces of it came"
+    (let [entries (atom [])
+          t (trace/begin! (collecting entries) {:messages [{:role "user" :content "x"}]})]
+      (doseq [piece ["Wait, let me  check" " the board AGAIN." "\n" "wait, let me check the board again.\n"
+                     "Wait, let me check the " "board again!  " "Wait, let me check the board again?\n\n"]]
+        (trace/observe! t {:thinking piece}))
+      (is (= [4] (map :count (suspects @entries))))))
+  (testing "short sentences, and different ones, are no repetition"
+    (let [entries (atom [])
+          t (trace/begin! (collecting entries) {:messages [{:role "user" :content "x"}]})]
+      (dotimes [i 20]
+        (trace/observe! t {:thinking "Hmm. "})
+        (trace/observe! t {:thinking (str "Step " i " of working out which of the many todos is the one. ")}))
+      (is (empty? (suspects @entries)))))
+  (testing "reasoning that goes on and on is a suspect at 8000 characters, and at each doubling"
+    (let [entries (atom [])
+          t (trace/begin! (collecting entries) {:messages [{:role "user" :content "x"}]})]
+      (dotimes [i 17]
+        (trace/observe! t {:thinking (str (format "%03d" i) (apply str (repeat 997 \x)))}))
+      (is (= [8000 16000] (map :chars (filter #(= :long-reasoning (:kind %)) (suspects @entries)))))))
+  (testing "a reply and calls are not reasoning"
+    (let [entries (atom [])
+          t (trace/begin! (collecting entries) {:messages [{:role "user" :content "x"}]})]
+      (dotimes [_ 10]
+        (trace/observe! t {:content "Wait, let me check the board again. "}))
+      (is (empty? (suspects @entries))))))
+
+(deftest finish-test
+  (testing "the end of a turn sums it up, and only the first end counts"
+    (let [entries (atom [])
+          t (trace/begin! (collecting entries) {:messages [{:role "user" :content "x"}]})]
+      (trace/observe! t {:thinking "hm"})
+      (trace/observe! t {:thinking "m"})
+      (trace/observe! t {:content "Hi"})
+      (trace/observe! t {:finish-reason "stop" :usage {:prompt_tokens 7 :completion_tokens 3}})
+      (trace/finish! t {:outcome :done})
+      (trace/finish! t {:outcome :aborted})
+      (let [ends (filter #(= :turn-end (:event %)) @entries)
+            end (first ends)]
+        (is (= 1 (count ends)))
+        (is (= {:outcome :done :events 4 :thinking-chars 3 :content-chars 2 :finish-reason "stop"
+                :prompt-tokens 7 :completion-tokens 3 :flags []}
+               (select-keys end [:outcome :events :thinking-chars :content-chars :finish-reason
+                                 :prompt-tokens :completion-tokens :flags])))
+        (is (every? #(and (number? %) (>= % 0)) ((juxt :duration-ms :ttft-ms :think-ms) end)))
+        (is (not (contains? end :reasoning)) "the text stays out unless it is asked for"))))
+  (testing "the flags of a turn are what went wrong in it"
+    (let [entries (atom [])
+          t (trace/begin! (collecting entries) {:messages [{:role "user" :content "x"}]})]
+      (dotimes [_ 4] (trace/observe! t {:thinking "Wait, let me check the board again. "}))
+      (trace/observe! t {:finish-reason "length"})
+      (trace/finish! t {:outcome :done})
+      (is (= [:repeated-thinking :truncated] (:flags (last @entries))))))
+  (testing "a long call is cut, and the time spent thinking is the time until the answer"
+    (let [entries (atom [])
+          t (trace/begin! (collecting entries) {:messages [{:role "user" :content "x"}]})]
+      (trace/observe! t {:thinking "hm"})
+      (trace/observe! t {:call-deltas [{:index 0 :name "add"}]})
+      (trace/finish! t {:outcome :tool-calls :calls [(call "a" "add" (apply str (repeat 2000 \y)))]})
+      (let [end (last @entries)]
+        (is (= [{:name "add" :args (str (apply str (repeat 500 \y)) "…")}] (:calls end)))
+        (is (<= (:think-ms end) (:duration-ms end))))))
+  (testing "with the full text on, the turn ends with what the model said"
+    (let [entries (atom [])
+          t (trace/begin! (collecting entries :full-text? true) {:messages [{:role "user" :content "x"}]})]
+      (trace/observe! t {:thinking "One. "})
+      (trace/observe! t {:thinking "Two."})
+      (trace/observe! t {:content "Three"})
+      (trace/finish! t {:outcome :done})
+      (is (= {:reasoning "One. Two." :reply "Three"} (select-keys (last @entries) [:reasoning :reply])))))
+  (testing "a failure has its words"
+    (let [entries (atom [])
+          t (trace/begin! (collecting entries) {:messages [{:role "user" :content "x"}]})]
+      (trace/finish! t {:outcome :error :error "the LLM server's reply was cut off" :detail "reset"})
+      (is (= {:outcome :error :error "the LLM server's reply was cut off" :detail "reset"}
+             (select-keys (last @entries) [:outcome :error :detail]))))))
+
+(deftest render-test
+  (let [line (trace/render {:event :turn-end :req "ab12cd34" :run "00ff00ff" :step 2 :outcome :tool-calls
+                            :duration-ms 1200 :thinking-chars 0 :error "it broke" :detail nil :flags [:truncated :repeated-thinking]
+                            :calls [{:name "add" :args "{\"x\":1}"}] :reasoning "secret words" :reply "more" :input [{:role "user"}]
+                            :extra []})]
+    (testing "one line, the fields in a fixed order, the values readable"
+      (is (= (str "[tbd] chat turn-end req=ab12cd34 run=00ff00ff step=2 outcome=tool-calls duration-ms=1200 thinking-chars=0"
+                  " calls=\"add{\\\"x\\\":1}\" flags=truncated,repeated-thinking error=\"it broke\"")
+             line)))
+    (testing "the text of the conversation is for the file only"
+      (is (not (str/includes? line "secret")))
+      (is (not (str/includes? line "more")))))
+  (testing "a long argument is cut in the line"
+    (is (< (count (trace/render {:event :turn-end :calls [{:name "add" :args (apply str (repeat 1000 \z))}]})) 250))))
+
+(defn- temp-file ^File []
+  (doto (File/createTempFile "chat-trace" ".jsonl") .delete .deleteOnExit))
+
+(deftest sink-test
+  (testing "without a file, an entry is a line of the log"
+    (is (= "[tbd] chat turn-start req=a page=todos\n"
+           (with-out-str ((trace/sink nil) {:event :turn-start :req "a" :page "todos"})))))
+  (testing "with a file, it is also a line of JSON there, with everything in it"
+    (let [file (temp-file)
+          sink (trace/sink (str file))
+          out (with-out-str
+                (sink {:event :turn-end :req "a" :outcome :done :reasoning "long \"thoughts\"\nover lines" :flags [:truncated]})
+                (sink {:event :turn-start :req "b"}))
+          lines (str/split-lines (slurp file))
+          [end start] (map #(m/decode "application/json" %) lines)]
+      (is (not (str/includes? out "thoughts")) "the log has no text")
+      (is (= 2 (count lines)))
+      (is (= {:event "turn-end" :req "a" :outcome "done" :reasoning "long \"thoughts\"\nover lines" :flags ["truncated"]}
+             (dissoc end :ts)))
+      (is (= "turn-start" (:event start)))
+      (is (some? (java.time.Instant/parse (:ts end))))))
+  (testing "the file's folders are made"
+    (let [dir (doto (File/createTempFile "chat-trace" "") .delete)
+          file (File. dir "deeper/trace.jsonl")]
+      (with-out-str ((trace/sink (str file)) {:event :turn-start :req "a"}))
+      (is (.exists file))
+      (.delete file) (.delete (.getParentFile file)) (.delete dir)))
+  (testing "a file that can't be written to is complained about, and nothing is thrown"
+    (let [dir (doto (File/createTempFile "chat-trace" "") .delete .mkdirs)
+          out (try (with-out-str ((trace/sink (str dir)) {:event :turn-start :req "a"}))
+                   (finally (.delete dir)))]
+      (is (str/includes? out "[tbd] chat turn-start req=a"))
+      (is (str/includes? out "can't write the trace file")))))
+
+(deftest config-for-test
+  (testing "no file: the log only, and no full text"
+    (is (= {:full-text? false :file nil} (select-keys (trace/config-for nil) [:full-text? :file])))
+    (is (fn? (:sink (trace/config-for nil)))))
+  (testing "a file: the full text goes there"
+    (let [file (str (temp-file))]
+      (is (= {:full-text? true :file file} (select-keys (trace/config-for file) [:full-text? :file]))))))

test/tbd/core_test.clj

@@ -12,13 +12,31 @@
   (handler {:request-method method :uri uri :headers {}}))
 
 (deftest root-test
-  (let [resp (request :get "/")]
+  (let [resp (request :get "/")
+        body (slurp (:body resp))]
     (is (= 200 (:status resp)))
-    (is (= "text/plain; charset=utf-8" (get-in resp [:headers "Content-Type"])))
-    (is (re-find #"/api-docs" (:body resp))))
+    (is (= "text/html; charset=utf-8" (get-in resp [:headers "Content-Type"])))
+    (testing "serves the HTML shell that mounts the re-frame UI"
+      (is (re-find #"<div id=\"app\"" body))
+      (is (re-find #"<script src=\"/js/main\.js\"" body))))
   (testing "HEAD is served like GET, without a body"
     (is (= 200 (:status (request :head "/"))))))
 
+(deftest origin-trial-header-test
+  (let [get-root (fn [config]
+                   ((core/make-app config) {:request-method :get :uri "/" :headers {}}))]
+    (testing "the WebMCP origin-trial token is sent as an Origin-Trial header on the page"
+      (is (= "tok-123" (get-in (get-root (assoc core/config :webmcp {:origin-trial-token "tok-123"}))
+                               [:headers "Origin-Trial"]))))
+    (testing "no token, no header"
+      (is (nil? (get-in (get-root (assoc core/config :webmcp {:origin-trial-token nil}))
+                        [:headers "Origin-Trial"]))))))
+
+(deftest js-assets-test
+  ;; main.js only exists once script/ui-build has run, so only the miss is asserted here;
+  ;; the integration suite (which runs against the built image) checks the hit.
+  (is (= 404 (:status (request :get "/js/nope.js")))))
+
 (deftest swagger-spec-test
   (let [resp (request :get "/swagger.json")]
     (is (= 200 (:status resp)))

test/tbd/http_test.clj

@@ -0,0 +1,99 @@
+(ns tbd.http-test
+  (:require [clojure.test :refer [deftest is testing]]
+            [muuntaja.core :as m]
+            [tbd.auth.routes-test :as t]
+            [tbd.core :as core]
+            [tbd.http :as http]
+            [tbd.test-util :as test-util]
+            [tbd.sqlite-test :as sqlite-test])
+  (:import (java.io ByteArrayInputStream)))
+
+(defn call
+  "`headers` is a map; `body` a string or nil. The response body is decoded by its Content-Type."
+  [app method uri headers & [body]]
+  (test-util/decode-body
+    (app (cond-> {:request-method method :uri uri :headers headers}
+           body (assoc :body (ByteArrayInputStream. (.getBytes ^String body)))))))
+
+(defn content-type [resp] (get-in resp [:headers "Content-Type"]))
+
+(defn get-add-swagger []
+  (core/app {:request-method :get :uri "/swagger.json" :headers {}}))
+
+(deftest response-format-test
+  (let [get-add (fn [accept]
+                  (test-util/decode-body
+                    (core/app (cond-> {:request-method :get :uri "/api/add" :query-string "x=2&y=3" :headers {}}
+                                accept (assoc-in [:headers "accept"] accept)))))]
+    (testing "EDN is the default: no Accept, or one nothing here satisfies"
+      (doseq [accept [nil "*/*" "application/xml"]]
+        (let [resp (get-add accept)]
+          (is (= "application/edn; charset=utf-8" (content-type resp)) (str "accept: " accept))
+          (is (= {:result 5} (:body resp))))))
+    (testing "JSON when asked for"
+      (let [resp (core/app {:request-method :get :uri "/api/add" :query-string "x=2&y=3"
+                            :headers {"accept" "application/json"}})]
+        (is (= "application/json; charset=utf-8" (content-type resp)))
+        (is (= "{\"result\":5}" (slurp (:body resp))))))
+    (testing "Transit when asked for"
+      (let [resp (get-add "application/transit+json")]
+        (is (= "application/transit+json; charset=utf-8" (content-type resp)))
+        (is (= {:result 5} (:body resp)))))
+    (testing "the first Accept type we can produce wins"
+      (is (= "application/json; charset=utf-8" (content-type (get-add "application/xml, application/json")))))
+    (testing "text/plain responses are left alone"
+      (let [resp (core/app {:request-method :get :uri "/api/ping" :headers {"accept" "application/json"}})]
+        (is (= "text/plain; charset=utf-8" (content-type resp)))
+        (is (= "pong" (:body resp)))))
+    (testing "swagger.json stays JSON, even with no Accept header"
+      (is (= "application/json; charset=utf-8" (content-type (get-add-swagger)))))))
+
+(deftest error-format-test
+  (testing "errors follow the same negotiation"
+    (let [req (fn [accept] (core/app (cond-> {:request-method :get :uri "/api/add" :query-string "x=abc&y=3" :headers {}}
+                                       accept (assoc-in [:headers "accept"] accept))))]
+      (is (= "application/edn; charset=utf-8" (content-type (req nil))))
+      (is (= "application/json; charset=utf-8" (content-type (req "application/json"))))
+      (is (= 400 (:status (req "application/json"))))
+      (is (contains? (:body (test-util/decode-body (req "application/json"))) :error)))
+    (testing "including the auth middleware's 401"
+      (let [app (t/make-app (t/gitea-stub "alice"))
+            resp (call app :get "/api/todos" {"accept" "application/json"})]
+        (is (= 401 (:status resp)))
+        (is (= "application/json; charset=utf-8" (content-type resp)))
+        (is (= {:error "login required"} (:body resp)))
+        (is (= "application/edn; charset=utf-8" (content-type (call app :get "/api/todos" {}))))))))
+
+(deftest request-format-test
+  (let [app (t/make-app (t/gitea-stub "alice" 7) :db {:db-path (sqlite-test/temp-db-path)})
+        cookie (t/login! app)
+        post (fn [headers body] (call app :post "/api/todos" (assoc headers "cookie" cookie) body))]
+    (testing "JSON in, EDN out by default"
+      (let [resp (post {"content-type" "application/json"} "{\"title\":\"a\"}")]
+        (is (= 201 (:status resp)))
+        (is (= "application/edn; charset=utf-8" (content-type resp)))
+        (is (= "a" (:title (:body resp))))))
+    (testing "EDN in, JSON out when asked for"
+      (let [resp (post {"content-type" "application/edn" "accept" "application/json"} "{:title \"b\"}")]
+        (is (= 201 (:status resp)))
+        (is (= "application/json; charset=utf-8" (content-type resp)))
+        (is (= "b" (:title (:body resp))))))
+    (testing "with no Content-Type the body is EDN"
+      (let [resp (post {} "{:title \"c\"}")]
+        (is (= 201 (:status resp)))
+        (is (= "c" (:title (:body resp))))))
+    (testing "Transit in"
+      (let [body (String. (.readAllBytes (m/encode http/muuntaja "application/transit+json" {:title "d"})) "UTF-8")
+            resp (post {"content-type" "application/transit+json"} body)]
+        (is (= 201 (:status resp)))
+        (is (= "d" (:title (:body resp))))))
+    (testing "a body that isn't valid for its type is a 400 in the negotiated format"
+      (let [resp (post {"content-type" "application/json" "accept" "application/json"} "{:title \"e\"}")]
+        (is (= 400 (:status resp)))
+        (is (= "application/json; charset=utf-8" (content-type resp)))
+        (is (= {:error "malformed request body"} (:body resp))))
+      (is (= 400 (:status (post {} "{\"title\":\"f\"}")))
+          "JSON isn't assumed when nothing says so"))
+    (testing "listing shows only what was created"
+      (is (= ["a" "b" "c" "d"]
+             (map :title (:todos (:body (call app :get "/api/todos" {"cookie" cookie "accept" "application/json"})))))))))

test/tbd/math/routes_test.clj

@@ -1,18 +1,13 @@
 (ns tbd.math.routes-test
   (:require [clojure.edn :as edn]
             [clojure.test :refer [deftest is testing]]
-            [reitit.ring :as ring]
-            [ring.middleware.params :refer [wrap-params]]
-            [tbd.math.routes :as math]))
-
-;; wrap-params populates :query-params, as wrap-defaults does in tbd.core.
-(def handler
-  (wrap-params (ring/ring-handler (ring/router (math/routes)))))
+            [muuntaja.core :as m]
+            [tbd.core :as core]
+            [tbd.test-util :as test-util]))
 
+;; Coercion/validation is configured on the router in tbd.core, so go through the real app.
 (defn add [query]
-  (let [resp (handler {:request-method :get :uri "/api/add" :query-string query})]
-    (-> resp
-        (update :body edn/read-string))))
+  (test-util/decode-body (core/app {:request-method :get :uri "/api/add" :query-string query})))
 
 (deftest add-route-test
   (testing "integers"
@@ -27,4 +22,30 @@
     (doseq [query [nil "x=2" "y=3" "x=abc&y=3" "x=2&y=abc"]]
       (let [resp (add query)]
         (is (= 400 (:status resp)) (str "query: " query))
+        (is (= "application/edn; charset=utf-8" (get-in resp [:headers "Content-Type"])))
         (is (contains? (:body resp) :error))))))
+
+(deftest add-route-browser-test
+  (testing "browser navigations get an inline-renderable type so Chrome doesn't download the EDN"
+    (let [resp (core/app {:request-method :get :uri "/api/add" :query-string "x=2&y=3"
+                          :headers {"accept" "text/html,application/xhtml+xml,*/*;q=0.8"}})]
+      (is (= "text/plain; charset=utf-8" (get-in resp [:headers "Content-Type"])))
+      (is (= {:result 5} (edn/read-string (slurp (:body resp)))))))
+  (testing "programmatic clients still get application/edn"
+    (let [resp (core/app {:request-method :get :uri "/api/add" :query-string "x=2&y=3"
+                          :headers {"accept" "*/*"}})]
+      (is (= "application/edn; charset=utf-8" (get-in resp [:headers "Content-Type"]))))))
+
+(deftest add-route-swagger-test
+  (let [spec (-> (core/app {:request-method :get :uri "/swagger.json"
+                            :headers {"accept" "application/json"}})
+                 :body
+                 (->> (m/decode "application/json")))
+        params (->> (:paths spec)
+                    (some (fn [[path v]] (when (= "/api/add" (str (namespace path) "/" (name path))) v)))
+                    :get
+                    :parameters)]
+    (testing "x and y are documented as required numeric query params"
+      (is (= [{:name "x" :in "query" :type "number" :required true}
+              {:name "y" :in "query" :type "number" :required true}]
+             (map #(select-keys % [:name :in :type :required]) params))))))

test/tbd/mcp/routes_test.clj

@@ -0,0 +1,276 @@
+(ns tbd.mcp.routes-test
+  (:require [clojure.string :as str]
+            [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.sqlite-test :as sqlite-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- decode-body
+  "The JSON-RPC message in a response body. plumcp answers a POST either with plain JSON or, when
+  it decides to stream (which one is a matter of timing, so a slow CI runner sees the other), as
+  Server-Sent Events: a seq of chunks whose `data:` lines hold the message. Clients accept both,
+  so the tests must too."
+  [{:keys [body headers]}]
+  (cond
+    (string? body) (m/decode "application/json" body)
+    (and (some? body) (str/starts-with? (str (get headers "Content-Type")) "text/event-stream"))
+    (let [data (->> (str/split-lines (if (instance? java.io.InputStream body) (slurp body) (apply str body)))
+                    (keep #(when (str/starts-with? % "data:") (str/trim (subs % 5))))
+                    (str/join "\n"))]
+      (m/decode "application/json" data))
+    :else body))
+
+(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 body decoded, whether plain JSON or an event
+  stream (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
+       (some? (:body resp)) (assoc :body (decode-body resp))))))
+
+(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 (sqlite-test/temp-db-path)]
+    {:path path
+     :app (t/make-app (t/gitea-stub "alice" 7) :db {:db-path 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))))))
+        (let [get-todo (input-schema "get_todo")]
+          (is (= ["id"] (:required get-todo)))
+          (is (= "string" (get-in get-todo [:properties :id :type])) "an id is a string, not a number")
+          (is (re-find #"UUID" (get-in get-todo [:properties :id :description])))
+          (is (re-find (re-pattern (get-in get-todo [:properties :id :pattern])) (str (random-uuid)))))
+        (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 (sqlite-test/temp-db-path)
+        token (mint-token! path "alice" 7)
+        app-with (fn [admins] (t/make-app (t/gitea-stub "alice") :db {: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") :db {:db-path (sqlite-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 (sqlite-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
+  ;; The rules (ownership, validation, not-found) are tbd.todo.service's and tested there; this is
+  ;; the tools' side: arguments in, JSON out, the caller's identity passed on, errors as results.
+  (let [{:keys [app alice bob]} (fixture)
+        alice-sid (initialize app alice)
+        bob-sid (initialize app bob)
+        as-alice (partial call-tool app alice alice-sid)
+        as-bob (partial call-tool app bob bob-sid)
+        data (fn [resp] (m/decode "application/json" (text resp)))
+        error (fn [resp] (when (true? (get-in resp [:result :isError])) (text resp)))]
+    (is (= [] (data (as-alice "list_todos" {}))))
+    (let [created (data (as-alice "create_todo" {:title "  write tests "}))
+          id (:id created)]
+      (is (= {:title "write tests" :done false :owner-id 7} (select-keys created [:title :done :owner-id])))
+      (is (= created (data (as-alice "get_todo" {:id id}))))
+      (is (= [created] (data (as-alice "list_todos" {}))))
+      (is (= {:title "ship it" :done true}
+             (select-keys (data (as-alice "update_todo" {:id id :title "ship it" :done true})) [:title :done])))
+      (testing "the tools act as whoever the token belongs to"
+        (is (= [] (data (as-bob "list_todos" {}))))
+        (is (= "todo not found" (error (as-bob "get_todo" {:id id})))))
+      (testing "a service error is an error result the model can read"
+        (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})))))
+      (is (= "deleted" (text (as-alice "delete_todo" {:id id}))))
+      (is (= "todo not found" (error (as-alice "get_todo" {:id id})))))))
+
+(deftest tool-arguments-are-validated-test
+  (let [{:keys [app alice]} (fixture)
+        todo-id "3f2b8c1e-5a47-4d0e-9b6a-1c2d3e4f5a6b"
+        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 a UUID\"]}" (error "get_todo" {:id "abc"})))
+      (is (= "invalid arguments: {:id [\"should be a UUID\"]}" (error "get_todo" {:id 1})) "todo ids are not integers")
+      (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 todo-id :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 todo-id :done "yes"})))
+      (is (true? (malli/validate todo-schema/UpdateTodo {:id todo-id :done true}))))))

test/tbd/nrepl/core_test.clj

@@ -0,0 +1,40 @@
+(ns tbd.nrepl.core-test
+  (:require [clojure.test :refer [deftest is testing use-fixtures]]
+            [tbd.nrepl.core :as nrepl])
+  (:import (java.net ConnectException InetSocketAddress Socket ServerSocket)))
+
+(use-fixtures :each (fn [t] (try (t) (finally (nrepl/disable!)))))
+
+(defn listening? [port]
+  (try (with-open [s (Socket.)]
+         (.connect s (InetSocketAddress. "127.0.0.1" (int port)) 500)
+         true)
+       (catch java.io.IOException _ false)))
+
+(deftest env-config-test
+  (is (= {:port 7888 :bind "127.0.0.1"} (nrepl/env-config {})))
+  (is (= {:port 7888 :bind "127.0.0.1"} (nrepl/env-config {"NREPL_PORT" " " "NREPL_BIND" ""})))
+  (is (= {:port 9000 :bind "0.0.0.0"} (nrepl/env-config {"NREPL_PORT" "9000" "NREPL_BIND" "0.0.0.0"}))))
+
+(deftest enable-disable-test
+  (is (= {:enabled false} (nrepl/status)))
+  (let [{:keys [enabled bind port] :as status} (nrepl/enable! {:port 0 :bind "127.0.0.1"})]
+    (is (true? enabled))
+    (is (= "127.0.0.1" bind))
+    (is (pos? port) "port 0 reports the port actually bound")
+    (is (= status (nrepl/status)))
+    (is (listening? port))
+    (testing "enabling again is a no-op"
+      (is (= status (nrepl/enable! {:port 0 :bind "127.0.0.1"}))))
+    (testing "disabling closes the port"
+      (is (= {:enabled false} (nrepl/disable!)))
+      (is (= {:enabled false} (nrepl/status)))
+      (is (not (listening? port))))
+    (testing "disabling again is a no-op"
+      (is (= {:enabled false} (nrepl/disable!))))))
+
+(deftest enable-failure-test
+  (with-open [taken (ServerSocket. 0 1 (java.net.InetAddress/getByName "127.0.0.1"))]
+    (is (thrown? java.net.BindException
+                 (nrepl/enable! {:port (.getLocalPort taken) :bind "127.0.0.1"})))
+    (is (= {:enabled false} (nrepl/status)) "a failed start leaves nREPL disabled")))

test/tbd/nrepl/routes_test.clj

@@ -0,0 +1,118 @@
+(ns tbd.nrepl.routes-test
+  (:require [clojure.test :refer [deftest is testing use-fixtures]]
+            [muuntaja.core :as m]
+            [tbd.auth.routes-test :as t]
+            [tbd.test-util :as test-util]
+            [tbd.nrepl.core :as nrepl])
+  (:import (java.io ByteArrayInputStream)
+           (java.net InetAddress ServerSocket)))
+
+(use-fixtures :each (fn [f] (try (f) (finally (nrepl/disable!)))))
+
+(defn post-nrepl
+  "POST /nrepl with `body` (a string, or nil for none), as JSON unless `content-type` says otherwise.
+  The handler logs each toggle; that's kept out of the test output."
+  ([app cookie body] (post-nrepl app cookie body "application/json"))
+  ([app cookie body content-type]
+   (let [resp (atom nil)]
+     (with-out-str
+       (reset! resp (app (cond-> {:request-method :post :uri "/nrepl"
+                                  :headers (cond-> {"content-type" content-type}
+                                             cookie (assoc "cookie" cookie))}
+                           body (assoc :body (ByteArrayInputStream. (.getBytes ^String body)))))))
+     (test-util/decode-body @resp))))
+
+(defn get-nrepl [app cookie]
+  (let [resp (app {:request-method :get :uri "/nrepl"
+                   :headers (cond-> {} cookie (assoc "cookie" cookie))})]
+    (test-util/decode-body resp)))
+
+(deftest anonymous-test
+  (let [app (t/make-app (t/gitea-stub "alice"))]
+    (doseq [body ["{\"enabled\":true}" "{\"enabled\":\"junk\"}" nil]]
+      (let [resp (post-nrepl app nil body)]
+        (is (= 401 (:status resp)) (str "body: " body))))
+    (is (= 401 (:status (get-nrepl app nil))))
+    (is (= {:enabled false} (nrepl/status)) "nothing was started")))
+
+(deftest non-admin-test
+  (let [app (t/make-app (t/gitea-stub "mallory"))
+        cookie (t/login! app)]
+    (is (= 403 (:status (post-nrepl app cookie "{\"enabled\":true}"))))
+    (is (= 403 (:status (get-nrepl app cookie))))
+    (is (= {:enabled false} (nrepl/status)) "nothing was started")))
+
+(deftest empty-allowlist-test
+  (let [app (t/make-app (t/gitea-stub "alice") :admin-users #{})
+        cookie (t/login! app)]
+    (is (= 403 (:status (post-nrepl app cookie "{\"enabled\":true}"))))))
+
+(deftest admin-test
+  (let [app (t/make-app (t/gitea-stub "Alice"))
+        cookie (t/login! app)]
+    (testing "enable"
+      (let [resp (post-nrepl app cookie "{\"enabled\":true}")]
+        (is (= 200 (:status resp)))
+        (is (= "application/edn; charset=utf-8" (get-in resp [:headers "Content-Type"])))
+        (is (= {:enabled true :bind "127.0.0.1"} (dissoc (:body resp) :port)))
+        (is (pos? (get-in resp [:body :port])))
+        (is (= (:body resp) (nrepl/status)))))
+    (testing "disable"
+      (let [resp (post-nrepl app cookie "{\"enabled\":false}")]
+        (is (= 200 (:status resp)))
+        (is (= {:enabled false} (:body resp)))
+        (is (= {:enabled false} (nrepl/status)))))
+    (testing "EDN bodies work too"
+      (let [resp (post-nrepl app cookie "{:enabled true}" "application/edn")]
+        (is (= 200 (:status resp)))
+        (is (true? (get-in resp [:body :enabled])))))))
+
+(deftest status-test
+  (let [app (t/make-app (t/gitea-stub "alice"))
+        cookie (t/login! app)]
+    (testing "off"
+      (let [resp (get-nrepl app cookie)]
+        (is (= 200 (:status resp)))
+        (is (= "application/edn; charset=utf-8" (get-in resp [:headers "Content-Type"])))
+        (is (= {:enabled false} (:body resp)))))
+    (testing "on"
+      (with-out-str (post-nrepl app cookie "{\"enabled\":true}"))
+      (let [resp (get-nrepl app cookie)]
+        (is (= 200 (:status resp)))
+        (is (= {:enabled true :bind "127.0.0.1"} (dissoc (:body resp) :port)))
+        (is (= (:body resp) (nrepl/status)))))
+    (testing "off again"
+      (with-out-str (post-nrepl app cookie "{\"enabled\":false}"))
+      (is (= {:enabled false} (:body (get-nrepl app cookie)))))))
+
+(deftest invalid-body-test
+  (let [app (t/make-app (t/gitea-stub "alice"))
+        cookie (t/login! app)]
+    (doseq [body [nil "{}" "{\"enabled\":\"maybe\"}" "{\"enabled\":null}" "not json"]]
+      (let [resp (post-nrepl app cookie body)]
+        (is (= 400 (:status resp)) (str "body: " body))
+        (is (contains? (:body resp) :error) (str "body: " body))))
+    (is (= {:enabled false} (nrepl/status)))))
+
+(deftest bind-failure-test
+  (with-open [taken (ServerSocket. 0 1 (InetAddress/getByName "127.0.0.1"))]
+    (let [app (tbd.core/make-app
+                {:auth {:gitea-url "https://gitea.test" :client-id "cid" :client-secret "sec"
+                        :redirect-uri "http://tbd.test/auth/callback" :admin-users #{"alice"}
+                        :session-secret "test-secret" :http (t/gitea-stub "alice")}
+                 :nrepl {:port (.getLocalPort taken) :bind "127.0.0.1"}})
+          cookie (t/login! app)
+          resp (post-nrepl app cookie "{\"enabled\":true}")]
+      (is (= 500 (:status resp)))
+      (is (re-find #"could not change nREPL state" (get-in resp [:body :error])))
+      (is (= {:enabled false} (nrepl/status))))))
+
+(deftest swagger-test
+  (let [app (t/make-app (t/gitea-stub "alice"))
+        spec (-> (app {:request-method :get :uri "/swagger.json" :headers {"accept" "application/json"}})
+                 :body
+                 (->> (m/decode "application/json")))
+        paths (into {} (map (fn [[k v]] [(str (namespace k) "/" (name k)) v])) (:paths spec))]
+    (is (contains? (get-in paths ["/nrepl"]) :post) "documented")
+    (is (contains? (get-in paths ["/nrepl"]) :get) "documented")
+    (is (contains? paths "/auth/login"))))

test/tbd/oauth/core_test.clj

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

test/tbd/oauth/db_test.clj

@@ -0,0 +1,111 @@
+(ns tbd.oauth.db-test
+  (:require [clojure.java.io :as io]
+            [clojure.test :refer [deftest is testing]]
+            [next.jdbc :as jdbc]
+            [tbd.oauth.db :as db]
+            [tbd.sqlite-test :refer [temp-db-path]]))
+
+(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 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 (uuid? (parse-uuid (:id (db/find-grant-by-refresh ds "refresh-1")))) "a grant's id is a UUID")
+      (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")))))
+
+(deftest integer-grant-ids-are-migrated-test
+  (testing "grants from before ids were UUIDs survive, under new ids, and still work"
+    (let [path (temp-db-path)
+          _ (io/make-parents path)
+          old (jdbc/get-datasource {:dbtype "sqlite" :dbname path})]
+      (jdbc/execute! old ["CREATE TABLE 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! old ["INSERT INTO grants (client_id, user_id, login, scope, access_hash, access_expires_at,
+                                               refresh_hash, refresh_expires_at, created_at)
+                           VALUES ('c1', 7, 'alice', 'mcp', 'access-1', 2000, 'refresh-1', 9000, 1000)"])
+      (let [ds (db/open path)
+            migrated (db/find-grant-by-access ds "access-1" 1000)]
+        (is (= {:client-id "c1" :user-id 7 :login "alice" :scope "mcp" :refresh-hash "refresh-1"}
+               (select-keys migrated [:client-id :user-id :login :scope :refresh-hash])))
+        (is (uuid? (parse-uuid (:id migrated))))
+        (is (some? (db/rotate-grant! ds (:id migrated) "refresh-1"
+                                     {:access-hash "access-2" :access-expires-at 3000
+                                      :refresh-hash "refresh-2" :refresh-expires-at 9500})))))))

test/tbd/oauth/routes_test.clj

@@ -0,0 +1,379 @@
+(ns tbd.oauth.routes-test
+  (:require [clojure.string :as str]
+            [clojure.test :refer [deftest is testing]]
+            [muuntaja.core :as m]
+            [tbd.auth.core :as auth]
+            [tbd.auth.routes-test :as t]
+            [tbd.oauth.core :as oauth]
+            [tbd.oauth.db :as db]
+            [tbd.sqlite-test :as sqlite-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) :db {: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 (sqlite-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 (sqlite-test/temp-db-path)
+        app (t/make-app (t/gitea-stub "alice") :db {: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 (sqlite-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 (sqlite-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 (sqlite-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 (sqlite-test/temp-db-path))
+        client-id (register! app {:client_name "<script>alert(1)</script>"})
+        {:keys [page csrf]} (consent! app (t/login! app) (authorize-params client-id))]
+    (is (= 200 (:status page)))
+    (testing "shows who, what for and where to, escaping what the client chose"
+      (is (str/includes? (:body page) "&lt;script&gt;alert(1)&lt;/script&gt;"))
+      (is (not (str/includes? (:body page) "<script>")))
+      (is (str/includes? (:body page) "alice"))
+      (is (str/includes? (:body page) redirect-uri)))
+    (testing "carries a CSRF token, and the request it will approve"
+      (is (some? csrf))
+      (doseq [k ["client_id" "redirect_uri" "code_challenge" "state"]]
+        (is (str/includes? (:body page) (str "name=\"" k "\"")) k)))
+    (testing "can't be framed or cached"
+      (is (= "DENY" (get-in page [:headers "X-Frame-Options"])))
+      (is (str/includes? (get-in page [:headers "Content-Security-Policy"]) "frame-ancestors 'none'"))
+      (is (= "no-store" (get-in page [:headers "Cache-Control"]))))))
+
+(deftest consent-decision-test
+  (let [app (app-for (sqlite-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 (sqlite-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 (sqlite-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]))))))

test/tbd/sqlite_test.clj

@@ -0,0 +1,44 @@
+(ns tbd.sqlite-test
+  (:require [clojure.java.io :as io]
+            [clojure.test :refer [deftest is testing]]
+            [next.jdbc :as jdbc]
+            [tbd.oauth.db :as oauth-db]
+            [tbd.sqlite :as sqlite]
+            [tbd.todo.db :as todo-db])
+  (:import (java.nio.file Files)
+           (java.nio.file.attribute FileAttribute)))
+
+(defn temp-db-path
+  "A path for a database file inside a fresh temp directory (which `open` has to create a
+  subdirectory of, as with the default data/tbd.db)."
+  []
+  (str (Files/createTempDirectory "tbd" (make-array FileAttribute 0)) "/data/tbd.db"))
+
+(deftest env-config-test
+  (is (= {:db-path "data/tbd.db"} (sqlite/env-config {})))
+  (is (= {:db-path "data/tbd.db"} (sqlite/env-config {"DB_PATH" "  "})))
+  (is (= {:db-path "/var/tbd.db"} (sqlite/env-config {"DB_PATH" " /var/tbd.db "}))))
+
+(deftest open-test
+  (testing "creates the file and its directory"
+    (let [path (temp-db-path)]
+      (sqlite/open path todo-db/migrate!)
+      (is (.exists (io/file path)))))
+  (testing "no path is an error, not a database in the working directory"
+    (is (thrown? clojure.lang.ExceptionInfo (sqlite/open nil)))
+    (is (thrown? clojure.lang.ExceptionInfo (sqlite/open " "))))
+  (testing "every migration runs on the datasource, and again (harmlessly) on reopening"
+    (let [path (temp-db-path)
+          tables #(set (map :name (jdbc/execute! % ["SELECT name FROM sqlite_master WHERE type = 'table'"]
+                                                 {:builder-fn next.jdbc.result-set/as-unqualified-maps})))]
+      (is (every? (tables (sqlite/open path todo-db/migrate! oauth-db/migrate!))
+                  ["todos" "clients" "codes" "grants"]))
+      (is (every? (tables (sqlite/open path todo-db/migrate! oauth-db/migrate!))
+                  ["todos" "clients" "codes" "grants"]))))
+  (testing "the groups keep their data apart in the one file"
+    (let [path (temp-db-path)
+          ds (sqlite/open path todo-db/migrate! oauth-db/migrate!)]
+      (todo-db/insert! ds {:owner-id 7 :title "buy milk" :done false :created-at 1 :updated-at 1})
+      (oauth-db/insert-client! ds {:id "c1" :name "Test client" :redirect-uris ["http://localhost/cb"] :created-at 1})
+      (is (= ["buy milk"] (map :title (todo-db/list-todos ds 7))))
+      (is (= "c1" (:id (oauth-db/find-client ds "c1")))))))

test/tbd/test_util.clj

@@ -0,0 +1,14 @@
+(ns tbd.test-util
+  (:require [clojure.string :as str]
+            [muuntaja.core :as m]
+            [tbd.http :as http]))
+
+(defn decode-body
+  "Reads a response's body back into data by the response's own Content-Type (JSON, EDN or
+  Transit). Bodies that aren't one of those, like text/plain, are left alone."
+  [resp]
+  (let [content-type (get-in resp [:headers "Content-Type"] "")
+        body (:body resp)]
+    (if (and body (not (string? body)) (re-find #"json|edn|transit" content-type))
+      (update resp :body #(m/decode http/muuntaja (first (str/split content-type #";")) %))
+      resp)))

test/tbd/todo/core_test.clj

@@ -0,0 +1,41 @@
+(ns tbd.todo.core-test
+  (:require [clojure.test :refer [deftest is testing]]
+            [tbd.todo.core :as todo]))
+
+(deftest validate-title-test
+  (testing "trims"
+    (is (= {:ok "buy milk"} (todo/validate-title "  buy milk\n"))))
+  (testing "blank or missing"
+    (doseq [title [nil "" "   " "\t\n"]]
+      (is (= {:error "title must not be blank"} (todo/validate-title title)) (pr-str title))))
+  (testing "length is checked after trimming"
+    (let [longest (apply str (repeat todo/max-title-length "x"))]
+      (is (= {:ok longest} (todo/validate-title (str "  " longest " "))))
+      (is (contains? (todo/validate-title (str longest "x")) :error)))))
+
+(deftest new-todo-test
+  (is (= {:ok {:owner-id 7 :title "buy milk" :done false :created-at 1000 :updated-at 1000}}
+         (todo/new-todo 7 " buy milk " 1000)))
+  (is (= {:error "title must not be blank"} (todo/new-todo 7 "  " 1000))))
+
+(def stored {:id "3f2b8c1e-5a47-4d0e-9b6a-1c2d3e4f5a6b" :owner-id 7 :title "buy milk" :done false :created-at 1000 :updated-at 1000})
+
+(deftest apply-changes-test
+  (testing "title"
+    (is (= {:ok (assoc stored :title "buy oat milk" :updated-at 2000)}
+           (todo/apply-changes stored {:title " buy oat milk "} 2000))))
+  (testing "done, both ways"
+    (let [done (:ok (todo/apply-changes stored {:done true} 2000))]
+      (is (= (assoc stored :done true :updated-at 2000) done))
+      (is (= (assoc stored :updated-at 3000) (:ok (todo/apply-changes done {:done false} 3000))))))
+  (testing "both at once"
+    (is (= {:ok (assoc stored :title "x" :done true :updated-at 2000)}
+           (todo/apply-changes stored {:title "x" :done true} 2000))))
+  (testing "an invalid title changes nothing"
+    (is (= {:error "title must not be blank"} (todo/apply-changes stored {:title " " :done true} 2000))))
+  (testing "only :title and :done can change; the rest of the todo is untouched"
+    (is (= {:ok (assoc stored :done true :updated-at 2000)}
+           (todo/apply-changes stored {:done true :id 99 :owner-id 8 :created-at 0} 2000))))
+  (testing "no changes"
+    (doseq [changes [{} {:id 99} nil]]
+      (is (contains? (todo/apply-changes stored changes 2000) :error) (pr-str changes)))))

test/tbd/todo/db_test.clj

@@ -0,0 +1,96 @@
+(ns tbd.todo.db-test
+  (:require [clojure.java.io :as io]
+            [clojure.test :refer [deftest is testing]]
+            [next.jdbc :as jdbc]
+            [tbd.sqlite-test :refer [temp-db-path]]
+            [tbd.todo.db :as db]))
+
+(defn todo [owner-id title]
+  {:owner-id owner-id :title title :done false :created-at 1000 :updated-at 1000})
+
+(deftest open-test
+  (testing "creates the file and its directory"
+    (let [path (temp-db-path)]
+      (db/open path)
+      (is (.exists (io/file path)))))
+  (testing "reopening keeps the data"
+    (let [path (temp-db-path)
+          saved (db/insert! (db/open path) (todo 7 "buy milk"))]
+      (is (= [saved] (db/list-todos (db/open path) 7)))))
+  (testing "a path is required"
+    (doseq [path [nil "" " "]]
+      (is (thrown? clojure.lang.ExceptionInfo (db/open path))))))
+
+(deftest crud-test
+  (let [ds (db/open (temp-db-path))
+        saved (db/insert! ds (todo 7 "buy milk"))
+        id (:id saved)]
+    (testing "insert returns the stored todo with an id"
+      (is (= (assoc (todo 7 "buy milk") :id id) saved))
+      (is (re-matches #"[0-9a-f]{8}-[0-9a-f]{4}-4[0-9a-f]{3}-[89ab][0-9a-f]{3}-[0-9a-f]{12}" id) "a UUID, not a number")
+      (is (not= id (:id (db/insert! ds (todo 7 "walk dog"))))))
+    (testing "find and list"
+      (is (= saved (db/find-todo ds 7 id)))
+      (is (= ["buy milk" "walk dog"] (map :title (db/list-todos ds 7)))))
+    (testing "update"
+      (is (= (assoc saved :title "buy oat milk" :done true :updated-at 2000)
+             (db/update! ds 7 (assoc saved :title "buy oat milk" :done true :updated-at 2000))))
+      (is (= true (:done (db/find-todo ds 7 id)))))
+    (testing "missing ids"
+      (let [missing (str (random-uuid))]
+        (is (nil? (db/find-todo ds 7 missing)))
+        (is (nil? (db/update! ds 7 (assoc saved :id missing))))
+        (is (false? (db/delete! ds 7 missing)))))
+    (testing "delete"
+      (is (true? (db/delete! ds 7 id)))
+      (is (nil? (db/find-todo ds 7 id)))
+      (is (false? (db/delete! ds 7 id))))))
+
+(deftest owner-scoping-test
+  (let [ds (db/open (temp-db-path))
+        mine (db/insert! ds (todo 7 "mine"))
+        theirs (db/insert! ds (todo 8 "theirs"))]
+    (is (= [mine] (db/list-todos ds 7)))
+    (is (= [theirs] (db/list-todos ds 8)))
+    (is (= [] (db/list-todos ds 9)))
+    (testing "another owner's todo can't be found, changed, or deleted by its id"
+      (is (nil? (db/find-todo ds 8 (:id mine))))
+      (is (nil? (db/update! ds 8 (assoc mine :title "hijacked"))))
+      (is (false? (db/delete! ds 8 (:id mine))))
+      (is (= mine (db/find-todo ds 7 (:id mine)))))))
+
+(deftest list-order-test
+  (testing "todos come oldest first, though their ids, being random, say nothing of the order"
+    (let [ds (db/open (temp-db-path))
+          titles (mapv #(str "todo " %) (range 20))]
+      (doseq [title titles] (db/insert! ds (todo 7 title)))
+      (db/insert! ds (assoc (todo 7 "the newest") :created-at 5000))
+      (db/insert! ds (assoc (todo 7 "the oldest") :created-at 1))
+      (is (= (concat ["the oldest"] titles ["the newest"]) (map :title (db/list-todos ds 7)))))))
+
+(deftest integer-ids-are-migrated-test
+  (testing "a database from before ids were UUIDs keeps its todos, in order, under new ids"
+    (let [path (temp-db-path)
+          _ (io/make-parents path)
+          old (jdbc/get-datasource {:dbtype "sqlite" :dbname path})]
+      (jdbc/execute! old ["CREATE TABLE todos (
+                             id         INTEGER PRIMARY KEY AUTOINCREMENT,
+                             owner_id   INTEGER NOT NULL,
+                             title      TEXT    NOT NULL,
+                             done       INTEGER NOT NULL DEFAULT 0,
+                             created_at INTEGER NOT NULL,
+                             updated_at INTEGER NOT NULL)"])
+      (jdbc/execute! old ["CREATE INDEX todos_by_owner ON todos (owner_id, id)"])
+      (doseq [[owner title done] [[7 "first" 0] [8 "theirs" 0] [7 "second" 1]]]
+        (jdbc/execute! old ["INSERT INTO todos (owner_id, title, done, created_at, updated_at) VALUES (?, ?, ?, 1000, 1000)"
+                            owner title done]))
+      (let [ds (db/open path)
+            mine (db/list-todos ds 7)]
+        (is (= [["first" false] ["second" true]] (map (juxt :title :done) mine)))
+        (is (every? (comp uuid? parse-uuid :id) mine))
+        (is (= ["theirs"] (map :title (db/list-todos ds 8))))
+        (testing "and is only migrated once"
+          (is (= mine (db/list-todos (db/open path) 7))))
+        (testing "and works as a new one does"
+          (db/insert! ds (todo 7 "third"))
+          (is (= ["first" "second" "third"] (map :title (db/list-todos ds 7)))))))))

test/tbd/todo/routes_test.clj

@@ -0,0 +1,107 @@
+(ns tbd.todo.routes-test
+  (:require [clojure.java.io :as io]
+            [clojure.test :refer [deftest is testing]]
+            [tbd.auth.routes-test :as t]
+            [tbd.test-util :as test-util]
+            [tbd.sqlite-test :as sqlite-test])
+  (:import (java.io ByteArrayInputStream)))
+
+(defn request
+  "`body` is a JSON string (or nil). The response body is decoded by its Content-Type."
+  [app method uri cookie & [body]]
+  (let [resp (app (cond-> {:request-method method :uri uri :headers (cond-> {} cookie (assoc "cookie" cookie))}
+                    body (-> (assoc :body (ByteArrayInputStream. (.getBytes ^String body)))
+                             (assoc-in [:headers "content-type"] "application/json"))))]
+    (test-util/decode-body resp)))
+
+(defn app-for [db-path login id]
+  (t/make-app (t/gitea-stub login id) :db {:db-path db-path}))
+
+(def ^:private todos "/api/todos")
+
+(deftest anonymous-test
+  (let [path (sqlite-test/temp-db-path)
+        app (app-for path "alice" 7)]
+    (doseq [[method uri body] [[:get todos nil]
+                               [:post todos "{\"title\":\"x\"}"]
+                               [:post todos "nope"]
+                               [:get (str todos "/1") nil]
+                               [:patch (str todos "/1") "{\"done\":true}"]
+                               [:delete (str todos "/1") nil]]]
+      (let [resp (request app method uri nil body)]
+        (is (= 401 (:status resp)) (str method " " uri))
+        (is (= {:error "login required"} (:body resp)))))
+    (is (not (.exists (io/file path))) "the database isn't even opened")))
+
+(deftest lifecycle-test
+  (let [app (app-for (sqlite-test/temp-db-path) "alice" 7)
+        cookie (t/login! app)]
+    (testing "starts empty"
+      (let [resp (request app :get todos cookie)]
+        (is (= 200 (:status resp)))
+        (is (= "application/edn; charset=utf-8" (get-in resp [:headers "Content-Type"])))
+        (is (= {:todos []} (:body resp)))))
+    (testing "create"
+      (let [resp (request app :post todos cookie "{\"title\":\"  buy milk \"}")
+            {:keys [id] :as created} (:body resp)]
+        (is (= 201 (:status resp)))
+        (is (= {:owner-id 7 :title "buy milk" :done false} (select-keys created [:owner-id :title :done])))
+        (is (uuid? (parse-uuid id)))
+        (testing "get"
+          (is (= created (:body (request app :get (str todos "/" id) cookie)))))
+        (testing "patch"
+          (let [resp (request app :patch (str todos "/" id) cookie "{\"done\":true}")]
+            (is (= 200 (:status resp)))
+            (is (= (dissoc (assoc created :done true) :updated-at) (dissoc (:body resp) :updated-at))))
+          (is (= "oat milk" (:title (:body (request app :patch (str todos "/" id) cookie "{\"title\":\"oat milk\"}"))))))
+        (testing "list"
+          (request app :post todos cookie "{\"title\":\"walk dog\"}")
+          (is (= ["oat milk" "walk dog"] (map :title (:todos (:body (request app :get todos cookie)))))))
+        (testing "delete"
+          (is (= {:status 200 :body {:deleted true}}
+                 (select-keys (request app :delete (str todos "/" id) cookie) [:status :body])))
+          (is (= 404 (:status (request app :get (str todos "/" id) cookie))))
+          (is (= 404 (:status (request app :delete (str todos "/" id) cookie))))
+          (is (= ["walk dog"] (map :title (:todos (:body (request app :get todos cookie)))))))))))
+
+(deftest validation-test
+  (let [app (app-for (sqlite-test/temp-db-path) "alice" 7)
+        cookie (t/login! app)
+        created (:body (request app :post todos cookie "{\"title\":\"keep\"}"))
+        one (str todos "/" (:id created))]
+    (testing "bad titles on create"
+      (doseq [body ["{\"title\":\"\"}" "{\"title\":\"   \"}" "{}" "{\"title\":5}" "{\"title\":null}" "nope"
+                    (format "{\"title\":\"%s\"}" (apply str (repeat 201 "x")))]]
+        (let [resp (request app :post todos cookie body)]
+          (is (= 400 (:status resp)) body)
+          (is (contains? (:body resp) :error)))))
+    (testing "bad changes"
+      (doseq [body ["{}" "{\"title\":\" \"}" "{\"done\":\"yes\"}" "{\"id\":99}"]]
+        (is (= 400 (:status (request app :patch one cookie body))) body))
+      (is (= 400 (:status (request app :patch one cookie))) "no body"))
+    (testing "an id that is not a UUID (an integer, as todos used to have, included)"
+      (doseq [method [:get :patch :delete]
+              id ["abc" "1"]]
+        (is (= 400 (:status (request app method (str todos "/" id) cookie "{\"done\":true}"))) (str method " " id))))
+    (is (= [created] (:todos (:body (request app :get todos cookie)))) "nothing above changed the todo")))
+
+(deftest per-user-scoping-test
+  (let [path (sqlite-test/temp-db-path)
+        alice-app (app-for path "alice" 7)
+        bob-app (app-for path "bob" 8)
+        alice (t/login! alice-app)
+        bob (t/login! bob-app)
+        {:keys [id] :as mine} (:body (request alice-app :post todos alice "{\"title\":\"alice's\"}"))
+        one (str todos "/" id)]
+    (testing "each user lists only their own"
+      (is (= [] (:todos (:body (request bob-app :get todos bob)))))
+      (request bob-app :post todos bob "{\"title\":\"bob's\"}")
+      (is (= ["alice's"] (map :title (:todos (:body (request alice-app :get todos alice))))))
+      (is (= ["bob's"] (map :title (:todos (:body (request bob-app :get todos bob)))))))
+    (testing "someone else's todo is indistinguishable from a missing one"
+      (let [missing (request bob-app :get (str todos "/" (random-uuid)) bob)]
+        (doseq [[method body] [[:get nil] [:patch "{\"title\":\"hijacked\"}"] [:delete nil]]]
+          (let [resp (request bob-app method one bob body)]
+            (is (= 404 (:status resp)) (str method))
+            (is (= (:body missing) (:body resp)))))))
+    (is (= mine (:body (request alice-app :get one alice))) "alice's todo is untouched")))

test/tbd/todo/service_test.clj

@@ -0,0 +1,75 @@
+(ns tbd.todo.service-test
+  (:require [clojure.test :refer [deftest is testing]]
+            [tbd.todo.core :as todo]
+            [tbd.todo.db :as db]
+            [tbd.sqlite-test :as sqlite-test]
+            [tbd.todo.service :as service]))
+
+;; The rules every front end (HTTP routes, MCP tools) gets: ownership, not-found and validation.
+;; They are tested here once; the front ends' tests only cover their own translation.
+
+(def alice {:id 7 :login "alice"})
+(def bob {:id 8 :login "bob"})
+
+(defn- fresh-ds [] (let [path (sqlite-test/temp-db-path)] (delay (db/open path))))
+
+(def ^:private not-found {:error "todo not found" :kind :not-found})
+
+(deftest lifecycle-test
+  (let [ds (fresh-ds)]
+    (is (= {:ok []} (service/list-todos ds alice)))
+    (let [{created :ok} (service/create! ds alice "  buy milk ")
+          id (:id created)]
+      (testing "create trims the title, makes it the user's and returns it stored"
+        (is (= {:owner-id 7 :title "buy milk" :done false} (select-keys created [:owner-id :title :done])))
+        (is (uuid? (parse-uuid id))))
+      (is (= {:ok created} (service/find-todo ds alice id)))
+      (is (= {:ok [created]} (service/list-todos ds alice)))
+      (testing "update changes the title and/or done"
+        (is (= {:title "buy milk" :done true}
+               (select-keys (:ok (service/update! ds alice id {:done true})) [:title :done])))
+        (is (= {:title "oat milk" :done true}
+               (select-keys (:ok (service/update! ds alice id {:title "oat milk"})) [:title :done])))
+        (is (= "oat milk" (:title (:ok (service/find-todo ds alice id)))) "and it is stored"))
+      (testing "delete"
+        (is (= {:ok true} (service/delete! ds alice id)))
+        (is (= not-found (service/find-todo ds alice id)))
+        (is (= not-found (service/delete! ds alice id)))
+        (is (= {:ok []} (service/list-todos ds alice)))))))
+
+(deftest validation-test
+  (let [ds (fresh-ds)
+        id (:id (:ok (service/create! ds alice "keep")))]
+    (testing "the rules of tbd.todo.core apply, as :invalid"
+      (is (= {:error "title must not be blank" :kind :invalid} (service/create! ds alice "   ")))
+      (is (= {:error (format "title must be at most %d characters" todo/max-title-length) :kind :invalid}
+             (service/create! ds alice (apply str (repeat (inc todo/max-title-length) "x")))))
+      (is (= {:error "title must not be blank" :kind :invalid} (service/update! ds alice id {:title " "})))
+      (is (= {:error "nothing to change: give a title and/or done" :kind :invalid}
+             (service/update! ds alice id {}))))
+    (is (= ["keep"] (map :title (:ok (service/list-todos ds alice)))) "nothing above changed anything")))
+
+(deftest ownership-test
+  (let [ds (fresh-ds)
+        {mine :ok} (service/create! ds alice "alice's")
+        id (:id mine)]
+    (testing "each user has their own list"
+      (service/create! ds bob "bob's")
+      (is (= ["alice's"] (map :title (:ok (service/list-todos ds alice)))))
+      (is (= ["bob's"] (map :title (:ok (service/list-todos ds bob))))))
+    (testing "someone else's todo is reported exactly like a missing one"
+      (let [missing (service/find-todo ds bob 999999)]
+        (is (= not-found missing))
+        (is (= missing (service/find-todo ds bob id)))
+        (is (= missing (service/update! ds bob id {:title "hijacked"})))
+        (is (= missing (service/delete! ds bob id)))))
+    (is (= {:ok mine} (service/find-todo ds alice id)) "and alice's todo is untouched")))
+
+(deftest database-is-opened-on-use-test
+  (testing "nothing opens the database until a service fn needs it"
+    (let [opened (atom 0)
+          ds (delay (swap! opened inc) (db/open (sqlite-test/temp-db-path)))]
+      (is (zero? @opened))
+      (service/list-todos ds alice)
+      (service/list-todos ds alice)
+      (is (= 1 @opened)))))

ui/.c8rc.json

@@ -0,0 +1,7 @@
+{
+  "temp-directory": "target/c8",
+  "reports-dir": "../target/coverage/ui",
+  "reporter": ["text", "html", "lcovonly"],
+  "include": [".shadow-cljs/builds/test/dev/out/cljs-runtime/tbd.ui.*.js"],
+  "exclude": ["**/node_modules/**", "**/*_test.js", "**/tbd.ui.test_util.js"]
+}

ui/package.json

@@ -0,0 +1,22 @@
+{
+  "name": "tbd-ui",
+  "private": true,
+  "version": "0.0.0",
+  "description": "ClojureScript (re-frame) front end for the tbd server",
+  "scripts": {
+    "watch": "shadow-cljs watch app",
+    "release": "shadow-cljs release app",
+    "test": "shadow-cljs compile test && node -r ./test/dom-setup.cjs target/ui-test/test.js",
+    "coverage": "shadow-cljs compile test && c8 --reporter=none node -r ./test/dom-setup.cjs target/ui-test/test.js && cp -r src/tbd .shadow-cljs/builds/test/dev/out/cljs-runtime/ && c8 report"
+  },
+  "dependencies": {
+    "@jason.today/webmcp": "0.1.13",
+    "react": "^19.3.0",
+    "react-dom": "^19.3.0"
+  },
+  "devDependencies": {
+    "c8": "^12.0.0",
+    "jsdom": "^30.1.0",
+    "shadow-cljs": "^3.5.3"
+  }
+}

ui/shadow-cljs.edn

@@ -0,0 +1,22 @@
+;; The UI compiles straight into the server's resources dir, so the server picks it up from
+;; the classpath (see `tbd.core`, which serves `resources/public` at `/js`). ../shared holds the
+;; .cljc the UI and the server both read (the prompts an LLM is given, tbd.agent.prompt).
+{:source-paths ["src" "test" "../shared"]
+
+ :dependencies
+ [[reagent "2.0.1"]
+  [re-frame "1.4.7"]]
+
+ :builds
+ {:app {:target :browser
+        :output-dir "../resources/public/js"
+        :asset-path "/js"
+        :modules {:main {:init-fn tbd.ui.core/init}}
+        :devtools {:after-load tbd.ui.core/reload}}
+
+  ;; script/ui-test (npm test): the tests run under Node, in a jsdom window (test/dom-setup.cjs,
+  ;; which npm test preloads), against a fake server (fetch). Not :autorun: the preload has to
+  ;; come first, so npm test starts node itself.
+  :test {:target :node-test
+         :output-to "target/ui-test/test.js"
+         :ns-regexp "-test$"}}}

ui/src/tbd/ui/core.cljs

@@ -0,0 +1,31 @@
+(ns tbd.ui.core
+  (:require [re-frame.core :as rf]
+            [reagent.dom.client :as rdc]
+            [tbd.ui.events :as events]
+            [tbd.ui.model-context :as model-context]
+            [tbd.ui.views :as views]
+            [tbd.ui.webmcp :as webmcp]))
+
+(defonce root (atom nil))
+
+(defn- render []
+  (rdc/render @root [views/app]))
+
+(defn- offer-tools!
+  "The page's tools go to the chatbot in the page, and to an agent outside it, through WebMCP."
+  []
+  (model-context/register! webmcp/tools)
+  (webmcp/register!))
+
+(defn reload
+  "Called by shadow-cljs after each hot reload."
+  []
+  (rf/clear-subscription-cache!)
+  (offer-tools!)
+  (render))
+
+(defn init []
+  (rf/dispatch-sync [::events/initialize])
+  (reset! root (rdc/create-root (js/document.getElementById "app")))
+  (offer-tools!)
+  (render))

ui/src/tbd/ui/db.cljs

@@ -0,0 +1,58 @@
+(ns tbd.ui.db
+  (:require [tbd.ui.tictactoe :as tictactoe]))
+
+(def default-db
+  {;; The page being shown (see tbd.ui.pages); it follows the URL's fragment.
+   :page :tic-tac-toe
+   :calc {:x "" :y ""
+          ;; {:status :idle}
+          ;; {:status :loading}
+          ;; {:status :ok :x "2" :y "3" :sum 5}
+          ;; {:status :error :message "..."}
+          :result {:status :idle}}
+   ;; {:status :unknown}                      (asking /auth/me)
+   ;; {:status :anonymous}                    (not logged in)
+   ;; {:status :logged-in :login "alice"}
+   ;; {:status :error :message "..."}
+   :user {:status :unknown}
+   ;; :status is the list load: :idle, :loading, :ok or :error. :error is the message of the
+   ;; last failed request (a load or a change); it is cleared when the next request starts.
+   :todos {:status :idle
+           :items []
+           :new-title ""
+           :error nil}
+   ;; The "Add this MCP server to Claude Code" page: :copied? is true right after the
+   ;; command was copied to the clipboard.
+   :mcp {:copied? false}
+   ;; The chat widget (the green square in the corner): :open? is whether its panel is showing,
+   ;; :messages the conversation so far, :input what is typed, :status :idle or :loading (waiting
+   ;; for the reply, or for the tools it asked for), and :error the message of the last failed send.
+   ;; A message is one of
+   ;;   {:role "user" :content "..."}
+   ;;   {:role "assistant" :content "..."}, with :tool-calls [{:id :name :arguments "{...}"}] when
+   ;;     the LLM asked for tools of the page to be called (:content may then be empty)
+   ;;   {:role "tool" :tool-call-id "..." :name "..." :content "..." :error? bool}: the result of
+   ;;     one such call.
+   ;; :size is what the panel was dragged to, in px: its :width and the :height of the conversation
+   ;; in it (the rest of the panel is the same at any size).
+   ;; :tools-expanded? is whether the tool calls and results show whole (wrapped) or, as they do by
+   ;; default, each cut to one line ending in "…" when it doesn't fit.
+   ;; The other two are for a reply that is still coming or being answered: :pending-calls are the
+   ;; calls it has asked for so far, :tool-calls-used how many calls this turn has made.
+   ;; :thinking-at is when (ms since the epoch) the last piece of the model's reasoning came, or nil.
+   :chat {:open? false
+          :size {:width 320 :height 256}
+          :tools-expanded? false
+          :input ""
+          :messages []
+          :status :idle
+          :error nil
+          :pending-calls nil
+          ;; Tool calls the server is still streaming (AG-UI's TOOL_CALL_START/ARGS/END), keyed by
+          ;; toolCallId, until each is complete and moves into :pending-calls.
+          :tool-call-buffer {}
+          :thinking-at nil
+          :tool-calls-used 0}
+   ;; Tic-tac-toe, entirely client side: the board (see tbd.ui.tictactoe) and whose turn it is.
+   :ttt {:board tictactoe/new-board
+         :turn :x}})

ui/src/tbd/ui/events.cljs

@@ -0,0 +1,626 @@
+(ns tbd.ui.events
+  (:require [cljs.reader :as reader]
+            [clojure.string :as str]
+            [re-frame.core :as rf]
+            [tbd.ui.db :as db]
+            [tbd.ui.model-context :as model-context]
+            [tbd.ui.pages :as pages]
+            [tbd.ui.sse :as sse]
+            [tbd.ui.tictactoe :as tictactoe]))
+
+;; A `js/fetch` of `uri` (GET unless `method` is given). A `body` is sent as EDN.
+(defn- fetch-request [{:keys [uri method body]}]
+  (js/fetch uri (clj->js (cond-> {:method (or method "GET")}
+                           body (assoc :headers {"Content-Type" "application/edn"}
+                                       :body (pr-str body))))))
+
+(defn- response-map [resp text]
+  {:ok? (.-ok resp) :status (.-status resp) :body text})
+
+;; Effect: request `uri` (GET unless `method` is given), then dispatch
+;; `(conj on-response {:ok? bool :status int-or-nil :body string})`. A `body` is sent as EDN.
+;; Network failures come back as `{:ok? false :status nil :body <message>}`.
+(rf/reg-fx
+  ::fetch
+  (fn [{:keys [on-response] :as request}]
+    (-> (fetch-request request)
+        (.then (fn [resp]
+                 (.then (.text resp) #(rf/dispatch (conj on-response (response-map resp %))))))
+        (.catch #(rf/dispatch (conj on-response {:ok? false :status nil :body (.-message %)}))))))
+
+(def ^:private connection-lost {:type "RUN_ERROR" :message "the connection was lost"})
+
+(def ^:private terminal-event-types
+  "The AG-UI event types (see tbd.chat.routes) that end a run."
+  #{"RUN_FINISHED" "RUN_ERROR"})
+
+(defn- read-events!
+  "Dispatches `(conj on-event event)` for each AG-UI event (see tbd.ui.sse, tbd.chat.routes) in the
+  body read by `reader`, as they arrive. A body that ends without a RUN_FINISHED or RUN_ERROR event
+  (the connection dropped) is a RUN_ERROR event of its own, so whoever waits for the end always
+  gets one."
+  [reader on-event]
+  (let [decoder (js/TextDecoder. "utf-8")
+        ended? (atom false)
+        lost! #(when-not @ended?
+                 (reset! ended? true)
+                 (rf/dispatch (conj on-event connection-lost)))
+        step (fn step [pending]
+               (-> (.read reader)
+                   (.then (fn [^js chunk]
+                            (if (.-done chunk)
+                              (lost!)
+                              (let [[events pending] (sse/parse (str pending (.decode decoder (.-value chunk)
+                                                                                      #js {:stream true})))]
+                                (doseq [event events]
+                                  (when (contains? terminal-event-types (:type event)) (reset! ended? true))
+                                  (rf/dispatch (conj on-event event)))
+                                (step pending)))))
+                   (.catch (fn [_] (lost!)))))]
+    (step "")))
+
+;; Effect: like ::fetch, for a response that is a stream of server-sent events. While it comes in,
+;; `(conj on-event event)` is dispatched for each event, as a map (see read-events!). When the
+;; request fails instead (a network error or a status that isn't 2xx: no stream came),
+;; `(conj on-response {:ok? false :status int-or-nil :body string})` is dispatched, as ::fetch does.
+(rf/reg-fx
+  ::fetch-stream
+  (fn [{:keys [on-event on-response] :as request}]
+    (-> (fetch-request request)
+        (.then (fn [resp]
+                 (if (.-ok resp)
+                   (read-events! (.getReader (.-body resp)) on-event)
+                   (.then (.text resp) #(rf/dispatch (conj on-response (response-map resp %)))))))
+        (.catch #(rf/dispatch (conj on-response {:ok? false :status nil :body (.-message %)}))))))
+
+;; Coeffect: the URL's fragment, which says which page to start on.
+(rf/reg-cofx
+  ::hash
+  (fn [cofx _]
+    (assoc cofx :hash js/location.hash)))
+
+;; Coeffect: the time now, in ms since the epoch.
+(rf/reg-cofx
+  ::now
+  (fn [cofx _]
+    (assoc cofx :now (js/Date.now))))
+
+;; Effect: show the page the URL names whenever it changes (a link was followed, or Back and
+;; Forward were pressed). Only one listener is ever installed, however often this runs.
+(defonce ^:private hash-listener (atom nil))
+
+(rf/reg-fx
+  ::listen-for-hash
+  (fn [_]
+    (when-let [old @hash-listener]
+      (.removeEventListener js/window "hashchange" old))
+    (reset! hash-listener #(rf/dispatch [::hash-changed js/location.hash]))
+    (.addEventListener js/window "hashchange" @hash-listener)))
+
+;; Effect: put `hash` in the URL, which is how a page gets its own address (and a Back button).
+(rf/reg-fx
+  ::set-hash
+  (fn [hash]
+    (set! js/location.hash hash)))
+
+(rf/reg-event-fx
+  ::initialize
+  [(rf/inject-cofx ::hash)]
+  (fn [{:keys [hash]} _]
+    {:db (assoc db/default-db :page (pages/hash->page hash))
+     ::listen-for-hash true
+     :dispatch [::load-user]}))
+
+;; --- Pages ---
+
+;; The URL changed (a link was followed, or Back was pressed): show the page it names.
+(rf/reg-event-db
+  ::hash-changed
+  (fn [db [_ hash]]
+    (assoc db :page (pages/hash->page hash))))
+
+;; Go to a page without a link, as the browser tools do. The page changes right away; the URL
+;; follows, and its change event finds the page already shown.
+(rf/reg-event-fx
+  ::navigate
+  (fn [{:keys [db]} [_ page]]
+    {:db (assoc db :page page)
+     ::set-hash (pages/page->hash page)}))
+
+(rf/reg-event-db
+  ::set-operand
+  (fn [db [_ k value]]
+    (assoc-in db [:calc k] value)))
+
+(rf/reg-event-fx
+  ::add
+  (fn [{:keys [db]} _]
+    (let [{:keys [x y]} (:calc db)]
+      {:db (assoc-in db [:calc :result] {:status :loading})
+       ::fetch {:uri (str "/api/add?x=" (js/encodeURIComponent x)
+                          "&y=" (js/encodeURIComponent y))
+                :on-response [::add-response x y]}})))
+
+(defn- error-message
+  "The API answers bad input with EDN like {:error \"...\" :details {:x [...]}}."
+  [{:keys [status body]}]
+  (let [{:keys [error details]} (try (reader/read-string body) (catch :default _ nil))]
+    (cond
+      error (str error (when (seq details) (str " (" (str/join ", " (map name (keys details))) ")")))
+      status (str "HTTP " status)
+      :else body)))
+
+(rf/reg-event-db
+  ::add-response
+  (fn [db [_ x y {:keys [ok? body] :as resp}]]
+    (assoc-in db [:calc :result]
+              (if ok?
+                {:status :ok :x x :y y :sum (:result (reader/read-string body))}
+                {:status :error :message (error-message resp)}))))
+
+;; --- Login state ---
+
+(rf/reg-event-fx
+  ::load-user
+  (fn [_ _]
+    {::fetch {:uri "/auth/me" :on-response [::user-response]}}))
+
+;; 401 just means "not logged in"; anything else is a real failure.
+(rf/reg-event-fx
+  ::user-response
+  (fn [{:keys [db]} [_ {:keys [ok? status] :as resp}]]
+    (cond
+      ok? {:db (assoc db :user {:status :logged-in
+                                :login (:login (reader/read-string (:body resp)))})
+           :dispatch [::load-todos]}
+      (= 401 status) {:db (assoc db :user {:status :anonymous})}
+      :else {:db (assoc db :user {:status :error :message (error-message resp)})})))
+
+(rf/reg-event-fx
+  ::logout
+  (fn [_ _]
+    {::fetch {:uri "/auth/logout" :method "POST" :on-response [::logout-response]}}))
+
+(defn- reset-chat
+  "An empty conversation, in a panel that is as open (or closed), and as big, as it was."
+  [db]
+  (assoc db :chat (merge (:chat db/default-db) (select-keys (:chat db) [:open? :size :tools-expanded?]))))
+
+(rf/reg-event-db
+  ::logout-response
+  (fn [db [_ {:keys [ok?] :as resp}]]
+    (if ok?
+      (-> db
+          (assoc :user {:status :anonymous} :todos (:todos db/default-db))
+          reset-chat)
+      (assoc-in db [:todos :error] (error-message resp)))))
+
+;; --- Todos ---
+
+(defn- start-request [db]
+  (assoc-in db [:todos :error] nil))
+
+(rf/reg-event-fx
+  ::load-todos
+  (fn [{:keys [db]} _]
+    {:db (-> db start-request (assoc-in [:todos :status] :loading))
+     ::fetch {:uri "/api/todos" :on-response [::todos-response]}}))
+
+(rf/reg-event-db
+  ::todos-response
+  (fn [db [_ {:keys [ok? body] :as resp}]]
+    (if ok?
+      (update db :todos assoc :status :ok :items (:todos (reader/read-string body)))
+      (update db :todos assoc :status :error :error (error-message resp)))))
+
+;; A failed change keeps the list as it is and shows the message. A 401 means the session
+;; expired, so fall back to the logged-out view (which hides the todos).
+(rf/reg-event-db
+  ::todo-failed
+  (fn [db [_ {:keys [status] :as resp}]]
+    (if (= 401 status)
+      (assoc db :user {:status :anonymous} :todos (:todos db/default-db))
+      (assoc-in db [:todos :error] (error-message resp)))))
+
+(rf/reg-event-db
+  ::set-new-title
+  (fn [db [_ title]]
+    (assoc-in db [:todos :new-title] title)))
+
+(rf/reg-event-fx
+  ::add-todo
+  (fn [{:keys [db]} _]
+    {:db (start-request db)
+     ::fetch {:uri "/api/todos" :method "POST"
+              :body {:title (get-in db [:todos :new-title])}
+              :on-response [::todo-added]}}))
+
+(rf/reg-event-fx
+  ::todo-added
+  (fn [{:keys [db]} [_ {:keys [ok? body] :as resp}]]
+    (if ok?
+      {:db (update db :todos (fn [todos]
+                               (-> todos
+                                   (update :items conj (reader/read-string body))
+                                   (assoc :new-title ""))))}
+      {:dispatch [::todo-failed resp]})))
+
+(rf/reg-event-fx
+  ::set-done
+  (fn [{:keys [db]} [_ id done?]]
+    {:db (start-request db)
+     ::fetch {:uri (str "/api/todos/" id) :method "PATCH"
+              :body {:done done?}
+              :on-response [::todo-changed]}}))
+
+(rf/reg-event-fx
+  ::todo-changed
+  (fn [{:keys [db]} [_ {:keys [ok? body] :as resp}]]
+    (if ok?
+      (let [changed (reader/read-string body)]
+        {:db (update-in db [:todos :items]
+                        (fn [items] (mapv #(if (= (:id %) (:id changed)) changed %) items)))})
+      {:dispatch [::todo-failed resp]})))
+
+(rf/reg-event-fx
+  ::delete-todo
+  (fn [{:keys [db]} [_ id]]
+    {:db (start-request db)
+     ::fetch {:uri (str "/api/todos/" id) :method "DELETE"
+              :on-response [::todo-deleted id]}}))
+
+(rf/reg-event-fx
+  ::todo-deleted
+  (fn [{:keys [db]} [_ id {:keys [ok?] :as resp}]]
+    (if ok?
+      {:db (update-in db [:todos :items] (fn [items] (filterv #(not= id (:id %)) items)))}
+      {:dispatch [::todo-failed resp]})))
+
+;; --- Chat ---
+
+;; The chat is a loop when the LLM uses the page's tools (see tbd.ui.model-context): the reply to a
+;; message can be a request for tool calls instead of (or after) text; the page makes the calls,
+;; and sends the conversation again, now with their results, for the LLM to go on from. It does
+;; that until the LLM answers without asking for tools.
+
+(def ^:private max-sent-messages
+  "How much of the conversation goes to the server with each message (its limit is
+  tbd.chat.schema/max-messages, which this stays within), the most recent part."
+  40)
+
+(def ^:private max-tool-calls-per-turn
+  "How many tool calls the LLM may make in answer to one message of the user's, before the page
+  stops it. A model that keeps calling tools never answers, and every call is something done on the
+  user's page. (A turn is at most 1 + this many assistant messages and this many results, so it is
+  always inside `max-sent-messages`.)"
+  12)
+
+(def ^:private max-tool-result-length
+  "The longest result of a tool that goes to the LLM (tbd.chat.schema/max-message-length)."
+  8000)
+
+(def ^:private truncated " … (truncated)")
+
+(defn- fit-result
+  "A tool's result text as the content of a message: never empty, and no longer than the server
+  takes."
+  [text]
+  (cond
+    (str/blank? text) "(no output)"
+    (> (count text) max-tool-result-length) (str (subs text 0 (- max-tool-result-length (count truncated)))
+                                                 truncated)
+    :else text))
+
+(defonce ^:private id-counter (atom 0))
+
+(defn- next-id
+  "An id unique within this page's session, for an AG-UI message: they only have to identify a
+  message within one run's conversation, never across page loads."
+  []
+  (str "m" (swap! id-counter inc)))
+
+(defn- wire-message
+  "A message of the conversation as AG-UI's Message has it (see tbd.chat.schema/Message: user,
+  assistant with `toolCalls`, or tool)."
+  [{:keys [role content tool-calls tool-call-id]}]
+  (cond-> {:id (next-id) :role role}
+    (= "tool" role) (assoc :toolCallId tool-call-id :content content)
+    (not= "tool" role) (assoc :content content)
+    (seq tool-calls) (assoc :toolCalls (mapv (fn [{:keys [id name arguments]}]
+                                               {:id id :type "function"
+                                                :function {:name name :arguments arguments}})
+                                             tool-calls))))
+
+(defn- recent
+  "The most recent `max-sent-messages` of `messages`, without the results of calls whose asking
+  is cut off: the LLM server refuses a result that answers nothing."
+  [messages]
+  (drop-while #(= "tool" (:role %)) (take-last max-sent-messages messages)))
+
+(def ^:private stale-result
+  "What the LLM is sent in place of a result from before the user's last message."
+  "(out of date: this was read on an earlier turn and the page may have changed since. Call the tool again for the current state.)")
+
+(defn- without-stale-results
+  "`messages` with the content of the tool results from before the user's last message replaced by
+  `stale-result`. A result is a snapshot of the page when the tool ran, and the user can change the
+  page between messages, by hand or on another page; a model that is still shown the old snapshot
+  goes by it, even when told it is wrong. What it did stays (its calls, its own words), only what
+  it read goes. The results of this turn stay: a chain of calls goes on from the ones before
+  (list, then act on an id)."
+  [messages]
+  (let [last-user (or (last (keep-indexed (fn [i {:keys [role]}] (when (= "user" role) i)) messages)) 0)]
+    (into [] (map-indexed (fn [i message]
+                            (cond-> message
+                              (and (< i last-user) (= "tool" (:role message)))
+                              (assoc :content stale-result))))
+          messages)))
+
+(defn- wire-tool
+  "A tool as AG-UI's Tool has it (see tbd.chat.schema/Tool): `parameters`, not MCP's `inputSchema`."
+  [{:keys [name description inputSchema]}]
+  (cond-> {:name name :parameters inputSchema}
+    description (assoc :description description)))
+
+;; The request that sends the conversation: an AG-UI RunAgentInput. It goes with the page being
+;; shown (as a `context` entry, for the LLM to know where the user is) and the tools that page
+;; offers the LLM. Both are read from the db every time, so a conversation that moves between
+;; pages (the LLM's own `navigate`, say) always tells the LLM where it is now.
+(defn- chat-request [db messages]
+  (let [tools (model-context/definitions (:page db))]
+    {:uri "/api/chat" :method "POST"
+     :body (cond-> {:threadId (next-id) :runId (next-id)
+                    :messages (mapv wire-message (without-stale-results (recent messages)))
+                    :context [{:description "page" :value (name (:page db))}]}
+             (seq tools) (assoc :tools (mapv wire-tool tools)))
+     :on-event [::chat-event]
+     :on-response [::chat-response]}))
+
+(rf/reg-event-db
+  ::chat-toggle
+  (fn [db _]
+    (update-in db [:chat :open?] not)))
+
+;; The panel is dragged to `width` px wide and its conversation `height` px high (the view keeps
+;; them within the window).
+(rf/reg-event-db
+  ::chat-resize
+  (fn [db [_ width height]]
+    (assoc-in db [:chat :size] {:width width :height height})))
+
+;; Whether the tool calls and results show whole, or each cut to one line.
+(rf/reg-event-db
+  ::chat-toggle-tools
+  (fn [db _]
+    (update-in db [:chat :tools-expanded?] not)))
+
+(rf/reg-event-db
+  ::chat-set-input
+  (fn [db [_ input]]
+    (assoc-in db [:chat :input] input)))
+
+;; Only one message is in flight at a time, and a blank one isn't sent.
+(rf/reg-event-fx
+  ::chat-send
+  (fn [{:keys [db]} _]
+    (let [{:keys [input messages status]} (:chat db)
+          content (str/trim input)]
+      (when (and (not= :loading status) (seq content))
+        (let [messages (conj messages {:role "user" :content content})]
+          {:db (update db :chat assoc :messages messages :input "" :status :loading :error nil
+                       :tool-calls-used 0)
+           ::fetch-stream (chat-request db messages)})))))
+
+(defn- only-reasoning?
+  "Whether `message` is a reply that has come to nothing but the reasoning for it: there is nothing
+  in it for the LLM to be sent (the server refuses an assistant message that says and asks for
+  nothing)."
+  [{:keys [role content tool-calls]}]
+  (and (= "assistant" role) (str/blank? content) (empty? tool-calls)))
+
+(defn- chat-failed
+  "The conversation after a send failed with `message`. If the last message is the user's (nothing
+  of the reply had come, but perhaps some reasoning, which goes), it leaves the conversation again
+  and goes back in the input, so trying once more is pressing Send (and the next message doesn't
+  follow one nobody answered). If part of the reply had come, or the tools' results had been sent,
+  that stays, and the next message follows it."
+  [db message]
+  (let [messages (get-in db [:chat :messages])
+        messages (cond-> messages (only-reasoning? (peek messages)) pop)
+        unanswered? (= "user" (:role (peek messages)))]
+    (update db :chat merge
+            {:status :idle :error message :pending-calls nil :messages messages}
+            (when unanswered?
+              {:messages (pop messages) :input (:content (peek messages))}))))
+
+;; The server answered without a stream: the request failed. A 401 means the session expired: fall
+;; back to the logged-out view. A response nobody is waiting for (the conversation was reset since,
+;; by logging out) is dropped.
+(rf/reg-event-db
+  ::chat-response
+  (fn [db [_ {:keys [status] :as resp}]]
+    (cond
+      (not= :loading (get-in db [:chat :status])) db
+      (= 401 status) (-> db (assoc :user {:status :anonymous}) reset-chat)
+      :else (chat-failed db (error-message resp)))))
+
+(defn- append-to-reply
+  "The conversation's assistant message being written, with `text` added to its content. The first
+  piece starts the message, the rest are added to it. Leading whitespace is dropped while nothing
+  has been said yet (the model often opens its answer with a stray blank line right after
+  reasoning), but preserved once the message has content, since it may be meaningful there."
+  [db text]
+  (update-in db [:chat :messages]
+             (fn [messages]
+               (if (= "assistant" (:role (peek messages)))
+                 (update messages (dec (count messages)) update :content
+                         (fn [content]
+                           (str content (if (str/blank? content) (str/triml text) text))))
+                 (conj messages {:role "assistant" :content (str/triml text)})))))
+
+(defn- with-tool-calls
+  "The conversation with the calls the LLM asked for: on the reply's text (the message it
+  started), or on a message of their own when it said nothing."
+  [messages calls]
+  (if (= "assistant" (:role (peek messages)))
+    (update messages (dec (count messages)) assoc :tool-calls calls)
+    (conj messages {:role "assistant" :content "" :tool-calls calls})))
+
+(defn- tool-message [{:keys [id name content error?]}]
+  {:role "tool" :tool-call-id id :name name :content content :error? (boolean error?)})
+
+(defn- finish-reply
+  "The reply is complete. Without calls that is all; with them, they are made (see ::call-tools)
+  and the conversation goes on when they are done, unless this turn has used all the calls it may."
+  [db]
+  (let [{:keys [pending-calls tool-calls-used]} (:chat db)
+        used (+ (or tool-calls-used 0) (count pending-calls))
+        db (update db :chat assoc :pending-calls nil :thinking-at nil)]
+    (cond
+      (empty? pending-calls)
+      {:db (assoc-in db [:chat :status] :idle)}
+
+      (> used max-tool-calls-per-turn)
+      ;; The calls still get their answers, for the conversation to make sense to the LLM later.
+      {:db (-> db
+               (update-in [:chat :messages] with-tool-calls pending-calls)
+               (update-in [:chat :messages] into
+                          (for [{:keys [id name]} pending-calls]
+                            (tool-message {:id id :name name :error? true
+                                           :content "not run: too many tool calls in one turn"})))
+               (update :chat assoc :status :idle
+                       :error "The assistant made too many tool calls in a row, so it was stopped."))}
+
+      :else
+      {:db (-> db
+               (update-in [:chat :messages] with-tool-calls pending-calls)
+               (assoc-in [:chat :tool-calls-used] used))
+       ::call-tools {:page (:page db) :calls pending-calls :on-results [::chat-tool-results]}})))
+
+(defn- text? [x]
+  (and (string? x) (seq x)))
+
+(defn- start-tool-call [db {:keys [toolCallId toolCallName]}]
+  (update-in db [:chat :tool-call-buffer] assoc toolCallId {:id toolCallId :name toolCallName :arguments ""}))
+
+(defn- append-tool-call-args [db {:keys [toolCallId delta]}]
+  (update-in db [:chat :tool-call-buffer toolCallId :arguments] str delta))
+
+(defn- end-tool-call [db {:keys [toolCallId]}]
+  (let [call (get-in db [:chat :tool-call-buffer toolCallId])]
+    (cond-> db
+      call (-> (update-in [:chat :pending-calls] (fnil conj []) call)
+              (update-in [:chat :tool-call-buffer] dissoc toolCallId)))))
+
+;; One AG-UI event of the reply (see tbd.chat.routes, https://docs.ag-ui.com): TEXT_MESSAGE_CONTENT
+;; ({:delta "..."}) for the next piece of the reply (the first starts the assistant's message, the
+;; rest are added to it), REASONING_MESSAGE_CONTENT for the next piece of the model's reasoning
+;; (which is not kept: the user only sees that the model is thinking, and for as long as pieces
+;; keep coming, which :thinking-at, the time the last one came, is for),
+;; TOOL_CALL_START/TOOL_CALL_ARGS/TOOL_CALL_END as it asks for tools to be called (accumulated in
+;; :tool-call-buffer until each call is complete), and last RUN_FINISHED or RUN_ERROR. Events
+;; nobody is waiting for (the conversation was reset since) are dropped.
+(rf/reg-event-fx
+  ::chat-event
+  [(rf/inject-cofx ::now)]
+  (fn [{:keys [db now]} [_ {:keys [type] :as event}]]
+    (let [loading? (= :loading (get-in db [:chat :status]))
+          db (cond-> db
+               (and loading? (= "REASONING_MESSAGE_CONTENT" type) (text? (:delta event)))
+               (assoc-in [:chat :thinking-at] now))]
+      (cond
+        (not loading?) {:db db}
+        (= "TEXT_MESSAGE_CONTENT" type) {:db (append-to-reply db (:delta event))}
+        (= "TOOL_CALL_START" type) {:db (start-tool-call db event)}
+        (= "TOOL_CALL_ARGS" type) {:db (append-tool-call-args db event)}
+        (= "TOOL_CALL_END" type) {:db (end-tool-call db event)}
+        (= "RUN_FINISHED" type) (finish-reply db)
+        (= "RUN_ERROR" type) {:db (chat-failed db (:message event))}
+        :else {:db db}))))
+
+(defn- call-all
+  "A promise of the results of `calls`, in order, as {:id :name :content :error?}. One after the
+  other: the tools work on the same page (one may need the page the last one opened). Only the
+  tools `page` offers can be called."
+  [page calls]
+  (reduce (fn [results {:keys [id name arguments]}]
+            (.then results
+                   (fn [done]
+                     (.then (model-context/call! page name arguments)
+                            (fn [{:keys [text error?]}]
+                              (conj done {:id id :name name :content (fit-result text) :error? error?}))))))
+          (js/Promise.resolve [])
+          calls))
+
+;; Effect: make the tool calls the LLM asked for, on the tools `page` (the one being shown) offers,
+;; and dispatch `(conj on-results results)` when all are done: one {:id :name :content :error?}
+;; for each, in order. A call that can't be made (an unknown tool, one the page doesn't offer,
+;; arguments that aren't JSON, a tool that fails) is a result with :error?, for the LLM to read.
+(rf/reg-fx
+  ::call-tools
+  (fn [{:keys [page calls on-results]}]
+    (.then (call-all page calls) #(rf/dispatch (conj on-results %)))))
+
+(defn- answers?
+  "Whether `results` are for the calls the conversation is waiting on. Results nobody waits for
+  (the conversation was reset while the tools ran) are not."
+  [db results]
+  (let [calls (:tool-calls (peek (get-in db [:chat :messages])))]
+    (and (= :loading (get-in db [:chat :status]))
+         (seq calls)
+         (= (map :id calls) (map :id results)))))
+
+;; The tools have run: their results join the conversation, and it goes to the LLM again.
+(rf/reg-event-fx
+  ::chat-tool-results
+  (fn [{:keys [db]} [_ results]]
+    (if-not (answers? db results)
+      {:db db}
+      (let [db (update-in db [:chat :messages] into (map tool-message) results)]
+        {:db db
+         ::fetch-stream (chat-request db (get-in db [:chat :messages]))}))))
+
+;; Starts the conversation over. Not while a reply is on its way: it would land in the new one.
+(rf/reg-event-db
+  ::chat-clear
+  (fn [db _]
+    (if (= :loading (get-in db [:chat :status]))
+      db
+      (reset-chat db))))
+
+;; --- MCP setup page ---
+
+;; 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)))
+
+;; --- Tic-tac-toe ---
+
+;; An illegal move (taken cell, game over) changes nothing.
+(rf/reg-event-db
+  ::ttt-move
+  (fn [db [_ i]]
+    (let [{:keys [board turn]} (:ttt db)]
+      (if-let [board' (tictactoe/move board turn i)]
+        (assoc db :ttt {:board board' :turn (tictactoe/next-player turn)})
+        db))))
+
+(rf/reg-event-db
+  ::ttt-reset
+  (fn [db _]
+    (assoc db :ttt (:ttt db/default-db))))

ui/src/tbd/ui/model_context.cljs

@@ -0,0 +1,98 @@
+(ns tbd.ui.model-context
+  "The page's `modelContext`: the tools the page offers to an agent, as WebMCP names it (a page
+  registers tools with `navigator.modelContext` in the browsers that have one). Here it is the
+  registry the page's own chatbot reads. tbd.ui.core registers the tools of tbd.ui.webmcp, which
+  are also offered to an outside agent through the WebMCP widget; the chatbot is the same thing
+  embedded in the page.
+
+  The chatbot passes the tools' metadata (`definitions`, the shape of MCP's `tools/list`) to the
+  LLM along with the conversation. The LLM never runs anything: it answers with the calls it wants
+  made, tbd.ui.events intercepts them, `call!` invokes the tool right here in the page (the same
+  handlers as WebMCP's, so it shows on screen like a user's own doing) and the result goes back to
+  the LLM with the next request, as MCP's `tools/call` result would.
+
+  A tool is {:name :description :input-schema :handler :pages}: `handler` takes its arguments as a
+  map and returns a value or a promise of one. A string is the result as it is, any other data
+  becomes JSON, and throwing (or rejecting) is an error result the agent can read. `pages` is the
+  set of pages (see tbd.ui.pages) the tool is offered on, so the LLM on the tic-tac-toe page is not
+  handed the todos' tools; a tool without it is offered on every page. What is offered follows the
+  page being shown: `definitions` and `call!` both take it, and a tool that is not offered on it
+  can neither be listed nor called."
+  (:require [clojure.string :as str]))
+
+(defonce ^:private registry (atom []))
+
+(defn register!
+  "Adds `tools` to what the page offers. A tool with the name of one already there replaces it
+  (which is what makes registering again, on hot reload, safe)."
+  [tools]
+  (let [names (set (map :name tools))]
+    (swap! registry (fn [registered] (into (filterv #(not (names (:name %))) registered) tools)))
+    nil))
+
+(defn clear!
+  "Takes every tool away: for a test to start from a page that offers none."
+  []
+  (reset! registry [])
+  nil)
+
+(defn- offered?
+  "Whether `tool` is offered on `page`."
+  [page {:keys [pages]}]
+  (or (nil? pages) (contains? pages page)))
+
+(defn definitions
+  "What the LLM is told about the tools offered on `page`, as MCP's `tools/list` gives them:
+  [{:name :description :inputSchema}], in the order they were registered."
+  [page]
+  (into []
+        (comp (filter #(offered? page %))
+              (map (fn [{:keys [name description input-schema]}]
+                     (cond-> {:name name :inputSchema input-schema}
+                       description (assoc :description description)))))
+        @registry))
+
+(defn- ->text [value]
+  (cond
+    (string? value) value
+    (nil? value) "ok"
+    :else (js/JSON.stringify (clj->js value))))
+
+(defn run
+  "A promise of the result of `handler` on `args`, as {:text string :error? bool}. It never
+  rejects: a handler that throws, or whose promise rejects, is an error result."
+  [handler args]
+  (-> (js/Promise.resolve)
+      (.then #(handler args))
+      (.then (fn [value] {:text (->text value) :error? false}))
+      (.catch (fn [e] {:text (or (some-> e (aget "message")) (str e)) :error? true}))))
+
+(defn- parse-arguments
+  "The arguments the LLM wrote, JSON text, as a map: nothing at all is no arguments (a model
+  calls a tool that takes none that way). Anything but a JSON object gives ::invalid."
+  [text]
+  (if (str/blank? text)
+    {}
+    (let [parsed (try (js->clj (js/JSON.parse text) :keywordize-keys true)
+                      (catch :default _ ::invalid))]
+      (if (map? parsed) parsed ::invalid))))
+
+(defn- failed [text]
+  (js/Promise.resolve {:text text :error? true}))
+
+(defn call!
+  "Calls the tool `tool-name` on `arguments`, the JSON text the LLM wrote, and gives a promise of
+  its result, as {:text string :error? bool}. A tool that isn't there or isn't offered on `page`
+  (the LLM may be going by an earlier page's tools), or arguments that aren't a JSON object, is an
+  error result the LLM can read and try again from."
+  [page tool-name arguments]
+  (let [tool (first (filter #(= tool-name (:name %)) @registry))
+        args (parse-arguments arguments)]
+    (cond
+      (nil? tool) (failed (str "unknown tool: " tool-name))
+      (not (offered? page tool)) (failed (str "tool not available on this page: " tool-name
+                                              " (it is offered on the "
+                                              (str/join ", " (map name (sort (:pages tool))))
+                                              " page)"))
+      (= ::invalid args) (failed "invalid arguments: they must be a JSON object")
+      :else (run (:handler tool) args))))

ui/src/tbd/ui/pages.cljs

@@ -0,0 +1,28 @@
+(ns tbd.ui.pages
+  "The pages of the app, and how they map to the URL. The server only serves the shell at `/`,
+  so a page lives in the fragment (`/#/todos`): following a link between pages never asks the
+  server for anything, and a page can still be bookmarked or reloaded.")
+
+(def pages
+  "The pages in the order of the tabs: {:id :title :login?}. :login? pages are only offered
+  (and only show anything) to someone who is logged in."
+  [{:id :tic-tac-toe :title "Tic-tac-toe"}
+   {:id :calculator :title "Calculator"}
+   {:id :todos :title "Todos" :login? true}
+   {:id :ai-setup :title "AI setup"}])
+
+(def default-page (:id (first pages)))
+
+(def ^:private ids (into #{} (map :id) pages))
+
+(defn page->hash
+  "The fragment that opens `page`: \"#/todos\"."
+  [page]
+  (str "#/" (name page)))
+
+(defn hash->page
+  "The page a fragment (with or without its leading #) opens; the default page when it is empty
+  or names no page."
+  [hash]
+  (let [id (keyword (second (re-find #"^#?/?([^/?]*)" (or hash ""))))]
+    (if (contains? ids id) id default-page)))

ui/src/tbd/ui/sse.cljs

@@ -0,0 +1,23 @@
+(ns tbd.ui.sse
+  "Reading server-sent events (what POST /api/chat answers with) out of the text that arrives in
+  pieces. Pure: tbd.ui.events does the fetching and feeds the pieces in."
+  (:require [clojure.string :as str]))
+
+(defn- event-data
+  "The data of one event (the lines between blank lines) as a map, or nil when there is none
+  (a comment, say) or it isn't JSON."
+  [block]
+  (let [data (->> (str/split-lines block)
+                  (keep #(second (re-matches #"data: ?(.*)" %))))]
+    (when (seq data)
+      (try (js->clj (js/JSON.parse (str/join "\n" data)) :keywordize-keys true)
+           (catch :default _ nil)))))
+
+(defn parse
+  "`text` is what has been received so far and hasn't been parsed yet. Returns [events rest]: the
+  events that are complete in it (each the JSON of its `data:` lines, as a map), and the end of it,
+  an event that hasn't fully arrived, to put in front of the next piece."
+  [text]
+  (let [blocks (str/split (str/replace text "\r\n" "\n") #"\n\n" -1)]
+    [(vec (keep event-data (butlast blocks)))
+     (last blocks)]))

ui/src/tbd/ui/subs.cljs

@@ -0,0 +1,23 @@
+(ns tbd.ui.subs
+  (:require [re-frame.core :as rf]
+            [tbd.ui.tictactoe :as tictactoe]))
+
+(rf/reg-sub ::page (fn [db _] (:page db)))
+(rf/reg-sub ::operand (fn [db [_ k]] (get-in db [:calc k])))
+(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 ::chat (fn [db _] (:chat db)))
+(rf/reg-sub ::mcp-copied? (fn [db _] (get-in db [:mcp :copied?])))
+
+(rf/reg-sub ::ttt (fn [db _] (:ttt db)))
+
+;; What the board view needs: the cells, whose turn, and how the game stands.
+;; :outcome is nil while the game is on, or {:player :x-or-:o :line [..]} for a win, or :draw.
+(rf/reg-sub
+  ::ttt-game
+  :<- [::ttt]
+  (fn [{:keys [board turn]} _]
+    {:board board
+     :turn turn
+     :outcome (tictactoe/outcome board)}))

ui/src/tbd/ui/tictactoe.cljs

@@ -0,0 +1,39 @@
+(ns tbd.ui.tictactoe
+  "Tic-tac-toe rules as plain functions of the board, called by the re-frame events and subs
+  (tbd.ui.events, tbd.ui.subs). The board is a vector of 9 cells, row by row, each nil, :x or :o.")
+
+(def new-board (vec (repeat 9 nil)))
+
+(def ^:private lines
+  [[0 1 2] [3 4 5] [6 7 8]
+   [0 3 6] [1 4 7] [2 5 8]
+   [0 4 8] [2 4 6]])
+
+(defn winner
+  "{:player :x-or-:o :line [i j k]} when someone has three in a row, else nil."
+  [board]
+  (some (fn [[a b c :as line]]
+          (let [player (board a)]
+            (when (and player (= player (board b) (board c)))
+              {:player player :line line})))
+        lines))
+
+(defn draw?
+  "The board is full and nobody won."
+  [board]
+  (and (every? some? board) (nil? (winner board))))
+
+(defn outcome
+  "How the game stands: nil while it's on, :draw, or the winner (see `winner`)."
+  [board]
+  (or (winner board) (when (draw? board) :draw)))
+
+(defn next-player [player]
+  (if (= :x player) :o :x))
+
+(defn move
+  "`player` takes cell `i`. Returns the new board, or nil when the move isn't allowed (the cell
+  is taken or off the board, or the game is already over)."
+  [board player i]
+  (when (and (contains? board i) (nil? (board i)) (nil? (winner board)))
+    (assoc board i player)))

ui/src/tbd/ui/views.cljs

@@ -0,0 +1,416 @@
+(ns tbd.ui.views
+  (:require [clojure.string :as str]
+            [reagent.core :as r]
+            [re-frame.core :as rf]
+            [tbd.ui.events :as events]
+            [tbd.ui.pages :as pages]
+            [tbd.ui.subs :as subs]
+            [tbd.ui.webmcp :as webmcp]))
+
+(defn- operand-input [k label]
+  [:label label " "
+   [:input {:type "number" :step "any" :required true :name (name k)
+            :style {:width "6rem"}
+            :value @(rf/subscribe [::subs/operand k])
+            :on-change #(rf/dispatch [::events/set-operand k (.. % -target -value)])}]])
+
+(defn- result-line [{:keys [status x y sum message]}]
+  (case status
+    :idle nil
+    :loading [:p "Adding…"]
+    :ok [:p {:aria-live "polite"} x " + " y " = " [:strong sum]]
+    :error [:p {:role "alert" :style {:color "crimson"}} message]))
+
+(defn calculator
+  "Sends GET /api/add?x=..&y=.. on submit and shows the sum the server returns."
+  []
+  (let [result @(rf/subscribe [::subs/result])]
+    [:section
+     [:h2 "Calculator"]
+     [:form {:on-submit (fn [e]
+                          (.preventDefault e)
+                          (rf/dispatch [::events/add]))}
+      [:div {:style {:display "flex" :gap "1rem" :align-items "center"}}
+       [operand-input :x "x"]
+       "+"
+       [operand-input :y "y"]
+       [:button {:type "submit" :disabled (= :loading (:status result))} "Add"]]
+      [result-line result]]]))
+
+(defn- todo-item [{:keys [id title done]}]
+  [:li {:style {:display "flex" :gap "0.5rem" :align-items "center" :margin "0.25rem 0"}}
+   [:label {:style {:flex 1 :text-decoration (when done "line-through") :opacity (when done 0.6)}}
+    [:input {:type "checkbox" :checked (boolean done)
+             :on-change #(rf/dispatch [::events/set-done id (.. % -target -checked)])}]
+    " " title]
+   [:button {:type "button" :aria-label (str "Delete " title)
+             :on-click #(rf/dispatch [::events/delete-todo id])}
+    "Delete"]])
+
+(defn- todo-list [{:keys [status items]}]
+  (cond
+    (and (= :loading status) (empty? items)) [:p "Loading…"]
+    (and (= :ok status) (empty? items)) [:p "Nothing to do."]
+    :else [:ul {:style {:list-style "none" :padding 0}}
+           (for [todo items]
+             ^{:key (:id todo)} [todo-item todo])]))
+
+(defn todos
+  "Your todos (GET/POST /api/todos, PATCH/DELETE /api/todos/:id)."
+  []
+  (let [{:keys [new-title error] :as state} @(rf/subscribe [::subs/todos])]
+    [:section
+     [:h2 "Todos"]
+     [:form {:on-submit (fn [e]
+                          (.preventDefault e)
+                          (rf/dispatch [::events/add-todo]))}
+      [:input {:type "text" :name "title" :required true :placeholder "What needs doing?"
+               :aria-label "New todo"
+               :style {:width "20rem"}
+               :value new-title
+               :on-change #(rf/dispatch [::events/set-new-title (.. % -target -value)])}]
+      " "
+      [:button {:type "submit"} "Add"]]
+     (when error [:p {:role "alert" :style {:color "crimson"}} error])
+     [todo-list state]]))
+
+(defn- ttt-status [{:keys [turn outcome]}]
+  (cond
+    (= :draw outcome) "It's a draw."
+    outcome (str (str/upper-case (name (:player outcome))) " wins!")
+    :else (str (str/upper-case (name turn)) "'s turn")))
+
+(defn- ttt-cell [i mark winning? over?]
+  [:button {:type "button"
+            :aria-label (str "Cell " (inc i) (when mark (str ", " (str/upper-case (name mark)))))
+            :disabled (or over? (some? mark))
+            :style {:aspect-ratio "1" :font-size "2.5rem" :font-weight "bold" :cursor "pointer"
+                    :background (when winning? "gold") :color (when winning? "black")}
+            :on-click #(rf/dispatch [::events/ttt-move i])}
+   (some-> mark name str/upper-case)])
+
+(defn tic-tac-toe
+  "Two players take turns on one board. Nothing goes to the server."
+  []
+  (let [{:keys [board outcome] :as game} @(rf/subscribe [::subs/ttt-game])
+        winning (set (:line outcome))]
+    [:section
+     [:h2 "Tic-tac-toe"]
+     [:p {:role "status" :aria-live "polite"} (ttt-status game)]
+     [:div {:style {:display "grid" :grid-template-columns "repeat(3, 4.5rem)" :gap "0.25rem"
+                    :width "fit-content"}}
+      (for [[i mark] (map-indexed vector board)]
+        ^{:key i} [ttt-cell i mark (contains? winning i) (some? outcome)])]
+     [:p [:button {:type "button" :on-click #(rf/dispatch [::events/ttt-reset])} "New game"]]]))
+
+(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
+     [: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 browser-tools
+  "The page's own tools for a browser agent (WebMCP, see tbd.ui.webmcp): how to connect an MCP
+  client to them. The token is pasted into the WebMCP widget in the corner of the page."
+  []
+  [:section
+   [:h2 "Browser tools (WebMCP)"]
+   [:p "This page offers " [:strong (count webmcp/tools)] " tools of its own (the calculator, the todos and the tic-tac-toe game) to "
+    "your MCP client, over " [:a {:href "https://webmcp.dev" :target "_blank" :rel "noreferrer"} "WebMCP"]
+    ", and you see them work on the page. To connect:"]
+   [:ol
+    [:li "Add the WebMCP server to your MCP client, once: " [:code "npx -y @jason.today/webmcp@latest --config claude"]
+     " (restart Claude Desktop afterwards)."]
+    [:li "Ask your MCP client: " [:em "\"make a webmcp token\""] "."]
+    [:li "Click the blue square in the bottom right corner of this page, paste the token, and press Connect. "
+     "(The token works once; to disconnect, press Disconnect there.)"]
+    [:li "The tools show up in your client, prefixed with this page's host."]]])
+
+(defn- link-button [props label]
+  [:button (merge {:type "button"
+                   :style {:background "none" :border 0 :padding 0 :font "inherit"
+                           :color "LinkText" :text-decoration "underline" :cursor "pointer"}}
+                  props)
+   label])
+
+(defn- auth-link
+  "Log in (a plain navigation to the OAuth flow) or log out (a POST), or nothing until we know."
+  [{:keys [status login]}]
+  (case status
+    :anonymous [:a {:href "/auth/login"} "Log in"]
+    :logged-in [link-button {:title (str "Signed in as " login)
+                             :on-click #(rf/dispatch [::events/logout])}
+                "Log out"]
+    nil))
+
+(defn- login-prompt
+  "What the todos page says to someone who isn't logged in (nothing while we don't know yet)."
+  [{:keys [status message]}]
+  (case status
+    :anonymous [:section
+                [:h2 "Todos"]
+                [:p [:a {:href "/auth/login"} "Log in"] " to see your todos."]]
+    :error [:p {:role "alert" :style {:color "crimson"}} message]
+    nil))
+
+(def ^:private chat-green "#28a745")
+
+(defn- chat-bubble [{:keys [role content]}]
+  (let [user? (= "user" role)]
+    [:div {:style {:align-self (if user? "flex-end" "flex-start")
+                   :max-width "85%" :padding "0.4rem 0.6rem" :border-radius "0.5rem"
+                   :white-space "pre-wrap" :overflow-wrap "anywhere"
+                   :background (if user? chat-green "#f1f1f1")
+                   :color (if user? "white" "#222")}}
+     content]))
+
+(defn- chat-tool-line
+  "A tool the assistant calls, or what came of it, apart from what is said, and in smaller print.
+  One line, ending in \"…\" where it doesn't fit, unless `expanded?`: then all of it shows, wrapped."
+  [expanded? text {:keys [error?]}]
+  [:div (cond-> {:data-tool true
+                 :style (merge {:align-self "flex-start" :max-width "85%" :flex-shrink 0
+                                :overflow-wrap "anywhere"
+                                :font-family "monospace" :font-size "12px"
+                                :color (if error? "crimson" "#777")}
+                               (if expanded?
+                                 {:white-space "pre-wrap"}
+                                 {:white-space "nowrap" :overflow "hidden" :text-overflow "ellipsis"}))}
+          (not expanded?) (assoc :title text))
+   text])
+
+(defn- call-text [{:keys [name arguments]}]
+  (str "Calling " name (when-not (str/blank? arguments) (str " " arguments)) "…"))
+
+(defn- result-text [{:keys [name content error?]}]
+  (str name (if error? " failed: " " → ") content))
+
+(defn- chat-message
+  "What was said, as a bubble, and the tool calls the assistant made with it, and their results,
+  as lines between the bubbles."
+  [tools-expanded? {:keys [role content tool-calls] :as message}]
+  (if (= "tool" role)
+    [chat-tool-line tools-expanded? (result-text message) message]
+    [:<>
+     (when-not (str/blank? content) [chat-bubble message])
+     (for [call tool-calls]
+       ^{:key (:id call)} [chat-tool-line tools-expanded? (call-text call) nil])]))
+
+(defn- tool-use?
+  "Whether the conversation has any tool call or result."
+  [messages]
+  (some #(or (= "tool" (:role %)) (seq (:tool-calls %))) messages))
+
+(def ^:private chat-min-width 260)
+(def ^:private chat-min-height 96)
+;; What the panel has besides the conversation (header, form, padding, and the gap under the
+;; window's top edge it keeps): the conversation can be as high as the window less this.
+(def ^:private chat-chrome-height 220)
+
+(def ^:private stuck-slack
+  "How far (px) from its end the conversation can be scrolled and still count as at its end."
+  24)
+
+(defn- at-end? [el]
+  (<= (- (.-scrollHeight el) (.-scrollTop el) (.-clientHeight el)) stuck-slack))
+
+(def ^:private thinking-live-ms
+  "How recently (ms) a piece of the model's reasoning must have come for it to count as still
+  coming in."
+  250)
+(def ^:private thinking-frame-ms 250)
+(def ^:private thinking-tick-ms 100)
+
+(defn- thinking-line
+  "\"Thinking…\" which, while pieces of the model's reasoning are still coming in (the last, at
+  `thinking-at`, was less than `thinking-live-ms` ago), cycles through one to three dots."
+  [thinking-at]
+  (r/with-let [clock (r/atom (js/Date.now))
+               timer (js/setInterval #(reset! clock (js/Date.now)) thinking-tick-ms)]
+    (let [now @clock
+          live? (and thinking-at (< (- now thinking-at) thinking-live-ms))]
+      [:div {:role "status" :style {:color "#777"}}
+       (if live?
+         (str "Thinking" (apply str (repeat (inc (mod (quot now thinking-frame-ms) 3)) ".")))
+         "Thinking…")])
+    (finally (js/clearInterval timer))))
+
+(defn- chat-log
+  "The conversation, which follows its end (as the pieces of a reply come in) for as long as it is
+  scrolled to it. Scroll up to read back and it stays where it is, until you send a message or
+  scroll down to the end again (a message sent is among the ones that came since the last render,
+  which may also hold the first of the reply). \"Thinking…\" shows from the sending until the reply's first piece
+  (animated while the model's reasoning is coming in); what the model reasons is not shown."
+  [_chat _size]
+  (let [stuck? (atom true)
+        seen (atom 0)]
+    (fn [{:keys [messages status thinking-at tools-expanded?]} {:keys [height]}]
+      [:div {:role "log" :aria-live "polite"
+             :ref (fn [el]
+                    (when el
+                      (when (some #(= "user" (:role %)) (drop @seen messages))
+                        (reset! stuck? true))
+                      (reset! seen (count messages))
+                      (when @stuck? (set! (.-scrollTop el) (.-scrollHeight el)))))
+             :on-scroll #(reset! stuck? (at-end? (.-target %)))
+             :style {:display "flex" :flex-direction "column" :gap "0.4rem"
+                     :height (str height "px")
+                     :max-height (str "max(" chat-min-height "px, calc(100vh - " chat-chrome-height "px))")
+                     :overflow-y "auto" :margin "0.5rem 0"}}
+       (if (and (empty? messages) (not= :loading status))
+         [:p {:style {:color "#777" :margin 0}} "Ask me anything."]
+         (for [[i message] (map-indexed vector messages)]
+           ^{:key i} [chat-message tools-expanded? message]))
+       (when (and (= :loading status) (not= "assistant" (:role (peek messages))))
+         [thinking-line thinking-at])])))
+
+(defn- chat-form [{:keys [input status]}]
+  (let [loading? (= :loading status)]
+    [:form {:on-submit (fn [e]
+                         (.preventDefault e)
+                         (rf/dispatch [::events/chat-send]))
+            :style {:display "flex" :gap "0.4rem"}}
+     ;; Read-only while waiting (rather than disabled) so it keeps the focus.
+     [:input {:type "text" :name "message" :aria-label "Message" :placeholder "Message"
+              :auto-focus true :auto-complete "off" :read-only loading?
+              :style {:flex 1 :min-width 0}
+              :value input
+              :on-change #(rf/dispatch [::events/chat-set-input (.. % -target -value)])}]
+     [:button {:type "submit" :disabled (or loading? (str/blank? input))} "Send"]]))
+
+(defn- chat-body [{:keys [error size] :as chat} user]
+  (case (:status user)
+    :logged-in [:<>
+                [chat-log chat size]
+                (when error [:p {:role "alert" :style {:color "crimson" :margin "0 0 0.5rem"}} error])
+                [chat-form chat]]
+    :anonymous [:p [:a {:href "/auth/login"} "Log in"] " to chat."]
+    :error [:p {:role "alert" :style {:color "crimson"}} (:message user)]
+    nil))
+
+(defn- clamp [lo n hi]
+  (max lo (min n hi)))
+
+(defn- start-resize!
+  "The panel is stuck to the bottom left corner, so dragging its top right corner is what makes it
+  bigger: to the right widens it, up makes the conversation higher. The pointer is followed
+  through the window, wherever it goes, until it is let go."
+  [e {:keys [width height]}]
+  (when (zero? (.-button e))
+    (.preventDefault e)
+    (let [x0 (.-clientX e)
+          y0 (.-clientY e)
+          move (fn [e]
+                 (rf/dispatch [::events/chat-resize
+                               (clamp chat-min-width (+ width (- (.-clientX e) x0))
+                                      (- (.-innerWidth js/window) 40))
+                               (clamp chat-min-height (- height (- (.-clientY e) y0))
+                                      (- (.-innerHeight js/window) chat-chrome-height))]))
+          stop (fn stop [_]
+                 (.removeEventListener js/window "pointermove" move)
+                 (.removeEventListener js/window "pointerup" stop)
+                 (.removeEventListener js/window "pointercancel" stop))]
+      (.addEventListener js/window "pointermove" move)
+      (.addEventListener js/window "pointerup" stop)
+      (.addEventListener js/window "pointercancel" stop))))
+
+(defn- resize-handle [size]
+  [:div {:role "separator" :aria-label "Resize chat" :title "Drag to resize"
+         :on-pointer-down #(start-resize! % size)
+         :style {:position "absolute" :top 0 :right 0 :width "14px" :height "14px"
+                 :cursor "nesw-resize" :touch-action "none"
+                 :background "linear-gradient(225deg, #bbb 0 2px, transparent 2px 5px, #bbb 5px 7px, transparent 7px)"}}])
+
+(defn- chat-panel [{:keys [messages status size tools-expanded?] :as chat} user]
+  [:div {:role "dialog" :aria-label "Chat"
+         :style {:position "absolute" :bottom "40px" :left 0 :box-sizing "border-box"
+                 :width (str (:width size) "px")
+                 :max-width "calc(100vw - 40px)" :padding "15px" :background "#fff" :color "#222"
+                 :border "1px solid #e1e1e1" :border-radius "5px"
+                 :box-shadow "0 5px 15px rgba(0,0,0,0.1)"}}
+   [:div {:style {:display "flex" :align-items "center" :gap "0.5rem"}}
+    [:strong {:style {:flex 1}} "Chat"]
+    (when (tool-use? messages)
+      [link-button {:on-click #(rf/dispatch [::events/chat-toggle-tools])}
+       (if tools-expanded? "Collapse tool use" "Expand tool use")])
+    (when (and (seq messages) (not= :loading status))
+      [link-button {:on-click #(rf/dispatch [::events/chat-clear])} "Clear"])
+    [:button {:type "button" :aria-label "Close chat"
+              :style {:background "none" :border 0 :font-size "1.25rem" :line-height 1 :cursor "pointer"}
+              :on-click #(rf/dispatch [::events/chat-toggle])}
+     "×"]]
+   [chat-body chat user]
+   [resize-handle size]])
+
+(defn chat-widget
+  "A green square in the bottom left corner that opens a chat with the LLM (POST /api/chat), the
+  way the WebMCP widget's blue square in the other corner opens its connection panel. The LLM can
+  use the page's tools (tbd.ui.model-context): the panel shows the calls it makes. Chat needs a
+  login, so someone who isn't logged in is asked to log in."
+  []
+  (let [{:keys [open?] :as chat} @(rf/subscribe [::subs/chat])
+        user @(rf/subscribe [::subs/user])]
+    [:div {:style {:position "fixed" :left "20px" :bottom "20px" :z-index 9999
+                   :font-family "Arial, sans-serif" :font-size "14px"}}
+     (when open? [chat-panel chat user])
+     [:button {:type "button" :aria-label "Chat" :title "Chat" :aria-expanded (boolean open?)
+               :style {:display "block" :width "30px" :height "30px" :padding 0 :border 0
+                       :border-radius "4px" :cursor "pointer" :background chat-green
+                       :box-shadow "0 2px 10px rgba(0,0,0,0.2)"}
+               :on-click #(rf/dispatch [::events/chat-toggle])}]]))
+
+(defn- current-page [page user]
+  (case page
+    :tic-tac-toe [tic-tac-toe]
+    :calculator [calculator]
+    :todos (if (= :logged-in (:status user)) [todos] [login-prompt user])
+    :ai-setup [:<> [mcp-setup] [browser-tools]]))
+
+(defn- tabs
+  "One link per page, the current one marked. The todos are only offered when logged in."
+  [current user]
+  [:nav {:aria-label "Pages" :style {:display "flex" :flex-wrap "wrap" :gap "1rem"
+                                     :border-bottom "1px solid GrayText" :padding-bottom "0.5rem"}}
+   (for [{:keys [id title login?]} pages/pages
+         :when (or (not login?) (= :logged-in (:status user)))]
+     ^{:key id}
+     [:a (cond-> {:href (pages/page->hash id)}
+           (= id current) (assoc :aria-current "page" :style {:font-weight "bold"}))
+      title])])
+
+(defn app []
+  (let [page @(rf/subscribe [::subs/page])
+        user @(rf/subscribe [::subs/user])]
+    [:<>
+     [:main {:style {:font-family "system-ui, sans-serif" :max-width "40rem" :margin "2rem auto"}}
+      [:h1 "tbd"]
+      [tabs page user]
+      [current-page page user]
+      [:p {:style {:margin-top "2rem"}}
+       [:a {:href "/api-docs"} "API docs"] " · " [:a {:href "/swagger.json"} "swagger.json"]
+       (when-let [link (auth-link user)]
+         [:<> " · " link])]]
+     [chat-widget]]))

ui/src/tbd/ui/webmcp.cljs

@@ -0,0 +1,539 @@
+(ns tbd.ui.webmcp
+  "The page's own MCP tools, for an agent running in the browser: the client-side counterpart of
+  tbd.mcp.tools. They are offered through WebMCP (https://webmcp.dev, the `@jason.today/webmcp`
+  library): it adds a small widget to the page, the user pastes a token from their MCP client
+  (Claude) into it, and the client then sees the tools registered here. Where tbd.mcp.tools works
+  on the server's data, these work the UI: each one does what a user could do on the page (type in
+  the form, press a button, tick a box) by dispatching the same re-frame events the views do, so
+  everything shows on screen, and reads what the page shows from the app-db.
+
+  Besides the tools, the page registers prompts and resources (`prompts`, `resources`), which is
+  what an MCP client lists next to the tools (Claude Code shows the prompts as slash commands and
+  the resources as @-mentions). They are the same instructions the page's own chatbot is given
+  (tbd.agent.prompt, shared with the server), so Claude or Codex is told to act rather than offer,
+  to chain calls and to play tic-tac-toe by the turn, and can read what page is open.
+
+  The same tools are registered with tbd.ui.model-context (by tbd.ui.core), which is how the page's
+  own chatbot offers them to its LLM and calls them, the ones of the page being shown (see
+  `tools`): this ns says what the tools are, and has the WebMCP way of offering them all to an
+  agent outside the page.
+
+  A tool takes its arguments as a map and returns a value or a promise of one: a string, or data
+  that becomes JSON. Throwing (or rejecting) becomes an error result the agent can read. Input
+  schemas are JSON Schema, written here: the UI has no Malli to share with the server's."
+  (:require ["@jason.today/webmcp/src/webmcp.js" :as WebMCP]
+            [clojure.string :as str]
+            [re-frame.core :as rf]
+            [re-frame.db :as rf-db]
+            [tbd.agent.prompt :as prompt]
+            [tbd.ui.events :as events]
+            [tbd.ui.model-context :as model-context]
+            [tbd.ui.pages :as pages]
+            [tbd.ui.tictactoe :as tictactoe]))
+
+;; --- Reading and waiting for the app-db ---
+
+(def ^:private timeout-ms
+  "How long a tool waits for the server to answer before giving up."
+  10000)
+
+(defn- db [] @rf-db/app-db)
+
+(defn- fail! [message] (throw (js/Error. message)))
+
+(defn- show!
+  "Opens `page` (see tbd.ui.pages), the way a user would click its tab, so a tool that acts on
+  the page does it where it can be seen."
+  [page]
+  (rf/dispatch-sync [::events/navigate page]))
+
+(defn- settled
+  "A promise of the app-db as soon as `(pred db)` holds (right away if it already does), or a
+  rejection after `timeout-ms`. Requests made by events finish some time after the event is
+  dispatched, so a tool that changes something waits for the change to show up in the db."
+  [pred what]
+  (js/Promise.
+    (fn [resolve reject]
+      (if (pred (db))
+        (resolve (db))
+        (let [k (keyword "tbd.ui.webmcp" (str (gensym "await")))
+              timer (atom nil)
+              finish! (fn [f v]
+                        (remove-watch rf-db/app-db k)
+                        (js/clearTimeout @timer)
+                        (f v))]
+          (reset! timer (js/setTimeout #(finish! reject (js/Error. (str "timed out waiting for " what)))
+                                       timeout-ms))
+          (add-watch rf-db/app-db k (fn [_ _ _ new-db]
+                                      (when (pred new-db) (finish! resolve new-db)))))))))
+
+(defn- known-user
+  "A promise of the login state, once the page has found out what it is."
+  []
+  (-> (settled #(not= :unknown (get-in % [:user :status])) "the login state")
+      (.then #(:user %))))
+
+(defn- logged-in!
+  "A promise that is fulfilled once the page knows someone is logged in, or rejected if no one is
+  (`what` is what needs the login: the page hides it then) or the page can't tell."
+  [what]
+  (-> (known-user)
+      (.then (fn [{:keys [status message]}]
+               (case status
+                 :logged-in nil
+                 :anonymous (fail! (str "not logged in: log in on the page to use " what))
+                 :error (fail! (str "could not tell who is logged in: " message)))))))
+
+(defn- logged-in-todos
+  "A promise of the todo list as the page shows it, or a rejection if there is no login (the page
+  hides the todos then) or the list could not be loaded."
+  []
+  (-> (logged-in! "the todos")
+      (.then #(settled (fn [d] (contains? #{:ok :error} (get-in d [:todos :status]))) "the todos"))
+      (.then (fn [d]
+               (let [{:keys [status items error]} (:todos d)]
+                 (if (= :error status) (fail! error) items))))))
+
+(defn- todo-failure
+  "Why the last change to the todos failed, or nil. A 401 drops the login, so that counts too."
+  [d]
+  (or (get-in d [:todos :error])
+      (when (not= :logged-in (get-in d [:user :status]))
+        "the login has expired: log in again on the page")))
+
+(defn- change-todos
+  "Dispatches `event`, then waits for `(done? db)` (or for the change to fail, which throws why),
+  and returns the db."
+  [event done? what]
+  (rf/dispatch-sync event)
+  (-> (settled #(or (todo-failure %) (done? %)) what)
+      (.then (fn [d] (if-let [why (todo-failure d)] (fail! why) d)))))
+
+(defn- find-todo [items id]
+  (first (filter #(= id (:id %)) items)))
+
+(defn- find-todo! [items id]
+  (or (find-todo items id) (fail! (str "todo not found: " id))))
+
+;; --- Argument checks (the page can't trust that the agent honours the schema) ---
+
+(defn- check-id! [id]
+  (when-not (and (string? id) (seq id))
+    (fail! "invalid arguments: id must be a todo's id, the UUID list_todos gives")))
+
+(defn- check-todos!
+  "Checks the `todos` argument of a todo tool, which takes its work as a list (one call for a
+  whole batch, not one call per todo): a non-empty list of maps that `check-item!` accepts."
+  [todos check-item!]
+  (when-not (and (sequential? todos) (seq todos) (every? map? todos))
+    (fail! "invalid arguments: todos must be a non-empty list of objects"))
+  (run! check-item! todos))
+
+(defn- in-order
+  "A promise of the vector of `(f item)` (a promise) for each of `items`, run one at a time: a
+  request finishes before the next starts, so a failure is one item's. When one fails after
+  others were done, the error says how many were."
+  [f items]
+  (let [total (count items)]
+    (reduce (fn [so-far item]
+              (.then so-far
+                     (fn [results]
+                       (-> (js/Promise.resolve item)
+                           (.then f)
+                           (.then #(conj results %))
+                           (.catch (fn [e]
+                                     (fail! (if (seq results)
+                                              (str (.-message e) " (the first " (count results) " of "
+                                                   total " were done)")
+                                              (.-message e)))))))))
+            (js/Promise.resolve [])
+            items)))
+
+;; --- The tools ---
+
+(defn- ping [_] "pong")
+
+(defn- navigate
+  "Opens a page, as a click on its tab would."
+  [{:keys [page]}]
+  (let [{:keys [id title login?] :as target} (when (string? page)
+                                               (first (filter #(= page (name (:id %))) pages/pages)))]
+    (when-not target
+      (fail! (str "invalid arguments: page must be one of " (str/join ", " (map (comp name :id) pages/pages)))))
+    (-> (if login? (logged-in! (str "the " title " page")) (js/Promise.resolve))
+        (.then (fn [_]
+                 (show! id)
+                 {:page (name id) :title title})))))
+
+(defn- whoami [_]
+  (-> (known-user)
+      (.then (fn [{:keys [status login message]}]
+               (case status
+                 :logged-in (str "logged in as " login)
+                 :anonymous "not logged in"
+                 :error (str "could not tell who is logged in: " message))))))
+
+(defn- get-calculator
+  [_]
+  (:calc (db)))
+
+(defn- add
+  "Types the numbers into the calculator form and presses Add."
+  [{:keys [x y]}]
+  (when-not (and (number? x) (js/Number.isFinite x) (number? y) (js/Number.isFinite y))
+    (fail! "invalid arguments: x and y must be numbers"))
+  (when (= :loading (get-in (db) [:calc :result :status]))
+    (fail! "an addition is already in progress"))
+  (show! :calculator)
+  (rf/dispatch-sync [::events/set-operand :x (str x)])
+  (rf/dispatch-sync [::events/set-operand :y (str y)])
+  (rf/dispatch-sync [::events/add])
+  (-> (settled #(not= :loading (get-in % [:calc :result :status])) "the sum")
+      (.then (fn [d]
+               (let [{:keys [status sum message]} (get-in d [:calc :result])]
+                 (if (= :ok status)
+                   {:x x :y y :sum sum}
+                   (fail! message)))))))
+
+(defn- list-todos [_]
+  (logged-in-todos))
+
+(defn- get-todo
+  "Reads todos by id, all of them or none."
+  [{:keys [todos]}]
+  (check-todos! todos #(check-id! (:id %)))
+  (-> (logged-in-todos)
+      (.then (fn [items] (mapv #(find-todo! items (:id %)) todos)))))
+
+(defn- create-one
+  "Types the title into the new-todo field and presses Add. A promise of the todo that was created."
+  [{:keys [title]}]
+  (show! :todos)
+  (rf/dispatch-sync [::events/set-new-title title])
+  ;; The field is emptied when the todo was added; a failure leaves it as it is.
+  (-> (change-todos [::events/add-todo] #(= "" (get-in % [:todos :new-title])) "the new todo")
+      (.then #(last (get-in % [:todos :items])))))
+
+(defn- create-todo
+  "Adds todos, one after the other: a promise of the todos that were created."
+  [{:keys [todos]}]
+  (check-todos! todos (fn [{:keys [title]}]
+                        (when-not (and (string? title) (seq title))
+                          (fail! "invalid arguments: title must be a non-empty string"))))
+  (-> (logged-in-todos)
+      (.then (fn [_] (in-order create-one todos)))))
+
+(defn- set-one-done
+  "Ticks or unticks one todo's checkbox, unless it is already so (no request then). A promise of
+  the todo as the page shows it."
+  [{:keys [id done]}]
+  (let [todo (find-todo! (get-in (db) [:todos :items]) id)]
+    (if (= done (boolean (:done todo)))
+      (js/Promise.resolve todo)
+      (-> (change-todos [::events/set-done id done]
+                        #(= done (boolean (:done (find-todo (get-in % [:todos :items]) id))))
+                        "the todo")
+          (.then #(find-todo (get-in % [:todos :items]) id))))))
+
+(defn- set-todo-done
+  "Ticks or unticks the checkboxes of several todos. Every change is checked before the first is
+  made. A promise of the todos as they are then."
+  [{:keys [todos]}]
+  (check-todos! todos (fn [{:keys [id done]}]
+                        (check-id! id)
+                        (when-not (boolean? done)
+                          (fail! "invalid arguments: done must be true or false"))))
+  (-> (logged-in-todos)
+      (.then (fn [items]
+               (run! #(find-todo! items (:id %)) todos)
+               (show! :todos)
+               (in-order set-one-done todos)))))
+
+(defn- delete-one
+  "Presses a todo's Delete button. A promise of its id."
+  [id]
+  (-> (change-todos [::events/delete-todo id]
+                    #(nil? (find-todo (get-in % [:todos :items]) id))
+                    "the todo to go")
+      (.then (fn [_] id))))
+
+(defn- delete-todo
+  "Presses the Delete button of several todos. Every id is looked up before the first is deleted."
+  [{:keys [todos]}]
+  (check-todos! todos #(check-id! (:id %)))
+  (let [ids (distinct (map :id todos))]
+    (-> (logged-in-todos)
+        (.then (fn [items]
+                 (run! #(find-todo! items %) ids)
+                 (show! :todos)
+                 (in-order delete-one ids)))
+        (.then (fn [deleted] {:deleted deleted})))))
+
+;; Tic-tac-toe is moves taken in turns: X, then O, on the same board. A person plays on the same
+;; board, so a move names the side it is for, and is refused when it is not that side's turn: an
+;; agent that lost track of whose turn it is cannot play the person's move (or both sides).
+;; Every result says whose turn it is.
+
+(defn- tic-tac-toe-state
+  "The game as the page shows it: the 9 cells (row by row, cell 0 is the top left; null when
+  empty, else \"x\" or \"o\"), `turn` (whose move it is, while the game is on), and `status`
+  (in_progress, won or draw; with `winner` and `line` when won)."
+  []
+  (let [{:keys [board turn]} (:ttt (db))
+        {:keys [player line] :as outcome} (tictactoe/outcome board)]
+    (cond-> {:board board}
+      (nil? outcome) (assoc :status "in_progress" :turn turn)
+      (= :draw outcome) (assoc :status "draw")
+      player (assoc :status "won" :winner player :line line))))
+
+(defn- get-tic-tac-toe [_]
+  (tic-tac-toe-state))
+
+(defn- move-tic-tac-toe
+  "Presses cell `cell` as `player` (\"x\" or \"o\"), only if it is that player's turn."
+  [{:keys [cell player]}]
+  (when-not (and (number? cell) (js/Number.isInteger cell) (<= 0 cell 8))
+    (fail! "invalid arguments: cell must be an integer from 0 to 8"))
+  (when-not (contains? #{"x" "o"} player)
+    (fail! "invalid arguments: player must be \"x\" or \"o\""))
+  (let [{:keys [board turn]} (:ttt (db))]
+    (when (tictactoe/outcome board)
+      (fail! "the game is over: start a new game"))
+    (when (not= player (name turn))
+      (fail! (str "it is " (name turn) "'s turn, not " player "'s: wait for the other side to move")))
+    (when (board cell)
+      (fail! (str "cell " cell " is taken")))
+    (show! :tic-tac-toe)
+    (rf/dispatch-sync [::events/ttt-move cell])
+    (tic-tac-toe-state)))
+
+(defn- new-tic-tac-toe-game
+  "Presses New game."
+  [_]
+  (show! :tic-tac-toe)
+  (rf/dispatch-sync [::events/ttt-reset])
+  (tic-tac-toe-state))
+
+(defn- object-schema [properties required]
+  {:type "object" :properties properties :required required})
+
+(def ^:private todo-id {:type "string" :description "The todo's id, a UUID as list_todos gives it"})
+
+(defn- todos-schema
+  "The `todos` argument of the todo tools: a list of objects, one per todo the call is about, so
+  that a batch is one call."
+  [description properties required]
+  (object-schema {:todos {:type "array" :minItems 1 :description description
+                          :items (object-schema properties required)}}
+                 ["todos"]))
+
+(def tools
+  "The tools, as {:name :description :input-schema :handler :pages}. `pages` is where the page's
+  own chatbot is offered the tool (see tbd.ui.model-context): the tools of a page's content are
+  only offered on that page, and the rest (no `pages`) on every page. An agent outside the page,
+  through WebMCP, is offered all of them."
+  [{:name "ping" :description "Health check: returns pong. Almost never useful: do not call it to look busy"
+    :input-schema (object-schema {} []) :handler ping}
+
+   {:name "whoami"
+    :description "Says who is logged in on this page, if anyone"
+    :input-schema (object-schema {} []) :handler whoami}
+
+   {:name "navigate"
+    :description (str "Opens one of the pages of the app, as a click on its tab would, and returns the page "
+                      "that is shown now (JSON). The pages are: "
+                      (str/join ", " (map (fn [{:keys [id title login?]}]
+                                            (str (name id) " (" title (when login? ", needs a login") ")"))
+                                          pages/pages))
+                      ". Each page has tools of its own, which are on offer once you are on it. Go there "
+                      "yourself, without asking, whenever what the user wants is on another page")
+    :input-schema (object-schema {:page {:type "string" :enum (mapv (comp name :id) pages/pages)
+                                         :description "The page to open"}}
+                                 ["page"])
+    :handler navigate}
+
+   {:name "get_calculator" :pages #{:calculator}
+    :description (str "What the calculator form on this page holds (JSON): the x and y in its fields, and "
+                      "the result it is showing (status idle, loading, ok with the sum, or error with the message)")
+    :input-schema (object-schema {} []) :handler get-calculator}
+
+   {:name "add" :pages #{:calculator}
+    :description (str "Adds two numbers: types them into the calculator form, presses Add, and returns the sum "
+                      "the page shows (JSON). Only for arithmetic, not for adding items to a list")
+    :input-schema (object-schema {:x {:type "number" :description "The first number"}
+                                  :y {:type "number" :description "The second number"}}
+                                 ["x" "y"])
+    :handler add}
+
+   {:name "list_todos" :pages #{:todos}
+    :description (str "Lists the todos this page shows (JSON: id, title, done, created-at, updated-at), oldest first. "
+                      "Needs a login on the page")
+    :input-schema (object-schema {} []) :handler list-todos}
+
+   {:name "get_todo" :pages #{:todos}
+    :description (str "Gets todos this page shows, by id (JSON list). Takes a list: to read several, make ONE call "
+                      "with all of them")
+    :input-schema (todos-schema "The todos to get, one per todo" {:id todo-id} ["id"])
+    :handler get-todo}
+
+   {:name "create_todo" :pages #{:todos}
+    :description (str "Adds todos: types each title into the new-todo field and presses Add, and returns the todos "
+                      "that were created (JSON list). Takes a list: to add several, make ONE call with all of them, "
+                      "never one call per todo")
+    :input-schema (todos-schema "The todos to add, one per todo"
+                                {:title {:type "string" :minLength 1 :maxLength 200 :description "What needs doing"}}
+                                ["title"])
+    :handler create-todo}
+
+   {:name "set_todo_done" :pages #{:todos}
+    :description (str "Ticks or unticks the checkboxes of todos, and returns those todos (JSON list). Takes a list: "
+                      "to change several, make ONE call with all of them, never one call per todo")
+    :input-schema (todos-schema "The changes to make, one per todo"
+                                {:id todo-id
+                                 :done {:type "boolean" :description "true to tick it off, false to untick it"}}
+                                ["id" "done"])
+    :handler set-todo-done}
+
+   {:name "delete_todo" :pages #{:todos}
+    :description (str "Deletes todos for good, by pressing their Delete buttons, and returns the ids that were "
+                      "deleted (JSON). Find the ids with list_todos first; never guess one, and never delete a "
+                      "todo the user did not clearly point at. Takes a list: to delete several, make ONE call "
+                      "with all of them")
+    :input-schema (todos-schema "The todos to delete, one per todo" {:id todo-id} ["id"])
+    :handler delete-todo}
+
+   {:name "get_tic_tac_toe" :pages #{:tic-tac-toe}
+    :description (str "The tic-tac-toe game on this page (JSON): board (9 cells, row by row, cell 0 the top left "
+                      "and cell 8 the bottom right; null when empty, else \"x\" or \"o\"), turn (whose move it "
+                      "is, \"x\" or \"o\": X goes first, and they alternate) and status (in_progress, won or draw; "
+                      "when won, also winner and line). A person moves on the same board, so check the turn "
+                      "before you move, and only move for your own side")
+    :input-schema (object-schema {} []) :handler get-tic-tac-toe}
+
+   {:name "move_tic_tac_toe" :pages #{:tic-tac-toe}
+    :description (str "Presses a cell of the tic-tac-toe board as `player`, your side, and returns the game as "
+                      "get_tic_tac_toe does (including whose turn is next). Fails, and changes nothing, if it "
+                      "is not your side's turn (the other side is the person's: wait for them to move), the "
+                      "cell is taken or the game is over. Never move for the other side")
+    :input-schema (object-schema {:cell {:type "integer" :minimum 0 :maximum 8
+                                         :description "0 is the top left, 2 the top right, 8 the bottom right"}
+                                  :player {:type "string" :enum ["x" "o"]
+                                           :description (str "The side you play. The move is refused if it "
+                                                             "is the other side's turn")}}
+                                 ["cell" "player"])
+    :handler move-tic-tac-toe}
+
+   {:name "new_tic_tac_toe_game" :pages #{:tic-tac-toe}
+    :description "Presses New game: clears the tic-tac-toe board, X to move (JSON, as get_tic_tac_toe)"
+    :input-schema (object-schema {} []) :handler new-tic-tac-toe-game}])
+
+;; --- Prompts and resources ---
+
+(def prompts
+  "The prompts an MCP client can start from, as {:name :description :arguments :handler}: `handler`
+  takes the arguments the client gave (strings, or nothing) and returns the prompt's text.
+  `arguments` is [{:name :description :required}], as MCP's `prompts/list`."
+  [{:name "drive_the_app"
+    :description (str "How to work this app's page: act in the same turn instead of offering, chain the "
+                      "tools, report in a sentence. Optionally hands over what you want done")
+    :arguments [{:name "task" :required false
+                 :description "What you want done in the app, e.g. \"add a todo to buy milk\""}]
+    :handler (fn [{:keys [task]}] (prompt/task task))}
+
+   {:name "play_tic_tac_toe"
+    :description "Plays tic-tac-toe with you on the page: moves only on its own side's turn, one move at a time"
+    :arguments [{:name "side" :required false
+                 :description "The side the agent plays, \"x\" or \"o\" (default o: you play X and start)"}]
+    :handler (fn [{:keys [side]}] (prompt/tic-tac-toe side))}])
+
+(defn- page-state
+  "A promise of what the page is showing: the open page, the pages and who is logged in."
+  []
+  (-> (known-user)
+      (.then (fn [{:keys [status login message]}]
+               {:page (name (:page (db)))
+                :pages (mapv (fn [{:keys [id title login?]}]
+                               (cond-> {:id (name id) :title title} login? (assoc :needs-login true)))
+                             pages/pages)
+                :user (case status
+                        :logged-in {:logged-in true :login login}
+                        :anonymous {:logged-in false}
+                        :error {:error message})}))))
+
+(def resources
+  "The resources an MCP client can read, as {:name :description :uri :mime-type :provide}:
+  `provide` returns the text, or a promise of it."
+  [{:name "app_guide" :uri "webmcp://app/guide" :mime-type "text/markdown"
+    :description (str "Read this first: what the page's tools are for and how to use them (act, don't "
+                      "offer; chain the calls; report briefly)")
+    :provide (fn [] prompt/guide)}
+
+   {:name "app_state" :uri "webmcp://app/state" :mime-type "application/json"
+    :description "Which page is open now, the pages of the app, and whether anyone is logged in (JSON)"
+    :provide (fn [] (-> (page-state) (.then #(js/JSON.stringify (clj->js %) nil 2))))}])
+
+;; --- Registering them with WebMCP ---
+
+(defn- text-result [text error?]
+  ;; Property names are strings: WebMCP's are not in the Closure externs, so an advanced build
+  ;; would rename plain `.-isError` style access.
+  (let [content #js [#js {"type" "text" "text" text}]]
+    (if error?
+      #js {"content" content "isError" true}
+      #js {"content" content})))
+
+(defn- execute
+  "A WebMCP `execute` callback for `handler`: runs it on the arguments, and turns what it
+  returns, or the error it throws, into a tool result."
+  [handler]
+  (fn [args]
+    (-> (model-context/run handler (js->clj args :keywordize-keys true))
+        (.then (fn [{:keys [text error?]}] (text-result text error?))))))
+
+(defn register-tools!
+  "Registers `tools` on `mcp`, a WebMCP instance: `registerTool(name, description, inputSchema,
+  execute)`. Registering a name again replaces the tool, so this is safe to call again (hot
+  reload). (WebMCP's methods are called by string: they are not in the Closure externs.)"
+  [mcp]
+  (doseq [{:keys [name description input-schema handler]} tools]
+    (js-invoke mcp "registerTool" name description (clj->js input-schema) (execute handler)))
+  mcp)
+
+(defn- prompt-result
+  "MCP's `prompts/get` result: the prompt's text as the user's first message."
+  [description text]
+  #js {"description" description
+       "messages" #js [#js {"role" "user" "content" #js {"type" "text" "text" text}}]})
+
+(defn register-prompts!
+  "Registers `prompts` on `mcp`: `registerPrompt(name, description, arguments, execute)`. Safe to
+  call again, like `register-tools!`."
+  [mcp]
+  (doseq [{:keys [name description arguments handler]} prompts]
+    (js-invoke mcp "registerPrompt" name description (clj->js arguments)
+               (fn [args] (prompt-result description (handler (js->clj args :keywordize-keys true))))))
+  mcp)
+
+(defn register-resources!
+  "Registers `resources` on `mcp`: `registerResource(name, description, {uri, mimeType}, provide)`,
+  where `provide(uri)` gives MCP's `resources/read` result. Safe to call again."
+  [mcp]
+  (doseq [{:keys [name description uri mime-type provide]} resources]
+    (js-invoke mcp "registerResource" name description #js {"uri" uri "mimeType" mime-type}
+               (fn [requested]
+                 (-> (js/Promise.resolve (provide))
+                     (.then (fn [text]
+                              #js {"contents" #js [#js {"uri" requested "mimeType" mime-type "text" text}]}))))))
+  mcp)
+
+(defonce ^:private widget (atom nil))
+
+(defn register!
+  "Offers `tools`, `prompts` and `resources` to the agent through WebMCP. The first call creates
+  the WebMCP widget (the small square in the corner of the page, where the user pastes the token
+  from their MCP client), later ones only register them again. Returns the WebMCP instance."
+  []
+  (-> (or @widget (reset! widget (WebMCP.)))
+      register-tools!
+      register-prompts!
+      register-resources!))

ui/test/dom-setup.cjs

@@ -0,0 +1,66 @@
+// Preloaded by `npm test` (node -r) before any compiled code runs: gives the ClojureScript
+// tests a browser-like global scope (window, document, location, ...) backed by jsdom.
+//
+// It has to happen first: React DOM decides at load time whether the browser supports the
+// `input` event; without a `window` then, <input onChange> never fires under test.
+const { JSDOM } = require("jsdom");
+
+const { window } = new JSDOM('<!doctype html><html><body><div id="app"></div></body></html>', {
+  url: "http://localhost:3000/",
+});
+
+// Copy the window's globals over, but leave Node's own (fetch, setTimeout, navigator, ...) alone.
+for (const key of Object.getOwnPropertyNames(window)) {
+  if (!(key in globalThis)) {
+    Object.defineProperty(globalThis, key, {
+      configurable: true,
+      get: () => window[key],
+      set: (value) => Object.defineProperty(globalThis, key, { value, writable: true, configurable: true }),
+    });
+  }
+}
+globalThis.window = window;
+
+// WebMCP, for `require("@jason.today/webmcp/src/webmcp.js")`. Its only export is
+// `module.exports = WebMCP`, guarded by `typeof module`, in a file its package.json declares as an
+// ES module. The browser build wraps it as CommonJS, so there it exports the class; Node's
+// require() loads it as ESM, where `module` doesn't exist, and gets nothing. So run the same
+// source with a `module` to export to, and hand that to require.
+const Module = require("module");
+const fs = require("fs");
+
+const webmcp = require.resolve("@jason.today/webmcp/src/webmcp.js");
+const cjs = new Module(webmcp);
+cjs.filename = webmcp;
+new Function("module", "exports", fs.readFileSync(webmcp, "utf8"))(cjs, cjs.exports);
+cjs.loaded = true;
+require.cache[webmcp] = cjs;
+
+// A run that doesn't finish must not look like a pass. An async test that throws before it calls
+// `done` (or whose promise chain rejects) never ends: the process then hangs, or runs out of things
+// to do and exits 0 without a word. Fail instead, and say which test it was.
+function fail(message) {
+  console.error(`\nFAILED: ${message}`);
+  process.exit(1);
+}
+
+process.on("unhandledRejection", (reason) =>
+  fail(`unhandled promise rejection (an async test without a catch?): ${(reason && reason.stack) || reason}`));
+
+// tbd.ui.test-util keeps `uiTestsCurrent` up to date: the test that is running, and since when.
+const STUCK_MS = 30000;
+globalThis.uiTestsCurrent = { name: "loading the tests", since: Date.now() };
+setInterval(() => {
+  const { name, since } = globalThis.uiTestsCurrent;
+  if (Date.now() - since > STUCK_MS) {
+    fail(`stuck for ${STUCK_MS / 1000}s in ${name} (an async test that never called done?)`);
+  }
+}, 1000).unref();
+
+// ... and sets `uiTestsFinished` once cljs.test has printed its summary.
+process.on("exit", (code) => {
+  if (code === 0 && !globalThis.uiTestsFinished) {
+    console.error("\nFAILED: the tests ended without reporting a result");
+    process.exitCode = 1;
+  }
+});

ui/test/tbd/ui/core_test.cljs

@@ -0,0 +1,73 @@
+(ns tbd.ui.core-test
+  (:require [cljs.test :refer [deftest is async use-fixtures]]
+            [re-frame.db :as rf-db]
+            [reagent.dom.client :as rdc]
+            [tbd.ui.core :as core]
+            [tbd.ui.model-context :as model-context]
+            [tbd.ui.test-util :as tu]
+            [tbd.ui.webmcp :as webmcp]))
+
+;; init runs as in the browser, WebMCP widget included (the library is loaded through
+;; test/webmcp-shim.cjs; see shadow-cljs.edn). Each test gets a fresh widget, and it is taken
+;; off the page afterwards.
+
+(defn- widget [] @@#'webmcp/widget)
+
+(defn- tools-in-widget
+  "The names of the tools the WebMCP widget offers its client."
+  []
+  (set (js/Array.from (.keys (.-availableTools ^js (widget))))))
+
+(def ^:private real-log (.-log js/console))
+
+(use-fixtures :each
+  tu/fake-server-fixture
+  tu/url-fixture
+  {:before (fn []
+             (reset! @#'webmcp/widget nil)
+             ;; The widget logs every tool it registers. (Not console.log as a whole: that is
+             ;; where the test report goes.)
+             (set! (.-log js/console)
+                   (fn [& args]
+                     (when-not (re-find #"^(Tool registered|Saved items)" (str (first args)))
+                       (.apply real-log js/console (to-array args))))))
+   :after (fn []
+            (set! (.-log js/console) real-log)
+            (when-let [w (widget)]
+              (some-> (.getElementById js/document (.-elementId ^js w)) .remove))
+            (reset! @#'webmcp/widget nil)
+            (.clear js/sessionStorage)
+            (model-context/clear!)
+            ;; init mounts the page in a root of its own.
+            (when-let [root @core/root]
+              (rdc/unmount root)
+              (reset! core/root nil)))})
+
+(deftest init-test
+  (tu/log-in!)
+  (async done
+    (tu/finish
+      (tu/steps
+        (fn []
+          (core/init)
+          (is (= :unknown (get-in @rf-db/app-db [:user :status])) "it starts out not knowing who is logged in")
+          (tu/shows "the page is on the screen" "main h1" "tbd"))
+        (fn []
+          (is (some? (.getElementById js/document (.-elementId ^js (widget)))) "the WebMCP widget is on the page")
+          (is (= (set (map :name webmcp/tools)) (tools-in-widget)) "it offers the page's tools to the agent")
+          (is (= (map :name (remove :pages webmcp/tools)) (map :name (model-context/definitions :ai-setup)))
+              "and to the chatbot, the ones of the page it is on")
+          ;; A tool, as the agent's client calls it.
+          (let [ping (.-execute (.get (.-availableTools ^js (widget)) "ping"))]
+            (-> (ping #js {})
+                (.then (fn [result] (is (= "pong" (.. result -content (at 0) -text))))))))
+        (fn []
+          (tu/eventually (fn [] (some #(= "Todos" (.-textContent %)) (tu/q-all "nav a")))))
+        (fn []
+          (is (= :logged-in (get-in @rf-db/app-db [:user :status])))
+          ;; The hot-reload hook redraws and registers the tools again, without starting over.
+          (.clear (.-availableTools ^js (widget)))
+          (core/reload)
+          (is (= (set (map :name webmcp/tools)) (tools-in-widget)))
+          (tu/shows "still there after a reload" "main h1" "tbd")))
+      done)))

ui/test/tbd/ui/fetch_stream_test.cljs

@@ -0,0 +1,149 @@
+(ns tbd.ui.fetch-stream-test
+  "The ::fetch-stream effect (what the chat's replies come in through), run for real against fakes
+  of fetch that fail in the ways a network does."
+  (:require [cljs.test :refer [deftest is testing async use-fixtures]]
+            [re-frame.core :as rf]
+            [tbd.ui.events :as events]
+            [tbd.ui.test-util :as tu]))
+
+(use-fixtures :each tu/fake-server-fixture)
+
+(def ^:private got (atom []))
+
+(rf/reg-event-fx ::got-event (fn [_ [_ event]] (swap! got conj [:event event]) nil))
+(rf/reg-event-fx ::got-response (fn [_ [_ response]] (swap! got conj [:response response]) nil))
+
+(defn- bytes-of [text] (.encode (js/TextEncoder.) text))
+
+(defn- reader
+  "A body reader that gives `reads` one at a time: bytes, or :fail for a read that fails. Then it's done."
+  [reads]
+  (let [reads (atom reads)]
+    #js {:read (fn []
+                 (let [r (first @reads)]
+                   (swap! reads rest)
+                   (cond
+                     (nil? r) (js/Promise.resolve #js {:done true})
+                     (= :fail r) (js/Promise.reject (js/Error. "network error"))
+                     :else (js/Promise.resolve #js {:done false :value r}))))}))
+
+(defn- streaming
+  "A fetch that answers 200 with a body of `reads` (see `reader`), and notes what it was asked."
+  [asked & reads]
+  (fn [uri opts]
+    (reset! asked [uri (js->clj opts :keywordize-keys true)])
+    (js/Promise.resolve #js {:ok true :status 200 :body #js {:getReader (fn [] (reader reads))}})))
+
+(defn- stream!
+  "Runs the effect against `fetch`, and gives a promise of what was dispatched once `n` things were
+  (and a moment more, for anything that shouldn't come)."
+  [fetch n]
+  (reset! got [])
+  (aset js/globalThis "fetch" fetch)
+  ((tu/real-effect ::events/fetch-stream)
+   {:uri "/api/chat" :method "POST" :body {:x 1} :on-event [::got-event] :on-response [::got-response]})
+  (-> (tu/eventually #(>= (count @got) n))
+      (.then (fn [_] (js/Promise. (fn [resolve] (js/setTimeout #(resolve @got) 30)))))))
+
+(defn- sse [& events]
+  (bytes-of (apply str (map #(str "data: " (js/JSON.stringify (clj->js %)) "\n\n") events))))
+
+(deftest request-test
+  (async done
+    (let [asked (atom nil)]
+      (tu/finish
+        (tu/steps
+          #(stream! (streaming asked (sse {:type "RUN_FINISHED"})) 1)
+          (fn [_]
+            (is (= ["/api/chat" {:method "POST"
+                                 :headers {:Content-Type "application/edn"}
+                                 :body "{:x 1}"}]
+                   @asked))))
+        done))))
+
+(deftest events-test
+  (async done
+    (tu/finish
+      (tu/steps
+        #(stream! (streaming (atom nil)
+                             (sse {:type "REASONING_MESSAGE_CONTENT" :delta "hm"} {:type "TEXT_MESSAGE_CONTENT" :delta "Hel"})
+                             (sse {:type "TEXT_MESSAGE_CONTENT" :delta "lo"} {:type "RUN_FINISHED"}))
+                 4)
+        (fn [got]
+          (is (= [[:event {:type "REASONING_MESSAGE_CONTENT" :delta "hm"}]
+                  [:event {:type "TEXT_MESSAGE_CONTENT" :delta "Hel"}]
+                  [:event {:type "TEXT_MESSAGE_CONTENT" :delta "lo"}]
+                  [:event {:type "RUN_FINISHED"}]]
+                 got)
+              "each event as it arrives, and nothing more when it ended properly")))
+      done)))
+
+(deftest split-anywhere-test
+  ;; The network cuts the stream wherever it likes: in a line, and in a multi-byte character too.
+  (async done
+    (let [bytes (sse {:type "TEXT_MESSAGE_CONTENT" :delta "héllo 👋 世界"} {:type "RUN_FINISHED"})
+          expected [[:event {:type "TEXT_MESSAGE_CONTENT" :delta "héllo 👋 世界"}] [:event {:type "RUN_FINISHED"}]]]
+      (tu/finish
+        (apply tu/steps
+               (for [cut (range 1 (.-length bytes))]
+                 (fn [_]
+                   (-> (stream! (streaming (atom nil) (.subarray bytes 0 cut) (.subarray bytes cut)) 2)
+                       (.then (fn [got] (is (= expected got) (str "cut at byte " cut))))))))
+        done))))
+
+(deftest lost-connection-test
+  (testing "a stream that ends without saying it is over"
+    (async done
+      (tu/finish
+        (tu/steps
+          #(stream! (streaming (atom nil) (sse {:type "TEXT_MESSAGE_CONTENT" :delta "Hi"})) 2)
+          (fn [got]
+            (is (= [[:event {:type "TEXT_MESSAGE_CONTENT" :delta "Hi"}]
+                    [:event {:type "RUN_ERROR" :message "the connection was lost"}]]
+                   got))))
+        done)))
+  (testing "a read that fails in the middle of the stream"
+    (async done
+      (tu/finish
+        (tu/steps
+          #(stream! (streaming (atom nil) (sse {:type "TEXT_MESSAGE_CONTENT" :delta "Hi"}) :fail
+                               (sse {:type "TEXT_MESSAGE_CONTENT" :delta "never"}))
+                 2)
+          (fn [got]
+            (is (= [[:event {:type "TEXT_MESSAGE_CONTENT" :delta "Hi"}]
+                    [:event {:type "RUN_ERROR" :message "the connection was lost"}]]
+                   got))))
+        done)))
+  (testing "a stream that ended with an error of its own says so once"
+    (async done
+      (tu/finish
+        (tu/steps
+          #(stream! (streaming (atom nil)
+                               (sse {:type "TEXT_MESSAGE_CONTENT" :delta "Hi"}
+                                    {:type "RUN_ERROR" :message "the LLM server took too long to answer"}))
+                 2)
+          (fn [got]
+            (is (= [[:event {:type "TEXT_MESSAGE_CONTENT" :delta "Hi"}]
+                    [:event {:type "RUN_ERROR" :message "the LLM server took too long to answer"}]]
+                   got))))
+        done))))
+
+(deftest failed-request-test
+  (testing "a status that isn't 2xx: no stream, the response is given as ::fetch gives it"
+    (async done
+      (tu/finish
+        (tu/steps
+          #(stream! (fn [_ _] (js/Promise.resolve #js {:ok false :status 502
+                                                    :text (fn [] (js/Promise.resolve "{:error \"down\"}"))}))
+                 1)
+          (fn [got]
+            (is (= [[:response {:ok? false :status 502 :body "{:error \"down\"}"}]] got))))
+        done)))
+  (testing "a request that fails outright"
+    (async done
+      (tu/finish
+        (tu/steps
+          #(stream! (fn [_ _] (js/Promise.reject (js/Error. "Failed to fetch"))) 1)
+          (fn [got]
+            (is (= [[:response {:ok? false :status nil :body "Failed to fetch"}]] got))))
+        done))))

ui/test/tbd/ui/model_context_test.cljs

@@ -0,0 +1,146 @@
+(ns tbd.ui.model-context-test
+  (:require [cljs.test :refer [deftest is testing async use-fixtures]]
+            [tbd.ui.model-context :as model-context]
+            [tbd.ui.test-util :as tu]))
+
+(use-fixtures :each
+  {:before model-context/clear!
+   :after model-context/clear!})
+
+(def ^:private schema {:type "object" :properties {} :required []})
+
+(defn- tool [tool-name handler & {:as more}]
+  (merge {:name tool-name :description (str tool-name " tool") :input-schema schema :handler handler} more))
+
+(deftest definitions-test
+  (testing "nothing registered, nothing offered"
+    (is (= [] (model-context/definitions :tic-tac-toe))))
+  (testing "what the LLM is told is MCP's tools/list, in the order of registration, without the handlers"
+    (model-context/register! [(tool "b" identity) (tool "a" identity)])
+    (is (= [{:name "b" :description "b tool" :inputSchema schema}
+            {:name "a" :description "a tool" :inputSchema schema}]
+           (model-context/definitions :tic-tac-toe))))
+  (testing "a tool without a description has none"
+    (model-context/clear!)
+    (model-context/register! [(tool "a" identity :description nil)])
+    (is (= [{:name "a" :inputSchema schema}] (model-context/definitions :tic-tac-toe)))))
+
+(deftest register-test
+  (testing "registering a name again replaces the tool, so it is safe on hot reload"
+    (model-context/register! [(tool "a" identity) (tool "b" identity)])
+    (model-context/register! [(tool "a" identity :description "new") (tool "b" identity)])
+    (is (= [["a" "new"] ["b" "b tool"]] (map (juxt :name :description) (model-context/definitions :tic-tac-toe)))))
+  (testing "tools of other names stay"
+    (model-context/register! [(tool "c" identity)])
+    (is (= ["a" "b" "c"] (map :name (model-context/definitions :tic-tac-toe)))))
+  (testing "clear! takes them all"
+    (model-context/clear!)
+    (is (= [] (model-context/definitions :tic-tac-toe)))))
+
+(deftest pages-test
+  (model-context/register! [(tool "everywhere" identity)
+                            (tool "tic-tac-toe-only" identity :pages #{:tic-tac-toe})
+                            (tool "todos-only" identity :pages #{:todos})
+                            (tool "both" identity :pages #{:tic-tac-toe :todos})])
+  (testing "a tool without pages is offered on every page, the others only on theirs"
+    (is (= ["everywhere" "tic-tac-toe-only" "both"] (map :name (model-context/definitions :tic-tac-toe))))
+    (is (= ["everywhere" "todos-only" "both"] (map :name (model-context/definitions :todos))))
+    (is (= ["everywhere"] (map :name (model-context/definitions :ai-setup)))))
+  (testing "the pages are not part of what the LLM is told"
+    (is (= #{:name :description :inputSchema} (set (mapcat keys (model-context/definitions :tic-tac-toe))))))
+  (testing "a page that is not known, or none, is offered the tools of no page"
+    (is (= ["everywhere"] (map :name (model-context/definitions nil)))))
+  (testing "registering a tool again replaces its pages too"
+    (model-context/register! [(tool "tic-tac-toe-only" identity :pages #{:todos})])
+    (is (= ["everywhere" "both"] (map :name (model-context/definitions :tic-tac-toe))))))
+
+(defn- called
+  "A promise of the result of calling `tool-name` on the JSON text `arguments`."
+  [tool-name arguments]
+  (model-context/call! :tic-tac-toe tool-name arguments))
+
+(deftest call-test
+  (let [seen (atom nil)]
+    (model-context/register!
+      [(tool "echo" (fn [args] (reset! seen args) (str "got " (pr-str args))))
+       (tool "data" (fn [_] {:a 1 :b [true nil]}))
+       (tool "nothing" (fn [_] nil))
+       (tool "later" (fn [_] (js/Promise.resolve "eventually")))
+       (tool "throws" (fn [_] (throw (js/Error. "boom"))))
+       (tool "rejects" (fn [_] (js/Promise.reject (js/Error. "no luck"))))
+       (tool "rejects-plainly" (fn [_] (js/Promise.reject "just a string")))])
+    (async done
+      (tu/finish
+        (tu/steps
+          #(called "echo" "{\"x\":1,\"name\":\"a b\",\"nested\":{\"y\":[1,2]}}")
+          (fn [r]
+            (testing "the arguments the LLM wrote reach the tool as a map with keyword keys"
+              (is (= {:x 1 :name "a b" :nested {:y [1 2]}} @seen))
+              (is (= {:text "got {:x 1, :name \"a b\", :nested {:y [1 2]}}" :error? false} r))))
+          #(called "echo" "")
+          (fn [r]
+            (testing "no arguments at all is an empty map: that is how a model calls a tool that takes none"
+              (is (= {} @seen))
+              (is (false? (:error? r)))))
+          #(called "echo" "   ")
+          (fn [_] (is (= {} @seen) "blank too"))
+          #(called "echo" "{}")
+          (fn [_] (is (= {} @seen)))
+          #(called "data" "{}")
+          (fn [r]
+            (testing "data becomes JSON"
+              (is (= {:text "{\"a\":1,\"b\":[true,null]}" :error? false} r))))
+          #(called "nothing" "{}")
+          (fn [r] (is (= {:text "ok" :error? false} r) "a tool with nothing to say says ok"))
+          #(called "later" "{}")
+          (fn [r] (is (= {:text "eventually" :error? false} r) "a promise is waited for"))
+          #(called "throws" "{}")
+          (fn [r] (is (= {:text "boom" :error? true} r) "a tool that fails is an error result, not a failure"))
+          #(called "rejects" "{}")
+          (fn [r] (is (= {:text "no luck" :error? true} r)))
+          #(called "rejects-plainly" "{}")
+          (fn [r] (is (= {:text "just a string" :error? true} r))))
+        done))))
+
+(deftest call-pages-test
+  (let [ran (atom [])]
+    (model-context/register! [(tool "tic-tac-toe-only" (fn [_] (swap! ran conj :tic-tac-toe-only) "played") :pages #{:tic-tac-toe})
+                              (tool "everywhere" (fn [_] (swap! ran conj :everywhere) "ran"))])
+    (async done
+      (tu/finish
+        (tu/steps
+          #(model-context/call! :tic-tac-toe "tic-tac-toe-only" "{}")
+          (fn [r] (is (= {:text "played" :error? false} r) "on its page, a tool is called"))
+          #(model-context/call! :todos "everywhere" "{}")
+          (fn [r] (is (= {:text "ran" :error? false} r) "a tool of no page is called on any"))
+          #(model-context/call! :todos "tic-tac-toe-only" "{}")
+          (fn [r]
+            (testing "a tool of another page is refused, and the LLM is told where it is offered"
+              (is (= {:text "tool not available on this page: tic-tac-toe-only (it is offered on the tic-tac-toe page)"
+                      :error? true}
+                     r))))
+          (fn [_] (is (= [:tic-tac-toe-only :everywhere] @ran) "and never run")))
+        done))))
+
+(deftest call-failures-test
+  (let [ran? (atom false)]
+    (model-context/register! [(tool "t" (fn [_] (reset! ran? true) "ran"))])
+    (async done
+      (tu/finish
+        (tu/steps
+          #(called "nope" "{}")
+          (fn [r]
+            (testing "a tool that isn't there: the LLM may have made it up, and reads what it got wrong"
+              (is (= {:text "unknown tool: nope" :error? true} r))))
+          #(called "t" "{not json")
+          (fn [r]
+            (testing "arguments that are no JSON"
+              (is (= {:text "invalid arguments: they must be a JSON object" :error? true} r))))
+          #(called "t" "[1,2]")
+          (fn [r] (is (:error? r) "an array isn't arguments"))
+          #(called "t" "\"text\"")
+          (fn [r] (is (:error? r) "nor is a string"))
+          #(called "t" "null")
+          (fn [r] (is (:error? r) "nor is null"))
+          (fn [_] (is (false? @ran?) "the tool was never called with any of them")))
+        done))))

ui/test/tbd/ui/pages_test.cljs

@@ -0,0 +1,26 @@
+(ns tbd.ui.pages-test
+  (:require [cljs.test :refer [deftest is testing]]
+            [tbd.ui.pages :as pages]))
+
+(deftest page->hash-test
+  (is (= "#/tic-tac-toe" (pages/page->hash :tic-tac-toe)))
+  (is (= "#/ai-setup" (pages/page->hash :ai-setup))))
+
+(deftest hash->page-test
+  (testing "every page has an address that opens it"
+    (doseq [{:keys [id]} pages/pages]
+      (is (= id (pages/hash->page (pages/page->hash id))))))
+  (testing "with or without the #"
+    (is (= :todos (pages/hash->page "#/todos")))
+    (is (= :todos (pages/hash->page "/todos")))
+    (is (= :todos (pages/hash->page "todos"))))
+  (testing "what follows the page's name is ignored"
+    (is (= :todos (pages/hash->page "#/todos/1?a=b"))))
+  (testing "no page, or an unknown one, is the first page"
+    (is (= :tic-tac-toe pages/default-page))
+    (doseq [hash [nil "" "#" "#/" "#/nowhere" "#/Todos"]]
+      (is (= :tic-tac-toe (pages/hash->page hash)) (pr-str hash)))))
+
+(deftest pages-test
+  (is (= [:tic-tac-toe :calculator :todos :ai-setup] (mapv :id pages/pages)) "the order of the tabs")
+  (is (= [:todos] (mapv :id (filter :login? pages/pages)))))

ui/test/tbd/ui/sse_test.cljs

@@ -0,0 +1,31 @@
+(ns tbd.ui.sse-test
+  (:require [cljs.test :refer [deftest is testing]]
+            [tbd.ui.sse :as sse]))
+
+(deftest parse-test
+  (testing "complete events come out as maps, in order"
+    (is (= [[{:content "Hel"} {:content "lo"} {:done true}] ""]
+           (sse/parse "data: {\"content\":\"Hel\"}\n\ndata: {\"content\":\"lo\"}\n\ndata: {\"done\":true}\n\n"))))
+  (testing "an event that hasn't fully arrived is given back, to be put in front of the next piece"
+    (is (= [[{:content "a"}] "data: {\"content\":\"b"]
+           (sse/parse "data: {\"content\":\"a\"}\n\ndata: {\"content\":\"b")))
+    (is (= [[] "data: {\"content\":\"a\"}\n"]
+           (sse/parse "data: {\"content\":\"a\"}\n")) "the blank line that ends it hasn't come")
+    (is (= [[] ""] (sse/parse ""))))
+  (testing "pieces cut anywhere give the same events"
+    (let [text "data: {\"thinking\":\"hm\"}\n\ndata: {\"content\":\"h\\u00e9llo\\n\"}\n\ndata: {\"done\":true}\n\n"
+          expected [{:thinking "hm"} {:content "héllo\n"} {:done true}]]
+      (doseq [cut (range (inc (count text)))]
+        (let [[first-events pending] (sse/parse (subs text 0 cut))
+              [more-events pending] (sse/parse (str pending (subs text cut)))]
+          (is (= expected (into first-events more-events)) (str "cut at " cut))
+          (is (= "" pending))))))
+  (testing "a space after `data:` is optional, and a line break can be CRLF"
+    (is (= [[{:content "a"} {:content "b"}] ""]
+           (sse/parse "data:{\"content\":\"a\"}\r\n\r\ndata: {\"content\":\"b\"}\r\n\r\n"))))
+  (testing "events that carry no data, or no JSON, are skipped"
+    (is (= [[{:content "a"}] ""]
+           (sse/parse ": keep-alive\n\nevent: ping\n\ndata: not json\n\ndata: {\"content\":\"a\"}\n\n"))))
+  (testing "data over several lines is one JSON text"
+    (is (= [[{:content "a"}] ""]
+           (sse/parse "data: {\"content\":\ndata: \"a\"}\n\n")))))

ui/test/tbd/ui/subs_test.cljs

@@ -0,0 +1,58 @@
+(ns tbd.ui.subs-test
+  (:require [cljs.test :refer [deftest is testing use-fixtures]]
+            [re-frame.core :as rf]
+            [re-frame.db :as rf-db]
+            [re-frame.subs :as rf-subs]
+            [tbd.ui.db :as db]
+            [tbd.ui.subs :as subs]
+            [tbd.ui.tictactoe :as ttt]))
+
+(use-fixtures :each
+  {:before #(do (rf/clear-subscription-cache!)
+                (reset! rf-db/app-db db/default-db))})
+
+(defn- sub
+  "The value of a subscription. (Read outside of a component, which re-frame warns about.)"
+  [query]
+  (with-redefs [rf-subs/warn-when-not-reactive (fn [])]
+    @(rf/subscribe query)))
+
+(defn- db! [f & args]
+  (apply swap! rf-db/app-db f args))
+
+(deftest plain-subs-test
+  (testing "a new page"
+    (is (= "" (sub [::subs/operand :x])))
+    (is (= :tic-tac-toe (sub [::subs/page])))
+    (is (= {:status :idle} (sub [::subs/result])))
+    (is (= {:status :unknown} (sub [::subs/user])))
+    (is (= (:todos db/default-db) (sub [::subs/todos])))
+    (is (false? (sub [::subs/mcp-copied?]))))
+  (testing "they follow the db"
+    (db! assoc :page :todos)
+    (db! assoc-in [:calc :x] "4")
+    (db! assoc-in [:calc :result] {:status :ok :x "4" :y "1" :sum 5})
+    (db! assoc :user {:status :logged-in :login "alice"})
+    (db! assoc-in [:todos :items] [{:id "a1" :title "a"}])
+    (db! assoc-in [:mcp :copied?] true)
+    (is (= :todos (sub [::subs/page])))
+    (is (= "4" (sub [::subs/operand :x])))
+    (is (= 5 (:sum (sub [::subs/result]))))
+    (is (= "alice" (:login (sub [::subs/user]))))
+    (is (= [{:id "a1" :title "a"}] (:items (sub [::subs/todos]))))
+    (is (true? (sub [::subs/mcp-copied?])))))
+
+(deftest ttt-game-test
+  (let [set-board! (fn [cells turn] (db! assoc :ttt {:board (mapv {\x :x \o :o} cells) :turn turn}))]
+    (testing "a new game: X to move, nobody has won"
+      (is (= {:board ttt/new-board :turn :x :outcome nil} (sub [::subs/ttt-game]))))
+    (testing "in progress"
+      (set-board! "x...o...." :x)
+      (is (= {:board [:x nil nil nil :o nil nil nil nil] :turn :x :outcome nil}
+             (sub [::subs/ttt-game]))))
+    (testing "a win, with the line"
+      (set-board! "xxxoo...." :o)
+      (is (= {:player :x :line [0 1 2]} (:outcome (sub [::subs/ttt-game])))))
+    (testing "a draw"
+      (set-board! "xoxxoooxx" :o)
+      (is (= :draw (:outcome (sub [::subs/ttt-game])))))))

ui/test/tbd/ui/test_util.cljs

@@ -0,0 +1,316 @@
+(ns tbd.ui.test-util
+  "Shared fakes for the UI tests: the server the page talks to (a stand-in for `fetch`), a way
+  to stub re-frame effects, and helpers to drive the page in jsdom (see dom-setup.cjs)."
+  (:require [cljs.reader :as reader]
+            [cljs.test :as t :refer [is]]
+            [re-frame.registrar :as registrar]
+            [reagent.dom.client :as rdc]))
+
+;; --- Telling dom-setup.cjs how the run is going (it fails a run that gets stuck or ends early) ---
+
+(let [begin (get-method t/report [::t/default :begin-test-var])]
+  (defmethod t/report [::t/default :begin-test-var] [m]
+    (when begin (begin m))
+    (set! (.-uiTestsCurrent js/globalThis)
+          #js {:name (str (:name (meta (:var m)))) :since (js/Date.now)})))
+
+(let [summary (get-method t/report [::t/default :summary])]
+  (defmethod t/report [::t/default :summary] [m]
+    (summary m)
+    (set! (.-uiTestsFinished js/globalThis) true)))
+
+;; --- A fake server ---
+
+(def server
+  "What the fake server holds: {:user nil-or-{:login ..}, :todos [..], :next-id n, :add-error msg,
+  :chat-error msg, :chats [the conversations it was sent], :chat-requests [the whole requests],
+  :chat-scripts [..], :chat-script [..], :resume fn}. Its LLM says \"echo: \" and the last message,
+  streaming it in pieces. `:chat-script`, if set, is what it streams instead: events (maps, as the
+  real server sends them) and :pause, where the stream stops until the test calls the `:resume` fn
+  the server then holds. `:chat-scripts` are scripts for the next requests, one each, first
+  come first served (a conversation that goes back and forth, as when the LLM uses tools)."
+  (atom nil))
+
+(defn todo-uuid
+  "The id the fake server gives its `n`th todo: a UUID, as the real server's are, but one a test
+  can write down."
+  [n]
+  (str "00000000-0000-4000-8000-" (.padStart (str n) 12 "0")))
+
+(defn- respond [status body]
+  {:status status :body (pr-str body)})
+
+(defn- respond-stream
+  "A 200 whose body is the server-sent events of `script` (events and :pause)."
+  [script]
+  {:status 200 :script script})
+
+(defn- next-chat-script!
+  "The next of the server's `:chat-scripts`, which it is then rid of, or nil."
+  []
+  (when-let [script (first (:chat-scripts @server))]
+    (swap! server update :chat-scripts subvec 1)
+    script))
+
+(defn- route [method uri body]
+  (let [{:keys [user todos]} @server
+        todo-id (some->> (re-find #"^/api/todos/([0-9a-f-]{36})$" uri) second)]
+    (cond
+      (= "/auth/me" uri) (if user (respond 200 user) (respond 401 {:error "not logged in"}))
+      (and (= "POST" method) (= "/auth/logout" uri)) (do (swap! server assoc :user nil)
+                                                        (respond 200 {:logged-out true}))
+      (and (= "GET" method) (re-find #"^/api/add\?" uri))
+      (let [[_ x y] (re-find #"x=([^&]*)&y=([^&]*)" uri)]
+        (if-let [error (:add-error @server)]
+          (respond 400 {:error error :details {:x ["is wrong"]}})
+          (respond 200 {:result (+ (js/parseFloat x) (js/parseFloat y))})))
+      (not user) (respond 401 {:error "not logged in"})
+      (and (= "POST" method) (= "/api/chat" uri))
+      (if-let [error (:chat-error @server)]
+        (respond 502 {:error error})
+        (do (swap! server update :chats (fnil conj []) (:messages body))
+            (swap! server update :chat-requests (fnil conj []) body)
+            (respond-stream (or (next-chat-script!)
+                                (:chat-script @server)
+                                [{:thinking "Reading the message."}
+                                 {:content "echo: "}
+                                 {:content (:content (last (:messages body)))}
+                                 {:done true}]))))
+      (and (= "GET" method) (= "/api/todos" uri)) (respond 200 {:todos todos})
+      (and (= "POST" method) (= "/api/todos" uri))
+      (if (seq (.trim (:title body)))
+        (let [todo {:id (todo-uuid (:next-id @server)) :owner-id 7 :title (:title body) :done false
+                    :created-at 1 :updated-at 1}]
+          (swap! server #(-> % (update :todos conj todo) (update :next-id inc)))
+          (respond 201 todo))
+        (respond 400 {:error "Invalid body" :details {:title ["must not be blank"]}}))
+      (and (= "PATCH" method) todo-id)
+      (if-let [todo (first (filter #(= todo-id (:id %)) todos))]
+        (let [changed (merge todo body)]
+          (swap! server update :todos (fn [ts] (mapv #(if (= todo-id (:id %)) changed %) ts)))
+          (respond 200 changed))
+        (respond 404 {:error "todo not found"}))
+      (and (= "DELETE" method) todo-id)
+      (do (swap! server update :todos (fn [ts] (filterv #(not= todo-id (:id %)) ts)))
+          (respond 200 {:deleted true}))
+      :else (respond 404 {:error "not found"}))))
+
+(def ^:private piece-size
+  "How many bytes of a stream the fake server delivers at a time: few, so events are cut anywhere,
+  even in the middle of a character, as the network may."
+  7)
+
+(defn- text? [x] (and (string? x) (seq x)))
+
+(defn- tool-call-events [{:keys [id name arguments]}]
+  [{:type "TOOL_CALL_START" :toolCallId id :toolCallName name}
+   {:type "TOOL_CALL_ARGS" :toolCallId id :delta arguments}
+   {:type "TOOL_CALL_END" :toolCallId id}])
+
+(defn- old->agui
+  "A script step, in the old shape tests write ({:thinking}/{:content}/{:tool-calls}/{:done}/
+  {:error}) as the AG-UI events (see tbd.chat.routes) it now corresponds to."
+  [{:keys [thinking content tool-calls done error]}]
+  (cond-> []
+    (text? thinking) (conj {:type "REASONING_MESSAGE_CONTENT" :delta thinking})
+    (text? content) (conj {:type "TEXT_MESSAGE_CONTENT" :delta content})
+    tool-calls (into (mapcat tool-call-events) tool-calls)
+    done (conj {:type "RUN_FINISHED"})
+    error (conj {:type "RUN_ERROR" :message error})))
+
+(defn- script-items
+  "The script's events (in the old shape a test writes; see old->agui) as the pieces of bytes that
+  arrive, and :pause where the stream waits."
+  [script]
+  (mapcat (fn [step]
+            (if (= :pause step)
+              [:pause]
+              (mapcat (fn [event]
+                        (let [bytes (.encode (js/TextEncoder.)
+                                             (str "data: " (js/JSON.stringify (clj->js event)) "\n\n"))]
+                          (for [i (range 0 (.-length bytes) piece-size)]
+                            (.subarray bytes i (min (.-length bytes) (+ i piece-size))))))
+                      (old->agui step))))
+          script))
+
+(defn- stream-reader
+  "What `response.body.getReader()` gives for a stream of `script`: `read` resolves with a piece
+  of bytes at a time, then with done. At a :pause it waits for the fn the server holds as :resume."
+  [script]
+  (let [items (atom (script-items script))]
+    (letfn [(read []
+              (let [item (first @items)]
+                (swap! items rest)
+                (cond
+                  (nil? item) (js/Promise.resolve #js {:done true})
+                  (= :pause item) (js/Promise. (fn [resolve]
+                                                 (swap! server assoc :resume #(resolve (read)))))
+                  :else (js/Promise.resolve #js {:done false :value item}))))]
+      #js {:read read})))
+
+(defn fake-fetch [uri opts]
+  (let [opts (js->clj opts :keywordize-keys true)
+        {:keys [status body script]} (route (:method opts) uri (some-> (:body opts) reader/read-string))]
+    (js/Promise.resolve
+      #js {:ok (< status 300) :status status
+           :text (fn [] (js/Promise.resolve body))
+           :body #js {:getReader (fn [] (stream-reader script))}})))
+
+(def ^:private real-fetch (.-fetch js/globalThis))
+
+(def fake-server-fixture
+  "Each test starts with an empty server, nobody logged in, and `fetch` talking to it."
+  {:before (fn []
+             (reset! server {:user nil :todos [] :next-id 1})
+             (aset js/globalThis "fetch" fake-fetch))
+   :after (fn []
+            (aset js/globalThis "fetch" real-fetch))})
+
+(def url-fixture
+  "Each test starts on the page's own address, with no fragment (the page shown is the first)."
+  (let [reset-hash! #(set! js/location.hash "")]
+    {:before reset-hash!
+     :after reset-hash!}))
+
+(defn log-in! [] (swap! server assoc :user {:login "alice" :id 7}))
+
+;; --- Stubbing re-frame effects ---
+
+(defn- set-effect!
+  "Installs `handler` for effect `id`. (Not reg-fx: that warns about every overwrite.)"
+  [id handler]
+  (swap! registrar/kind->id->handler assoc-in [:fx id] handler))
+
+(def ^:private real-effects
+  "The effect handlers as the app registered them, before any test stubbed one."
+  (atom {}))
+
+(defn real-effect
+  "The app's own handler for effect `id`, even while a test has it stubbed."
+  [id]
+  (or (get @real-effects id)
+      (let [handler (registrar/get-handler :fx id)]
+        (swap! real-effects assoc id handler)
+        handler)))
+
+(defn stub-effects-fixture
+  "A fixture that replaces re-frame effects for the length of a test. `stubs` is a map of effect
+  id to a function of the effect's value, which is called instead of the real handler."
+  [stubs]
+  {:before (fn []
+             (doseq [[id handler] stubs]
+               (real-effect id)
+               (set-effect! id handler)))
+   :after (fn []
+            (doseq [id (keys stubs)]
+              (set-effect! id (real-effect id))))})
+
+;; --- Driving the page ---
+
+(defn- poll
+  "A promise of {:ok? bool :value v}: `(f)` as soon as it is truthy, or its last value after about
+  a second. The page updates asynchronously (re-frame queues events, React renders in the
+  background), so tests wait for what they expect to show up rather than for a fixed time."
+  [f]
+  (js/Promise.
+    (fn [resolve]
+      (let [start (js/Date.now)
+            check (fn check []
+                    (let [v (f)]
+                      (cond
+                        v (resolve {:ok? true :value v})
+                        (> (- (js/Date.now) start) 1000) (resolve {:ok? false :value v})
+                        :else (js/setTimeout check 2))))]
+        (check)))))
+
+(defn eventually
+  "A promise of `(f)`, once it is truthy. If it isn't within about a second the test fails (with
+  the place that waited), so a wait that can't succeed doesn't pass unnoticed."
+  [f]
+  (let [waited-at (js/Error. "timed out waiting for the page")]
+    (-> (poll f)
+        (.then (fn [{:keys [ok? value]}]
+                 (when-not ok?
+                   (t/do-report {:type :fail :message "timed out waiting for the page"
+                                 :expected "the condition to become true"
+                                 :actual (str "still " (pr-str value) "\n" (.-stack waited-at))}))
+                 value)))))
+
+(defn q
+  "The first element of the page matching CSS `selector`, or nil."
+  [selector]
+  (.querySelector js/document selector))
+
+(defn q-all [selector]
+  (vec (.querySelectorAll js/document selector)))
+
+(defn text
+  "The text of the first element matching `selector`, or nil when there is none."
+  [selector]
+  (some-> (q selector) .-textContent))
+
+(defn shows
+  "A promise that checks that the text of `selector` becomes `expected` (`what` says what it is)."
+  [what selector expected]
+  (-> (poll #(= expected (text selector)))
+      (.then (fn [_] (is (= expected (text selector)) what)))))
+
+(defn by-label
+  "The element whose aria-label is `label`."
+  [label]
+  (q (str "[aria-label=\"" label "\"]")))
+
+(defn click! [el]
+  (.click ^js el))
+
+(defn type!
+  "Types `value` into an input: sets it the way the browser does and fires `input`, which is
+  what React's onChange listens to."
+  [el value]
+  ;; window.Event, not the global one: under Node that is Node's own, which jsdom rejects.
+  (let [setter (.-set (js/Object.getOwnPropertyDescriptor js/HTMLInputElement.prototype "value"))]
+    (.call setter el value)
+    (.dispatchEvent el (js/window.Event. "input" #js {:bubbles true}))))
+
+(defn submit!
+  "Submits the form `el` (an event, not requestSubmit, so it doesn't matter what the browser
+  would validate)."
+  [el]
+  (.dispatchEvent el (js/window.Event. "submit" #js {:bubbles true :cancelable true})))
+
+(defonce ^:private root (atom nil))
+
+(defn mount!
+  "Renders `component` (hiccup) into a fresh #app, as core/init does, and returns a promise."
+  [component]
+  (let [container (.getElementById js/document "app")]
+    (reset! root (rdc/create-root container))
+    (rdc/render @root component)
+    (js/Promise.resolve)))
+
+(defn unmount!
+  "Removes what `mount!` rendered."
+  []
+  (when-let [r @root]
+    (rdc/unmount r)
+    (reset! root nil)))
+
+(defn steps
+  "Runs `fs` one after the other, as a promise: each is called with the result of the previous
+  one, which may be a promise, and the promise resolves to the result of the last."
+  [& fs]
+  (reduce (fn [p f] (.then p f)) (js/Promise.resolve) fs))
+
+(defn finish
+  "Ends an `async` test when the promise `p` settles; a rejection fails the test."
+  [p done]
+  (-> p
+      (.then (fn [_] (done)))
+      (.catch (fn [e]
+                (t/do-report {:type :error :message "Uncaught exception, not in assertion."
+                              :expected nil :actual e})
+                (done)))))
+
+(def page-fixture
+  "Leaves the page empty after each test."
+  {:after unmount!})

ui/test/tbd/ui/tictactoe_test.cljs

@@ -0,0 +1,72 @@
+(ns tbd.ui.tictactoe-test
+  (:require [cljs.test :refer [deftest is testing]]
+            [re-frame.core :as rf]
+            [re-frame.db :as rf-db]
+            [tbd.ui.events :as events]
+            [tbd.ui.tictactoe :as ttt]))
+
+(defn- board
+  "A board from a string of 9 characters: x, o or anything else for an empty cell."
+  [s]
+  (mapv {\x :x \o :o} s))
+
+(deftest winner-test
+  (testing "every row, column and diagonal"
+    (doseq [line [[0 1 2] [3 4 5] [6 7 8] [0 3 6] [1 4 7] [2 5 8] [0 4 8] [2 4 6]]
+            player [:x :o]]
+      (let [b (reduce #(assoc %1 %2 player) ttt/new-board line)]
+        (is (= {:player player :line line} (ttt/winner b))))))
+  (testing "no winner"
+    (is (nil? (ttt/winner ttt/new-board)))
+    (is (nil? (ttt/winner (board "xo.ox.xo."))))
+    (is (nil? (ttt/winner (board "xxo.oxxox"))))))
+
+(deftest draw-test
+  (is (ttt/draw? (board "xoxxoooxx")))
+  (is (not (ttt/draw? (board "xxxooxoxo"))) "a full board with a winner is not a draw")
+  (is (not (ttt/draw? (board "xoxxooox.")))))
+
+(deftest outcome-test
+  (is (nil? (ttt/outcome ttt/new-board)))
+  (is (= :draw (ttt/outcome (board "xoxxoooxx"))))
+  (is (= {:player :o :line [0 4 8]} (ttt/outcome (board "oxxxoxxxo")))))
+
+(deftest move-test
+  (is (= :x (get (ttt/move ttt/new-board :x 4) 4)))
+  (is (nil? (ttt/move (board "x........") :o 0)) "taken cell")
+  (is (nil? (ttt/move ttt/new-board :x 9)) "off the board")
+  (is (nil? (ttt/move ttt/new-board :x -1)) "off the board")
+  (is (nil? (ttt/move (board "xxxoo....") :o 8)) "game already won"))
+
+(defn- move! [& cells]
+  (doseq [i cells] (rf/dispatch-sync [::events/ttt-move i])))
+
+(deftest game-flow-test
+  (rf/dispatch-sync [::events/initialize])
+  (let [game #(let [{:keys [board turn]} (:ttt @rf-db/app-db)]
+                {:board board :turn turn :outcome (ttt/outcome board)})]
+    (testing "a new game"
+      (is (= :x (:turn (game))))
+      (is (nil? (:outcome (game)))))
+    (testing "players alternate"
+      (move! 0)
+      (is (= :o (:turn (game))))
+      (move! 3)
+      (is (= [:x nil nil :o] (subvec (:board (game)) 0 4))))
+    (testing "a taken cell is ignored and doesn't pass the turn"
+      (move! 0)
+      (is (= :x (:turn (game))))
+      (is (= :o (get (:board (game)) 3))))
+    (testing "X wins on the top row; the game then ignores moves"
+      (move! 1 4 2)
+      (is (= {:player :x :line [0 1 2]} (:outcome (game))))
+      (let [before (:board (game))]
+        (move! 8)
+        (is (= before (:board (game))))))
+    (testing "new game"
+      (rf/dispatch-sync [::events/ttt-reset])
+      (is (= ttt/new-board (:board (game))))
+      (is (= :x (:turn (game)))))
+    (testing "a draw"
+      (move! 0 1 2 4 3 5 7 6 8)
+      (is (= :draw (:outcome (game)))))))