scope tools by page

src/tbd/chat/core.clj

@@ -16,9 +16,14 @@
   MCP does in `tools/list`: {:name :description :inputSchema}. The LLM only sees their metadata: it
   asks for a call, the browser makes it and sends the result back with the next request, as a
   message with the role \"tool\" (see tbd.chat.schema/Message). This ns translates all of that to
-  and from the OpenAI-style `tools`, `tool_calls` and `tool_call_id` of the LLM server."
+  and from the OpenAI-style `tools`, `tool_calls` and `tool_call_id` of the LLM server.
+
+  Every turn is traced (see tbd.chat.trace): what was asked, how the reply went, and whether the
+  model looks stuck in a loop. The config's `:trace` says where that goes."
   (:require [clojure.string :as str]
-            [muuntaja.core :as m])
+            [muuntaja.core :as m]
+            [tbd.agent.prompt :as prompt]
+            [tbd.chat.trace :as trace])
   (:import (java.io BufferedReader Closeable IOException InputStream InputStreamReader)
            (java.net URI)
            (java.net.http HttpClient HttpClient$Version HttpRequest HttpRequest$BodyPublishers HttpResponse$BodyHandlers)
@@ -59,7 +64,10 @@
     LMSTUDIO_URL      where the LM Studio server is, e.g. http://192.168.1.20:1234 (chat is off without it)
     LMSTUDIO_MODEL    the model id to ask for (optional: LM Studio uses the model that is loaded)
     LMSTUDIO_API_KEY  sent as a bearer token, when the server wants one (optional)
-    LMSTUDIO_TIMEOUT_SECONDS  how long the server may stay silent before giving up (default 120)"
+    LMSTUDIO_TIMEOUT_SECONDS  how long the server may stay silent before giving up (default 120)
+    CHAT_TRACE_FILE   a file to append a JSON trace of every turn to, with the model's full reasoning and
+                      replies and the messages it was sent (optional: without it, each turn is only
+                      summarised in the log)"
   ([] (env-config (System/getenv)))
   ([env]
    {:url (some-> (env-val env "LMSTUDIO_URL") (str/replace #"/+$" ""))
@@ -67,6 +75,7 @@
     :api-key (env-val env "LMSTUDIO_API_KEY")
     :timeout-seconds (or (some-> (env-val env "LMSTUDIO_TIMEOUT_SECONDS") parse-long)
                          default-timeout-seconds)
+    :trace (trace/config-for (env-val env "CHAT_TRACE_FILE"))
     :http java-http}))
 
 (defn configured? [{:keys [url]}]
@@ -105,45 +114,10 @@
                description (assoc :description description))})
 
 (def default-system-prompt
-  "What the LLM is told about its job. The chatbot is an agent embedded in a UI, not a
-  conversationalist: what it does shows on the user's screen the moment it does it, so the prompt
-  is about acting (calling the page's tools in the same turn, chaining them, saying little
-  afterwards) and about the few cases where it should not. A model that is only asked to be
-  helpful answers a request for action with an offer of help. It is short and concrete on purpose,
-  with examples: the models behind LM Studio follow that better than a long list of rules."
-  (str "You are the assistant built into this web app. Your tools type, click and read on the page the\n"
-       "user is looking at, and every call shows on their screen the moment you make it.\n"
-       "\n"
-       "Act, don't offer. When the user asks for something a tool can do, call the tool in this same\n"
-       "turn. Never say you are about to do something, never ask \"would you like me to\", never ask them\n"
-       "to confirm what they just asked for.\n"
-       "\n"
-       "Work it out yourself:\n"
-       "- Detail missing: take the obvious default and go. Ask only when a required argument is genuinely\n"
-       "  unknowable (which of several todos they mean) or when you would delete or overwrite something\n"
-       "  and cannot tell what.\n"
-       "- Chain calls without stopping. The tool you need belongs to another page: navigate there, then\n"
-       "  use it. You need an id: list first, then act. Never invent an id, a title or the state of the\n"
-       "  page: read it with a tool.\n"
-       "- A call fails: read the error, fix the arguments or read the state, and try once more. No\n"
-       "  apologies, no explanation of what went wrong unless it still fails.\n"
-       "\n"
-       "Then say one short plain sentence: \"Added it.\" \"That's 23.\" The call and its result are already\n"
-       "on screen under your message, so never repeat them, never paste JSON, never use markdown,\n"
-       "headings or bullet lists. Say something was done only if a tool result says it was.\n"
-       "\n"
-       "Some things are not tool work: greetings, questions about you, questions you can simply answer.\n"
-       "Answer those in a sentence or two, with no tool call. Asked what you can do, say it plainly from\n"
-       "the tools you have. Think briefly before you act.\n"
-       "\n"
-       "Tic-tac-toe: check whose turn it is, move only for your own side, one move, then stop and let the\n"
-       "person play theirs.\n"
-       "\n"
-       "Examples:\n"
-       "\"add a todo to buy milk\" -> create_todo{\"title\":\"buy milk\"} -> \"Added.\"\n"
-       "\"tick off the milk one\" -> list_todos -> set_todo_done{\"id\":7,\"done\":true} -> \"Ticked off.\"\n"
-       "\"what's 19 and 4?\" -> add{\"x\":19,\"y\":4} -> \"23.\"\n"
-       "\"play tic tac toe, you're O\" -> get_tic_tac_toe -> it is X's turn -> \"You're up, X starts.\""))
+  "What the LLM is told about its job: an agent embedded in a UI, not a conversationalist. The text
+  is tbd.agent.prompt/chat, shared with the prompts the page offers to an MCP client outside it
+  (Claude, Codex, through WebMCP), so that tuning it tunes both."
+  prompt/chat)
 
 (defn- system-message
   "Everything the LLM is told before the conversation, as one message: the instructions
@@ -193,7 +167,9 @@
   of the reasoning: kept as it is, blanks too, since a piece can be just the line break between two
   paragraphs), and :call-deltas (see call-deltas) if there are any; {:error text :detail text}; or
   :end (`data: [DONE]`). nil for a line that says nothing: blank, a comment, or an event without
-  text."
+  text. A map may also have :finish-reason (why the model stopped: \"stop\", \"tool_calls\",
+  \"length\" for a reply that ran out of tokens) and :usage ({:prompt_tokens :completion_tokens
+  :total_tokens}, when the server counts): they are for the trace, not the client."
   [line]
   (when-let [data (some-> (re-matches #"data:\s?(.*)" line) second str/trim)]
     (if (= "[DONE]" data)
@@ -201,14 +177,18 @@
       (let [event (try (m/decode "application/json" data) (catch Exception _ nil))
             delta (get-in event [:choices 0 :delta])
             text? (not (str/blank? (:content delta)))
-            thinking (:reasoning_content delta)]
+            thinking (:reasoning_content delta)
+            finish-reason (get-in event [:choices 0 :finish_reason])
+            usage (:usage event)]
         (if (:error event)
           {:error "the LLM server reported an error" :detail (pr-str (:error event))}
           (not-empty
             (cond-> {}
               text? (assoc :content (:content delta))
               (and (string? thinking) (seq thinking)) (assoc :thinking thinking)
-              (seq (call-deltas delta)) (assoc :call-deltas (vec (call-deltas delta))))))))))
+              (seq (call-deltas delta)) (assoc :call-deltas (vec (call-deltas delta)))
+              (string? finish-reason) (assoc :finish-reason finish-reason)
+              (map? usage) (assoc :usage (select-keys usage [:prompt_tokens :completion_tokens :total_tokens])))))))))
 
 (defn- add-deltas
   "`calls` ({index {:id :name :arguments}}, in order) with the pieces of calls in `deltas`."
@@ -234,8 +214,9 @@
 (defn- pump
   "Reads the LLM's event stream `in`, calling `emit` with each event (see the ns docstring), and
   closes `in`. More than `timeout-seconds` of silence from the LLM is an error. An exception from
-  `emit` (the client went away, say) ends it too, and is thrown to the caller."
-  [^InputStream in timeout-seconds emit]
+  `emit` (the client went away, say) ends it too, and is thrown to the caller. `tracer` (see
+  tbd.chat.trace) sees everything the LLM says, and how the turn ended, before the client is told."
+  [^InputStream in timeout-seconds emit tracer]
   (let [timer (atom nil)
         timed-out? (atom false)
         arm! (fn []
@@ -263,15 +244,26 @@
               (nil? event) (do (arm!) (recur replied? calls))
               (= :end event) (let [calls (finished-calls calls)]
                                (cond
-                                 (seq calls) (do (emit {:tool-calls calls}) (emit {:done true}))
-                                 replied? (emit {:done true})
-                                 :else (emit {:error (fail "the LLM server sent no reply")})))
-              (:error event) (emit {:error (fail (:error event) (:detail event))})
+                                 (seq calls) (do (trace/finish! tracer {:outcome :tool-calls :calls calls})
+                                                 (emit {:tool-calls calls})
+                                                 (emit {:done true}))
+                                 replied? (do (trace/finish! tracer {:outcome :done})
+                                              (emit {:done true}))
+                                 :else (let [text (fail "the LLM server sent no reply")]
+                                         (trace/finish! tracer {:outcome :error :error text})
+                                         (emit {:error text}))))
+              (:error event) (let [text (fail (:error event) (:detail event))]
+                               (trace/finish! tracer {:outcome :error :error text :detail (:detail event)})
+                               (emit {:error text}))
               :else (do (arm!)
-                        (when-let [out (not-empty (dissoc event :call-deltas))] (emit out))
+                        (trace/observe! tracer event)
+                        (when-let [out (not-empty (select-keys event [:content :thinking]))] (emit out))
                         (recur (or replied? (contains? event :content))
                                (add-deltas calls (:call-deltas event))))))))
       (finally
+        ;; Only does anything if the turn ended some other way than the ones above: `emit` threw
+        ;; (the client went away), or something else did.
+        (trace/finish! tracer {:outcome :aborted})
         (some-> ^ScheduledFuture @timer (.cancel false))
         (try (.close in) (catch IOException _ nil))))))
 
