ajet/tbd
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

migrate to AG-UI state sync
CI / Test + coverage (push) Successful in 1m4s
Details

Browse Source
This commit is contained in:
Adam Jeniski
2026-09-22 06:07:45 -09:00
parent 6569a69463
commit a7f12b5d72
21 changed files with 725 additions and 140 deletions
Download Patch File Download Diff File Expand all files Collapse all files
shared/tbd/agent/prompt.cljc
+12 -6
View File
@@ -48,15 +48,21 @@
"person play theirs.\n"
"\n"))
(def examples
"Shared with tbd.agent.instructions/chat."
(defn examples
"Shared with tbd.agent.instructions/chat. `reads?` is whether looking something up (a todo's id,
the board) takes its own call first (an outside agent's list_todos/get_tic_tac_toe) or is
already in view (the chatbot's state, tbd.chat.schema/RunAgentInput's `state`) — the one place
the two agents' examples differ."
[reads?]
(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"
"\"tick off the milk one\" -> " (when reads? "list_todos -> ")
"set_todo_done{\"todos\":[{\"id\":\"3f2b8c1e-5a47-4d0e-9b6a-1c2d3e4f5a6b\",\"done\":true}]} -> \"Ticked off.\"\n"
"\"untick all my todos\" -> " (when reads? "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.\""))
"\"play tic tac toe, you're O\" -> " (when reads? "get_tic_tac_toe -> ") "it is X's turn -> \"You're up, X starts.\""))
;; --- An MCP client outside the page (Claude, Codex) ---
@@ -85,7 +91,7 @@
"tell them so.\n"
"\n"
tic-tac-toe-rules
examples))
(examples true)))
(defn task
"The prompt that hands an outside agent a job on the page: `guide`, then the user's `request` if
src/tbd/agent/instructions.clj
+15 -11
View File
@@ -7,6 +7,7 @@
genuinely shared (`act`, `work-it-out`, `tic-tac-toe-rules`, `examples`) from tbd.agent.prompt
rather than duplicating it."
(:require [clojure.string :as str]
[jsonista.core :as json]
[tbd.agent.prompt :as prompt]))
(defn chat
@@ -19,8 +20,8 @@
"\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"))
" use it. Never invent an id, a title or the state of the page: it's in \"Current state of the\n"
" page\" below, if there is one, or 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"
@@ -30,20 +31,23 @@
"the tools you have. Think briefly before you act.\n"
"\n"
prompt/tic-tac-toe-rules
prompt/examples))
(prompt/examples false)))
(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]
"`chat`'s prompt, with, last, where the user is (`page`), the names of the `tools` on offer
there, and `state` (see tbd.chat.schema/RunAgentInput) — what the page is showing right now, so
the model is never told to call a tool to read what it already has. 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 state]
(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.")))
". The tools of other pages are offered once you navigate there.")
(seq state) (str "\n\nCurrent state of the page (JSON), already up to date as of this message — "
"never call a tool just to read it, only to act:\n" (json/write-value-as-string state))))
(defn a2a
"The A2A server's system prompt: an outside agent calling this app directly, not through a
@@ -61,4 +65,4 @@
"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))
(prompt/examples true)))
src/tbd/chat/db.clj
+51
View File
@@ -0,0 +1,51 @@
(ns tbd.chat.db
"SQLite persistence for the chat widget's history, in the app's database (see tbd.sqlite). Not
the AG-UI run itself (tbd.chat.routes' /api/chat stays stateless) — this is the browser's own
conversation (tbd.ui.db's :chat :messages), saved so a reload or a new browser can pick it back
up. One row per user: the whole conversation is kept as one EDN blob and replaced wholesale on
each save, the same way the browser already treats it as a single vector, never a diff."
(:require [clojure.edn :as edn]
[next.jdbc :as jdbc]
[next.jdbc.result-set :as rs]
[tbd.sqlite :as sqlite]))
(def ^:private create-chat-history
;; `owner_id` is the user's id in Gitea, like tbd.todo.db's todos.
"CREATE TABLE IF NOT EXISTS chat_history (
owner_id INTEGER PRIMARY KEY,
messages TEXT NOT NULL,
updated_at INTEGER NOT NULL)")
(defn migrate!
"Creates the chat_history table in the database `ds`, or brings it up to date."
[ds]
(jdbc/execute! ds [create-chat-history]))
(defn open
"A database with just the chat_history table, 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})
(defn get-history
"The owner's stored conversation (tbd.chat.schema/HistoryMessage maps), oldest first, or [] if
nothing is stored for them yet."
[ds owner-id]
(if-let [{:keys [messages]} (jdbc/execute-one!
ds ["SELECT messages FROM chat_history WHERE owner_id = ?" owner-id] opts)]
(edn/read-string messages)
[]))
(defn save-history!
"Replaces the owner's stored conversation with `messages`."
[ds owner-id messages now]
(jdbc/execute! ds ["INSERT INTO chat_history (owner_id, messages, updated_at) VALUES (?, ?, ?)
ON CONFLICT (owner_id) DO UPDATE SET messages = excluded.messages, updated_at = excluded.updated_at"
owner-id (pr-str messages) now]))
(defn clear-history!
"Deletes the owner's stored conversation, if any."
[ds owner-id]
(jdbc/execute! ds ["DELETE FROM chat_history WHERE owner_id = ?" owner-id]))
src/tbd/chat/routes.clj
+35 -8
View File
@@ -13,6 +13,7 @@
(:require [muuntaja.core :as m]
[ring.core.protocols :as ring-protocols]
[tbd.agent.core :as agent]
[tbd.chat.db :as chat-db]
[tbd.chat.schema :as schema]
[tbd.http :refer [respond]])
(:import (java.io IOException OutputStream)
@@ -126,13 +127,39 @@
"X-Accel-Buffering" "no"}
:body (event-stream ok thread-id run-id)}))))
(defn- history-handler [ds]
(fn [{:keys [user]}]
(respond 200 {:messages (chat-db/get-history @ds (:id user))})))
(defn- save-history-handler [ds]
(fn [{{{:keys [messages]} :body} :parameters :keys [user]}]
(chat-db/save-history! @ds (:id user) messages (System/currentTimeMillis))
(respond 200 {:saved true})))
(defn- clear-history-handler [ds]
(fn [{:keys [user]}]
(chat-db/clear-history! @ds (:id user))
(respond 200 {:cleared true})))
(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]
"`config` is the agent config (see tbd.agent.core/env-config). `ds` is a delay of the app's
database (see tbd.sqlite/open), for /api/chat/history. Only logged-in users may chat: every
message costs the LLM server's time."
[config ds]
["/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)}}])
{:tags ["chat"]}
[""
{:post {: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)}}]
["/history"
{:login? true}
[""
{:get {:summary "The logged-in user's stored chat history (tbd.chat.schema/HistoryMessage, oldest first); {:messages []} if there is none"
:handler (history-handler ds)}
:put {:summary "Replaces the logged-in user's stored chat history with the given messages — the browser's own full conversation, saved so a reload or another browser can restore it"
:parameters {:body schema/History}
:handler (save-history-handler ds)}
:delete {:summary "Clears the logged-in user's stored chat history (the \"Clear\" button: the next reload starts a new session)"
:handler (clear-history-handler ds)}}]]])
src/tbd/chat/schema.clj
+54 -5
View File
@@ -24,6 +24,14 @@
(defn- small? [tool]
(<= (count (pr-str tool)) max-tool-schema-length))
(def ^:private max-state-length
"How long RunAgentInput's `state` may be, printed: room for a todo list or a game board, not a
free way to put an unbounded payload in every system prompt."
8000)
(defn- small-state? [state]
(<= (count (pr-str state)) max-state-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."
@@ -83,7 +91,10 @@
(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).
for this run (`tools`), ambient information (`context`, which is where `page` travels), and
`state` — what the page is showing right now (its todo list, its tic-tac-toe board, ...), so the
model has it up front instead of spending a tool call to read it (see tbd.ui.model-context's
state registry, which is what fills it on the browser's side).
`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."
@@ -92,7 +103,45 @@
[: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]]])
[:context {:optional true} [:vector {:max 8} Context]]
[:state {:optional true} [:and [:map-of :keyword :any] [:fn small-state?]]]])
(def max-history-messages
"How many messages of a browser's own conversation (see tbd.ui.db's :chat :messages) the
/api/chat/history endpoint stores for it, the most recent (see tbd.ui.events/storable) — more
than max-messages, since this is scrollback for the user, not context for the LLM."
100)
(def HistoryMessage
"A message as the browser's own :chat :messages keeps it (see tbd.ui.db), not AG-UI's wire
Message: /api/chat/history is this app's own addition, not part of the AG-UI run protocol, so it
round-trips the client's fields as-is (kebab-case, and a tool result's :name/:error? for
display, which AG-UI's Message has no place for) instead of forcing them through Message's shape."
[:multi {:dispatch :role}
["user" [:map
[:role [:= "user"]]
[:content [:string {:min 1 :max max-message-length}]]]]
["assistant" [:and
[:map
[:role [:= "assistant"]]
[:content {:optional true} [:string {:max max-message-length}]]
[:tool-calls {:optional true}
[:vector {:max max-tool-calls}
[:map
[:id Id]
[:name [:string {:min 1 :max 200}]]
[:arguments [:string {:max 100000}]]]]]]
[:fn (fn [{:keys [content tool-calls]}] (or (seq content) (seq tool-calls)))]]]
["tool" [:map
[:role [:= "tool"]]
[:tool-call-id Id]
[:name {:optional true} [:string {:max 200}]]
[:content [:string {:min 1 :max max-message-length}]]
[:error? {:optional true} :boolean]]]])
(def History
"The body of a PUT to /api/chat/history: the browser's whole conversation, oldest first."
[:map [:messages [:vector {:max max-history-messages} HistoryMessage]]])
(defn page-of
"The `page` context entry's value, or nil."
@@ -119,6 +168,6 @@
(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))
supply: only `page` (from `context`), `tools` and `state` shape it."
[{:keys [tools context state]}]
(instructions/chat-system-message (page-of context) tools state))
src/tbd/core.clj
+3 -2
View File
@@ -19,6 +19,7 @@
[tbd.auth.core :as auth]
[tbd.auth.middleware :as auth-mw]
[tbd.auth.routes :as auth-routes]
[tbd.chat.db :as chat-db]
[tbd.chat.routes :as chat-routes]
[tbd.health.routes :as health]
[tbd.http :as http]
@@ -74,7 +75,7 @@
;; namespace that returns its own route subtree; they're concatenated here.
(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!))]
(let [ds (delay (sqlite/open (:db-path db) todo-db/migrate! oauth-db/migrate! chat-db/migrate!))]
(ring/router
[["/swagger.json"
;; The spec is JSON, whatever the API default is (Swagger UI can't read EDN).
@@ -90,7 +91,7 @@
(a2a/routes auth ds chat)
(oauth-routes/routes auth ds)
(auth-routes/routes auth)
(chat-routes/routes chat)
(chat-routes/routes chat ds)
(nrepl-routes/routes nrepl)
(todo-routes/routes ds)]
{:data {:muuntaja http/muuntaja
test/tbd/agent/instructions_test.clj
+16 -4
View File
@@ -22,17 +22,29 @@
(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")))
(is (str/includes? text "navigate there, then") "the chatbot's tools follow the page it is on")
(is (str/includes? (flat text) "\"Current state of the page\" below")
"it's told where to find what a read tool used to be for")
(is (not (str/includes? text "list_todos")) "it has no list_todos: the state has that")
(is (not (str/includes? text "get_tic_tac_toe")) "nor get_tic_tac_toe")))
(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 (= (instructions/chat) (instructions/chat-system-message nil nil nil)))
(let [text (instructions/chat-system-message "todos" [{:name "create_todo"} {:name "list_todos"}] nil)]
(is (str/includes? text "on the \"todos\" page"))
(is (str/includes? text "Its tools: create_todo, list_todos"))))
(deftest chat-system-message-adds-state
(is (= (instructions/chat) (instructions/chat-system-message nil nil {})) "empty state adds nothing")
(let [text (instructions/chat-system-message nil nil {:todos [{:title "milk" :done false}]})]
(is (str/includes? text "Current state of the page"))
(is (str/includes? text "never call a tool just to read it"))
(is (str/includes? text "\"title\":\"milk\""))))
(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")))))
(is (not (str/includes? text "under your message")))
(is (str/includes? text "list_todos -> set_todo_done") "it has no state either: it reads first, like WebMCP's guide")))
test/tbd/agent/prompt_test.clj
+14 -1
View File
@@ -1,6 +1,6 @@
(ns tbd.agent.prompt-test
(:require [clojure.string :as str]
[clojure.test :refer [deftest is]]
[clojure.test :refer [deftest is testing]]
[tbd.agent.prompt :as prompt]))
(defn- flat
@@ -28,6 +28,19 @@
(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 examples-differ-by-reads
(testing "an outside agent (no state channel) is shown reading first"
(is (str/includes? (prompt/examples true) "list_todos -> set_todo_done"))
(is (str/includes? (prompt/examples true) "list_todos -> ONE set_todo_done"))
(is (str/includes? (prompt/examples true) "get_tic_tac_toe -> it is X's turn")))
(testing "the chatbot (state already in view) is not, since it has no list_todos or get_tic_tac_toe"
(is (not (str/includes? (prompt/examples false) "list_todos")))
(is (not (str/includes? (prompt/examples false) "get_tic_tac_toe"))))
(testing "the rest is the same either way"
(doseq [text [(prompt/examples true) (prompt/examples false)]]
(is (str/includes? text "create_todo{\"todos\":[{\"title\":\"buy milk\"}]} -> \"Added.\""))
(is (str/includes? text "add{\"x\":19,\"y\":4} -> \"23.\"")))))
(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."))
test/tbd/agent/test_support.clj
+10
View File
@@ -44,6 +44,16 @@
(doseq [p pieces] (.onPartialResponse handler (PartialResponse. ^String p) (PartialResponseContext. h)))
(complete handler (AiMessage/from (apply str pieces)) FinishReason/STOP [10 5])))))
(defn text-model-capturing
"Like text-model, but `(reset! captured req)` with the ChatRequest sent — for a test that checks
what went into the system prompt (tbd.agent.instructions/chat-system-message), tools, or history."
[captured & pieces]
(model-of (fn [req handler]
(reset! captured req)
(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]
test/tbd/chat/db_test.clj
+43
View File
@@ -0,0 +1,43 @@
(ns tbd.chat.db-test
(:require [clojure.java.io :as io]
[clojure.test :refer [deftest is testing]]
[tbd.chat.db :as db]
[tbd.sqlite-test :refer [temp-db-path]]))
(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)
messages [{:role "user" :content "hi"}]]
(db/save-history! (db/open path) 7 messages 1000)
(is (= messages (db/get-history (db/open path) 7))))))
(deftest crud-test
(let [ds (db/open (temp-db-path))]
(testing "nothing stored yet"
(is (= [] (db/get-history ds 7))))
(testing "save and load"
(db/save-history! ds 7 [{:role "user" :content "hi"}] 1000)
(is (= [{:role "user" :content "hi"}] (db/get-history ds 7))))
(testing "saving again replaces the whole conversation"
(db/save-history! ds 7 [{:role "user" :content "hi"}
{:role "assistant" :content "hello"}]
2000)
(is (= [{:role "user" :content "hi"} {:role "assistant" :content "hello"}]
(db/get-history ds 7))))
(testing "clear"
(db/clear-history! ds 7)
(is (= [] (db/get-history ds 7))))))
(deftest owner-scoping-test
(let [ds (db/open (temp-db-path))]
(db/save-history! ds 7 [{:role "user" :content "mine"}] 1000)
(db/save-history! ds 8 [{:role "user" :content "theirs"}] 1000)
(is (= [{:role "user" :content "mine"}] (db/get-history ds 7)))
(is (= [{:role "user" :content "theirs"}] (db/get-history ds 8)))
(db/clear-history! ds 7)
(is (= [] (db/get-history ds 7)))
(is (= [{:role "user" :content "theirs"}] (db/get-history ds 8)) "clearing one owner's history leaves the other's")))
test/tbd/chat/routes_test.clj
+96 -3
View File
@@ -5,8 +5,11 @@
[ring.core.protocols :as ring-protocols]
[tbd.agent.test-support :as ts]
[tbd.auth.routes-test :as t]
[tbd.sqlite-test :as sqlite-test]
[tbd.test-util :as test-util])
(:import (java.io ByteArrayInputStream ByteArrayOutputStream IOException OutputStream)))
(:import (dev.langchain4j.data.message SystemMessage)
(dev.langchain4j.model.chat.request ChatRequest)
(java.io ByteArrayInputStream ByteArrayOutputStream IOException OutputStream)))
(defn- json [data] (slurp (m/encode "application/json" data)))
@@ -37,8 +40,19 @@
(def ^:private hello (json {:messages [{:id "m1" :role "user" :content "hi"}]}))
(defn- app-with [chat]
(t/make-app (t/gitea-stub "alice") :chat chat))
(defn- app-with
([chat] (app-with chat "alice" 7 (sqlite-test/temp-db-path)))
([chat login id db-path]
(t/make-app (t/gitea-stub login id) :chat chat :db {:db-path db-path})))
(defn- request
"`body` is EDN data (or nil), sent (and the response read) as EDN, like the browser does."
[app method uri cookie & [body]]
(test-util/decode-body
(app (cond-> {:request-method method :uri uri
:headers (cond-> {} cookie (assoc "cookie" cookie))}
body (-> (assoc :body (ByteArrayInputStream. (.getBytes ^String (pr-str body))))
(assoc-in [:headers "content-type"] "application/edn"))))))
(deftest anonymous-test
(let [app (app-with (ts/config (ts/text-model "x")))]
@@ -127,6 +141,26 @@
(json {:messages [{:id "m1" :role "user" :content "hi"}]
:context [{:description "page" :value "ai-setup"}]}))))))))
(deftest state-test
(let [req (atom nil)
app (app-with (ts/config (ts/text-model-capturing req "ok")))
cookie (t/login! app)
system-text (fn [] (.text ^SystemMessage (first (.messages ^ChatRequest @req))))]
(testing "the page's state reaches the system prompt, so the model doesn't need a tool to read it"
(post-chat app cookie (json {:messages [{:id "m1" :role "user" :content "hi"}]
:state {:todos [{:title "milk" :done false}]}}))
(is (str/includes? (system-text) "Current state of the page"))
(is (str/includes? (system-text) "\"title\":\"milk\"")))
(testing "no state, nothing added"
(post-chat app cookie hello)
(is (not (str/includes? (system-text) "Current state of the page"))))
(testing "state is optional, and bounded like a tool's schema"
(is (= 200 (:status (post-chat app cookie (json {:messages [{:id "m1" :role "user" :content "hi"}]
:state {:board (vec (repeat 9 nil)) :turn "x"}})))))
(is (= 400 (:status (post-chat app cookie
(json {:messages [{:id "m1" :role "user" :content "hi"}]
:state {:huge (apply str (repeat 8000 "x"))}}))))))))
(deftest invalid-tools-test
(let [app (app-with (ts/config (ts/text-model "x")))
cookie (t/login! app)
@@ -163,6 +197,65 @@
(is (= 200 (:status resp)))
(is (= "RUN_ERROR" (:type (last (events resp))))))))
(def ^:private history "/api/chat/history")
(deftest history-anonymous-test
(let [app (app-with (ts/config (ts/text-model "x")))]
(doseq [[method body] [[:get nil] [:put {:messages []}] [:delete nil]]]
(is (= 401 (:status (request app method history nil body)))))))
(deftest history-lifecycle-test
(let [app (app-with (ts/config (ts/text-model "x")))
cookie (t/login! app)]
(testing "starts empty"
(is (= {:status 200 :body {:messages []}} (select-keys (request app :get history cookie) [:status :body]))))
(testing "save and load"
(let [messages [{:role "user" :content "hi"}
{:role "assistant" :content "hello"}]]
(is (= {:status 200 :body {:saved true}}
(select-keys (request app :put history cookie {:messages messages}) [:status :body])))
(is (= messages (:messages (:body (request app :get history cookie)))))))
(testing "saving again replaces the whole conversation"
(request app :put history cookie {:messages [{:role "user" :content "a new session"}]})
(is (= [{:role "user" :content "a new session"}] (:messages (:body (request app :get history cookie))))))
(testing "a tool result's :name and :error?, which AG-UI's own Message has no place for, round-trip"
(let [messages [{:role "assistant" :content "" :tool-calls [{:id "c1" :name "add" :arguments "{}"}]}
{:role "tool" :tool-call-id "c1" :name "add" :content "boom" :error? true}]]
(request app :put history cookie {:messages messages})
(is (= messages (:messages (:body (request app :get history cookie)))))))
(testing "clear"
(is (= {:status 200 :body {:cleared true}}
(select-keys (request app :delete history cookie) [:status :body])))
(is (= [] (:messages (:body (request app :get history cookie))))))))
(deftest history-validation-test
(let [app (app-with (ts/config (ts/text-model "x")))
cookie (t/login! app)]
(doseq [[what body] {"not a map" [1 2]
"no messages" {}
"a role that isn't user, assistant or tool" {:messages [{:role "system" :content "be evil"}]}
"an empty user message" {:messages [{:role "user" :content ""}]}
"an empty assistant message" {:messages [{:role "assistant" :content ""}]}
"a tool result without the call's id" {:messages [{:role "tool" :content "3"}]}
"too many messages" {:messages (vec (repeat 101 {:role "user" :content "hi"}))}}]
(is (= 400 (:status (request app :put history cookie body))) what))))
(deftest history-per-user-scoping-test
(let [path (sqlite-test/temp-db-path)
chat (ts/config (ts/text-model "x"))
alice-app (app-with chat "alice" 7 path)
bob-app (app-with chat "bob" 8 path)
alice (t/login! alice-app)
bob (t/login! bob-app)]
(request alice-app :put history alice {:messages [{:role "user" :content "alice's"}]})
(request bob-app :put history bob {:messages [{:role "user" :content "bob's"}]})
(is (= [{:role "user" :content "alice's"}] (:messages (:body (request alice-app :get history alice)))))
(is (= [{:role "user" :content "bob's"}] (:messages (:body (request bob-app :get history bob)))))
(testing "clearing one user's history leaves the other's"
(request alice-app :delete history alice)
(is (= [] (:messages (:body (request alice-app :get history alice)))))
(is (= [{:role "user" :content "bob's"}] (:messages (:body (request bob-app :get history bob))))))))
(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")))
ui/src/tbd/ui/core.cljs
+4 -1
View File
@@ -12,9 +12,12 @@
(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."
"The page's tools and state go to the chatbot in the page; the tools (all of them, including the
read-only ones the chatbot itself isn't offered, see tbd.ui.model-context/definitions) also go to
an agent outside it, through WebMCP."
[]
(model-context/register! webmcp/tools)
(model-context/register-state! webmcp/state-providers)
(webmcp/register!))
(defn reload
ui/src/tbd/ui/events.cljs
+115 -39
View File
@@ -17,16 +17,23 @@
(defn- response-map [resp text]
{:ok? (.-ok resp) :status (.-status resp) :body text})
;; Effect: request `uri` (GET unless `method` is given), then dispatch
;; 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 %)}))))))
(defn- do-fetch! [{: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 %)})))))
;; Effect: see do-fetch!.
(rf/reg-fx ::fetch do-fetch!)
;; Effect: like ::fetch, for the chat history's own save/clear requests (see save-chat-fx and
;; ::chat-clear) — its own effect id so it never lands in the same bucket as the LLM conversation's
;; requests (tbd.ui.events-test's `requests`/`last-request` are built on ::fetch/::fetch-stream
;; alone, and would otherwise sometimes see this request instead of the one a test is waiting for).
(rf/reg-fx ::persist-chat do-fetch!)
(def ^:private connection-lost {:type "RUN_ERROR" :message "the connection was lost"})
@@ -172,7 +179,7 @@
(cond
ok? {:db (assoc db :user {:status :logged-in
:login (:login (reader/read-string (:body resp)))})
:dispatch [::load-todos]}
:dispatch-n [[::load-chat-history] [::load-todos]]}
(= 401 status) {:db (assoc db :user {:status :anonymous})}
:else {:db (assoc db :user {:status :error :message (error-message resp)})})))
@@ -331,11 +338,47 @@
:function {:name name :arguments arguments}})
tool-calls))))
(defn- windowed
"The most recent `n` of `messages`, without the results of calls whose asking is cut off: a
result stranded at the front, its call dropped, answers nothing."
[n messages]
(drop-while #(= "tool" (:role %)) (take-last n messages)))
(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)))
(windowed max-sent-messages messages))
(def ^:private max-stored-messages
"How much of the conversation is saved for the \"restore my last session\" feature
(tbd.chat.schema/max-history-messages, which this stays within): more than max-sent-messages,
since this is scrollback for the user to read, not context sent to the LLM."
100)
(defn- storable
"The most recent `max-stored-messages` of `messages`, as /api/chat/history's PUT wants them: the
browser's own internal shape (see tbd.ui.db), not AG-UI's wire Message — that endpoint is this
app's own addition, not part of an AG-UI run, so nothing is lost translating to and from it."
[messages]
(windowed max-stored-messages messages))
;; Effect: best-effort save of the conversation so far, for /api/chat/history to hand back on the
;; next login. Never blocks anything: on failure the next natural save point (the next message
;; sent, or the turn after) tries again with the conversation as it is by then.
(defn- save-chat-fx [db]
{:uri "/api/chat/history" :method "PUT"
:body {:messages (storable (get-in db [:chat :messages]))}
:on-response [::save-chat-history-response]})
(rf/reg-event-db
::save-chat-history-response
(fn [db [_ {:keys [status]}]]
;; A 401 means the session expired since the save was sent; anything else is a transient
;; failure the next save point papers over, so there is nothing to do for it.
(if (= 401 status)
(-> db (assoc :user {:status :anonymous}) reset-chat)
db)))
(def ^:private stale-result
"What the LLM is sent in place of a result from before the user's last message."
@@ -363,19 +406,38 @@
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.
;; shown (as a `context` entry, for the LLM to know where the user is), the tools that page offers
;; the LLM, and its current state (`state`, see tbd.ui.model-context/current-state and
;; tbd.chat.schema/RunAgentInput) — what a read-only tool would have told it, so it never has to
;; spend a call finding out. All three 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))]
(let [tools (model-context/definitions (:page db))
state (model-context/current-state (: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)))
(seq tools) (assoc :tools (mapv wire-tool tools))
(seq state) (assoc :state state))
:on-event [::chat-event]
:on-response [::chat-response]}))
;; Restoring the last session: fetched once, right after login (see ::user-response), and merged
;; in only if nothing has been said in this page load yet — a slow response landing after the user
;; already started a fresh conversation would otherwise stomp on it.
(rf/reg-event-fx
::load-chat-history
(fn [_ _]
{::fetch {:uri "/api/chat/history" :on-response [::chat-history-response]}}))
(rf/reg-event-db
::chat-history-response
(fn [db [_ {:keys [ok? body]}]]
(if (and ok? (empty? (get-in db [:chat :messages])))
(assoc-in db [:chat :messages] (:messages (reader/read-string body)))
db)))
(rf/reg-event-db
::chat-toggle
(fn [db _]
@@ -406,10 +468,12 @@
(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)})))))
(let [messages (conj messages {:role "user" :content content})
db (update db :chat assoc :messages messages :input "" :status :loading :error nil
:tool-calls-used 0)]
{:db db
::fetch-stream (chat-request db messages)
::persist-chat (save-chat-fx db)})))))
(defn- only-reasoning?
"Whether `message` is a reply that has come to nothing but the reasoning for it: there is nothing
@@ -436,13 +500,14 @@
;; 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
(rf/reg-event-fx
::chat-response
(fn [db [_ {:keys [status] :as resp}]]
(fn [{:keys [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)))))
(not= :loading (get-in db [:chat :status])) {:db db}
(= 401 status) {:db (-> db (assoc :user {:status :anonymous}) reset-chat)}
:else (let [db (chat-failed db (error-message resp))]
{:db db ::persist-chat (save-chat-fx db)}))))
(defn- append-to-reply
"The conversation's assistant message being written, with `text` added to its content. The first
@@ -478,18 +543,20 @@
db (update db :chat assoc :pending-calls nil :thinking-at nil)]
(cond
(empty? pending-calls)
{:db (assoc-in db [:chat :status] :idle)}
(let [db (assoc-in db [:chat :status] :idle)]
{:db db ::persist-chat (save-chat-fx db)})
(> 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."))}
(let [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."))]
{:db db ::persist-chat (save-chat-fx db)})
:else
{:db (-> db
@@ -535,7 +602,8 @@
(= "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))}
(= "RUN_ERROR" type) (let [db (chat-failed db (:message event))]
{:db db ::persist-chat (save-chat-fx db)})
:else {:db db}))))
(defn- call-all
@@ -580,13 +648,21 @@
{: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
;; Starts a new session: not while a reply is on its way (it would land in the new one), and the
;; stored history goes with it, so a reload doesn't bring the old conversation back.
(rf/reg-event-fx
::chat-clear
(fn [db _]
(fn [{:keys [db]} _]
(if (= :loading (get-in db [:chat :status]))
db
(reset-chat db))))
{:db db}
{:db (reset-chat db)
::persist-chat {:uri "/api/chat/history" :method "DELETE" :on-response [::clear-chat-history-response]}})))
(rf/reg-event-db
::clear-chat-history-response
;; Best-effort: a failure here just means the old session may come back on the next reload,
;; which the next successful save (or clear) fixes.
(fn [db _] db))
;; --- MCP setup page ---
ui/src/tbd/ui/model_context.cljs
+34 -4
View File
@@ -17,10 +17,18 @@
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."
can neither be listed nor called.
Besides tools, the page registers state providers: {:pages :provide}, `provide` a plain function
of no arguments returning the page's current state as a map (`pages` means the same as a tool's).
tbd.ui.events attaches `(current-state page)` to every /api/chat request (see
tbd.chat.schema/RunAgentInput's `state`), so the model has what the page shows already, without
spending a tool call to read it — tbd.ui.webmcp's `state-providers` is where these live, since
they need `db`, and it already requires this ns for the tools."
(:require [clojure.string :as str]))
(defonce ^:private registry (atom []))
(defonce ^:private state-registry (atom []))
(defn register!
"Adds `tools` to what the page offers. A tool with the name of one already there replaces it
@@ -31,27 +39,49 @@
nil))
(defn clear!
"Takes every tool away: for a test to start from a page that offers none."
"Takes every tool and state provider away: for a test to start from a page that offers none."
[]
(reset! registry [])
(reset! state-registry [])
nil)
(defn- offered?
"Whether `tool` is offered on `page`."
"Whether `entry` (a tool or a state provider) 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."
[{:name :description :inputSchema}], in the order they were registered. A `:read-only?` tool
(one that only reads what `current-state` already covers, like list_todos) is left out: the
chatbot is handed the state instead of a call to read it, but the tool stays registered for
WebMCP, whose outside agents have no state channel to fall back on."
[page]
(into []
(comp (filter #(offered? page %))
(remove :read-only?)
(map (fn [{:keys [name description input-schema]}]
(cond-> {:name name :inputSchema input-schema}
description (assoc :description description)))))
@registry))
(defn register-state!
"Replaces what the page offers as state with `providers` ({:pages :provide}, see this ns's
docstring). Unlike `register!`'s tools (registered piecemeal, by name, from more than one
caller), there is one caller (tbd.ui.core) and one list, so registering again — hot reload —
just replaces it, rather than needing a name to replace by."
[providers]
(reset! state-registry (vec providers))
nil)
(defn current-state
"What `page` shows right now, as one map: every state provider offered on it, merged (later ones
win a key both share, though none do today). {} when nothing is registered for it, or nothing
goes to the LLM (tbd.ui.events omits an empty state rather than sending it)."
[page]
(transduce (comp (filter #(offered? page %)) (map (fn [{:keys [provide]}] (provide))))
merge {} @state-registry))
(defn- ->text [value]
(cond
(string? value) value
ui/src/tbd/ui/webmcp.cljs
+52 -26
View File
@@ -16,7 +16,10 @@
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.
agent outside the page. A `:read-only? true` tool (one that only reads what `state-providers`
already covers, like list_todos) stays registered here for WebMCP's outside agents, but is left
out of what the page's own chatbot is offered (see tbd.ui.model-context/definitions): that
chatbot is handed the state instead, through `state-providers`.
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
@@ -215,13 +218,16 @@
(.then #(last (get-in % [:todos :items])))))
(defn- create-todo
"Adds todos, one after the other: a promise of the todos that were created."
"Adds todos, one after the other, and resolves to nil (\"ok\"): the page shows them as they're
added, and the next request's state (tbd.ui.webmcp/state-providers) has them, ids included, so
there is nothing left for the result itself to say."
[{: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)))))
(.then (fn [_] (in-order create-one todos)))
(.then (constantly nil))))
(defn- set-one-done
"Ticks or unticks one todo's checkbox, unless it is already so (no request then). A promise of
@@ -237,7 +243,7 @@
(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."
made. Resolves to nil (\"ok\"): the checkboxes show it, and the next request's state has it too."
[{:keys [todos]}]
(check-todos! todos (fn [{:keys [id done]}]
(check-id! id)
@@ -247,7 +253,8 @@
(.then (fn [items]
(run! #(find-todo! items (:id %)) todos)
(show! :todos)
(in-order set-one-done todos)))))
(in-order set-one-done todos)))
(.then (constantly nil))))
(defn- delete-one
"Presses a todo's Delete button. A promise of its id."
@@ -258,7 +265,8 @@
(.then (fn [_] id))))
(defn- delete-todo
"Presses the Delete button of several todos. Every id is looked up before the first is deleted."
"Presses the Delete button of several todos. Every id is looked up before the first is deleted.
Resolves to nil (\"ok\"): they're gone from the page, and from the next request's state."
[{:keys [todos]}]
(check-todos! todos #(check-id! (:id %)))
(let [ids (distinct (map :id todos))]
@@ -267,7 +275,7 @@
(run! #(find-todo! items %) ids)
(show! :todos)
(in-order delete-one ids)))
(.then (fn [deleted] {:deleted deleted})))))
(.then (constantly nil)))))
;; 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
@@ -289,8 +297,28 @@
(defn- get-tic-tac-toe [_]
(tic-tac-toe-state))
;; --- State (tbd.ui.model-context/current-state, attached to every request of the page's own
;; chatbot instead of spent as a read tool's call; see tbd.ui.model-context's docstring) ---
(defn- todos-state
"The todos, once they have loaded: nil (nothing to add to the state) while they haven't, or
there is no login, rather than an empty list that would read as \"there are none\"."
[]
(let [{:keys [status items]} (:todos (db))]
(when (= :ok status)
{:todos (mapv #(select-keys % [:id :title :done]) items)})))
(def state-providers
"{:pages :provide}, one per page that has state worth telling the model up front. `provide`
returns the page's state as a map, or nil for nothing to add right now (see
tbd.ui.model-context/current-state, which merges them)."
[{:pages #{:todos} :provide todos-state}
{:pages #{:tic-tac-toe} :provide tic-tac-toe-state}
{:pages #{:calculator} :provide (fn [] (:calc (db)))}])
(defn- move-tic-tac-toe
"Presses cell `cell` as `player` (\"x\" or \"o\"), only if it is that player's turn."
"Presses cell `cell` as `player` (\"x\" or \"o\"), only if it is that player's turn. Resolves to
nil (\"ok\") once it lands: the board shows it, and the next request's state has it too."
[{: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"))
@@ -305,14 +333,14 @@
(fail! (str "cell " cell " is taken")))
(show! :tic-tac-toe)
(rf/dispatch-sync [::events/ttt-move cell])
(tic-tac-toe-state)))
nil))
(defn- new-tic-tac-toe-game
"Presses New game."
"Presses New game. Resolves to nil (\"ok\"): the empty board shows it, and so does the state."
[_]
(show! :tic-tac-toe)
(rf/dispatch-sync [::events/ttt-reset])
(tic-tac-toe-state))
nil)
(defn- object-schema [properties required]
{:type "object" :properties properties :required required})
@@ -352,7 +380,7 @@
["page"])
:handler navigate}
{:name "get_calculator" :pages #{:calculator}
{:name "get_calculator" :pages #{:calculator} :read-only? true
: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}
@@ -365,29 +393,28 @@
["x" "y"])
:handler add}
{:name "list_todos" :pages #{:todos}
{:name "list_todos" :pages #{:todos} :read-only? true
: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}
{:name "get_todo" :pages #{:todos} :read-only? true
: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")
:description (str "Adds todos: types each title into the new-todo field and presses Add. 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")
:description (str "Ticks or unticks the checkboxes of todos. 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"}}
@@ -395,14 +422,14 @@
: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 "
:description (str "Deletes todos for good, by pressing their Delete buttons. Find the id first — from the "
"page's current state if you have it, or list_todos — 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}
{:name "get_tic_tac_toe" :pages #{:tic-tac-toe} :read-only? true
: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; "
@@ -411,9 +438,8 @@
: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 "
:description (str "Presses a cell of the tic-tac-toe board as `player`, your side. 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"}
@@ -424,7 +450,7 @@
: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)"
:description "Presses New game: clears the tic-tac-toe board, X to move"
:input-schema (object-schema {} []) :handler new-tic-tac-toe-game}])
;; --- Prompts and resources ---
ui/test/tbd/ui/core_test.cljs
+3
View File
@@ -57,6 +57,9 @@
(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")
(is (= {:board (vec (repeat 9 nil)) :status "in_progress" :turn :x}
(model-context/current-state :tic-tac-toe))
"and its state, for the page it starts on")
;; A tool, as the agent's client calls it.
(let [ping (.-execute (.get (.-availableTools ^js (widget)) "ping"))]
(-> (ping #js {})
ui/test/tbd/ui/events_test.cljs
+75 -6
View File
@@ -25,10 +25,12 @@
:after model-context/clear!}
(tu/stub-effects-fixture {::events/fetch (record ::events/fetch)
::events/fetch-stream (record ::events/fetch-stream)
::events/persist-chat (record ::events/persist-chat)
::events/call-tools (record ::events/call-tools)
::events/copy-to-clipboard (record ::events/copy-to-clipboard)
:dispatch-later (record :dispatch-later)
:dispatch #(swap! queued conj %)}))
:dispatch #(swap! queued conj %)
:dispatch-n #(swap! queued into %)}))
(defn- dispatch!
"Dispatches `event` and, one after the other, the events it sets off."
@@ -49,6 +51,14 @@
(defn- last-request [] (last (requests)))
(defn- persist-requests
"The chat history save/clear requests asked for so far (see ::events/persist-chat), as
{:uri :method :body :on-response}."
[]
(mapv second (filter (comp #{::events/persist-chat} first) @effects)))
(defn- last-persist-request [] (last (persist-requests)))
(defn- answer!
"The server answers the last request."
([status body] (answer! (last-request) status body))
@@ -162,10 +172,11 @@
;; --- Login ---
(deftest user-response-test
(testing "logged in: remembers who, and loads the todos"
(testing "logged in: remembers who, loads the todos, and asks for the last chat session"
(start!)
(answer! 200 {:login "alice" :id 7})
(is (= {:status :logged-in :login "alice"} (:user (app-db))))
(is (= #{"/auth/me" "/api/todos" "/api/chat/history"} (set (map :uri (requests)))))
(is (= "/api/todos" (:uri (last-request)))))
(testing "401 only means nobody is logged in"
(start!)
@@ -338,8 +349,7 @@
(logged-in! [])
(say! " hello there ")
(testing "the trimmed message joins the conversation and goes to the server, for a stream back"
(let [[effect request] (last @effects)]
(is (= ::events/fetch-stream effect))
(let [request (last-request)]
(is (= "/api/chat" (:uri request)))
(is (= "POST" (:method request)))
(is (= [::events/chat-event] (:on-event request)))
@@ -347,7 +357,11 @@
(is (= [{:role "user" :content "hello there"}] (sent-messages request)))
(is (= [{:description "page" :value "tic-tac-toe"}] (get-in request [:body :context]))))
(is (= {:messages [{:role "user" :content "hello there"}] :input "" :status :loading :error nil}
(select-keys (chat) [:messages :input :status :error]))))
(select-keys (chat) [:messages :input :status :error])))
(testing "and is saved for the next login, right away (not only once the reply comes)"
(is (= {:uri "/api/chat/history" :method "PUT"
:body {:messages [{:role "user" :content "hello there"}]}}
(select-keys (last-persist-request) [:uri :method :body])))))
(testing "only one message is in flight, so sending again does nothing"
(say! "and another")
(is (= 1 (count (requests))))
@@ -532,7 +546,41 @@
(event! {:done true})
(dispatch! [::events/chat-toggle])
(dispatch! [::events/chat-clear])
(is (= (assoc (:chat db/default-db) :open? true) (chat)) "starts over, and the panel stays as it was"))
(is (= (assoc (:chat db/default-db) :open? true) (chat)) "starts over, and the panel stays as it was")
(testing "the stored session goes with it, so a reload doesn't bring the old conversation back"
(is (= {:uri "/api/chat/history" :method "DELETE"} (select-keys (last-persist-request) [:uri :method])))))
(deftest chat-history-restore-test
(testing "the last session comes back, once, right after login"
(start!)
(answer! 200 {:login "alice" :id 7})
(let [history-request (first (filter #(= "/api/chat/history" (:uri %)) (requests)))
messages [{:role "user" :content "hi"} {:role "assistant" :content "echo: hi"}]]
(answer! history-request 200 {:messages messages})
(answer! 200 {:todos []})
(is (= messages (:messages (chat))))))
(testing "an empty history leaves the conversation empty"
(start!)
(answer! 200 {:login "bob" :id 8})
(let [history-request (first (filter #(= "/api/chat/history" (:uri %)) (requests)))]
(answer! history-request 200 {:messages []})
(answer! 200 {:todos []})
(is (= [] (:messages (chat))))))
(testing "a conversation already started (the response arriving late) is not overwritten"
(start!)
(answer! 200 {:login "alice" :id 7})
(let [history-request (first (filter #(= "/api/chat/history" (:uri %)) (requests)))]
(answer! 200 {:todos []})
(say! "already started")
(answer! history-request 200 {:messages [{:role "user" :content "old session"}]})
(is (= [{:role "user" :content "already started"}] (:messages (chat))))))
(testing "a failed load (a 401, say) just leaves the conversation empty"
(start!)
(answer! 200 {:login "alice" :id 7})
(let [history-request (first (filter #(= "/api/chat/history" (:uri %)) (requests)))]
(answer! history-request 401 {:error "login required"})
(answer! 200 {:todos []})
(is (= [] (:messages (chat)))))))
(deftest chat-toggle-tools-test
(logged-in! [])
@@ -618,6 +666,27 @@
(is (= [{:name "add" :description "Adds" :parameters add-schema}]
(:tools (:body (last-request)))))))
(deftest chat-offers-the-state-test
(logged-in! [])
(testing "no state provider on the page, none offered"
(say! "hi")
(is (not (contains? (:body (last-request)) :state))))
(testing "the page's state goes along with the conversation, as tbd.chat.schema/RunAgentInput's state"
(reply! "hello")
(model-context/register-state! [{:provide (fn [] {:board (vec (repeat 9 nil))})}])
(say! "again")
(is (= {:board (vec (repeat 9 nil))} (:state (:body (last-request))))))
(testing "a provider offered on another page adds nothing here"
(reply! "hello")
(model-context/register-state! [{:provide (fn [] {:todos []}) :pages #{:todos}}])
(say! "once more")
(is (not (contains? (:body (last-request)) :state))))
(testing "a provider that has nothing to say (nil) adds nothing"
(reply! "hello")
(model-context/register-state! [{:provide (fn [] nil)}])
(say! "again")
(is (not (contains? (:body (last-request)) :state)))))
(defn- page-of [request]
(some #(when (= "page" (:description %)) (:value %)) (get-in request [:body :context])))
ui/test/tbd/ui/model_context_test.cljs
+14
View File
@@ -122,6 +122,20 @@
(fn [_] (is (= [:tic-tac-toe-only :everywhere] @ran) "and never run")))
done))))
(deftest current-state-test
(testing "nothing registered, nothing to offer"
(is (= {} (model-context/current-state :todos))))
(model-context/register-state! [{:provide (fn [] {:todos [{:title "milk"}]}) :pages #{:todos}}
{:provide (fn [] {:board (vec (repeat 9 nil))}) :pages #{:tic-tac-toe}}
{:provide (fn [] {:page-status "ok"})}])
(testing "only the providers offered on the page run, merged into one map"
(is (= {:todos [{:title "milk"}] :page-status "ok"} (model-context/current-state :todos)))
(is (= {:board (vec (repeat 9 nil)) :page-status "ok"} (model-context/current-state :tic-tac-toe)))
(is (= {:page-status "ok"} (model-context/current-state :calculator))))
(testing "clear! takes state providers away too"
(model-context/clear!)
(is (= {} (model-context/current-state :todos)))))
(deftest call-failures-test
(let [ran? (atom false)]
(model-context/register! [(tool "t" (fn [_] (reset! ran? true) "ran"))])
ui/test/tbd/ui/test_util.cljs
+7
View File
@@ -76,6 +76,13 @@
{:content "echo: "}
{:content (:content (last (:messages body)))}
{:done true}]))))
(and (= "GET" method) (= "/api/chat/history" uri)) (respond 200 {:messages (:chat-history @server [])})
(and (= "PUT" method) (= "/api/chat/history" uri))
(do (swap! server assoc :chat-history (:messages body))
(respond 200 {:saved true}))
(and (= "DELETE" method) (= "/api/chat/history" uri))
(do (swap! server assoc :chat-history [])
(respond 200 {:cleared true}))
(and (= "GET" method) (= "/api/todos" uri)) (respond 200 {:todos todos})
(and (= "POST" method) (= "/api/todos" uri))
(if (seq (.trim (:title body)))
ui/test/tbd/ui/views_test.cljs
+4 -2
View File
@@ -828,8 +828,10 @@
#(tu/eventually (fn [] (= ["what is 2 + 3? use the calculator" "I'll add them." "2 + 3 is 5."]
(chat-messages))))
(fn [_]
(testing "the LLM was told about the tools of the page it was on (the calculator), not all of them"
(is (= (set (map :name (filter #(contains? (or (:pages %) #{:calculator}) :calculator) webmcp/tools)))
(testing "the LLM was told about the tools of the page it was on (the calculator), not all of them,
and not the read-only ones (get_calculator): its state covers those"
(is (= (set (map :name (remove :read-only? (filter #(contains? (or (:pages %) #{:calculator}) :calculator)
webmcp/tools))))
(set (map :name (:tools (first (:chat-requests @tu/server))))))))
(testing "the page made the call, as a user would: the calculator holds what was typed and its sum"
(is (= {:x "2" :y "3" :result {:status :ok :x "2" :y "3" :sum 5}}
ui/test/tbd/ui/webmcp_test.cljs
+68 -22
View File
@@ -225,9 +225,7 @@
(-> (call "whoami" {})
(.then (fn [_] (call "set_todo_done" {:todos (mapv #(hash-map :id (tu/todo-uuid %) :done false) (range 1 4))})))
(.then (fn [r]
(is (false? (:error? r)))
(is (= ["todo-1" "todo-2" "todo-3"] (map :title (json (:text r)))))
(is (= [false false false] (map :done (json (:text r)))))
(is (= {:text "ok" :error? false} r) "nothing left to say: the page shows it, and so will the next state")
(is (= [false false false] (map :done (get-in @rf-db/app-db [:todos :items]))))
(is (= :todos (page)))
;; A bad entry, or an unknown todo, refuses the whole batch before anything changes.
@@ -254,9 +252,8 @@
(-> (call "whoami" {})
(.then (fn [_] (call "create_todo" {:todos [{:title "milk"} {:title "eggs"} {:title "bread"}]})))
(.then (fn [r]
(is (false? (:error? r)))
(is (= ["milk" "eggs" "bread"] (map :title (json (:text r)))) "in the order given")
(is (= ["milk" "eggs" "bread"] (map :title (get-in @rf-db/app-db [:todos :items]))))
(is (= {:text "ok" :error? false} r))
(is (= ["milk" "eggs" "bread"] (map :title (get-in @rf-db/app-db [:todos :items]))) "in the order given")
(is (= :todos (page)))
(call "get_todo" {:todos [{:id (tu/todo-uuid 3)} {:id (tu/todo-uuid 1)}]})))
(.then (fn [r]
@@ -272,8 +269,7 @@
(is (= 3 (count (get-in @rf-db/app-db [:todos :items]))) "an unknown id deletes nothing")
(call "delete_todo" {:todos [{:id (tu/todo-uuid 1)} {:id (tu/todo-uuid 1)} {:id (tu/todo-uuid 2)}]})))
(.then (fn [r]
(is (false? (:error? r)))
(is (= {:deleted [(tu/todo-uuid 1) (tu/todo-uuid 2)]} (json (:text r))) "a repeated id is deleted once")
(is (= {:text "ok" :error? false} r) "a repeated id is deleted once, not refused as unknown the second time")
(is (= ["bread"] (map :title (get-in @rf-db/app-db [:todos :items]))))
(is (= ["bread"] (map :title (:todos @tu/server))))
;; The server refuses a blank title, which the page only sees after the first was added.
@@ -367,27 +363,25 @@
(is (= {:text (str "todo not found: " (tu/todo-uuid 99)) :error? true} r))
(call "create_todo" {:todos [{:title "buy milk"}]})))
(.then (fn [r]
(is (false? (:error? r)))
(is (= [{:id (tu/todo-uuid 2) :title "buy milk" :done false}]
(map #(select-keys % [:id :title :done]) (json (:text r)))))
(is (= {:text "ok" :error? false} r))
;; 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" {:todos [{:id (tu/todo-uuid 2) :done true}]})))
(.then (fn [r]
(is (= [true] (map :done (json (:text r)))))
(is (= {:text "ok" :error? false} r))
(is (true? (:done (last (get-in @rf-db/app-db [:todos :items])))))
;; Already ticked: nothing to do, and no request.
(swap! tu/server assoc :todos [])
(call "set_todo_done" {:todos [{:id (tu/todo-uuid 2) :done true}]})))
(.then (fn [r]
(is (= [true] (map :done (json (:text r)))))
(is (= {:text "ok" :error? false} r) "still nothing to do: the now-empty server list was never asked")
(call "set_todo_done" {:todos [{:id (tu/todo-uuid 2) :done "yes"}]})))
(.then (fn [r]
(is (:error? r))
(call "delete_todo" {:todos [{:id (tu/todo-uuid 1)}]})))
(.then (fn [r]
(is (= {:text (str "{\"deleted\":[\"" (tu/todo-uuid 1) "\"]}") :error? false} r))
(is (= {:text "ok" :error? false} r))
(is (= ["buy milk"] (map :title (get-in @rf-db/app-db [:todos :items]))))
(call "delete_todo" {:todos [{:id (tu/todo-uuid 1)}]})))
(.then (fn [r]
@@ -417,10 +411,11 @@
(is (= {:board (vec (repeat 9 nil)) :status "in_progress" :turn "x"} (json (:text r))))
(call "move_tic_tac_toe" {:cell 4 :player "x"})))
(.then (fn [r]
;; It pressed the cell, as a user would, and says it is O's turn now.
;; It pressed the cell, as a user would; there is nothing left to say (see
;; provider-for's tic-tac-toe assertions for the shape it takes in the state).
(is (= {:text "ok" :error? false} r))
(is (= :x (get-in @rf-db/app-db [:ttt :board 4])))
(is (= {:board [nil nil nil nil "x" nil nil nil nil] :status "in_progress" :turn "o"}
(json (:text r))))
(is (= :o (get-in @rf-db/app-db [:ttt :turn])) "it is O's turn now")
(call "move_tic_tac_toe" {:cell 4 :player "o"})))
(.then (fn [r]
(is (= {:text "cell 4 is taken" :error? true} r))
@@ -448,21 +443,72 @@
(is (:error? r))
(call "move_tic_tac_toe" {:cell 0 :player "o"})))
(.then (fn [r]
(is (= "x" (:turn (json (:text r)))))
(is (= {:text "ok" :error? false} r))
(is (= :x (get-in @rf-db/app-db [:ttt :turn])))
;; The person moves X to 3 and O to 1; the agent's X then completes the middle row.
(rf/dispatch-sync [::events/ttt-move 3])
(rf/dispatch-sync [::events/ttt-move 1])
(call "move_tic_tac_toe" {:cell 5 :player "x"})))
(.then (fn [r]
(is (= {:board ["o" "o" nil "x" "x" "x" nil nil nil]
:status "won" :winner "x" :line [3 4 5]}
(json (:text r))))
(is (= {:text "ok" :error? false} r))
(is (= [:o :o nil :x :x :x nil nil nil] (get-in @rf-db/app-db [:ttt :board])) "X won the middle row")
(call "move_tic_tac_toe" {:cell 8 :player "o"})))
(.then (fn [r]
(is (= {:text "the game is over: start a new game" :error? true} r))
(call "new_tic_tac_toe_game" {})))
(.then (fn [r]
(is (= {:board (vec (repeat 9 nil)) :status "in_progress" :turn "x"} (json (:text r))))
(is (= {:text "ok" :error? false} r))
(is (= (vec (repeat 9 nil)) (get-in @rf-db/app-db [:ttt :board])))
(is (= :x (get-in @rf-db/app-db [:ttt :turn])))
(done))))))
;; --- State (tbd.ui.model-context's registry, filled from webmcp/state-providers) ---
(defn- provider-for
"The `:provide` fn of the state provider registered for exactly `pages`."
[pages]
(:provide (first (filter #(= pages (:pages %)) webmcp/state-providers))))
(deftest calculator-state-provider-test
(open-page!)
(async done
(-> (page-loaded)
(.then (fn [_]
(is (= {:x "" :y "" :result {:status :idle}} ((provider-for #{:calculator}))))
(call "add" {:x 2 :y 3})))
(.then (fn [_]
(is (= {:x "2" :y "3" :result {:status :ok :x "2" :y "3" :sum 5}}
((provider-for #{:calculator}))))
(done))))))
(deftest tic-tac-toe-state-provider-test
(open-page!)
;; Raw, as tbd.ui.tictactoe keeps it (:x/:o, not the "x"/"o" strings get_tic_tac_toe's JSON gave:
;; there is no JSON round trip here, only on the wire to the server).
(is (= {:board (vec (repeat 9 nil)) :status "in_progress" :turn :x} ((provider-for #{:tic-tac-toe})))
"the same state get_tic_tac_toe used to hand back")
(async done
(-> (call "move_tic_tac_toe" {:cell 4 :player "x"})
(.then (fn [_]
(is (= {:board [nil nil nil nil :x nil nil nil nil] :status "in_progress" :turn :o}
((provider-for #{:tic-tac-toe}))))
(done))))))
(deftest todos-state-provider-test
(testing "nothing until the todos have loaded (no login, or not fetched yet): not an empty list,
which would read as \"there are none\""
(is (nil? ((provider-for #{:todos})))))
(tu/log-in!)
(swap! tu/server assoc :todos [{:id (tu/todo-uuid 1) :owner-id 7 :title "old" :done false :created-at 1 :updated-at 1}]
:next-id 2)
(open-page!)
(async done
(-> (call "list_todos" {}) ; waits for the load, the way logged-in-todos does
(.then (fn [_]
(is (= {:todos [{:id (tu/todo-uuid 1) :title "old" :done false}]} ((provider-for #{:todos}))))
(call "create_todo" {:todos [{:title "buy milk"}]})))
(.then (fn [_]
(is (= ["old" "buy milk"] (map :title (:todos ((provider-for #{:todos}))))))
(done))))))
;; --- Prompts and resources ---