add webmcp

.env-template

@@ -36,6 +36,14 @@ ADMIN_USERS=
 # has to be approved again after a restart. BASE_URL (above) must be the address MCP clients use.
 # OAUTH_DB_PATH=data/oauth.db
 
+# --- 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

README.md

@@ -125,6 +125,8 @@ it (plumcp only checks that required ones are present). A tool that touches a us
 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+.
@@ -218,6 +220,37 @@ directory at `/js`, and serves `resources/public/index.html`, the shell that mou
 
 The Docker image builds the UI in its own stage, so `docker build` needs no local Node.
 
+### 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. 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 |
+| `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`, `get_todo` | The todos the page shows (login required, like the todo list itself) |
+| `create_todo` | Types a `title` into the new-todo field, presses Add, returns the new todo |
+| `set_todo_done` | Ticks or unticks a todo's checkbox (`id`, `done`) |
+| `delete_todo` | Presses a todo's Delete button |
+
+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.
+
+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
@@ -232,6 +265,7 @@ 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 (needs Node and a JDK; CI doesn't run it yet) |
 | `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/docker-unit-test` | Same as `script/unit-test`, but inside the app image (Docker only) |
@@ -265,7 +299,7 @@ src/tbd/
   oauth/              tbd as the OAuth authorization server for MCP clients: rules (core), SQLite storage (db), `/oauth` + discovery routes, and the bearer-token middleware guarding `/mcp` (middleware)
   nrepl/              On-demand nREPL server (core) and the admin-only `/nrepl` routes
   todo/               Per-user todos: pure rules (core), Malli schemas of the input (schema), SQLite storage (db), `/api/todos` routes
-ui/                   ClojureScript re-frame app (shadow-cljs project); ui/src/tbd/ui/{db,events,subs,views,core}.cljs
+ui/                   ClojureScript re-frame app (shadow-cljs project); ui/src/tbd/ui/{db,events,subs,views,webmcp,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

script/ui-test

@@ -0,0 +1,7 @@
+#!/usr/bin/env bash
+# Run the UI's (ClojureScript) tests under Node. Needs Node and a JDK, like script/ui-build.
+set -euo pipefail
+cd "$(dirname "$0")/../ui"
+
+[[ -d node_modules ]] || npm ci
+exec npx shadow-cljs compile test

src/tbd/core.clj

@@ -1,5 +1,6 @@
 (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]
@@ -45,10 +46,14 @@
                      :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."
+  "The HTML shell for the re-frame UI (ui/); it loads the compiled JS from /js. With a WebMCP
-  [_req]
+  origin-trial token it also sends it as an `Origin-Trial` header, which is how Chrome enables the
-  (-> (response/resource-response "public/index.html")
+  trial for this origin before any script runs."
-      (response/content-type "text/html; charset=utf-8")))
+  [{: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."
@@ -63,7 +68,7 @@
 
 ;; Each logical group (health, users, orders, ...) owns a `tbd.<group>.routes`
 ;; namespace that returns its own route subtree; they're concatenated here.
-(defn make-router [{:keys [auth nrepl todo oauth]}]
+(defn make-router [{:keys [auth nrepl todo oauth webmcp]}]
   (let [oauth-ds (delay (oauth-db/open (:db-path oauth)))
         ;; Opened (and migrated) on first use, not when the app loads.
         todo-ds (delay (todo-db/open (:db-path todo)))]
@@ -75,7 +80,7 @@
                :swagger {:info {:title "tbd API" :version "1.0.0"}}
                :handler (swagger-handler)}}]
        ["/" {:get {:no-doc true
-                   :handler index-handler}}]
+                   :handler (index-handler webmcp)}}]
        (health/routes)
        (math/routes)
        (mcp-routes/routes auth oauth-ds todo-ds)
@@ -116,7 +121,8 @@
   {:auth (auth/env-config)
    :nrepl (nrepl/env-config)
    :todo (todo-db/env-config)
-   :oauth (oauth-db/env-config)})
+   :oauth (oauth-db/env-config)
+   :webmcp {:origin-trial-token (some-> (System/getenv "WEBMCP_ORIGIN_TRIAL_TOKEN") str/trim not-empty)}})
 
 (def app (make-app config))
 

test/tbd/core_test.clj

@@ -22,6 +22,16 @@
   (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.

ui/package.json

@@ -8,6 +8,7 @@
     "release": "shadow-cljs release app"
   },
   "dependencies": {
+    "@jason.today/webmcp": "0.1.13",
     "react": "^19.3.0",
     "react-dom": "^19.3.0"
   },

ui/shadow-cljs.edn

@@ -1,6 +1,6 @@
 ;; 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`).
-{:source-paths ["src"]
+{:source-paths ["src" "test"]
 
  :dependencies
  [[reagent "2.0.1"]
@@ -11,4 +11,10 @@
         :output-dir "../resources/public/js"
         :asset-path "/js"
         :modules {:main {:init-fn tbd.ui.core/init}}
-        :devtools {:after-load tbd.ui.core/reload}}}}
+        :devtools {:after-load tbd.ui.core/reload}}
+
+  ;; script/ui-test: the tests run under Node, against fakes of fetch and navigator.modelContext.
+  :test {:target :node-test
+         :output-to "target/ui-test/test.js"
+         :ns-regexp "-test$"
+         :autorun true}}}

ui/src/tbd/ui/core.cljs

@@ -2,7 +2,8 @@
   (:require [re-frame.core :as rf]
             [reagent.dom.client :as rdc]
             [tbd.ui.events :as events]
-            [tbd.ui.views :as views]))
+            [tbd.ui.views :as views]
+            [tbd.ui.webmcp :as webmcp]))
 
 (defonce root (atom nil))
 
@@ -13,9 +14,11 @@
   "Called by shadow-cljs after each hot reload."
   []
   (rf/clear-subscription-cache!)
+  (webmcp/register!)
   (render))
 
 (defn init []
   (rf/dispatch-sync [::events/initialize])
   (reset! root (rdc/create-root (js/document.getElementById "app")))
+  (webmcp/register!)
   (render))

ui/src/tbd/ui/views.cljs

@@ -1,7 +1,8 @@
 (ns tbd.ui.views
   (:require [re-frame.core :as rf]
             [tbd.ui.events :as events]
-            [tbd.ui.subs :as subs]))
+            [tbd.ui.subs :as subs]
+            [tbd.ui.webmcp :as webmcp]))
 
 (defn- operand-input [k label]
   [:label label " "
@@ -74,13 +75,20 @@
   []
   (str "claude mcp add --transport http tbd " js/location.origin "/mcp"))
 
+(defn- collapsible
+  "A section the reader can fold away by its heading (a native <details>, open to start with)."
+  [title & body]
+  (into [:details {:open true :style {:margin-top "2rem"}}
+         [:summary {:style {:cursor "pointer"}}
+          [:h2 {:style {:display "inline"}} title]]]
+        body))
+
 (defn mcp-setup
   "How to add this server to Claude Code: a command to copy, then signing in once."
   []
   (let [command (mcp-command)
         copied? @(rf/subscribe [::subs/mcp-copied?])]
-    [:section {:style {:margin-top "2rem"}}
+    [collapsible "Add this MCP server to Claude Code"
-     [: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"
@@ -97,6 +105,22 @@
        ". 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."
+  []
+  [collapsible "Browser tools (WebMCP)"
+   [:p "This page offers " [:strong (count webmcp/tools)] " tools of its own (the calculator and the todos) 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"
@@ -122,6 +146,7 @@
      (when (= :logged-in (:status user))
        [todos])
      [mcp-setup]
+     [browser-tools]
      [:p [:a {:href "/api-docs"} "API docs"] " · " [:a {:href "/swagger.json"} "swagger.json"]
       (when-let [link (auth-link user)]
         [:<> " · " link])]]))

ui/src/tbd/ui/webmcp.cljs

@@ -0,0 +1,273 @@
+(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.
+
+  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]
+            [re-frame.core :as rf]
+            [re-frame.db :as rf-db]
+            [tbd.ui.events :as events]))
+
+;; --- 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- 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-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."
+  []
+  (-> (known-user)
+      (.then (fn [{:keys [status message]}]
+               (case status
+                 :logged-in nil
+                 :anonymous (fail! "not logged in: log in on the page to use the todos")
+                 :error (fail! (str "could not tell who is logged in: " message)))))
+      (.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! "todo not found")))
+
+;; --- Argument checks (the page can't trust that the agent honours the schema) ---
+
+(defn- check-id! [id]
+  (when-not (and (number? id) (js/Number.isInteger id))
+    (fail! "invalid arguments: id must be an integer")))
+
+;; --- The tools ---
+
+(defn- ping [_] "pong")
+
+(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"))
+  (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 [{:keys [id]}]
+  (check-id! id)
+  (-> (logged-in-todos)
+      (.then #(find-todo! % id))))
+
+(defn- create-todo
+  "Types the title into the new-todo field and presses Add."
+  [{:keys [title]}]
+  (when-not (and (string? title) (seq title))
+    (fail! "invalid arguments: title must be a non-empty string"))
+  (-> (logged-in-todos)
+      (.then (fn [_]
+               (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- set-todo-done
+  "Ticks or unticks a todo's checkbox."
+  [{: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]
+               (let [todo (find-todo! items id)]
+                 (if (= done (boolean (:done todo)))
+                   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- delete-todo
+  "Presses a todo's Delete button."
+  [{:keys [id]}]
+  (check-id! id)
+  (-> (logged-in-todos)
+      (.then (fn [items]
+               (find-todo! items id)
+               (change-todos [::events/delete-todo id]
+                             #(nil? (find-todo (get-in % [:todos :items]) id))
+                             "the todo to go")))
+      (.then (fn [_] "deleted"))))
+
+(defn- object-schema [properties required]
+  {:type "object" :properties properties :required required})
+
+(def ^:private todo-id {:type "integer" :description "The todo's id"})
+
+(def tools
+  "The tools, as {:name :description :input-schema :handler}."
+  [{:name "ping" :description "Health check: returns pong"
+    :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 "get_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"
+    :description "Types two numbers into the calculator form, presses Add, and returns the sum the page shows (JSON)"
+    :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"
+    :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"
+    :description "Gets one of the todos this page shows, by id (JSON)"
+    :input-schema (object-schema {:id todo-id} ["id"]) :handler get-todo}
+
+   {:name "create_todo"
+    :description "Types a title into the new-todo field, presses Add, and returns the todo that was created (JSON)"
+    :input-schema (object-schema {:title {:type "string" :minLength 1 :maxLength 200
+                                          :description "What needs doing"}}
+                                 ["title"])
+    :handler create-todo}
+
+   {:name "set_todo_done"
+    :description "Ticks or unticks a todo's checkbox and returns the todo (JSON)"
+    :input-schema (object-schema {: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"
+    :description "Presses a todo's Delete button"
+    :input-schema (object-schema {:id todo-id} ["id"])
+    :handler delete-todo}])
+
+;; --- 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- ->text [value]
+  (cond
+    (string? value) value
+    (nil? value) "ok"
+    :else (js/JSON.stringify (clj->js value))))
+
+(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]
+    (-> (js/Promise.resolve)
+        (.then #(handler (js->clj args :keywordize-keys true)))
+        (.then (fn [value] (text-result (->text value) false)))
+        (.catch (fn [e] (text-result (or (some-> e (aget "message")) (str e)) true))))))
+
+(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)
+
+(defonce ^:private widget (atom nil))
+
+(defn register!
+  "Offers `tools` 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 the tools again. Returns the WebMCP instance."
+  []
+  (register-tools! (or @widget (reset! widget (WebMCP.)))))

ui/test/tbd/ui/webmcp_test.cljs

@@ -0,0 +1,230 @@
+(ns tbd.ui.webmcp-test
+  (:require [cljs.reader :as reader]
+            [cljs.test :refer [deftest is testing async use-fixtures]]
+            [re-frame.core :as rf]
+            [re-frame.db :as rf-db]
+            [tbd.ui.events :as events]
+            [tbd.ui.webmcp :as webmcp]))
+
+;; A fake browser: the page's server, and the WebMCP registry the tools end up in.
+
+(def ^:private server
+  "What the fake server holds: {:user nil-or-{:login ..}, :todos [..], :next-id n}."
+  (atom nil))
+
+(defn- respond [status body]
+  {:status status :body (pr-str body)})
+
+(defn- route [method uri body]
+  (let [{:keys [user todos]} @server
+        todo-id (some->> (re-find #"^/api/todos/(\d+)$" uri) second js/parseInt)]
+    (cond
+      (= "/auth/me" uri) (if user (respond 200 user) (respond 401 {:error "not logged in"}))
+      (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 (= "GET" method) (= "/api/todos" uri)) (respond 200 {:todos todos})
+      (and (= "POST" method) (= "/api/todos" uri))
+      (if (seq (.trim (:title body)))
+        (let [todo {:id (: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"}))))
+
+(defn- fake-fetch [uri opts]
+  (let [opts (js->clj opts :keywordize-keys true)
+        {:keys [status body]} (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))})))
+
+(def ^:private registered
+  "What the page registered with WebMCP: name -> {:description :input-schema :execute}."
+  (atom {}))
+
+(def ^:private fake-mcp
+  "A WebMCP instance, as far as the page uses it: registerTool(name, description, schema, execute)."
+  #js {:registerTool (fn [name description input-schema execute]
+                       (swap! registered assoc name {:description description
+                                                     :input-schema input-schema
+                                                     :execute execute}))})
+
+(def ^:private real-fetch (.-fetch js/globalThis))
+
+(use-fixtures :each
+  {:before (fn []
+             (reset! registered {})
+             (reset! server {:user nil :todos [] :next-id 1})
+             (aset js/globalThis "fetch" fake-fetch))
+   :after (fn []
+            (aset js/globalThis "fetch" real-fetch))})
+
+(defn- call
+  "A promise of the result of the tool `tool-name` on `args`, as {:text :error?}."
+  [tool-name args]
+  (-> ((:execute (get @registered tool-name)) (clj->js args))
+      (.then (fn [^js result]
+               {:text (.. result -content (at 0) -text)
+                :error? (true? (.-isError result))}))))
+
+(defn- page-loaded
+  "A promise that is fulfilled once the page has found out who is logged in. A test that ends
+  sooner would leave that answer to arrive in the next test's page."
+  []
+  (call "whoami" {}))
+
+(defn- json [text] (js->clj (js/JSON.parse text) :keywordize-keys true))
+
+(defn- open-page!
+  "Loads the page as core/init does (after the fake server is set up): the app starts up, asking
+  the server who is logged in, and registers its tools."
+  []
+  (rf/dispatch-sync [::events/initialize])
+  (webmcp/register-tools! fake-mcp))
+
+(defn- log-in! [] (swap! server assoc :user {:login "alice" :id 7}))
+
+(deftest registers-the-tools
+  (is (identical? fake-mcp (webmcp/register-tools! fake-mcp)))
+  (is (= (set (map :name webmcp/tools)) (set (keys @registered))))
+  (doseq [[tool-name {:keys [description input-schema execute]}] @registered]
+    (is (and (string? description) (seq description)) tool-name)
+    (is (= "object" (.-type ^js input-schema)) tool-name)
+    (is (object? (.-properties ^js input-schema)) tool-name)
+    (is (fn? execute) tool-name))
+  (testing "what the tools need, as the agent sees it"
+    (is (= ["x" "y"] (vec (.. ^js (:input-schema (get @registered "add")) -required))))
+    (is (= ["id" "done"] (vec (.. ^js (:input-schema (get @registered "set_todo_done")) -required))))))
+
+(deftest registering-again-replaces-the-tools
+  (webmcp/register-tools! fake-mcp)
+  (webmcp/register-tools! fake-mcp)
+  (is (= (count webmcp/tools) (count @registered))))
+
+(deftest ping-and-add
+  (open-page!)
+  (async done
+    (-> (page-loaded)
+        (.then #(call "ping" {}))
+        (.then (fn [r]
+                 (is (= {:text "pong" :error? false} r))
+                 (call "add" {:x 2 :y 3})))
+        (.then (fn [r]
+                 (is (false? (:error? r)))
+                 (is (= {:x 2 :y 3 :sum 5} (json (:text r))))
+                 ;; It filled in the form, as a user would.
+                 (is (= {:x "2" :y "3" :result {:status :ok :x "2" :y "3" :sum 5}}
+                        (:calc @rf-db/app-db)))
+                 (call "get_calculator" {})))
+        (.then (fn [r]
+                 (is (= "2" (:x (json (:text r)))))
+                 (is (= "ok" (:status (:result (json (:text r))))))
+                 (call "add" {:x "two" :y 3})))
+        (.then (fn [r]
+                 (is (:error? r))
+                 (is (re-find #"must be numbers" (:text r)))
+                 (done))))))
+
+(deftest add-shows-the-servers-error
+  (swap! server assoc :add-error "Invalid parameters")
+  (open-page!)
+  (async done
+    (-> (page-loaded)
+        (.then #(call "add" {:x 1 :y 2}))
+        (.then (fn [r]
+                 (is (:error? r))
+                 (is (re-find #"Invalid parameters" (:text r)))
+                 (call "add" {:x js/NaN :y 1})))
+        (.then (fn [r]
+                 (is (:error? r) "not a number, so nothing was sent")
+                 (is (re-find #"must be numbers" (:text r)))
+                 (done))))))
+
+(deftest anonymous-user
+  (open-page!)
+  (async done
+    (-> (call "whoami" {})
+        (.then (fn [r]
+                 (is (= {:text "not logged in" :error? false} r))
+                 (call "list_todos" {})))
+        (.then (fn [r]
+                 (is (:error? r))
+                 (is (re-find #"not logged in" (:text r)))
+                 (call "create_todo" {:title "buy milk"})))
+        (.then (fn [r]
+                 (is (:error? r))
+                 (is (empty? (:todos @server)) "nothing was sent")
+                 (done))))))
+
+(deftest todos
+  (log-in!)
+  (swap! server assoc :todos [{:id 1 :owner-id 7 :title "old" :done false :created-at 1 :updated-at 1}]
+         :next-id 2)
+  (open-page!)
+  (async done
+    (-> (call "whoami" {})
+        (.then (fn [r]
+                 (is (= "logged in as alice" (:text r)))
+                 (call "list_todos" {})))
+        (.then (fn [r]
+                 (is (= ["old"] (map :title (json (:text r)))))
+                 (call "get_todo" {:id 1})))
+        (.then (fn [r]
+                 (is (= "old" (:title (json (:text r)))))
+                 (call "get_todo" {:id 99})))
+        (.then (fn [r]
+                 (is (= {:text "todo not found" :error? true} r))
+                 (call "create_todo" {:title "buy milk"})))
+        (.then (fn [r]
+                 (is (false? (:error? r)))
+                 (is (= {:id 2 :title "buy milk" :done false} (select-keys (json (:text r)) [:id :title :done])))
+                 ;; The page shows it, and the field is empty again.
+                 (is (= ["old" "buy milk"] (map :title (get-in @rf-db/app-db [:todos :items]))))
+                 (is (= "" (get-in @rf-db/app-db [:todos :new-title])))
+                 (call "set_todo_done" {:id 2 :done true})))
+        (.then (fn [r]
+                 (is (true? (:done (json (:text r)))))
+                 (is (true? (:done (last (get-in @rf-db/app-db [:todos :items])))))
+                 ;; Already ticked: nothing to do, and no request.
+                 (swap! server assoc :todos [])
+                 (call "set_todo_done" {:id 2 :done true})))
+        (.then (fn [r]
+                 (is (true? (:done (json (:text r)))))
+                 (call "set_todo_done" {:id 2 :done "yes"})))
+        (.then (fn [r]
+                 (is (:error? r))
+                 (call "delete_todo" {:id 1})))
+        (.then (fn [r]
+                 (is (= {:text "deleted" :error? false} r))
+                 (is (= ["buy milk"] (map :title (get-in @rf-db/app-db [:todos :items]))))
+                 (call "delete_todo" {:id 1})))
+        (.then (fn [r]
+                 (is (= {:text "todo not found" :error? true} r))
+                 (call "get_todo" {:id 1.5})))
+        (.then (fn [r]
+                 (is (:error? r))
+                 (done))))))
+
+(deftest create-todo-shows-the-servers-error
+  (log-in!)
+  (open-page!)
+  (async done
+    (-> (call "create_todo" {:title "   "})
+        (.then (fn [r]
+                 (is (:error? r))
+                 (is (re-find #"Invalid body" (:text r)))
+                 (is (empty? (get-in @rf-db/app-db [:todos :items])))
+                 (done))))))