add todo api

src/tbd/auth/middleware.clj

@@ -2,7 +2,7 @@
   (:require [ring.middleware.session :refer [wrap-session]]
             [ring.middleware.session.cookie :refer [cookie-store]]
             [tbd.auth.core :as auth]
-            [tbd.http :refer [edn-response]]))
+            [tbd.http :refer [respond]]))
 
 (def session-ttl-ms (* 8 60 60 1000))
 
@@ -42,5 +42,18 @@
                     (if-let [user (current-user req)]
                       (if (auth/admin? config (:login user))
                         (handler (assoc req :user user))
-                        (edn-response 403 {:error "admin access required"}))
-                      (edn-response 401 {:error "login required"}))))))})
+                        (respond 403 {:error "admin access required"}))
+                      (respond 401 {:error "login required"}))))))})
+
+(def login-middleware
+  "Reitit middleware for routes whose data has `:login? true`: 401 without a login, otherwise
+  the user goes on as `:user` ({:login :id ...}). Like admin-middleware, mount it ahead of the
+  parsing/coercion middleware."
+  {:name ::login
+   :compile (fn [route-data _opts]
+              (when (:login? route-data)
+                (fn [handler]
+                  (fn [req]
+                    (if-let [user (current-user req)]
+                      (handler (assoc req :user user))
+                      (respond 401 {:error "login required"}))))))})

src/tbd/auth/routes.clj

@@ -2,10 +2,10 @@
   (:require [ring.util.response :as response]
             [tbd.auth.core :as auth]
             [tbd.auth.middleware :as mw]
-            [tbd.http :refer [edn-response]]))
+            [tbd.http :refer [respond]]))
 
 (def ^:private not-configured
-  (edn-response 503 {:error "OAuth is not configured (set GITEA_URL, GITEA_CLIENT_ID, GITEA_CLIENT_SECRET, BASE_URL)"}))
+  (respond 503 {:error "OAuth is not configured (set GITEA_URL, GITEA_CLIENT_ID, GITEA_CLIENT_SECRET, BASE_URL)"}))
 
 (defn- login-handler [config]
   (fn [{:keys [session]}]
@@ -20,9 +20,9 @@
     (let [{:keys [code state error]} (:query parameters)]
       (cond
         (not (auth/configured? config)) not-configured
-        (not (auth/state-matches? (:oauth-state session) state)) (edn-response 400 {:error "invalid OAuth state"})
-        error (edn-response 403 {:error "login was denied"})
-        (nil? code) (edn-response 400 {:error "missing authorization code"})
+        (not (auth/state-matches? (:oauth-state session) state)) (respond 400 {:error "invalid OAuth state"})
+        error (respond 403 {:error "login was denied"})
+        (nil? code) (respond 400 {:error "missing authorization code"})
         :else
         (try
           (let [user (some->> (auth/exchange-code config code) (auth/fetch-user config))]
@@ -31,16 +31,16 @@
               (-> (response/redirect "/")
                   (assoc :session {:user (assoc user :expires-at (+ (System/currentTimeMillis)
                                                                      mw/session-ttl-ms))}))
-              (edn-response 401 {:error "login failed"})))
+              (respond 401 {:error "login failed"})))
           (catch Exception e
             (println "[tbd] Gitea login failed:" (.getMessage e))
-            (edn-response 502 {:error "could not complete login with Gitea"})))))))
+            (respond 502 {:error "could not complete login with Gitea"})))))))
 
 (defn- me-handler [config]
   (fn [req]
     (if-let [{:keys [login id]} (mw/current-user req)]
-      (edn-response 200 {:login login :id id :admin? (auth/admin? config login)})
-      (edn-response 401 {:error "login required"}))))
+      (respond 200 {:login login :id id :admin? (auth/admin? config login)})
+      (respond 401 {:error "login required"}))))
 
 (defn routes [config]
   ["/auth"
@@ -57,7 +57,7 @@
    ["/logout" {:post {:tags ["auth"]
                       :summary "End the session"
                       :handler (fn [_req]
-                                 (assoc (edn-response 200 {:logged-out true}) :session nil))}}]
+                                 (assoc (respond 200 {:logged-out true}) :session nil))}}]
    ["/me" {:get {:tags ["auth"]
                  :summary "The logged-in user (401 if not logged in)"
                  :handler (me-handler config)}}]])

src/tbd/core.clj

@@ -20,7 +20,9 @@
             [tbd.http :as http]
             [tbd.math.routes :as math]
             [tbd.nrepl.core :as nrepl]
