mirror of
https://github.com/penpot/penpot.git
synced 2025-06-27 01:36:59 +02:00
⚡ Improve migration script performance and api usability
This commit is contained in:
parent
471fd78174
commit
41287d8fc5
10 changed files with 559 additions and 379 deletions
|
@ -207,6 +207,7 @@
|
|||
(s/def ::telemetry-uri ::us/string)
|
||||
(s/def ::telemetry-with-taiga ::us/boolean)
|
||||
(s/def ::tenant ::us/string)
|
||||
(s/def ::svgo-max-procs ::us/integer)
|
||||
|
||||
(s/def ::config
|
||||
(s/keys :opt-un [::secret-key
|
||||
|
@ -326,7 +327,9 @@
|
|||
::telemetry-uri
|
||||
::telemetry-referer
|
||||
::telemetry-with-taiga
|
||||
::tenant]))
|
||||
::tenant
|
||||
|
||||
::svgo-max-procs]))
|
||||
|
||||
(def default-flags
|
||||
[:enable-backend-api-doc
|
||||
|
|
|
@ -39,27 +39,54 @@
|
|||
[app.rpc.commands.media :as cmd.media]
|
||||
[app.storage :as sto]
|
||||
[app.storage.tmp :as tmp]
|
||||
[app.svgo :as svgo]
|
||||
[app.util.blob :as blob]
|
||||
[app.util.pointer-map :as pmap]
|
||||
[app.util.time :as dt]
|
||||
[buddy.core.codecs :as bc]
|
||||
[cuerdas.core :as str]
|
||||
[datoteka.io :as io]
|
||||
[promesa.exec :as px]
|
||||
[promesa.exec.semaphore :as ps]
|
||||
[promesa.util :as pu]))
|
||||
[promesa.core :as p]))
|
||||
|
||||
(def ^:dynamic *system* nil)
|
||||
(def ^:dynamic *stats* nil)
|
||||
(def ^:dynamic *file-stats* nil)
|
||||
(def ^:dynamic *team-stats* nil)
|
||||
(def ^:dynamic *semaphore* nil)
|
||||
(def ^:dynamic *skip-on-error* true)
|
||||
(def ^:dynamic *stats*
|
||||
"A dynamic var for setting up state for collect stats globally."
|
||||
nil)
|
||||
|
||||
(def ^:dynamic *skip-on-error*
|
||||
"A dynamic var for setting up the default error behavior."
|
||||
true)
|
||||
|
||||
(def ^:dynamic ^:private *system*
|
||||
"An internal var for making the current `system` available to all
|
||||
internal functions without the need to explicitly pass it top down."
|
||||
nil)
|
||||
|
||||
(def ^:dynamic ^:private *max-procs*
|
||||
"A dynamic variable that can optionally indicates the maxumum number
|
||||
of concurrent graphics migration processes."
|
||||
nil)
|
||||
|
||||
(def ^:dynamic ^:private *file-stats*
|
||||
"An internal dynamic var for collect stats by file."
|
||||
nil)
|
||||
|
||||
(def ^:dynamic ^:private *team-stats*
|
||||
"An internal dynamic var for collect stats by team."
|
||||
nil)
|
||||
|
||||
(def grid-gap 50)
|
||||
(def frame-gap 200)
|
||||
(def max-group-size 50)
|
||||
|
||||
(defn decode-row
|
||||
[{:keys [features data] :as row}]
|
||||
(cond-> row
|
||||
(some? features)
|
||||
(assoc :features (db/decode-pgarray features #{}))
|
||||
|
||||
(some? data)
|
||||
(assoc :data (blob/decode data))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; FILE PREPARATION BEFORE MIGRATION
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
@ -220,19 +247,17 @@
|
|||
(fn [file-data]
|
||||
;; Transform component and copy heads to frames, and set the
|
||||
;; frame-id of its childrens
|
||||
(letfn [(fix-container
|
||||
[container]
|
||||
(letfn [(fix-container [container]
|
||||
(update container :objects update-vals fix-shape))
|
||||
|
||||
(fix-shape
|
||||
[shape]
|
||||
(fix-shape [shape]
|
||||
(if (or (nil? (:parent-id shape)) (ctk/instance-head? shape))
|
||||
(assoc shape
|
||||
:type :frame ; Old groups must be converted
|
||||
:fills (or (:fills shape) []) ; to frames and conform to spec
|
||||
:hide-in-viewer (or (:hide-in-viewer shape) true)
|
||||
:rx (or (:rx shape) 0)
|
||||
:ry (or (:ry shape) 0))
|
||||
:type :frame ; Old groups must be converted
|
||||
:fills (or (:fills shape) []) ; to frames and conform to spec
|
||||
:hide-in-viewer (or (:hide-in-viewer shape) true)
|
||||
:rx (or (:rx shape) 0)
|
||||
:ry (or (:ry shape) 0))
|
||||
shape))]
|
||||
(-> file-data
|
||||
(update :pages-index update-vals fix-container)
|
||||
|
@ -310,10 +335,10 @@
|
|||
|
||||
(defn- get-asset-groups
|
||||
[assets generic-name]
|
||||
(let [; Group by first element of the path.
|
||||
(let [;; Group by first element of the path.
|
||||
groups (d/group-by #(first (cfh/split-path (:path %))) assets)
|
||||
|
||||
; Split large groups in chunks of max-group-size elements
|
||||
;; Split large groups in chunks of max-group-size elements
|
||||
groups (loop [groups (seq groups)
|
||||
result {}]
|
||||
(if (empty? groups)
|
||||
|
@ -334,15 +359,14 @@
|
|||
result
|
||||
splits)))))))
|
||||
|
||||
; Sort assets in each group by path
|
||||
;; Sort assets in each group by path
|
||||
groups (update-vals groups (fn [assets]
|
||||
(sort-by (fn [{:keys [path name]}]
|
||||
(str/lower (cfh/merge-path-item path name)))
|
||||
assets)))
|
||||
assets)))]
|
||||
|
||||
; Sort groups by name
|
||||
groups (into (sorted-map) groups)]
|
||||
groups))
|
||||
;; Sort groups by name
|
||||
(into (sorted-map) groups)))
|
||||
|
||||
(defn- create-frame
|
||||
[name position width height]
|
||||
|
@ -612,14 +636,11 @@
|
|||
|
||||
(defn- create-shapes-for-svg
|
||||
[{:keys [id] :as mobj} file-id objects frame-id position]
|
||||
(let [svg-text (get-svg-content id)
|
||||
|
||||
optimizer (::csvg/optimizer *system*)
|
||||
svg-text (csvg/optimize optimizer svg-text)
|
||||
|
||||
svg-data (-> (csvg/parse svg-text)
|
||||
(assoc :name (:name mobj))
|
||||
(collect-and-persist-images file-id))]
|
||||
(let [svg-text (get-svg-content id)
|
||||
svg-text (svgo/optimize *system* svg-text)
|
||||
svg-data (-> (csvg/parse svg-text)
|
||||
(assoc :name (:name mobj))
|
||||
(collect-and-persist-images file-id))]
|
||||
|
||||
(sbuilder/create-svg-shapes svg-data position objects frame-id frame-id #{} false)))
|
||||
|
||||
|
@ -678,9 +699,7 @@
|
|||
|
||||
(defn- create-media-grid
|
||||
[fdata page-id frame-id grid media-group]
|
||||
(let [factory (px/thread-factory :virtual true)
|
||||
executor (px/fixed-executor :parallelism 10 :factory factory)
|
||||
process (fn [mobj position]
|
||||
(let [process (fn [mobj position]
|
||||
(let [position (gpt/add position (gpt/point grid-gap grid-gap))
|
||||
tp1 (dt/tpoint)]
|
||||
(try
|
||||
|
@ -690,7 +709,6 @@
|
|||
:file-id (str (:id fdata))
|
||||
:id (str (:id mobj))
|
||||
:cause cause)
|
||||
|
||||
(if-not *skip-on-error*
|
||||
(throw cause)
|
||||
nil))
|
||||
|
@ -699,21 +717,24 @@
|
|||
:file-id (str (:id fdata))
|
||||
:media-id (str (:id mobj))
|
||||
:elapsed (dt/format-duration (tp1)))))))]
|
||||
(try
|
||||
(->> (d/zip media-group grid)
|
||||
(map (fn [[mobj position]]
|
||||
(sse/tap {:type :migration-progress
|
||||
:section :graphics
|
||||
:name (:name mobj)})
|
||||
(px/submit! executor (partial process mobj position))))
|
||||
(reduce (fn [fdata promise]
|
||||
(if-let [changes (deref promise)]
|
||||
(-> (assoc-in fdata [:options :components-v2] true)
|
||||
(cp/process-changes changes false))
|
||||
fdata))
|
||||
fdata))
|
||||
(finally
|
||||
(pu/close! executor)))))
|
||||
|
||||
(->> (d/zip media-group grid)
|
||||
(partition-all (or *max-procs* 1))
|
||||
(mapcat (fn [partition]
|
||||
(->> partition
|
||||
(map (fn [[mobj position]]
|
||||
(sse/tap {:type :migration-progress
|
||||
:section :graphics
|
||||
:name (:name mobj)})
|
||||
(p/vthread (process mobj position))))
|
||||
(doall)
|
||||
(map deref)
|
||||
(doall))))
|
||||
(filter some?)
|
||||
(reduce (fn [fdata changes]
|
||||
(-> (assoc-in fdata [:options :components-v2] true)
|
||||
(cp/process-changes changes false)))
|
||||
fdata))))
|
||||
|
||||
(defn- migrate-graphics
|
||||
[fdata]
|
||||
|
@ -759,6 +780,11 @@
|
|||
(create-media-grid fdata page-id (:id frame) grid assets)
|
||||
(gpt/add position (gpt/point 0 (+ height (* 2 grid-gap) frame-gap))))))))))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; PRIVATE HELPERS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn- migrate-fdata
|
||||
[fdata libs]
|
||||
(let [migrated? (dm/get-in fdata [:options :components-v2])]
|
||||
|
@ -771,11 +797,22 @@
|
|||
(defn- get-file
|
||||
[system id]
|
||||
(binding [pmap/*load-fn* (partial fdata/load-pointer system id)]
|
||||
(-> (files/get-file system id :migrate? false)
|
||||
(-> (db/get system :file {:id id}
|
||||
{::db/remove-deleted false
|
||||
::db/check-deleted false})
|
||||
(decode-row)
|
||||
(update :data assoc :id id)
|
||||
(update :data fdata/process-pointers deref)
|
||||
(fmg/migrate-file))))
|
||||
|
||||
|
||||
(defn- get-team
|
||||
[system team-id]
|
||||
(-> (db/get system :team {:id team-id}
|
||||
{::db/remove-deleted false
|
||||
::db/check-deleted false})
|
||||
(decode-row)))
|
||||
|
||||
(defn- validate-file!
|
||||
[file libs throw-on-validate?]
|
||||
(try
|
||||
|
@ -791,7 +828,8 @@
|
|||
(let [file (get-file system id)
|
||||
|
||||
libs (->> (files/get-file-libraries conn id)
|
||||
(into [file] (comp (map :id) (map (partial get-file system))))
|
||||
(into [file] (comp (map :id)
|
||||
(map (partial get-file system))))
|
||||
(d/index-by :id))
|
||||
|
||||
file (-> file
|
||||
|
@ -820,13 +858,35 @@
|
|||
|
||||
(dissoc file :data)))
|
||||
|
||||
|
||||
(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-files
|
||||
[conn team-id]
|
||||
(->> (db/cursor conn [sql:get-and-lock-team-files team-id])
|
||||
(map :id)))
|
||||
|
||||
(defn- update-team-features!
|
||||
[conn team-id features]
|
||||
(let [features (db/create-array conn "text" features)]
|
||||
(db/update! conn :team
|
||||
{:features features}
|
||||
{:id team-id})))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; PUBLIC API
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn migrate-file!
|
||||
[system file-id & {:keys [validate? throw-on-validate?]}]
|
||||
(let [tpoint (dt/tpoint)
|
||||
file-id (if (string? file-id)
|
||||
(parse-uuid file-id)
|
||||
file-id)]
|
||||
(binding [*file-stats* (atom {})]
|
||||
[system file-id & {:keys [validate? throw-on-validate? max-procs]}]
|
||||
(let [tpoint (dt/tpoint)]
|
||||
(binding [*file-stats* (atom {})
|
||||
*max-procs* max-procs]
|
||||
(try
|
||||
(l/dbg :hint "migrate:file:start" :file-id (str file-id))
|
||||
|
||||
|
@ -838,7 +898,6 @@
|
|||
(process-file system file-id
|
||||
:validate? validate?
|
||||
:throw-on-validate? throw-on-validate?)))))
|
||||
|
||||
(finally
|
||||
(let [elapsed (tpoint)
|
||||
components (get @*file-stats* :processed/components 0)
|
||||
|
@ -854,75 +913,51 @@
|
|||
(some-> *team-stats* (swap! update :processed/files (fnil inc 0)))))))))
|
||||
|
||||
(defn migrate-team!
|
||||
[system team-id & {:keys [validate? throw-on-validate?]}]
|
||||
(let [tpoint (dt/tpoint)
|
||||
team-id (if (string? team-id)
|
||||
(parse-uuid team-id)
|
||||
team-id)]
|
||||
(l/dbg :hint "migrate:team:start" :team-id (dm/str team-id))
|
||||
[system team-id & {:keys [validate? throw-on-validate? max-procs]}]
|
||||
|
||||
(l/dbg :hint "migrate:team:start"
|
||||
:team-id (dm/str team-id))
|
||||
|
||||
(let [tpoint (dt/tpoint)
|
||||
|
||||
migrate-file
|
||||
(fn [system file-id]
|
||||
(migrate-file! system file-id
|
||||
:max-procs max-procs
|
||||
:validate? validate?
|
||||
:throw-on-validate? throw-on-validate?))
|
||||
migrate-team
|
||||
(fn [{:keys [::db/conn] :as system} {:keys [id features] :as team}]
|
||||
(let [features (-> features
|
||||
(disj "ephimeral/v2-migration")
|
||||
(conj "components/v2")
|
||||
(conj "layout/grid")
|
||||
(conj "styles/v2"))]
|
||||
|
||||
(run! (partial migrate-file system)
|
||||
(get-and-lock-files conn id))
|
||||
|
||||
(update-team-features! conn id features)))]
|
||||
|
||||
(binding [*team-stats* (atom {})]
|
||||
(try
|
||||
;; We execute this out of transaction because we want this
|
||||
;; change to be visible to all other sessions before starting
|
||||
;; the migration
|
||||
(let [sql (str "UPDATE team SET features = "
|
||||
" array_append(features, 'ephimeral/v2-migration') "
|
||||
" WHERE id = ?")]
|
||||
(db/exec-one! system [sql team-id]))
|
||||
|
||||
(db/tx-run! system
|
||||
(fn [{:keys [::db/conn] :as system}]
|
||||
;; Lock the team
|
||||
(db/exec-one! conn ["SET idle_in_transaction_session_timeout = 0"])
|
||||
|
||||
(let [{:keys [features] :as team} (-> (db/get conn :team {:id team-id})
|
||||
(update :features db/decode-pgarray #{}))]
|
||||
|
||||
(if (contains? features "components/v2")
|
||||
(l/dbg :hint "team already migrated")
|
||||
(let [sql (str/concat
|
||||
"SELECT f.id FROM file AS f "
|
||||
" JOIN project AS p ON (p.id = f.project_id) "
|
||||
"WHERE p.team_id = ? AND f.deleted_at IS NULL AND p.deleted_at IS NULL "
|
||||
"FOR UPDATE")]
|
||||
|
||||
(doseq [file-id (->> (db/exec! conn [sql team-id])
|
||||
(map :id))]
|
||||
(migrate-file! system file-id
|
||||
:validate? validate?
|
||||
:throw-on-validate? throw-on-validate?))
|
||||
|
||||
(let [features (-> features
|
||||
(disj "ephimeral/v2-migration")
|
||||
(conj "components/v2")
|
||||
(conj "layout/grid")
|
||||
(conj "styles/v2"))]
|
||||
(db/update! conn :team
|
||||
{:features (db/create-array conn "text" features)}
|
||||
{:id team-id})
|
||||
|
||||
nil))))))
|
||||
(db/tx-run! system (fn [system]
|
||||
(db/exec-one! system ["SET idle_in_transaction_session_timeout = 0"])
|
||||
(let [team (get-team system team-id)]
|
||||
(if (contains? (:features team) "components/v2")
|
||||
(l/inf :hint "team already migrated")
|
||||
(migrate-team system team)))))
|
||||
(finally
|
||||
(some-> *semaphore* ps/release!)
|
||||
(let [elapsed (tpoint)]
|
||||
(let [elapsed (tpoint)
|
||||
components (get @*team-stats* :processed/components 0)
|
||||
graphics (get @*team-stats* :processed/graphics 0)
|
||||
files (get @*team-stats* :processed/files 0)]
|
||||
|
||||
(some-> *stats* (swap! update :processed/teams (fnil inc 0)))
|
||||
|
||||
;; We execute this out of transaction because we want this
|
||||
;; change to be visible to all other sessions before starting
|
||||
;; the migration
|
||||
(let [sql (str "UPDATE team SET features = "
|
||||
" array_remove(features, 'ephimeral/v2-migration') "
|
||||
" WHERE id = ?")]
|
||||
(db/exec-one! system [sql team-id]))
|
||||
|
||||
(let [components (get @*team-stats* :processed/components 0)
|
||||
graphics (get @*team-stats* :processed/graphics 0)
|
||||
files (get @*team-stats* :processed/files 0)]
|
||||
(l/dbg :hint "migrate:team:end"
|
||||
:team-id (dm/str team-id)
|
||||
:files files
|
||||
:components components
|
||||
:graphics graphics
|
||||
:elapsed (dt/format-duration elapsed)))))))))
|
||||
|
||||
|
||||
(l/dbg :hint "migrate:team:end"
|
||||
:team-id (dm/str team-id)
|
||||
:files files
|
||||
:components components
|
||||
:graphics graphics
|
||||
:elapsed (dt/format-duration elapsed))))))))
|
||||
|
|
|
@ -10,7 +10,6 @@
|
|||
[app.auth.oidc :as-alias oidc]
|
||||
[app.auth.oidc.providers :as-alias oidc.providers]
|
||||
[app.common.logging :as l]
|
||||
[app.common.svg :as csvg]
|
||||
[app.config :as cf]
|
||||
[app.db :as-alias db]
|
||||
[app.email :as-alias email]
|
||||
|
@ -37,6 +36,7 @@
|
|||
[app.storage.gc-deleted :as-alias sto.gc-deleted]
|
||||
[app.storage.gc-touched :as-alias sto.gc-touched]
|
||||
[app.storage.s3 :as-alias sto.s3]
|
||||
[app.svgo :as-alias svgo]
|
||||
[app.util.time :as dt]
|
||||
[app.worker :as-alias wrk]
|
||||
[cider.nrepl :refer [cider-nrepl-handler]]
|
||||
|
@ -316,7 +316,7 @@
|
|||
::mtx/metrics (ig/ref ::mtx/metrics)
|
||||
::mbus/msgbus (ig/ref ::mbus/msgbus)
|
||||
::rds/redis (ig/ref ::rds/redis)
|
||||
::csvg/optimizer (ig/ref ::csvg/optimizer)
|
||||
::svgo/optimizer (ig/ref ::svgo/optimizer)
|
||||
|
||||
::rpc/climit (ig/ref ::rpc/climit)
|
||||
::rpc/rlimit (ig/ref ::rpc/rlimit)
|
||||
|
@ -409,8 +409,9 @@
|
|||
;; module requires the migrations to run before initialize.
|
||||
::migrations (ig/ref :app.migrations/migrations)}
|
||||
|
||||
::csvg/optimizer
|
||||
{}
|
||||
::svgo/optimizer
|
||||
{::wrk/executor (ig/ref ::wrk/executor)
|
||||
::svgo/max-procs (cf/get :svgo-max-procs)}
|
||||
|
||||
::audit.tasks/archive
|
||||
{::props (ig/ref ::setup/props)
|
||||
|
|
|
@ -664,6 +664,7 @@
|
|||
(case feature
|
||||
"components/v2"
|
||||
(feat.compv2/migrate-file! options file-id
|
||||
:max-procs 2
|
||||
:validate? validate?
|
||||
:throw-on-validate? true)
|
||||
|
||||
|
|
|
@ -6,8 +6,6 @@
|
|||
|
||||
(ns app.srepl.components-v2
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.logging :as l]
|
||||
[app.common.pprint :as pp]
|
||||
[app.db :as db]
|
||||
|
@ -19,6 +17,13 @@
|
|||
[promesa.exec.semaphore :as ps]
|
||||
[promesa.util :as pu]))
|
||||
|
||||
(def ^:dynamic *scope* nil)
|
||||
(def ^:dynamic *semaphore* nil)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; PRIVATE HELPERS
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn- print-stats!
|
||||
[stats]
|
||||
(->> stats
|
||||
|
@ -87,210 +92,228 @@
|
|||
res (db/exec-one! pool [sql])]
|
||||
(:count res)))
|
||||
|
||||
(defn migrate-file!
|
||||
[system file-id & {:keys [rollback?] :or {rollback? true}}]
|
||||
|
||||
(l/dbg :hint "migrate:start")
|
||||
(let [tpoint (dt/tpoint)]
|
||||
(try
|
||||
(binding [feat/*stats* (atom {})]
|
||||
(defn- mark-team-migration!
|
||||
[{:keys [::db/pool]} team-id]
|
||||
;; We execute this out of transaction because we want this
|
||||
;; change to be visible to all other sessions before starting
|
||||
;; the migration
|
||||
(let [sql (str "UPDATE team SET features = "
|
||||
" array_append(features, 'ephimeral/v2-migration') "
|
||||
" WHERE id = ?")]
|
||||
(db/exec-one! pool [sql team-id])))
|
||||
|
||||
(defn- unmark-team-migration!
|
||||
[{:keys [::db/pool]} team-id]
|
||||
;; We execute this out of transaction because we want this
|
||||
;; change to be visible to all other sessions before starting
|
||||
;; the migration
|
||||
(let [sql (str "UPDATE team SET features = "
|
||||
" array_remove(features, 'ephimeral/v2-migration') "
|
||||
" WHERE id = ?")]
|
||||
(db/exec-one! pool [sql team-id])))
|
||||
|
||||
(def ^:private sql:get-teams
|
||||
"SELECT id, features
|
||||
FROM team
|
||||
WHERE deleted_at IS NULL
|
||||
ORDER BY created_at ASC")
|
||||
|
||||
(defn- get-teams
|
||||
[conn]
|
||||
(->> (db/cursor conn sql:get-teams)
|
||||
(map feat/decode-row)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; PUBLIC API
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defn migrate-file!
|
||||
[system file-id & {:keys [rollback? max-procs]
|
||||
:or {rollback? true}}]
|
||||
|
||||
(l/dbg :hint "migrate:start" :rollback rollback?)
|
||||
(let [tpoint (dt/tpoint)
|
||||
file-id (if (string? file-id)
|
||||
(parse-uuid file-id)
|
||||
file-id)]
|
||||
(binding [feat/*stats* (atom {})]
|
||||
(try
|
||||
(-> (assoc system ::db/rollback rollback?)
|
||||
(feat/migrate-file! file-id))
|
||||
(feat/migrate-file! file-id :max-procs max-procs))
|
||||
|
||||
(-> (deref feat/*stats*)
|
||||
(assoc :elapsed (dt/format-duration (tpoint)))))
|
||||
(assoc :elapsed (dt/format-duration (tpoint))))
|
||||
|
||||
(catch Throwable cause
|
||||
(l/wrn :hint "migrate:error" :cause cause))
|
||||
(catch Throwable cause
|
||||
(l/wrn :hint "migrate:error" :cause cause))
|
||||
|
||||
(finally
|
||||
(let [elapsed (dt/format-duration (tpoint))]
|
||||
(l/dbg :hint "migrate:end" :elapsed elapsed))))))
|
||||
|
||||
(defn migrate-files!
|
||||
[{:keys [::db/pool] :as system}
|
||||
& {:keys [chunk-size max-jobs max-items start-at preset rollback? skip-on-error validate?]
|
||||
:or {chunk-size 10
|
||||
skip-on-error true
|
||||
max-jobs 10
|
||||
max-items Long/MAX_VALUE
|
||||
preset :shutdown-on-failure
|
||||
rollback? true
|
||||
validate? false}}]
|
||||
(letfn [(get-chunk [cursor]
|
||||
(let [sql (str/concat
|
||||
"SELECT id, created_at FROM file "
|
||||
" WHERE created_at < ? AND deleted_at IS NULL "
|
||||
" ORDER BY created_at desc LIMIT ?")
|
||||
rows (db/exec! pool [sql cursor chunk-size])]
|
||||
[(some->> rows peek :created-at) (seq rows)]))
|
||||
|
||||
(get-candidates []
|
||||
(->> (d/iteration get-chunk
|
||||
:vf second
|
||||
:kf first
|
||||
:initk (or start-at (dt/now)))
|
||||
(take max-items)
|
||||
(map :id)))]
|
||||
|
||||
(l/dbg :hint "migrate:start")
|
||||
(let [fsem (ps/create :permits max-jobs)
|
||||
total (get-total-files pool)
|
||||
stats (atom {:files/total total})
|
||||
tpoint (dt/tpoint)]
|
||||
|
||||
(add-watch stats :progress-report (report-progress-files tpoint))
|
||||
|
||||
(binding [feat/*stats* stats
|
||||
feat/*semaphore* fsem
|
||||
feat/*skip-on-error* skip-on-error]
|
||||
(try
|
||||
(pu/with-open [scope (px/structured-task-scope :preset preset :factory :virtual)]
|
||||
|
||||
(run! (fn [file-id]
|
||||
(ps/acquire! feat/*semaphore*)
|
||||
(px/submit! scope (fn []
|
||||
(-> (assoc system ::db/rollback rollback?)
|
||||
(feat/migrate-file! file-id
|
||||
:validate? validate?
|
||||
:throw-on-validate? (not skip-on-error))))))
|
||||
(get-candidates))
|
||||
|
||||
(p/await! scope))
|
||||
|
||||
(-> (deref feat/*stats*)
|
||||
(assoc :elapsed (dt/format-duration (tpoint))))
|
||||
|
||||
(catch Throwable cause
|
||||
(l/dbg :hint "migrate:error" :cause cause))
|
||||
|
||||
(finally
|
||||
(let [elapsed (dt/format-duration (tpoint))]
|
||||
(l/dbg :hint "migrate:end" :elapsed elapsed))))))))
|
||||
(finally
|
||||
(let [elapsed (dt/format-duration (tpoint))]
|
||||
(l/dbg :hint "migrate:end" :rollback rollback? :elapsed elapsed)))))))
|
||||
|
||||
(defn migrate-team!
|
||||
[{:keys [::db/pool] :as system} team-id
|
||||
& {:keys [rollback? skip-on-error validate?]
|
||||
:or {rollback? true skip-on-error true validate? false}}]
|
||||
(l/dbg :hint "migrate:start")
|
||||
[{:keys [::db/pool] :as system} team-id & {:keys [rollback? skip-on-error validate? max-procs]
|
||||
:or {rollback? true
|
||||
skip-on-error true
|
||||
validate? false
|
||||
max-procs 1 }
|
||||
:as opts}]
|
||||
|
||||
(let [total (get-total-files pool :team-id team-id)
|
||||
stats (atom {:total/files total})
|
||||
tpoint (dt/tpoint)]
|
||||
(l/dbg :hint "migrate:start" :rollback rollback?)
|
||||
|
||||
(let [team-id (if (string? team-id)
|
||||
(parse-uuid team-id)
|
||||
team-id)
|
||||
total (get-total-files pool :team-id team-id)
|
||||
stats (atom {:total/files total})
|
||||
tpoint (dt/tpoint)]
|
||||
|
||||
(add-watch stats :progress-report (report-progress-files tpoint))
|
||||
|
||||
(try
|
||||
(binding [feat/*stats* stats
|
||||
feat/*skip-on-error* skip-on-error]
|
||||
(binding [feat/*stats* stats
|
||||
feat/*skip-on-error* skip-on-error]
|
||||
|
||||
(try
|
||||
(mark-team-migration! system team-id)
|
||||
|
||||
(-> (assoc system ::db/rollback rollback?)
|
||||
(feat/migrate-team! team-id
|
||||
:max-procs max-procs
|
||||
:validate? validate?
|
||||
:throw-on-validate? (not skip-on-error)))
|
||||
|
||||
(print-stats!
|
||||
(-> (deref feat/*stats*)
|
||||
(dissoc :total/files)
|
||||
(assoc :elapsed (dt/format-duration (tpoint))))))
|
||||
(assoc :elapsed (dt/format-duration (tpoint)))))
|
||||
|
||||
(catch Throwable cause
|
||||
(l/dbg :hint "migrate:error" :cause cause))
|
||||
(catch Throwable cause
|
||||
(l/dbg :hint "migrate:error" :cause cause))
|
||||
|
||||
(finally
|
||||
(let [elapsed (dt/format-duration (tpoint))]
|
||||
(l/dbg :hint "migrate:end" :elapsed elapsed))))))
|
||||
(finally
|
||||
(unmark-team-migration! system team-id)
|
||||
|
||||
(defn default-on-end
|
||||
[stats]
|
||||
(print-stats!
|
||||
(-> stats
|
||||
(update :elapsed/total dt/format-duration)
|
||||
(dissoc :total/teams))))
|
||||
(let [elapsed (dt/format-duration (tpoint))]
|
||||
(l/dbg :hint "migrate:end" :rollback rollback? :elapsed elapsed)))))))
|
||||
|
||||
(defn migrate-teams!
|
||||
[{:keys [::db/pool] :as system}
|
||||
& {:keys [chunk-size max-jobs max-items start-at
|
||||
rollback? validate? preset skip-on-error
|
||||
max-time on-start on-progress on-error on-end]
|
||||
:or {chunk-size 10000
|
||||
validate? false
|
||||
rollback? true
|
||||
skip-on-error true
|
||||
on-end default-on-end
|
||||
preset :shutdown-on-failure
|
||||
max-jobs Integer/MAX_VALUE
|
||||
max-items Long/MAX_VALUE}}]
|
||||
"A REPL helper for migrate all teams.
|
||||
|
||||
(letfn [(get-chunk [cursor]
|
||||
(let [sql (str/concat
|
||||
"SELECT id, created_at, features FROM team "
|
||||
" WHERE created_at < ? AND deleted_at IS NULL "
|
||||
" ORDER BY created_at desc LIMIT ?")
|
||||
rows (db/exec! pool [sql cursor chunk-size])]
|
||||
[(some->> rows peek :created-at) (seq rows)]))
|
||||
This function starts multiple concurrent team migration processes
|
||||
until thw maximum number of jobs is reached which by default has the
|
||||
value of `1`. This is controled with the `:max-jobs` option.
|
||||
|
||||
(get-candidates []
|
||||
(->> (d/iteration get-chunk
|
||||
:vf second
|
||||
:kf first
|
||||
:initk (or start-at (dt/now)))
|
||||
(map #(update % :features db/decode-pgarray #{}))
|
||||
(remove #(contains? (:features %) "ephimeral/v2-migration"))
|
||||
(take max-items)
|
||||
(map :id)))
|
||||
Each tram migration process also can start multiple procs for
|
||||
graphics migration, the total of that procs is controled with the
|
||||
`:max-procs` option.
|
||||
|
||||
(migrate-team [team-id]
|
||||
(try
|
||||
(-> (assoc system ::db/rollback rollback?)
|
||||
(feat/migrate-team! team-id
|
||||
:validate? validate?
|
||||
:throw-on-validate? (not skip-on-error)))
|
||||
(catch Throwable cause
|
||||
(l/err :hint "unexpected error on processing team" :team-id (dm/str team-id) :cause cause))))
|
||||
Internally, the graphics migration process uses SVGO module which by
|
||||
default has a limited number of maximum concurent
|
||||
operations (globally), ensure setting up correct number with
|
||||
PENPOT_SVGO_MAX_PROCS environment variable."
|
||||
|
||||
(process-team [scope tpoint mtime team-id]
|
||||
(ps/acquire! feat/*semaphore*)
|
||||
(let [ts (tpoint)]
|
||||
(if (and mtime (neg? (compare mtime ts)))
|
||||
(l/inf :hint "max time constraint reached" :elapsed (dt/format-duration ts))
|
||||
(px/submit! scope (partial migrate-team team-id)))))]
|
||||
[{:keys [::db/pool] :as system} & {:keys [max-jobs max-procs max-items
|
||||
rollback? validate? preset
|
||||
skip-on-error max-time
|
||||
on-start on-progress on-error on-end]
|
||||
:or {validate? false
|
||||
rollback? true
|
||||
skip-on-error true
|
||||
preset :shutdown-on-failure
|
||||
max-jobs 1
|
||||
max-procs 10
|
||||
max-items Long/MAX_VALUE}
|
||||
:as opts}]
|
||||
|
||||
(l/dbg :hint "migrate:start")
|
||||
(let [total (get-total-teams pool)
|
||||
stats (atom {:total/teams (min total max-items)})
|
||||
|
||||
(let [sem (ps/create :permits max-jobs)
|
||||
total (get-total-teams pool)
|
||||
stats (atom {:total/teams (min total max-items)})
|
||||
tpoint (dt/tpoint)
|
||||
mtime (some-> max-time dt/duration)]
|
||||
tpoint (dt/tpoint)
|
||||
mtime (some-> max-time dt/duration)
|
||||
|
||||
(when (fn? on-start)
|
||||
(on-start {:total total :rollback rollback?}))
|
||||
scope (px/structured-task-scope :preset preset :factory :virtual)
|
||||
sjobs (ps/create :permits max-jobs)
|
||||
|
||||
(add-watch stats :progress-report (report-progress-teams tpoint on-progress))
|
||||
migrate-team
|
||||
(fn [{:keys [id features] :as team}]
|
||||
(ps/acquire! sjobs)
|
||||
(let [ts (tpoint)]
|
||||
(cond
|
||||
(and mtime (neg? (compare mtime ts)))
|
||||
(do
|
||||
(l/inf :hint "max time constraint reached"
|
||||
:team-id (str id)
|
||||
:elapsed (dt/format-duration ts))
|
||||
(ps/release! sjobs)
|
||||
(reduced nil))
|
||||
|
||||
(binding [feat/*stats* stats
|
||||
feat/*semaphore* sem
|
||||
feat/*skip-on-error* skip-on-error]
|
||||
(or (contains? features "ephimeral/v2-migration")
|
||||
(contains? features "components/v2"))
|
||||
(do
|
||||
(l/dbg :hint "skip team" :team-id (str id))
|
||||
(ps/release! sjobs))
|
||||
|
||||
:else
|
||||
(px/submit! scope (fn []
|
||||
(try
|
||||
(mark-team-migration! system id)
|
||||
(-> (assoc system ::db/rollback rollback?)
|
||||
(feat/migrate-team! id
|
||||
:max-procs max-procs
|
||||
:validate? validate?
|
||||
:throw-on-validate? (not skip-on-error)))
|
||||
(catch Throwable cause
|
||||
(l/err :hint "unexpected error on processing team"
|
||||
:team-id (str id)
|
||||
:cause cause))
|
||||
(finally
|
||||
(ps/release! sjobs)
|
||||
(unmark-team-migration! system id))))))))]
|
||||
|
||||
(l/dbg :hint "migrate:start"
|
||||
:rollback rollback?
|
||||
:total total
|
||||
:max-jobs max-jobs
|
||||
:max-procs max-procs
|
||||
:max-items max-items)
|
||||
|
||||
(add-watch stats :progress-report (report-progress-teams tpoint on-progress))
|
||||
|
||||
(binding [feat/*stats* stats
|
||||
feat/*skip-on-error* skip-on-error]
|
||||
(try
|
||||
(when (fn? on-start)
|
||||
(on-start {:total total :rollback rollback?}))
|
||||
|
||||
(db/tx-run! system
|
||||
(fn [{:keys [::db/conn]}]
|
||||
(run! (partial migrate-team)
|
||||
(->> (get-teams conn)
|
||||
(take max-items)))))
|
||||
(try
|
||||
(pu/with-open [scope (px/structured-task-scope :preset preset
|
||||
:factory :virtual)]
|
||||
(loop [candidates (get-candidates)]
|
||||
(when-let [team-id (first candidates)]
|
||||
(when (process-team scope tpoint mtime team-id)
|
||||
(recur (rest candidates)))))
|
||||
|
||||
(p/await! scope))
|
||||
|
||||
(when (fn? on-end)
|
||||
(-> (deref stats)
|
||||
(assoc :elapsed/total (tpoint))
|
||||
(on-end)))
|
||||
|
||||
(catch Throwable cause
|
||||
(l/dbg :hint "migrate:error" :cause cause)
|
||||
(when (fn? on-error)
|
||||
(on-error cause)))
|
||||
|
||||
(p/await! scope)
|
||||
(finally
|
||||
(let [elapsed (dt/format-duration (tpoint))]
|
||||
(l/dbg :hint "migrate:end" :elapsed elapsed))))))))
|
||||
(pu/close! scope)))
|
||||
|
||||
|
||||
(if (fn? on-end)
|
||||
(-> (deref stats)
|
||||
(assoc :elapsed/total (tpoint))
|
||||
(on-end))
|
||||
(-> (deref stats)
|
||||
(assoc :elapsed/total (tpoint))
|
||||
(update :elapsed/total dt/format-duration)
|
||||
(dissoc :total/teams)
|
||||
(print-stats!)))
|
||||
|
||||
(catch Throwable cause
|
||||
(l/dbg :hint "migrate:error" :cause cause)
|
||||
(when (fn? on-error)
|
||||
(on-error cause)))
|
||||
|
||||
(finally
|
||||
(let [elapsed (dt/format-duration (tpoint))]
|
||||
(l/dbg :hint "migrate:end"
|
||||
:rollback rollback?
|
||||
:elapsed elapsed)))))))
|
||||
|
|
65
backend/src/app/svgo.clj
Normal file
65
backend/src/app/svgo.clj
Normal file
|
@ -0,0 +1,65 @@
|
|||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS INC
|
||||
|
||||
(ns app.svgo
|
||||
"A SVG Optimizer service"
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.data.macros :as dm]
|
||||
[app.common.jsrt :as jsrt]
|
||||
[app.common.logging :as l]
|
||||
[app.common.spec :as us]
|
||||
[app.worker :as-alias wrk]
|
||||
[clojure.spec.alpha :as s]
|
||||
[integrant.core :as ig]
|
||||
[promesa.exec :as px]
|
||||
[promesa.exec.bulkhead :as bh]
|
||||
[promesa.exec.semaphore :as ps]
|
||||
[promesa.util :as pu]))
|
||||
|
||||
(def ^:dynamic *semaphore*
|
||||
"A dynamic variable that can optionally contain a traffic light to
|
||||
appropriately delimit the use of resources, managed externally."
|
||||
nil)
|
||||
|
||||
(defn optimize
|
||||
[system data]
|
||||
(dm/assert! "expect data to be a string" (string? data))
|
||||
|
||||
(letfn [(optimize-fn [pool]
|
||||
(jsrt/run! pool
|
||||
(fn [context]
|
||||
(jsrt/set! context "svgData" data)
|
||||
(jsrt/eval! context "penpotSvgo.optimize(svgData, {plugins: ['safeAndFastPreset']})"))))]
|
||||
(try
|
||||
(some-> *semaphore* ps/acquire!)
|
||||
(let [{:keys [::jsrt/pool ::wrk/executor]} (::optimizer system)]
|
||||
(dm/assert! "expect optimizer instance" (jsrt/pool? pool))
|
||||
(px/invoke! executor (partial optimize-fn pool)))
|
||||
(finally
|
||||
(some-> *semaphore* ps/release!)))))
|
||||
|
||||
(s/def ::max-procs (s/nilable ::us/integer))
|
||||
|
||||
(defmethod ig/pre-init-spec ::optimizer [_]
|
||||
(s/keys :req [::wrk/executor ::max-procs]))
|
||||
|
||||
(defmethod ig/prep-key ::optimizer
|
||||
[_ cfg]
|
||||
(merge {::max-procs 20} (d/without-nils cfg)))
|
||||
|
||||
(defmethod ig/init-key ::optimizer
|
||||
[_ {:keys [::wrk/executor ::max-procs]}]
|
||||
(l/inf :hint "initializing svg optimizer pool" :max-procs max-procs)
|
||||
(let [init (jsrt/resource->source "app/common/svg/optimizer.js")
|
||||
executor (bh/create :type :executor :executor executor :permits max-procs)]
|
||||
{::jsrt/pool (jsrt/pool :init init)
|
||||
::wrk/executor executor}))
|
||||
|
||||
(defmethod ig/halt-key! ::optimizer
|
||||
[_ {:keys [::jsrt/pool]}]
|
||||
(l/info :hint "stopping svg optimizer pool")
|
||||
(pu/close! pool))
|
|
@ -42,8 +42,8 @@
|
|||
|
||||
(defmethod ig/init-key ::executor
|
||||
[_ _]
|
||||
(let [factory (px/thread-factory :prefix "penpot/default/")
|
||||
executor (px/cached-executor :factory factory :keepalive 30000)]
|
||||
(let [factory (px/thread-factory :prefix "penpot/default/")
|
||||
executor (px/cached-executor :factory factory :keepalive 60000)]
|
||||
(l/inf :hint "starting executor")
|
||||
(reify
|
||||
java.lang.AutoCloseable
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue