backend: use xtdb

backend/.clj-kondo/config.edn

@@ -0,0 +1,4 @@
+{:lint-as {mount.core/defstate clojure.core/declare
+           #_#_specialist-server.type/defscalar clojure.core/declare
+           #_#_specialist-server.type/defobject clojure.core/declare
+           #_#_orchestra.core/defn-spec clojure.core/declare}}

backend/.gitignore

@@ -12,3 +12,4 @@ pom.xml.asc
 .hgignore
 .lsp
 .clj-kondo
+/data

backend/project.clj

@@ -1,15 +1,25 @@
-(defproject formswizard "0.2.0" #_"-SNAPSHOT"
+(defproject formswizard "0.2.1" #_"-SNAPSHOT"
   :description "FormsWizard backend based on clojure+reitit+xtdb"
   :url "https://github.com/FormsWizard/formswizard"
   :license {:name "EPL-2.0 OR GPL-2.0-or-later WITH Classpath-exception-2.0"
             :url "https://www.eclipse.org/legal/epl-2.0/"}
-  :dependencies [[org.clojure/clojure "1.11.1"]
+  :dependencies [;; core
+                 [org.clojure/clojure "1.11.1"]
+                 [yogthos/config "1.2.0"]
+                 [mount "0.1.17"]
+                 [spootnik/signal "0.2.4"]
+                 ;; http
                  [ring/ring-jetty-adapter "1.10.0"]
+                 [ring/ring-devel "1.10.0"]
                  [metosin/reitit "0.7.0-alpha5"]
                  [metosin/ring-swagger-ui "5.0.0-alpha.0"]
                  [metosin/spec-tools "0.10.6"]
                  [zerg000000/simple-cors "0.0.8"]
-                 [aleph "0.6.3"]]
-  :main formswizard.core/-main
-  :repl-options {:init-ns formswizard.core}
-  :profiles {:dev {:dependencies [[ring/ring-mock "0.4.0"]]}})
+                 [aleph "0.6.3"]
+                 ;; db
+                 [com.xtdb/xtdb-core "1.24.0"]
+                 [com.xtdb/xtdb-rocksdb "1.24.0"]]
+  :main formswizard.core
+  :profiles {:dev {:dependencies [[ring/ring-mock "0.4.0"]]}
+             :test {:jvm-opts ["-Ddb-inmemory=true" "-Ddb-export-prefix="]}
+             :uberjar {:aot :all}})

backend/src/config.edn

@@ -0,0 +1,13 @@
+{:verbose false
+
+ :port 4000
+
+ :db-inmemory false
+ :db-dir "./data/xtdb/rocksdb"
+ ;:db-seed "./data/seed/example.edn"  ;; set it explicitly
+ :db-export-prefix "./data/export/"
+ :db-validate true
+
+ :frontend-base-url "http://localhost:4000"
+ :frontend-backend-base-url "http://localhost:4000"
+}

backend/src/formswizard/config/state.clj

@@ -0,0 +1,55 @@
+(ns formswizard.config.state
+  "Wrapping yogthos/config with defstate allows overwriting the config at runtime and checking it at startup against a spec"
+  (:require [clojure.spec.alpha :as s]
+            [mount.core :refer [defstate args]]
+            [config.core]
+            [clojure.string]))
+
+(s/def ::verbose boolean?)
+
+(s/def ::port number?)  ;; the webserver port
+
+(s/def ::db-inmemory boolean?)  ;; we run unit tests in an in-memory instance, otherwise the default db would be looked
+(s/def ::db-dir string?)  ;; ignored when ::db-inmemory
+(s/def ::db-seed string?)  ;; an edn-file to be used for seeding
+(s/def ::db-export-prefix (s/nilable string?))  ;; path where during startup an export should be written
+(s/def ::db-validate boolean?)
+
+(s/def ::frontend-base-url string?)
+(s/def ::frontend-backend-base-url string?)
+
+(s/def ::env (s/keys :req-un [::verbose
+                              ::port
+                              ::db-inmemory ::db-dir
+                              ::db-export-prefix
+                              ::db-validate
+                              ::frontend-base-url
+                              ::frontend-backend-base-url]
+                     :opt-un [::db-seed ]))
+
+(defn strip-secrets [env]
+  env
+  #_(assoc env :example-secret "*"))
+
+(defn filter-defined [keys-spec m]
+  (let [req-un (nth (s/form keys-spec) 2)
+        opt-un (nth (s/form keys-spec) 4)
+        unnamespaced-keys (map #(-> (clojure.string/replace %
+                                                            (if-let [n (namespace %)]
+                                                                    (str n "/")
+                                                                    "")
+                                                            "")
+                                    (clojure.string/replace ":" "")
+                                    keyword)
+                               (concat req-un opt-un))]
+       (select-keys m (into [] unnamespaced-keys))))
+
+(defstate env
+  :start (let [env (->> (merge (config.core/load-env)
+                               (args))  ;; allows: (mount/start-with-args {…})
+                        (filter-defined ::env))
+               config-errors (s/explain-data ::env env)]
+              (when (:verbose env)
+                    (println (strip-secrets env)))
+              (assert (not config-errors) (with-out-str (s/explain-out config-errors)))
+              env))

backend/src/formswizard/core.clj

@@ -1,5 +1,14 @@
 (ns formswizard.core
-  (:require [formswizard.server :as server]))
+  (:require [mount.core :as mount]
+            [signal.handler :refer [with-handler]]
+            [formswizard.webserver.state :as server]))
 
