mirror of
https://github.com/penpot/penpot.git
synced 2025-05-30 05:36:12 +02:00
♻️ Refactor backend to be more async friendly
This commit is contained in:
Andrey Antukh
Alonso Torres
parent
087d896569
commit
9e4a50fb15
49 changed files with 1503 additions and 1378 deletions
|
|
@ -19,9 +19,12 @@
|
|||
[app.storage.impl :as impl]
|
||||
[app.storage.s3 :as ss3]
|
||||
[app.util.time :as dt]
|
||||
[app.worker :as wrk]
|
||||
[clojure.spec.alpha :as s]
|
||||
[datoteka.core :as fs]
|
||||
[integrant.core :as ig]))
|
||||
[integrant.core :as ig]
|
||||
[promesa.core :as p]
|
||||
[promesa.exec :as px]))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Storage Module State
|
||||
|
|
@ -39,7 +42,7 @@
|
|||
:db ::sdb/backend))))
|
||||
|
||||
(defmethod ig/pre-init-spec ::storage [_]
|
||||
(s/keys :req-un [::db/pool ::backends]))
|
||||
(s/keys :req-un [::db/pool ::wrk/executor ::backends]))
|
||||
|
||||
(defmethod ig/prep-key ::storage
|
||||
[_ {:keys [backends] :as cfg}]
|
||||
|
|
@ -67,48 +70,58 @@
|
|||
(s/def ::storage-object storage-object?)
|
||||
(s/def ::storage-content impl/content?)
|
||||
|
||||
(defn get-metadata
|
||||
[params]
|
||||
(into {}
|
||||
(remove (fn [[k _]] (qualified-keyword? k)))
|
||||
params))
|
||||
|
||||
(defn- clone-database-object
|
||||
;; If we in this condition branch, this means we come from the
|
||||
;; clone-object, so we just need to clone it with a new backend.
|
||||
[{:keys [conn backend]} object]
|
||||
(let [id (uuid/random)
|
||||
mdata (meta object)
|
||||
result (db/insert! conn :storage-object
|
||||
{:id id
|
||||
:size (:size object)
|
||||
:backend (name backend)
|
||||
:metadata (db/tjson mdata)
|
||||
:deleted-at (:expired-at object)
|
||||
:touched-at (:touched-at object)})]
|
||||
(assoc object
|
||||
:id (:id result)
|
||||
:backend backend
|
||||
:created-at (:created-at result)
|
||||
:touched-at (:touched-at result))))
|
||||
(defn- get-database-object-by-hash
|
||||
[conn backend bucket hash]
|
||||
(let [sql (str "select * from storage_object "
|
||||
" where (metadata->>'~:hash') = ? "
|
||||
" and (metadata->>'~:bucket') = ? "
|
||||
" and backend = ?"
|
||||
" and deleted_at is null"
|
||||
" limit 1")]
|
||||
(db/exec-one! conn [sql hash bucket (name backend)])))
|
||||
|
||||
(defn- create-database-object
|
||||
[{:keys [conn backend]} {:keys [content] :as object}]
|
||||
[{:keys [conn backend executor]} {:keys [::content ::expired-at ::touched-at] :as params}]
|
||||
(us/assert ::storage-content content)
|
||||
(let [id (uuid/random)
|
||||
mdata (dissoc object :content :expired-at :touched-at)
|
||||
(px/with-dispatch executor
|
||||
(let [id (uuid/random)
|
||||
|
||||
result (db/insert! conn :storage-object
|
||||
{:id id
|
||||
:size (count content)
|
||||
:backend (name backend)
|
||||
:metadata (db/tjson mdata)
|
||||
:deleted-at (:expired-at object)
|
||||
:touched-at (:touched-at object)})]
|
||||
mdata (cond-> (get-metadata params)
|
||||
(satisfies? impl/IContentHash content)
|
||||
(assoc :hash (impl/get-hash content)))
|
||||
|
||||
(StorageObject. (:id result)
|
||||
(:size result)
|
||||
(:created-at result)
|
||||
(:deleted-at result)
|
||||
(:touched-at result)
|
||||
backend
|
||||
mdata
|
||||
nil)))
|
||||
;; NOTE: for now we don't reuse the deleted objects, but in
|
||||
;; futute we can consider reusing deleted objects if we
|
||||
;; 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 conn backend (:bucket mdata) (:hash mdata)))
|
||||
|
||||
result (or result
|
||||
(db/insert! conn :storage-object
|
||||
{:id id
|
||||
:size (count content)
|
||||
:backend (name backend)
|
||||
:metadata (db/tjson mdata)
|
||||
:deleted-at expired-at
|
||||
:touched-at touched-at}))]
|
||||
|
||||
(StorageObject. (:id result)
|
||||
(:size result)
|
||||
(:created-at result)
|
||||
(:deleted-at result)
|
||||
(:touched-at result)
|
||||
backend
|
||||
mdata
|
||||
nil))))
|
||||
|
||||
(def ^:private sql:retrieve-storage-object
|
||||
"select * from storage_object where id = ? and (deleted_at is null or deleted_at > now())")
|
||||
|
|
@ -129,14 +142,6 @@
|
|||
(when-let [res (db/exec-one! conn [sql:retrieve-storage-object id])]
|
||||
(row->storage-object res)))
|
||||
|
||||
(def sql:delete-storage-object
|
||||
"update storage_object set deleted_at=now() where id=?")
|
||||
|
||||
(defn- delete-database-object
|
||||
[{:keys [conn] :as storage} id]
|
||||
(let [result (db/exec-one! conn [sql:delete-storage-object id])]
|
||||
(pos? (:next.jdbc/update-count result))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; API
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -149,24 +154,24 @@
|
|||
[url]
|
||||
(fs/path (java.net.URI. (str url))))
|
||||
|
||||
(defn content
|
||||
([data] (impl/content data nil))
|
||||
([data size] (impl/content data size)))
|
||||
(dm/export impl/content)
|
||||
(dm/export impl/wrap-with-hash)
|
||||
|
||||
(defn get-object
|
||||
[{:keys [conn pool] :as storage} id]
|
||||
(us/assert ::storage storage)
|
||||
(-> (assoc storage :conn (or conn pool))
|
||||
(retrieve-database-object id)))
|
||||
(p/do
|
||||
(-> (assoc storage :conn (or conn pool))
|
||||
(retrieve-database-object id))))
|
||||
|
||||
(defn put-object
|
||||
(defn put-object!
|
||||
"Creates a new object with the provided content."
|
||||
[{:keys [pool conn backend] :as storage} {:keys [content] :as params}]
|
||||
[{:keys [pool conn backend] :as storage} {:keys [::content] :as params}]
|
||||
(us/assert ::storage storage)
|
||||
(us/assert ::storage-content content)
|
||||
(us/assert ::us/keyword backend)
|
||||
(let [storage (assoc storage :conn (or conn pool))
|
||||
object (create-database-object storage params)]
|
||||
(p/let [storage (assoc storage :conn (or conn pool))
|
||||
object (create-database-object storage params)]
|
||||
|
||||
;; Store the data finally on the underlying storage subsystem.
|
||||
(-> (impl/resolve-backend storage backend)
|
||||
|
|
@ -174,82 +179,78 @@
|
|||
|
||||
object))
|
||||
|
||||
(defn clone-object
|
||||
"Creates a clone of the provided object using backend based efficient
|
||||
method. Always clones objects to the configured default."
|
||||
[{:keys [pool conn backend] :as storage} object]
|
||||
(us/assert ::storage storage)
|
||||
(us/assert ::storage-object object)
|
||||
(us/assert ::us/keyword backend)
|
||||
(let [storage (assoc storage :conn (or conn pool))
|
||||
object* (clone-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.
|
||||
(-> (impl/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 [is (-> (impl/resolve-backend storage (:backend object))
|
||||
(impl/get-object-data object))]
|
||||
(-> (impl/resolve-backend storage (:backend storage))
|
||||
(impl/put-object object* (impl/content is (:size object))))))
|
||||
object*))
|
||||
(defn touch-object!
|
||||
"Mark object as touched."
|
||||
[{:keys [pool conn] :as storage} object-or-id]
|
||||
(p/do
|
||||
(let [id (if (storage-object? object-or-id) (:id object-or-id) object-or-id)
|
||||
res (db/update! (or conn pool) :storage-object
|
||||
{:touched-at (dt/now)}
|
||||
{:id id}
|
||||
{:return-keys false})]
|
||||
(pos? (:next.jdbc/update-count res)))))
|
||||
|
||||
(defn get-object-data
|
||||
"Return an input stream instance of the object content."
|
||||
[{:keys [pool conn] :as storage} object]
|
||||
(us/assert ::storage storage)
|
||||
(when (or (nil? (:expired-at object))
|
||||
(dt/is-after? (:expired-at object) (dt/now)))
|
||||
(-> (assoc storage :conn (or conn pool))
|
||||
(impl/resolve-backend (:backend object))
|
||||
(impl/get-object-data object))))
|
||||
(p/do
|
||||
(when (or (nil? (:expired-at object))
|
||||
(dt/is-after? (:expired-at object) (dt/now)))
|
||||
(-> (assoc storage :conn (or conn pool))
|
||||
(impl/resolve-backend (:backend object))
|
||||
(impl/get-object-data object)))))
|
||||
|
||||
(defn get-object-bytes
|
||||
"Returns a byte array of object content."
|
||||
[{:keys [pool conn] :as storage} object]
|
||||
(us/assert ::storage storage)
|
||||
(when (or (nil? (:expired-at object))
|
||||
(dt/is-after? (:expired-at object) (dt/now)))
|
||||
(-> (assoc storage :conn (or conn pool))
|
||||
(impl/resolve-backend (:backend object))
|
||||
(impl/get-object-bytes object))))
|
||||
(p/do
|
||||
(when (or (nil? (:expired-at object))
|
||||
(dt/is-after? (:expired-at object) (dt/now)))
|
||||
(-> (assoc storage :conn (or conn pool))
|
||||
(impl/resolve-backend (:backend object))
|
||||
(impl/get-object-bytes object)))))
|
||||
|
||||
(defn get-object-url
|
||||
([storage object]
|
||||
(get-object-url storage object nil))
|
||||
([{:keys [conn pool] :as storage} object options]
|
||||
(us/assert ::storage storage)
|
||||
(when (or (nil? (:expired-at object))
|
||||
(dt/is-after? (:expired-at object) (dt/now)))
|
||||
(-> (assoc storage :conn (or conn pool))
|
||||
(impl/resolve-backend (:backend object))
|
||||
(impl/get-object-url object options)))))
|
||||
(p/do
|
||||
(when (or (nil? (:expired-at object))
|
||||
(dt/is-after? (:expired-at object) (dt/now)))
|
||||
(-> (assoc storage :conn (or conn pool))
|
||||
(impl/resolve-backend (:backend object))
|
||||
(impl/get-object-url object options))))))
|
||||
|
||||
(defn get-object-path
|
||||
"Get the Path to the object. Only works with `:fs` type of
|
||||
storages."
|
||||
[storage object]
|
||||
(let [backend (impl/resolve-backend storage (:backend object))]
|
||||
(when (not= :fs (:type backend))
|
||||
(ex/raise :type :internal
|
||||
:code :operation-not-allowed
|
||||
:hint "get-object-path only works with fs type backends"))
|
||||
(when (or (nil? (:expired-at object))
|
||||
(dt/is-after? (:expired-at object) (dt/now)))
|
||||
(-> (impl/get-object-url backend object nil)
|
||||
(file-url->path)))))
|
||||
(p/do
|
||||
(let [backend (impl/resolve-backend storage (:backend object))]
|
||||
(when (not= :fs (:type backend))
|
||||
(ex/raise :type :internal
|
||||
:code :operation-not-allowed
|
||||
:hint "get-object-path only works with fs type backends"))
|
||||
(when (or (nil? (:expired-at object))
|
||||
(dt/is-after? (:expired-at object) (dt/now)))
|
||||
(p/-> (impl/get-object-url backend object nil) file-url->path)))))
|
||||
|
||||
(defn del-object
|
||||
[{:keys [conn pool] :as storage} id-or-obj]
|
||||
(defn del-object!
|
||||
[{:keys [conn pool] :as storage} object-or-id]
|
||||
(us/assert ::storage storage)
|
||||
(-> (assoc storage :conn (or conn pool))
|
||||
(delete-database-object (if (uuid? id-or-obj) id-or-obj (:id id-or-obj)))))
|
||||
(p/do
|
||||
(let [id (if (storage-object? object-or-id) (:id object-or-id) object-or-id)
|
||||
res (db/update! (or conn pool) :storage-object
|
||||
{:deleted-at (dt/now)}
|
||||
{:id id}
|
||||
{:return-keys false})]
|
||||
(pos? (:next.jdbc/update-count res)))))
|
||||
|
||||
(dm/export impl/resolve-backend)
|
||||
(dm/export impl/calculate-hash)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Garbage Collection: Permanently delete objects
|
||||
|
|
@ -263,7 +264,7 @@
|
|||
(s/def ::min-age ::dt/duration)
|
||||
|
||||
(defmethod ig/pre-init-spec ::gc-deleted-task [_]
|
||||
(s/keys :req-un [::storage ::db/pool ::min-age]))
|
||||
(s/keys :req-un [::storage ::db/pool ::min-age ::wrk/executor]))
|
||||
|
||||
(defmethod ig/init-key ::gc-deleted-task
|
||||
[_ {:keys [pool storage min-age] :as cfg}]
|
||||
|
|
@ -284,7 +285,7 @@
|
|||
(delete-in-bulk [conn backend ids]
|
||||
(let [backend (impl/resolve-backend storage backend)
|
||||
backend (assoc backend :conn conn)]
|
||||
(impl/del-objects-in-bulk backend ids)))]
|
||||
@(impl/del-objects-in-bulk backend ids)))]
|
||||
|
||||
(fn [_]
|
||||
(db/with-atomic [conn pool]
|
||||
|
|
@ -317,18 +318,23 @@
|
|||
;; Garbage Collection: Analyze touched objects
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;; This task is part of the garbage collection of storage objects and is responsible on analyzing the touched
|
||||
;; objects and mark them for deletion if corresponds.
|
||||
;; This task is part of the garbage collection of storage objects and
|
||||
;; is responsible on analyzing the touched objects and mark them for
|
||||
;; deletion if corresponds.
|
||||
;;
|
||||
;; For example: when file_media_object is deleted, the depending storage_object are marked as touched. This
|
||||
;; means that some files that depend on a concrete storage_object are no longer exists and maybe this
|
||||
;; storage_object is no longer necessary and can be eligible for elimination. This task periodically analyzes
|
||||
;; touched objects and mark them as freeze (means that has other references and the object is still valid) or
|
||||
;; deleted (no more references to this object so is ready to be deleted).
|
||||
;; For example: when file_media_object is deleted, the depending
|
||||
;; storage_object are marked as touched. This means that some files
|
||||
;; that depend on a concrete storage_object are no longer exists and
|
||||
;; maybe this storage_object is no longer necessary and can be
|
||||
;; eligible for elimination. This task periodically analyzes touched
|
||||
;; objects and mark them as freeze (means that has other references
|
||||
;; and the object is still valid) or deleted (no more references to
|
||||
;; this object so is ready to be deleted).
|
||||
|
||||
(declare sql:retrieve-touched-objects-chunk)
|
||||
(declare sql:retrieve-file-media-object-nrefs)
|
||||
(declare sql:retrieve-team-font-variant-nrefs)
|
||||
(declare sql:retrieve-profile-nrefs)
|
||||
|
||||
(defmethod ig/pre-init-spec ::gc-touched-task [_]
|
||||
(s/keys :req-un [::db/pool]))
|
||||
|
|
@ -341,6 +347,9 @@
|
|||
(has-file-media-object-nrefs? [conn id]
|
||||
(-> (db/exec-one! conn [sql:retrieve-file-media-object-nrefs id id]) :nrefs pos?))
|
||||
|
||||
(has-profile-nrefs? [conn id]
|
||||
(-> (db/exec-one! conn [sql:retrieve-profile-nrefs id id]) :nrefs pos?))
|
||||
|
||||
(mark-freeze-in-bulk [conn ids]
|
||||
(db/exec-one! conn ["update storage_object set touched_at=null where id = ANY(?)"
|
||||
(db/create-array conn "uuid" ids)]))
|
||||
|
|
@ -349,17 +358,30 @@
|
|||
(db/exec-one! conn ["update storage_object set deleted_at=now(), touched_at=null where id = ANY(?)"
|
||||
(db/create-array conn "uuid" ids)]))
|
||||
|
||||
;; NOTE: A getter that retrieves the key witch will be used
|
||||
;; for group ids; previoulsy we have no value, then we
|
||||
;; introduced the `:reference` prop, and then it is renamed
|
||||
;; to `:bucket` and now is string instead. This is
|
||||
;; implemented in this way for backward comaptibilty.
|
||||
|
||||
;; NOTE: we use the "file-media-object" as default value for
|
||||
;; backward compatibility because when we deploy it we can
|
||||
;; have old backend instances running in the same time as
|
||||
;; the new one and we can still have storage-objects created
|
||||
;; without bucket value. And we know that if it does not
|
||||
;; have value, it means :file-media-object.
|
||||
|
||||
(get-bucket [{:keys [metadata]}]
|
||||
(or (some-> metadata :bucket)
|
||||
(some-> metadata :reference d/name)
|
||||
"file-media-object"))
|
||||
|
||||
(retrieve-touched-chunk [conn cursor]
|
||||
(let [rows (->> (db/exec! conn [sql:retrieve-touched-objects-chunk cursor])
|
||||
(mapv #(d/update-when % :metadata db/decode-transit-pgobject)))
|
||||
kw (fn [o] (if (keyword? o) o (keyword o)))]
|
||||
(mapv #(d/update-when % :metadata db/decode-transit-pgobject)))]
|
||||
(when (seq rows)
|
||||
[(-> rows peek :created-at)
|
||||
;; NOTE: we use the :file-media-object as default value for backward compatibility because when we
|
||||
;; deploy it we can have old backend instances running in the same time as the new one and we can
|
||||
;; still have storage-objects created without reference value. And we know that if it does not
|
||||
;; have value, it means :file-media-object.
|
||||
(d/group-by' #(or (some-> % :metadata :reference kw) :file-media-object) :id rows)])))
|
||||
(d/group-by' get-bucket :id rows)])))
|
||||
|
||||
(retrieve-touched [conn]
|
||||
(->> (d/iteration (fn [cursor]
|
||||
|
|
@ -389,13 +411,14 @@
|
|||
(loop [to-freeze 0
|
||||
to-delete 0
|
||||
groups (retrieve-touched conn)]
|
||||
(if-let [[reference ids] (first groups)]
|
||||
(let [[f d] (case reference
|
||||
:file-media-object (process-objects! conn has-file-media-object-nrefs? ids)
|
||||
:team-font-variant (process-objects! conn has-team-font-variant-nrefs? ids)
|
||||
(if-let [[bucket ids] (first groups)]
|
||||
(let [[f d] (case bucket
|
||||
"file-media-object" (process-objects! conn has-file-media-object-nrefs? ids)
|
||||
"team-font-variant" (process-objects! conn has-team-font-variant-nrefs? ids)
|
||||
"profile" (process-objects! conn has-profile-nrefs? ids)
|
||||
(ex/raise :type :internal
|
||||
:code :unexpected-unknown-reference
|
||||
:hint (format "unknown reference %s" (pr-str reference))))]
|
||||
:hint (dm/fmt "unknown reference %" bucket)))]
|
||||
(recur (+ to-freeze f)
|
||||
(+ to-delete d)
|
||||
(rest groups)))
|
||||
|
|
@ -419,3 +442,7 @@
|
|||
(select count(*) from team_font_variant where woff2_file_id = ?) +
|
||||
(select count(*) from team_font_variant where otf_file_id = ?) +
|
||||
(select count(*) from team_font_variant where ttf_file_id = ?)) as nrefs")
|
||||
|
||||
(def sql:retrieve-profile-nrefs
|
||||
"select ((select count(*) from profile where photo_id = ?) +
|
||||
(select count(*) from team where photo_id = ?)) as nrefs")
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue