diff --git a/README.md b/README.md index 41c8c9b..720f157 100644 --- a/README.md +++ b/README.md @@ -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 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 (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 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 -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//schema.clj`, the same schema the 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 diff --git a/src/tbd/mcp/tools.clj b/src/tbd/mcp/tools.clj index dbf647e..c66c62c 100644 --- a/src/tbd/mcp/tools.clj +++ b/src/tbd/mcp/tools.clj @@ -1,9 +1,11 @@ (ns tbd.mcp.tools "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..core) - and storage; it has no rules of its own. Its arguments are described by the group's Malli schema - (tbd..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). + Like the HTTP handlers, a tool is a thin adapter over a group's business logic: pure functions + (tbd..core) or, for a group with storage, its service (tbd..service), which the + HTTP routes call too. A tool has no rules of its own and never touches a database. Its + arguments are described by the group's Malli schema (tbd..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, 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.mcp.schema :refer [tool ctx-get]] [tbd.oauth.middleware :as oauth-mw] - [tbd.todo.core :as todo] - [tbd.todo.db :as todo-db] - [tbd.todo.schema :as todo-schema])) + [tbd.todo.schema :as todo-schema] + [tbd.todo.service :as todo])) (def todo-ds-key "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- 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]}] - (or ok (throw (ex-info error {})))) + (if error (throw (ex-info error {})) ok)) -(defn- now [] (System/currentTimeMillis)) - -;; 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})))) +;; Todos belong to the caller, and tbd.todo.service scopes every operation to them. +(defn- todo-ds [ctx] (ctx-get ctx todo-ds-key)) (def primitives {:tools @@ -62,23 +55,20 @@ (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] - (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 - (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 - (fn [{:keys [title]} ctx] - (->json (todo-db/insert! (todo-ds ctx) (ok! (todo/new-todo (owner-id ctx) title (now))))))) + (fn [{:keys [title]} ctx] (->json (ok! (todo/create! (todo-ds ctx) (current-user ctx) title))))) (tool "update_todo" "Changes the title and/or done flag of one of your todos and returns it (JSON)" todo-schema/UpdateTodo (fn [{:keys [id] :as input} ctx] - (let [changed (ok! (todo/apply-changes (find-todo! ctx id) (dissoc input :id) (now)))] - (->json (todo-db/update! (todo-ds ctx) (owner-id ctx) changed))))) + (->json (ok! (todo/update! (todo-ds ctx) (current-user ctx) id (dissoc input :id)))))) (tool "delete_todo" "Deletes one of your todos" todo-schema/IdParam (fn [{:keys [id]} ctx] - (find-todo! ctx id) - (todo-db/delete! (todo-ds ctx) (owner-id ctx) id) + (ok! (todo/delete! (todo-ds ctx) (current-user ctx) id)) "deleted"))]}) diff --git a/src/tbd/todo/routes.clj b/src/tbd/todo/routes.clj index 9d2d1a3..51a8d51 100644 --- a/src/tbd/todo/routes.clj +++ b/src/tbd/todo/routes.clj @@ -1,49 +1,42 @@ (ns tbd.todo.routes (:require [tbd.http :refer [respond]] [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 -;; todo is answered exactly like a missing one, so ids can't be probed. -(defn- owner-id [req] (get-in req [:user :id])) - -(defn- now [] (System/currentTimeMillis)) +(defn- reply + "The response for a service `result`: `status` and `(shape value)` when it is ok, else the + error's status and message." + ([status result] (reply status identity result)) + ([status shape {:keys [ok error kind]}] + (if error + (respond (error-status kind) {:error error}) + (respond status (shape ok))))) (defn- list-handler [ds] - (fn [req] - (respond 200 {:todos (db/list-todos @ds (owner-id req))}))) + (fn [{:keys [user]}] + (reply 200 (fn [todos] {:todos todos}) (service/list-todos ds user)))) (defn- create-handler [ds] - (fn [{{{:keys [title]} :body} :parameters :as req}] - (let [{:keys [ok error]} (todo/new-todo (owner-id req) title (now))] - (if error - (respond 400 {:error error}) - (respond 201 (db/insert! @ds ok)))))) + (fn [{{{:keys [title]} :body} :parameters :keys [user]}] + (reply 201 (service/create! ds user title)))) (defn- get-handler [ds] - (fn [{{{:keys [id]} :path} :parameters :as req}] - (if-let [found (db/find-todo @ds (owner-id req) id)] - (respond 200 found) - not-found))) + (fn [{{{:keys [id]} :path} :parameters :keys [user]}] + (reply 200 (service/find-todo ds user id)))) (defn- patch-handler [ds] - (fn [{{{:keys [id]} :path changes :body} :parameters :as req}] - (let [owner (owner-id req)] - (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)))) + (fn [{{{:keys [id]} :path changes :body} :parameters :keys [user]}] + (reply 200 (service/update! ds user id changes)))) (defn- delete-handler [ds] - (fn [{{{:keys [id]} :path} :parameters :as req}] - (if (db/delete! @ds (owner-id req) id) - (respond 200 {:deleted true}) - not-found))) + (fn [{{{:keys [id]} :path} :parameters :keys [user]}] + (reply 200 (fn [_] {:deleted true}) (service/delete! ds user id)))) (defn routes "`ds` is a delay of the todo database (see tbd.todo.db/open), shared with the MCP tools." diff --git a/src/tbd/todo/schema.clj b/src/tbd/todo/schema.clj index b0efc5d..6ef38fd 100644 --- a/src/tbd/todo/schema.clj +++ b/src/tbd/todo/schema.clj @@ -3,7 +3,8 @@ 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 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] [tbd.todo.core :as todo])) diff --git a/src/tbd/todo/service.clj b/src/tbd/todo/service.clj new file mode 100644 index 0000000..cde156a --- /dev/null +++ b/src/tbd/todo/service.clj @@ -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)) diff --git a/test/tbd/mcp/routes_test.clj b/test/tbd/mcp/routes_test.clj index ff6a991..48e58a9 100644 --- a/test/tbd/mcp/routes_test.clj +++ b/test/tbd/mcp/routes_test.clj @@ -211,40 +211,31 @@ (is (= 200 (:status (app {:request-method :get :uri "/api/add" :query-string "x=2&y=3"}))))))) (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) alice-sid (initialize app alice) bob-sid (initialize app bob) - call (fn [token sid tool arguments] (call-tool app token sid tool arguments)) - as-alice (partial call alice alice-sid) - as-bob (partial call bob bob-sid) - result (fn [resp] (:result resp)) + as-alice (partial call-tool app alice alice-sid) + as-bob (partial call-tool app bob bob-sid) data (fn [resp] (m/decode "application/json" (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 "})) 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 (integer? id))) - (testing "get and list" - (is (= created (data (as-alice "get_todo" {:id id})))) - (is (= [created] (data (as-alice "list_todos" {}))))) - (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 (= {: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 (= [created] (data (as-alice "list_todos" {})))) + (is (= {:title "ship it" :done true} + (select-keys (data (as-alice "update_todo" {:id id :title "ship it" :done true})) [:title :done]))) + (testing "the tools act as whoever the token belongs to" (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 tool args))) tool)) - (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 (= "todo not found" (error (as-bob "get_todo" {:id id}))))) + (testing "a service error is an error result the model can read" (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}))))) - (testing "delete" - (is (= "deleted" (text (as-alice "delete_todo" {:id id})))) - (is (= "todo not found" (error (as-alice "get_todo" {:id id})))) - (is (= [] (data (as-alice "list_todos" {})))))))) + (is (= "deleted" (text (as-alice "delete_todo" {:id id})))) + (is (= "todo not found" (error (as-alice "get_todo" {:id id}))))))) (deftest tool-arguments-are-validated-test (let [{:keys [app alice]} (fixture) diff --git a/test/tbd/todo/service_test.clj b/test/tbd/todo/service_test.clj new file mode 100644 index 0000000..53e9854 --- /dev/null +++ b/test/tbd/todo/service_test.clj @@ -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)))))