@@ -286,21 +278,25 @@
   the LLM is closed (which stops it generating) and the exception is rethrown."
   ([config messages] (start config messages nil nil))
   ([config messages tools] (start config messages tools nil))
-  ([{:keys [timeout-seconds http] :as config} messages tools page]
+  ([{:keys [timeout-seconds http trace] :as config} messages tools page]
    (if-not (configured? config)
      {:error "chat is not configured" :kind :unavailable}
-     (try
-       (let [{:keys [status body]} (http (request config messages tools page))]
-         (if (= 200 status)
-           {:ok (fn [emit] (pump body timeout-seconds emit))}
-           (let [snippet (try (String. (.readNBytes ^InputStream body 200) StandardCharsets/UTF_8)
-                              (catch Exception _ nil))]
-             (some-> ^Closeable body .close)
-             {:error (fail (str "the LLM server answered HTTP " status) (str "body: " snippet))
-              :kind :upstream})))
-       (catch java.net.http.HttpTimeoutException e
-         {:error (fail "the LLM server took too long to answer" (.getMessage e)) :kind :upstream})
-       (catch IOException e
-         {:error (fail "the LLM server can't be reached" (exception-detail e)) :kind :upstream})
-       (catch Exception e
-         {:error (fail "the LLM server sent an unreadable reply" (exception-detail e)) :kind :upstream})))))
+     (let [tracer (trace/begin! trace {:messages messages :tools tools :page page :model (:model config)})
+           upstream-error (fn [text detail]
+                            (fail text detail)
+                            (trace/finish! tracer {:outcome :upstream-error :error text :detail detail})
+                            {:error text :kind :upstream})]
+       (try
+         (let [{:keys [status body]} (http (request config messages tools page))]
+           (if (= 200 status)
+             {:ok (fn [emit] (pump body timeout-seconds emit tracer))}
+             (let [snippet (try (String. (.readNBytes ^InputStream body 200) StandardCharsets/UTF_8)
+                                (catch Exception _ nil))]
+               (some-> ^Closeable body .close)
+               (upstream-error (str "the LLM server answered HTTP " status) (str "body: " snippet)))))
+         (catch java.net.http.HttpTimeoutException e
+           (upstream-error "the LLM server took too long to answer" (.getMessage e)))
+         (catch IOException e
+           (upstream-error "the LLM server can't be reached" (exception-detail e)))
+         (catch Exception e
+           (upstream-error "the LLM server sent an unreadable reply" (exception-detail e))))))))

src/tbd/chat/schema.clj

