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