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

This commit is contained in:
2026-09-22 06:07:45 -09:00
parent 6569a69463
commit a7f12b5d72
21 changed files with 725 additions and 140 deletions
+12 -6
View File
@@ -48,15 +48,21 @@
"person play theirs.\n" "person play theirs.\n"
"\n")) "\n"))
(def examples (defn examples
"Shared with tbd.agent.instructions/chat." "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" (str "Examples:\n"
"\"add a todo to buy milk\" -> create_todo{\"todos\":[{\"title\":\"buy milk\"}]} -> \"Added.\"\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" "\"tick off the milk one\" -> " (when reads? "list_todos -> ")
"\"untick all my todos\" -> list_todos -> ONE set_todo_done with every todo in \"todos\" -> \"Unticked them all.\"\n" "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" "\"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" "\"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) --- ;; --- An MCP client outside the page (Claude, Codex) ---
@@ -85,7 +91,7 @@
"tell them so.\n" "tell them so.\n"
"\n" "\n"
tic-tac-toe-rules tic-tac-toe-rules
examples)) (examples true)))
(defn task (defn task
"The prompt that hands an outside agent a job on the page: `guide`, then the user's `request` if "The prompt that hands an outside agent a job on the page: `guide`, then the user's `request` if
+15 -11
View File
@@ -7,6 +7,7 @@
genuinely shared (`act`, `work-it-out`, `tic-tac-toe-rules`, `examples`) from tbd.agent.prompt genuinely shared (`act`, `work-it-out`, `tic-tac-toe-rules`, `examples`) from tbd.agent.prompt
rather than duplicating it." rather than duplicating it."
(:require [clojure.string :as str] (:require [clojure.string :as str]
[jsonista.core :as json]
[tbd.agent.prompt :as prompt])) [tbd.agent.prompt :as prompt]))
(defn chat (defn chat
@@ -19,8 +20,8 @@
"\n" "\n"
prompt/act prompt/act
(prompt/work-it-out (str "- Chain calls without stopping. The tool you need belongs to another page: navigate there, then\n" (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" " use it. Never invent an id, a title or the state of the page: it's in \"Current state of the\n"
" page: read it with a tool.\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" "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" "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" "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" "the tools you have. Think briefly before you act.\n"
"\n" "\n"
prompt/tic-tac-toe-rules prompt/tic-tac-toe-rules
prompt/examples)) (prompt/examples false)))
(defn chat-system-message (defn chat-system-message
"`chat`'s prompt, with, last, where the user is (`page`) and the names of the `tools` on offer "`chat`'s prompt, with, last, where the user is (`page`), 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 there, and `state` (see tbd.chat.schema/RunAgentInput) — what the page is showing right now, so
when the instructions say them as well, and it can say what it can do without a call. One the model is never told to call a tool to read what it already has. The tools' names are in the
message, and the first: several chat templates (Gemma's, Mistral's) refuse more than one system request's `tools` too, but a model picks them more readily when the instructions say them as
message, or one that isn't first." well, and it can say what it can do without a call. One message, and the first: several chat
[page tools] templates (Gemma's, Mistral's) refuse more than one system message, or one that isn't first."
[page tools state]
(cond-> (chat) (cond-> (chat)
page (str "\n\nThe user is on the \"" page "\" page of the app: what it shows is what they can see.") 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") (seq tools) (str (if page " Its" "\n\nYour")
" tools: " (str/join ", " (map :name tools)) " 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 (defn a2a
"The A2A server's system prompt: an outside agent calling this app directly, not through a "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" "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" "paste JSON, don't describe the tool call itself, just its outcome.\n"
"\n" "\n"
prompt/examples)) (prompt/examples true)))
+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]))
+35 -8
View File
@@ -13,6 +13,7 @@
(:require [muuntaja.core :as m] (:require [muuntaja.core :as m]
[ring.core.protocols :as ring-protocols] [ring.core.protocols :as ring-protocols]
[tbd.agent.core :as agent] [tbd.agent.core :as agent]
[tbd.chat.db :as chat-db]
[tbd.chat.schema :as schema] [tbd.chat.schema :as schema]
[tbd.http :refer [respond]]) [tbd.http :refer [respond]])
(:import (java.io IOException OutputStream) (:import (java.io IOException OutputStream)
@@ -126,13 +127,39 @@
"X-Accel-Buffering" "no"} "X-Accel-Buffering" "no"}
:body (event-stream ok thread-id run-id)})))) :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 (defn routes
"`config` is the agent config (see tbd.agent.core/env-config). Only logged-in users may chat: "`config` is the agent config (see tbd.agent.core/env-config). `ds` is a delay of the app's
every message costs the LLM server's time." database (see tbd.sqlite/open), for /api/chat/history. Only logged-in users may chat: every
[config] message costs the LLM server's time."
[config ds]
["/api/chat" ["/api/chat"
{:post {:tags ["chat"] {: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" {:post {:login? true
:parameters {:body schema/RunAgentInput} :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"
:handler (chat-handler config)}}]) :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)}}]]])
+54 -5
View File
@@ -24,6 +24,14 @@
(defn- small? [tool] (defn- small? [tool]
(<= (count (pr-str tool)) max-tool-schema-length)) (<= (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 (def Tool
"AG-UI's Tool: {name, description, parameters}. `parameters` is JSON Schema for the arguments, "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." which is the LLM's to read, so it is any (small) object."
@@ -83,7 +91,10 @@
(def RunAgentInput (def RunAgentInput
"AG-UI's RunAgentInput: the conversation so far, oldest first (`messages`), the tools on offer "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 `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 browser resends the whole conversation each time, see tbd.ui.events), so it only echoes them
back, never reads them." back, never reads them."
@@ -92,7 +103,45 @@
[:runId {:optional true} [:string {:max 200}]] [:runId {:optional true} [:string {:max 200}]]
[:messages [:vector {:min 1 :max max-messages} Message]] [:messages [:vector {:min 1 :max max-messages} Message]]
[:tools {:optional true} [:vector {:max max-tools} Tool]] [: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 (defn page-of
"The `page` context entry's value, or nil." "The `page` context entry's value, or nil."
@@ -119,6 +168,6 @@
(defn system-text (defn system-text
"The agent's own system prompt for this run (see tbd.agent.instructions), never the caller's to "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." supply: only `page` (from `context`), `tools` and `state` shape it."
[{:keys [tools context]}] [{:keys [tools context state]}]
(instructions/chat-system-message (page-of context) tools)) (instructions/chat-system-message (page-of context) tools state))
+3 -2
View File
@@ -19,6 +19,7 @@
[tbd.auth.core :as auth] [tbd.auth.core :as auth]
[tbd.auth.middleware :as auth-mw] [tbd.auth.middleware :as auth-mw]
[tbd.auth.routes :as auth-routes] [tbd.auth.routes :as auth-routes]
[tbd.chat.db :as chat-db]
[tbd.chat.routes :as chat-routes] [tbd.chat.routes :as chat-routes]
[tbd.health.routes :as health] [tbd.health.routes :as health]
[tbd.http :as http] [tbd.http :as http]
@@ -74,7 +75,7 @@
;; namespace that returns its own route subtree; they're concatenated here. ;; namespace that returns its own route subtree; they're concatenated here.
(defn make-router [{:keys [auth nrepl db webmcp chat]}] (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. ;; 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 (ring/router
[["/swagger.json" [["/swagger.json"
;; The spec is JSON, whatever the API default is (Swagger UI can't read EDN). ;; The spec is JSON, whatever the API default is (Swagger UI can't read EDN).
@@ -90,7 +91,7 @@
(a2a/routes auth ds chat) (a2a/routes auth ds chat)
(oauth-routes/routes auth ds) (oauth-routes/routes auth ds)
(auth-routes/routes auth) (auth-routes/routes auth)
(chat-routes/routes chat) (chat-routes/routes chat ds)
(nrepl-routes/routes nrepl) (nrepl-routes/routes nrepl)
(todo-routes/routes ds)] (todo-routes/routes ds)]
{:data {:muuntaja http/muuntaja {:data {:muuntaja http/muuntaja
+16 -4
View File
@@ -22,17 +22,29 @@
(let [text (instructions/chat)] (let [text (instructions/chat)]
(is (str/includes? text "under your message")) (is (str/includes? text "under your message"))
(is (str/includes? text "Chain calls without stopping")) (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 (deftest chat-system-message-adds-page-and-tools
(is (= (instructions/chat) (instructions/chat-system-message nil nil))) (is (= (instructions/chat) (instructions/chat-system-message nil nil nil)))
(let [text (instructions/chat-system-message "todos" [{:name "create_todo"} {:name "list_todos"}])] (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 "on the \"todos\" page"))
(is (str/includes? text "Its tools: create_todo, list_todos")))) (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 (deftest a2a-has-no-in-page-framing
(let [text (instructions/a2a)] (let [text (instructions/a2a)]
(is (str/includes? text "Act, don't offer")) (is (str/includes? text "Act, don't offer"))
(is (str/includes? text "Agent2Agent protocol")) (is (str/includes? text "Agent2Agent protocol"))
(is (str/includes? text "no page open")) (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")))
+14 -1
View File
@@ -1,6 +1,6 @@
(ns tbd.agent.prompt-test (ns tbd.agent.prompt-test
(:require [clojure.string :as str] (:require [clojure.string :as str]
[clojure.test :refer [deftest is]] [clojure.test :refer [deftest is testing]]
[tbd.agent.prompt :as prompt])) [tbd.agent.prompt :as prompt]))
(defn- flat (defn- flat
@@ -28,6 +28,19 @@
(is (str/includes? (prompt/task none) "Ask the user what they want") (pr-str none)) (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)))) (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 (deftest tic-tac-toe-prompt
(is (str/includes? (prompt/tic-tac-toe "x") "as X.")) (is (str/includes? (prompt/tic-tac-toe "x") "as X."))
(is (str/includes? (prompt/tic-tac-toe "o") "as O.")) (is (str/includes? (prompt/tic-tac-toe "o") "as O."))
+10
View File
@@ -44,6 +44,16 @@
(doseq [p pieces] (.onPartialResponse handler (PartialResponse. ^String p) (PartialResponseContext. h))) (doseq [p pieces] (.onPartialResponse handler (PartialResponse. ^String p) (PartialResponseContext. h)))
(complete handler (AiMessage/from (apply str pieces)) FinishReason/STOP [10 5]))))) (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 (defn thinking-model
"A model that streams `thinking`, then `pieces` as content." "A model that streams `thinking`, then `pieces` as content."
[thinking & pieces] [thinking & pieces]
+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")))
+96 -3
View File
@@ -5,8 +5,11 @@
[ring.core.protocols :as ring-protocols] [ring.core.protocols :as ring-protocols]
[tbd.agent.test-support :as ts] [tbd.agent.test-support :as ts]
[tbd.auth.routes-test :as t] [tbd.auth.routes-test :as t]
[tbd.sqlite-test :as sqlite-test]
[tbd.test-util :as test-util]) [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))) (defn- json [data] (slurp (m/encode "application/json" data)))
@@ -37,8 +40,19 @@
(def ^:private hello (json {:messages [{:id "m1" :role "user" :content "hi"}]})) (def ^:private hello (json {:messages [{:id "m1" :role "user" :content "hi"}]}))
(defn- app-with [chat] (defn- app-with
(t/make-app (t/gitea-stub "alice") :chat chat)) ([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 (deftest anonymous-test
(let [app (app-with (ts/config (ts/text-model "x")))] (let [app (app-with (ts/config (ts/text-model "x")))]
@@ -127,6 +141,26 @@
(json {:messages [{:id "m1" :role "user" :content "hi"}] (json {:messages [{:id "m1" :role "user" :content "hi"}]
:context [{:description "page" :value "ai-setup"}]})))))))) :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 (deftest invalid-tools-test
(let [app (app-with (ts/config (ts/text-model "x"))) (let [app (app-with (ts/config (ts/text-model "x")))
cookie (t/login! app) cookie (t/login! app)
@@ -163,6 +197,65 @@
(is (= 200 (:status resp))) (is (= 200 (:status resp)))
(is (= "RUN_ERROR" (:type (last (events 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 (deftest browser-goes-away-test
(testing "a browser that leaves mid-reply ends the stream quietly" (testing "a browser that leaves mid-reply ends the stream quietly"
(let [app (app-with (ts/config (ts/text-model "a" "b" "c"))) (let [app (app-with (ts/config (ts/text-model "a" "b" "c")))
+4 -1
View File
@@ -12,9 +12,12 @@
(rdc/render @root [views/app])) (rdc/render @root [views/app]))
(defn- offer-tools! (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! webmcp/tools)
(model-context/register-state! webmcp/state-providers)
(webmcp/register!)) (webmcp/register!))
(defn reload (defn reload
+115 -39
View File
@@ -17,16 +17,23 @@
(defn- response-map [resp text] (defn- response-map [resp text]
{:ok? (.-ok resp) :status (.-status resp) :body 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. ;; `(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>}`. ;; Network failures come back as `{:ok? false :status nil :body <message>}`.
(rf/reg-fx (defn- do-fetch! [{:keys [on-response] :as request}]
::fetch (-> (fetch-request request)
(fn [{:keys [on-response] :as request}] (.then (fn [resp]
(-> (fetch-request request) (.then (.text resp) #(rf/dispatch (conj on-response (response-map resp %))))))
(.then (fn [resp] (.catch #(rf/dispatch (conj on-response {:ok? false :status nil :body (.-message %)})))))
(.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"}) (def ^:private connection-lost {:type "RUN_ERROR" :message "the connection was lost"})
@@ -172,7 +179,7 @@
(cond (cond
ok? {:db (assoc db :user {:status :logged-in ok? {:db (assoc db :user {:status :logged-in
:login (:login (reader/read-string (:body resp)))}) :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})} (= 401 status) {:db (assoc db :user {:status :anonymous})}
:else {:db (assoc db :user {:status :error :message (error-message resp)})}))) :else {:db (assoc db :user {:status :error :message (error-message resp)})})))
@@ -331,11 +338,47 @@
:function {:name name :arguments arguments}}) :function {:name name :arguments arguments}})
tool-calls)))) 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 (defn- recent
"The most recent `max-sent-messages` of `messages`, without the results of calls whose asking "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." is cut off: the LLM server refuses a result that answers nothing."
[messages] [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 (def ^:private stale-result
"What the LLM is sent in place of a result from before the user's last message." "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))) description (assoc :description description)))
;; The request that sends the conversation: an AG-UI RunAgentInput. It goes with the page being ;; 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 ;; shown (as a `context` entry, for the LLM to know where the user is), the tools that page offers
;; offers the LLM. Both are read from the db every time, so a conversation that moves between ;; the LLM, and its current state (`state`, see tbd.ui.model-context/current-state and
;; pages (the LLM's own `navigate`, say) always tells the LLM where it is now. ;; 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] (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" {:uri "/api/chat" :method "POST"
:body (cond-> {:threadId (next-id) :runId (next-id) :body (cond-> {:threadId (next-id) :runId (next-id)
:messages (mapv wire-message (without-stale-results (recent messages))) :messages (mapv wire-message (without-stale-results (recent messages)))
:context [{:description "page" :value (name (:page db))}]} :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-event [::chat-event]
:on-response [::chat-response]})) :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 (rf/reg-event-db
::chat-toggle ::chat-toggle
(fn [db _] (fn [db _]
@@ -406,10 +468,12 @@
(let [{:keys [input messages status]} (:chat db) (let [{:keys [input messages status]} (:chat db)
content (str/trim input)] content (str/trim input)]
(when (and (not= :loading status) (seq content)) (when (and (not= :loading status) (seq content))
(let [messages (conj messages {:role "user" :content content})] (let [messages (conj messages {:role "user" :content content})
{:db (update db :chat assoc :messages messages :input "" :status :loading :error nil db (update db :chat assoc :messages messages :input "" :status :loading :error nil
:tool-calls-used 0) :tool-calls-used 0)]
::fetch-stream (chat-request db messages)}))))) {:db db
::fetch-stream (chat-request db messages)
::persist-chat (save-chat-fx db)})))))
(defn- only-reasoning? (defn- only-reasoning?
"Whether `message` is a reply that has come to nothing but the reasoning for it: there is nothing "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 ;; 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, ;; back to the logged-out view. A response nobody is waiting for (the conversation was reset since,
;; by logging out) is dropped. ;; by logging out) is dropped.
(rf/reg-event-db (rf/reg-event-fx
::chat-response ::chat-response
(fn [db [_ {:keys [status] :as resp}]] (fn [{:keys [db]} [_ {:keys [status] :as resp}]]
(cond (cond
(not= :loading (get-in db [:chat :status])) db (not= :loading (get-in db [:chat :status])) {:db db}
(= 401 status) (-> db (assoc :user {:status :anonymous}) reset-chat) (= 401 status) {:db (-> db (assoc :user {:status :anonymous}) reset-chat)}
:else (chat-failed db (error-message resp))))) :else (let [db (chat-failed db (error-message resp))]
{:db db ::persist-chat (save-chat-fx db)}))))
(defn- append-to-reply (defn- append-to-reply
"The conversation's assistant message being written, with `text` added to its content. The first "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)] db (update db :chat assoc :pending-calls nil :thinking-at nil)]
(cond (cond
(empty? pending-calls) (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) (> used max-tool-calls-per-turn)
;; The calls still get their answers, for the conversation to make sense to the LLM later. ;; The calls still get their answers, for the conversation to make sense to the LLM later.
{:db (-> db (let [db (-> db
(update-in [:chat :messages] with-tool-calls pending-calls) (update-in [:chat :messages] with-tool-calls pending-calls)
(update-in [:chat :messages] into (update-in [:chat :messages] into
(for [{:keys [id name]} pending-calls] (for [{:keys [id name]} pending-calls]
(tool-message {:id id :name name :error? true (tool-message {:id id :name name :error? true
:content "not run: too many tool calls in one turn"}))) :content "not run: too many tool calls in one turn"})))
(update :chat assoc :status :idle (update :chat assoc :status :idle
:error "The assistant made too many tool calls in a row, so it was stopped."))} :error "The assistant made too many tool calls in a row, so it was stopped."))]
{:db db ::persist-chat (save-chat-fx db)})
:else :else
{:db (-> db {:db (-> db
@@ -535,7 +602,8 @@
(= "TOOL_CALL_ARGS" type) {:db (append-tool-call-args db event)} (= "TOOL_CALL_ARGS" type) {:db (append-tool-call-args db event)}
(= "TOOL_CALL_END" type) {:db (end-tool-call db event)} (= "TOOL_CALL_END" type) {:db (end-tool-call db event)}
(= "RUN_FINISHED" type) (finish-reply db) (= "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})))) :else {:db db}))))
(defn- call-all (defn- call-all
@@ -580,13 +648,21 @@
{:db db {:db db
::fetch-stream (chat-request db (get-in db [:chat :messages]))})))) ::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. ;; Starts a new session: not while a reply is on its way (it would land in the new one), and the
(rf/reg-event-db ;; stored history goes with it, so a reload doesn't bring the old conversation back.
(rf/reg-event-fx
::chat-clear ::chat-clear
(fn [db _] (fn [{:keys [db]} _]
(if (= :loading (get-in db [:chat :status])) (if (= :loading (get-in db [:chat :status]))
db {:db db}
(reset-chat 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 --- ;; --- MCP setup page ---
+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 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 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 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])) (:require [clojure.string :as str]))
(defonce ^:private registry (atom [])) (defonce ^:private registry (atom []))
(defonce ^:private state-registry (atom []))
(defn register! (defn register!
"Adds `tools` to what the page offers. A tool with the name of one already there replaces it "Adds `tools` to what the page offers. A tool with the name of one already there replaces it
@@ -31,27 +39,49 @@
nil)) nil))
(defn clear! (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! registry [])
(reset! state-registry [])
nil) nil)
(defn- offered? (defn- offered?
"Whether `tool` is offered on `page`." "Whether `entry` (a tool or a state provider) is offered on `page`."
[page {:keys [pages]}] [page {:keys [pages]}]
(or (nil? pages) (contains? pages page))) (or (nil? pages) (contains? pages page)))
(defn definitions (defn definitions
"What the LLM is told about the tools offered on `page`, as MCP's `tools/list` gives them: "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] [page]
(into [] (into []
(comp (filter #(offered? page %)) (comp (filter #(offered? page %))
(remove :read-only?)
(map (fn [{:keys [name description input-schema]}] (map (fn [{:keys [name description input-schema]}]
(cond-> {:name name :inputSchema input-schema} (cond-> {:name name :inputSchema input-schema}
description (assoc :description description))))) description (assoc :description description)))))
@registry)) @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] (defn- ->text [value]
(cond (cond
(string? value) value (string? value) value
+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 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 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 `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 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 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]))))) (.then #(last (get-in % [:todos :items])))))
(defn- create-todo (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]}] [{:keys [todos]}]
(check-todos! todos (fn [{:keys [title]}] (check-todos! todos (fn [{:keys [title]}]
(when-not (and (string? title) (seq title)) (when-not (and (string? title) (seq title))
(fail! "invalid arguments: title must be a non-empty string")))) (fail! "invalid arguments: title must be a non-empty string"))))
(-> (logged-in-todos) (-> (logged-in-todos)
(.then (fn [_] (in-order create-one todos))))) (.then (fn [_] (in-order create-one todos)))
(.then (constantly nil))))
(defn- set-one-done (defn- set-one-done
"Ticks or unticks one todo's checkbox, unless it is already so (no request then). A promise of "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 (defn- set-todo-done
"Ticks or unticks the checkboxes of several todos. Every change is checked before the first is "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]}] [{:keys [todos]}]
(check-todos! todos (fn [{:keys [id done]}] (check-todos! todos (fn [{:keys [id done]}]
(check-id! id) (check-id! id)
@@ -247,7 +253,8 @@
(.then (fn [items] (.then (fn [items]
(run! #(find-todo! items (:id %)) todos) (run! #(find-todo! items (:id %)) todos)
(show! :todos) (show! :todos)
(in-order set-one-done todos))))) (in-order set-one-done todos)))
(.then (constantly nil))))
(defn- delete-one (defn- delete-one
"Presses a todo's Delete button. A promise of its id." "Presses a todo's Delete button. A promise of its id."
@@ -258,7 +265,8 @@
(.then (fn [_] id)))) (.then (fn [_] id))))
(defn- delete-todo (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]}] [{:keys [todos]}]
(check-todos! todos #(check-id! (:id %))) (check-todos! todos #(check-id! (:id %)))
(let [ids (distinct (map :id todos))] (let [ids (distinct (map :id todos))]
@@ -267,7 +275,7 @@
(run! #(find-todo! items %) ids) (run! #(find-todo! items %) ids)
(show! :todos) (show! :todos)
(in-order delete-one ids))) (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 ;; 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 ;; 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 [_] (defn- get-tic-tac-toe [_]
(tic-tac-toe-state)) (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 (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]}] [{:keys [cell player]}]
(when-not (and (number? cell) (js/Number.isInteger cell) (<= 0 cell 8)) (when-not (and (number? cell) (js/Number.isInteger cell) (<= 0 cell 8))
(fail! "invalid arguments: cell must be an integer from 0 to 8")) (fail! "invalid arguments: cell must be an integer from 0 to 8"))
@@ -305,14 +333,14 @@
(fail! (str "cell " cell " is taken"))) (fail! (str "cell " cell " is taken")))
(show! :tic-tac-toe) (show! :tic-tac-toe)
(rf/dispatch-sync [::events/ttt-move cell]) (rf/dispatch-sync [::events/ttt-move cell])
(tic-tac-toe-state))) nil))
(defn- new-tic-tac-toe-game (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) (show! :tic-tac-toe)
(rf/dispatch-sync [::events/ttt-reset]) (rf/dispatch-sync [::events/ttt-reset])
(tic-tac-toe-state)) nil)
(defn- object-schema [properties required] (defn- object-schema [properties required]
{:type "object" :properties properties :required required}) {:type "object" :properties properties :required required})
@@ -352,7 +380,7 @@
["page"]) ["page"])
:handler navigate} :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 " :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)") "the result it is showing (status idle, loading, ok with the sum, or error with the message)")
:input-schema (object-schema {} []) :handler get-calculator} :input-schema (object-schema {} []) :handler get-calculator}
@@ -365,29 +393,28 @@
["x" "y"]) ["x" "y"])
:handler add} :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. " :description (str "Lists the todos this page shows (JSON: id, title, done, created-at, updated-at), oldest first. "
"Needs a login on the page") "Needs a login on the page")
:input-schema (object-schema {} []) :handler list-todos} :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 " :description (str "Gets todos this page shows, by id (JSON list). Takes a list: to read several, make ONE call "
"with all of them") "with all of them")
:input-schema (todos-schema "The todos to get, one per todo" {:id todo-id} ["id"]) :input-schema (todos-schema "The todos to get, one per todo" {:id todo-id} ["id"])
:handler get-todo} :handler get-todo}
{:name "create_todo" :pages #{:todos} {:name "create_todo" :pages #{:todos}
:description (str "Adds todos: types each title into the new-todo field and presses Add, and returns the todos " :description (str "Adds todos: types each title into the new-todo field and presses Add. Takes a list: to add "
"that were created (JSON list). Takes a list: to add several, make ONE call with all of them, " "several, make ONE call with all of them, never one call per todo")
"never one call per todo")
:input-schema (todos-schema "The todos to add, one 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 {:type "string" :minLength 1 :maxLength 200 :description "What needs doing"}}
["title"]) ["title"])
:handler create-todo} :handler create-todo}
{:name "set_todo_done" :pages #{:todos} {:name "set_todo_done" :pages #{:todos}
:description (str "Ticks or unticks the checkboxes of todos, and returns those todos (JSON list). Takes a list: " :description (str "Ticks or unticks the checkboxes of todos. Takes a list: to change several, make ONE call "
"to change several, make ONE call with all of them, never one call per todo") "with all of them, never one call per todo")
:input-schema (todos-schema "The changes to make, one per todo" :input-schema (todos-schema "The changes to make, one per todo"
{:id todo-id {:id todo-id
:done {:type "boolean" :description "true to tick it off, false to untick it"}} :done {:type "boolean" :description "true to tick it off, false to untick it"}}
@@ -395,14 +422,14 @@
:handler set-todo-done} :handler set-todo-done}
{:name "delete_todo" :pages #{:todos} {:name "delete_todo" :pages #{:todos}
:description (str "Deletes todos for good, by pressing their Delete buttons, and returns the ids that were " :description (str "Deletes todos for good, by pressing their Delete buttons. Find the id first — from the "
"deleted (JSON). Find the ids with list_todos first; never guess one, and never delete a " "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 " "todo the user did not clearly point at. Takes a list: to delete several, make ONE call "
"with all of them") "with all of them")
:input-schema (todos-schema "The todos to delete, one per todo" {:id todo-id} ["id"]) :input-schema (todos-schema "The todos to delete, one per todo" {:id todo-id} ["id"])
:handler delete-todo} :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 " :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 " "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; " "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} :input-schema (object-schema {} []) :handler get-tic-tac-toe}
{:name "move_tic_tac_toe" :pages #{: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 " :description (str "Presses a cell of the tic-tac-toe board as `player`, your side. Fails, and changes nothing, "
"get_tic_tac_toe does (including whose turn is next). Fails, and changes nothing, if it " "if it is not your side's turn (the other side is the person's: wait for them to move), the "
"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") "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 :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"} :description "0 is the top left, 2 the top right, 8 the bottom right"}
@@ -424,7 +450,7 @@
:handler move-tic-tac-toe} :handler move-tic-tac-toe}
{:name "new_tic_tac_toe_game" :pages #{: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}]) :input-schema (object-schema {} []) :handler new-tic-tac-toe-game}])
;; --- Prompts and resources --- ;; --- Prompts and resources ---
+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 (= (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))) (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") "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. ;; A tool, as the agent's client calls it.
(let [ping (.-execute (.get (.-availableTools ^js (widget)) "ping"))] (let [ping (.-execute (.get (.-availableTools ^js (widget)) "ping"))]
(-> (ping #js {}) (-> (ping #js {})
+75 -6
View File
@@ -25,10 +25,12 @@
:after model-context/clear!} :after model-context/clear!}
(tu/stub-effects-fixture {::events/fetch (record ::events/fetch) (tu/stub-effects-fixture {::events/fetch (record ::events/fetch)
::events/fetch-stream (record ::events/fetch-stream) ::events/fetch-stream (record ::events/fetch-stream)
::events/persist-chat (record ::events/persist-chat)
::events/call-tools (record ::events/call-tools) ::events/call-tools (record ::events/call-tools)
::events/copy-to-clipboard (record ::events/copy-to-clipboard) ::events/copy-to-clipboard (record ::events/copy-to-clipboard)
:dispatch-later (record :dispatch-later) :dispatch-later (record :dispatch-later)
:dispatch #(swap! queued conj %)})) :dispatch #(swap! queued conj %)
:dispatch-n #(swap! queued into %)}))
(defn- dispatch! (defn- dispatch!
"Dispatches `event` and, one after the other, the events it sets off." "Dispatches `event` and, one after the other, the events it sets off."
@@ -49,6 +51,14 @@
(defn- last-request [] (last (requests))) (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! (defn- answer!
"The server answers the last request." "The server answers the last request."
([status body] (answer! (last-request) status body)) ([status body] (answer! (last-request) status body))
@@ -162,10 +172,11 @@
;; --- Login --- ;; --- Login ---
(deftest user-response-test (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!) (start!)
(answer! 200 {:login "alice" :id 7}) (answer! 200 {:login "alice" :id 7})
(is (= {:status :logged-in :login "alice"} (:user (app-db)))) (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))))) (is (= "/api/todos" (:uri (last-request)))))
(testing "401 only means nobody is logged in" (testing "401 only means nobody is logged in"
(start!) (start!)
@@ -338,8 +349,7 @@
(logged-in! []) (logged-in! [])
(say! " hello there ") (say! " hello there ")
(testing "the trimmed message joins the conversation and goes to the server, for a stream back" (testing "the trimmed message joins the conversation and goes to the server, for a stream back"
(let [[effect request] (last @effects)] (let [request (last-request)]
(is (= ::events/fetch-stream effect))
(is (= "/api/chat" (:uri request))) (is (= "/api/chat" (:uri request)))
(is (= "POST" (:method request))) (is (= "POST" (:method request)))
(is (= [::events/chat-event] (:on-event request))) (is (= [::events/chat-event] (:on-event request)))
@@ -347,7 +357,11 @@
(is (= [{:role "user" :content "hello there"}] (sent-messages request))) (is (= [{:role "user" :content "hello there"}] (sent-messages request)))
(is (= [{:description "page" :value "tic-tac-toe"}] (get-in request [:body :context])))) (is (= [{:description "page" :value "tic-tac-toe"}] (get-in request [:body :context]))))
(is (= {:messages [{:role "user" :content "hello there"}] :input "" :status :loading :error nil} (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" (testing "only one message is in flight, so sending again does nothing"
(say! "and another") (say! "and another")
(is (= 1 (count (requests)))) (is (= 1 (count (requests))))
@@ -532,7 +546,41 @@
(event! {:done true}) (event! {:done true})
(dispatch! [::events/chat-toggle]) (dispatch! [::events/chat-toggle])
(dispatch! [::events/chat-clear]) (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 (deftest chat-toggle-tools-test
(logged-in! []) (logged-in! [])
@@ -618,6 +666,27 @@
(is (= [{:name "add" :description "Adds" :parameters add-schema}] (is (= [{:name "add" :description "Adds" :parameters add-schema}]
(:tools (:body (last-request))))))) (: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] (defn- page-of [request]
(some #(when (= "page" (:description %)) (:value %)) (get-in request [:body :context]))) (some #(when (= "page" (:description %)) (:value %)) (get-in request [:body :context])))
+14
View File
@@ -122,6 +122,20 @@
(fn [_] (is (= [:tic-tac-toe-only :everywhere] @ran) "and never run"))) (fn [_] (is (= [:tic-tac-toe-only :everywhere] @ran) "and never run")))
done)))) 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 (deftest call-failures-test
(let [ran? (atom false)] (let [ran? (atom false)]
(model-context/register! [(tool "t" (fn [_] (reset! ran? true) "ran"))]) (model-context/register! [(tool "t" (fn [_] (reset! ran? true) "ran"))])
+7
View File
@@ -76,6 +76,13 @@
{:content "echo: "} {:content "echo: "}
{:content (:content (last (:messages body)))} {:content (:content (last (:messages body)))}
{:done true}])))) {: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 (= "GET" method) (= "/api/todos" uri)) (respond 200 {:todos todos})
(and (= "POST" method) (= "/api/todos" uri)) (and (= "POST" method) (= "/api/todos" uri))
(if (seq (.trim (:title body))) (if (seq (.trim (:title body)))
+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."] #(tu/eventually (fn [] (= ["what is 2 + 3? use the calculator" "I'll add them." "2 + 3 is 5."]
(chat-messages)))) (chat-messages))))
(fn [_] (fn [_]
(testing "the LLM was told about the tools of the page it was on (the calculator), not all of them" (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))) 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)))))))) (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" (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}} (is (= {:x "2" :y "3" :result {:status :ok :x "2" :y "3" :sum 5}}
+68 -22
View File
@@ -225,9 +225,7 @@
(-> (call "whoami" {}) (-> (call "whoami" {})
(.then (fn [_] (call "set_todo_done" {:todos (mapv #(hash-map :id (tu/todo-uuid %) :done false) (range 1 4))}))) (.then (fn [_] (call "set_todo_done" {:todos (mapv #(hash-map :id (tu/todo-uuid %) :done false) (range 1 4))})))
(.then (fn [r] (.then (fn [r]
(is (false? (:error? r))) (is (= {:text "ok" :error? false} r) "nothing left to say: the page shows it, and so will the next state")
(is (= ["todo-1" "todo-2" "todo-3"] (map :title (json (:text r)))))
(is (= [false false false] (map :done (json (:text r)))))
(is (= [false false false] (map :done (get-in @rf-db/app-db [:todos :items])))) (is (= [false false false] (map :done (get-in @rf-db/app-db [:todos :items]))))
(is (= :todos (page))) (is (= :todos (page)))
;; A bad entry, or an unknown todo, refuses the whole batch before anything changes. ;; A bad entry, or an unknown todo, refuses the whole batch before anything changes.
@@ -254,9 +252,8 @@
(-> (call "whoami" {}) (-> (call "whoami" {})
(.then (fn [_] (call "create_todo" {:todos [{:title "milk"} {:title "eggs"} {:title "bread"}]}))) (.then (fn [_] (call "create_todo" {:todos [{:title "milk"} {:title "eggs"} {:title "bread"}]})))
(.then (fn [r] (.then (fn [r]
(is (false? (:error? r))) (is (= {:text "ok" :error? false} 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]))) "in the order given")
(is (= ["milk" "eggs" "bread"] (map :title (get-in @rf-db/app-db [:todos :items]))))
(is (= :todos (page))) (is (= :todos (page)))
(call "get_todo" {:todos [{:id (tu/todo-uuid 3)} {:id (tu/todo-uuid 1)}]}))) (call "get_todo" {:todos [{:id (tu/todo-uuid 3)} {:id (tu/todo-uuid 1)}]})))
(.then (fn [r] (.then (fn [r]
@@ -272,8 +269,7 @@
(is (= 3 (count (get-in @rf-db/app-db [:todos :items]))) "an unknown id deletes nothing") (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)}]}))) (call "delete_todo" {:todos [{:id (tu/todo-uuid 1)} {:id (tu/todo-uuid 1)} {:id (tu/todo-uuid 2)}]})))
(.then (fn [r] (.then (fn [r]
(is (false? (:error? r))) (is (= {:text "ok" :error? false} r) "a repeated id is deleted once, not refused as unknown the second time")
(is (= {:deleted [(tu/todo-uuid 1) (tu/todo-uuid 2)]} (json (:text r))) "a repeated id is deleted once")
(is (= ["bread"] (map :title (get-in @rf-db/app-db [:todos :items])))) (is (= ["bread"] (map :title (get-in @rf-db/app-db [:todos :items]))))
(is (= ["bread"] (map :title (:todos @tu/server)))) (is (= ["bread"] (map :title (:todos @tu/server))))
;; The server refuses a blank title, which the page only sees after the first was added. ;; 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)) (is (= {:text (str "todo not found: " (tu/todo-uuid 99)) :error? true} r))
(call "create_todo" {:todos [{:title "buy milk"}]}))) (call "create_todo" {:todos [{:title "buy milk"}]})))
(.then (fn [r] (.then (fn [r]
(is (false? (:error? r))) (is (= {:text "ok" :error? false} r))
(is (= [{:id (tu/todo-uuid 2) :title "buy milk" :done false}]
(map #(select-keys % [:id :title :done]) (json (:text r)))))
;; The page shows it, and the field is empty again. ;; 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 (= ["old" "buy milk"] (map :title (get-in @rf-db/app-db [:todos :items]))))
(is (= "" (get-in @rf-db/app-db [:todos :new-title]))) (is (= "" (get-in @rf-db/app-db [:todos :new-title])))
(call "set_todo_done" {:todos [{:id (tu/todo-uuid 2) :done true}]}))) (call "set_todo_done" {:todos [{:id (tu/todo-uuid 2) :done true}]})))
(.then (fn [r] (.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]))))) (is (true? (:done (last (get-in @rf-db/app-db [:todos :items])))))
;; Already ticked: nothing to do, and no request. ;; Already ticked: nothing to do, and no request.
(swap! tu/server assoc :todos []) (swap! tu/server assoc :todos [])
(call "set_todo_done" {:todos [{:id (tu/todo-uuid 2) :done true}]}))) (call "set_todo_done" {:todos [{:id (tu/todo-uuid 2) :done true}]})))
(.then (fn [r] (.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"}]}))) (call "set_todo_done" {:todos [{:id (tu/todo-uuid 2) :done "yes"}]})))
(.then (fn [r] (.then (fn [r]
(is (:error? r)) (is (:error? r))
(call "delete_todo" {:todos [{:id (tu/todo-uuid 1)}]}))) (call "delete_todo" {:todos [{:id (tu/todo-uuid 1)}]})))
(.then (fn [r] (.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])))) (is (= ["buy milk"] (map :title (get-in @rf-db/app-db [:todos :items]))))
(call "delete_todo" {:todos [{:id (tu/todo-uuid 1)}]}))) (call "delete_todo" {:todos [{:id (tu/todo-uuid 1)}]})))
(.then (fn [r] (.then (fn [r]
@@ -417,10 +411,11 @@
(is (= {:board (vec (repeat 9 nil)) :status "in_progress" :turn "x"} (json (:text r)))) (is (= {:board (vec (repeat 9 nil)) :status "in_progress" :turn "x"} (json (:text r))))
(call "move_tic_tac_toe" {:cell 4 :player "x"}))) (call "move_tic_tac_toe" {:cell 4 :player "x"})))
(.then (fn [r] (.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 (= :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"} (is (= :o (get-in @rf-db/app-db [:ttt :turn])) "it is O's turn now")
(json (:text r))))
(call "move_tic_tac_toe" {:cell 4 :player "o"}))) (call "move_tic_tac_toe" {:cell 4 :player "o"})))
(.then (fn [r] (.then (fn [r]
(is (= {:text "cell 4 is taken" :error? true} r)) (is (= {:text "cell 4 is taken" :error? true} r))
@@ -448,21 +443,72 @@
(is (:error? r)) (is (:error? r))
(call "move_tic_tac_toe" {:cell 0 :player "o"}))) (call "move_tic_tac_toe" {:cell 0 :player "o"})))
(.then (fn [r] (.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. ;; 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 3])
(rf/dispatch-sync [::events/ttt-move 1]) (rf/dispatch-sync [::events/ttt-move 1])
(call "move_tic_tac_toe" {:cell 5 :player "x"}))) (call "move_tic_tac_toe" {:cell 5 :player "x"})))
(.then (fn [r] (.then (fn [r]
(is (= {:board ["o" "o" nil "x" "x" "x" nil nil nil] (is (= {:text "ok" :error? false} r))
:status "won" :winner "x" :line [3 4 5]} (is (= [:o :o nil :x :x :x nil nil nil] (get-in @rf-db/app-db [:ttt :board])) "X won the middle row")
(json (:text r))))
(call "move_tic_tac_toe" {:cell 8 :player "o"}))) (call "move_tic_tac_toe" {:cell 8 :player "o"})))
(.then (fn [r] (.then (fn [r]
(is (= {:text "the game is over: start a new game" :error? true} r)) (is (= {:text "the game is over: start a new game" :error? true} r))
(call "new_tic_tac_toe_game" {}))) (call "new_tic_tac_toe_game" {})))
(.then (fn [r] (.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)))))) (done))))))
;; --- Prompts and resources --- ;; --- Prompts and resources ---