feat(backend): upgrade suricatta

backend/deps.edn

@@ -1,9 +1,11 @@
 {:deps {org.clojure/clojure {:mvn/version "1.10.1"}
         org.clojure/tools.logging {:mvn/version "0.3.1"}
-        funcool/suricatta {:mvn/version "1.3.1"}
         funcool/promesa {:mvn/version "2.0.1"}
         funcool/cuerdas {:mvn/version "2.2.0"}
 
+        funcool/suricatta {:git/url "https://github.com/funcool/suricatta.git"
+                           :sha "80ef2dfdb3248f94f987b476a6bc1a6cfbe5f306"}
+
         funcool/datoteka {:git/url "https://github.com/funcool/datoteka.git"
                           :sha "bae298a642b40e84e92dc195a68444bc63e807d9"}
 
@@ -23,7 +25,7 @@
         org.slf4j/slf4j-simple {:mvn/version "1.7.26"}
         com.layerware/hugsql-core {:mvn/version "0.4.9"
                                    :exclusions [org.clojure/tools.reader]}
-        niwinz/migrante {:mvn/version "0.1.0"}
+        ;; niwinz/migrante {:mvn/version "0.1.0"}
         buddy/buddy-sign {:mvn/version "3.1.0"}
         buddy/buddy-hashers {:mvn/version "1.4.0"}
 

backend/src/uxbox/config.clj

@@ -36,11 +36,7 @@
   {:http-server-port (lookup-env env :uxbox-http-server-port 6060)
    :http-server-debug (lookup-env env :uxbox-http-server-debug true)
    :http-server-cors (lookup-env env :uxbox-http-server-cors "http://localhost:3449")
-   :database-username (lookup-env env :uxbox-database-username nil)
-   :database-password (lookup-env env :uxbox-database-password nil)
-   :database-name (lookup-env env :uxbox-database-name "uxbox")
-   :database-server (lookup-env env :uxbox-database-server "localhost")
-   :database-port (lookup-env env :uxbox-database-port 5432)
+   :database-uri (lookup-env env :uxbox-database-uri "jdbc:postgresql://127.0.0.1/uxbox")
    :media-directory (lookup-env env :uxbox-media-directory "resources/public/media")
    :media-uri (lookup-env env :uxbox-media-uri "http://localhost:6060/media/")
    :assets-directory (lookup-env env :uxbox-assets-directory "resources/public/static")

backend/src/uxbox/db.clj

@@ -6,18 +6,20 @@
 
 (ns uxbox.db
   "Database access layer for UXBOX."
-  (:require [mount.core :as mount :refer (defstate)]
-            [promesa.core :as p]
-            [hikari-cp.core :as hikari]
-            [executors.core :as exec]
-            [suricatta.core :as sc]
-            [suricatta.proto :as scp]
-            [suricatta.types :as sct]
-            [suricatta.transaction :as sctx]
-            [uxbox.config :as cfg])
-  (:import org.jooq.TransactionContext
-           org.jooq.TransactionProvider
-           org.jooq.Configuration))
+  (:require
+   [executors.core :as exec]
+   [hikari-cp.core :as hikari]
+   [mount.core :as mount :refer (defstate)]
+   [promesa.core :as p]
+   [suricatta.core :as sc]
+   [suricatta.impl :as si]
+   [suricatta.proto :as sp]
+   [uxbox.config :as cfg])
+  (:import
+   org.jooq.Configuration
+   org.jooq.TransactionContext
+   org.jooq.TransactionProvider
+   ))
 
 ;; --- State
 
@@ -26,22 +28,11 @@
    :idle-timeout 600000
    :max-lifetime 1800000
    :minimum-idle 10
-   :maximum-pool-size 10
-   :adapter "postgresql"
-   :username ""
-   :password ""
-   :database-name ""
-   :server-name "localhost"
-   :port-number 5432})
+   :maximum-pool-size 10})
 
 (defn get-db-config
   [config]
-  (assoc connection-defaults
-         :username (:database-username config)
-         :password (:database-password config)
-         :database-name (:database-name config)
-         :server-name (:database-server config)
-         :port-number (:database-port config)))
+  (assoc connection-defaults :jdbc-url (:database-uri config)))
 
 (defn create-datasource
   [config]
@@ -58,15 +49,15 @@
   "Asynchronous transaction handling."
   {:internal true}
   [ctx func]
-  (let [^Configuration conf (.derive (scp/-config ctx))
-        ^TransactionContext txctx (sctx/transaction-context conf)
+  (let [^Configuration conf (.derive (sp/-config ctx))
+        ^TransactionContext txctx (si/transaction-context conf)
         ^TransactionProvider provider (.transactionProvider conf)]
     (doto conf
       (.data "suricatta.rollback" false)
       (.data "suricatta.transaction" true))
     (try
       (.begin provider txctx)
-      (->> (func (sct/context conf))
+      (->> (func (si/make-context conf))
            (p/map (fn [result]
                     (if (.data conf "suricatta.rollback")
                       (.rollback provider txctx)

backend/src/uxbox/util/time.clj

@@ -5,7 +5,8 @@
 ;; Copyright (c) 2016 Andrey Antukh <niwi@niwi.nz>
 
 (ns uxbox.util.time
-  (:require [suricatta.proto :as proto]
+  (:require [suricatta.proto :as sp]
+            [suricatta.impl :as si]
             [cognitect.transit :as t])
   (:import java.time.Instant
            java.sql.Timestamp))
@@ -36,22 +37,17 @@
 ;; Persistence Layer Conversions
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(extend-protocol proto/IParamType
+(extend-protocol sp/IParam
   Instant
-  (-render [self ctx]
-    (if (proto/-inline? ctx)
-      (str "'" (.toString self) "'::timestamptz")
-      "?::timestamptz"))
+  (-param [self ctx]
+    (si/sql->param "{0}::timestamptz" (.toString self))))
 
-  (-bind [self ctx]
-    (when-not (proto/-inline? ctx)
-      (let [stmt (proto/-statement ctx)
-            idx  (proto/-next-bind-index ctx)
-            obj (Timestamp/from self)]
-        (.setTimestamp stmt idx obj)))))
-
-(extend-protocol proto/ISQLType
+(extend-protocol sp/ISQLType
   Timestamp
+  (-convert [self]
+    (.toInstant self))
+
+  java.time.OffsetDateTime
   (-convert [self]
     (.toInstant self)))
 

backend/test/uxbox/tests/test_images.clj

@@ -78,7 +78,7 @@
       (th/with-server {:handler @http/app}
         (let [uri (str th/+base-url+ "/api/library/images")
               parts [{:name "sample.jpg"
-                      :part-name "upload"
+                      :part-name "file"
                       :content (io/input-stream
                                 (io/resource "uxbox/tests/_files/sample.jpg"))}
                      {:part-name "user" :content (str (:id user))}

backend/vendor/migrante/core.clj

@@ -0,0 +1,218 @@
+(ns migrante.core
+  (:require [suricatta.core :as sc]
+            [suricatta.proto :as sp]
+            [cuerdas.core :as str]
+            [clojure.java.io :as io]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Private Api: Helpers
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def ^:dynamic *verbose* false)
+(def ^:dynamic *ctx* nil)
+
+(defmacro ^:private log
+  "A simple sugar syntax helper for log information
+  into the standard output."
+  [& args]
+  `(when *verbose*
+     (println ~@args)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Private Api: Implementation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- migration-registered?
+  "Check if concrete migration is already registred."
+  ([conn module step]
+   {:pre [(keyword? module) (keyword? step)]}
+   (let [sql (str "select * from migrations"
+                  " where module=? and step=?")
+         res (sc/fetch conn [sql (name module) (name step)])]
+     (pos? (count res)))))
+
+(defn- register-migration!
+  "Register a concrete migration into local migrations database."
+  ([conn module step]
+   {:pre [(keyword? module) (keyword? step)]}
+   (let [sql "insert into migrations (module, step) values (?, ?)"]
+     (sc/execute conn [sql (name module) (name step)]))))
+
+(defn- unregister-migration!
+  "Unregister a concrete migration from local migrations database."
+  ([conn module step]
+   {:pre [(keyword? module) (keyword? step)]}
+   (let [sql "delete from migrations where module=? and step=?;"]
+     (sc/execute conn [sql (name module) (name step)]))))
+
+(defn- setup!
+  "Initialize the database if it is not initialized."
+  [conn]
+  (let [sql (str "create table if not exists migrations ("
+                 " module text,"
+                 " step text,"
+                 " created_at timestamp DEFAULT current_timestamp,"
+                 " unique(module, step)"
+                 ");")]
+    (sc/execute conn sql)))
+
+(defprotocol IMigration
+  "Define a migration step behavior on up and down
+  migration actons."
+  (-name [_] "Return the migration name")
+  (-desc [_] "Return the migration desc")
+  (-run-up [_ _] "Run function in migrate process.")
+  (-run-down [_ _] "Run function in rollback process."))
+
+(deftype Migration [name desc up down])
+
+(extend-protocol IMigration
+  Migration
+  (-run-up [step conn]
+    (let [upfn (.-up step)]
+      (binding [*ctx* conn]
+        (upfn))))
+  (-run-down [step conn]
+    (if-let [downfn (.-down step)]
+      (binding [*ctx* conn]
+        (downfn))))
+  (-name [step]
+    (str/collapse-whitespace
+     (.-name step)))
+  (-desc [step]
+    (str/collapse-whitespace
+     (.-desc step))))
+
+(defn- do-migrate
+  [conn migration {:keys [until fake] :or {fake false}}]
+  (let [mid (:name migration)
+        steps (:steps migration)]
+    (log (str/format "Applying migrations for `%s`:" mid))
+    (sc/atomic conn
+      (run! (fn [[sid sdata]]
+              (when-not (migration-registered? conn mid sid)
+                (log (format "- %s - %s - %s" sid (-name sdata)
+                             (str/prune (-desc sdata) 70)))
+                (sc/atomic conn
+                  (when (not fake)
+                    (-run-up sdata conn))
+                  (register-migration! conn mid sid)))
+              (when (= until sid)
+                (reduced nil)))
+            steps))
+    (log "\n")))
+
+(defn- do-rollback
+  [conn migration {:keys [until fake] :or {fake false}}]
+  (let [mid (:name migration)
+        steps (reverse (:steps migration))]
+    (sc/atomic conn
+      (run! (fn [[sid sdata]]
+              (when (migration-registered? conn mid sid)
+                (log (format "- Rollback migration %s/%s (%s - %s)"
+                             mid sid (-name sdata) (-desc sdata)))
+                (sc/atomic conn
+                  (when (not fake)
+                    (-run-down sdata conn))
+                  (unregister-migration! conn mid sid)))
+              (when (= until sid)
+                (reduced nil)))
+            steps))))
+
+(defn- normalize-to-connection
+  [dbspec]
+  (if (satisfies? sp/IContextHolder dbspec)
+    dbspec
+    (sc/context dbspec)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Public Api
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn execute
+  "Execute a query and return a number of rows affected."
+  [q]
+  (sc/execute *ctx* q))
+
+(defn fetch
+  "Fetch eagerly results executing a query.
+
+  This function returns a vector of records (default) or
+  rows (depending on specified opts). Resources are relased
+  inmediatelly without specific explicit action for it."
+  ([q]
+   (sc/fetch *ctx* q))
+  ([q opts]
+   (sc/fetch *ctx* q opts)))
+
+(defprotocol IMigrationContext
+  (-migrate [_ migration options])
+  (-rollback [_ migration options])
+  (-registered? [_ module step]))
+
+(defn context
+  "Create new instance of migration context."
+  ([conn] (context conn nil))
+  ([conn {:keys [verbose] :or {verbose true}}]
+   (let [conn (normalize-to-connection conn)]
+     (setup! conn)
+     (reify
+       java.lang.AutoCloseable
+       (close [_] (.close conn))
+
+       IMigrationContext
+       (-migrate [_ migration options]
+         (sc/atomic conn
+           (binding [*verbose* verbose]
+             (do-migrate conn migration options))))
+
+       (-rollback [_ migration options]
+         (sc/atomic conn
+           (binding [*verbose* verbose]
+             (do-rollback conn migration options))))
+       (-registered? [_ module step]
+         (migration-registered? conn module step))))))
+
+(defn migrate
+  "Main entry point for apply a migration."
+  ([mctx migration]
+   (migrate mctx migration nil))
+  ([mctx migration options]
+   (-migrate mctx migration options)))
+
+(defn rollback
+  "Main entry point for apply a migration."
+  ([mctx migration]
+   (rollback mctx migration nil))
+  ([mctx migration options]
+   (-rollback mctx migration options)))
+
+(defn registered?
+  [mctx module step]
+  (-registered? mctx module step))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Sugar Syntax
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro defmigration
+  [sym & [docs & args]]
+  (let [{:keys [up down]} (if (string? docs)
+                            (apply hash-map args)
+                            (apply hash-map docs args))
+        docs (if (string? docs) docs "")
+        mname (name sym)]
+    `(def ~sym
+       ~docs
+       (->Migration ~mname ~docs
+                    (or ~up identity)
+                    (or ~down identity)))))
+
+(defmacro resource
+  "Helper for setup migration functions
+  just using a simple path to sql file
+  located in the class path."
+  [path]
+  `(fn []
+     (let [sql# (slurp (io/resource ~path))]
+       (execute sql#))))