-(defn -main [& args]
-  (server/start))
+(defn -main [& _args]
+  (mount/start)
+
+  (let [finaly (fn [] (mount/stop)  ;; Export the database
+                      (System/exit 0))]
+       (with-handler :term (finaly))  ;; kill
+       (with-handler :int (finaly)))  ;; Ctrl+C
+
+  (mount.core/running-states))  ;; Return value for debugging when called on repl

backend/src/formswizard/db/export.clj

@@ -0,0 +1,25 @@
+(ns formswizard.db.export
+  (:require [clojure.pprint :refer [pprint]]
+            [clojure.edn]))
+
+(defn all_docs [db_ctx]
+  (let [{:keys [sync q_unary]} db_ctx]
+       (sync)
+       (q_unary '{:find [(pull ?e [*])] :where [[?e :xt/id]]})))
+
+(defn edn->pprint [edn]
+  (with-out-str (pprint edn)))
+
+(defn write-edn [file docs]
+  (->> (edn->pprint docs)
+       (spit file)))
+
+(defn export [file db_ctx]
+  (->> (all_docs db_ctx)
+       (write-edn file)))
+
+(defn seed [file db_ctx]
+  (let [{:keys [tx_sync]} db_ctx]
+       (->> (clojure.edn/read-string (slurp file))
+            (map (fn [entry] [:xtdb.api/put entry]))
+            tx_sync)))

backend/src/formswizard/db/state.clj

@@ -0,0 +1,79 @@
+(ns formswizard.db.state
+  (:require[xtdb.api :as xtdb]
+            [clojure.java.io :as io]
+            [mount.core :as mount :refer [defstate]]
+            [formswizard.config.state :refer [env]]
+            [formswizard.db.export :refer [export seed]]
+            [formswizard.db.validate :refer [validate-db validate-tx]]))
+
+(defn export-named-by-date [db_ctx cause]
+  (when (:db-export-prefix env)
+        (let [date (.format (java.text.SimpleDateFormat. "yyyy-MM-dd_HH:mm:ss")
+                            (.getTime (java.util.Calendar/getInstance)))
+              file (str (:db-export-prefix env) date "_" cause ".edn")]
+             (when (:verbose env)
+                   (println "Export database to:" file))
+             (io/make-parents file)
+             (export file db_ctx))))
+
+(defn submit-tx [node tx-ops]
+  (xtdb/submit-tx node (validate-tx tx-ops)))
+
+(defn q [node & args]
+  (apply xtdb/q (xtdb/db node) args))
+
+(defn ->db_ctx []
+  (let [node (xtdb/start-node (when-not (:db-inmemory env)
+                                        {:my-rocksdb {:xtdb/module 'xtdb.rocksdb/->kv-store
+                                                      :db-dir (clojure.java.io/file (:db-dir env))
+                                                      :sync? true}
+                                         :xtdb/tx-log {:kv-store :my-rocksdb}
+                                         :xtdb/document-store {:kv-store :my-rocksdb}}))  ;; To optimize for read performance, we might switch to LMDB (B-Tree instead of LSM-Tree)
+                                                                                          ;; But for our workload it doesn't matter much
+        db_ctx {:node node
+                :tx (fn [tx-ops]
+                        (submit-tx node tx-ops))
+                :tx_sync (fn [tx-ops]
+                             (->> (submit-tx node tx-ops)
+                                  (xtdb.api/await-tx node)))
+                :tx-committed? (fn [transaction]
+                                   #_(println "synced" (xtdb/sync node))
+                                   #_(println "awaited" (xtdb/await-tx node transaction))
+                                   (xtdb/tx-committed? node transaction))
+                :tx-fn-put (fn [fn-name quoted-fn]
+                               ;; In future we may want add transaction functions only once (at startup)
+                               (xtdb/submit-tx node [[::xtdb/put {:xt/id fn-name :xt/fn quoted-fn}]]))
+                :tx-fn-call (fn [fn-name & args]
+                                (xtdb/submit-tx node [(concat [::xtdb/fn fn-name] args)]))
+                :sync (fn [] (xtdb/sync node))
+                :q (fn [& args]
+                       (apply q node args))
+                :q_unary (fn [& args]
+                             ;; A query returning unary results
+                             (->> (apply q node args)
+                                  (map first)))
+                :q_id (fn [& args]
+                           ;; A query returning only 1 result
+                           (-> (apply q node args)
+                               first))
+                :q_id_unary (fn [& args]
+                                ;; A query returning only 1 unary result
+                                (-> (apply q node args)
+                                    ffirst))}]
+
+       (export-named-by-date db_ctx "start")  ;; before seeding
+
+       (when (:db-seed env)
+             (when (:verbose env)
+                   (println "Seed the database from:" (:db-seed env)))
+             (seed (:db-seed env) db_ctx))
+
+       (if (:db-validate env)
+           (or (validate-db db_ctx)
+               (System/exit 1))
+           db_ctx)))
+
+(defstate db_ctx
+  :start (->db_ctx)
+  :stop (do (export-named-by-date db_ctx "stop")
+            (.close (:node db_ctx))))

backend/src/formswizard/db/validate.clj

@@ -0,0 +1,45 @@
+(ns formswizard.db.validate
+  (:require [clojure.spec.alpha :as s]
+            [formswizard.db.export :refer [all_docs write-edn]]
+            [clojure.pprint :refer [pprint]]))
+
+(defn validate
+  "Validate a xtdb-document or a collection of documents.
+   When not conforming to the spec, an explaination is associated."
+  [doc]
+  (if (map? doc)
+      (when-not (:xt/fn doc)
+                (let [spec (:xt/spec doc)]
+                     (when-not spec
+                               (println ":xt/spec must not be empty!" doc))
+                     (if (s/valid? spec doc)
+                         doc
+                         (assoc doc :explain (s/explain-data spec doc)))))
+      (map validate doc)))
+
+(defn validate-db
+  "Validate the database.
+   The db_ctx is only returned, when all documents have been confirmed."
+  [db_ctx]
+  (let [validated-docs (validate (all_docs db_ctx))
+        errors (filter :explain validated-docs)
+        file "/tmp/validation-errors"]
+       (if (not-empty errors)
+           (do
+             (println "There have been validation errors in" (count errors) "database documents.")
+             (println "It seems that the latest update changed this specs:" (into [] (keys (group-by :xt/spec errors))))
+             (write-edn file errors)
+             (println "Details have been written to:" file))
+           db_ctx)))
+
+(defn validate-tx
+  "Validate docs before they are written to the database."
+  [tx-ops]
+  (let [docs (->> tx-ops
+                  (filter #(= :xtdb.api/put (first %)))
+                  (map second))
+        errors (filter :explain (validate docs))]
+       (if (not-empty errors)
+           (do (println "Transaction canceled due to validiation errors:")
+               (pprint errors))
+           tx-ops)))

backend/src/formswizard/model/project_state/api.clj

@@ -5,3 +5,4 @@
 (s/def ::formAdminToken string?)  ;; Grants write permissions for updating the forms and adding pubKeys
                                   ;; Must be keeped secret between admins and server, to prevent denial-of-service
                                   ;; PubKeys will also be signed (keyId of author is part of link) and checked clientside, so server can't manipulate pubKeys (TODO)
+(s/def ::formAdminTokenRecord (s/keys :req-un [::formAdminToken]))

backend/src/formswizard/state.clj

@@ -1,32 +1,75 @@
-(ns formswizard.state)
+(ns formswizard.state
+  (:require [formswizard.db.state :refer [db_ctx]]
+            [formswizard.model.project-state.keys :as keys]
+            [formswizard.model.project-state.schema :as schema]
+            [formswizard.model.project-state.cryptedData :as cryptedData]
+            [formswizard.model.project-state.api :as api]))
 
-(def state (atom {:cryptedData []}))
+;(def state (atom {:cryptedData []}))
 
 
 ;; On first write access (setSchema! or setKeys!) of a form, the formAdminToken will be set.
 ;; Later write accesses must use the same formAdminToken.
 (defn authorized? [formId formAdminToken]
-  (if (get @state formId)
-    (= formAdminToken (get-in @state [formId :formAdminToken]))
-    (swap! state assoc-in [formId :formAdminToken] formAdminToken)))
+  ;(if (get @state formId)
+  ;  (= formAdminToken (get-in @state [formId :formAdminToken]))
+  ;  (swap! state assoc-in [formId :formAdminToken] formAdminToken))
+  (let [correctFormAdminToken ((:q_id_unary db_ctx) '{:find [(pull ?e [:formAdminToken])]
+                                                      :where [[?e :xt/spec ::api/formAdminTokenRecord]
+                                                              [?e :formId ?formId]]
+                                                      :in [?formId]}
+                                                    formId)]
+       (if correctFormAdminToken
+           (= formAdminToken correctFormAdminToken)
+           ((:tx db_ctx) [[:xtdb.api/put {:xt/id (str "formAdminToken_" formId)
+                                          :xt/spec ::api/formAdminTokenRecord
+                                          :formId formId
+                                          :formAdminToken formAdminToken}]]))))
 
 
 (defn setSchema! [formId schema]
-  (swap! state assoc-in [formId :schema] schema))
+  ;(swap! state assoc-in [formId :schema] schema)
+  ((:tx db_ctx) [[:xtdb.api/put (assoc schema
+                                       :xt/id (str "schema_" formId)
+                                       :xt/spec ::schema/schema
+                                       :formId formId)]]))
 
 (defn getSchema [formId]
-  (select-keys (get @state formId) [:schema]))
+  ;(select-keys (get @state formId) [:schema])
+  {:schema ((:q_id_unary db_ctx) '{:find [(pull ?e [*])]
+                                   :where [[?e :xt/spec ::schema/schema]
+                                           [?e :formId ?formId]]
+                                   :in [?formId]}
+                                 formId)})
 
 
 (defn setKeys! [formId keys]
-  (swap! state assoc-in [formId :keys] keys))
+  ;(swap! state assoc-in [formId :keys] keys))
+  ((:tx db_ctx) [[:xtdb.api/put (assoc keys
+                                       :xt/id (str "keys_" formId)
+                                       :xt/spec ::keys/keys
+                                       :formId formId)]]))
 
 (defn getKeys [formId]
-  (select-keys (get @state formId) [:keys]))
+  ;(select-keys (get @state formId) [:keys])
+  {:keys ((:q_id_unary db_ctx) '{:find [(pull ?e [*])]
+                                 :where [[?e :xt/spec ::keys/keys]
+                                         [?e :formId ?formId]]
+                                 :in [?formId]}
+                               formId)})
 
 
 (defn addCryptedDatum! [formId cryptedDatum]
-  (swap! state update-in [formId :cryptedData] conj cryptedDatum))
+  ;(swap! state update-in [formId :cryptedData] conj cryptedDatum)
+  ((:tx db_ctx) [[:xtdb.api/put (assoc cryptedDatum
+                                       :xt/id (str "cryptedDatum_" (:uuid cryptedDatum))
+                                       :xt/spec ::cryptedData/cryptedDatum
+                                       :formId formId)]]))
 
 (defn getCryptedData [formId]
-  (select-keys (get @state formId) [:cryptedData]))
+  ;(select-keys (get @state formId) [:cryptedData])
+  {:cryptedData ((:q_unary db_ctx) '{:find [(pull ?e [*])]
+                                     :where [[?e :xt/spec ::cryptedData/cryptedDatum]
+                                             [?e :formId ?formId]]
+                                     :in [?formId]}
+                                   formId)})