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

scope tools by page
CI / Test + coverage (push) Successful in 3m34s
Details

Browse Source
This commit is contained in:
Adam Jeniski
2026-09-21 14:01:34 -09:00
parent a53f0c3621
commit bf38f7b1be
37 changed files with 1894 additions and 359 deletions
Download Patch File Download Diff File Expand all files Collapse all files
test/tbd/agent/prompt_test.clj
+40
View File
@@ -0,0 +1,40 @@
(ns tbd.agent.prompt-test
(:require [clojure.string :as str]
[clojure.test :refer [deftest is testing]]
[tbd.agent.prompt :as prompt]))
(defn- flat
"`text` on one line: the prompts are wrapped in the source, where they wrap is not the point."
[text]
(str/replace text #"\s+" " "))
(deftest chat-and-guide-share-the-instructions
(testing "both tell the agent to act, to chain calls and to report only what a result says"
(doseq [text (map flat [prompt/chat prompt/guide])]
(is (str/includes? text "Act, don't offer"))
(is (str/includes? text "in this same turn"))
(is (str/includes? text "Work it out yourself:"))
(is (str/includes? text "Chain calls without stopping"))
(is (str/includes? text "results from an earlier message are marked out of date"))
(is (str/includes? text "never go by an earlier result"))
(is (str/includes? text "Say something was done only if a tool result says it was"))
(is (str/includes? text "Tic-tac-toe: check whose turn it is"))
(is (str/includes? text "Examples: "))))
(testing "what only fits the chatbot is not said to an agent outside the page"
(is (str/includes? prompt/chat "under your message"))
(is (not (str/includes? prompt/guide "under your message")))
(is (not (str/includes? prompt/guide "navigate there, then")) "an outside agent is offered every tool")))
(deftest task-prompt
(is (str/starts-with? (prompt/task "add a todo") prompt/guide))
(is (str/ends-with? (prompt/task "add a todo") "The user's request: add a todo"))
(doseq [none [nil "" 5]]
(is (str/includes? (prompt/task none) "Ask the user what they want") (pr-str none))
(is (not (str/includes? (prompt/task none) "The user's request")) (pr-str none))))
(deftest tic-tac-toe-prompt
(is (str/includes? (prompt/tic-tac-toe "x") "as X."))
(is (str/includes? (prompt/tic-tac-toe "o") "as O."))
(doseq [other [nil "" "z" :x]]
(is (str/includes? (prompt/tic-tac-toe other) "as O.") (pr-str other)))
(is (str/includes? (prompt/tic-tac-toe "x") "never move for the other side")))
test/tbd/chat/core_test.clj
+102 -3
View File
@@ -34,10 +34,15 @@
(defn- stream-of ^InputStream [& parts]
(ByteArrayInputStream. (.getBytes ^String (apply str parts) "UTF-8")))
(def ^:private quiet
"A trace config that says nothing (see tbd.chat.trace/config-for): the tests' log is for failures."
{:sink (fn [_]) :full-text? false})
(defn- config
"A configured chat whose LLM server is `http`; `calls` (an atom) collects what it was sent."
[calls http & {:as overrides}]
(merge {:url "http://llm.test:1234" :timeout-seconds 30
:trace quiet
:http (fn [req] (swap! calls conj req) (http req))}
overrides))
@@ -368,6 +373,100 @@
(is (= [{:error "the LLM server's reply was cut off"}]
(run (config (atom []) (fn [_] {:status 200 :body in}))))))))
;; --- Tracing: what the operator sees of a turn ---
(defn- traced
"Runs a chat over `conversation` with `http`, tracing into an atom: [what the client was sent, entries]."
([http] (traced http hello))
([http conversation]
(let [entries (atom [])
result (run* (config (atom []) http :trace {:sink #(swap! entries conj %) :full-text? true}
:model "qwen")
conversation nil)]
[result @entries])))
(defn- turn-end [entries] (first (filter #(= :turn-end (:event %)) entries)))
(deftest tracing-test
(testing "a turn is logged when it starts, and when it ends, with the same ids"
(let [[events entries] (traced (replying (reasoning "Let me think. ") (content "Hi") done))
[start end] entries]
(is (= [{:thinking "Let me think. "} {:content "Hi"} {:done true}] events))
(is (= [:turn-start :turn-end] (map :event entries)))
(is (= (select-keys start [:req :run :step]) (select-keys end [:req :run :step])))
(is (= {:model "qwen" :messages 1 :tools 0 :step 0 :run-calls 0} (select-keys start [:model :messages :tools :step :run-calls])))
(is (= {:outcome :done :thinking-chars 14 :content-chars 2 :events 2}
(select-keys end [:outcome :thinking-chars :content-chars :events])))
(is (every? #(number? (get end %)) [:duration-ms :ttft-ms :think-ms]))
(is (= "Let me think. " (:reasoning end)))
(is (= "Hi" (:reply end)))
(is (= hello (:input start)))))
(testing "the calls the model asked for are in the outcome"
(let [[_ entries] (traced (replying (call-piece 0 {:id "a" :name "add" :arguments "{\"x\":1}"}) done))]
(is (= :tool-calls (:outcome (turn-end entries))))
(is (= [{:name "add" :args "{\"x\":1}"}] (:calls (turn-end entries))))))
(testing "why the model stopped, and what it cost, are logged, and are not the client's business"
(let [[events entries] (traced (replying (content "Hi")
(str "data: " (json {:choices [{:index 0 :delta {} :finish_reason "length"}]}) "\n\n")
(str "data: " (json {:choices [] :usage {:prompt_tokens 10 :completion_tokens 5
:total_tokens 15 :other "x"}}) "\n\n")
done))
end (turn-end entries)]
(is (= [{:content "Hi"} {:done true}] events))
(is (= {:finish-reason "length" :prompt-tokens 10 :completion-tokens 5 :flags [:truncated]}
(select-keys end [:finish-reason :prompt-tokens :completion-tokens :flags])))))
(testing "the failures of the LLM are outcomes too"
(is (= {:outcome :error :error "the LLM server sent no reply"}
(select-keys (turn-end (second (traced (replying done)))) [:outcome :error])))
(let [end (turn-end (second (traced (fn [_] {:status 200 :body (cut-off (content "Hel"))}))))]
(is (= {:outcome :error :error "the LLM server's reply was cut off"} (select-keys end [:outcome :error])))
(is (str/includes? (:detail end) "connection reset")))
(let [entries (atom [])
{:keys [ok]} (chat/start (config (atom []) (fn [_] {:status 200 :body (silent)}) :timeout-seconds 1
:trace {:sink #(swap! entries conj %)}) hello)]
(ok identity)
(is (= "1s of silence" (:detail (turn-end @entries))))))
(testing "a turn that never got a reply says why"
(let [entries (atom [])
result (chat/start (config (atom []) (fn [_] {:status 500 :body (stream-of "oops")})
:trace {:sink #(swap! entries conj %)}) hello)
end (turn-end @entries)]
(is (= :upstream (:kind result)))
(is (= [:turn-start :turn-end] (map :event @entries)))
(is (= {:outcome :upstream-error :error "the LLM server answered HTTP 500" :detail "body: oops"}
(select-keys end [:outcome :error :detail])))))
(testing "a client that goes away ends the turn as aborted, once"
(let [entries (atom [])
{:keys [ok]} (chat/start (config (atom []) (replying (content "a") (content "b") done)
:trace {:sink #(swap! entries conj %)}) hello)]
(is (thrown? IOException (ok (fn [_] (throw (IOException. "broken pipe"))))))
(is (= [:aborted] (map :outcome (filter #(= :turn-end (:event %)) @entries))))))
(testing "a tracer that breaks doesn't break the chat"
(is (= [{:content "Hi"} {:done true}]
(run (config (atom []) (replying (content "Hi") done)
:trace {:sink (fn [_] (throw (IllegalStateException. "disk full")))})))))
(testing "without a trace config the turn is still logged, to the log"
(let [out (with-out-str (run (dissoc (config (atom []) (replying (content "Hi") done)) :trace)))]
(is (str/includes? out "[tbd] chat turn-start"))
(is (str/includes? out "[tbd] chat turn-end")))))
(deftest tracing-the-tool-loop-test
(let [call {:role "assistant" :content "" :tool-calls [{:id "c" :name "get_tic_tac_toe" :arguments "{}"}]}
result {:role "tool" :tool-call-id "c" :content "board"}
conversation (fn [n] (into [{:role "user" :content "play"}] (take (* 2 n) (cycle [call result]))))
starts (fn [n] (filter #(#{:turn-start :loop-suspect} (:event %))
(second (traced (replying (content "x") done) (conversation n)))))]
(testing "the turns of one run share a run id, and count their steps"
(let [[a b] (map (comp first starts) [1 2])]
(is (= (:run a) (:run b)))
(is (= [1 2] [(:step a) (:step b)]))
(is (= [1 2] [(:run-calls a) (:run-calls b)]))))
(testing "the same call over and over is a suspect"
(is (= [:turn-start] (map :event (starts 2))))
(let [[_ suspect] (starts 3)]
(is (= {:event :loop-suspect :kind :repeated-call :tool "get_tic_tac_toe" :count 3 :args "{}"}
(select-keys suspect [:event :kind :tool :count :args])))))))
;; --- The default HTTP client, against a real server on loopback ---
(defn- llm-server
@@ -399,7 +498,7 @@
(testing "an unreachable server is an error result"
;; Port 1 on loopback: nothing listens there, so the connection is refused at once.
(is (= {:error "the LLM server can't be reached" :kind :upstream}
(chat/start {:url "http://127.0.0.1:1" :timeout-seconds 5 :http chat/java-http} hello))))
(chat/start {:url "http://127.0.0.1:1" :timeout-seconds 5 :trace quiet :http chat/java-http} hello))))
(testing "a plain HTTP/1.1 request, with no upgrade to HTTP/2 offered, that gets the whole reply"
(let [seen (atom nil)]
(llm-server
@@ -412,7 +511,7 @@
(.close ex))
(fn [url]
(is (= [{:content "Hello "} {:content "from the LLM"} {:done true}]
(run {:url url :model "qwen" :timeout-seconds 10 :http chat/java-http})))))
(run {:url url :model "qwen" :timeout-seconds 10 :trace quiet :http chat/java-http})))))
(is (= "POST" (:method @seen)))
(is (= "application/json" (:content-type @seen)))
(is (= {:model "qwen" :stream true :messages hello} (sent-body (:body @seen))))))
@@ -430,6 +529,6 @@
(.close ex))
(fn [url]
(is (= [{:content "first"} {:content "second"} {:done true}]
(run {:url url :timeout-seconds 10 :http chat/java-http}
(run {:url url :timeout-seconds 10 :trace quiet :http chat/java-http}
#(when (= {:content "first"} %) (.countDown first-arrived)))))))
(is (true? @released?) "the first piece was delivered while the server was still replying"))))
test/tbd/chat/trace_test.clj
+222
View File
@@ -0,0 +1,222 @@
(ns tbd.chat.trace-test
(:require [clojure.string :as str]
[clojure.test :refer [deftest is testing]]
[muuntaja.core :as m]
[tbd.chat.trace :as trace])
(:import (java.io File)))
(defn- collecting
"A trace config that keeps its entries in `entries`, an atom."
[entries & {:as opts}]
(merge {:sink #(swap! entries conj %) :full-text? false} opts))
(defn- suspects [entries] (filter #(= :loop-suspect (:event %)) entries))
(defn- call [id name args] {:id id :name name :arguments args})
(defn- assistant [& calls] {:role "assistant" :content "" :tool-calls (vec calls)})
(defn- result [id] {:role "tool" :tool-call-id id :content "ok"})
(deftest run-summary-test
(let [ask {:role "user" :content "add milk"}
list-call (call "1" "list_todos" "{}")]
(testing "a conversation that has just begun"
(is (= {:step 0 :run-calls 0 :top-call nil :input [ask]}
(dissoc (trace/run-summary [ask]) :run))))
(testing "the turns of a run count the assistant's messages since the user's, and their calls"
(let [s (trace/run-summary [ask (assistant list-call) (result "1") (assistant (call "2" "add" "{}") (call "3" "add" "{}"))
(result "2") (result "3")])]
(is (= {:step 2 :run-calls 3 :top-call {:tool "add" :args "{}" :count 2}}
(select-keys s [:step :run-calls :top-call])))
(is (= ask (first (:input s))))
(is (= 6 (count (:input s))))))
(testing "the run id is that of the user's last message: the same for every turn of a run"
(let [a (trace/run-summary [ask])
b (trace/run-summary [ask (assistant list-call) (result "1")])
c (trace/run-summary [{:role "user" :content "something else"}])]
(is (re-matches #"[0-9a-f]{8}" (:run a)))
(is (= (:run a) (:run b)))
(is (not= (:run a) (:run c)))))
(testing "an earlier run's calls are not this run's"
(let [s (trace/run-summary [ask (assistant list-call) (result "1") {:role "assistant" :content "Done."}
{:role "user" :content "again"}])]
(is (= {:step 0 :run-calls 0} (select-keys s [:step :run-calls])))))
(testing "the same tool with other arguments is another call"
(is (= 1 (:count (:top-call (trace/run-summary [ask (assistant (call "1" "add" "{\"x\":1}") (call "2" "add" "{\"x\":2}"))]))))))
(testing "a conversation with no user message, and none at all"
(is (= "-" (:run (trace/run-summary [{:role "assistant" :content "hi"}]))))
(is (= {:run "-" :step 0 :run-calls 0} (select-keys (trace/run-summary []) [:run :step :run-calls]))))))
(deftest begin-test
(testing "the start of a turn says what it is about, without the words of the conversation"
(let [entries (atom [])]
(trace/begin! (collecting entries)
{:messages [{:role "user" :content "hello"}] :tools [{:name "add"} {:name "sub"}]
:page "todos" :model "qwen"})
(let [[start :as all] @entries]
(is (= 1 (count all)))
(is (= {:event :turn-start :page "todos" :model "qwen" :messages 1 :tools 2 :prompt-chars 5 :step 0}
(select-keys start [:event :page :model :messages :tools :prompt-chars :step])))
(is (re-matches #"[0-9a-f]{8}" (:req start)))
(is (not (contains? start :input))))))
(testing "with the full text on, it has the run's messages"
(let [entries (atom [])
messages [{:role "user" :content "old"} {:role "assistant" :content "reply"} {:role "user" :content "new"}]]
(trace/begin! (collecting entries :full-text? true) {:messages messages})
(is (= [{:role "user" :content "new"}] (:input (first @entries))))))
(testing "every turn has its own req id"
(let [entries (atom [])]
(dotimes [_ 3] (trace/begin! (collecting entries) {:messages [{:role "user" :content "x"}]}))
(is (= 3 (count (set (map :req @entries)))))))
(testing "a call made three times in a run is a suspect, twice is not"
(let [ask {:role "user" :content "go"}
messages (fn [n] (into [ask] (mapcat (fn [i] [(assistant (call (str i) "look" "{}")) (result (str i))])) (range n)))
entries (atom [])]
(trace/begin! (collecting entries) {:messages (messages 2)})
(is (empty? (suspects @entries)))
(trace/begin! (collecting entries) {:messages (messages 3)})
(is (= [{:kind :repeated-call :tool "look" :args "{}" :count 3}]
(map #(select-keys % [:kind :tool :args :count]) (suspects @entries)))))))
(deftest observe-test
(testing "reasoning that says the same sentence over and over is a suspect, at 4 times and each doubling"
(let [entries (atom [])
t (trace/begin! (collecting entries) {:messages [{:role "user" :content "x"}]})]
(dotimes [_ 16]
(trace/observe! t {:thinking "Wait, let me check the board again. "}))
(is (= [4 8 16] (map :count (suspects @entries))))
(is (every? #(= :repeated-thinking (:kind %)) (suspects @entries)))
(is (= "Wait, let me check the board again." (:text (first (suspects @entries)))))))
(testing "a sentence is the same whatever its case and spacing, and however the pieces of it came"
(let [entries (atom [])
t (trace/begin! (collecting entries) {:messages [{:role "user" :content "x"}]})]
(doseq [piece ["Wait, let me check" " the board AGAIN." "\n" "wait, let me check the board again.\n"
"Wait, let me check the " "board again! " "Wait, let me check the board again?\n\n"]]
(trace/observe! t {:thinking piece}))
(is (= [4] (map :count (suspects @entries))))))
(testing "short sentences, and different ones, are no repetition"
(let [entries (atom [])
t (trace/begin! (collecting entries) {:messages [{:role "user" :content "x"}]})]
(dotimes [i 20]
(trace/observe! t {:thinking "Hmm. "})
(trace/observe! t {:thinking (str "Step " i " of working out which of the many todos is the one. ")}))
(is (empty? (suspects @entries)))))
(testing "reasoning that goes on and on is a suspect at 8000 characters, and at each doubling"
(let [entries (atom [])
t (trace/begin! (collecting entries) {:messages [{:role "user" :content "x"}]})]
(dotimes [i 17]
(trace/observe! t {:thinking (str (format "%03d" i) (apply str (repeat 997 \x)))}))
(is (= [8000 16000] (map :chars (filter #(= :long-reasoning (:kind %)) (suspects @entries)))))))
(testing "a reply and calls are not reasoning"
(let [entries (atom [])
t (trace/begin! (collecting entries) {:messages [{:role "user" :content "x"}]})]
(dotimes [_ 10]
(trace/observe! t {:content "Wait, let me check the board again. "}))
(is (empty? (suspects @entries))))))
(deftest finish-test
(testing "the end of a turn sums it up, and only the first end counts"
(let [entries (atom [])
t (trace/begin! (collecting entries) {:messages [{:role "user" :content "x"}]})]
(trace/observe! t {:thinking "hm"})
(trace/observe! t {:thinking "m"})
(trace/observe! t {:content "Hi"})
(trace/observe! t {:finish-reason "stop" :usage {:prompt_tokens 7 :completion_tokens 3}})
(trace/finish! t {:outcome :done})
(trace/finish! t {:outcome :aborted})
(let [ends (filter #(= :turn-end (:event %)) @entries)
end (first ends)]
(is (= 1 (count ends)))
(is (= {:outcome :done :events 4 :thinking-chars 3 :content-chars 2 :finish-reason "stop"
:prompt-tokens 7 :completion-tokens 3 :flags []}
(select-keys end [:outcome :events :thinking-chars :content-chars :finish-reason
:prompt-tokens :completion-tokens :flags])))
(is (every? #(and (number? %) (>= % 0)) ((juxt :duration-ms :ttft-ms :think-ms) end)))
(is (not (contains? end :reasoning)) "the text stays out unless it is asked for"))))
(testing "the flags of a turn are what went wrong in it"
(let [entries (atom [])
t (trace/begin! (collecting entries) {:messages [{:role "user" :content "x"}]})]
(dotimes [_ 4] (trace/observe! t {:thinking "Wait, let me check the board again. "}))
(trace/observe! t {:finish-reason "length"})
(trace/finish! t {:outcome :done})
(is (= [:repeated-thinking :truncated] (:flags (last @entries))))))
(testing "a long call is cut, and the time spent thinking is the time until the answer"
(let [entries (atom [])
t (trace/begin! (collecting entries) {:messages [{:role "user" :content "x"}]})]
(trace/observe! t {:thinking "hm"})
(trace/observe! t {:call-deltas [{:index 0 :name "add"}]})
(trace/finish! t {:outcome :tool-calls :calls [(call "a" "add" (apply str (repeat 2000 \y)))]})
(let [end (last @entries)]
(is (= [{:name "add" :args (str (apply str (repeat 500 \y)) "…")}] (:calls end)))
(is (<= (:think-ms end) (:duration-ms end))))))
(testing "with the full text on, the turn ends with what the model said"
(let [entries (atom [])
t (trace/begin! (collecting entries :full-text? true) {:messages [{:role "user" :content "x"}]})]
(trace/observe! t {:thinking "One. "})
(trace/observe! t {:thinking "Two."})
(trace/observe! t {:content "Three"})
(trace/finish! t {:outcome :done})
(is (= {:reasoning "One. Two." :reply "Three"} (select-keys (last @entries) [:reasoning :reply])))))
(testing "a failure has its words"
(let [entries (atom [])
t (trace/begin! (collecting entries) {:messages [{:role "user" :content "x"}]})]
(trace/finish! t {:outcome :error :error "the LLM server's reply was cut off" :detail "reset"})
(is (= {:outcome :error :error "the LLM server's reply was cut off" :detail "reset"}
(select-keys (last @entries) [:outcome :error :detail]))))))
(deftest render-test
(let [line (trace/render {:event :turn-end :req "ab12cd34" :run "00ff00ff" :step 2 :outcome :tool-calls
:duration-ms 1200 :thinking-chars 0 :error "it broke" :detail nil :flags [:truncated :repeated-thinking]
:calls [{:name "add" :args "{\"x\":1}"}] :reasoning "secret words" :reply "more" :input [{:role "user"}]
:extra []})]
(testing "one line, the fields in a fixed order, the values readable"
(is (= (str "[tbd] chat turn-end req=ab12cd34 run=00ff00ff step=2 outcome=tool-calls duration-ms=1200 thinking-chars=0"
" calls=\"add{\\\"x\\\":1}\" flags=truncated,repeated-thinking error=\"it broke\"")
line)))
(testing "the text of the conversation is for the file only"
(is (not (str/includes? line "secret")))
(is (not (str/includes? line "more")))))
(testing "a long argument is cut in the line"
(is (< (count (trace/render {:event :turn-end :calls [{:name "add" :args (apply str (repeat 1000 \z))}]})) 250))))
(defn- temp-file ^File []
(doto (File/createTempFile "chat-trace" ".jsonl") .delete .deleteOnExit))
(deftest sink-test
(testing "without a file, an entry is a line of the log"
(is (= "[tbd] chat turn-start req=a page=todos\n"
(with-out-str ((trace/sink nil) {:event :turn-start :req "a" :page "todos"})))))
(testing "with a file, it is also a line of JSON there, with everything in it"
(let [file (temp-file)
sink (trace/sink (str file))
out (with-out-str
(sink {:event :turn-end :req "a" :outcome :done :reasoning "long \"thoughts\"\nover lines" :flags [:truncated]})
(sink {:event :turn-start :req "b"}))
lines (str/split-lines (slurp file))
[end start] (map #(m/decode "application/json" %) lines)]
(is (not (str/includes? out "thoughts")) "the log has no text")
(is (= 2 (count lines)))
(is (= {:event "turn-end" :req "a" :outcome "done" :reasoning "long \"thoughts\"\nover lines" :flags ["truncated"]}
(dissoc end :ts)))
(is (= "turn-start" (:event start)))
(is (some? (java.time.Instant/parse (:ts end))))))
(testing "the file's folders are made"
(let [dir (doto (File/createTempFile "chat-trace" "") .delete)
file (File. dir "deeper/trace.jsonl")]
(with-out-str ((trace/sink (str file)) {:event :turn-start :req "a"}))
(is (.exists file))
(.delete file) (.delete (.getParentFile file)) (.delete dir)))
(testing "a file that can't be written to is complained about, and nothing is thrown"
(let [dir (doto (File/createTempFile "chat-trace" "") .delete .mkdirs)
out (try (with-out-str ((trace/sink (str dir)) {:event :turn-start :req "a"}))
(finally (.delete dir)))]
(is (str/includes? out "[tbd] chat turn-start req=a"))
(is (str/includes? out "can't write the trace file")))))
(deftest config-for-test
(testing "no file: the log only, and no full text"
(is (= {:full-text? false :file nil} (select-keys (trace/config-for nil) [:full-text? :file])))
(is (fn? (:sink (trace/config-for nil)))))
(testing "a file: the full text goes there"
(let [file (str (temp-file))]
(is (= {:full-text? true :file file} (select-keys (trace/config-for file) [:full-text? :file]))))))
test/tbd/mcp/routes_test.clj
+11 -6
View File
@@ -99,8 +99,11 @@
(is (= {:x "First addend" :y "Second addend"}
(update-vals (:properties add) :description)))
(is (= ["number" "number"] (map :type (vals (:properties add))))))
(is (= {:type "object" :required ["id"] :properties {:id {:type "integer" :description "Todo id"}}}
(input-schema "get_todo")))
(let [get-todo (input-schema "get_todo")]
(is (= ["id"] (:required get-todo)))
(is (= "string" (get-in get-todo [:properties :id :type])) "an id is a string, not a number")
(is (re-find #"UUID" (get-in get-todo [:properties :id :description])))
(is (re-find (re-pattern (get-in get-todo [:properties :id :pattern])) (str (random-uuid)))))
(is (= ["id"] (:required (input-schema "update_todo"))) "title and done are optional")
(is (= #{"id" "title" "done"} (set (map name (keys (:properties (input-schema "update_todo"))))))))
(testing "and ones with no arguments say so"
@@ -256,16 +259,18 @@
(deftest tool-arguments-are-validated-test
(let [{:keys [app alice]} (fixture)
todo-id "3f2b8c1e-5a47-4d0e-9b6a-1c2d3e4f5a6b"
sid (initialize app alice)
error (fn [tool arguments]
(let [resp (call-tool app alice sid tool arguments)]
(is (true? (get-in resp [:result :isError])) (str tool " " (pr-str arguments)))
(text resp)))]
(testing "arguments of the wrong type are turned away, which plumcp alone doesn't do"
(is (= "invalid arguments: {:id [\"should be an integer\"]}" (error "get_todo" {:id "abc"})))
(is (= "invalid arguments: {:id [\"should be a UUID\"]}" (error "get_todo" {:id "abc"})))
(is (= "invalid arguments: {:id [\"should be a UUID\"]}" (error "get_todo" {:id 1})) "todo ids are not integers")
(is (= "invalid arguments: {:title [\"should be a string\"]}" (error "create_todo" {:title 5})))
(is (= "invalid arguments: {:done [\"should be a boolean\"]}" (error "update_todo" {:id 1 :done "yes"})))
(is (= "invalid arguments: {:done [\"should be a boolean\"]}" (error "update_todo" {:id todo-id :done "yes"})))
(is (= "invalid arguments: {:x [\"should be an integer\" \"should be a double\"]}" (error "add" {:x "2" :y 3}))))
(testing "the tools and the HTTP API validate against the same schemas"
(is (false? (malli/validate todo-schema/UpdateTodo {:id 1 :done "yes"})))
(is (true? (malli/validate todo-schema/UpdateTodo {:id 1 :done true}))))))
(is (false? (malli/validate todo-schema/UpdateTodo {:id todo-id :done "yes"})))
(is (true? (malli/validate todo-schema/UpdateTodo {:id todo-id :done true}))))))
test/tbd/oauth/db_test.clj
+30
View File
@@ -1,6 +1,7 @@
(ns tbd.oauth.db-test
(:require [clojure.java.io :as io]
[clojure.test :refer [deftest is testing]]
[next.jdbc :as jdbc]
[tbd.oauth.db :as db])
(:import (java.nio.file Files)
(java.nio.file.attribute FileAttribute)))
@@ -55,6 +56,7 @@
(is (nil? (db/find-grant-by-access ds "refresh-1" 1000)) "a refresh token isn't an access token"))
(testing "found by refresh token"
(is (= 7 (:user-id (db/find-grant-by-refresh ds "refresh-1"))))
(is (uuid? (parse-uuid (:id (db/find-grant-by-refresh ds "refresh-1")))) "a grant's id is a UUID")
(is (nil? (db/find-grant-by-refresh ds "access-1"))))
(testing "rotating replaces both tokens, and works once per refresh token"
(let [id (:id (db/find-grant-by-refresh ds "refresh-1"))
@@ -88,3 +90,31 @@
(is (nil? (db/find-grant-by-refresh ds "refresh-2")) "one that can't is dropped")
(is (nil? (db/take-code! ds "expired")))
(is (some? (db/take-code! ds "pending")))))
(deftest integer-grant-ids-are-migrated-test
(testing "grants from before ids were UUIDs survive, under new ids, and still work"
(let [path (temp-db-path)
_ (io/make-parents path)
old (jdbc/get-datasource {:dbtype "sqlite" :dbname path})]
(jdbc/execute! old ["CREATE TABLE grants (
id INTEGER PRIMARY KEY AUTOINCREMENT,
client_id TEXT NOT NULL,
user_id INTEGER NOT NULL,
login TEXT NOT NULL,
scope TEXT NOT NULL,
access_hash TEXT NOT NULL UNIQUE,
access_expires_at INTEGER NOT NULL,
refresh_hash TEXT NOT NULL UNIQUE,
refresh_expires_at INTEGER NOT NULL,
created_at INTEGER NOT NULL)"])
(jdbc/execute! old ["INSERT INTO grants (client_id, user_id, login, scope, access_hash, access_expires_at,
refresh_hash, refresh_expires_at, created_at)
VALUES ('c1', 7, 'alice', 'mcp', 'access-1', 2000, 'refresh-1', 9000, 1000)"])
(let [ds (db/open path)
migrated (db/find-grant-by-access ds "access-1" 1000)]
(is (= {:client-id "c1" :user-id 7 :login "alice" :scope "mcp" :refresh-hash "refresh-1"}
(select-keys migrated [:client-id :user-id :login :scope :refresh-hash])))
(is (uuid? (parse-uuid (:id migrated))))
(is (some? (db/rotate-grant! ds (:id migrated) "refresh-1"
{:access-hash "access-2" :access-expires-at 3000
:refresh-hash "refresh-2" :refresh-expires-at 9500})))))))
test/tbd/todo/core_test.clj
+1 -1
View File
@@ -18,7 +18,7 @@
(todo/new-todo 7 " buy milk " 1000)))
(is (= {:error "title must not be blank"} (todo/new-todo 7 " " 1000))))
(def stored {:id 1 :owner-id 7 :title "buy milk" :done false :created-at 1000 :updated-at 1000})
(def stored {:id "3f2b8c1e-5a47-4d0e-9b6a-1c2d3e4f5a6b" :owner-id 7 :title "buy milk" :done false :created-at 1000 :updated-at 1000})
(deftest apply-changes-test
(testing "title"
test/tbd/todo/db_test.clj
+42 -3
View File
@@ -1,6 +1,7 @@
(ns tbd.todo.db-test
(:require [clojure.java.io :as io]
[clojure.test :refer [deftest is testing]]
[next.jdbc :as jdbc]
[tbd.todo.db :as db])
(:import (java.nio.file Files)
(java.nio.file.attribute FileAttribute)))
@@ -38,6 +39,7 @@
id (:id saved)]
(testing "insert returns the stored todo with an id"
(is (= (assoc (todo 7 "buy milk") :id id) saved))
(is (re-matches #"[0-9a-f]{8}-[0-9a-f]{4}-4[0-9a-f]{3}-[89ab][0-9a-f]{3}-[0-9a-f]{12}" id) "a UUID, not a number")
(is (not= id (:id (db/insert! ds (todo 7 "walk dog"))))))
(testing "find and list"
(is (= saved (db/find-todo ds 7 id)))
@@ -47,9 +49,10 @@
(db/update! ds 7 (assoc saved :title "buy oat milk" :done true :updated-at 2000))))
(is (= true (:done (db/find-todo ds 7 id)))))
(testing "missing ids"
(is (nil? (db/find-todo ds 7 999)))
(is (nil? (db/update! ds 7 (assoc saved :id 999))))
(is (false? (db/delete! ds 7 999))))
(let [missing (str (random-uuid))]
(is (nil? (db/find-todo ds 7 missing)))
(is (nil? (db/update! ds 7 (assoc saved :id missing))))
(is (false? (db/delete! ds 7 missing)))))
(testing "delete"
(is (true? (db/delete! ds 7 id)))
(is (nil? (db/find-todo ds 7 id)))
@@ -67,3 +70,39 @@
(is (nil? (db/update! ds 8 (assoc mine :title "hijacked"))))
(is (false? (db/delete! ds 8 (:id mine))))
(is (= mine (db/find-todo ds 7 (:id mine)))))))
(deftest list-order-test
(testing "todos come oldest first, though their ids, being random, say nothing of the order"
(let [ds (db/open (temp-db-path))
titles (mapv #(str "todo " %) (range 20))]
(doseq [title titles] (db/insert! ds (todo 7 title)))
(db/insert! ds (assoc (todo 7 "the newest") :created-at 5000))
(db/insert! ds (assoc (todo 7 "the oldest") :created-at 1))
(is (= (concat ["the oldest"] titles ["the newest"]) (map :title (db/list-todos ds 7)))))))
(deftest integer-ids-are-migrated-test
(testing "a database from before ids were UUIDs keeps its todos, in order, under new ids"
(let [path (temp-db-path)
_ (io/make-parents path)
old (jdbc/get-datasource {:dbtype "sqlite" :dbname path})]
(jdbc/execute! old ["CREATE TABLE todos (
id INTEGER PRIMARY KEY AUTOINCREMENT,
owner_id INTEGER NOT NULL,
title TEXT NOT NULL,
done INTEGER NOT NULL DEFAULT 0,
created_at INTEGER NOT NULL,
updated_at INTEGER NOT NULL)"])
(jdbc/execute! old ["CREATE INDEX todos_by_owner ON todos (owner_id, id)"])
(doseq [[owner title done] [[7 "first" 0] [8 "theirs" 0] [7 "second" 1]]]
(jdbc/execute! old ["INSERT INTO todos (owner_id, title, done, created_at, updated_at) VALUES (?, ?, ?, 1000, 1000)"
owner title done]))
(let [ds (db/open path)
mine (db/list-todos ds 7)]
(is (= [["first" false] ["second" true]] (map (juxt :title :done) mine)))
(is (every? (comp uuid? parse-uuid :id) mine))
(is (= ["theirs"] (map :title (db/list-todos ds 8))))
(testing "and is only migrated once"
(is (= mine (db/list-todos (db/open path) 7))))
(testing "and works as a new one does"
(db/insert! ds (todo 7 "third"))
(is (= ["first" "second" "third"] (map :title (db/list-todos ds 7)))))))))
test/tbd/todo/routes_test.clj
+6 -5
View File
@@ -46,7 +46,7 @@
{:keys [id] :as created} (:body resp)]
(is (= 201 (:status resp)))
(is (= {:owner-id 7 :title "buy milk" :done false} (select-keys created [:owner-id :title :done])))
(is (pos? id))
(is (uuid? (parse-uuid id)))
(testing "get"
(is (= created (:body (request app :get (str todos "/" id) cookie)))))
(testing "patch"
@@ -79,9 +79,10 @@
(doseq [body ["{}" "{\"title\":\" \"}" "{\"done\":\"yes\"}" "{\"id\":99}"]]
(is (= 400 (:status (request app :patch one cookie body))) body))
(is (= 400 (:status (request app :patch one cookie))) "no body"))
(testing "a non-numeric id"
(doseq [method [:get :patch :delete]]
(is (= 400 (:status (request app method (str todos "/abc") cookie "{\"done\":true}"))) (str method))))
(testing "an id that is not a UUID (an integer, as todos used to have, included)"
(doseq [method [:get :patch :delete]
id ["abc" "1"]]
(is (= 400 (:status (request app method (str todos "/" id) cookie "{\"done\":true}"))) (str method " " id))))
(is (= [created] (:todos (:body (request app :get todos cookie)))) "nothing above changed the todo")))
(deftest per-user-scoping-test
@@ -98,7 +99,7 @@
(is (= ["alice's"] (map :title (:todos (:body (request alice-app :get todos alice))))))
(is (= ["bob's"] (map :title (:todos (:body (request bob-app :get todos bob)))))))
(testing "someone else's todo is indistinguishable from a missing one"
(let [missing (request bob-app :get (str todos "/999999") bob)]
(let [missing (request bob-app :get (str todos "/" (random-uuid)) bob)]
(doseq [[method body] [[:get nil] [:patch "{\"title\":\"hijacked\"}"] [:delete nil]]]
(let [resp (request bob-app method one bob body)]
(is (= 404 (:status resp)) (str method))
test/tbd/todo/service_test.clj
+1 -1
View File
@@ -22,7 +22,7 @@
id (:id created)]
(testing "create trims the title, makes it the user's and returns it stored"
(is (= {:owner-id 7 :title "buy milk" :done false} (select-keys created [:owner-id :title :done])))
(is (integer? id)))
(is (uuid? (parse-uuid id))))
(is (= {:ok created} (service/find-todo ds alice id)))
(is (= {:ok [created]} (service/list-todos ds alice)))
(testing "update changes the title and/or done"