3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-06-04 06:41:37 +02:00
Code Issues Projects Releases Packages Wiki Activity

♻️ Refactor storage internal concurrency model

Browse source
This commit is contained in:
Andrey Antukh 2023-03-03 14:05:26 +01:00
parent aafbf6bc15
commit dfdc9c9fa5
16 changed files with 261 additions and 290 deletions
Download patch file Download diff file Expand all files Collapse all files

59
backend/src/app/http/assets.clj
View file

@ -14,10 +14,8 @@
[app.db :as db] [app.db :as db]
[app.storage :as sto] [app.storage :as sto]
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as wrk]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[integrant.core :as ig] [integrant.core :as ig]
[promesa.core :as p]
[yetti.response :as-alias yrs])) [yetti.response :as-alias yrs]))
(def ^:private cache-max-age (def ^:private cache-max-age
@ -38,15 +36,12 @@
(defn- serve-object-from-s3 (defn- serve-object-from-s3
[{:keys [::sto/storage] :as cfg} obj] [{:keys [::sto/storage] :as cfg} obj]
(let [mdata (meta obj)] (let [{:keys [host port] :as url} (sto/get-object-url storage obj {:max-age signature-max-age})]
(->> (sto/get-object-url storage obj {:max-age signature-max-age}) {::yrs/status 307
(p/fmap (fn [{:keys [host port] :as url}] ::yrs/headers {"location" (str url)
(let [headers {"location" (str url) "x-host" (cond-> host port (str ":" port))
"x-host" (cond-> host port (str ":" port)) "x-mtype" (-> obj meta :content-type)
"x-mtype" (:content-type mdata) "cache-control" (str "max-age=" (inst-ms cache-max-age))}}))
"cache-control" (str "max-age=" (inst-ms cache-max-age))}]
{::yrs/status 307
::yrs/headers headers}))))))
(defn- serve-object-from-fs (defn- serve-object-from-fs
[{:keys [::path]} obj] [{:keys [::path]} obj]
@ -56,9 +51,8 @@
headers {"x-accel-redirect" (:path purl) headers {"x-accel-redirect" (:path purl)
"content-type" (:content-type mdata) "content-type" (:content-type mdata)
"cache-control" (str "max-age=" (inst-ms cache-max-age))}] "cache-control" (str "max-age=" (inst-ms cache-max-age))}]
(p/resolved {::yrs/status 204
{::yrs/status 204 ::yrs/headers headers}))
::yrs/headers headers})))
(defn- serve-object (defn- serve-object
"Helper function that returns the appropriate response depending on "Helper function that returns the appropriate response depending on
@ -71,37 +65,34 @@
(defn objects-handler (defn objects-handler
"Handler that servers storage objects by id." "Handler that servers storage objects by id."
[{:keys [::sto/storage ::wrk/executor] :as cfg} request] [{:keys [::sto/storage] :as cfg} request]
(->> (get-id request) (let [id (get-id request)
(p/mcat executor (fn [id] (sto/get-object storage id))) obj (sto/get-object storage id)]
(p/mcat executor (fn [obj] (if obj
(if (some? obj) (serve-object cfg obj)
(serve-object cfg obj) {::yrs/status 404})))
(p/resolved {::yrs/status 404}))))
(p/await!)))
(defn- generic-handler (defn- generic-handler
"A generic handler helper/common code for file-media based handlers." "A generic handler helper/common code for file-media based handlers."
[{:keys [::sto/storage ::wrk/executor] :as cfg} request kf] [{:keys [::sto/storage] :as cfg} request kf]
(let [pool (::db/pool storage)] (let [pool (::db/pool storage)
(->> (get-id request) id (get-id request)
(p/fmap executor (fn [id] (get-file-media-object pool id))) mobj (get-file-media-object pool id)
(p/mcat executor (fn [mobj] (sto/get-object storage (kf mobj)))) sobj (sto/get-object storage (kf mobj))]
(p/mcat executor (fn [sobj] (if sobj
(if sobj (serve-object cfg sobj)
(serve-object cfg sobj) {::yrs/status 404})))
(p/resolved {::yrs/status 404})))))))
(defn file-objects-handler (defn file-objects-handler
"Handler that serves storage objects by file media id." "Handler that serves storage objects by file media id."
[cfg request] [cfg request]
(p/await! (generic-handler cfg request :media-id))) (generic-handler cfg request :media-id))
(defn file-thumbnails-handler (defn file-thumbnails-handler
"Handler that serves storage objects by thumbnail-id and quick "Handler that serves storage objects by thumbnail-id and quick
fallback to file-media-id if no thumbnail is available." fallback to file-media-id if no thumbnail is available."
[cfg request] [cfg request]
(p/await! (generic-handler cfg request #(or (:thumbnail-id %) (:media-id %))))) (generic-handler cfg request #(or (:thumbnail-id %) (:media-id %))))
;; --- Initialization ;; --- Initialization
@ -109,7 +100,7 @@
(s/def ::routes vector?) (s/def ::routes vector?)
(defmethod ig/pre-init-spec ::routes [_] (defmethod ig/pre-init-spec ::routes [_]
(s/keys :req [::sto/storage ::wrk/executor ::path])) (s/keys :req [::sto/storage ::path]))
(defmethod ig/init-key ::routes (defmethod ig/init-key ::routes
[_ cfg] [_ cfg]

7
backend/src/app/rpc/commands/binfile.clj
View file

@ -37,7 +37,6 @@
[clojure.walk :as walk] [clojure.walk :as walk]
[cuerdas.core :as str] [cuerdas.core :as str]
[datoteka.io :as io] [datoteka.io :as io]
[promesa.core :as p]
[yetti.adapter :as yt] [yetti.adapter :as yt]
[yetti.response :as yrs]) [yetti.response :as yrs])
(:import (:import
@ -527,13 +526,13 @@
(write-obj! output sids) (write-obj! output sids)
(doseq [id sids] (doseq [id sids]
(let [{:keys [size] :as obj} (p/await! (sto/get-object storage id))] (let [{:keys [size] :as obj} (sto/get-object storage id)]
(l/debug :hint "write sobject" :id id ::l/sync? true) (l/debug :hint "write sobject" :id id ::l/sync? true)
(doto output (doto output
(write-uuid! id) (write-uuid! id)
(write-obj! (meta obj))) (write-obj! (meta obj)))
(with-open [^InputStream stream (p/await! (sto/get-object-data storage obj))] (with-open [^InputStream stream (sto/get-object-data storage obj)]
(let [written (write-stream! output stream size)] (let [written (write-stream! output stream size)]
(when (not= written size) (when (not= written size)
(ex/raise :type :validation (ex/raise :type :validation
@ -719,7 +718,7 @@
(assoc ::sto/touched-at (dt/now)) (assoc ::sto/touched-at (dt/now))
(assoc :bucket "file-media-object")) (assoc :bucket "file-media-object"))
sobject (p/await! (sto/put-object! storage params))] sobject (sto/put-object! storage params)]
(l/debug :hint "persisted storage object" :id id :new-id (:id sobject) ::l/sync? true) (l/debug :hint "persisted storage object" :id id :new-id (:id sobject) ::l/sync? true)
(vswap! *state* update :index assoc id (:id sobject))))) (vswap! *state* update :index assoc id (:id sobject)))))

14
backend/src/app/rpc/commands/fonts.clj
View file

@ -6,6 +6,7 @@
(ns app.rpc.commands.fonts (ns app.rpc.commands.fonts
(:require (:require
[app.common.data.macros :as dm]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
@ -24,8 +25,7 @@
[app.storage :as sto] [app.storage :as sto]
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]))
[promesa.core :as p]))
(def valid-weight #{100 200 300 400 500 600 700 800 900 950}) (def valid-weight #{100 200 300 400 500 600 700 800 900 950})
(def valid-style #{"normal" "italic"}) (def valid-style #{"normal" "italic"})
@ -56,7 +56,7 @@
(sv/defmethod ::get-font-variants (sv/defmethod ::get-font-variants
{::doc/added "1.18"} {::doc/added "1.18"}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id file-id project-id] :as params}] [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id file-id project-id] :as params}]
(with-open [conn (db/open pool)] (dm/with-open [conn (db/open pool)]
(cond (cond
(uuid? team-id) (uuid? team-id)
(do (do
@ -134,13 +134,13 @@
wf2-params (prepare-font data "font/woff2")] wf2-params (prepare-font data "font/woff2")]
(cond-> {} (cond-> {}
(some? otf-params) (some? otf-params)
(assoc :otf (p/await! (sto/put-object! storage otf-params))) (assoc :otf (sto/put-object! storage otf-params))
(some? ttf-params) (some? ttf-params)
(assoc :ttf (p/await! (sto/put-object! storage ttf-params))) (assoc :ttf (sto/put-object! storage ttf-params))
(some? wf1-params) (some? wf1-params)
(assoc :woff1 (p/await! (sto/put-object! storage wf1-params))) (assoc :woff1 (sto/put-object! storage wf1-params))
(some? wf2-params) (some? wf2-params)
(assoc :woff2 (p/await! (sto/put-object! storage wf2-params)))))) (assoc :woff2 (sto/put-object! storage wf2-params)))))
(insert-font-variant! [{:keys [woff1 woff2 otf ttf]}] (insert-font-variant! [{:keys [woff1 woff2 otf ttf]}]
(db/insert! pool :team-font-variant (db/insert! pool :team-font-variant

7
backend/src/app/rpc/commands/media.clj
View file

@ -24,8 +24,7 @@
[app.util.services :as sv] [app.util.services :as sv]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
[datoteka.io :as io] [datoteka.io :as io]))
[promesa.core :as p]))
(def default-max-file-size (def default-max-file-size
(* 1024 1024 10)) ; 10 MiB (* 1024 1024 10)) ; 10 MiB
@ -151,9 +150,9 @@
(let [result (-> (climit/configure cfg :process-image) (let [result (-> (climit/configure cfg :process-image)
(climit/submit! (partial process-image content))) (climit/submit! (partial process-image content)))
image (p/await! (sto/put-object! storage (::image result))) image (sto/put-object! storage (::image result))
thumb (when-let [params (::thumb result)] thumb (when-let [params (::thumb result)]
(p/await! (sto/put-object! storage params)))] (sto/put-object! storage params))]
(db/exec-one! pool [sql:create-file-media-object (db/exec-one! pool [sql:create-file-media-object
(or id (uuid/next)) (or id (uuid/next))

7
backend/src/app/rpc/commands/profile.clj
View file

@ -27,8 +27,7 @@
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]))
[promesa.core :as p]))
(declare check-profile-existence!) (declare check-profile-existence!)
(declare decode-row) (declare decode-row)
@ -182,7 +181,7 @@
;; Schedule deletion of old photo ;; Schedule deletion of old photo
(when-let [id (:photo-id profile)] (when-let [id (:photo-id profile)]
(p/await! (sto/touch-object! storage id))) (sto/touch-object! storage id))
;; Save new photo ;; Save new photo
(db/update! pool :profile (db/update! pool :profile
@ -217,7 +216,7 @@
[{:keys [::sto/storage] :as cfg} {:keys [file]}] [{:keys [::sto/storage] :as cfg} {:keys [file]}]
(let [params (-> (climit/configure cfg :process-image) (let [params (-> (climit/configure cfg :process-image)
(climit/submit! (partial generate-thumbnail! file)))] (climit/submit! (partial generate-thumbnail! file)))]
(p/await! (sto/put-object! storage params)))) (sto/put-object! storage params)))
;; --- MUTATION: Request Email Change ;; --- MUTATION: Request Email Change

18
backend/src/app/rpc/commands/teams.clj
View file

@ -7,6 +7,7 @@
(ns app.rpc.commands.teams (ns app.rpc.commands.teams
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.spec :as us] [app.common.spec :as us]
@ -28,8 +29,7 @@
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]))
[promesa.core :as p]))
;; --- Helpers & Specs ;; --- Helpers & Specs
@ -84,7 +84,7 @@
(sv/defmethod ::get-teams (sv/defmethod ::get-teams
{::doc/added "1.17"} {::doc/added "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}] [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
(with-open [conn (db/open pool)] (dm/with-open [conn (db/open pool)]
(retrieve-teams conn profile-id))) (retrieve-teams conn profile-id)))
(def sql:teams (def sql:teams
@ -129,7 +129,7 @@
(sv/defmethod ::get-team (sv/defmethod ::get-team
{::doc/added "1.17"} {::doc/added "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id]}] [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id]}]
(with-open [conn (db/open pool)] (dm/with-open [conn (db/open pool)]
(retrieve-team conn profile-id id))) (retrieve-team conn profile-id id)))
(defn retrieve-team (defn retrieve-team
@ -170,7 +170,7 @@
(sv/defmethod ::get-team-members (sv/defmethod ::get-team-members
{::doc/added "1.17"} {::doc/added "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}] [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
(with-open [conn (db/open pool)] (dm/with-open [conn (db/open pool)]
(check-read-permissions! conn profile-id team-id) (check-read-permissions! conn profile-id team-id)
(retrieve-team-members conn team-id))) (retrieve-team-members conn team-id)))
@ -188,7 +188,7 @@
(sv/defmethod ::get-team-users (sv/defmethod ::get-team-users
{::doc/added "1.17"} {::doc/added "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id file-id]}] [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id file-id]}]
(with-open [conn (db/open pool)] (dm/with-open [conn (db/open pool)]
(if team-id (if team-id
(do (do
(check-read-permissions! conn profile-id team-id) (check-read-permissions! conn profile-id team-id)
@ -246,7 +246,7 @@
(sv/defmethod ::get-team-stats (sv/defmethod ::get-team-stats
{::doc/added "1.17"} {::doc/added "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}] [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
(with-open [conn (db/open pool)] (dm/with-open [conn (db/open pool)]
(check-read-permissions! conn profile-id team-id) (check-read-permissions! conn profile-id team-id)
(retrieve-team-stats conn team-id))) (retrieve-team-stats conn team-id)))
@ -277,7 +277,7 @@
(sv/defmethod ::get-team-invitations (sv/defmethod ::get-team-invitations
{::doc/added "1.17"} {::doc/added "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}] [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
(with-open [conn (db/open pool)] (dm/with-open [conn (db/open pool)]
(check-read-permissions! conn profile-id team-id) (check-read-permissions! conn profile-id team-id)
(get-team-invitations conn team-id))) (get-team-invitations conn team-id)))
@ -595,7 +595,7 @@
;; Mark object as touched for make it ellegible for tentative ;; Mark object as touched for make it ellegible for tentative
;; garbage collection. ;; garbage collection.
(when-let [id (:photo-id team)] (when-let [id (:photo-id team)]
(p/await! (sto/touch-object! storage id))) (sto/touch-object! storage id))
;; Save new photo ;; Save new photo
(db/update! pool :team (db/update! pool :team

146
backend/src/app/storage.clj
View file

@ -22,8 +22,7 @@
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[datoteka.fs :as fs] [datoteka.fs :as fs]
[integrant.core :as ig] [integrant.core :as ig]
[promesa.core :as p] [promesa.core :as p]))
[promesa.exec :as px]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Storage Module State ;; Storage Module State
@ -79,42 +78,40 @@
(update :metadata db/decode-transit-pgobject)))) (update :metadata db/decode-transit-pgobject))))
(defn- create-database-object (defn- create-database-object
[{:keys [::backend ::wrk/executor ::db/pool-or-conn]} {:keys [::content ::expired-at ::touched-at] :as params}] [{:keys [::backend ::db/pool-or-conn]} {:keys [::content ::expired-at ::touched-at] :as params}]
(px/with-dispatch executor (let [id (uuid/random)
(let [id (uuid/random) mdata (cond-> (get-metadata params)
(satisfies? impl/IContentHash content)
(assoc :hash (impl/get-hash content)))
mdata (cond-> (get-metadata params) ;; NOTE: for now we don't reuse the deleted objects, but in
(satisfies? impl/IContentHash content) ;; futute we can consider reusing deleted objects if we
(assoc :hash (impl/get-hash content))) ;; found a duplicated one and is marked for deletion but
;; still not deleted.
result (when (and (::deduplicate? params)
(:hash mdata)
(:bucket mdata))
(get-database-object-by-hash pool-or-conn backend (:bucket mdata) (:hash mdata)))
;; NOTE: for now we don't reuse the deleted objects, but in result (or result
;; futute we can consider reusing deleted objects if we (-> (db/insert! pool-or-conn :storage-object
;; found a duplicated one and is marked for deletion but {:id id
;; still not deleted. :size (impl/get-size content)
result (when (and (::deduplicate? params) :backend (name backend)
(:hash mdata) :metadata (db/tjson mdata)
(:bucket mdata)) :deleted-at expired-at
(get-database-object-by-hash pool-or-conn backend (:bucket mdata) (:hash mdata))) :touched-at touched-at})
(update :metadata db/decode-transit-pgobject)
(update :metadata assoc ::created? true)))]
result (or result (impl/storage-object
(-> (db/insert! pool-or-conn :storage-object (:id result)
{:id id (:size result)
:size (impl/get-size content) (:created-at result)
:backend (name backend) (:deleted-at result)
:metadata (db/tjson mdata) (:touched-at result)
:deleted-at expired-at backend
:touched-at touched-at}) (:metadata result))))
(update :metadata db/decode-transit-pgobject)
(update :metadata assoc ::created? true)))]
(impl/storage-object
(:id result)
(:size result)
(:created-at result)
(:deleted-at result)
(:touched-at result)
backend
(:metadata result)))))
(def ^:private sql:retrieve-storage-object (def ^:private sql:retrieve-storage-object
"select * from storage_object where id = ? and (deleted_at is null or deleted_at > now())") "select * from storage_object where id = ? and (deleted_at is null or deleted_at > now())")
@ -153,45 +150,41 @@
(dm/export impl/object?) (dm/export impl/object?)
(defn get-object (defn get-object
[{:keys [::db/pool-or-conn ::wrk/executor] :as storage} id] [{:keys [::db/pool-or-conn] :as storage} id]
(us/assert! ::storage storage) (us/assert! ::storage storage)
(px/with-dispatch executor (retrieve-database-object pool-or-conn id))
(retrieve-database-object pool-or-conn id)))
(defn put-object! (defn put-object!
"Creates a new object with the provided content." "Creates a new object with the provided content."
[{:keys [::backend] :as storage} {:keys [::content] :as params}] [{:keys [::backend] :as storage} {:keys [::content] :as params}]
(us/assert! ::storage-with-backend storage) (us/assert! ::storage-with-backend storage)
(us/assert! ::impl/content content) (us/assert! ::impl/content content)
(->> (create-database-object storage params) (let [object (create-database-object storage params)]
(p/mcat (fn [object] (if (::created? (meta object))
(if (::created? (meta object)) ;; Store the data finally on the underlying storage subsystem.
;; Store the data finally on the underlying storage subsystem. (-> (impl/resolve-backend storage backend)
(-> (impl/resolve-backend storage backend) (impl/put-object object content))
(impl/put-object object content)) object)))
(p/resolved object))))))
(defn touch-object! (defn touch-object!
"Mark object as touched." "Mark object as touched."
[{:keys [::db/pool-or-conn ::wrk/executor] :as storage} object-or-id] [{:keys [::db/pool-or-conn] :as storage} object-or-id]
(us/assert! ::storage storage) (us/assert! ::storage storage)
(px/with-dispatch executor (let [id (if (impl/object? object-or-id) (:id object-or-id) object-or-id)
(let [id (if (impl/object? object-or-id) (:id object-or-id) object-or-id) rs (db/update! pool-or-conn :storage-object
rs (db/update! pool-or-conn :storage-object {:touched-at (dt/now)}
{:touched-at (dt/now)} {:id id}
{:id id} {::db/return-keys? false})]
{::db/return-keys? false})] (pos? (db/get-update-count rs))))
(pos? (db/get-update-count rs)))))
(defn get-object-data (defn get-object-data
"Return an input stream instance of the object content." "Return an input stream instance of the object content."
[storage object] [storage object]
(us/assert! ::storage storage) (us/assert! ::storage storage)
(if (or (nil? (:expired-at object)) (when (or (nil? (:expired-at object))
(dt/is-after? (:expired-at object) (dt/now))) (dt/is-after? (:expired-at object) (dt/now)))
(-> (impl/resolve-backend storage (:backend object)) (-> (impl/resolve-backend storage (:backend object))
(impl/get-object-data object)) (impl/get-object-data object))))
(p/resolved nil)))
(defn get-object-bytes (defn get-object-bytes
"Returns a byte array of object content." "Returns a byte array of object content."
@ -208,11 +201,10 @@
(get-object-url storage object nil)) (get-object-url storage object nil))
([storage object options] ([storage object options]
(us/assert! ::storage storage) (us/assert! ::storage storage)
(if (or (nil? (:expired-at object)) (when (or (nil? (:expired-at object))
(dt/is-after? (:expired-at object) (dt/now))) (dt/is-after? (:expired-at object) (dt/now)))
(-> (impl/resolve-backend storage (:backend object)) (-> (impl/resolve-backend storage (:backend object))
(impl/get-object-url object options)) (impl/get-object-url object options)))))
(p/resolved nil))))
(defn get-object-path (defn get-object-path
"Get the Path to the object. Only works with `:fs` type of "Get the Path to the object. Only works with `:fs` type of
@ -220,24 +212,20 @@
[storage object] [storage object]
(us/assert! ::storage storage) (us/assert! ::storage storage)
(let [backend (impl/resolve-backend storage (:backend object))] (let [backend (impl/resolve-backend storage (:backend object))]
(if (not= :fs (::type backend)) (when (and (= :fs (::type backend))
(p/resolved nil) (or (nil? (:expired-at object))
(if (or (nil? (:expired-at object)) (dt/is-after? (:expired-at object) (dt/now))))
(dt/is-after? (:expired-at object) (dt/now))) (-> (impl/get-object-url backend object nil) file-url->path))))
(->> (impl/get-object-url backend object nil)
(p/fmap file-url->path))
(p/resolved nil)))))
(defn del-object! (defn del-object!
[{:keys [::db/pool-or-conn ::wrk/executor] :as storage} object-or-id] [{:keys [::db/pool-or-conn] :as storage} object-or-id]
(us/assert! ::storage storage) (us/assert! ::storage storage)
(px/with-dispatch executor (let [id (if (impl/object? object-or-id) (:id object-or-id) object-or-id)
(let [id (if (impl/object? object-or-id) (:id object-or-id) object-or-id) res (db/update! pool-or-conn :storage-object
res (db/update! pool-or-conn :storage-object {:deleted-at (dt/now)}
{:deleted-at (dt/now)} {:id id}
{:id id} {::db/return-keys? false})]
{::db/return-keys? false})] (pos? (db/get-update-count res))))
(pos? (db/get-update-count res)))))
(dm/export impl/resolve-backend) (dm/export impl/resolve-backend)
(dm/export impl/calculate-hash) (dm/export impl/calculate-hash)
@ -281,7 +269,7 @@
(doseq [id ids] (doseq [id ids]
(l/debug :hint "gc-deleted: permanently delete storage object" :backend backend-id :id id)) (l/debug :hint "gc-deleted: permanently delete storage object" :backend backend-id :id id))
@(impl/del-objects-in-bulk backend ids)))] (impl/del-objects-in-bulk backend ids)))]
(fn [params] (fn [params]
(let [min-age (or (:min-age params) min-age)] (let [min-age (or (:min-age params) min-age)]
@ -422,8 +410,8 @@
(ex/raise :type :internal (ex/raise :type :internal
:code :unexpected-unknown-reference :code :unexpected-unknown-reference
:hint (dm/fmt "unknown reference %" bucket)))] :hint (dm/fmt "unknown reference %" bucket)))]
(recur (+ to-freeze f) (recur (+ to-freeze (long f))
(+ to-delete d) (+ to-delete (long d))
(rest groups))) (rest groups)))
(do (do
(l/info :hint "gc-touched: task finished" :to-freeze to-freeze :to-delete to-delete) (l/info :hint "gc-touched: task finished" :to-freeze to-freeze :to-delete to-delete)

96
backend/src/app/storage/fs.clj
View file

@ -6,22 +6,18 @@
(ns app.storage.fs (ns app.storage.fs
(:require (:require
[app.common.data.macros :as dm]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.uri :as u] [app.common.uri :as u]
[app.storage :as-alias sto] [app.storage :as-alias sto]
[app.storage.impl :as impl] [app.storage.impl :as impl]
[app.worker :as-alias wrk]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
[datoteka.fs :as fs] [datoteka.fs :as fs]
[datoteka.io :as io] [datoteka.io :as io]
[integrant.core :as ig] [integrant.core :as ig])
[promesa.core :as p]
[promesa.exec :as px])
(:import (:import
java.io.InputStream
java.io.OutputStream
java.nio.file.Path java.nio.file.Path
java.nio.file.Files)) java.nio.file.Files))
@ -48,74 +44,66 @@
(s/keys :req [::directory (s/keys :req [::directory
::uri] ::uri]
:opt [::sto/type :opt [::sto/type
::sto/id ::sto/id]))
::wrk/executor]))
;; --- API IMPL ;; --- API IMPL
(defmethod impl/put-object :fs (defmethod impl/put-object :fs
[{:keys [::wrk/executor] :as backend} {:keys [id] :as object} content] [backend {:keys [id] :as object} content]
(us/assert! ::backend backend) (us/assert! ::backend backend)
(px/with-dispatch executor (let [base (fs/path (::directory backend))
(let [base (fs/path (::directory backend)) path (fs/path (impl/id->path id))
path (fs/path (impl/id->path id)) full (fs/normalize (fs/join base path))]
full (fs/normalize (fs/join base path))]
(when-not (fs/exists? (fs/parent full))
(fs/create-dir (fs/parent full)))
(with-open [^InputStream src (io/input-stream content)
^OutputStream dst (io/output-stream full)]
(io/copy! src dst))
object))) (when-not (fs/exists? (fs/parent full))
(fs/create-dir (fs/parent full)))
(dm/with-open [src (io/input-stream content)
dst (io/output-stream full)]
(io/copy! src dst))
object))
(defmethod impl/get-object-data :fs (defmethod impl/get-object-data :fs
[{:keys [::wrk/executor] :as backend} {:keys [id] :as object}] [backend {:keys [id] :as object}]
(us/assert! ::backend backend) (us/assert! ::backend backend)
(px/with-dispatch executor (let [^Path base (fs/path (::directory backend))
(let [^Path base (fs/path (::directory backend)) ^Path path (fs/path (impl/id->path id))
^Path path (fs/path (impl/id->path id)) ^Path full (fs/normalize (fs/join base path))]
^Path full (fs/normalize (fs/join base path))] (when-not (fs/exists? full)
(when-not (fs/exists? full) (ex/raise :type :internal
(ex/raise :type :internal :code :filesystem-object-does-not-exists
:code :filesystem-object-does-not-exists :path (str full)))
:path (str full))) (io/input-stream full)))
(io/input-stream full))))
(defmethod impl/get-object-bytes :fs (defmethod impl/get-object-bytes :fs
[backend object] [backend object]
(->> (impl/get-object-data backend object) (dm/with-open [input (impl/get-object-data backend object)]
(p/fmap (fn [input] (io/read-as-bytes input)))
(try
(io/read-as-bytes input)
(finally
(io/close! input)))))))
(defmethod impl/get-object-url :fs (defmethod impl/get-object-url :fs
[{:keys [::uri] :as backend} {:keys [id] :as object} _] [{:keys [::uri] :as backend} {:keys [id] :as object} _]
(us/assert! ::backend backend) (us/assert! ::backend backend)
(p/resolved (update uri :path
(update uri :path (fn [existing]
(fn [existing] (if (str/ends-with? existing "/")
(if (str/ends-with? existing "/") (str existing (impl/id->path id))
(str existing (impl/id->path id)) (str existing "/" (impl/id->path id))))))
(str existing "/" (impl/id->path id)))))))
(defmethod impl/del-object :fs (defmethod impl/del-object :fs
[{:keys [::wrk/executor] :as backend} {:keys [id] :as object}] [backend {:keys [id] :as object}]
(us/assert! ::backend backend) (us/assert! ::backend backend)
(px/with-dispatch executor (let [base (fs/path (::directory backend))
(let [base (fs/path (::directory backend)) path (fs/path (impl/id->path id))
path (fs/path (impl/id->path id)) path (fs/join base path)]
path (fs/join base path)] (Files/deleteIfExists ^Path path)))
(Files/deleteIfExists ^Path path))))
(defmethod impl/del-objects-in-bulk :fs (defmethod impl/del-objects-in-bulk :fs
[{:keys [::wrk/executor] :as backend} ids] [backend ids]
(us/assert! ::backend backend) (us/assert! ::backend backend)
(px/with-dispatch executor (let [base (fs/path (::directory backend))]
(let [base (fs/path (::directory backend))] (doseq [id ids]
(doseq [id ids] (let [path (fs/path (impl/id->path id))
(let [path (fs/path (impl/id->path id)) path (fs/join base path)]
path (fs/join base path)] (Files/deleteIfExists ^Path path)))))
(Files/deleteIfExists ^Path path))))))

6
backend/src/app/storage/impl.clj
View file

@ -153,8 +153,8 @@
(content (.toPath ^java.io.File data) size) (content (.toPath ^java.io.File data) size)
(instance? String data) (instance? String data)
(let [data (.getBytes data "UTF-8")] (let [data (.getBytes ^String data "UTF-8")]
(bytes->content data (alength data))) (bytes->content data (alength ^bytes data)))
(bytes? data) (bytes? data)
(bytes->content data (or size (alength ^bytes data))) (bytes->content data (or size (alength ^bytes data)))
@ -195,7 +195,7 @@
(defn calculate-hash (defn calculate-hash
[resource] [resource]
(let [result (with-open [input (io/input-stream resource)] (let [result (dm/with-open [input (io/input-stream resource)]
(-> (bh/blake2b-256 input) (-> (bh/blake2b-256 input)
(bc/bytes->hex)))] (bc/bytes->hex)))]
(str "blake2b:" result))) (str "blake2b:" result)))

34
backend/src/app/storage/s3.clj
View file

@ -45,6 +45,7 @@
software.amazon.awssdk.http.nio.netty.SdkEventLoopGroup software.amazon.awssdk.http.nio.netty.SdkEventLoopGroup
software.amazon.awssdk.regions.Region software.amazon.awssdk.regions.Region
software.amazon.awssdk.services.s3.S3AsyncClient software.amazon.awssdk.services.s3.S3AsyncClient
software.amazon.awssdk.services.s3.S3AsyncClientBuilder
software.amazon.awssdk.services.s3.S3Configuration software.amazon.awssdk.services.s3.S3Configuration
software.amazon.awssdk.services.s3.model.Delete software.amazon.awssdk.services.s3.model.Delete
software.amazon.awssdk.services.s3.model.DeleteObjectRequest software.amazon.awssdk.services.s3.model.DeleteObjectRequest
@ -121,7 +122,7 @@
(defmethod impl/put-object :s3 (defmethod impl/put-object :s3
[backend object content] [backend object content]
(us/assert! ::backend backend) (us/assert! ::backend backend)
(put-object backend object content)) (p/await! (put-object backend object content)))
(defmethod impl/get-object-data :s3 (defmethod impl/get-object-data :s3
[backend object] [backend object]
@ -135,12 +136,13 @@
:cause cause))] :cause cause))]
(-> (get-object-data backend object) (-> (get-object-data backend object)
(p/catch no-such-key? handle-not-found)))) (p/catch no-such-key? handle-not-found)
(p/await!))))
(defmethod impl/get-object-bytes :s3 (defmethod impl/get-object-bytes :s3
[backend object] [backend object]
(us/assert! ::backend backend) (us/assert! ::backend backend)
(get-object-bytes backend object)) (p/await! (get-object-bytes backend object)))
(defmethod impl/get-object-url :s3 (defmethod impl/get-object-url :s3
[backend object options] [backend object options]
@ -150,12 +152,12 @@
(defmethod impl/del-object :s3 (defmethod impl/del-object :s3
[backend object] [backend object]
(us/assert! ::backend backend) (us/assert! ::backend backend)
(del-object backend object)) (p/await! (del-object backend object)))
(defmethod impl/del-objects-in-bulk :s3 (defmethod impl/del-objects-in-bulk :s3
[backend ids] [backend ids]
(us/assert! ::backend backend) (us/assert! ::backend backend)
(del-object-in-bulk backend ids)) (p/await! (del-object-in-bulk backend ids)))
;; --- HELPERS ;; --- HELPERS
@ -187,13 +189,17 @@
(.writeTimeout default-timeout) (.writeTimeout default-timeout)
(.build)) (.build))
client (-> (S3AsyncClient/builder) client (let [builder (S3AsyncClient/builder)
(.serviceConfiguration ^S3Configuration sconfig) builder (.serviceConfiguration ^S3AsyncClientBuilder builder ^S3Configuration sconfig)
(.asyncConfiguration ^ClientAsyncConfiguration aconfig) builder (.asyncConfiguration ^S3AsyncClientBuilder builder ^ClientAsyncConfiguration aconfig)
(.httpClient ^NettyNioAsyncHttpClient hclient) builder (.httpClient ^S3AsyncClientBuilder builder ^NettyNioAsyncHttpClient hclient)
(.region (lookup-region region)) builder (.region ^S3AsyncClientBuilder builder (lookup-region region))
(cond-> (some? endpoint) (.endpointOverride (URI. endpoint))) builder (cond-> ^S3AsyncClientBuilder builder
(.build))] (some? endpoint)
(.endpointOverride (URI. endpoint)))]
(.build ^S3AsyncClientBuilder builder))
]
(reify (reify
clojure.lang.IDeref clojure.lang.IDeref
@ -288,6 +294,7 @@
^AsyncRequestBody rbody) ^AsyncRequestBody rbody)
(p/fmap (constantly object))))) (p/fmap (constantly object)))))
;; FIXME: research how to avoid reflection on close method
(defn- path->stream (defn- path->stream
[path] [path]
(proxy [FilterInputStream] [(io/input-stream path)] (proxy [FilterInputStream] [(io/input-stream path)]
@ -347,8 +354,7 @@
(getObjectRequest ^GetObjectRequest gor) (getObjectRequest ^GetObjectRequest gor)
(build)) (build))
pgor (.presignGetObject ^S3Presigner presigner ^GetObjectPresignRequest gopr)] pgor (.presignGetObject ^S3Presigner presigner ^GetObjectPresignRequest gopr)]
(p/resolved (u/uri (str (.url ^PresignedGetObjectRequest pgor)))))
(u/uri (str (.url ^PresignedGetObjectRequest pgor))))))
(defn- del-object (defn- del-object
[{:keys [::bucket ::client ::prefix]} {:keys [id] :as obj}] [{:keys [::bucket ::client ::prefix]} {:keys [id] :as obj}]

12
backend/src/app/tasks/objects_gc.clj
View file

@ -85,7 +85,7 @@
;; Mark as deleted the storage object related with the ;; Mark as deleted the storage object related with the
;; photo-id field. ;; photo-id field.
(some->> photo-id (sto/touch-object! storage) deref) (some->> photo-id (sto/touch-object! storage))
;; And finally, permanently delete the profile. ;; And finally, permanently delete the profile.
(db/delete! conn :profile {:id id}) (db/delete! conn :profile {:id id})
@ -117,7 +117,7 @@
;; Mark as deleted the storage object related with the ;; Mark as deleted the storage object related with the
;; photo-id field. ;; photo-id field.
(some->> photo-id (sto/touch-object! storage) deref) (some->> photo-id (sto/touch-object! storage))
;; And finally, permanently delete the team. ;; And finally, permanently delete the team.
(db/delete! conn :team {:id id}) (db/delete! conn :team {:id id})
@ -184,10 +184,10 @@
(l/debug :hint "permanently delete font variant" :id (str id)) (l/debug :hint "permanently delete font variant" :id (str id))
;; Mark as deleted the all related storage objects ;; Mark as deleted the all related storage objects
(some->> (:woff1-file-id font) (sto/touch-object! storage) deref) (some->> (:woff1-file-id font) (sto/touch-object! storage))
(some->> (:woff2-file-id font) (sto/touch-object! storage) deref) (some->> (:woff2-file-id font) (sto/touch-object! storage))
(some->> (:otf-file-id font) (sto/touch-object! storage) deref) (some->> (:otf-file-id font) (sto/touch-object! storage))
(some->> (:ttf-file-id font) (sto/touch-object! storage) deref) (some->> (:ttf-file-id font) (sto/touch-object! storage))
;; And finally, permanently delete the team font variant ;; And finally, permanently delete the team font variant
(db/delete! conn :team-font-variant {:id id}) (db/delete! conn :team-font-variant {:id id})

25
backend/test/backend_tests/helpers.clj
View file

@ -8,6 +8,7 @@
(:require (:require
[app.auth] [app.auth]
[app.common.data :as d] [app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.flags :as flags] [app.common.flags :as flags]
[app.common.pages :as cp] [app.common.pages :as cp]
@ -208,7 +209,7 @@
:password "123123" :password "123123"
:is-demo false} :is-demo false}
params)] params)]
(with-open [conn (db/open pool)] (dm/with-open [conn (db/open pool)]
(->> params (->> params
(cmd.auth/create-profile! conn) (cmd.auth/create-profile! conn)
(cmd.auth/create-profile-rels! conn)))))) (cmd.auth/create-profile-rels! conn))))))
@ -218,7 +219,7 @@
([pool i {:keys [profile-id team-id] :as params}] ([pool i {:keys [profile-id team-id] :as params}]
(us/assert uuid? profile-id) (us/assert uuid? profile-id)
(us/assert uuid? team-id) (us/assert uuid? team-id)
(with-open [conn (db/open pool)] (dm/with-open [conn (db/open pool)]
(->> (merge {:id (mk-uuid "project" i) (->> (merge {:id (mk-uuid "project" i)
:name (str "project" i)} :name (str "project" i)}
params) params)
@ -230,7 +231,7 @@
([pool i {:keys [profile-id project-id] :as params}] ([pool i {:keys [profile-id project-id] :as params}]
(us/assert uuid? profile-id) (us/assert uuid? profile-id)
(us/assert uuid? project-id) (us/assert uuid? project-id)
(with-open [conn (db/open pool)] (dm/with-open [conn (db/open pool)]
(files.create/create-file conn (files.create/create-file conn
(merge {:id (mk-uuid "file" i) (merge {:id (mk-uuid "file" i)
:name (str "file" i) :name (str "file" i)
@ -246,7 +247,7 @@
([i params] (create-team* *pool* i params)) ([i params] (create-team* *pool* i params))
([pool i {:keys [profile-id] :as params}] ([pool i {:keys [profile-id] :as params}]
(us/assert uuid? profile-id) (us/assert uuid? profile-id)
(with-open [conn (db/open pool)] (dm/with-open [conn (db/open pool)]
(let [id (mk-uuid "team" i)] (let [id (mk-uuid "team" i)]
(teams/create-team conn {:id id (teams/create-team conn {:id id
:profile-id profile-id :profile-id profile-id
@ -257,7 +258,7 @@
([pool {:keys [name width height mtype file-id is-local media-id] ([pool {:keys [name width height mtype file-id is-local media-id]
:or {name "sample" width 100 height 100 mtype "image/svg+xml" is-local true}}] :or {name "sample" width 100 height 100 mtype "image/svg+xml" is-local true}}]
(with-open [conn (db/open pool)] (dm/with-open [conn (db/open pool)]
(db/insert! conn :file-media-object (db/insert! conn :file-media-object
{:id (uuid/next) {:id (uuid/next)
:file-id file-id :file-id file-id
@ -271,12 +272,12 @@
(defn link-file-to-library* (defn link-file-to-library*
([params] (link-file-to-library* *pool* params)) ([params] (link-file-to-library* *pool* params))
([pool {:keys [file-id library-id] :as params}] ([pool {:keys [file-id library-id] :as params}]
(with-open [conn (db/open pool)] (dm/with-open [conn (db/open pool)]
(#'files/link-file-to-library conn {:file-id file-id :library-id library-id})))) (#'files/link-file-to-library conn {:file-id file-id :library-id library-id}))))
(defn create-complaint-for (defn create-complaint-for
[pool {:keys [id created-at type]}] [pool {:keys [id created-at type]}]
(with-open [conn (db/open pool)] (dm/with-open [conn (db/open pool)]
(db/insert! conn :profile-complaint-report (db/insert! conn :profile-complaint-report
{:profile-id id {:profile-id id
:created-at (or created-at (dt/now)) :created-at (or created-at (dt/now))
@ -285,7 +286,7 @@
(defn create-global-complaint-for (defn create-global-complaint-for
[pool {:keys [email type created-at]}] [pool {:keys [email type created-at]}]
(with-open [conn (db/open pool)] (dm/with-open [conn (db/open pool)]
(db/insert! conn :global-complaint-report (db/insert! conn :global-complaint-report
{:email email {:email email
:type (name type) :type (name type)
@ -295,7 +296,7 @@
(defn create-team-role* (defn create-team-role*
([params] (create-team-role* *pool* params)) ([params] (create-team-role* *pool* params))
([pool {:keys [team-id profile-id role] :or {role :owner}}] ([pool {:keys [team-id profile-id role] :or {role :owner}}]
(with-open [conn (db/open pool)] (dm/with-open [conn (db/open pool)]
(#'teams/create-team-role conn {:team-id team-id (#'teams/create-team-role conn {:team-id team-id
:profile-id profile-id :profile-id profile-id
:role role})))) :role role}))))
@ -303,7 +304,7 @@
(defn create-project-role* (defn create-project-role*
([params] (create-project-role* *pool* params)) ([params] (create-project-role* *pool* params))
([pool {:keys [project-id profile-id role] :or {role :owner}}] ([pool {:keys [project-id profile-id role] :or {role :owner}}]
(with-open [conn (db/open pool)] (dm/with-open [conn (db/open pool)]
(#'teams/create-project-role conn {:project-id project-id (#'teams/create-project-role conn {:project-id project-id
:profile-id profile-id :profile-id profile-id
:role role})))) :role role}))))
@ -311,7 +312,7 @@
(defn create-file-role* (defn create-file-role*
([params] (create-file-role* *pool* params)) ([params] (create-file-role* *pool* params))
([pool {:keys [file-id profile-id role] :or {role :owner}}] ([pool {:keys [file-id profile-id role] :or {role :owner}}]
(with-open [conn (db/open pool)] (dm/with-open [conn (db/open pool)]
(files.create/create-file-role! conn {:file-id file-id (files.create/create-file-role! conn {:file-id file-id
:profile-id profile-id :profile-id profile-id
:role role})))) :role role}))))
@ -320,7 +321,7 @@
([params] (update-file* *pool* params)) ([params] (update-file* *pool* params))
([pool {:keys [file-id changes session-id profile-id revn] ([pool {:keys [file-id changes session-id profile-id revn]
:or {session-id (uuid/next) revn 0}}] :or {session-id (uuid/next) revn 0}}]
(with-open [conn (db/open pool)] (dm/with-open [conn (db/open pool)]
(let [features #{"components/v2"} (let [features #{"components/v2"}
cfg (-> (select-keys *system* [::mbus/msgbus ::mtx/metrics]) cfg (-> (select-keys *system* [::mbus/msgbus ::mtx/metrics])
(assoc ::db/conn conn))] (assoc ::db/conn conn))]

16
backend/test/backend_tests/rpc_file_test.clj
View file

@ -215,10 +215,10 @@
(t/is (= 1 (count rows)))) (t/is (= 1 (count rows))))
;; The underlying storage objects are still available. ;; The underlying storage objects are still available.
(t/is (some? @(sto/get-object storage (:media-id fmo2)))) (t/is (some? (sto/get-object storage (:media-id fmo2))))
(t/is (some? @(sto/get-object storage (:thumbnail-id fmo2)))) (t/is (some? (sto/get-object storage (:thumbnail-id fmo2))))
(t/is (some? @(sto/get-object storage (:media-id fmo1)))) (t/is (some? (sto/get-object storage (:media-id fmo1))))
(t/is (some? @(sto/get-object storage (:thumbnail-id fmo1)))) (t/is (some? (sto/get-object storage (:thumbnail-id fmo1))))
;; proceed to remove usage of the file ;; proceed to remove usage of the file
(update-file {:file-id (:id file) (update-file {:file-id (:id file)
@ -246,10 +246,10 @@
;; Finally, check that some of the objects that are marked as ;; Finally, check that some of the objects that are marked as
;; deleted we are unable to retrieve them using standard storage ;; deleted we are unable to retrieve them using standard storage
;; public api. ;; public api.
(t/is (nil? @(sto/get-object storage (:media-id fmo2)))) (t/is (nil? (sto/get-object storage (:media-id fmo2))))
(t/is (nil? @(sto/get-object storage (:thumbnail-id fmo2)))) (t/is (nil? (sto/get-object storage (:thumbnail-id fmo2))))
(t/is (nil? @(sto/get-object storage (:media-id fmo1)))) (t/is (nil? (sto/get-object storage (:media-id fmo1))))
(t/is (nil? @(sto/get-object storage (:thumbnail-id fmo1)))) (t/is (nil? (sto/get-object storage (:thumbnail-id fmo1))))
))) )))
(t/deftest permissions-checks-creating-file (t/deftest permissions-checks-creating-file

26
backend/test/backend_tests/rpc_management_test.clj
View file

@ -26,9 +26,9 @@
(let [storage (-> (:app.storage/storage th/*system*) (let [storage (-> (:app.storage/storage th/*system*)
(configure-storage-backend)) (configure-storage-backend))
sobject @(sto/put-object! storage {::sto/content (sto/content "content") sobject (sto/put-object! storage {::sto/content (sto/content "content")
:content-type "text/plain" :content-type "text/plain"
:other "data"}) :other "data"})
profile (th/create-profile* 1 {:is-active true}) profile (th/create-profile* 1 {:is-active true})
project (th/create-project* 1 {:team-id (:default-team-id profile) project (th/create-project* 1 {:team-id (:default-team-id profile)
:profile-id (:id profile)}) :profile-id (:id profile)})
@ -98,9 +98,9 @@
(t/deftest duplicate-file-with-deleted-relations (t/deftest duplicate-file-with-deleted-relations
(let [storage (-> (:app.storage/storage th/*system*) (let [storage (-> (:app.storage/storage th/*system*)
(configure-storage-backend)) (configure-storage-backend))
sobject @(sto/put-object! storage {::sto/content (sto/content "content") sobject (sto/put-object! storage {::sto/content (sto/content "content")
:content-type "text/plain" :content-type "text/plain"
:other "data"}) :other "data"})
profile (th/create-profile* 1 {:is-active true}) profile (th/create-profile* 1 {:is-active true})
project (th/create-project* 1 {:team-id (:default-team-id profile) project (th/create-project* 1 {:team-id (:default-team-id profile)
@ -120,7 +120,7 @@
:media-id (:id sobject)})] :media-id (:id sobject)})]
(th/mark-file-deleted* {:id (:id file2)}) (th/mark-file-deleted* {:id (:id file2)})
@(sto/del-object! storage sobject) (sto/del-object! storage sobject)
(let [data {::th/type :duplicate-file (let [data {::th/type :duplicate-file
::rpc/profile-id (:id profile) ::rpc/profile-id (:id profile)
@ -157,9 +157,9 @@
(let [storage (-> (:app.storage/storage th/*system*) (let [storage (-> (:app.storage/storage th/*system*)
(configure-storage-backend)) (configure-storage-backend))
sobject @(sto/put-object! storage {::sto/content (sto/content "content") sobject (sto/put-object! storage {::sto/content (sto/content "content")
:content-type "text/plain" :content-type "text/plain"
:other "data"}) :other "data"})
profile (th/create-profile* 1 {:is-active true}) profile (th/create-profile* 1 {:is-active true})
project (th/create-project* 1 {:team-id (:default-team-id profile) project (th/create-project* 1 {:team-id (:default-team-id profile)
@ -230,9 +230,9 @@
(t/deftest duplicate-project-with-deleted-files (t/deftest duplicate-project-with-deleted-files
(let [storage (-> (:app.storage/storage th/*system*) (let [storage (-> (:app.storage/storage th/*system*)
(configure-storage-backend)) (configure-storage-backend))
sobject @(sto/put-object! storage {::sto/content (sto/content "content") sobject (sto/put-object! storage {::sto/content (sto/content "content")
:content-type "text/plain" :content-type "text/plain"
:other "data"}) :other "data"})
profile (th/create-profile* 1 {:is-active true}) profile (th/create-profile* 1 {:is-active true})
project (th/create-project* 1 {:team-id (:default-team-id profile) project (th/create-project* 1 {:team-id (:default-team-id profile)
:profile-id (:id profile)}) :profile-id (:id profile)})

16
backend/test/backend_tests/rpc_media_test.clj
View file

@ -42,8 +42,8 @@
(t/is (uuid? media-id)) (t/is (uuid? media-id))
(t/is (uuid? thumbnail-id)) (t/is (uuid? thumbnail-id))
(let [storage (:app.storage/storage th/*system*) (let [storage (:app.storage/storage th/*system*)
mobj1 @(sto/get-object storage media-id) mobj1 (sto/get-object storage media-id)
mobj2 @(sto/get-object storage thumbnail-id)] mobj2 (sto/get-object storage thumbnail-id)]
(t/is (sto/object? mobj1)) (t/is (sto/object? mobj1))
(t/is (sto/object? mobj2)) (t/is (sto/object? mobj2))
(t/is (= 122785 (:size mobj1))) (t/is (= 122785 (:size mobj1)))
@ -83,8 +83,8 @@
(t/is (uuid? media-id)) (t/is (uuid? media-id))
(t/is (uuid? thumbnail-id)) (t/is (uuid? thumbnail-id))
(let [storage (:app.storage/storage th/*system*) (let [storage (:app.storage/storage th/*system*)
mobj1 @(sto/get-object storage media-id) mobj1 (sto/get-object storage media-id)
mobj2 @(sto/get-object storage thumbnail-id)] mobj2 (sto/get-object storage thumbnail-id)]
(t/is (sto/object? mobj1)) (t/is (sto/object? mobj1))
(t/is (sto/object? mobj2)) (t/is (sto/object? mobj2))
(t/is (= 312043 (:size mobj1))) (t/is (= 312043 (:size mobj1)))
@ -162,8 +162,8 @@
(t/is (uuid? media-id)) (t/is (uuid? media-id))
(t/is (uuid? thumbnail-id)) (t/is (uuid? thumbnail-id))
(let [storage (:app.storage/storage th/*system*) (let [storage (:app.storage/storage th/*system*)
mobj1 @(sto/get-object storage media-id) mobj1 (sto/get-object storage media-id)
mobj2 @(sto/get-object storage thumbnail-id)] mobj2 (sto/get-object storage thumbnail-id)]
(t/is (sto/object? mobj1)) (t/is (sto/object? mobj1))
(t/is (sto/object? mobj2)) (t/is (sto/object? mobj2))
(t/is (= 122785 (:size mobj1))) (t/is (= 122785 (:size mobj1)))
@ -203,8 +203,8 @@
(t/is (uuid? media-id)) (t/is (uuid? media-id))
(t/is (uuid? thumbnail-id)) (t/is (uuid? thumbnail-id))
(let [storage (:app.storage/storage th/*system*) (let [storage (:app.storage/storage th/*system*)
mobj1 @(sto/get-object storage media-id) mobj1 (sto/get-object storage media-id)
mobj2 @(sto/get-object storage thumbnail-id)] mobj2 (sto/get-object storage thumbnail-id)]
(t/is (sto/object? mobj1)) (t/is (sto/object? mobj1))
(t/is (sto/object? mobj2)) (t/is (sto/object? mobj2))
(t/is (= 312043 (:size mobj1))) (t/is (= 312043 (:size mobj1)))

62
backend/test/backend_tests/storage_test.clj
View file

@ -37,61 +37,61 @@
(let [storage (-> (:app.storage/storage th/*system*) (let [storage (-> (:app.storage/storage th/*system*)
(configure-storage-backend)) (configure-storage-backend))
content (sto/content "content") content (sto/content "content")
object @(sto/put-object! storage {::sto/content content object (sto/put-object! storage {::sto/content content
:content-type "text/plain" :content-type "text/plain"
:other "data"})] :other "data"})]
(t/is (sto/object? object)) (t/is (sto/object? object))
(t/is (fs/path? @(sto/get-object-path storage object))) (t/is (fs/path? (sto/get-object-path storage object)))
(t/is (nil? (:expired-at object))) (t/is (nil? (:expired-at object)))
(t/is (= :assets-fs (:backend object))) (t/is (= :assets-fs (:backend object)))
(t/is (= "data" (:other (meta object)))) (t/is (= "data" (:other (meta object))))
(t/is (= "text/plain" (:content-type (meta object)))) (t/is (= "text/plain" (:content-type (meta object))))
(t/is (= "content" (slurp @(sto/get-object-data storage object)))) (t/is (= "content" (slurp (sto/get-object-data storage object))))
(t/is (= "content" (slurp @(sto/get-object-path storage object)))) (t/is (= "content" (slurp (sto/get-object-path storage object))))
)) ))
(t/deftest put-and-retrieve-expired-object (t/deftest put-and-retrieve-expired-object
(let [storage (-> (:app.storage/storage th/*system*) (let [storage (-> (:app.storage/storage th/*system*)
(configure-storage-backend)) (configure-storage-backend))
content (sto/content "content") content (sto/content "content")
object @(sto/put-object! storage {::sto/content content object (sto/put-object! storage {::sto/content content
::sto/expired-at (dt/in-future {:seconds 1}) ::sto/expired-at (dt/in-future {:seconds 1})
:content-type "text/plain" :content-type "text/plain"
})] })]
(t/is (sto/object? object)) (t/is (sto/object? object))
(t/is (dt/instant? (:expired-at object))) (t/is (dt/instant? (:expired-at object)))
(t/is (dt/is-after? (:expired-at object) (dt/now))) (t/is (dt/is-after? (:expired-at object) (dt/now)))
(t/is (= object @(sto/get-object storage (:id object)))) (t/is (= object (sto/get-object storage (:id object))))
(th/sleep 1000) (th/sleep 1000)
(t/is (nil? @(sto/get-object storage (:id object)))) (t/is (nil? (sto/get-object storage (:id object))))
(t/is (nil? @(sto/get-object-data storage object))) (t/is (nil? (sto/get-object-data storage object)))
(t/is (nil? @(sto/get-object-url storage object))) (t/is (nil? (sto/get-object-url storage object)))
(t/is (nil? @(sto/get-object-path storage object))) (t/is (nil? (sto/get-object-path storage object)))
)) ))
(t/deftest put-and-delete-object (t/deftest put-and-delete-object
(let [storage (-> (:app.storage/storage th/*system*) (let [storage (-> (:app.storage/storage th/*system*)
(configure-storage-backend)) (configure-storage-backend))
content (sto/content "content") content (sto/content "content")
object @(sto/put-object! storage {::sto/content content object (sto/put-object! storage {::sto/content content
:content-type "text/plain" :content-type "text/plain"
:expired-at (dt/in-future {:seconds 1})})] :expired-at (dt/in-future {:seconds 1})})]
(t/is (sto/object? object)) (t/is (sto/object? object))
(t/is (true? @(sto/del-object! storage object))) (t/is (true? (sto/del-object! storage object)))
;; retrieving the same object should be not nil because the ;; retrieving the same object should be not nil because the
;; deletion is not immediate ;; deletion is not immediate
(t/is (some? @(sto/get-object-data storage object))) (t/is (some? (sto/get-object-data storage object)))
(t/is (some? @(sto/get-object-url storage object))) (t/is (some? (sto/get-object-url storage object)))
(t/is (some? @(sto/get-object-path storage object))) (t/is (some? (sto/get-object-path storage object)))
;; But you can't retrieve the object again because in database is ;; But you can't retrieve the object again because in database is
;; marked as deleted/expired. ;; marked as deleted/expired.
(t/is (nil? @(sto/get-object storage (:id object)))) (t/is (nil? (sto/get-object storage (:id object))))
)) ))
(t/deftest test-deleted-gc-task (t/deftest test-deleted-gc-task
@ -99,14 +99,14 @@
(configure-storage-backend)) (configure-storage-backend))
content1 (sto/content "content1") content1 (sto/content "content1")
content2 (sto/content "content2") content2 (sto/content "content2")
object1 @(sto/put-object! storage {::sto/content content1 object1 (sto/put-object! storage {::sto/content content1
::sto/expired-at (dt/now) ::sto/expired-at (dt/now)
:content-type "text/plain" :content-type "text/plain"
}) })
object2 @(sto/put-object! storage {::sto/content content2 object2 (sto/put-object! storage {::sto/content content2
::sto/expired-at (dt/in-past {:hours 2}) ::sto/expired-at (dt/in-past {:hours 2})
:content-type "text/plain" :content-type "text/plain"
})] })]
(th/sleep 200) (th/sleep 200)