🎉 Add plugable storages abstraction layer (with support for fs, s3 and db).

backend/src/app/storage/db.clj

@@ -0,0 +1,62 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; This Source Code Form is "Incompatible With Secondary Licenses", as
+;; defined by the Mozilla Public License, v. 2.0.
+;;
+;; Copyright (c) 2020-2021 UXBOX Labs SL
+
+(ns app.storage.db
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.db :as db]
+   [app.storage.impl :as impl]
+   [clojure.java.io :as io]
+   [clojure.spec.alpha :as s]
+   [datoteka.core :as fs]
+   [lambdaisland.uri :as u]
+   [integrant.core :as ig])
+  (:import
+   org.postgresql.largeobject.LargeObject
+   java.io.ByteArrayInputStream
+   java.io.ByteArrayOutputStream
+   java.io.InputStream
+   java.io.OutputStream))
+
+;; --- BACKEND INIT
+
+(defmethod ig/pre-init-spec ::backend [_]
+  (s/keys :opt-un [::db/pool]))
+
+(defmethod ig/init-key ::backend
+  [_ cfg]
+  (assoc cfg :type :db))
+
+(s/def ::type #{:db})
+(s/def ::backend
+  (s/keys :req-un [::type ::db/pool]))
+
+;; --- API IMPL
+
+(defmethod impl/put-object :db
+  [{:keys [conn] :as storage} {:keys [id] :as object} content]
+  (let [data (impl/slurp-bytes content)]
+    (db/insert! conn :storage-data {:id id :data data})
+    object))
+
+(defmethod impl/get-object :db
+  [{:keys [conn] :as backend} {:keys [id] :as object}]
+  (let [result (db/exec-one! conn ["select data from storage_data where id=?" id])]
+    (ByteArrayInputStream. (:data result))))
+
+(defmethod impl/get-object-url :db
+  [backend {:keys [id] :as object}]
+  (throw (UnsupportedOperationException. "not supported")))
+
+(defmethod impl/del-objects-in-bulk :db
+  [backend ids]
+  ;; NOOP: because delting the row already deletes the file data from
+  ;; the database.
+  nil)

backend/src/app/storage/fs.clj

@@ -0,0 +1,84 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; This Source Code Form is "Incompatible With Secondary Licenses", as
+;; defined by the Mozilla Public License, v. 2.0.
+;;
+;; Copyright (c) 2020-2021 UXBOX Labs SL
+
+(ns app.storage.fs
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.db :as db]
+   [app.storage.impl :as impl]
+   [clojure.java.io :as io]
+   [clojure.spec.alpha :as s]
+   [datoteka.core :as fs]
+   [lambdaisland.uri :as u]
+   [integrant.core :as ig])
+  (:import
+   java.io.InputStream
+   java.io.OutputStream
+   java.nio.file.Path
+   java.nio.file.Files))
+
+;; --- BACKEND INIT
+
+(s/def ::directory ::us/string)
+(s/def ::uri ::us/string)
+
+(defmethod ig/pre-init-spec ::backend [_]
+  (s/keys :opt-un [::directory ::uri]))
+
+(defmethod ig/init-key ::backend
+  [_ cfg]
+  ;; Return a valid backend data structure only if all optional
+  ;; parameters are provided.
+  (when (and (string? (:directory cfg))
+             (string? (:uri cfg)))
+    (assoc cfg :type :fs)))
+
+(s/def ::type #{:fs})
+(s/def ::backend
+  (s/keys :req-un [::directory ::uri ::type]))
+
+;; --- API IMPL
+
+(defmethod impl/put-object :fs
+  [backend {:keys [id] :as object} content]
+  (let [^Path base (fs/path (:directory backend))
+        ^Path path (fs/path (impl/id->path id))
+        ^Path full (.resolve base path)]
+    (when-not (fs/exists? (.getParent full))
+      (fs/create-dir (.getParent full)))
+    (with-open [^InputStream src  (io/input-stream content)
+                ^OutputStream dst (io/output-stream full)]
+      (io/copy src dst))))
+
+(defmethod impl/get-object :fs
+  [backend {:keys [id] :as object}]
+  (let [^Path base (fs/path (:directory backend))
+        ^Path path (fs/path (impl/id->path id))
+        ^Path full (.resolve base path)]
+    (when-not (fs/exists? full)
+      (ex/raise :type :internal
+                :code :filesystem-object-does-not-exists
+                :path (str full)))
+    (io/input-stream full)))
+
+(defmethod impl/get-object-url :fs
+  [backend {:keys [id] :as object} _]
+  (let [uri (u/uri (:uri backend))]
+    (update uri :path
+            (fn [existing]
+              (str existing (impl/id->path id))))))
+
+(defmethod impl/del-objects-in-bulk :fs
+  [backend ids]
+  (let [base (fs/path (:directory backend))]
+    (doseq [id ids]
+      (let [path (fs/path (impl/id->path id))
+            path (.resolve ^Path base ^Path path)]
+        (Files/deleteIfExists ^Path path)))))

backend/src/app/storage/impl.clj

@@ -0,0 +1,181 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; This Source Code Form is "Incompatible With Secondary Licenses", as
+;; defined by the Mozilla Public License, v. 2.0.
+;;
+;; Copyright (c) 2020-2021 UXBOX Labs SL
+
+(ns app.storage.impl
+  "Storage backends abstraction layer."
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.common.uuid :as uuid]
+   [clojure.java.io :as io]
+   [buddy.core.codecs :as bc])
+  (:import
+   java.nio.ByteBuffer
+   java.util.UUID
+   java.io.ByteArrayInputStream
+   java.io.InputStream
+   java.nio.file.Path
+   java.nio.file.Files))
+
+;; --- API Definition
+
+(defmulti put-object (fn [cfg _ _] (:type cfg)))
+
+(defmethod put-object :default
+  [cfg _ _]
+  (ex/raise :type :internal
+            :code :invalid-storage-backend
+            :context cfg))
+
+(defmulti get-object (fn [cfg _] (:type cfg)))
+
+(defmethod get-object :default
+  [cfg _]
+  (ex/raise :type :internal
+            :code :invalid-storage-backend
+            :context cfg))
+
+(defmulti get-object-url (fn [cfg _ _] (:type cfg)))
+
+(defmethod get-object-url :default
+  [cfg _ _]
+  (ex/raise :type :internal
+            :code :invalid-storage-backend
+            :context cfg))
+
+
+(defmulti del-objects-in-bulk (fn [cfg _] (:type cfg)))
+
+(defmethod del-objects-in-bulk :default
+  [cfg _]
+  (ex/raise :type :internal
+            :code :invalid-storage-backend
+            :context cfg))
+
+
+;; --- HELPERS
+
+(defn uuid->hex
+  [^UUID v]
+  (let [buffer (ByteBuffer/allocate 16)]
+    (.putLong buffer (.getMostSignificantBits v))
+    (.putLong buffer (.getLeastSignificantBits v))
+    (bc/bytes->hex (.array buffer))))
+
+(defn id->path
+  [id]
+  (let [tokens (->> (uuid->hex id)
+                    (re-seq #"[\w\d]{2}"))
+        prefix (take 2 tokens)
+        suffix (drop 2 tokens)]
+    (str (apply str (interpose "/" prefix))
+         "/"
+         (apply str suffix))))
+
+(defn coerce-id
+  [id]
+  (cond
+    (string? id) (uuid/uuid id)
+    (uuid? id) id
+    :else (ex/raise :type :internal
+                    :code :invalid-id-type
+                    :hint "id should be string or uuid")))
+
+
+(defprotocol IContentObject)
+
+(defn- path->content-object
+  [path]
+  (let [size (Files/size path)]
+    (reify
+      IContentObject
+      io/IOFactory
+      (make-reader [_ opts]
+	    (io/make-reader path opts))
+      (make-writer [_ opts]
+        (throw (UnsupportedOperationException. "not implemented")))
+      (make-input-stream [_ opts]
+        (io/make-input-stream path opts))
+      (make-output-stream [_ opts]
+        (throw (UnsupportedOperationException. "not implemented")))
+      clojure.lang.Counted
+      (count [_] size))))
+
+(defn string->content-object
+  [^String v]
+  (let [data (.getBytes v "UTF-8")
+        bais (ByteArrayInputStream. ^bytes data)]
+    (reify
+      IContentObject
+      io/IOFactory
+      (make-reader [_ opts]
+	    (io/make-reader bais opts))
+      (make-writer [_ opts]
+        (throw (UnsupportedOperationException. "not implemented")))
+      (make-input-stream [_ opts]
+        (io/make-input-stream bais opts))
+      (make-output-stream [_ opts]
+        (throw (UnsupportedOperationException. "not implemented")))
+
+      clojure.lang.Counted
+      (count [_]
+        (alength data)))))
+
+(defn- input-stream->content-object
+  [^InputStream is size]
+  (reify
+    IContentObject
+    io/IOFactory
+    (make-reader [_ opts]
+	  (io/make-reader is opts))
+    (make-writer [_ opts]
+      (throw (UnsupportedOperationException. "not implemented")))
+    (make-input-stream [_ opts]
+      (io/make-input-stream is opts))
+    (make-output-stream [_ opts]
+      (throw (UnsupportedOperationException. "not implemented")))
+
+      clojure.lang.Counted
+      (count [_] size)))
+
+(defn content-object
+  ([data] (content-object data nil))
+  ([data size]
+   (cond
+     (instance? java.nio.file.Path data)
+     (path->content-object data)
+
+     (instance? java.io.File data)
+     (path->content-object (.toPath ^java.io.File data))
+
+     (instance? String data)
+     (string->content-object data)
+
+     (instance? InputStream data)
+     (do
+       (when-not size
+         (throw (UnsupportedOperationException. "size should be provided on InputStream")))
+       (input-stream->content-object data size))
+
+     :else
+     (throw (UnsupportedOperationException. "type not supported")))))
+
+(defn content-object?
+  [v]
+  (satisfies? IContentObject v))
+
+(defn slurp-bytes
+  [content]
+  (us/assert content-object? content)
+  (with-open [input  (io/input-stream content)
+              output (java.io.ByteArrayOutputStream. (count content))]
+    (io/copy input output)
+    (.toByteArray output)))
+
+

backend/src/app/storage/s3.clj

@@ -0,0 +1,174 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; This Source Code Form is "Incompatible With Secondary Licenses", as
+;; defined by the Mozilla Public License, v. 2.0.
+;;
+;; Copyright (c) 2020 UXBOX Labs SL
+
+(ns app.storage.s3
+  "Storage backends abstraction layer."
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.db :as db]
+   [app.storage.impl :as impl]
+   [app.util.time :as dt]
+   [clojure.java.io :as io]
+   [clojure.spec.alpha :as s]
+   [lambdaisland.uri :as u]
+   [integrant.core :as ig])
+  (:import
+   java.io.InputStream
+   java.io.OutputStream
+   java.nio.file.Path
+   software.amazon.awssdk.regions.Region
+   software.amazon.awssdk.services.s3.S3Client
+   software.amazon.awssdk.services.s3.S3ClientBuilder
+   software.amazon.awssdk.core.sync.RequestBody
+   software.amazon.awssdk.services.s3.model.PutObjectRequest
+   software.amazon.awssdk.services.s3.model.GetObjectRequest
+   software.amazon.awssdk.services.s3.presigner.model.GetObjectPresignRequest
+   software.amazon.awssdk.services.s3.presigner.model.PresignedGetObjectRequest
+   software.amazon.awssdk.services.s3.presigner.S3Presigner
+   software.amazon.awssdk.services.s3.model.DeleteObjectsRequest
+   software.amazon.awssdk.services.s3.model.Delete
+   software.amazon.awssdk.services.s3.model.ObjectIdentifier
+   software.amazon.awssdk.services.s3.model.DeleteObjectsResponse))
+
+
+(declare put-object)
+(declare get-object)
+(declare get-object-url)
+(declare del-object-in-bulk)
+(declare build-s3-client)
+(declare build-s3-presigner)
+
+;; --- BACKEND INIT
+
+(s/def ::region #{:eu-central-1})
+(s/def ::bucket ::us/string)
+
+(defmethod ig/pre-init-spec ::backend [_]
+  (s/keys :opt-un [::region ::bucket]))
+
+(defmethod ig/init-key ::backend
+  [_ cfg]
+  ;; Return a valid backend data structure only if all optional
+  ;; parameters are provided.
+  (when (and (contains? cfg :region)
+             (string? (:bucket cfg)))
+    (let [client    (build-s3-client cfg)
+          presigner (build-s3-presigner cfg)]
+      (assoc cfg
+             :client client
+             :presigner presigner
+             :type :s3))))
+
+(s/def ::type #{:s3})
+(s/def ::client #(instance? S3Client %))
+(s/def ::presigner #(instance? S3Presigner %))
+(s/def ::backend
+  (s/keys :req-un [::region ::bucket ::client ::type ::presigner]))
+
+;; --- API IMPL
+
+(defmethod impl/put-object :s3
+  [backend object content]
+  (put-object backend object content))
+
+(defmethod impl/get-object :s3
+  [backend object]
+  (get-object backend object))
+
+(defmethod impl/get-object-url :s3
+  [backend object options]
+  (get-object-url backend object options))
+
+(defmethod impl/del-objects-in-bulk :s3
+  [backend ids]
+  (del-object-in-bulk backend ids))
+
+;; --- HELPERS
+
+(defn- lookup-region
+  [region]
+  (case region
+    :eu-central-1 Region/EU_CENTRAL_1))
+
+(defn- build-s3-client
+  [{:keys [region bucket]}]
+  (.. (S3Client/builder)
+      (region (lookup-region region))
+      (build)))
+
+(defn- build-s3-presigner
+  [{:keys [region]}]
+  (.. (S3Presigner/builder)
+      (region (lookup-region region))
+      (build)))
+
+(defn- put-object
+  [{:keys [client bucket]} {:keys [id] :as object} content]
+  (let [path    (impl/id->path id)
+        mdata   (meta object)
+        mtype   (:content-type mdata "application/octet-stream")
+        request (.. (PutObjectRequest/builder)
+                    (bucket bucket)
+                    (contentType mtype)
+                    (key path)
+                    (build))
+        content (RequestBody/fromInputStream (io/input-stream content)
+                                             (count content))]
+    (.putObject ^S3Client client
+                ^PutObjectRequest request
+                ^RequestBody content)))
+
+(defn- get-object
+  [{:keys [client bucket]} {:keys [id]}]
+  (let [gor (.. (GetObjectRequest/builder)
+                (bucket bucket)
+                (key (impl/id->path id))
+                (build))
+        obj (.getObject ^S3Client client gor)]
+    (io/input-stream obj)))
+
+(def default-max-age
+  (dt/duration {:minutes 10}))
+
+(defn- get-object-url
+  [{:keys [presigner bucket]} {:keys [id]} {:keys [max-age] :or {max-age default-max-age}}]
+  (us/assert dt/duration? max-age)
+  (let [gor  (.. (GetObjectRequest/builder)
+                 (bucket bucket)
+                 (key (impl/id->path id))
+                 (build))
+        gopr (.. (GetObjectPresignRequest/builder)
+                 (signatureDuration max-age)
+                 (getObjectRequest gor)
+                 (build))
+        pgor (.presignGetObject ^S3Presigner presigner gopr)]
+    (u/uri (str (.url ^PresignedGetObjectRequest pgor)))))
+
+(defn- del-object-in-bulk
+  [{:keys [bucket client]} ids]
+  (let [oids (map (fn [id]
+                    (.. (ObjectIdentifier/builder)
+                        (key (impl/id->path id))
+                        (build)))
+                  ids)
+        delc (.. (Delete/builder)
+                 (objects oids)
+                 (build))
+        dor  (.. (DeleteObjectsRequest/builder)
+                 (bucket bucket)
+                 (delete ^Delete delc)
+                 (build))
+        dres (.deleteObjects ^S3Client client
+                             ^DeleteObjectsRequest dor)]
+    (when (.hasErrors ^DeleteObjectsResponse dres)
+      (let [errors (seq (.errors ^DeleteObjectsResponse dres))]
+        (ex/raise :type :s3-error
+                  :code :error-on-bulk-delete
+                  :context errors)))))