Historical db (#40)

* update server API, update deps, improve testing

* fix formatting, fix dev mode test

* cleanup comments

* add basic history support

* use only dots for kaocha feedback

* ignore IDE files

* ignore even more files

* add middleware and history tests

* fix formatting :(

* fix deps

* remove duplicate deps entry

.gitignore

@@ -30,6 +30,8 @@ datahike-server.iml
 
 /.store
 resources/config.edn
-.clj-kondo/.cache/
+.clj-kondo
 .dir-locals.el
 .cpcache/
+.lsp
+.calva

bin/run-integrationtests

@@ -12,6 +12,10 @@ function test_auth() {
     cp -av test/datahike_server/resources/config.edn resources/config.edn
     ./bin/kaocha --focus datahike-server.integration-test
 }
+function test_middleware() {
+    cp -av test/datahike_server/resources/config.edn resources/config.edn
+    ./bin/kaocha --focus datahike-server.middleware-test
+}
 function test_dev_mode() {
     cp -av test/datahike_server/resources/config-dev-mode.edn resources/config.edn
     ./bin/kaocha --focus datahike-server.setup-test
@@ -22,4 +26,5 @@ function teardown() {
 
 setup
 test_auth
+test_middleware
 test_dev_mode

deps.edn

@@ -21,8 +21,8 @@
 
            :test {:extra-paths        ["test"]
                   :extra-deps         {clj-http/clj-http      {:mvn/version "3.12.3"}
-                                       org.clojure/test.check {:mvn/version "1.1.1"}}
-                  lambdaisland/kaocha {:mvn/version "1.64.1010"}}
+                                       org.clojure/test.check {:mvn/version "1.1.1"}
+                                       lambdaisland/kaocha {:mvn/version "1.64.1010"}}}
 
            :repl {:extra-deps {cider/cider-nrepl           {:mvn/version "0.27.4"}
                                nrepl/nrepl                 {:mvn/version "0.9.0"}
@@ -32,7 +32,6 @@
            :ffix {:extra-deps {cljfmt/cljfmt {:mvn/version "0.8.0"}}
                   :main-opts ["-m" "cljfmt.main" "fix"]}
 
-
            :build {:deps       {io.github.clojure/tools.build   {:git/tag "v0.8.1" :git/sha "7d40500"}
                                 slipset/deps-deploy             {:mvn/version "0.2.0"}
                                 borkdude/gh-release-artifact    {:git/url "https://github.com/borkdude/gh-release-artifact"

src/clj/datahike_server/core.clj

@@ -22,4 +22,4 @@
 
   (mount/start)
 
-  (mount/stop))
+  (mount/stop))

src/clj/datahike_server/database.clj

@@ -43,3 +43,9 @@
     (d/delete-database cfg)
     (println "Done"))
   (start #'datahike-server.database/conns))
+
+(defn get-db [db-name]
+  (if-let [conn (get conns db-name)]
+    conn
+    (throw (ex-info (format "Database %s does not exist." db-name)
+                    {:cause :db-does-not-exist}))))

src/clj/datahike_server/handlers.clj

@@ -1,7 +1,6 @@
 (ns datahike-server.handlers
   (:require [datahike-server.database :refer [conns]]
             [datahike.api :as d]
-            [datahike.db :as dd]
             [datahike.core :as c]))
 
 (defn success
@@ -15,7 +14,7 @@
         databases (into [] xf (-> conns vals))]
     (success {:databases databases})))
 
-(defn get-db [{:keys [conn]}]
+(defn get-db-hash [{:keys [conn]}]
   (success {:hash (hash @conn)}))
 
 (defn cleanup-result [result]

src/clj/datahike_server/middleware.clj

@@ -1,9 +1,13 @@
 (ns datahike-server.middleware
   (:require
+   [datahike.api :as d]
    [datahike-server.config :as dc]
+   [datahike-server.database :as dd]
    [buddy.auth :refer [authenticated?]]
    [buddy.auth.backends :as buddy-auth-backends]
-   [buddy.auth.middleware :as buddy-auth-middleware]))
+   [buddy.auth.middleware :as buddy-auth-middleware])
+  (:import
+   [clojure.lang ExceptionInfo]))
 
 (defn auth
   "Middleware used in routes that require authentication. If request is not
@@ -32,3 +36,52 @@
   "Middleware used on routes requiring token authentication"
   [handler]
   (buddy-auth-middleware/wrap-authentication handler token-backend))
+
+(defn wrap-db-connection
+  "Middleware that adds a database connection based on db-name in the header of a request."
+  [handler]
+  (fn [{:keys [headers] :as request}]
+    (if-let [db-name (get headers "db-name")]
+      (let [conn (dd/get-db db-name)]
+        (handler (assoc request :conn conn)))
+      (handler request))))
+
+(defn wrap-db-history
+  "Middleware that adds a historical database based on db-history-type and db-timepoint in the header of a request"
+  [handler]
+  (fn [{:keys [headers conn] :as request}]
+    (if (some? conn)
+      (if-let [history-type (get headers "db-history-type")]
+        (if (= "history" history-type)
+          (handler (assoc request :db (d/history @conn)))
+          (if-let [timepoint (get headers "db-timepoint")]
+            (case history-type
+              "as-of" (handler (assoc request :db (d/as-of @conn (Long/parseLong timepoint))))
+              "since" (handler (assoc request :db (d/since @conn (Long/parseLong timepoint))))
+              (handler request))
+            (handler request)))
+        (handler request))
+      (handler request))))
+
+(defn cause->status-code [cause]
+  (case cause
+    :db-does-not-exist 404
+    400))
+
+(defn wrap-server-exception [handler]
+  (fn [request]
+    (try
+      (handler request)
+      (catch ExceptionInfo e
+        (let [cause (:cause (.getData e))]
+          {:status (cause->status-code cause)
+           :body {:message (.getMessage e)}})))))
+
+(defn wrap-fallback-exception
+  [handler]
+  (fn [request]
+    (try
+      (handler request)
+      (catch Exception _
+        {:status 500
+         :body {:message "Unexpected internal server error."}}))))

src/clj/datahike_server/server.clj

@@ -1,28 +1,27 @@
 (ns datahike-server.server
-  (:require [datahike-server.handlers :as h]
-            [datahike-server.config :refer [config]]
-            [datahike-server.database :refer [conns]]
-            [datahike-server.middleware :as middleware]
-            [datahike.api :as d]
-            [reitit.ring :as ring]
-            [reitit.coercion.spec]
-            [reitit.swagger :as swagger]
-            [reitit.swagger-ui :as swagger-ui]
-            [reitit.ring.coercion :as coercion]
-            [reitit.dev.pretty :as pretty]
-            [reitit.ring.middleware.muuntaja :as muuntaja]
-            [reitit.ring.middleware.exception :as exception]
-            [reitit.ring.middleware.multipart :as multipart]
-            [reitit.ring.middleware.parameters :as parameters]
-            [reitit.ring.middleware.dev :as dev]
-            [ring.middleware.cors :refer [wrap-cors]]
-            [muuntaja.core :as m]
-            [clojure.spec.alpha :as s]
-            [taoensso.timbre :as log]
-            [mount.core :refer [defstate]]
-            [ring.adapter.jetty :refer [run-jetty]]
-            [clojure.pprint :refer [pprint]]
-            [spec-tools.core :as st]))
+  (:require
+   [datahike-server.handlers :as h]
+   [datahike-server.config :refer [config]]
+   [datahike-server.database :refer [conns]]
+   [datahike-server.middleware :as middleware]
+   [reitit.ring :as ring]
+   [reitit.coercion.spec]
+   [reitit.swagger :as swagger]
+   [reitit.swagger-ui :as swagger-ui]
+   [reitit.ring.coercion :as coercion]
+   [reitit.dev.pretty :as pretty]
+   [reitit.ring.middleware.muuntaja :as muuntaja]
+   [reitit.ring.middleware.exception :as exception]
+   [reitit.ring.middleware.multipart :as multipart]
+   [reitit.ring.middleware.parameters :as parameters]
+   [ring.middleware.cors :refer [wrap-cors]]
+   [muuntaja.core :as m]
+   [clojure.spec.alpha :as s]
+   [taoensso.timbre :as log]
+   [mount.core :refer [defstate]]
+   [ring.adapter.jetty :refer [run-jetty]]
+   [clojure.pprint :refer [pprint]]
+   [spec-tools.core :as st]))
 
 (defn long? [x]
   (instance? java.lang.Long x))
@@ -121,7 +120,7 @@
                :summary "Get current database as a hash."
                :parameters {:header ::conn-header}
                :middleware [middleware/token-auth middleware/auth]
-               :handler    h/get-db}}]
+               :handler    h/get-db-hash}}]
 
    ["/q"
     {:swagger {:tags ["API"]}
@@ -206,6 +205,7 @@
                :parameters {:header ::db-header}
                :middleware [middleware/token-auth middleware/auth]
                :handler    h/reverse-schema}}]
