service-ize
CI / Test + coverage (push) Successful in 27s

This commit is contained in:
2026-09-19 13:57:13 -09:00
parent 5aaf5a8d6c
commit 1f907cfe7b
7 changed files with 206 additions and 85 deletions
+8 -2
View File
@@ -83,7 +83,11 @@ Handlers return plain data (`(tbd.http/respond 200 {:result 5})`), and the muunt
Each logged-in user has their own todo list, keyed by their Gitea user id. Every query is Each logged-in user has their own todo list, keyed by their Gitea user id. Every query is
filtered by that id, so users can't see or change each other's todos; someone else's todo answers filtered by that id, so users can't see or change each other's todos; someone else's todo answers
`404`, exactly like a missing one. Without a login the todo routes answer `401`. `404`, exactly like a missing one. Without a login the todo routes answer `401`. The operations
themselves (ownership, validation, storage) live in `src/tbd/todo/service.clj`, which the HTTP routes
and the [MCP tools](#mcp-server) both call, so they behave the same and are tested once; a route or
tool only translates its request into a service call and the result into a response, and never
touches the database.
Todos are stored in a local [SQLite](https://www.sqlite.org/) file, `data/todo.db` by default Todos are stored in a local [SQLite](https://www.sqlite.org/) file, `data/todo.db` by default
(git-ignored), which is created and migrated on the first todo request. Set `TODO_DB_PATH` to put it (git-ignored), which is created and migrated on the first todo request. Set `TODO_DB_PATH` to put it
@@ -117,7 +121,9 @@ be the address the client uses; without them `/mcp` answers `503` rather than be
It offers these tools: `ping`, `add` (the same logic as `/api/add`), `whoami` (which user this It offers these tools: `ping`, `add` (the same logic as `/api/add`), `whoami` (which user this
connection acts as, and whether they are an admin), and, on the caller's own todos (the same ones connection acts as, and whether they are an admin), and, on the caller's own todos (the same ones
as `/api/todos`), `list_todos`, `get_todo`, `create_todo`, `update_todo` and `delete_todo`. To add a as `/api/todos`), `list_todos`, `get_todo`, `create_todo`, `update_todo` and `delete_todo`. To add a
tool, add a `tool` to `src/tbd/mcp/tools.clj`. Its arguments are described by the group's tool, add a `tool` to `src/tbd/mcp/tools.clj`; it should call the group's service (or pure `core`
functions), not a database, and if the group has no service yet, that is the thing to add, so the
HTTP routes can share it. Its arguments are described by the group's
[Malli](https://github.com/metosin/malli) schema in `src/tbd/<group>/schema.clj`, the same schema the [Malli](https://github.com/metosin/malli) schema in `src/tbd/<group>/schema.clj`, the same schema the
HTTP routes use for their parameters, so a shape of data is written down once: the tool's HTTP routes use for their parameters, so a shape of data is written down once: the tool's
input schema is generated from it, and the arguments a client sends are coerced and validated against input schema is generated from it, and the arguments a client sends are coerced and validated against
+17 -27
View File
@@ -1,9 +1,11 @@
(ns tbd.mcp.tools (ns tbd.mcp.tools
"The MCP tools the server offers, in the shape plumcp's server options take as `:primitives`. "The MCP tools the server offers, in the shape plumcp's server options take as `:primitives`.
Like the HTTP handlers, a tool is a thin adapter over a group's business logic (tbd.<group>.core) Like the HTTP handlers, a tool is a thin adapter over a group's business logic: pure functions
and storage; it has no rules of its own. Its arguments are described by the group's Malli schema (tbd.<group>.core) or, for a group with storage, its service (tbd.<group>.service), which the
(tbd.<group>.schema), the same one the HTTP routes use, so shapes are defined once and every tool HTTP routes call too. A tool has no rules of its own and never touches a database. Its
gets its input schema and argument validation from them (see tbd.mcp.schema). arguments are described by the group's Malli schema (tbd.<group>.schema), the same one the HTTP
routes use, so shapes are defined once and every tool gets its input schema and argument
validation from them (see tbd.mcp.schema).
A tool function takes the coerced arguments and the request context, and returns a string, A tool function takes the coerced arguments and the request context, and returns a string,
number, boolean or vector of content, or throws: an exception becomes an error result the model number, boolean or vector of content, or throws: an exception becomes an error result the model
@@ -13,9 +15,8 @@
[tbd.math.schema :as math-schema] [tbd.math.schema :as math-schema]
[tbd.mcp.schema :refer [tool ctx-get]] [tbd.mcp.schema :refer [tool ctx-get]]
[tbd.oauth.middleware :as oauth-mw] [tbd.oauth.middleware :as oauth-mw]
[tbd.todo.core :as todo] [tbd.todo.schema :as todo-schema]
[tbd.todo.db :as todo-db] [tbd.todo.service :as todo]))
[tbd.todo.schema :as todo-schema]))
(def todo-ds-key (def todo-ds-key
"Where the todo database (a delay, as for the HTTP routes) is in the request's plumcp runtime "Where the todo database (a delay, as for the HTTP routes) is in the request's plumcp runtime
@@ -33,20 +34,12 @@
(defn- ->json [data] (slurp (m/encode "application/json" data))) (defn- ->json [data] (slurp (m/encode "application/json" data)))
(defn- ok! (defn- ok!
"The value of a todo.core result, or throws its error." "The value of a service result, or throws its error (which reaches the model as an error result)."
[{:keys [ok error]}] [{:keys [ok error]}]
(or ok (throw (ex-info error {})))) (if error (throw (ex-info error {})) ok))
(defn- now [] (System/currentTimeMillis)) ;; Todos belong to the caller, and tbd.todo.service scopes every operation to them.
(defn- todo-ds [ctx] (ctx-get ctx todo-ds-key))
;; Todos belong to the caller. Someone else's is reported exactly like a missing one.
(defn- todo-ds [ctx] @(ctx-get ctx todo-ds-key))
(defn- owner-id [ctx] (:id (current-user ctx)))
(defn- find-todo! [ctx id]
(or (todo-db/find-todo (todo-ds ctx) (owner-id ctx) id)
(throw (ex-info "todo not found" {:id id}))))
(def primitives (def primitives
{:tools {:tools
@@ -62,23 +55,20 @@
(format "%s (Gitea user %d)%s" login id (if admin? ", admin" ""))))) (format "%s (Gitea user %d)%s" login id (if admin? ", admin" "")))))
(tool "list_todos" "Lists your todos (JSON: id, title, done, created-at, updated-at), oldest first" [:map] (tool "list_todos" "Lists your todos (JSON: id, title, done, created-at, updated-at), oldest first" [:map]
(fn [_ ctx] (->json (todo-db/list-todos (todo-ds ctx) (owner-id ctx))))) (fn [_ ctx] (->json (ok! (todo/list-todos (todo-ds ctx) (current-user ctx))))))
(tool "get_todo" "Gets one of your todos by id (JSON)" todo-schema/IdParam (tool "get_todo" "Gets one of your todos by id (JSON)" todo-schema/IdParam
(fn [{:keys [id]} ctx] (->json (find-todo! ctx id)))) (fn [{:keys [id]} ctx] (->json (ok! (todo/find-todo (todo-ds ctx) (current-user ctx) id)))))
(tool "create_todo" "Creates a todo for you and returns it (JSON)" todo-schema/NewTodo (tool "create_todo" "Creates a todo for you and returns it (JSON)" todo-schema/NewTodo
(fn [{:keys [title]} ctx] (fn [{:keys [title]} ctx] (->json (ok! (todo/create! (todo-ds ctx) (current-user ctx) title)))))
(->json (todo-db/insert! (todo-ds ctx) (ok! (todo/new-todo (owner-id ctx) title (now)))))))
(tool "update_todo" "Changes the title and/or done flag of one of your todos and returns it (JSON)" (tool "update_todo" "Changes the title and/or done flag of one of your todos and returns it (JSON)"
todo-schema/UpdateTodo todo-schema/UpdateTodo
(fn [{:keys [id] :as input} ctx] (fn [{:keys [id] :as input} ctx]
(let [changed (ok! (todo/apply-changes (find-todo! ctx id) (dissoc input :id) (now)))] (->json (ok! (todo/update! (todo-ds ctx) (current-user ctx) id (dissoc input :id))))))
(->json (todo-db/update! (todo-ds ctx) (owner-id ctx) changed)))))
(tool "delete_todo" "Deletes one of your todos" todo-schema/IdParam (tool "delete_todo" "Deletes one of your todos" todo-schema/IdParam
(fn [{:keys [id]} ctx] (fn [{:keys [id]} ctx]
(find-todo! ctx id) (ok! (todo/delete! (todo-ds ctx) (current-user ctx) id))
(todo-db/delete! (todo-ds ctx) (owner-id ctx) id)
"deleted"))]}) "deleted"))]})
+24 -31
View File
@@ -1,49 +1,42 @@
(ns tbd.todo.routes (ns tbd.todo.routes
(:require [tbd.http :refer [respond]] (:require [tbd.http :refer [respond]]
[tbd.todo.core :as todo] [tbd.todo.core :as todo]
[tbd.todo.db :as db] [tbd.todo.schema :as schema]
[tbd.todo.schema :as schema])) [tbd.todo.service :as service]))
(def ^:private not-found (respond 404 {:error "todo not found"})) ;; Todos belong to the logged-in user (:login? true puts them on the request as :user); the
;; rules, and the scoping to that user, are tbd.todo.service's, shared with the MCP tools. These
;; handlers only turn a service result into a response.
(def ^:private error-status {:invalid 400 :not-found 404})
;; Todos belong to the logged-in user (:login? true puts them on the request). Someone else's (defn- reply
;; todo is answered exactly like a missing one, so ids can't be probed. "The response for a service `result`: `status` and `(shape value)` when it is ok, else the
(defn- owner-id [req] (get-in req [:user :id])) error's status and message."
([status result] (reply status identity result))
(defn- now [] (System/currentTimeMillis)) ([status shape {:keys [ok error kind]}]
(if error
(respond (error-status kind) {:error error})
(respond status (shape ok)))))
(defn- list-handler [ds] (defn- list-handler [ds]
(fn [req] (fn [{:keys [user]}]
(respond 200 {:todos (db/list-todos @ds (owner-id req))}))) (reply 200 (fn [todos] {:todos todos}) (service/list-todos ds user))))
(defn- create-handler [ds] (defn- create-handler [ds]
(fn [{{{:keys [title]} :body} :parameters :as req}] (fn [{{{:keys [title]} :body} :parameters :keys [user]}]
(let [{:keys [ok error]} (todo/new-todo (owner-id req) title (now))] (reply 201 (service/create! ds user title))))
(if error
(respond 400 {:error error})
(respond 201 (db/insert! @ds ok))))))
(defn- get-handler [ds] (defn- get-handler [ds]
(fn [{{{:keys [id]} :path} :parameters :as req}] (fn [{{{:keys [id]} :path} :parameters :keys [user]}]
(if-let [found (db/find-todo @ds (owner-id req) id)] (reply 200 (service/find-todo ds user id))))
(respond 200 found)
not-found)))
(defn- patch-handler [ds] (defn- patch-handler [ds]
(fn [{{{:keys [id]} :path changes :body} :parameters :as req}] (fn [{{{:keys [id]} :path changes :body} :parameters :keys [user]}]
(let [owner (owner-id req)] (reply 200 (service/update! ds user id changes))))
(if-let [found (db/find-todo @ds owner id)]
(let [{:keys [ok error]} (todo/apply-changes found changes (now))]
(if error
(respond 400 {:error error})
(respond 200 (db/update! @ds owner ok))))
not-found))))
(defn- delete-handler [ds] (defn- delete-handler [ds]
(fn [{{{:keys [id]} :path} :parameters :as req}] (fn [{{{:keys [id]} :path} :parameters :keys [user]}]
(if (db/delete! @ds (owner-id req) id) (reply 200 (fn [_] {:deleted true}) (service/delete! ds user id))))
(respond 200 {:deleted true})
not-found)))
(defn routes (defn routes
"`ds` is a delay of the todo database (see tbd.todo.db/open), shared with the MCP tools." "`ds` is a delay of the todo database (see tbd.todo.db/open), shared with the MCP tools."
+2 -1
View File
@@ -3,7 +3,8 @@
the HTTP routes coerce and validate requests with it (tbd.todo.routes), and the MCP tools the HTTP routes coerce and validate requests with it (tbd.todo.routes), and the MCP tools
derive their input schema and validate their arguments from it (tbd.mcp.tools). They describe derive their input schema and validate their arguments from it (tbd.mcp.tools). They describe
shape only (types, which keys may be missing); the rules on values (trimming, blank or too long shape only (types, which keys may be missing); the rules on values (trimming, blank or too long
titles, an empty change) stay in tbd.todo.core, which both callers go through." titles, an empty change) stay in tbd.todo.core, applied by tbd.todo.service, which both callers
go through."
(:require [malli.util :as mu] (:require [malli.util :as mu]
[tbd.todo.core :as todo])) [tbd.todo.core :as todo]))
+65
View File
@@ -0,0 +1,65 @@
(ns tbd.todo.service
"What a caller can do with todos: the one place that ties the rules (tbd.todo.core) to storage
(tbd.todo.db). Both front ends, the HTTP routes (tbd.todo.routes) and the MCP tools
(tbd.mcp.tools), call these and nothing lower, so ownership, not-found and validation behave the
same on both and are written (and tested) once. A front end only translates: its request into
arguments, and the result into a response.
`ds` is the delay of the todo database the app shares (opened on first use, so a caller who is
turned away earlier never opens it). `user` is the authenticated caller, {:id ...} at least
(however they proved who they are: a session or an access token); a todo is only ever reached
through its owner's id, and someone else's is reported exactly like a missing one.
Every fn returns {:ok value} or {:error message :kind kind}, where kind is :invalid (the
input is no good) or :not-found."
(:require [tbd.todo.core :as todo]
[tbd.todo.db :as db]))
(defn- now [] (System/currentTimeMillis))
(defn- owner-id [user] (:id user))
(def ^:private not-found {:error "todo not found" :kind :not-found})
(defn- invalid [{:keys [error]}] {:error error :kind :invalid})
(defn list-todos
"The user's todos, oldest first."
[ds user]
{:ok (db/list-todos @ds (owner-id user))})
(defn find-todo
"The user's todo with this id."
[ds user id]
(if-let [found (db/find-todo @ds (owner-id user) id)]
{:ok found}
not-found))
(defn create!
"Stores a new todo for the user and returns it."
[ds user title]
(let [{:keys [ok] :as built} (todo/new-todo (owner-id user) title (now))]
(if ok
{:ok (db/insert! @ds ok)}
(invalid built))))
(defn update!
"Applies `changes` (:title and/or :done) to the user's todo and returns it."
[ds user id changes]
(let [owner (owner-id user)]
(if-let [found (db/find-todo @ds owner id)]
(let [{:keys [ok] :as changed} (todo/apply-changes found changes (now))]
(if ok
;; nil only if it was deleted since the lookup.
(if-let [stored (db/update! @ds owner ok)]
{:ok stored}
not-found)
(invalid changed)))
not-found)))
(defn delete!
"Deletes the user's todo; {:ok true} once it is gone."
[ds user id]
(if (db/delete! @ds (owner-id user) id)
{:ok true}
not-found))
+15 -24
View File
@@ -211,40 +211,31 @@
(is (= 200 (:status (app {:request-method :get :uri "/api/add" :query-string "x=2&y=3"}))))))) (is (= 200 (:status (app {:request-method :get :uri "/api/add" :query-string "x=2&y=3"})))))))
(deftest todo-tools-test (deftest todo-tools-test
;; The rules (ownership, validation, not-found) are tbd.todo.service's and tested there; this is
;; the tools' side: arguments in, JSON out, the caller's identity passed on, errors as results.
(let [{:keys [app alice bob]} (fixture) (let [{:keys [app alice bob]} (fixture)
alice-sid (initialize app alice) alice-sid (initialize app alice)
bob-sid (initialize app bob) bob-sid (initialize app bob)
call (fn [token sid tool arguments] (call-tool app token sid tool arguments)) as-alice (partial call-tool app alice alice-sid)
as-alice (partial call alice alice-sid) as-bob (partial call-tool app bob bob-sid)
as-bob (partial call bob bob-sid)
result (fn [resp] (:result resp))
data (fn [resp] (m/decode "application/json" (text resp))) data (fn [resp] (m/decode "application/json" (text resp)))
error (fn [resp] (when (true? (get-in resp [:result :isError])) (text resp)))] error (fn [resp] (when (true? (get-in resp [:result :isError])) (text resp)))]
(testing "no todos yet" (is (= [] (data (as-alice "list_todos" {}))))
(is (= [] (data (as-alice "list_todos" {})))))
(let [created (data (as-alice "create_todo" {:title " write tests "})) (let [created (data (as-alice "create_todo" {:title " write tests "}))
id (:id created)] id (:id created)]
(testing "create trims the title, as the API does, and returns the todo" (is (= {:title "write tests" :done false :owner-id 7} (select-keys created [:title :done :owner-id])))
(is (= {:title "write tests" :done false :owner-id 7} (select-keys created [:title :done :owner-id]))) (is (= created (data (as-alice "get_todo" {:id id}))))
(is (integer? id))) (is (= [created] (data (as-alice "list_todos" {}))))
(testing "get and list" (is (= {:title "ship it" :done true}
(is (= created (data (as-alice "get_todo" {:id id})))) (select-keys (data (as-alice "update_todo" {:id id :title "ship it" :done true})) [:title :done])))
(is (= [created] (data (as-alice "list_todos" {}))))) (testing "the tools act as whoever the token belongs to"
(testing "update changes the title and/or done"
(is (= {:title "write tests" :done true} (select-keys (data (as-alice "update_todo" {:id id :done true})) [:title :done])))
(is (= {:title "ship it" :done true} (select-keys (data (as-alice "update_todo" {:id id :title "ship it"})) [:title :done]))))
(testing "todos are private to their owner, and someone else's is reported as missing"
(is (= [] (data (as-bob "list_todos" {})))) (is (= [] (data (as-bob "list_todos" {}))))
(doseq [[tool args] [["get_todo" {:id id}] ["update_todo" {:id id :done false}] ["delete_todo" {:id id}]]] (is (= "todo not found" (error (as-bob "get_todo" {:id id})))))
(is (= "todo not found" (error (as-bob tool args))) tool)) (testing "a service error is an error result the model can read"
(is (= "ship it" (:title (data (as-alice "get_todo" {:id id})))) "and bob's attempts changed nothing"))
(testing "the rules of tbd.todo.core apply here too"
(is (= "title must not be blank" (error (as-alice "create_todo" {:title " "})))) (is (= "title must not be blank" (error (as-alice "create_todo" {:title " "}))))
(is (= "nothing to change: give a title and/or done" (error (as-alice "update_todo" {:id id}))))) (is (= "nothing to change: give a title and/or done" (error (as-alice "update_todo" {:id id})))))
(testing "delete" (is (= "deleted" (text (as-alice "delete_todo" {:id id}))))
(is (= "deleted" (text (as-alice "delete_todo" {:id id})))) (is (= "todo not found" (error (as-alice "get_todo" {:id id})))))))
(is (= "todo not found" (error (as-alice "get_todo" {:id id}))))
(is (= [] (data (as-alice "list_todos" {}))))))))
(deftest tool-arguments-are-validated-test (deftest tool-arguments-are-validated-test
(let [{:keys [app alice]} (fixture) (let [{:keys [app alice]} (fixture)
+75
View File
@@ -0,0 +1,75 @@
(ns tbd.todo.service-test
(:require [clojure.test :refer [deftest is testing]]
[tbd.todo.core :as todo]
[tbd.todo.db :as db]
[tbd.todo.db-test :as db-test]
[tbd.todo.service :as service]))
;; The rules every front end (HTTP routes, MCP tools) gets: ownership, not-found and validation.
;; They are tested here once; the front ends' tests only cover their own translation.
(def alice {:id 7 :login "alice"})
(def bob {:id 8 :login "bob"})
(defn- fresh-ds [] (let [path (db-test/temp-db-path)] (delay (db/open path))))
(def ^:private not-found {:error "todo not found" :kind :not-found})
(deftest lifecycle-test
(let [ds (fresh-ds)]
(is (= {:ok []} (service/list-todos ds alice)))
(let [{created :ok} (service/create! ds alice " buy milk ")
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 (= {:ok created} (service/find-todo ds alice id)))
(is (= {:ok [created]} (service/list-todos ds alice)))
(testing "update changes the title and/or done"
(is (= {:title "buy milk" :done true}
(select-keys (:ok (service/update! ds alice id {:done true})) [:title :done])))
(is (= {:title "oat milk" :done true}
(select-keys (:ok (service/update! ds alice id {:title "oat milk"})) [:title :done])))
(is (= "oat milk" (:title (:ok (service/find-todo ds alice id)))) "and it is stored"))
(testing "delete"
(is (= {:ok true} (service/delete! ds alice id)))
(is (= not-found (service/find-todo ds alice id)))
(is (= not-found (service/delete! ds alice id)))
(is (= {:ok []} (service/list-todos ds alice)))))))
(deftest validation-test
(let [ds (fresh-ds)
id (:id (:ok (service/create! ds alice "keep")))]
(testing "the rules of tbd.todo.core apply, as :invalid"
(is (= {:error "title must not be blank" :kind :invalid} (service/create! ds alice " ")))
(is (= {:error (format "title must be at most %d characters" todo/max-title-length) :kind :invalid}
(service/create! ds alice (apply str (repeat (inc todo/max-title-length) "x")))))
(is (= {:error "title must not be blank" :kind :invalid} (service/update! ds alice id {:title " "})))
(is (= {:error "nothing to change: give a title and/or done" :kind :invalid}
(service/update! ds alice id {}))))
(is (= ["keep"] (map :title (:ok (service/list-todos ds alice)))) "nothing above changed anything")))
(deftest ownership-test
(let [ds (fresh-ds)
{mine :ok} (service/create! ds alice "alice's")
id (:id mine)]
(testing "each user has their own list"
(service/create! ds bob "bob's")
(is (= ["alice's"] (map :title (:ok (service/list-todos ds alice)))))
(is (= ["bob's"] (map :title (:ok (service/list-todos ds bob))))))
(testing "someone else's todo is reported exactly like a missing one"
(let [missing (service/find-todo ds bob 999999)]
(is (= not-found missing))
(is (= missing (service/find-todo ds bob id)))
(is (= missing (service/update! ds bob id {:title "hijacked"})))
(is (= missing (service/delete! ds bob id)))))
(is (= {:ok mine} (service/find-todo ds alice id)) "and alice's todo is untouched")))
(deftest database-is-opened-on-use-test
(testing "nothing opens the database until a service fn needs it"
(let [opened (atom 0)
ds (delay (swap! opened inc) (db/open (db-test/temp-db-path)))]
(is (zero? @opened))
(service/list-todos ds alice)
(service/list-todos ds alice)
(is (= 1 @opened)))))