This commit is contained in:
@@ -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
|
||||||
|
|||||||
@@ -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)))
|
||||||
|
|||||||
@@ -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
@@ -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
@@ -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
@@ -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
|
||||||
|
|||||||
@@ -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")))
|
||||||
|
|||||||
@@ -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."))
|
||||||
|
|||||||
@@ -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]
|
||||||
|
|||||||
@@ -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")))
|
||||||
@@ -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")))
|
||||||
|
|||||||
@@ -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
@@ -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 ---
|
||||||
|
|
||||||
|
|||||||
@@ -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
@@ -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 ---
|
||||||
|
|||||||
@@ -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 {})
|
||||||
|
|||||||
@@ -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])))
|
||||||
|
|
||||||
|
|||||||
@@ -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"))])
|
||||||
|
|||||||
@@ -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)))
|
||||||
|
|||||||
@@ -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}}
|
||||||
|
|||||||
@@ -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 ---
|
||||||
|
|||||||
Reference in New Issue
Block a user