+
    ["/load-entities"
     {:swagger {:tags ["API"]}
      :post {:operationId "LoadEntities"
@@ -216,30 +216,22 @@
             :middleware [middleware/token-auth middleware/auth]
             :handler h/load-entities}}]])
 
-(defn wrap-db-connection [handler]
-  (fn [request]
-    (if-let [db-name (get-in request [:headers "db-name"])]
-      (if-let [conn (conns db-name)]
-        (if-let [tx (get-in request [:headers "db-tx"])]
-          (if-let [db (d/as-of @conn (Integer/parseInt tx))]
-            (handler (assoc request :db db :conn conn))
-            (handler request))
-          (handler (assoc request :conn conn)))
-        (handler request))
-      (handler request))))
-
 (def route-opts
   {;; :reitit.middleware/transform dev/print-request-diffs ;; pretty diffs
    ;; :validate spec/validate ;; enable spec validation for route data
-   ;;:reitit.spec/wrap spell/closed ;; strict top-level validation
-   :exception pretty/exception
+   ;; :reitit.spec/wrap spell/closed ;; strict top-level validation
+   ; :exception pretty/exception
    :data      {:coercion   reitit.coercion.spec/coercion
                :muuntaja   m/instance
                :middleware [swagger/swagger-feature
                             parameters/parameters-middleware
                             muuntaja/format-negotiate-middleware
                             muuntaja/format-response-middleware
-                            exception/exception-middleware
+                            ;;  exception/exception-middleware
+                            middleware/wrap-fallback-exception
+                            middleware/wrap-server-exception
+                            middleware/wrap-db-connection
+                            middleware/wrap-db-history
                             muuntaja/format-request-middleware
                             coercion/coerce-response-middleware
                             coercion/coerce-request-middleware
@@ -254,7 +246,6 @@
           :config {:validatorUrl     nil
                    :operationsSorter "alpha"}})
         (ring/create-default-handler)))
-      wrap-db-connection
       (wrap-cors :access-control-allow-origin [#"http://localhost" #"http://localhost:8080" #"http://localhost:4000"]
                  :access-control-allow-methods [:get :put :post :delete])))
 
@@ -266,5 +257,3 @@
            (log/debug "Starting server")
            (start-server config))
   :stop (.stop server))
-
-(comment)