-            [tbd.nrepl.routes :as nrepl-routes]))
+            [tbd.nrepl.routes :as nrepl-routes]
+            [tbd.todo.db :as todo-db]
+            [tbd.todo.routes :as todo-routes]))
 
 (defn- swagger-handler
   "reitit emits `\"definitions\": null` when no route declares a schema, which
@@ -34,12 +36,10 @@
           (update :body dissoc :definitions))))))
 
 (defn- coercion-error-handler
-  "Invalid request params -> 400 in the same EDN shape the routes use."
+  "Invalid request params -> 400, in the same shape (and format) the routes use."
   [e _req]
-  {:status 400
-   :headers {"Content-Type" "application/edn; charset=utf-8"}
-   :body (pr-str {:error "invalid request parameters"
-                  :details (:humanized (reitit.coercion/encode-error (ex-data e)))})})
+  (http/respond 400 {:error "invalid request parameters"
+                     :details (:humanized (reitit.coercion/encode-error (ex-data e)))}))
 
 (defn- index-handler
   "The HTML shell for the re-frame UI (ui/); it loads the compiled JS from /js."
@@ -48,11 +48,9 @@
       (response/content-type "text/html; charset=utf-8")))
 
 (defn- decode-error-handler
-  "A request body that isn't valid for its Content-Type -> 400 in the same EDN shape."
+  "A request body that isn't valid for its Content-Type -> 400, in the same shape (and format) the routes use."
   [_e _req]
-  {:status 400
-   :headers {"Content-Type" "application/edn; charset=utf-8"}
-   :body (pr-str {:error "malformed request body"})})
+  (http/respond 400 {:error "malformed request body"}))
 
 (def ^:private exception-middleware
   (exception/create-exception-middleware
@@ -62,10 +60,12 @@
 
 ;; Each logical group (health, users, orders, ...) owns a `tbd.<group>.routes`
 ;; namespace that returns its own route subtree; they're concatenated here.
-(defn make-router [{:keys [auth nrepl]}]
+(defn make-router [{:keys [auth nrepl todo]}]
   (ring/router
     [["/swagger.json"
-      {:get {:no-doc true
+      ;; The spec is JSON, whatever the API default is (Swagger UI can't read EDN).
+      {:muuntaja m/instance
+       :get {:no-doc true
              :swagger {:info {:title "tbd API" :version "1.0.0"}}
              :handler (swagger-handler)}}]
      ["/" {:get {:no-doc true
@@ -73,17 +73,21 @@
      (health/routes)
      (math/routes)
      (auth-routes/routes auth)
-     (nrepl-routes/routes nrepl)]
-    {:data {:muuntaja m/instance
+     (nrepl-routes/routes nrepl)
+     (todo-routes/routes todo)]
+    {:data {:muuntaja http/muuntaja
             :coercion malli/coercion
-            ;; Admin auth goes first so unauthenticated callers to `:admin? true` routes
-            ;; are turned away before any body parsing or coercion runs. The muuntaja
-            ;; middleware is split around the exception middleware (rather than the combined
-            ;; format-middleware) so a malformed request body is caught and answered with a 400.
-            :middleware [(auth-mw/admin-middleware auth)
-                         parameters/parameters-middleware
-                         muuntaja-middleware/format-negotiate-middleware
+            ;; Handlers (and the auth/error middleware) return plain data; the muuntaja
+            ;; middleware encodes it as the Accept header asks, so it wraps everything else.
+            ;; Auth comes next, so unauthenticated callers to `:admin? true` / `:login? true`
+            ;; routes are turned away before any body parsing or coercion runs. The request
+            ;; half of muuntaja is split off below the exception middleware (rather than using the
+            ;; combined format-middleware) so a malformed request body is caught and answered with a 400.
+            :middleware [muuntaja-middleware/format-negotiate-middleware
                          muuntaja-middleware/format-response-middleware
+                         (auth-mw/admin-middleware auth)
+                         auth-mw/login-middleware
+                         parameters/parameters-middleware
                          exception-middleware
                          muuntaja-middleware/format-request-middleware
                          coercion/coerce-request-middleware]}}))
@@ -102,7 +106,8 @@
 
 (def config
   {:auth (auth/env-config)
-   :nrepl (nrepl/env-config)})
+   :nrepl (nrepl/env-config)
+   :todo (todo-db/env-config)})
 
 (def app (make-app config))
 

src/tbd/http.clj

@@ -1,9 +1,20 @@
-(ns tbd.http)
+(ns tbd.http
+  (:require [muuntaja.core :as m]))
 
-(defn edn-response [status body]
-  {:status status
-   :headers {"Content-Type" "application/edn; charset=utf-8"}
-   :body (pr-str body)})
+(def muuntaja
+  "Content negotiation for the API. The request body is decoded by its Content-Type and the
+  response is encoded by the Accept header: JSON, EDN or Transit. When a request doesn't say
+  (no Content-Type, no Accept, or an Accept nothing here satisfies, like `*/*`) it is EDN."
+  (m/create
+    (-> m/default-options
+        (assoc :default-format "application/edn")
+        (assoc-in [:http :extract-content-type]
+                  #(or (m/extract-content-type-ring %) "application/edn")))))
+
+(defn respond
+  "A response whose `body` is plain data; the muuntaja middleware encodes it as the client asked."
+  [status body]
+  {:status status :body body})
 
 (defn wrap-browser-viewable-edn
   "Browsers download `application/edn` instead of showing it. When the request comes from a

src/tbd/math/routes.clj

@@ -1,18 +1,14 @@
 (ns tbd.math.routes
-  (:require [tbd.math.core :as math]))
+  (:require [tbd.http :as http]
+            [tbd.math.core :as math]))
 
 ;; :int first so "2" stays a long (a bare `number?` or :double would decode it to 2.0).
 ;; The :swagger/* props make the spec say plain `number` instead of the first :or branch.
 (def ^:private number-schema
   [:or {:swagger/type "number" :swagger/format "double"} :int :double])
 
-(defn- edn-response [status body]
-  {:status status
-   :headers {"Content-Type" "application/edn; charset=utf-8"}
-   :body (pr-str body)})
-
 (defn- add-handler [{{{:keys [x y]} :query} :parameters}]
-  (edn-response 200 {:result (math/add x y)}))
+  (http/respond 200 {:result (math/add x y)}))
 
 (defn routes []
   ["/api/add"

src/tbd/nrepl/routes.clj

@@ -1,5 +1,5 @@
 (ns tbd.nrepl.routes
-  (:require [tbd.http :refer [edn-response]]
+  (:require [tbd.http :refer [respond]]
             [tbd.nrepl.core :as nrepl]))
 
 (defn- toggle-handler [config]
@@ -10,13 +10,13 @@
                          (if enabled "enabled" "disabled")
                          login
                          (if enabled (format " on %s:%d" (:bind status) (:port status)) "")))
-        (edn-response 200 status))
+        (respond 200 status))
       (catch Exception e
         (println "[tbd] nREPL toggle failed:" (.getMessage e))
-        (edn-response 500 {:error (str "could not change nREPL state: " (.getMessage e))})))))
+        (respond 500 {:error (str "could not change nREPL state: " (.getMessage e))})))))
 
 (defn- status-handler [_req]
-  (edn-response 200 (nrepl/status)))
+  (respond 200 (nrepl/status)))
 
 (defn routes [config]
   ["/nrepl"

src/tbd/todo/core.clj

@@ -0,0 +1,40 @@
+(ns tbd.todo.core
+  "Business logic for the todo group: validation and state changes on plain maps. No HTTP and
+  no database (see tbd.todo.db); anything time-dependent takes `now` (epoch ms) as an argument.
+
+  Fallible fns return {:ok value} or {:error message}."
+  (:require [clojure.string :as str]))
+
+(def max-title-length 200)
+
+(defn validate-title
+  "Titles are trimmed, and must be non-blank and at most `max-title-length` characters."
+  [title]
+  (let [title (some-> title str/trim)]
+    (cond
+      (str/blank? title) {:error "title must not be blank"}
+      (> (count title) max-title-length) {:error (format "title must be at most %d characters" max-title-length)}
+      :else {:ok title})))
+
+(defn new-todo
+  "A todo for `owner-id`, not yet stored (so no :id)."
+  [owner-id title now]
+  (let [{:keys [ok error]} (validate-title title)]
+    (if error
+      {:error error}
+      {:ok {:owner-id owner-id :title ok :done false :created-at now :updated-at now}})))
+
+(defn apply-changes
+  "`todo` with `changes` (a map with :title and/or :done) applied. Anything else in `changes`
+  is ignored; a change with neither is an error."
+  [todo changes now]
+  (let [changes (select-keys changes [:title :done])
+        {:keys [ok error]} (if (contains? changes :title)
+                             (validate-title (:title changes))
+                             {:ok (:title todo)})]
+    (cond
+      (empty? changes) {:error "nothing to change: give a title and/or done"}
+      error {:error error}
+      :else {:ok (-> todo
+                     (assoc :title ok :updated-at now)
+                     (cond-> (contains? changes :done) (assoc :done (boolean (:done changes)))))})))

src/tbd/todo/db.clj

@@ -0,0 +1,79 @@
+(ns tbd.todo.db
+  "SQLite persistence for the todo group, in a local file. Storage only: validation and other
+  rules live in tbd.todo.core. Every query takes an `owner-id` and filters on it, so one
+  user's todos can't be read or changed through another user's ids."
+  (:require [clojure.java.io :as io]
+            [clojure.string :as str]
+            [next.jdbc :as jdbc]
+            [next.jdbc.result-set :as rs]))
+
+(def default-path "data/todo.db")
+
+(defn env-config
+  "TODO_DB_PATH: where the SQLite file lives (default data/todo.db; its directory is created)."
+  ([] (env-config (System/getenv)))
+  ([env]
+   (let [path (get env "TODO_DB_PATH")]
+     {:db-path (if (str/blank? path) default-path (str/trim path))})))
+
+(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)"]))
+
+(defn open
+  "A datasource for the database file at `path`, created and migrated if need be. Each query
+  opens its own connection (cheap for a local file); WAL mode plus a busy timeout let
+  concurrent requests wait on each other's writes instead of failing."
+  [path]
+  (when (str/blank? path)
+    (throw (ex-info "no todo database path configured (set TODO_DB_PATH)" {})))
+  (some-> (io/file path) .getAbsoluteFile .getParentFile .mkdirs)
+  (doto (jdbc/get-datasource {:dbtype "sqlite" :dbname path
+                              :journal_mode "WAL" :busy_timeout 5000})
+    migrate!))
+
+(def ^:private opts {:builder-fn rs/as-unqualified-kebab-maps})
+
+;; SQLite has no boolean type; `done` is stored as 0/1.
+(defn- row->todo [row]
+  (some-> row (update :done #(= 1 %))))
+
+(defn insert!
+  "Stores a todo (as built by tbd.todo.core/new-todo) and returns it with its :id."
+  [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]
+                       opts)))
+
+(defn list-todos [ds owner-id]
+  (mapv row->todo
+        (jdbc/execute! ds ["SELECT * FROM todos WHERE owner_id = ? ORDER BY id" owner-id] opts)))
+
+(defn find-todo
+  "The owner's todo with this id, or nil (including when it belongs to someone else)."
+  [ds owner-id id]
+  (row->todo
+    (jdbc/execute-one! ds ["SELECT * FROM todos WHERE owner_id = ? AND id = ?" owner-id id] opts)))
+
+(defn update!
+  "Writes the todo's :title, :done and :updated-at; returns the stored row, or nil if the owner has no such todo."
+  [ds owner-id {:keys [id title done updated-at]}]
+  (row->todo
+    (jdbc/execute-one! ds ["UPDATE todos SET title = ?, done = ?, updated_at = ?
+                            WHERE owner_id = ? AND id = ? RETURNING *"
+                           title (if done 1 0) updated-at owner-id id]
+                       opts)))
+
+(defn delete!
+  "True if the owner's todo existed and is now gone."
+  [ds owner-id id]
+  (pos? (::jdbc/update-count
+          (jdbc/execute-one! ds ["DELETE FROM todos WHERE owner_id = ? AND id = ?" owner-id id]))))

src/tbd/todo/routes.clj

@@ -0,0 +1,71 @@
+(ns tbd.todo.routes
+  (:require [tbd.http :refer [respond]]
+            [tbd.todo.core :as todo]
+            [tbd.todo.db :as db]))
+
+(def ^:private not-found (respond 404 {:error "todo not found"}))
+
+;; 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- list-handler [ds]
+  (fn [req]
+    (respond 200 {:todos (db/list-todos @ds (owner-id req))})))
+
+(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))))))
+
+(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)))
+
+(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))))
+
+(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)))
+
+(defn routes
+  "`db-path` is opened (and migrated) on the first request, not when the app loads."
+  [{:keys [db-path]}]
+  (let [ds (delay (db/open db-path))
+        id-param {:path [:map [:id {:description "Todo id"} :int]]}]
+    ["/api/todos"
+     {:tags ["todo"] :login? true}
+     [""
+      {:get {:summary "List your todos (login required)"
+             :handler (list-handler ds)}
+       :post {:summary (format "Create a todo; the title is trimmed, non-blank, at most %d characters" todo/max-title-length)
+              :parameters {:body [:map [:title :string]]}
+              :handler (create-handler ds)}}]
+     ["/:id"
+      {:get {:summary "One of your todos (404 if it isn't yours)"
+             :parameters id-param
+             :handler (get-handler ds)}
+       :patch {:summary "Change the title and/or done flag of one of your todos"
+               :parameters (assoc id-param :body [:map
+                                                  [:title {:optional true} :string]
+                                                  [:done {:optional true} :boolean]])
+               :handler (patch-handler ds)}
+       :delete {:summary "Delete one of your todos"
+                :parameters id-param
+                :handler (delete-handler ds)}}]]))