mirror of
https://github.com/penpot/penpot.git
synced 2025-03-19 19:21:23 -05:00
✨ Improve snapshot related internal API
This commit also adds the ability to take snapshot of all files of the team in a single run/transaction.
This commit is contained in:
Andrey Antukh
Andrés Moya
parent
aaf457a792
commit
6d35cb2eb4
7 changed files with 433 additions and 286 deletions
backend/src/app
features
http
rpc/commands
srepl
|
|
@ -1497,7 +1497,7 @@
|
|||
(-> (db/get system :team {:id team-id}
|
||||
{::db/remove-deleted false
|
||||
::db/check-deleted false})
|
||||
(decode-row)))
|
||||
(update :features db/decode-pgarray #{})))
|
||||
|
||||
(defn- validate-file!
|
||||
[file libs]
|
||||
|
|
@ -1546,19 +1546,21 @@
|
|||
AND f.deleted_at IS NULL
|
||||
FOR UPDATE")
|
||||
|
||||
(defn get-and-lock-files
|
||||
(defn get-and-lock-team-files
|
||||
[conn team-id]
|
||||
(->> (db/cursor conn [sql:get-and-lock-team-files team-id])
|
||||
(map :id)))
|
||||
|
||||
(defn update-team!
|
||||
[conn team]
|
||||
(let [params (-> team
|
||||
[system {:keys [id] :as team}]
|
||||
(let [conn (db/get-connection system)
|
||||
params (-> team
|
||||
(update :features db/encode-pgarray conn "text")
|
||||
(dissoc :id))]
|
||||
(db/update! conn :team
|
||||
params
|
||||
{:id (:id team)})))
|
||||
{:id id})
|
||||
team))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; PUBLIC API
|
||||
|
|
@ -1657,7 +1659,7 @@
|
|||
:id id})
|
||||
|
||||
(run! (partial migrate-file system)
|
||||
(get-and-lock-files conn id))
|
||||
(get-and-lock-team-files conn id))
|
||||
|
||||
(->> (assoc team :features features)
|
||||
(update-team! conn))))))]
|
||||
|
|
|
|||
|
|
@ -414,12 +414,12 @@
|
|||
:hint "provided invalid version"))
|
||||
|
||||
(binding [srepl/*system* cfg]
|
||||
(srepl/update-file! :id file-id
|
||||
:update-fn (fn [file]
|
||||
(update file :data assoc :version version))
|
||||
:migrate? false
|
||||
:inc-revn? false
|
||||
:save? true))
|
||||
(srepl/process-file! :id file-id
|
||||
:update-fn (fn [file]
|
||||
(update file :data assoc :version version))
|
||||
:migrate? false
|
||||
:inc-revn? false
|
||||
:save? true))
|
||||
{::rres/status 200
|
||||
::rres/headers {"content-type" "text/plain"}
|
||||
::rres/body "OK"}))
|
||||
|
|
|
|||
|
|
@ -285,8 +285,9 @@
|
|||
file)))
|
||||
|
||||
(defn get-minimal-file
|
||||
[{:keys [::db/pool] :as cfg} id]
|
||||
(db/get pool :file {:id id} {:columns [:id :modified-at :revn]}))
|
||||
[cfg id & {:as opts}]
|
||||
(let [opts (assoc opts ::sql/columns [:id :modified-at :revn])]
|
||||
(db/get cfg :file {:id id} opts)))
|
||||
|
||||
(defn get-file-etag
|
||||
[{:keys [::rpc/profile-id]} {:keys [modified-at revn]}]
|
||||
|
|
|
|||
|
|
@ -12,14 +12,17 @@
|
|||
[app.common.uuid :as uuid]
|
||||
[app.config :as cf]
|
||||
[app.db :as db]
|
||||
[app.db.sql :as-alias sql]
|
||||
[app.main :as-alias main]
|
||||
[app.media :as media]
|
||||
[app.rpc :as-alias rpc]
|
||||
[app.rpc.commands.files :as files]
|
||||
[app.rpc.commands.profile :as profile]
|
||||
[app.rpc.doc :as-alias doc]
|
||||
[app.storage :as sto]
|
||||
[app.util.services :as sv]
|
||||
[app.util.time :as dt]))
|
||||
[app.util.time :as dt]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
(defn check-authorized!
|
||||
[{:keys [::db/pool]} profile-id]
|
||||
|
|
@ -57,76 +60,119 @@
|
|||
::sm/params schema:get-file-snapshots}
|
||||
[cfg {:keys [::rpc/profile-id] :as params}]
|
||||
(check-authorized! cfg profile-id)
|
||||
(db/run! cfg #(get-file-snapshots % params)))
|
||||
(db/run! cfg get-file-snapshots params))
|
||||
|
||||
(defn restore-file-snapshot!
|
||||
[{:keys [::db/conn ::sto/storage] :as cfg} {:keys [file-id id]}]
|
||||
(let [storage (media/configure-assets-storage storage conn)
|
||||
params {:id id :file-id file-id}
|
||||
options {:columns [:id :data :revn :features]}
|
||||
snapshot (db/get* conn :file-change params options)]
|
||||
file (files/get-minimal-file conn file-id {::db/for-update true})
|
||||
snapshot (db/get* conn :file-change
|
||||
{:file-id file-id
|
||||
:id id}
|
||||
{::db/for-share true})]
|
||||
|
||||
(when (and (some? snapshot)
|
||||
(some? (:data snapshot)))
|
||||
(when-not snapshot
|
||||
(ex/raise :type :not-found
|
||||
:code :snapshot-not-found
|
||||
:hint "unable to find snapshot with the provided label"
|
||||
:id id
|
||||
:file-id file-id))
|
||||
|
||||
(l/dbg :hint "restoring snapshot"
|
||||
:file-id (str file-id)
|
||||
:snapshot-id (str (:id snapshot)))
|
||||
(when-not (:data snapshot)
|
||||
(ex/raise :type :precondition
|
||||
:code :snapshot-without-data
|
||||
:hint "snapshot has no data"
|
||||
:label (:label snapshot)
|
||||
:file-id file-id))
|
||||
|
||||
(db/update! conn :file
|
||||
{:data (:data snapshot)
|
||||
:revn (:revn snapshot)
|
||||
:features (:features snapshot)}
|
||||
{:id file-id})
|
||||
(l/dbg :hint "restoring snapshot"
|
||||
:file-id (str file-id)
|
||||
:label (:label snapshot)
|
||||
:snapshot-id (str (:id snapshot)))
|
||||
|
||||
;; clean object thumbnails
|
||||
(let [sql (str "update file_tagged_object_thumbnail "
|
||||
" set deleted_at = now() "
|
||||
" where file_id=? returning media_id")
|
||||
res (db/exec! conn [sql file-id])]
|
||||
(db/update! conn :file
|
||||
{:data (:data snapshot)
|
||||
:revn (inc (:revn file))
|
||||
:features (:features snapshot)}
|
||||
{:id file-id})
|
||||
|
||||
(doseq [media-id (into #{} (keep :media-id) res)]
|
||||
(sto/touch-object! storage media-id)))
|
||||
;; clean object thumbnails
|
||||
(let [sql (str "update file_tagged_object_thumbnail "
|
||||
" set deleted_at = now() "
|
||||
" where file_id=? returning media_id")
|
||||
res (db/exec! conn [sql file-id])]
|
||||
|
||||
;; clean object thumbnails
|
||||
(let [sql (str "update file_thumbnail "
|
||||
" set deleted_at = now() "
|
||||
" where file_id=? returning media_id")
|
||||
res (db/exec! conn [sql file-id])]
|
||||
(doseq [media-id (into #{} (keep :media-id) res)]
|
||||
(sto/touch-object! storage media-id)))
|
||||
(doseq [media-id (into #{} (keep :media-id) res)]
|
||||
(sto/touch-object! storage media-id)))
|
||||
|
||||
{:id (:id snapshot)})))
|
||||
;; clean object thumbnails
|
||||
(let [sql (str "update file_thumbnail "
|
||||
" set deleted_at = now() "
|
||||
" where file_id=? returning media_id")
|
||||
res (db/exec! conn [sql file-id])]
|
||||
(doseq [media-id (into #{} (keep :media-id) res)]
|
||||
(sto/touch-object! storage media-id)))
|
||||
|
||||
(def ^:private schema:restore-file-snapshot
|
||||
[:map
|
||||
[:file-id ::sm/uuid]
|
||||
[:id ::sm/uuid]])
|
||||
{:id (:id snapshot)
|
||||
:label (:label snapshot)}))
|
||||
|
||||
(defn- resolve-snapshot-by-label
|
||||
[conn file-id label]
|
||||
(->> (db/query conn :file-change
|
||||
{:file-id file-id
|
||||
:label label}
|
||||
{::sql/order-by [[:created-at :desc]]
|
||||
::sql/columns [:file-id :id :label]})
|
||||
(first)))
|
||||
|
||||
(def ^:private
|
||||
schema:restore-file-snapshot
|
||||
[:and
|
||||
[:map
|
||||
[:file-id ::sm/uuid]
|
||||
[:id {:optional true} ::sm/uuid]
|
||||
[:label {:optional true} :string]]
|
||||
[::sm/contains-any #{:id :label}]])
|
||||
|
||||
(sv/defmethod ::restore-file-snapshot
|
||||
{::doc/added "1.20"
|
||||
::doc/skip true
|
||||
::sm/params schema:restore-file-snapshot}
|
||||
[cfg {:keys [::rpc/profile-id] :as params}]
|
||||
[cfg {:keys [::rpc/profile-id file-id id label] :as params}]
|
||||
(check-authorized! cfg profile-id)
|
||||
(db/tx-run! cfg #(restore-file-snapshot! % params)))
|
||||
(db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
|
||||
(let [params (cond-> params
|
||||
(and (not id) (string? label))
|
||||
(merge (resolve-snapshot-by-label conn file-id label)))]
|
||||
(restore-file-snapshot! cfg params)))))
|
||||
|
||||
(defn take-file-snapshot!
|
||||
[{:keys [::db/conn]} {:keys [file-id label]}]
|
||||
(when-let [file (db/get* conn :file {:id file-id})]
|
||||
(let [id (uuid/next)
|
||||
label (or label (str "Snapshot at " (dt/format-instant (dt/now) :rfc1123)))]
|
||||
(l/debug :hint "persisting file snapshot"
|
||||
:file-id (str file-id)
|
||||
:label label)
|
||||
(db/insert! conn :file-change
|
||||
{:id id
|
||||
:revn (:revn file)
|
||||
:data (:data file)
|
||||
:features (:features file)
|
||||
:file-id (:id file)
|
||||
:label label})
|
||||
{:id id})))
|
||||
(let [file (db/get conn :file {:id file-id})
|
||||
id (uuid/next)]
|
||||
|
||||
(l/debug :hint "creating file snapshot"
|
||||
:file-id (str file-id)
|
||||
:label label)
|
||||
|
||||
(db/insert! conn :file-change
|
||||
{:id id
|
||||
:revn (:revn file)
|
||||
:data (:data file)
|
||||
:features (:features file)
|
||||
:file-id (:id file)
|
||||
:label label}
|
||||
{::db/return-keys false})
|
||||
|
||||
{:id id :label label}))
|
||||
|
||||
(defn generate-snapshot-label
|
||||
[]
|
||||
(let [ts (-> (dt/now)
|
||||
(dt/format-instant)
|
||||
(str/replace #"[T:\.]" "-")
|
||||
(str/rtrim "Z"))]
|
||||
(str "snapshot-" ts)))
|
||||
|
||||
(def ^:private schema:take-file-snapshot
|
||||
[:map [:file-id ::sm/uuid]])
|
||||
|
|
@ -137,5 +183,8 @@
|
|||
::sm/params schema:take-file-snapshot}
|
||||
[cfg {:keys [::rpc/profile-id] :as params}]
|
||||
(check-authorized! cfg profile-id)
|
||||
(db/tx-run! cfg #(take-file-snapshot! % params)))
|
||||
(db/tx-run! cfg (fn [cfg]
|
||||
(let [params (update params :label (fn [label]
|
||||
(or label (generate-snapshot-label))))]
|
||||
(take-file-snapshot! cfg params)))))
|
||||
|
||||
|
|
|
|||
|
|
@ -12,7 +12,6 @@
|
|||
[app.db :as db]
|
||||
[app.features.components-v2 :as feat]
|
||||
[app.main :as main]
|
||||
[app.rpc.commands.files-snapshot :as rpc]
|
||||
[app.srepl.helpers :as h]
|
||||
[app.svgo :as svgo]
|
||||
[app.util.cache :as cache]
|
||||
|
|
@ -634,42 +633,3 @@
|
|||
:file-name (:name file))
|
||||
(assoc file :deleted-at (dt/now)))
|
||||
file))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; RESTORE SNAPSHOT
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(def ^:private sql:snapshots-with-file
|
||||
"SELECT f.id AS file_id,
|
||||
fc.id AS id
|
||||
FROM file AS f
|
||||
JOIN file_change AS fc ON (fc.file_id = f.id)
|
||||
WHERE fc.label = ? AND f.id = ANY(?)")
|
||||
|
||||
(defn restore-team!
|
||||
[team-id label & {:keys [rollback?] :or {rollback? true}}]
|
||||
(let [team-id (h/parse-uuid team-id)
|
||||
|
||||
get-file-snapshots
|
||||
(fn [conn ids]
|
||||
(let [label (str "migration/" label)]
|
||||
(db/exec! conn [sql:snapshots-with-file label
|
||||
(db/create-array conn "uuid" ids)])))
|
||||
|
||||
restore-snapshot
|
||||
(fn [{:keys [::db/conn] :as system}]
|
||||
(let [ids (into #{} (feat/get-and-lock-files conn team-id))
|
||||
snap (get-file-snapshots conn ids)
|
||||
ids' (into #{} (map :file-id) snap)
|
||||
team (-> (feat/get-team conn team-id)
|
||||
(update :features disj "components/v2"))]
|
||||
|
||||
(when (not= ids ids')
|
||||
(throw (RuntimeException. "no uniform snapshot available")))
|
||||
|
||||
(feat/update-team! conn team)
|
||||
(run! (partial rpc/restore-file-snapshot! system) snap)))]
|
||||
|
||||
|
||||
(-> (assoc main/system ::db/rollback rollback?)
|
||||
(db/tx-run! restore-snapshot))))
|
||||
|
|
|
|||
|
|
@ -56,6 +56,75 @@
|
|||
(d/parse-uuid v)
|
||||
v))
|
||||
|
||||
;; (def ^:private sql:get-and-lock-team-files
|
||||
;; "SELECT f.id
|
||||
;; FROM file AS f
|
||||
;; JOIN project AS p ON (p.id = f.project_id)
|
||||
;; WHERE p.team_id = ?
|
||||
;; FOR UPDATE")
|
||||
|
||||
;; (defn get-and-lock-team-files
|
||||
;; [conn team-id]
|
||||
;; (->> (db/exec! conn [sql:get-and-lock-team-files team-id])
|
||||
;; (into #{} (map :id))))
|
||||
|
||||
;; (defn get-team
|
||||
;; [system team-id]
|
||||
;; (-> (db/get system :team {:id team-id}
|
||||
;; {::db/remove-deleted false
|
||||
;; ::db/check-deleted false})
|
||||
;; (update :features db/decode-pgarray #{})))
|
||||
|
||||
(defn get-file
|
||||
"Get the migrated data of one file."
|
||||
([id] (get-file (or *system* main/system) id))
|
||||
([system id]
|
||||
(db/run! system
|
||||
(fn [system]
|
||||
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer system id)]
|
||||
(-> (files/get-file system id :migrate? false)
|
||||
(update :data feat.fdata/process-pointers deref)
|
||||
(update :data feat.fdata/process-objects (partial into {}))
|
||||
(fmg/migrate-file)))))))
|
||||
|
||||
(defn update-file!
|
||||
[system {:keys [id] :as file}]
|
||||
(let [conn (db/get-connection system)
|
||||
file (if (contains? (:features file) "fdata/objects-map")
|
||||
(feat.fdata/enable-objects-map file)
|
||||
file)
|
||||
|
||||
file (if (contains? (:features file) "fdata/pointer-map")
|
||||
(binding [pmap/*tracked* (pmap/create-tracked)]
|
||||
(let [file (feat.fdata/enable-pointer-map file)]
|
||||
(feat.fdata/persist-pointers! system id)
|
||||
file))
|
||||
file)
|
||||
|
||||
file (-> file
|
||||
(update :features db/encode-pgarray conn "text")
|
||||
(update :data blob/encode))]
|
||||
|
||||
(db/update! conn :file
|
||||
{:revn (:revn file)
|
||||
:data (:data file)
|
||||
:features (:features file)
|
||||
:data-backend nil
|
||||
:modified-at (dt/now)
|
||||
:has-media-trimmed false}
|
||||
{:id (:id file)})))
|
||||
|
||||
(defn update-team!
|
||||
[system {:keys [id] :as team}]
|
||||
(let [conn (db/get-connection system)
|
||||
params (-> team
|
||||
(update :features db/encode-pgarray conn "text")
|
||||
(dissoc :id))]
|
||||
(db/update! conn :team
|
||||
params
|
||||
{:id id})
|
||||
team))
|
||||
|
||||
(defn reset-file-data!
|
||||
"Hardcode replace of the data of one file."
|
||||
[id data]
|
||||
|
|
@ -65,111 +134,90 @@
|
|||
{:data data}
|
||||
{:id id}))))
|
||||
|
||||
(defn- get-file*
|
||||
"Get the migrated data of one file."
|
||||
[system id]
|
||||
(db/run! system
|
||||
(fn [system]
|
||||
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer system id)]
|
||||
(-> (files/get-file system id :migrate? false)
|
||||
(update :data feat.fdata/process-pointers deref)
|
||||
(update :data feat.fdata/process-objects (partial into {}))
|
||||
(fmg/migrate-file))))))
|
||||
|
||||
(defn get-file
|
||||
"Get the migrated data of one file."
|
||||
[id]
|
||||
(get-file* main/system id))
|
||||
|
||||
(defn validate
|
||||
(defn validate-file
|
||||
"Validate structure, referencial integrity and semantic coherence of
|
||||
all contents of a file. Returns a list of errors."
|
||||
[id]
|
||||
(db/tx-run! main/system
|
||||
(fn [{:keys [::db/conn] :as system}]
|
||||
(let [id (if (string? id) (parse-uuid id) id)
|
||||
file (get-file* system id)
|
||||
file (get-file system id)
|
||||
libs (->> (files/get-file-libraries conn id)
|
||||
(into [file] (map (fn [{:keys [id]}]
|
||||
(get-file* system id))))
|
||||
(get-file system id))))
|
||||
(d/index-by :id))]
|
||||
(validate/validate-file file libs)))))
|
||||
|
||||
(defn repair!
|
||||
(defn repair-file*
|
||||
"Internal helper for validate and repair the file. The operation is
|
||||
applied multiple times untile file is fixed or max iteration counter
|
||||
is reached (default 10)"
|
||||
[system id & {:keys [max-iterations] :or {max-iterations 10}}]
|
||||
(let [id (parse-uuid id)
|
||||
|
||||
validate-and-repair
|
||||
(fn [file libs iteration]
|
||||
(when-let [errors (not-empty (validate/validate-file file libs))]
|
||||
(l/trc :hint "repairing file"
|
||||
:file-id (str id)
|
||||
:iteration iteration
|
||||
:errors (count errors))
|
||||
(let [changes (repair/repair-file file libs errors)]
|
||||
(-> file
|
||||
(update :revn inc)
|
||||
(update :data cpc/process-changes changes)))))
|
||||
|
||||
process-file
|
||||
(fn [file libs]
|
||||
(loop [file file
|
||||
iteration 0]
|
||||
(if (> iteration max-iterations)
|
||||
(do
|
||||
(l/wrn :hint "max retry num reached on repairing file"
|
||||
:file-id (str id)
|
||||
:iteration iteration)
|
||||
file)
|
||||
(if-let [file (validate-and-repair file libs iteration)]
|
||||
(recur file (inc iteration))
|
||||
file))))]
|
||||
|
||||
(db/tx-run! system
|
||||
(fn [{:keys [::db/conn] :as system}]
|
||||
(let [file (get-file system id)
|
||||
libs (->> (files/get-file-libraries conn id)
|
||||
(into [file] (map (fn [{:keys [id]}]
|
||||
(get-file system id))))
|
||||
(d/index-by :id))
|
||||
file (process-file file libs)]
|
||||
(update-file! system file))))))
|
||||
|
||||
(defn repair-file!
|
||||
"Repair the list of errors detected by validation."
|
||||
[id]
|
||||
(db/tx-run! main/system
|
||||
(fn [{:keys [::db/conn] :as system}]
|
||||
(let [id (if (string? id) (parse-uuid id) id)
|
||||
file (get-file* system id)
|
||||
libs (->> (files/get-file-libraries conn id)
|
||||
(into [file] (map (fn [{:keys [id]}]
|
||||
(get-file* system id))))
|
||||
(d/index-by :id))
|
||||
errors (validate/validate-file file libs)
|
||||
changes (repair/repair-file file libs errors)
|
||||
[id & {:keys [rollback?] :or {rollback? true} :as opts}]
|
||||
(let [system (or *system* (assoc main/system ::db/rollback rollback?))]
|
||||
(repair-file* system id (dissoc opts :rollback?))))
|
||||
|
||||
file (-> file
|
||||
(update :revn inc)
|
||||
(update :data cpc/process-changes changes))
|
||||
(defn process-file*
|
||||
[system file-id update-fn]
|
||||
(let [file (get-file system file-id)
|
||||
file (-> (update-fn file)
|
||||
(update :revn inc))]
|
||||
|
||||
file (if (contains? (:features file) "fdata/objects-map")
|
||||
(feat.fdata/enable-objects-map file)
|
||||
file)
|
||||
(cfv/validate-file-schema! file)
|
||||
(update-file! system file)
|
||||
(dissoc file :data)))
|
||||
|
||||
file (if (contains? (:features file) "fdata/pointer-map")
|
||||
(binding [pmap/*tracked* (pmap/create-tracked)]
|
||||
(let [file (feat.fdata/enable-pointer-map file)]
|
||||
(feat.fdata/persist-pointers! system id)
|
||||
file))
|
||||
file)]
|
||||
|
||||
(db/update! conn :file
|
||||
{:revn (:revn file)
|
||||
:data (blob/encode (:data file))
|
||||
:data-backend nil
|
||||
:modified-at (dt/now)
|
||||
:has-media-trimmed false}
|
||||
{:id (:id file)})
|
||||
|
||||
:repaired))))
|
||||
|
||||
|
||||
(defn update-file!
|
||||
(defn process-file!
|
||||
"Apply a function to the data of one file. Optionally save the changes or not.
|
||||
The function receives the decoded and migrated file data."
|
||||
[& {:keys [update-fn id rollback? inc-revn?]
|
||||
:or {rollback? true inc-revn? true}}]
|
||||
(letfn [(process-file [{:keys [::db/conn] :as system} file-id]
|
||||
(let [file (get-file* system file-id)
|
||||
file (cond-> (update-fn file)
|
||||
inc-revn? (update :revn inc))
|
||||
[& {:keys [update-fn id rollback?]
|
||||
:or {rollback? true}}]
|
||||
|
||||
_ (cfv/validate-file-schema! file)
|
||||
|
||||
file (if (contains? (:features file) "fdata/objects-map")
|
||||
(feat.fdata/enable-objects-map file)
|
||||
file)
|
||||
|
||||
file (if (contains? (:features file) "fdata/pointer-map")
|
||||
(binding [pmap/*tracked* (pmap/create-tracked)]
|
||||
(let [file (feat.fdata/enable-pointer-map file)]
|
||||
(feat.fdata/persist-pointers! system id)
|
||||
file))
|
||||
file)]
|
||||
|
||||
(db/update! conn :file
|
||||
{:data (blob/encode (:data file))
|
||||
:features (db/create-array conn "text" (:features file))
|
||||
:revn (:revn file)}
|
||||
{:id (:id file)})
|
||||
|
||||
(dissoc file :data)))]
|
||||
|
||||
(db/tx-run! (or *system* (assoc main/system ::db/rollback rollback?))
|
||||
(let [system (or *system* (assoc main/system ::db/rollback rollback?))]
|
||||
(db/tx-run! system
|
||||
(fn [system]
|
||||
(binding [*system* system]
|
||||
(process-file system id))))))
|
||||
(process-file* system id update-fn))))))
|
||||
|
||||
|
||||
(def ^:private sql:get-file-ids
|
||||
|
|
@ -196,11 +244,11 @@
|
|||
(strace/print-stack-trace cause))
|
||||
|
||||
(process-file [{:keys [::db/conn] :as system} file-id]
|
||||
(let [file (get-file* system file-id)
|
||||
(let [file (get-file system file-id)
|
||||
libs (when with-libraries?
|
||||
(->> (files/get-file-libraries conn file-id)
|
||||
(into [file] (map (fn [{:keys [id]}]
|
||||
(get-file* system id))))
|
||||
(get-file system id))))
|
||||
(d/index-by :id)))]
|
||||
(try
|
||||
(if with-libraries?
|
||||
|
|
@ -220,38 +268,6 @@
|
|||
(when (fn? on-end)
|
||||
(ex/ignoring (on-end)))))))))
|
||||
|
||||
(defn repair-file-media
|
||||
[{:keys [id data] :as file}]
|
||||
(let [conn (db/get-connection *system*)
|
||||
used (bfc/collect-used-media data)
|
||||
ids (db/create-array conn "uuid" used)
|
||||
sql (str "SELECT * FROM file_media_object WHERE id = ANY(?)")
|
||||
rows (db/exec! conn [sql ids])
|
||||
index (reduce (fn [index media]
|
||||
(if (not= (:file-id media) id)
|
||||
(let [media-id (uuid/next)]
|
||||
(l/wrn :hint "found not referenced media"
|
||||
:file-id (str id)
|
||||
:media-id (str (:id media)))
|
||||
|
||||
(db/insert! *system* :file-media-object
|
||||
(-> media
|
||||
(assoc :file-id id)
|
||||
(assoc :id media-id)))
|
||||
(assoc index (:id media) media-id))
|
||||
index))
|
||||
{}
|
||||
rows)]
|
||||
|
||||
(when (seq index)
|
||||
(binding [bfc/*state* (atom {:index index})]
|
||||
(update file :data (fn [fdata]
|
||||
(-> fdata
|
||||
(update :pages-index #'bfc/relink-shapes)
|
||||
(update :components #'bfc/relink-shapes)
|
||||
(update :media #'bfc/relink-media)
|
||||
(d/without-nils))))))))
|
||||
|
||||
(defn process-files!
|
||||
"Apply a function to all files in the database"
|
||||
[& {:keys [max-items
|
||||
|
|
@ -281,7 +297,7 @@
|
|||
(l/trc :hint "process:file:start" :file-id (str file-id) :index idx)
|
||||
(db/tx-run! (assoc main/system ::db/rollback rollback?)
|
||||
(fn [{:keys [::db/conn] :as system}]
|
||||
(let [file' (get-file* system file-id)
|
||||
(let [file' (get-file system file-id)
|
||||
file (binding [*system* system]
|
||||
(on-file file'))]
|
||||
|
||||
|
|
@ -350,3 +366,37 @@
|
|||
:rollback rollback?
|
||||
:elapsed elapsed))))))
|
||||
|
||||
|
||||
(defn repair-file-media
|
||||
"A helper intended to be used with `process-files!` that fixes all
|
||||
not propertly referenced file-media-object for a file"
|
||||
[{:keys [id data] :as file}]
|
||||
(let [conn (db/get-connection *system*)
|
||||
used (bfc/collect-used-media data)
|
||||
ids (db/create-array conn "uuid" used)
|
||||
sql (str "SELECT * FROM file_media_object WHERE id = ANY(?)")
|
||||
rows (db/exec! conn [sql ids])
|
||||
index (reduce (fn [index media]
|
||||
(if (not= (:file-id media) id)
|
||||
(let [media-id (uuid/next)]
|
||||
(l/wrn :hint "found not referenced media"
|
||||
:file-id (str id)
|
||||
:media-id (str (:id media)))
|
||||
|
||||
(db/insert! *system* :file-media-object
|
||||
(-> media
|
||||
(assoc :file-id id)
|
||||
(assoc :id media-id)))
|
||||
(assoc index (:id media) media-id))
|
||||
index))
|
||||
{}
|
||||
rows)]
|
||||
|
||||
(when (seq index)
|
||||
(binding [bfc/*state* (atom {:index index})]
|
||||
(update file :data (fn [fdata]
|
||||
(-> fdata
|
||||
(update :pages-index #'bfc/relink-shapes)
|
||||
(update :components #'bfc/relink-shapes)
|
||||
(update :media #'bfc/relink-media)
|
||||
(d/without-nils))))))))
|
||||
|
|
|
|||
|
|
@ -19,7 +19,8 @@
|
|||
[app.common.uuid :as uuid]
|
||||
[app.config :as cf]
|
||||
[app.db :as db]
|
||||
[app.features.fdata :as features.fdata]
|
||||
[app.features.components-v2 :as feat.comp-v2]
|
||||
[app.features.fdata :as feat.fdata]
|
||||
[app.main :as main]
|
||||
[app.msgbus :as mbus]
|
||||
[app.rpc.commands.auth :as auth]
|
||||
|
|
@ -38,7 +39,11 @@
|
|||
[clojure.tools.namespace.repl :as repl]
|
||||
[cuerdas.core :as str]))
|
||||
|
||||
(defn print-available-tasks
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; TASKS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn print-tasks
|
||||
[]
|
||||
(let [tasks (:app.worker/registry main/system)]
|
||||
(p/pprint (keys tasks) :level 200)))
|
||||
|
|
@ -84,6 +89,10 @@
|
|||
(auth/send-email-verification! pool sprops profile)
|
||||
:email-sent))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; PROFILES MANAGEMENT
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn mark-profile-as-active!
|
||||
"Mark the profile blocked and removes all the http sessiones
|
||||
associated with the profile-id."
|
||||
|
|
@ -121,19 +130,28 @@
|
|||
(let [email (str/lower email)]
|
||||
(db/exec! conn ["update profile set password=? where email=?" password email]))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; FEATURES
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn enable-objects-map-feature-on-file!
|
||||
[& {:keys [save? id]}]
|
||||
(h/update-file! main/system
|
||||
:id id
|
||||
:update-fn features.fdata/enable-objects-map
|
||||
:save? save?))
|
||||
(h/process-file! main/system
|
||||
:id id
|
||||
:update-fn feat.fdata/enable-objects-map
|
||||
:save? save?))
|
||||
|
||||
(defn enable-pointer-map-feature-on-file!
|
||||
[& {:keys [save? id]}]
|
||||
(h/update-file! main/system
|
||||
:id id
|
||||
:update-fn features.fdata/enable-pointer-map
|
||||
:save? save?))
|
||||
(h/process-file! main/system
|
||||
:id id
|
||||
:update-fn feat.fdata/enable-pointer-map
|
||||
:save? save?))
|
||||
|
||||
(defn enable-storage-features-on-file!
|
||||
[& {:as params}]
|
||||
(enable-objects-map-feature-on-file! main/system params)
|
||||
(enable-pointer-map-feature-on-file! main/system params))
|
||||
|
||||
(defn enable-team-feature!
|
||||
[team-id feature]
|
||||
|
|
@ -171,57 +189,10 @@
|
|||
{:id team-id})
|
||||
:disabled))))))
|
||||
|
||||
(defn enable-storage-features-on-file!
|
||||
[& {:as params}]
|
||||
(enable-objects-map-feature-on-file! main/system params)
|
||||
(enable-pointer-map-feature-on-file! main/system params))
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; NOTIFICATIONS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn instrument-var
|
||||
[var]
|
||||
(alter-var-root var (fn [f]
|
||||
(let [mf (meta f)]
|
||||
(if (::original mf)
|
||||
f
|
||||
(with-meta
|
||||
(fn [& params]
|
||||
(tap> params)
|
||||
(let [result (apply f params)]
|
||||
(tap> result)
|
||||
result))
|
||||
{::original f}))))))
|
||||
|
||||
(defn uninstrument-var
|
||||
[var]
|
||||
(alter-var-root var (fn [f]
|
||||
(or (::original (meta f)) f))))
|
||||
|
||||
(defn take-file-snapshot!
|
||||
"An internal helper that persist the file snapshot using non-gc
|
||||
collectable file-changes entry."
|
||||
[& {:keys [file-id label]}]
|
||||
(let [file-id (h/parse-uuid file-id)]
|
||||
(db/tx-run! main/system fsnap/take-file-snapshot! {:file-id file-id :label label})))
|
||||
|
||||
(defn restore-file-snapshot!
|
||||
[& {:keys [file-id id]}]
|
||||
(db/tx-run! main/system
|
||||
(fn [cfg]
|
||||
(let [file-id (h/parse-uuid file-id)
|
||||
id (h/parse-uuid id)]
|
||||
|
||||
(if (and (uuid? id) (uuid? file-id))
|
||||
(fsnap/restore-file-snapshot! cfg {:id id :file-id file-id})
|
||||
(println "=> invalid parameters"))))))
|
||||
|
||||
|
||||
(defn list-file-snapshots!
|
||||
[& {:keys [file-id limit]}]
|
||||
(db/tx-run! main/system
|
||||
(fn [system]
|
||||
(let [params {:file-id (h/parse-uuid file-id)
|
||||
:limit limit}]
|
||||
(->> (fsnap/get-file-snapshots system (d/without-nils params))
|
||||
(print-table [:id :revn :created-at :label]))))))
|
||||
|
||||
(defn notify!
|
||||
[{:keys [::mbus/msgbus ::db/pool]} & {:keys [dest code message level]
|
||||
|
|
@ -321,6 +292,121 @@
|
|||
(into #{})
|
||||
(run! send))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; SNAPSHOTS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn take-file-snapshot!
|
||||
"An internal helper that persist the file snapshot using non-gc
|
||||
collectable file-changes entry."
|
||||
[& {:keys [file-id label]}]
|
||||
(let [file-id (h/parse-uuid file-id)]
|
||||
(db/tx-run! main/system fsnap/take-file-snapshot! {:file-id file-id :label label})))
|
||||
|
||||
(defn restore-file-snapshot!
|
||||
[& {:keys [file-id id]}]
|
||||
(db/tx-run! main/system
|
||||
(fn [cfg]
|
||||
(let [file-id (h/parse-uuid file-id)
|
||||
id (h/parse-uuid id)]
|
||||
(if (and (uuid? id) (uuid? file-id))
|
||||
(fsnap/restore-file-snapshot! cfg {:id id :file-id file-id})
|
||||
(println "=> invalid parameters"))))))
|
||||
|
||||
|
||||
(defn list-file-snapshots!
|
||||
[& {:keys [file-id limit]}]
|
||||
(db/tx-run! main/system
|
||||
(fn [system]
|
||||
(let [params {:file-id (h/parse-uuid file-id)
|
||||
:limit limit}]
|
||||
(->> (fsnap/get-file-snapshots system (d/without-nils params))
|
||||
(print-table [:id :revn :created-at :label]))))))
|
||||
|
||||
(defn take-team-snapshot!
|
||||
[& {:keys [team-id label rollback?]
|
||||
:or {rollback? true}}]
|
||||
(let [team-id (h/parse-uuid team-id)
|
||||
label (or label (fsnap/generate-snapshot-label))
|
||||
|
||||
take-snapshot
|
||||
(fn [{:keys [::db/conn] :as system}]
|
||||
(->> (feat.comp-v2/get-and-lock-team-files conn team-id)
|
||||
(map (fn [file-id]
|
||||
{:file-id file-id
|
||||
:label label}))
|
||||
(run! (partial fsnap/take-file-snapshot! system))))]
|
||||
|
||||
(-> (assoc main/system ::db/rollback rollback?)
|
||||
(db/tx-run! take-snapshot))))
|
||||
|
||||
(def ^:private sql:snapshots-with-file
|
||||
"WITH files AS (
|
||||
SELECT f.id AS file_id,
|
||||
(SELECT fc.id
|
||||
FROM file_change AS fc
|
||||
WHERE fc.label = ?
|
||||
AND fc.file_id = f.id
|
||||
ORDER BY fc.created_at DESC
|
||||
LIMIT 1) AS id
|
||||
FROM file AS f
|
||||
) SELECT * FROM files
|
||||
WHERE file_id = ANY(?)
|
||||
AND id IS NOT NULL")
|
||||
|
||||
(defn restore-team-snapshot!
|
||||
"Restore a snapshot on all files of the team. The snapshot should
|
||||
exists for all files; if is not the case, an exception is raised."
|
||||
[& {:keys [team-id label rollback?] :or {rollback? true}}]
|
||||
(let [team-id (h/parse-uuid team-id)
|
||||
|
||||
get-file-snapshots
|
||||
(fn [conn ids]
|
||||
(db/exec! conn [sql:snapshots-with-file label
|
||||
(db/create-array conn "uuid" ids)]))
|
||||
|
||||
restore-snapshot
|
||||
(fn [{:keys [::db/conn] :as system}]
|
||||
(let [ids (->> (feat.comp-v2/get-and-lock-team-files conn team-id)
|
||||
(into #{}))
|
||||
snap (get-file-snapshots conn ids)
|
||||
ids' (into #{} (map :file-id) snap)
|
||||
team (-> (feat.comp-v2/get-team conn team-id)
|
||||
(update :features disj "components/v2"))]
|
||||
|
||||
(when (not= ids ids')
|
||||
(throw (RuntimeException. "no uniform snapshot available")))
|
||||
|
||||
(feat.comp-v2/update-team! conn team)
|
||||
(run! (partial fsnap/restore-file-snapshot! system) snap)))]
|
||||
|
||||
(-> (assoc main/system ::db/rollback rollback?)
|
||||
(db/tx-run! restore-snapshot))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; MISC
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn instrument-var
|
||||
[var]
|
||||
(alter-var-root var (fn [f]
|
||||
(let [mf (meta f)]
|
||||
(if (::original mf)
|
||||
f
|
||||
(with-meta
|
||||
(fn [& params]
|
||||
(tap> params)
|
||||
(let [result (apply f params)]
|
||||
(tap> result)
|
||||
result))
|
||||
{::original f}))))))
|
||||
|
||||
(defn uninstrument-var
|
||||
[var]
|
||||
(alter-var-root var (fn [f]
|
||||
(or (::original (meta f)) f))))
|
||||
|
||||
|
||||
(defn duplicate-team
|
||||
[team-id & {:keys [name]}]
|
||||
(let [team-id (h/parse-uuid team-id)]
|
||||
|
|
@ -337,4 +423,3 @@
|
|||
(assoc :team-id (:id team)))]
|
||||
(db/insert! conn :team-profile-rel params
|
||||
{::db/return-keys false}))))))))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue