🎉 Add builtin copy fast path operation for storage.

backend/src/app/storage.clj

@@ -69,10 +69,11 @@
           mdata  (meta object)
           result (db/exec-one! conn [sql:insert-storage-object id
                                      (:size object)
-                                     (name (:backend object))
+                                     (name backend)
                                      (db/tjson mdata)])]
       (assoc object
              :id (:id result)
+             :backend backend
              :created-at (:created-at result)))
     (let [id     (uuid/random)
           mdata  (dissoc object :content)
@@ -129,10 +130,10 @@
       (retrieve-database-object id)))
 
 (defn put-object
-  [{:keys [pool conn backend executor] :as storage} {:keys [content] :as object}]
+  [{:keys [pool conn backend executor] :as storage} {:keys [content] :as params}]
   (us/assert impl/content? content)
   (let [storage (assoc storage :conn (or conn pool))
-        object  (create-database-object storage object)]
+        object  (create-database-object storage params)]
 
     ;; Schedule to execute in background; in an other transaction and
     ;; register the currently created storage object id for a later
@@ -149,13 +150,21 @@
   [{:keys [pool conn executor] :as storage} object]
   (let [storage (assoc storage :conn (or conn pool))
         object* (create-database-object storage object)]
+    (if (= (:backend object) (:backend storage))
+      ;; if the source and destination backends are the same, we
+      ;; proceed to use the fast path with specific copy
+      ;; implementation on backend.
+      (-> (resolve-backend storage (:backend storage))
+          (impl/copy-object object object*))
 
+      ;; if the source and destination backends are different, we just
+      ;; need to obtain the streams and proceed full copy of the data
       (with-open [input (-> (resolve-backend storage (:backend object))
                             (impl/get-object-data object))]
         (-> (resolve-backend storage (:backend storage))
-          (impl/put-object object* (impl/content input (:size object))))
+            (impl/put-object object* (impl/content input (:size object))))))
 
-      object*)))
+    object*))
 
 (defn get-object-data
   [{:keys [pool conn] :as storage} object]

backend/src/app/storage/db.clj

@@ -46,6 +46,12 @@
     (db/insert! conn :storage-data {:id id :data data})
     object))
 
+(defmethod impl/copy-object :db
+  [{:keys [conn] :as storage} src-object dst-object]
+  (db/exec-one! conn ["insert into storage_data (id, data) select ? as id, data from storage_data  where id=?"
+                      (:id dst-object)
+                      (:id src-object)]))
+
 (defmethod impl/get-object-data :db
   [{:keys [conn] :as backend} {:keys [id] :as object}]
   (let [result (db/exec-one! conn ["select data from storage_data where id=?" id])]

backend/src/app/storage/fs.clj

@@ -59,6 +59,17 @@
                 ^OutputStream dst (io/output-stream full)]
       (io/copy src dst))))
 
+(defmethod impl/copy-object :fs
+  [backend src-object dst-object]
+  (let [base (fs/path (:directory backend))
+        path (fs/path (impl/id->path (:id dst-object)))
+        full (fs/normalize (fs/join base path))]
+    (when-not (fs/exists? (fs/parent full))
+      (fs/create-dir (fs/parent full)))
+    (with-open [^InputStream src  (impl/get-object-data backend src-object)
+                ^OutputStream dst (io/output-stream full)]
+      (io/copy src dst))))
+
 (defmethod impl/get-object-data :fs
   [backend {:keys [id] :as object}]
   (let [^Path base (fs/path (:directory backend))

backend/src/app/storage/impl.clj

@@ -33,6 +33,14 @@
             :code :invalid-storage-backend
             :context cfg))
 
+(defmulti copy-object (fn [cfg _ _] (:type cfg)))
+
+(defmethod copy-object :default
+  [cfg _ _]
+  (ex/raise :type :internal
+            :code :invalid-storage-backend
+            :context cfg))
+
 (defmulti get-object-data (fn [cfg _] (:type cfg)))
 
 (defmethod get-object-data :default

backend/src/app/storage/s3.clj

@@ -29,6 +29,7 @@
    software.amazon.awssdk.services.s3.S3Client
    software.amazon.awssdk.services.s3.S3ClientBuilder
    software.amazon.awssdk.services.s3.model.Delete
+   software.amazon.awssdk.services.s3.model.CopyObjectRequest
    software.amazon.awssdk.services.s3.model.DeleteObjectsRequest
    software.amazon.awssdk.services.s3.model.DeleteObjectsResponse
    software.amazon.awssdk.services.s3.model.GetObjectRequest
@@ -39,6 +40,7 @@
    software.amazon.awssdk.services.s3.presigner.model.PresignedGetObjectRequest))
 
 (declare put-object)
+(declare copy-object)
 (declare get-object)
 (declare get-object-url)
 (declare del-object-in-bulk)
@@ -85,6 +87,10 @@
   [backend object content]
   (put-object backend object content))
 
+(defmethod impl/copy-object :s3
+  [backend src-object dst-object]
+  (copy-object backend src-object dst-object))
+
 (defmethod impl/get-object-data :s3
   [backend object]
   (get-object backend object))
@@ -132,6 +138,23 @@
                 ^PutObjectRequest request
                 ^RequestBody content)))
 
+(defn- copy-object
+  [{:keys [client bucket prefix]} src-object dst-object]
+  (let [source-path  (str prefix (impl/id->path (:id src-object)))
+        source-mdata (meta src-object)
+        source-mtype (:content-type source-mdata "application/octet-stream")
+        dest-path    (str prefix (impl/id->path (:id dst-object)))
+
+        request      (.. (CopyObjectRequest/builder)
+                         (copySource (u/query-encode (str bucket "/" source-path)))
+                         (destinationBucket bucket)
+                         (destinationKey dest-path)
+                         (contentType source-mtype)
+                         (build))]
+
+    (.copyObject ^S3Client client
+                 ^CopyObjectRequest request)))
+
 (defn- get-object
   [{:keys [client bucket prefix]} {:keys [id]}]
   (let [gor (.. (GetObjectRequest/builder)