add integrated chatbot with streaming + tools

ui/test/tbd/ui/core_test.cljs

@@ -3,6 +3,7 @@
             [re-frame.db :as rf-db]
             [reagent.dom.client :as rdc]
             [tbd.ui.core :as core]
+            [tbd.ui.model-context :as model-context]
             [tbd.ui.test-util :as tu]
             [tbd.ui.webmcp :as webmcp]))
 
@@ -36,6 +37,7 @@
               (some-> (.getElementById js/document (.-elementId ^js w)) .remove))
             (reset! @#'webmcp/widget nil)
             (.clear js/sessionStorage)
+            (model-context/clear!)
             ;; init mounts the page in a root of its own.
             (when-let [root @core/root]
               (rdc/unmount root)
@@ -53,6 +55,8 @@
         (fn []
           (is (some? (.getElementById js/document (.-elementId ^js (widget)))) "the WebMCP widget is on the page")
           (is (= (set (map :name webmcp/tools)) (tools-in-widget)) "it offers the page's tools to the agent")
+          (is (= (map :name (remove :pages webmcp/tools)) (map :name (model-context/definitions :ai-setup)))
+              "and to the chatbot, the ones of the page it is on")
           ;; A tool, as the agent's client calls it.
           (let [ping (.-execute (.get (.-availableTools ^js (widget)) "ping"))]
             (-> (ping #js {})

ui/test/tbd/ui/events_test.cljs

@@ -4,6 +4,7 @@
             [re-frame.db :as rf-db]
             [tbd.ui.db :as db]
             [tbd.ui.events :as events]
+            [tbd.ui.model-context :as model-context]
             [tbd.ui.test-util :as tu]))
 
 ;; The handlers run for real; what they ask the outside world for (a request, the clipboard, a
@@ -19,8 +20,11 @@
 
 (use-fixtures :each
   tu/url-fixture
-  {:before (fn [] (reset! effects []) (reset! queued []))}
+  {:before (fn [] (reset! effects []) (reset! queued []) (model-context/clear!))
+   :after model-context/clear!}
   (tu/stub-effects-fixture {::events/fetch (record ::events/fetch)
+                            ::events/fetch-stream (record ::events/fetch-stream)
+                            ::events/call-tools (record ::events/call-tools)
                             ::events/copy-to-clipboard (record ::events/copy-to-clipboard)
                             :dispatch-later (record :dispatch-later)
                             :dispatch #(swap! queued conj %)}))
@@ -37,9 +41,10 @@
 (defn- app-db [] @rf-db/app-db)
 
 (defn- requests
-  "The requests asked for so far, as {:uri :method :body :on-response}."
+  "The requests asked for so far, as {:uri :method :body :on-response}. (Those for a stream of
+  events also have :on-event.)"
   []
-  (mapv second (filter (comp #{::events/fetch} first) @effects)))
+  (mapv second (filter (comp #{::events/fetch ::events/fetch-stream} first) @effects)))
 
 (defn- last-request [] (last (requests)))
 
@@ -268,6 +273,566 @@
       (is (= {:status :anonymous} (:user (app-db))) (str event))
       (is (= (:todos db/default-db) (:todos (app-db))) "the todos are hidden and forgotten"))))
 
+;; --- Chat ---
+
+(defn- chat [] (:chat (app-db)))
+
+(defn- say!
+  "Types `text` into the chat input and sends it."
+  [text]
+  (dispatch! [::events/chat-set-input text])
+  (dispatch! [::events/chat-send]))
+
+(defn- event!
+  "The stream the last request asked for delivers `event`."
+  [event]
+  (dispatch! (conj (:on-event (last-request)) event)))
+
+(defn- reply!
+  "The stream delivers `pieces` of the reply, and ends."
+  [& pieces]
+  (doseq [piece pieces] (event! {:content piece}))
+  (event! {:done true}))
+
+(deftest chat-toggle-test
+  (start!)
+  (is (false? (:open? (chat))))
+  (dispatch! [::events/chat-toggle])
+  (is (true? (:open? (chat))))
+  (dispatch! [::events/chat-toggle])
+  (is (false? (:open? (chat)))))
+
+(deftest chat-send-test
+  (logged-in! [])
+  (say! "  hello there ")
+  (testing "the trimmed message joins the conversation and goes to the server, for a stream back"
+    (is (= [::events/fetch-stream
+            {:uri "/api/chat" :method "POST"
+             :body {:messages [{:role "user" :content "hello there"}] :page "games"}
+             :on-event [::events/chat-event]
+             :on-response [::events/chat-response]}]
+           (last @effects)))
+    (is (= {:messages [{:role "user" :content "hello there"}] :input "" :status :loading :error nil}
+           (select-keys (chat) [:messages :input :status :error]))))
+  (testing "only one message is in flight, so sending again does nothing"
+    (say! "and another")
+    (is (= 1 (count (requests))))
+    (is (= "and another" (:input (chat)))))
+  (testing "the reply joins the conversation, and the next message carries all of it"
+    (reply! "Hi!")
+    (is (= :idle (:status (chat))))
+    (dispatch! [::events/chat-set-input "how are you"])
+    (dispatch! [::events/chat-send])
+    (is (= [{:role "user" :content "hello there"}
+            {:role "assistant" :content "Hi!"}
+            {:role "user" :content "how are you"}]
+           (get-in (last-request) [:body :messages])))))
+
+(deftest chat-streaming-reply-test
+  (logged-in! [])
+  (say! "hello")
+  (testing "the model's reasoning is not kept, and it keeps waiting"
+    (event! {:thinking "Let me "})
+    (event! {:thinking "think."})
+    (is (= [{:role "user" :content "hello"}] (:messages (chat))))
+    (is (= :loading (:status (chat)))))
+  (testing "the first piece of the reply, and the ones that follow, are added to that message"
+    (event! {:content "Hel"})
+    (is (= [{:role "user" :content "hello"} {:role "assistant" :content "Hel"}]
+           (:messages (chat))))
+    (event! {:content "lo, "})
+    (event! {:content "world"})
+    (is (= [{:role "user" :content "hello"}
+            {:role "assistant" :content "Hello, world"}]
+           (:messages (chat))))
+    (is (= :loading (:status (chat))) "it isn't over until it says so"))
+  (testing "another message can't be sent while the reply is coming in"
+    (say! "and another")
+    (is (= 1 (count (requests)))))
+  (testing "done ends it"
+    (event! {:done true})
+    (is (= {:status :idle :error nil} (select-keys (chat) [:status :error])))
+    (is (= [{:role "user" :content "hello"}
+            {:role "assistant" :content "Hello, world"}]
+           (:messages (chat)))))
+  (testing "events that come after the end are dropped"
+    (event! {:content "late"})
+    (is (= "Hello, world" (:content (last (:messages (chat)))))))
+  (testing "the next message has the conversation so far"
+    (say! "again")
+    (is (= [{:role "user" :content "hello"} {:role "assistant" :content "Hello, world"}
+            {:role "user" :content "again"}]
+           (get-in (last-request) [:body :messages])))))
+
+(deftest chat-thinking-and-text-in-one-event-test
+  (logged-in! [])
+  (say! "hello")
+  (event! {:thinking "hm" :content "Hi"})
+  (event! {:thinking "m" :content "!"})
+  (is (= [{:role "user" :content "hello"} {:role "assistant" :content "Hi!"}]
+         (:messages (chat))))
+  (testing "an empty piece changes nothing"
+    (event! {:thinking "" :content ""})
+    (is (= [{:role "user" :content "hello"} {:role "assistant" :content "Hi!"}]
+           (:messages (chat))))))
+
+(deftest chat-thinking-is-never-kept-test
+  ;; The reasoning of each reply of a turn, before and after tools, leaves nothing in the conversation.
+  (logged-in! [])
+  (say! "hi")
+  (event! {:thinking "first"})
+  (event! {:tool-calls [{:id "c1" :name "ping" :arguments "{}"}]})
+  (event! {:done true})
+  (dispatch! [::events/chat-tool-results [{:id "c1" :name "ping" :content "pong" :error? false}]])
+  (event! {:thinking "second"})
+  (event! {:content "done"})
+  (is (= [["user" nil] ["assistant" nil] ["tool" nil] ["assistant" nil]]
+         (map (juxt :role :thinking) (:messages (chat)))))
+  (is (not-any? #(re-find #"first|second" (pr-str %)) (:messages (chat)))))
+
+(deftest chat-blank-message-test
+  (logged-in! [])
+  (say! "   ")
+  (is (= [] (requests)) "a blank message isn't sent")
+  (is (= [] (:messages (chat)))))
+
+(deftest chat-sends-the-recent-conversation-test
+  (logged-in! [])
+  (swap! rf-db/app-db assoc-in [:chat :messages]
+         (vec (for [i (range 60)] {:role (if (even? i) "user" "assistant") :content (str i)})))
+  (say! "latest")
+  (let [sent (get-in (last-request) [:body :messages])]
+    (is (= 40 (count sent)) "what the server accepts")
+    (is (vector? sent))
+    (is (= "latest" (:content (last sent))))
+    (is (= "21" (:content (first sent))) "the oldest part is what is left out")))
+
+(deftest chat-failure-test
+  (logged-in! [])
+  (say! "hello")
+  (answer! 503 {:error "chat is not configured"})
+  (testing "the message goes back in the input, and the error is shown"
+    (is (= {:messages [] :input "hello" :status :idle :error "chat is not configured"}
+           (select-keys (chat) [:messages :input :status :error]))))
+  (testing "sending again clears the error, and then it can work"
+    (dispatch! [::events/chat-send])
+    (is (nil? (:error (chat))))
+    (reply! "Hi!")
+    (is (= ["hello" "Hi!"] (mapv :content (:messages (chat)))))))
+
+(deftest chat-network-failure-test
+  (logged-in! [])
+  (say! "hello")
+  (dispatch! (conj (:on-response (last-request)) {:ok? false :status nil :body "Failed to fetch"}))
+  (is (= {:messages [] :input "hello" :status :idle :error "Failed to fetch"}
+         (select-keys (chat) [:messages :input :status :error]))))
+
+(deftest chat-failure-in-the-stream-test
+  (testing "before any of the reply: like a request that failed, the message goes back in the input"
+    (logged-in! [])
+    (say! "hello")
+    (event! {:thinking "hmm"})
+    (event! {:error "the LLM server took too long to answer"})
+    (is (= {:messages [] :input "hello" :status :idle :error "the LLM server took too long to answer"}
+           (select-keys (chat) [:messages :input :status :error]))))
+  (testing "in the middle of the reply: what came stays, with the error, and the conversation goes on from it"
+    (logged-in! [])
+    (say! "hello")
+    (event! {:content "Hel"})
+    (event! {:error "the connection was lost"})
+    (is (= {:messages [{:role "user" :content "hello"} {:role "assistant" :content "Hel"}]
+            :input "" :status :idle :error "the connection was lost"}
+           (select-keys (chat) [:messages :input :status :error])))
+    (say! "again")
+    (is (nil? (:error (chat))))
+    (is (= ["hello" "Hel" "again"] (map :content (get-in (last-request) [:body :messages]))))))
+
+(deftest chat-expired-session-test
+  (logged-in! [])
+  (dispatch! [::events/chat-toggle])
+  (say! "hello")
+  (answer! 401 {:error "login required"})
+  (is (= {:status :anonymous} (:user (app-db))) "falls back to the logged-out view")
+  (is (= (assoc (:chat db/default-db) :open? true) (chat)) "the conversation is forgotten, the panel stays open"))
+
+(deftest chat-clear-test
+  (logged-in! [])
+  (say! "hello")
+  (testing "not while a reply is on its way"
+    (dispatch! [::events/chat-clear])
+    (is (= [{:role "user" :content "hello"}] (:messages (chat))))
+    (event! {:content "Hi"})
+    (dispatch! [::events/chat-clear])
+    (is (= 2 (count (:messages (chat))))))
+  (event! {:done true})
+  (dispatch! [::events/chat-toggle])
+  (dispatch! [::events/chat-clear])
+  (is (= (assoc (:chat db/default-db) :open? true) (chat)) "starts over, and the panel stays as it was"))
+
+(deftest chat-resize-test
+  (logged-in! [])
+  (is (= {:width 320 :height 256} (:size (chat))) "the size it starts with")
+  (dispatch! [::events/chat-resize 500 400])
+  (is (= {:width 500 :height 400} (:size (chat))))
+  (testing "the panel keeps its size when the conversation starts over"
+    (say! "hello")
+    (reply! "Hi!")
+    (dispatch! [::events/chat-clear])
+    (is (empty? (:messages (chat))))
+    (is (= {:width 500 :height 400} (:size (chat)))))
+  (testing "and when its owner logs out"
+    (dispatch! [::events/logout])
+    (answer! 200 {:logged-out true})
+    (is (= {:width 500 :height 400} (:size (chat))))))
+
+(deftest chat-forgotten-on-logout-test
+  (logged-in! [])
+  (say! "hello")
+  (reply! "Hi!")
+  (say! "and again")
+  (let [request (last-request)]
+    (event! {:content "partial"})
+    (dispatch! [::events/logout])
+    (answer! 200 {:logged-out true})
+    (is (= (:chat db/default-db) (chat)))
+    (testing "what the stream still delivers is dropped"
+      (dispatch! (conj (:on-event request) {:content "late"}))
+      (dispatch! (conj (:on-event request) {:done true}))
+      (dispatch! (conj (:on-response request) {:ok? false :status 502 :body "{:error \"x\"}"}))
+      (is (= (:chat db/default-db) (chat))))))
+
+;; --- Chat: the LLM uses the page's tools ---
+
+(def ^:private add-schema {:type "object" :properties {:x {:type "number"}} :required ["x"]})
+
+(defn- call [id tool-name arguments]
+  {:id id :name tool-name :arguments arguments})
+
+(defn- tool-calls-asked
+  "What the page was asked to do, by the ::call-tools effects so far: {:page :calls :on-results}."
+  []
+  (mapv second (filter (comp #{::events/call-tools} first) @effects)))
+
+(defn- asks!
+  "The stream delivers a request for `calls`, and ends."
+  [& calls]
+  (event! {:tool-calls (vec calls)})
+  (event! {:done true}))
+
+(defn- ran!
+  "The tools the last request for calls asked for have run, with these results: [id name content
+  error?] each."
+  [& results]
+  (dispatch! (conj (:on-results (last (tool-calls-asked)))
+                   (mapv (fn [[id tool-name content error?]]
+                           {:id id :name tool-name :content content :error? error?})
+                         results))))
+
+(deftest chat-offers-the-tools-test
+  (logged-in! [])
+  (testing "no tools on the page, none offered"
+    (say! "hi")
+    (is (not (contains? (:body (last-request)) :tools))))
+  (testing "the page's tools go along with the conversation, as MCP describes them"
+    (reply! "hello")
+    (model-context/register! [{:name "add" :description "Adds" :input-schema add-schema :handler identity}])
+    (say! "again")
+    (is (= [{:name "add" :description "Adds" :inputSchema add-schema}]
+           (:tools (:body (last-request)))))))
+
+(deftest chat-says-which-page-it-is-on-test
+  (logged-in! [])
+  (testing "the page the user is on goes along with the conversation"
+    (say! "hi")
+    (is (= "games" (:page (:body (last-request))))))
+  (testing "and follows them, or the LLM itself, to the next page"
+    (reply! "hello")
+    (dispatch! [::events/navigate :ai-setup])
+    (say! "again")
+    (is (= "ai-setup" (:page (:body (last-request))))))
+  (testing "a page the LLM opened with its tools is the page its next request comes from"
+    (reply! "hello")
+    (model-context/register! [{:name "go" :description "Opens the todos" :input-schema add-schema
+                               :handler identity}])
+    (say! "go to the todos")
+    (asks! (call "c1" "go" "{}"))
+    (dispatch! [::events/navigate :todos]) ; what the tool did
+
+    (ran! ["c1" "go" "ok" false])
+    (is (= "todos" (:page (:body (last-request)))))))
+
+(deftest chat-offers-the-tools-of-the-page-test
+  (logged-in! [])
+  (model-context/register! [{:name "ping" :description "Pings" :input-schema add-schema :handler identity}
+                            {:name "add" :pages #{:games} :description "Adds" :input-schema add-schema :handler identity}
+                            {:name "list_todos" :pages #{:todos} :description "Lists" :input-schema add-schema
+                             :handler identity}])
+  (let [offered (fn [] (map :name (:tools (:body (last-request)))))]
+    (testing "on a page, its tools and those of every page are offered"
+      (say! "hi")
+      (is (= :games (:page (app-db))))
+      (is (= ["ping" "add"] (offered))))
+    (testing "the tools follow the page the user is on when the message is sent"
+      (reply! "hello")
+      (dispatch! [::events/navigate :todos])
+      (say! "again")
+      (is (= ["ping" "list_todos"] (offered))))
+    (testing "a page with no tools of its own is offered the tools of every page"
+      (reply! "hello")
+      (dispatch! [::events/navigate :ai-setup])
+      (say! "once more")
+      (is (= ["ping"] (offered))))))
+
+(deftest chat-tool-calls-go-by-the-page-test
+  (logged-in! [])
+  (model-context/register! [{:name "add" :pages #{:games} :description "Adds" :input-schema add-schema :handler identity}])
+  (dispatch! [::events/navigate :todos])
+  (say! "1+2?")
+  (asks! (call "c1" "add" "{}"))
+  (testing "the calls are made on the tools of the page the user is on, not those of the first page"
+    (is (= [:todos] (map :page (tool-calls-asked)))))
+  (testing "the follow-up request follows the page too: the user may have gone elsewhere meanwhile"
+    (dispatch! [::events/navigate :games])
+    (ran! ["c1" "add" "tool not available on this page: add" true])
+    (is (= ["add"] (map :name (:tools (:body (last-request))))))))
+
+(deftest chat-tool-call-test
+  (logged-in! [])
+  (model-context/register! [{:name "add" :description "Adds" :input-schema add-schema :handler identity}])
+  (say! "1+2?")
+  (testing "while the model reasons or writes a call, nothing is done, and the conversation has neither"
+    (event! {:thinking "I should add."})
+    (event! {:tool-calls [(call "c1" "add" "{\"x\":1,\"y\":2}")]})
+    (is (= [{:role "user" :content "1+2?"}] (:messages (chat))))
+    (is (= [] (tool-calls-asked))))
+  (testing "when the reply is over, the calls join the conversation and are made"
+    (event! {:done true})
+    (is (= [{:role "user" :content "1+2?"}
+            {:role "assistant" :content ""
+             :tool-calls [(call "c1" "add" "{\"x\":1,\"y\":2}")]}]
+           (:messages (chat))))
+    (is (= :loading (:status (chat))) "the LLM still has to answer")
+    (is (= [{:page :games :calls [(call "c1" "add" "{\"x\":1,\"y\":2}")] :on-results [::events/chat-tool-results]}]
+           (tool-calls-asked)))
+    (is (= 1 (count (requests))) "nothing is sent while the tools run"))
+  (testing "another message can't be sent meanwhile"
+    (say! "and another")
+    (is (= 1 (count (requests)))))
+  (testing "the results join the conversation, and go to the LLM, calls and all"
+    (ran! ["c1" "add" "3" false])
+    (is (= {:role "tool" :tool-call-id "c1" :name "add" :content "3" :error? false}
+           (last (:messages (chat)))))
+    (is (= 2 (count (requests))))
+    (is (= [{:role "user" :content "1+2?"}
+            {:role "assistant" :content "" :tool-calls [(call "c1" "add" "{\"x\":1,\"y\":2}")]}
+            {:role "tool" :tool-call-id "c1" :content "3"}]
+           (get-in (last-request) [:body :messages])) "as the server has them: only what the LLM needs")
+    (is (= 1 (count (:tools (:body (last-request))))) "and the tools are still on offer"))
+  (testing "the answer is a new message, and ends it"
+    (reply! "It's " "3.")
+    (is (= [{:role "assistant" :content "It's 3."}] (take-last 1 (:messages (chat)))))
+    (is (= {:status :idle :error nil} (select-keys (chat) [:status :error])))
+    (is (nil? (:pending-calls (chat))))))
+
+(deftest chat-tool-call-with-text-test
+  (logged-in! [])
+  (say! "hi")
+  (event! {:content "Let me "})
+  (event! {:content "check."})
+  (asks! (call "a" "ping" "{}") (call "b" "whoami" ""))
+  (testing "the calls are made on the message that says what it does, in order"
+    (is (= [{:role "user" :content "hi"}
+            {:role "assistant" :content "Let me check."
+             :tool-calls [(call "a" "ping" "{}") (call "b" "whoami" "")]}]
+           (:messages (chat))))
+    (is (= [(call "a" "ping" "{}") (call "b" "whoami" "")] (:calls (last (tool-calls-asked))))))
+  (testing "their results follow in the same order, one message each"
+    (ran! ["a" "ping" "pong" false] ["b" "whoami" "not logged in" false])
+    (is (= [["tool" "a"] ["tool" "b"]]
+           (map (juxt :role :tool-call-id) (take-last 2 (:messages (chat))))))))
+
+(deftest chat-tool-calls-go-on-test
+  (logged-in! [])
+  (say! "do it")
+  (testing "the LLM may ask again after the results, and again, until it answers"
+    (asks! (call "a" "ping" "{}"))
+    (ran! ["a" "ping" "pong" false])
+    (asks! (call "b" "ping" "{}"))
+    (ran! ["b" "ping" "pong" false])
+    (is (= 3 (count (requests))))
+    (is (= :loading (:status (chat))))
+    (reply! "Done.")
+    (is (= ["user" "assistant" "tool" "assistant" "tool" "assistant"] (map :role (:messages (chat)))))
+    (is (= :idle (:status (chat)))))
+  (testing "a new message starts a new turn, with all the calls it may make"
+    (dispatch! [::events/chat-set-input "again"])
+    (dispatch! [::events/chat-send])
+    (is (zero? (:tool-calls-used (chat))))))
+
+(deftest chat-tool-call-budget-test
+  (logged-in! [])
+  (say! "go wild")
+  (testing "a turn may make 12 calls, as many rounds as it takes"
+    (dotimes [i 4]
+      (asks! (call (str "a" i) "ping" "{}") (call (str "b" i) "ping" "{}") (call (str "c" i) "ping" "{}"))
+      (ran! [(str "a" i) "ping" "pong" false] [(str "b" i) "ping" "pong" false] [(str "c" i) "ping" "pong" false]))
+    (is (= 12 (:tool-calls-used (chat))))
+    (is (= :loading (:status (chat))))
+    (is (= 5 (count (requests))))
+    (is (<= (count (get-in (last-request) [:body :messages])) 40) "and it all still fits what the server takes"))
+  (testing "one more is too many: it is answered, but not made, and the turn is over"
+    (asks! (call "z" "ping" "{}"))
+    (is (= 4 (count (tool-calls-asked))) "no more asked of the page")
+    (is (= 5 (count (requests))) "nor of the LLM")
+    (is (= {:role "tool" :tool-call-id "z" :name "ping" :content "not run: too many tool calls in one turn"
+            :error? true}
+           (last (:messages (chat)))) "the conversation stays whole: every call has its answer")
+    (is (= "assistant" (:role (nth (:messages (chat)) (- (count (:messages (chat))) 2)))))
+    (is (= {:status :idle :error "The assistant made too many tool calls in a row, so it was stopped."}
+           (select-keys (chat) [:status :error]))))
+  (testing "the next message goes on from there"
+    (say! "ok, stop")
+    (is (nil? (:error (chat))))
+    (is (zero? (:tool-calls-used (chat))))
+    (is (= "user" (:role (last (get-in (last-request) [:body :messages])))))))
+
+(deftest chat-tool-results-nobody-waits-for-test
+  (logged-in! [])
+  (say! "hi")
+  (asks! (call "a" "ping" "{}"))
+  (let [asked (last (tool-calls-asked))]
+    (testing "results for other calls than the ones asked for are dropped"
+      (dispatch! (conj (:on-results asked) [{:id "other" :name "ping" :content "pong" :error? false}]))
+      (is (= 1 (count (requests))))
+      (is (= "assistant" (:role (last (:messages (chat)))))))
+    (testing "and so are results that come when the conversation was reset meanwhile"
+      (dispatch! [::events/logout])
+      (answer! 200 {:logged-out true})
+      (dispatch! (conj (:on-results asked) [{:id "a" :name "ping" :content "pong" :error? false}]))
+      (is (= 1 (count (filter #(= "/api/chat" (:uri %)) (requests)))) "nothing more went to the LLM")
+      (is (= (:chat db/default-db) (chat))))))
+
+(deftest chat-tool-results-are-answered-once-test
+  (logged-in! [])
+  (say! "hi")
+  (asks! (call "a" "ping" "{}"))
+  (ran! ["a" "ping" "pong" false])
+  (ran! ["a" "ping" "pong" false])
+  (is (= 2 (count (requests))) "the same results again change nothing")
+  (is (= 3 (count (:messages (chat))))))
+
+(deftest chat-failure-after-tools-test
+  (logged-in! [])
+  (say! "hi")
+  (asks! (call "a" "ping" "{}"))
+  (testing "the LLM can't be reached with the results: they stay, and the error is shown"
+    (ran! ["a" "ping" "pong" false])
+    (answer! 502 {:error "the LLM server can't be reached"})
+    (is (= ["user" "assistant" "tool"] (map :role (:messages (chat)))) "no message goes back in the input")
+    (is (= {:input "" :status :idle :error "the LLM server can't be reached"}
+           (select-keys (chat) [:input :status :error]))))
+  (testing "the conversation goes on from there"
+    (say! "hello?")
+    (is (= ["user" "assistant" "tool" "user"] (map :role (get-in (last-request) [:body :messages]))))))
+
+(deftest chat-failure-with-calls-coming-test
+  (logged-in! [])
+  (say! "hi")
+  (event! {:tool-calls [(call "a" "ping" "{}")]})
+  (event! {:error "the connection was lost"})
+  (testing "calls that never got to be made are forgotten, like any reply that didn't come"
+    (is (= {:messages [] :input "hi" :status :idle :error "the connection was lost" :pending-calls nil}
+           (select-keys (chat) [:messages :input :status :error :pending-calls])))
+    (is (= [] (tool-calls-asked)))))
+
+(deftest chat-sends-no-orphaned-result-test
+  (logged-in! [])
+  ;; The oldest message is the one that asked for the call whose result comes next, and it is what
+  ;; falls out of the 40 that are sent.
+  (swap! rf-db/app-db assoc-in [:chat :messages]
+         (into [{:role "assistant" :content "" :tool-calls [(call "old" "ping" "{}")]}
+                {:role "tool" :tool-call-id "old" :name "ping" :content "pong" :error? false}]
+               (for [i (range 38)] {:role (if (even? i) "user" "assistant") :content (str i)})))
+  (say! "latest")
+  (let [sent (get-in (last-request) [:body :messages])]
+    (is (= "user" (:role (first sent))) "a result the LLM can't match to a call would be refused")
+    (is (= "0" (:content (first sent))))
+    (is (= "latest" (:content (last sent))))))
+
+(deftest call-tools-effect-page-test
+  ;; The real effect: a tool is called only on a page that offers it.
+  (let [call-tools-fx (tu/real-effect ::events/call-tools)
+        answer (atom nil)]
+    (rf/reg-event-fx ::ran (fn [_ [_ results]] (@answer results) {}))
+    (model-context/register!
+      [{:name "games-only" :pages #{:games} :description "d" :input-schema add-schema :handler (fn [_] "played")}
+       {:name "anywhere" :description "d" :input-schema add-schema :handler (fn [_] "ok")}])
+    (async done
+      (tu/finish
+        (tu/steps
+          #(js/Promise. (fn [resolve]
+                          (reset! answer resolve)
+                          (call-tools-fx {:page :todos
+                                          :calls [(call "1" "games-only" "{}") (call "2" "anywhere" "{}")]
+                                          :on-results [::ran]})))
+          (fn [results]
+            (is (= [["tool not available on this page: games-only (it is offered on the games page)" true]
+                    ["ok" false]]
+                   (map (juxt :content (comp boolean :error?)) results))))
+          #(js/Promise. (fn [resolve]
+                          (reset! answer resolve)
+                          (call-tools-fx {:page :games :calls [(call "1" "games-only" "{}")] :on-results [::ran]})))
+          (fn [results] (is (= ["played"] (map :content results)))))
+        done))))
+
+(deftest call-tools-effect-test
+  ;; The real effect, on real tools; the results are dispatched to ::ran.
+  (let [call-tools-fx (tu/real-effect ::events/call-tools)
+        order (atom [])
+        answer (atom nil)]
+    (rf/reg-event-fx ::ran (fn [_ [_ results]] (@answer results) {}))
+    (model-context/register!
+      [{:name "slow" :description "d" :input-schema add-schema
+        :handler (fn [_] (js/Promise. (fn [resolve] (js/setTimeout #(do (swap! order conj :slow) (resolve "slow done")) 20))))}
+       {:name "fast" :description "d" :input-schema add-schema
+        :handler (fn [args] (swap! order conj :fast) (str "fast " (pr-str args)))}
+       {:name "huge" :description "d" :input-schema add-schema :handler (fn [_] (apply str (repeat 9000 "x")))}
+       {:name "blank" :description "d" :input-schema add-schema :handler (fn [_] "  ")}
+       {:name "fails" :description "d" :input-schema add-schema :handler (fn [_] (throw (js/Error. "it broke")))}])
+    (async done
+      (tu/finish
+        (tu/steps
+          #(js/Promise. (fn [resolve]
+                          (reset! answer resolve)
+                          (call-tools-fx {:calls [(call "1" "slow" "{}")
+                                                  (call "2" "fast" "{\"x\":1}")
+                                                  (call "3" "huge" "{}")
+                                                  (call "4" "blank" "")
+                                                  (call "5" "fails" "{}")
+                                                  (call "6" "nope" "{}")
+                                                  (call "7" "fast" "oops")]
+                                          :on-results [::ran]})))
+          (fn [results]
+            (testing "one after the other, in order: the tools work on the same page"
+              (is (= [:slow :fast] @order)))
+            (testing "a result for each call, whatever became of it"
+              (is (= ["1" "2" "3" "4" "5" "6" "7"] (map :id results)))
+              (is (= ["slow" "fast" "huge" "blank" "fails" "nope" "fast"] (map :name results)))
+              (is (= ["slow done" "fast {:x 1}"] (map :content (take 2 results)))))
+            (testing "a result is never empty, and never longer than the server takes"
+              (is (= "(no output)" (:content (nth results 3))))
+              (is (= 8000 (count (:content (nth results 2)))))
+              (is (= "xxx … (truncated)" (subs (:content (nth results 2)) 7983))))
+            (testing "failures are results for the LLM to read"
+              (is (= [false false false false true true true] (map (comp boolean :error?) results)))
+              (is (= ["it broke" "unknown tool: nope" "invalid arguments: they must be a JSON object"]
+                     (map :content (drop 4 results))))))
+          #(js/Promise. (fn [resolve]
+                          (reset! answer resolve)
+                          (call-tools-fx {:calls [] :on-results [::ran]})))
+          (fn [results] (is (= [] results) "no calls, no results")))
+        done))))
+
 ;; --- MCP setup ---
 
 (deftest copy-mcp-command-test

ui/test/tbd/ui/fetch_stream_test.cljs

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

ui/test/tbd/ui/model_context_test.cljs

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

ui/test/tbd/ui/sse_test.cljs

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

ui/test/tbd/ui/test_util.cljs

@@ -22,12 +22,30 @@
 ;; --- A fake server ---
 
 (def server
-  "What the fake server holds: {:user nil-or-{:login ..}, :todos [..], :next-id n, :add-error msg}."
+  "What the fake server holds: {:user nil-or-{:login ..}, :todos [..], :next-id n, :add-error msg,
+  :chat-error msg, :chats [the conversations it was sent], :chat-requests [the whole requests],
+  :chat-scripts [..], :chat-script [..], :resume fn}. Its LLM says \"echo: \" and the last message,
+  streaming it in pieces. `:chat-script`, if set, is what it streams instead: events (maps, as the
+  real server sends them) and :pause, where the stream stops until the test calls the `:resume` fn
+  the server then holds. `:chat-scripts` are scripts for the next requests, one each, first
+  come first served (a conversation that goes back and forth, as when the LLM uses tools)."
   (atom nil))
 
 (defn- respond [status body]
   {:status status :body (pr-str body)})
 
+(defn- respond-stream
+  "A 200 whose body is the server-sent events of `script` (events and :pause)."
+  [script]
+  {:status 200 :script script})
+
+(defn- next-chat-script!
+  "The next of the server's `:chat-scripts`, which it is then rid of, or nil."
+  []
+  (when-let [script (first (:chat-scripts @server))]
+    (swap! server update :chat-scripts subvec 1)
+    script))
+
 (defn- route [method uri body]
   (let [{:keys [user todos]} @server
         todo-id (some->> (re-find #"^/api/todos/(\d+)$" uri) second js/parseInt)]
@@ -41,6 +59,17 @@
           (respond 400 {:error error :details {:x ["is wrong"]}})
           (respond 200 {:result (+ (js/parseFloat x) (js/parseFloat y))})))
       (not user) (respond 401 {:error "not logged in"})
+      (and (= "POST" method) (= "/api/chat" uri))
+      (if-let [error (:chat-error @server)]
+        (respond 502 {:error error})
+        (do (swap! server update :chats (fnil conj []) (:messages body))
+            (swap! server update :chat-requests (fnil conj []) body)
+            (respond-stream (or (next-chat-script!)
+                                (:chat-script @server)
+                                [{:thinking "Reading the message."}
+                                 {:content "echo: "}
+                                 {:content (:content (last (:messages body)))}
+                                 {:done true}]))))
       (and (= "GET" method) (= "/api/todos" uri)) (respond 200 {:todos todos})
       (and (= "POST" method) (= "/api/todos" uri))
       (if (seq (.trim (:title body)))
@@ -60,11 +89,45 @@
           (respond 200 {:deleted true}))
       :else (respond 404 {:error "not found"}))))
 
+(def ^:private piece-size
+  "How many bytes of a stream the fake server delivers at a time: few, so events are cut anywhere,
+  even in the middle of a character, as the network may."
+  7)
+
+(defn- script-items
+  "The script's events as the pieces of bytes that arrive, and :pause where the stream waits."
+  [script]
+  (mapcat (fn [step]
+            (if (= :pause step)
+              [:pause]
+              (let [bytes (.encode (js/TextEncoder.)
+                                   (str "data: " (js/JSON.stringify (clj->js step)) "\n\n"))]
+                (for [i (range 0 (.-length bytes) piece-size)]
+                  (.subarray bytes i (min (.-length bytes) (+ i piece-size)))))))
+          script))
+
+(defn- stream-reader
+  "What `response.body.getReader()` gives for a stream of `script`: `read` resolves with a piece
+  of bytes at a time, then with done. At a :pause it waits for the fn the server holds as :resume."
+  [script]
+  (let [items (atom (script-items script))]
+    (letfn [(read []
+              (let [item (first @items)]
+                (swap! items rest)
+                (cond
+                  (nil? item) (js/Promise.resolve #js {:done true})
+                  (= :pause item) (js/Promise. (fn [resolve]
+                                                 (swap! server assoc :resume #(resolve (read)))))
+                  :else (js/Promise.resolve #js {:done false :value item}))))]
+      #js {:read read})))
+
 (defn fake-fetch [uri opts]
   (let [opts (js->clj opts :keywordize-keys true)
-        {:keys [status body]} (route (:method opts) uri (some-> (:body opts) reader/read-string))]
+        {:keys [status body script]} (route (:method opts) uri (some-> (:body opts) reader/read-string))]
     (js/Promise.resolve
-      #js {:ok (< status 300) :status status :text (fn [] (js/Promise.resolve body))})))
+      #js {:ok (< status 300) :status status
+           :text (fn [] (js/Promise.resolve body))
+           :body #js {:getReader (fn [] (stream-reader script))}})))
 
 (def ^:private real-fetch (.-fetch js/globalThis))
 

ui/test/tbd/ui/views_test.cljs

@@ -7,6 +7,7 @@
             [re-frame.db :as rf-db]
             [tbd.ui.db :as db]
             [tbd.ui.events :as events]
+            [tbd.ui.model-context :as model-context]
             [tbd.ui.pages :as pages]
             [tbd.ui.test-util :as tu :refer [q q-all text shows steps click! type! submit!]]
             [tbd.ui.views :as views]
@@ -467,3 +468,476 @@
           (is (= "Log in" (text "section p a")))
           (is (= "/auth/login" (.getAttribute (q "section p a") "href")))))
       done)))
+
+;; --- Chat widget ---
+
+(defn- panel [] (q "[role=dialog]"))
+
+(defn- chat-messages
+  "What the conversation shows, message by message."
+  []
+  (mapv #(.-textContent %) (q-all "[role=log] > div:not([role=status]):not([data-tool])")))
+
+(defn- chat-tool-lines
+  "The tool calls and results the conversation shows, line by line."
+  []
+  (mapv #(.-textContent %) (q-all "[role=log] > div[data-tool]")))
+
+(deftest chat-widget-test
+  ;; A green square in the bottom left corner, opposite WebMCP's blue one; it opens the panel.
+  (async done
+    (tu/finish
+      (steps
+        #(log-in-page! [])
+        (fn []
+          (let [square (q "button[aria-label=Chat]")
+                style (.-style square)]
+            (is (= "fixed" (.. square -parentElement -style -position)))
+            (is (= ["20px" "20px"] [(.. square -parentElement -style -left) (.. square -parentElement -style -bottom)])
+                "bottom left")
+            (is (= "rgb(40, 167, 69)" (.-backgroundColor style)) "green")
+            (is (= "false" (.getAttribute square "aria-expanded")))
+            (is (nil? (panel)) "the panel starts closed")
+            (click! square)))
+        #(tu/eventually panel)
+        (fn [_]
+          (is (= "true" (.getAttribute (q "button[aria-label=Chat]") "aria-expanded")))
+          (is (= "Ask me anything." (text "[role=log] p")))
+          (is (nil? (q "[role=alert]")))
+          (click! (q "button[aria-label=Chat]")))
+        #(tu/eventually (fn [] (nil? (panel))))
+        (fn [_]
+          (is true "the square closes it again")
+          (click! (q "button[aria-label=Chat]")))
+        #(tu/eventually panel)
+        (fn [_]
+          (click! (q "button[aria-label=\"Close chat\"]")))
+        #(tu/eventually (fn [] (nil? (panel)))))
+      done)))
+
+(deftest chat-conversation-test
+  (async done
+    (tu/finish
+      (steps
+        #(log-in-page! [])
+        (fn [] (click! (q "button[aria-label=Chat]")))
+        #(tu/eventually (fn [] (q "input[name=message]")))
+        (fn [input]
+          (is (true? (.-disabled (q "[role=dialog] button[type=submit]"))) "nothing to send yet")
+          (type! input "hello")
+          (tu/eventually (fn [] (false? (.-disabled (q "[role=dialog] button[type=submit]"))))))
+        (fn [_]
+          (submit! (q "[role=dialog] form"))
+          (tu/eventually (fn [] (= ["hello" "echo: hello"] (chat-messages)))))
+        (fn [_]
+          (is (= "" (.-value (q "input[name=message]"))) "the input is emptied when sent")
+          (is (nil? (q "[role=status]")) "no longer thinking")
+          (is (= ["Clear" "×"] (mapv #(.-textContent %) (q-all "[role=dialog] > div:first-child button"))))
+          (type! (q "input[name=message]") "again")
+          (tu/eventually (fn [] (= "again" (.-value (q "input[name=message]"))))))
+        (fn [_]
+          (submit! (q "[role=dialog] form"))
+          (tu/eventually (fn [] (= 4 (count (chat-messages))))))
+        (fn [_]
+          (is (= [[{:role "user" :content "hello"}]
+                  [{:role "user" :content "hello"}
+                   {:role "assistant" :content "echo: hello"}
+                   {:role "user" :content "again"}]]
+                 (:chats @tu/server))
+              "each message carries the conversation so far")
+          (click! (first (filter #(= "Clear" (.-textContent %)) (q-all "[role=dialog] button")))))
+        #(tu/eventually (fn [] (= "Ask me anything." (text "[role=log] p"))))
+        (fn [_]
+          (is (empty? (chat-messages)) "cleared")))
+      done)))
+
+(deftest chat-thinking-test
+  ;; While the reply is on its way the page says so, and the input can't take another message.
+  (async done
+    (let [release (atom nil)
+          fake-fetch (aget js/globalThis "fetch")]
+      (aset js/globalThis "fetch"
+            (fn [uri opts]
+              (if (= "/api/chat" uri)
+                (js/Promise. (fn [resolve] (reset! release #(resolve (fake-fetch uri opts)))))
+                (fake-fetch uri opts))))
+      (tu/finish
+        (steps
+          #(log-in-page! [])
+          (fn [] (click! (q "button[aria-label=Chat]")))
+          #(tu/eventually (fn [] (q "input[name=message]")))
+          (fn [input] (type! input "hello") (tu/eventually #(= "hello" (.-value input))))
+          (fn [_] (submit! (q "[role=dialog] form")))
+          #(tu/eventually (fn [] (q "[role=status]")))
+          (fn [_]
+            (is (= "Thinking…" (text "[role=status]")))
+            (is (= ["hello"] (chat-messages)))
+            (is (true? (.-readOnly (q "input[name=message]"))))
+            (is (true? (.-disabled (q "[role=dialog] button[type=submit]"))))
+            (is (nil? (first (filter #(= "Clear" (.-textContent %)) (q-all "[role=dialog] button"))))
+                "can't start over mid-reply")
+            (@release))
+          #(tu/eventually (fn [] (nil? (q "[role=status]"))))
+          (fn [_]
+            (is (= ["hello" "echo: hello"] (chat-messages)))
+            (is (false? (.-readOnly (q "input[name=message]"))))))
+        done))))
+
+(defn- send-chat!
+  "Types `text` into the chat's input and sends it; a promise, which resolves once it was sent."
+  [text]
+  (tu/steps
+    (fn [] (tu/eventually (fn [] (q "input[name=message]"))))
+    (fn [input] (type! input text) (tu/eventually #(= text (.-value input))))
+    (fn [_] (submit! (q "[role=dialog] form")))))
+
+(defn- resume-stream!
+  "Lets the fake server's stream go on from its pause (see tu/server)."
+  []
+  (let [resume (:resume @tu/server)]
+    (swap! tu/server dissoc :resume)
+    (resume)))
+
+(defn- panel-text
+  "Everything the chat panel shows, as text."
+  []
+  (.-textContent (panel)))
+
+(deftest chat-streaming-test
+  ;; The reply shows as it arrives: "Thinking…" until the model's first word (however long it
+  ;; reasons, which is never shown), then the reply growing piece by piece, and only at its end can
+  ;; another message be sent.
+  (async done
+    (swap! tu/server assoc :chat-script [:pause
+                                         {:thinking "Let me "} {:thinking "think."} :pause
+                                         {:content "Hel"} {:content "lo"} :pause
+                                         {:content ", world"} {:done true}])
+    (tu/finish
+      (tu/steps
+        #(log-in-page! [])
+        (fn [] (click! (q "button[aria-label=Chat]")))
+        #(send-chat! "hi")
+        #(tu/eventually (fn [] (and (:resume @tu/server) (q "[role=status]"))))
+        (fn [_]
+          (is (= "Thinking…" (text "[role=status]")))
+          (is (= ["hi"] (chat-messages)) "nothing of the reply yet")
+          (resume-stream!))
+        #(tu/eventually (fn [] (:resume @tu/server)))
+        (fn [_]
+          (is (= "Thinking…" (text "[role=status]")) "still thinking while the model reasons")
+          (is (not (str/includes? (panel-text) "Let me think.")) "and what it reasons is not shown")
+          (is (= ["hi"] (chat-messages)) "it hasn't said anything")
+          (is (true? (.-readOnly (q "input[name=message]"))) "and it isn't over")
+          (resume-stream!))
+        #(tu/eventually (fn [] (and (:resume @tu/server) (= ["hi" "Hello"] (chat-messages)))))
+        (fn [_]
+          (is (nil? (q "[role=status]")) "the model has begun to answer")
+          (is (true? (.-readOnly (q "input[name=message]"))) "but it isn't over")
+          (is (true? (.-disabled (q "[role=dialog] button[type=submit]"))))
+          (resume-stream!))
+        #(tu/eventually (fn [] (= ["hi" "Hello, world"] (chat-messages))))
+        #(tu/eventually (fn [] (false? (.-readOnly (q "input[name=message]")))))
+        (fn [_]
+          (is (not (str/includes? (panel-text) "Let me think.")) "the reasoning is not shown after it either")
+          (is (nil? (q "[role=status]")))
+          (is (nil? (q "[role=dialog] [role=alert]")))))
+      done)))
+
+(deftest chat-reasoning-is-never-shown-test
+  ;; Neither while it comes nor in the finished conversation, in any element of the panel.
+  (async done
+    (let [thought "secret reasoning about the answer"]
+      (swap! tu/server assoc :chat-script [{:thinking thought} {:content "Done."} {:done true}])
+      (tu/finish
+        (tu/steps
+          #(log-in-page! [])
+          (fn [] (click! (q "button[aria-label=Chat]")))
+          #(send-chat! "hi")
+          #(tu/eventually (fn [] (= ["hi" "Done."] (chat-messages))))
+          (fn [_]
+            (is (not (str/includes? (panel-text) "secret")))))
+        done))))
+
+(defn- pointer!
+  "Fires a pointer event of `type` at `target`, at (`x`, `y`)."
+  [target type x y]
+  (.dispatchEvent target (js/window.MouseEvent. type #js {:bubbles true :clientX x :clientY y :button 0})))
+
+(defn- chat-size [] (:size (:chat @rf-db/app-db)))
+
+(defn- drag-to!
+  "Moves the pointer to (`x`, `y`), and waits for the panel to have `size` by it."
+  [x y size]
+  (pointer! js/window "pointermove" x y)
+  (tu/eventually (fn [] (= size (chat-size)))))
+
+(deftest chat-resize-test
+  ;; The panel is stuck to the bottom left corner, so dragging its top right corner out is what
+  ;; makes it bigger: right for wider, up for higher. Every drag is from the size it began with.
+  (async done
+    (tu/finish
+      (tu/steps
+        #(log-in-page! [])
+        (fn [] (click! (q "button[aria-label=Chat]")))
+        #(tu/eventually panel)
+        (fn [_]
+          (is (= "320px" (.. (panel) -style -width)))
+          (is (= "256px" (.. (q "[role=log]") -style -height)))
+          (is (= "Resize chat" (.getAttribute (q "[role=separator]") "aria-label")))
+          (pointer! (q "[role=separator]") "pointerdown" 300 300))
+        #(drag-to! 350 260 {:width 370 :height 296})
+        #(tu/eventually (fn [] (= ["370px" "296px"] [(.. (panel) -style -width) (.. (q "[role=log]") -style -height)])))
+        (fn [_] (is true "right 50, up 40"))
+        #(drag-to! 280 380 {:width 300 :height 176})
+        #(drag-to! -900 900 {:width 260 :height 96})
+        (fn [_] (is true "not smaller than is usable"))
+        #(drag-to! 9000 -9000 {:width (- js/window.innerWidth 40) :height (- js/window.innerHeight 220)})
+        (fn [_] (is true "not bigger than the window"))
+        #(drag-to! 400 300 {:width 420 :height 256})
+        (fn [_]
+          (pointer! js/window "pointerup" 400 300)
+          (pointer! js/window "pointermove" 900 100)
+          (js/Promise. (fn [resolve] (js/setTimeout resolve 20))))
+        (fn [_]
+          (is (= {:width 420 :height 256} (chat-size)) "once let go, the pointer no longer resizes")
+          (click! (q "button[aria-label=\"Close chat\"]")))
+        #(tu/eventually (fn [] (nil? (panel))))
+        (fn [_] (click! (q "button[aria-label=Chat]")))
+        #(tu/eventually panel)
+        (fn [_]
+          (is (= "420px" (.. (panel) -style -width)) "the size is kept while it is closed")))
+      done)))
+
+(defn- fake-scroll!
+  "jsdom doesn't lay anything out: give `el` the sizes of a conversation of 1000px in a window of
+  100px, and a scroll position that stays where it is put."
+  [el]
+  (let [top (atom 0)]
+    (js/Object.defineProperty el "scrollHeight" #js {:get (fn [] 1000)})
+    (js/Object.defineProperty el "clientHeight" #js {:get (fn [] 100)})
+    (js/Object.defineProperty el "scrollTop" #js {:get (fn [] @top) :set (fn [v] (reset! top v))})
+    top))
+
+(deftest chat-scrollback-test
+  ;; The conversation follows its end while it is scrolled to it, but scrolling up to read back
+  ;; is left alone, even as the reply keeps coming; sending a message goes back to the end.
+  (async done
+    (swap! tu/server assoc :chat-script [{:content "one"} :pause
+                                         {:content " two"} :pause
+                                         {:content " three"} {:done true}])
+    (let [top (atom nil)
+          resume! (fn []
+                    (let [resume (:resume @tu/server)]
+                      (swap! tu/server dissoc :resume)
+                      (resume)))]
+      (tu/finish
+        (tu/steps
+          #(log-in-page! [])
+          (fn [] (click! (q "button[aria-label=Chat]")))
+          #(tu/eventually (fn [] (q "[role=log]")))
+          (fn [log] (reset! top (fake-scroll! log)))
+          #(send-chat! "hi")
+          #(tu/eventually (fn [] (and (:resume @tu/server) (= ["hi" "one"] (chat-messages)))))
+          (fn [_]
+            (is (= 1000 @@top) "at the end, it follows the end")
+            (reset! @top 200)
+            (.dispatchEvent (q "[role=log]") (js/window.Event. "scroll"))
+            (resume!))
+          #(tu/eventually (fn [] (= ["hi" "one two"] (chat-messages))))
+          (fn [_]
+            (is (= 200 @@top) "scrolled up, the reply coming in doesn't pull it down")
+            (reset! @top 890)
+            (.dispatchEvent (q "[role=log]") (js/window.Event. "scroll"))
+            (resume!))
+          #(tu/eventually (fn [] (= ["hi" "one two three"] (chat-messages))))
+          (fn [_]
+            (is (= 1000 @@top) "back near the end, it follows again")
+            (reset! @top 200)
+            (.dispatchEvent (q "[role=log]") (js/window.Event. "scroll")))
+          #(tu/eventually (fn [] (false? (.-readOnly (q "input[name=message]")))))
+          #(send-chat! "again")
+          #(tu/eventually (fn [] (and (:resume @tu/server) (= 1000 @@top))))
+          (fn [_]
+            (is (= 1000 @@top) "sending a message goes back to the end, wherever it was")
+            (resume!))
+          #(tu/eventually (fn [] (:resume @tu/server)))
+          (fn [_] (resume!)))
+        done))))
+
+(deftest chat-tools-test
+  ;; The LLM asks for the page's own tools: the page calls them, so it shows on the page, and the
+  ;; results go back to the LLM for its answer.
+  (async done
+    (model-context/register! webmcp/tools)
+    (swap! tu/server assoc :chat-scripts
+           [[{:content "I'll add them."}
+             {:tool-calls [{:id "call_1" :name "add" :arguments "{\"x\":2,\"y\":3}"}]}
+             {:done true}]
+            [{:content "2 + 3 is 5."} {:done true}]])
+    (tu/finish
+      (-> (tu/steps
+            #(log-in-page! [])
+            ;; The calculator's tools are offered on the games page.
+            (fn [] (rf/dispatch-sync [::events/navigate :games]))
+            (fn [] (click! (q "button[aria-label=Chat]")))
+            #(send-chat! "what is 2 + 3? use the calculator")
+            #(tu/eventually (fn [] (= ["what is 2 + 3? use the calculator" "I'll add them." "2 + 3 is 5."]
+                                      (chat-messages))))
+            (fn [_]
+              (testing "the LLM was told about the tools of the page it was on (the games), not all of them"
+                (is (= (set (map :name (filter #(contains? (or (:pages %) #{:games}) :games) webmcp/tools)))
+                       (set (map :name (:tools (first (:chat-requests @tu/server))))))))
+              (testing "the page made the call, as a user would: the calculator holds what was typed and its sum"
+                (is (= {:x "2" :y "3" :result {:status :ok :x "2" :y "3" :sum 5}}
+                       (:calc @rf-db/app-db))))
+              (testing "the call and its result show in the conversation, between what was said"
+                (is (= ["Calling add {\"x\":2,\"y\":3}…" "add → {\"x\":2,\"y\":3,\"sum\":5}"]
+                       (chat-tool-lines)))
+                (testing "the lines are shown whole: wrapped, not cut off"
+                  (doseq [line (q-all "[data-tool]")]
+                    (is (= "pre-wrap" (.. line -style -whiteSpace)))
+                    (is (= "" (.. line -style -textOverflow)))
+                    (is (not= "hidden" (.. line -style -overflow)))
+                    (is (nil? (.getAttribute line "title")) "no tooltip: there is nothing hidden")))
+                (is (= ["user" "assistant" "tool" "assistant"] (map :role (:messages (:chat @rf-db/app-db))))))
+              (testing "the second request took the result to the LLM"
+                (is (= [{:role "user" :content "what is 2 + 3? use the calculator"}
+                        {:role "assistant" :content "I'll add them."
+                         :tool-calls [{:id "call_1" :name "add" :arguments "{\"x\":2,\"y\":3}"}]}
+                        {:role "tool" :tool-call-id "call_1" :content "{\"x\":2,\"y\":3,\"sum\":5}"}]
+                       (:messages (second (:chat-requests @tu/server))))))
+              (testing "and it is over: the panel takes messages again"
+                (is (false? (.-readOnly (q "input[name=message]")))))))
+          (.finally model-context/clear!))
+      done)))
+
+(deftest chat-tool-error-test
+  ;; A tool that can't do what it was asked is an error the LLM reads, not the end of the chat.
+  (async done
+    (model-context/register! webmcp/tools)
+    (swap! tu/server assoc :chat-scripts
+           [[{:tool-calls [{:id "c1" :name "add" :arguments "{\"x\":\"two\",\"y\":3}"}
+                           {:id "c2" :name "made_up" :arguments "{}"}]}
+             {:done true}]
+            [{:content "Sorry, that didn't work."} {:done true}]])
+    (tu/finish
+      (-> (tu/steps
+            #(log-in-page! [])
+            ;; The calculator's tools are offered on the games page.
+            (fn [] (rf/dispatch-sync [::events/navigate :games]))
+            (fn [] (click! (q "button[aria-label=Chat]")))
+            #(send-chat! "add two and three")
+            #(tu/eventually (fn [] (= ["add two and three" "Sorry, that didn't work."] (chat-messages))))
+            (fn [_]
+              (is (= ["Calling add {\"x\":\"two\",\"y\":3}…" "Calling made_up {}…"
+                      "add failed: invalid arguments: x and y must be numbers"
+                      "made_up failed: unknown tool: made_up"]
+                     (chat-tool-lines)))
+              (is (= "crimson" (.. (last (q-all "[role=log] > div[data-tool]")) -style -color)) "failures stand out")
+              (is (= [true true] (map :error? (filter #(= "tool" (:role %)) (:messages (:chat @rf-db/app-db))))))
+              (is (nil? (q "[role=dialog] [role=alert]")) "it isn't an error of the chat's")
+              (is (= {:x "" :y "" :result {:status :idle}} (:calc @rf-db/app-db)) "nothing was done")))
+          (.finally model-context/clear!))
+      done)))
+
+(deftest chat-stream-failure-test
+  ;; The stream breaks in the middle of the reply: what came stays, with the error under it.
+  (async done
+    (swap! tu/server assoc :chat-script [{:thinking "hm"} {:content "Hel"}
+                                         {:error "the LLM server took too long to answer"}])
+    (tu/finish
+      (tu/steps
+        #(log-in-page! [])
+        (fn [] (click! (q "button[aria-label=Chat]")))
+        #(send-chat! "hi")
+        #(tu/eventually (fn [] (q "[role=dialog] [role=alert]")))
+        (fn [_]
+          (is (= "the LLM server took too long to answer" (text "[role=dialog] [role=alert]")))
+          (is (= ["hi" "Hel"] (chat-messages)))
+          (is (nil? (q "[role=status]")))
+          (is (= "" (.-value (q "input[name=message]"))))
+          (is (false? (.-readOnly (q "input[name=message]"))) "another message can be sent")))
+      done)))
+
+(deftest chat-stream-cut-test
+  ;; The connection drops with no word from the server: the page says so, rather than wait forever.
+  (async done
+    (swap! tu/server assoc :chat-script [{:content "Hel"}])
+    (tu/finish
+      (tu/steps
+        #(log-in-page! [])
+        (fn [] (click! (q "button[aria-label=Chat]")))
+        #(send-chat! "hi")
+        #(tu/eventually (fn [] (q "[role=dialog] [role=alert]")))
+        (fn [_]
+          (is (= "the connection was lost" (text "[role=dialog] [role=alert]")))
+          (is (= ["hi" "Hel"] (chat-messages)))
+          (is (nil? (q "[role=status]")) "no longer thinking")))
+      done)))
+
+(deftest chat-text-survives-the-stream-test
+  ;; The fake server sends its bytes in pieces of a few, so this cuts the text mid-character.
+  (async done
+    (tu/finish
+      (tu/steps
+        #(log-in-page! [])
+        (fn [] (click! (q "button[aria-label=Chat]")))
+        #(send-chat! "héllo 👋 世界")
+        #(tu/eventually (fn [] (= 2 (count (chat-messages)))))
+        (fn [_]
+          (is (= ["héllo 👋 世界" "echo: héllo 👋 世界"] (chat-messages)))))
+      done)))
+
+(deftest chat-error-test
+  (async done
+    (tu/finish
+      (steps
+        #(log-in-page! [])
+        (fn []
+          (swap! tu/server assoc :chat-error "the LLM server can't be reached")
+          (click! (q "button[aria-label=Chat]")))
+        #(tu/eventually (fn [] (q "input[name=message]")))
+        (fn [input] (type! input "hello") (tu/eventually #(= "hello" (.-value input))))
+        (fn [_] (submit! (q "[role=dialog] form")))
+        #(tu/eventually (fn [] (q "[role=dialog] [role=alert]")))
+        (fn [_]
+          (is (= "the LLM server can't be reached" (text "[role=dialog] [role=alert]")))
+          (is (empty? (chat-messages)))
+          (is (= "hello" (.-value (q "input[name=message]"))) "the message is back in the input, to send again")
+          (swap! tu/server dissoc :chat-error)
+          (submit! (q "[role=dialog] form")))
+        #(tu/eventually (fn [] (= ["hello" "echo: hello"] (chat-messages))))
+        (fn [_]
+          (is (nil? (q "[role=dialog] [role=alert]")) "the error goes away")))
+      done)))
+
+(deftest chat-needs-login-test
+  (async done
+    (tu/finish
+      (steps
+        #(open-page!)
+        #(tu/eventually (fn [] (some #{"Log in"} (nav-links))))
+        (fn [] (click! (q "button[aria-label=Chat]")))
+        #(tu/eventually panel)
+        (fn [_]
+          (is (= "Log in to chat." (text "[role=dialog] p")))
+          (is (= "/auth/login" (.getAttribute (q "[role=dialog] p a") "href")))
+          (is (nil? (q "input[name=message]")) "no way to type without a login")))
+      done)))
+
+(deftest chat-forgotten-on-logout-test
+  (async done
+    (tu/finish
+      (steps
+        #(log-in-page! [])
+        (fn [] (click! (q "button[aria-label=Chat]")))
+        #(tu/eventually (fn [] (q "input[name=message]")))
+        (fn [input] (type! input "secret") (tu/eventually #(= "secret" (.-value input))))
+        (fn [_] (submit! (q "[role=dialog] form")))
+        #(tu/eventually (fn [] (= 2 (count (chat-messages)))))
+        (fn [_] (click! (q "main > p:last-child button")))
+        #(tu/eventually (fn [] (= "Log in to chat." (text "[role=dialog] p"))))
+        (fn [_]
+          (is (empty? (chat-messages)))
+          (is (= [] (:messages (:chat @rf-db/app-db))) "and the conversation is gone, not just hidden")))
+      done)))

ui/test/tbd/ui/webmcp_test.cljs

@@ -164,7 +164,7 @@
                  (call "get_tic_tac_toe" {})))
         (.then (fn [_]
                  (is (= :ai-setup (page)) "reading changes nothing")
-                 (call "move_tic_tac_toe" {:cell 4})))
+                 (call "move_tic_tac_toe" {:cell 4 :player "x"})))
         (.then (fn [_]
                  (is (= :games (page)))
                  (rf/dispatch-sync [::events/navigate :ai-setup])
@@ -191,6 +191,56 @@
                  (is (= :todos (page)))
                  (done))))))
 
+(deftest navigate
+  (open-page!)
+  (async done
+    (-> (page-loaded)
+        (.then #(call "navigate" {:page "ai-setup"}))
+        (.then (fn [r]
+                 (is (= {:text "{\"page\":\"ai-setup\",\"title\":\"AI setup\"}" :error? false} r))
+                 (is (= :ai-setup (page)) "the page is shown, as after a click on its tab")
+                 (is (= "#/ai-setup" js/location.hash) "and the URL follows")
+                 (call "navigate" {:page "games"})))
+        (.then (fn [r]
+                 (is (false? (:error? r)))
+                 (is (= :games (page)))
+                 (call "navigate" {:page "nowhere"})))
+        (.then (fn [r]
+                 (is (:error? r))
+                 (is (re-find #"page must be one of games, todos, ai-setup" (:text r)))
+                 (call "navigate" {:page "ai-setup"})))
+        (.then (fn [_]
+                 (call "navigate" {:page 5})))
+        (.then (fn [r]
+                 (is (:error? r) "the page is the name of one")
+                 (call "navigate" {})))
+        (.then (fn [r]
+                 (is (:error? r))
+                 (is (= :ai-setup (page)) "a refused navigation leaves the page where it was")
+                 (done))))))
+
+(deftest navigate-to-a-page-that-needs-a-login
+  (open-page!)
+  (async done
+    (-> (page-loaded)
+        (.then #(call "navigate" {:page "todos"}))
+        (.then (fn [r]
+                 (is (:error? r) "the tab isn't there for someone who is not logged in")
+                 (is (re-find #"not logged in" (:text r)))
+                 (is (= :games (page)))
+                 (done))))))
+
+(deftest navigate-to-the-todos-when-logged-in
+  (tu/log-in!)
+  (open-page!)
+  (async done
+    (-> (page-loaded)
+        (.then #(call "navigate" {:page "todos"}))
+        (.then (fn [r]
+                 (is (= {:text "{\"page\":\"todos\",\"title\":\"Todos\"}" :error? false} r))
+                 (is (= :todos (page)))
+                 (done))))))
+
 (deftest a-tool-that-fails-leaves-the-page-alone
   (open-page!)
   (async done
@@ -268,24 +318,32 @@
         (.then (fn [r]
                  (is (false? (:error? r)))
                  (is (= {:board (vec (repeat 9 nil)) :status "in_progress" :turn "x"} (json (:text r))))
-                 (call "move_tic_tac_toe" {:cell 4})))
+                 (call "move_tic_tac_toe" {:cell 4 :player "x"})))
         (.then (fn [r]
                  ;; It pressed the cell, as a user would, and says it is O's turn now.
                  (is (= :x (get-in @rf-db/app-db [:ttt :board 4])))
                  (is (= {:board [nil nil nil nil "x" nil nil nil nil] :status "in_progress" :turn "o"}
                         (json (:text r))))
-                 (call "move_tic_tac_toe" {:cell 4})))
+                 (call "move_tic_tac_toe" {:cell 4 :player "o"})))
         (.then (fn [r]
                  (is (= {:text "cell 4 is taken" :error? true} r))
+                 (is (= :x (get-in @rf-db/app-db [:ttt :board 4])) "the mark on the taken cell stays")
+                 (is (= :o (get-in @rf-db/app-db [:ttt :turn])) "and the refused move does not use up the turn")
                  (call "move_tic_tac_toe" {:cell 0 :player "x"})))
         (.then (fn [r]
-                 (is (= {:text "it is o's turn, not x's" :error? true} r))
+                 (is (:error? r))
+                 (is (re-find #"it is o's turn, not x's" (:text r)))
                  (is (nil? (get-in @rf-db/app-db [:ttt :board 0])) "nothing was moved")
-                 (call "move_tic_tac_toe" {:cell 9})))
+                 (call "move_tic_tac_toe" {:cell 0})))
+        (.then (fn [r]
+                 (is (:error? r) "the side is required: no moving for whoever's turn it is")
+                 (is (re-find #"player must be" (:text r)))
+                 (is (nil? (get-in @rf-db/app-db [:ttt :board 0])) "nothing was moved")
+                 (call "move_tic_tac_toe" {:cell 9 :player "o"})))
         (.then (fn [r]
                  (is (:error? r))
                  (is (re-find #"0 to 8" (:text r)))
-                 (call "move_tic_tac_toe" {:cell 1.5})))
+                 (call "move_tic_tac_toe" {:cell 1.5 :player "o"})))
         (.then (fn [r]
                  (is (:error? r))
                  (call "move_tic_tac_toe" {:cell 0 :player "z"})))
@@ -302,7 +360,7 @@
                  (is (= {:board ["o" "o" nil "x" "x" "x" nil nil nil]
                          :status "won" :winner "x" :line [3 4 5]}
                         (json (:text r))))
-                 (call "move_tic_tac_toe" {:cell 8})))
+                 (call "move_tic_tac_toe" {:cell 8 :player "o"})))
         (.then (fn [r]
                  (is (= {:text "the game is over: start a new game" :error? true} r))
                  (call "new_tic_tac_toe_game" {})))