@@ -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
@@ -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
@@ -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."
|
||||||
|
|||||||
@@ -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]))
|
||||||
|
|
||||||
|
|||||||
@@ -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))
|
||||||
@@ -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)
|
||||||
|
|||||||
@@ -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)))))
|
||||||
Reference in New Issue
Block a user