@@ -60,7 +60,7 @@
             [:content [:string {:min 1 :max max-message-length}]]]]])
 
 (def Page
-  "Which page of the UI the user is on: its id, as the UI has it (\"games\", \"ai-setup\"). The server
+  "Which page of the UI the user is on: its id, as the UI has it (\"tic-tac-toe\", \"ai-setup\"). The server
   doesn't know the pages, but the LLM is told it, so it is a short slug and nothing that reads as
   an instruction."
   [:re #"^[a-z0-9-]{1,64}$"])

src/tbd/chat/trace.clj

@@ -0,0 +1,281 @@
+(ns tbd.chat.trace
+  "Observability for the chatbot's LLM turns: what the model was asked, what it did with it, how long
+  it took, and whether it looks stuck. No Ring and no LLM here; tbd.chat.core calls it.
+
+  One request to /api/chat is one turn of the model. The loop that runs tools lives in the browser
+  (tbd.ui.events): a tool's result comes back as a new request holding the conversation so far, so the
+  server keeps nothing between turns. A stuck agent shows up in two ways, and both are watched:
+
+  - within a turn, as reasoning that never ends (`:long-reasoning`) or that says the same sentence
+    again and again (`:repeated-thinking`);
+  - across turns, as the same tool call made over and over (`:repeated-call`), read off the
+    conversation each request carries.
+
+  Every turn is one `tracer`: `begin!` when the request goes out (logs `:turn-start`), `observe!` for
+  each event of the reply (logs a `:loop-suspect` when one of the above trips), `finish!` when it ends
+  (logs `:turn-end`, with the outcome, timings, sizes and flags). A tracer is for one thread, the one
+  that reads the reply.
+
+  Turns are correlated by `req` (one per turn) and `run` (a hash of the user's last message, the same
+  for every turn of the tool loop it started), with `step` counting the turns of the run from 0.
+
+  Entries are maps that go to a `sink`. `sink` prints each as one `[tbd] chat <event> k=v ...` line and,
+  if given a file, appends it there as JSON. Only the file has the text of the reasoning and the reply
+  (`:reasoning`, `:reply`) and the run's messages (`:input`): they are what you read to see why a
+  model is looping, and they are the user's words, so they are off unless a file is asked for
+  (CHAT_TRACE_FILE, see tbd.chat.core/env-config)."
+  (:require [clojure.java.io :as io]
+            [clojure.string :as str]
+            [muuntaja.core :as m])
+  (:import (java.time Instant)))
+
+(def reasoning-warn-chars
+  "Reasoning this long, without an answer or a call yet, is worth a look: a `:long-reasoning` entry
+  at this many characters, and again at each doubling."
+  8000)
+
+(def ^:private repeat-min-length
+  "Shorter sentences (\"Let me check.\") repeat in any reasoning; only longer ones say anything."
+  20)
+
+(def ^:private repeat-warn-count
+  "A sentence of the reasoning said this many times is a `:repeated-thinking`; and again at each doubling."
+  4)
+
+(def ^:private repeated-call-warn-count
+  "The same tool called with the same arguments this many times in one run is a `:repeated-call`."
+  3)
+
+(def ^:private max-distinct-sentences 5000)
+(def ^:private max-pending-chars 1000)
+(def ^:private max-args-length 500)
+(def ^:private sample-length 160)
+
+(defn- now-ms [] (quot (System/nanoTime) 1000000))
+
+(defn- truncate [s n]
+  (let [s (str s)]
+    (if (> (count s) n) (str (subs s 0 n) "…") s)))
+
+;; --- Reading the conversation ---
+
+(defn run-summary
+  "What the conversation `messages` (see tbd.chat.schema/Message) says about the tool loop it is in.
+  A run starts at the user's last message: `:run` is a short hash of it (the same for every turn of
+  the run, which is what ties their log lines together), `:step` how many assistant messages have
+  answered it so far (0 for the first turn), `:run-calls` how many tool calls those made,
+  `:top-call` {:tool :args :count} the call made most often (nil if none), and `:input` the messages
+  of the run, the user's first."
+  [messages]
+  (let [messages (vec messages)
+        user-at (last (keep-indexed (fn [i {:keys [role]}] (when (= "user" role) i)) messages))
+        input (if user-at (subvec messages user-at) messages)
+        answers (filter #(= "assistant" (:role %)) input)
+        calls (into [] (mapcat :tool-calls) answers)
+        [[tool args] n] (when (seq calls)
+                          (apply max-key val (frequencies (map (juxt :name :arguments) calls))))]
+    {:run (if user-at (format "%08x" (bit-and 0xffffffff (hash (:content (messages user-at))))) "-")
+     :step (count answers)
+     :run-calls (count calls)
+     :top-call (when tool {:tool tool :args args :count n})
+     :input input}))
+
+;; --- Watching the reply ---
+
+(defn- split-sentences
+  "[complete pending]: the sentences of `text` that are finished (a full stop, question or exclamation
+  mark, or a line break, ends one), and the rest, which the next piece of text may go on with."
+  [text]
+  (let [parts (str/split text #"(?<=[.!?])\s+|\n+" -1)
+        complete (pop parts)
+        pending (peek parts)]
+    (if (> (count pending) max-pending-chars)
+      [(conj complete pending) ""]
+      [complete pending])))
+
+(defn- repeat-milestone?
+  "True at the count that is worth a log line: `repeat-warn-count`, then each doubling of it."
+  [n]
+  (and (>= n repeat-warn-count)
+       (zero? (rem n repeat-warn-count))
+       (let [q (quot n repeat-warn-count)] (zero? (bit-and q (dec q))))))
+
+(defn- count-sentence
+  "[seen alerts], with `sentence` counted in `seen` ({normalized sentence count}); an alert if it
+  has now been said often enough. Case, spacing and the mark that ends it don't make a sentence
+  another: a model that loops varies those as it likes."
+  [[seen alerts] sentence]
+  (let [k (-> sentence str/trim str/lower-case (str/replace #"\s+" " ") (str/replace #"[.!?]+$" ""))]
+    (if (or (< (count k) repeat-min-length)
+            (and (not (contains? seen k)) (>= (count seen) max-distinct-sentences)))
+      [seen alerts]
+      (let [n (inc (get seen k 0))]
+        [(assoc seen k n)
+         (cond-> alerts
+           (repeat-milestone? n) (conj {:kind :repeated-thinking :count n
+                                        :text (truncate sentence sample-length)}))]))))
+
+(defn- think
+  "[state' alerts] after `text` of the model's reasoning."
+  [state text now full?]
+  (let [state (cond-> (-> state
+                          (update :thinking-events inc)
+                          (update :thinking-chars + (count text))
+                          (update :first-thinking-at #(or % now)))
+                full? (update :reasoning conj text))
+        [complete pending] (split-sentences (str (:pending state) text))
+        [seen alerts] (reduce count-sentence [(:seen state) []] complete)
+        chars (:thinking-chars state)
+        long? (>= chars (:next-long-warn state))]
+    [(cond-> (assoc state :pending pending :seen seen)
+       long? (update :next-long-warn * 2))
+     (cond-> alerts
+       long? (conj {:kind :long-reasoning :chars chars :elapsed-ms (- now (:t0 state))}))]))
+
+(defn- advance
+  "[state' alerts]: `state` after one event of the LLM's reply (tbd.chat.core/event-of's map)."
+  [state {:keys [content thinking call-deltas finish-reason usage]} now full?]
+  (let [state (cond-> (-> state
+                          (update :events inc)
+                          (update :first-event-at #(or % now)))
+                content (-> (update :content-chars + (count content))
+                            (update :first-content-at #(or % now)))
+                (and content full?) (update :reply conj content)
+                (seq call-deltas) (update :first-call-at #(or % now))
+                finish-reason (assoc :finish-reason finish-reason)
+                usage (assoc :usage usage))]
+    (if (seq thinking)
+      (think state thinking now full?)
+      [state []])))
+
+;; --- Sinks: where entries go ---
+
+(def ^:private lock (Object.))
+
+(def ^:private field-order
+  [:req :run :step :kind :outcome :page :model :messages :tools :prompt-chars :run-calls :duration-ms
+   :ttft-ms :think-ms :events :thinking-chars :content-chars :finish-reason :prompt-tokens
+   :completion-tokens :count :chars :elapsed-ms :tool :args :text :calls :flags :error :detail])
+
+(def ^:private heavy-fields
+  "What only the trace file gets."
+  #{:reasoning :reply :input})
+
+(defn- render-field [k v]
+  (str (name k) "="
+       (cond
+         (keyword? v) (name v)
+         (= :calls k) (pr-str (str/join "; " (map (fn [{:keys [name args]}] (str name (truncate args 120))) v)))
+         (and (sequential? v) (every? keyword? v)) (str/join "," (map name v))
+         (and (string? v) (re-matches #"[\w./:@-]+" v)) v
+         :else (pr-str v))))
+
+(defn render
+  "An entry as the line the log gets: `[tbd] chat turn-end req=ab12cd34 outcome=done ...`. Without the
+  heavy fields (see the ns docstring), and without what is nil or empty."
+  [{:keys [event] :as entry}]
+  (let [order (zipmap field-order (range))
+        fields (->> (reduce dissoc entry (cons :event heavy-fields))
+                    (remove (fn [[_ v]] (or (nil? v) (and (coll? v) (empty? v)))))
+                    (sort-by (fn [[k _]] [(get order k (count field-order)) (name k)])))]
+    (str "[tbd] chat " (name event) (apply str (for [[k v] fields] (str " " (render-field k v)))))))
+
+(defn- json [data] (slurp (m/encode "application/json" data)))
+
+(defn sink
+  "A fn that takes entries: prints each with `render`, and appends it to `file`, if there is one, as a
+  line of JSON with a timestamp and all its fields. A file that can't be written to is complained
+  about, and never fails the chat."
+  [file]
+  (when file (io/make-parents (io/file file)))
+  (fn [entry]
+    (locking lock
+      (println (render entry))
+      (when file
+        (try (spit file (str (json (-> (into {} (remove (comp nil? val)) entry)
+                                       (assoc :ts (str (Instant/now)))))
+                             "\n")
+                   :append true)
+             (catch Exception e
+               (println "[tbd] chat: can't write the trace file" file (str "(" (.getMessage e) ")"))))))))
+
+(defn config-for
+  "The trace config (what `begin!` takes) for a trace file, or none if `file` is nil: the entries are
+  logged either way, and the text of the reasoning and the replies goes to the file only."
+  [file]
+  {:sink (sink file) :full-text? (some? file) :file file})
+
+(def default-config
+  "Log lines only."
+  (config-for nil))
+
+;; --- Tracing a turn ---
+
+(defn- log! [{:keys [sink ids]} event fields]
+  (try (sink (merge {:event event} ids fields))
+       (catch Throwable _ nil)))
+
+(defn begin!
+  "Starts tracing a turn, and logs `:turn-start`; `messages`, `tools` and `page` are the request's, and
+  `model` the LLM's, if the config names one. `trace` is a config of `config-for`, or nil for
+  `default-config`. Returns the tracer."
+  [trace {:keys [messages tools page model]}]
+  (let [{:keys [sink full-text?]} (or trace default-config)
+        {:keys [run step run-calls top-call input]} (run-summary messages)
+        tracer {:sink sink :full-text? full-text?
+                :ids {:req (subs (str (random-uuid)) 0 8) :run run :step step}
+                :state (atom {:t0 (now-ms) :events 0 :thinking-events 0 :thinking-chars 0
+                              :content-chars 0 :next-long-warn reasoning-warn-chars
+                              :seen {} :pending "" :reasoning [] :reply [] :flags #{}})}]
+    (log! tracer :turn-start
+          (cond-> {:page page :model model :messages (count messages) :tools (count tools)
+                   :prompt-chars (transduce (map #(count (:content %))) + 0 messages)
+                   :run-calls run-calls}
+            full-text? (assoc :input input)))
+    (when (and top-call (>= (:count top-call) repeated-call-warn-count))
+      (log! tracer :loop-suspect {:kind :repeated-call :tool (:tool top-call) :count (:count top-call)
+                                  :args (truncate (:args top-call) sample-length)}))
+    tracer))
+
+(defn observe!
+  "Takes one event of the LLM's reply (see tbd.chat.core/event-of: any of :content, :thinking,
+  :call-deltas, :finish-reason, :usage), logging a `:loop-suspect` if the reasoning has gone on for
+  long, or is repeating itself."
+  [{:keys [state full-text?] :as tracer} event]
+  (let [[state' alerts] (advance @state event (now-ms) full-text?)]
+    (reset! state (update state' :flags into (map :kind) alerts))
+    (doseq [alert alerts]
+      (log! tracer :loop-suspect alert))))
+
+(defn finish!
+  "Ends the turn, logging `:turn-end`; only the first call does anything, so it is safe to call
+  again in a `finally`. `outcome` is a map: {:outcome :done | :tool-calls | :error | :upstream-error
+  | :aborted, :calls [{:name :arguments}] for :tool-calls, :error text and :detail text for the
+  failures}. :aborted is a turn that just stopped (the client went away, or something threw)."
+  [{:keys [state full-text?] :as tracer} {:keys [outcome calls error detail]}]
+  (let [s @state]
+    (when-not (:finished? s)
+      (swap! state assoc :finished? true)
+      (let [now (now-ms)
+            {:keys [t0 first-event-at first-thinking-at first-content-at first-call-at usage]} s
+            answered-at (or first-content-at first-call-at)
+            flags (cond-> (:flags s) (= "length" (:finish-reason s)) (conj :truncated))]
+        (log! tracer :turn-end
+              (cond-> {:outcome outcome
+                       :duration-ms (- now t0)
+                       :ttft-ms (some-> first-event-at (- t0))
+                       :think-ms (when first-thinking-at (- (or answered-at now) first-thinking-at))
+                       :events (:events s)
+                       :thinking-chars (:thinking-chars s)
+                       :content-chars (:content-chars s)
+                       :finish-reason (:finish-reason s)
+                       :prompt-tokens (:prompt_tokens usage)
+                       :completion-tokens (:completion_tokens usage)
+                       :calls (mapv (fn [{:keys [name arguments]}]
+                                      {:name name :args (truncate arguments max-args-length)})
+                                    calls)
+                       :error error
+                       :detail detail
+                       :flags (vec (sort flags))}
+                full-text? (assoc :reasoning (str/join (:reasoning s))
+                                  :reply (str/join (:reply s)))))))))

src/tbd/core.clj

@@ -147,6 +147,8 @@
       (println "[tbd] WARNING: SESSION_SECRET is not set; logins won't survive a restart"))
     (when-not (chat/configured? (:chat config))
       (println "[tbd] LMSTUDIO_URL is not set; the chatbot is unavailable"))
+    (when-let [file (get-in config [:chat :trace :file])]
+      (println (str "[tbd] chat: tracing every turn, reasoning and replies included, to " file)))
     (try
       (let [server (jetty/run-jetty (wrap-defaults app api-defaults)
                                     {:port port

src/tbd/oauth/db.clj

@@ -6,7 +6,8 @@
             [clojure.java.io :as io]
             [clojure.string :as str]
             [next.jdbc :as jdbc]
-            [next.jdbc.result-set :as rs]))
+            [next.jdbc.result-set :as rs]
+            [tbd.sqlite :as sqlite]))
 
 (def default-path "data/oauth.db")
 
@@ -17,6 +18,22 @@
    (let [path (get env "OAUTH_DB_PATH")]
      {:db-path (if (str/blank? path) default-path (str/trim path))})))
 
+;; A user's approval of a client: the current access and refresh token (hashed), replaced
+;; together when the refresh token is used. Deleting the row revokes the approval. `id` is a
+;; UUID (see tbd.sqlite/new-id); `user_id` is the user's id in Gitea, which the app doesn't issue.
+(def ^:private create-grants
+  "CREATE TABLE IF NOT EXISTS grants (
+     id                 TEXT    PRIMARY KEY,
+     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)")
+
 (defn- migrate! [ds]
   ;; Clients register themselves (RFC 7591), so a row here says nothing about who the user is.
   (jdbc/execute! ds ["CREATE TABLE IF NOT EXISTS clients (
@@ -34,19 +51,8 @@
                         code_challenge TEXT    NOT NULL,
                         scope          TEXT    NOT NULL,
                         expires_at     INTEGER NOT NULL)"])
-  ;; A user's approval of a client: the current access and refresh token (hashed), replaced
-  ;; together when the refresh token is used. Deleting the row revokes the approval.
-  (jdbc/execute! ds ["CREATE TABLE IF NOT EXISTS 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)"])
+  (sqlite/migrate-integer-id! ds "grants" create-grants)
+  (jdbc/execute! ds [create-grants])
   (jdbc/execute! ds ["CREATE INDEX IF NOT EXISTS grants_by_client ON grants (client_id)"]))
 
 (defn open
@@ -107,10 +113,10 @@
 (defn insert-grant!
   [ds {:keys [client-id user-id login scope access-hash access-expires-at
               refresh-hash refresh-expires-at created-at]}]
-  (jdbc/execute! ds ["INSERT INTO grants (client_id, user_id, login, scope, access_hash, access_expires_at,
+  (jdbc/execute! ds ["INSERT INTO grants (id, client_id, user_id, login, scope, access_hash, access_expires_at,
                                           refresh_hash, refresh_expires_at, created_at)
-                      VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?)"
-                     client-id user-id login scope access-hash access-expires-at
+                      VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)"
+                     (sqlite/new-id) client-id user-id login scope access-hash access-expires-at
                      refresh-hash refresh-expires-at created-at]))
 
 (defn find-grant-by-access

src/tbd/sqlite.clj

@@ -0,0 +1,37 @@
+(ns tbd.sqlite
+  "What the app's SQLite databases (tbd.todo.db, tbd.oauth.db) share: the ids of the rows they
+  own, and moving a table off the integer ids it used to have."
+  (:require [clojure.string :as str]
+            [next.jdbc :as jdbc]
+            [next.jdbc.result-set :as rs]))
+
+(defn new-id
+  "An id for a row this app owns: a random UUID, as lowercase text. Never an integer: an LLM that
+  reads `7` as a todo's id confuses it with a 7 in a title, and a UUID is nothing else."
+  []
+  (str (random-uuid)))
+
+(defn- integer-id? [tx table]
+  (boolean
+    (some (fn [{:keys [name type]}] (and (= "id" name) (= "INTEGER" (str/upper-case type))))
+          (jdbc/execute! tx [(str "PRAGMA table_info(" table ")")]
+                         {:builder-fn rs/as-unqualified-maps}))))
+
+(defn migrate-integer-id!
+  "If `table` still has the INTEGER id it was first created with, recreates it with `create-sql`
+  (its current definition, an id TEXT PRIMARY KEY) and gives each row a UUID, keeping the
+  rows' order and everything else in them. Does nothing for a new database or one already
+  migrated. Runs in a transaction, so a failure leaves the old table as it was."
+  [ds table create-sql]
+  (jdbc/with-transaction [tx ds]
+    (when (integer-id? tx table)
+      (let [rows (jdbc/execute! tx [(str "SELECT * FROM " table " ORDER BY id")]
+                                {:builder-fn rs/as-unqualified-maps})]
+        (jdbc/execute! tx [(str "DROP TABLE " table)])
+        (jdbc/execute! tx [create-sql])
+        (doseq [row rows
+                :let [row (assoc row :id (new-id))
+                      columns (keys row)]]
+          (jdbc/execute! tx (into [(str "INSERT INTO " table " (" (str/join ", " (map name columns)) ")"
+                                        " VALUES (" (str/join ", " (repeat (count columns) "?")) ")")]
+                                  (map row columns))))))))

src/tbd/todo/db.clj

@@ -5,7 +5,8 @@
   (:require [clojure.java.io :as io]
             [clojure.string :as str]
             [next.jdbc :as jdbc]
-            [next.jdbc.result-set :as rs]))
+            [next.jdbc.result-set :as rs]
+            [tbd.sqlite :as sqlite]))
 
 (def default-path "data/todo.db")
 
@@ -16,15 +17,21 @@
    (let [path (get env "TODO_DB_PATH")]
      {:db-path (if (str/blank? path) default-path (str/trim path))})))
 
+(def ^:private create-todos
+  ;; `id` is a UUID (see tbd.sqlite/new-id); `owner_id` is the user's id in Gitea, which the app
+  ;; doesn't issue, so it stays the integer Gitea gave.
+  "CREATE TABLE IF NOT EXISTS todos (
+     id         TEXT    PRIMARY KEY,
+     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)")
+
 (defn- migrate! [ds]
-  (jdbc/execute! ds ["CREATE TABLE IF NOT EXISTS 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! ds ["CREATE INDEX IF NOT EXISTS todos_by_owner ON todos (owner_id, id)"]))
+  (sqlite/migrate-integer-id! ds "todos" create-todos)
+  (jdbc/execute! ds [create-todos])
+  (jdbc/execute! ds ["CREATE INDEX IF NOT EXISTS todos_by_owner ON todos (owner_id, created_at)"]))
 
 (defn open
   "A datasource for the database file at `path`, created and migrated if need be. Each query
@@ -45,17 +52,19 @@
   (some-> row (update :done #(= 1 %))))
 
 (defn insert!
-  "Stores a todo (as built by tbd.todo.core/new-todo) and returns it with its :id."
+  "Stores a todo (as built by tbd.todo.core/new-todo) and returns it with its new :id, a UUID."
   [ds {:keys [owner-id title done created-at updated-at]}]
   (row->todo
-    (jdbc/execute-one! ds ["INSERT INTO todos (owner_id, title, done, created_at, updated_at)
-                            VALUES (?, ?, ?, ?, ?) RETURNING *"
-                           owner-id title (if done 1 0) created-at updated-at]
+    (jdbc/execute-one! ds ["INSERT INTO todos (id, owner_id, title, done, created_at, updated_at)
+                            VALUES (?, ?, ?, ?, ?, ?) RETURNING *"
+                           (sqlite/new-id) owner-id title (if done 1 0) created-at updated-at]
                        opts)))
 
-(defn list-todos [ds owner-id]
+(defn list-todos
+  "The owner's todos, oldest first (ids are random, so they say nothing of the order)."
+  [ds owner-id]
   (mapv row->todo
-        (jdbc/execute! ds ["SELECT * FROM todos WHERE owner_id = ? ORDER BY id" owner-id] opts)))
+        (jdbc/execute! ds ["SELECT * FROM todos WHERE owner_id = ? ORDER BY created_at, rowid" owner-id] opts)))
 
 (defn find-todo
   "The owner's todo with this id, or nil (including when it belongs to someone else)."

src/tbd/todo/schema.clj

@@ -8,7 +8,11 @@
   (:require [malli.util :as mu]
             [tbd.todo.core :as todo]))
 
-(def Id [:int {:description "Todo id"}])
+(def Id
+  "A todo's id: a UUID, as lowercase text (see tbd.sqlite/new-id), kept a string all the way through."
+  [:re {:description "Todo id, a UUID such as 3f2b8c1e-5a47-4d0e-9b6a-1c2d3e4f5a6b"
+        :error/message "should be a UUID"}
+   #"^[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}$"])
 
 (def Title
   [:string {:description (format "What needs doing; trimmed, non-blank, at most %d characters"