♻️ Refactor file data migrations subsystem (#5692)

* ♻️ Refactor file data migrations subsystem

* 📎 Add backend scripts/run helper script
This commit is contained in:
Andrey Antukh 2025-01-31 13:37:41 +01:00 committed by GitHub
parent 96e99f6a78
commit f871f88f30
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
20 changed files with 465 additions and 476 deletions

44
backend/scripts/run Executable file
View file

@ -0,0 +1,44 @@
#!/usr/bin/env bash
export PENPOT_SECRET_KEY=super-secret-devenv-key
export PENPOT_HOST=devenv
export PENPOT_FLAGS="\
$PENPOT_FLAGS \
enable-backend-asserts \
enable-feature-fdata-pointer-map \
enable-feature-fdata-objects-map \
enable-file-snapshot \
enable-tiered-file-data-storage";
export JAVA_OPTS="
-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
-Djdk.attach.allowAttachSelf \
-Dlog4j2.configurationFile=log4j2-devenv.xml \
-XX:+EnableDynamicAgentLoading \
-XX:-OmitStackTraceInFastThrow \
-XX:+UnlockDiagnosticVMOptions \
-XX:+DebugNonSafepoints";
export CLOJURE_OPTIONS="-A:dev"
# Default deletion delay for devenv
export PENPOT_DELETION_DELAY="24h"
# Setup default upload media file size to 100MiB
export PENPOT_MEDIA_MAX_FILE_SIZE=104857600
# Setup default multipart upload size to 300MiB
export PENPOT_HTTP_SERVER_MAX_MULTIPART_BODY_SIZE=314572800
export AWS_ACCESS_KEY_ID=penpot-devenv
export AWS_SECRET_ACCESS_KEY=penpot-devenv
export PENPOT_OBJECTS_STORAGE_BACKEND=s3
export PENPOT_OBJECTS_STORAGE_S3_ENDPOINT=http://minio:9000
export PENPOT_OBJECTS_STORAGE_S3_BUCKET=penpot
entrypoint=${1:-app.main};
shift 1;
set -ex
clojure $CLOJURE_OPTIONS -A:dev -M -m $entrypoint "$@";

View file

@ -23,6 +23,7 @@
[app.db.sql :as sql] [app.db.sql :as sql]
[app.features.components-v2 :as feat.compv2] [app.features.components-v2 :as feat.compv2]
[app.features.fdata :as feat.fdata] [app.features.fdata :as feat.fdata]
[app.features.file-migrations :as feat.fmigr]
[app.loggers.audit :as-alias audit] [app.loggers.audit :as-alias audit]
[app.loggers.webhooks :as-alias webhooks] [app.loggers.webhooks :as-alias webhooks]
[app.storage :as sto] [app.storage :as sto]
@ -58,6 +59,7 @@
(def file-attrs (def file-attrs
#{:id #{:id
:name :name
:migrations
:features :features
:project-id :project-id
:is-shared :is-shared
@ -154,13 +156,17 @@
pointers, run migrations and return plain vanilla file map" pointers, run migrations and return plain vanilla file map"
[cfg {:keys [id] :as file}] [cfg {:keys [id] :as file}]
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)] (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)]
(-> (feat.fdata/resolve-file-data cfg file) (let [file (->> file
(feat.fmigr/resolve-applied-migrations cfg)
(feat.fdata/resolve-file-data cfg))]
(-> file
(update :features db/decode-pgarray #{}) (update :features db/decode-pgarray #{})
(update :data blob/decode) (update :data blob/decode)
(update :data feat.fdata/process-pointers deref) (update :data feat.fdata/process-pointers deref)
(update :data feat.fdata/process-objects (partial into {})) (update :data feat.fdata/process-objects (partial into {}))
(update :data assoc :id id) (update :data assoc :id id)
(fmg/migrate-file)))) (fmg/migrate-file)))))
(defn get-file (defn get-file
"Get file, resolve all features and apply migrations. "Get file, resolve all features and apply migrations.
@ -414,20 +420,9 @@
(db/exec-one! conn ["SET LOCAL idle_in_transaction_session_timeout = 0"]) (db/exec-one! conn ["SET LOCAL idle_in_transaction_session_timeout = 0"])
(db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"]))) (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])))
(defn- fix-version
[file]
(let [file (fmg/fix-version file)]
;; FIXME: We're temporarily activating all migrations because a
;; problem in the environments messed up with the version numbers
;; When this problem is fixed delete the following line
(if (> (:version file) 22)
(assoc file :version 22)
file)))
(defn process-file (defn process-file
[{:keys [id] :as file}] [{:keys [id] :as file}]
(-> file (-> file
(fix-version)
(update :data (fn [fdata] (update :data (fn [fdata]
(-> fdata (-> fdata
(assoc :id id) (assoc :id id)
@ -441,7 +436,7 @@
(update :colors relink-colors) (update :colors relink-colors)
(d/without-nils)))))) (d/without-nils))))))
(defn- encode-file (defn encode-file
[{:keys [::db/conn] :as cfg} {:keys [id] :as file}] [{:keys [::db/conn] :as cfg} {:keys [id] :as file}]
(let [file (if (contains? (:features file) "fdata/objects-map") (let [file (if (contains? (:features file) "fdata/objects-map")
(feat.fdata/enable-objects-map file) (feat.fdata/enable-objects-map file)
@ -458,7 +453,7 @@
(update :features db/encode-pgarray conn "text") (update :features db/encode-pgarray conn "text")
(update :data blob/encode)))) (update :data blob/encode))))
(defn- file->params (defn get-params-from-file
[file] [file]
(let [params {:has-media-trimmed (:has-media-trimmed file) (let [params {:has-media-trimmed (:has-media-trimmed file)
:ignore-sync-until (:ignore-sync-until file) :ignore-sync-until (:ignore-sync-until file)
@ -481,16 +476,17 @@
(defn insert-file! (defn insert-file!
"Insert a new file into the database table" "Insert a new file into the database table"
[{:keys [::db/conn] :as cfg} file] [{:keys [::db/conn] :as cfg} file & {:as opts}]
(feat.fmigr/upsert-migrations! conn file)
(let [params (-> (encode-file cfg file) (let [params (-> (encode-file cfg file)
(file->params))] (get-params-from-file))]
(db/insert! conn :file params {::db/return-keys true}))) (db/insert! conn :file params opts)))
(defn update-file! (defn update-file!
"Update an existing file on the database." "Update an existing file on the database."
[{:keys [::db/conn ::sto/storage] :as cfg} {:keys [id] :as file}] [{:keys [::db/conn ::sto/storage] :as cfg} {:keys [id] :as file} & {:as opts}]
(let [file (encode-file cfg file) (let [file (encode-file cfg file)
params (-> (file->params file) params (-> (get-params-from-file file)
(dissoc :id))] (dissoc :id))]
;; If file was already offloaded, we touch the underlying storage ;; If file was already offloaded, we touch the underlying storage
@ -498,12 +494,13 @@
(when (feat.fdata/offloaded? file) (when (feat.fdata/offloaded? file)
(some->> (:data-ref-id file) (sto/touch-object! storage))) (some->> (:data-ref-id file) (sto/touch-object! storage)))
(db/update! conn :file params {:id id} {::db/return-keys true}))) (feat.fmigr/upsert-migrations! conn file)
(db/update! conn :file params {:id id} opts)))
(defn save-file! (defn save-file!
"Applies all the final validations and perist the file, binfile "Applies all the final validations and perist the file, binfile
specific, should not be used outside of binfile domain" specific, should not be used outside of binfile domain"
[{:keys [::timestamp] :as cfg} file] [{:keys [::timestamp] :as cfg} file & {:as opts}]
(dm/assert! (dm/assert!
"expected valid timestamp" "expected valid timestamp"
@ -530,9 +527,9 @@
(when (ex/exception? result) (when (ex/exception? result)
(l/error :hint "file schema validation error" :cause result)))) (l/error :hint "file schema validation error" :cause result))))
(insert-file! cfg file))) (insert-file! cfg file opts)))
(defn register-pending-migrations (defn register-pending-migrations!
"All features that are enabled and requires explicit migration are "All features that are enabled and requires explicit migration are
added to the state for a posterior migration step." added to the state for a posterior migration step."
[cfg {:keys [id features] :as file}] [cfg {:keys [id features] :as file}]

View file

@ -561,7 +561,7 @@
(vswap! bfc/*state* update :pending-to-migrate (fnil conj []) [feature file-id'])) (vswap! bfc/*state* update :pending-to-migrate (fnil conj []) [feature file-id']))
(l/dbg :hint "create file" :id (str file-id') ::l/sync? true) (l/dbg :hint "create file" :id (str file-id') ::l/sync? true)
(bfc/save-file! system file) (bfc/save-file! system file ::db/return-keys false)
file-id')))) file-id'))))

View file

@ -297,7 +297,7 @@
(set/difference (:features file)))] (set/difference (:features file)))]
(vswap! bfc/*state* update :pending-to-migrate (fnil conj []) [feature (:id file)])) (vswap! bfc/*state* update :pending-to-migrate (fnil conj []) [feature (:id file)]))
(bfc/save-file! cfg file)) (bfc/save-file! cfg file ::db/return-keys false))
(doseq [thumbnail (read-seq cfg :file-object-thumbnail file-id)] (doseq [thumbnail (read-seq cfg :file-object-thumbnail file-id)]
(let [thumbnail (-> thumbnail (let [thumbnail (-> thumbnail

View file

@ -734,9 +734,9 @@
(dissoc :options) (dissoc :options)
(bfc/process-file))] (bfc/process-file))]
(->> file
(bfc/register-pending-migrations cfg) (bfc/register-pending-migrations! cfg file)
(bfc/save-file! cfg)) (bfc/save-file! cfg file ::db/return-keys false)
file-id'))) file-id')))

View file

@ -39,7 +39,10 @@
(defn insert-many (defn insert-many
[table cols rows opts] [table cols rows opts]
(let [opts (merge default-opts opts)] (let [opts (merge default-opts opts)
opts (cond-> opts
(::on-conflict-do-nothing opts)
(assoc :suffix "ON CONFLICT DO NOTHING"))]
(sql/for-insert-multi table cols rows opts))) (sql/for-insert-multi table cols rows opts)))
(defn select (defn select

View file

@ -1630,9 +1630,19 @@
fdata (migrate-graphics fdata)] fdata (migrate-graphics fdata)]
(update fdata :options assoc :components-v2 true))))) (update fdata :options assoc :components-v2 true)))))
;; FIXME: revisit this fn
(defn- fix-version*
[{:keys [version] :as file}]
(if (int? version)
file
(let [version (or (-> file :data :version) 0)]
(-> file
(assoc :version version)
(update :data dissoc :version)))))
(defn- fix-version (defn- fix-version
[file] [file]
(let [file (fmg/fix-version file)] (let [file (fix-version* file)]
(if (> (:version file) 22) (if (> (:version file) 22)
(assoc file :version 22) (assoc file :version 22)
file))) file)))

View file

@ -0,0 +1,39 @@
;; 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.features.file-migrations
"Backend specific code for file migrations. Implemented as permanent feature of files."
(:require
[app.common.data :as d]
[app.common.files.migrations :as fmg :refer [xf:map-name]]
[app.db :as db]
[app.db.sql :as-alias sql]))
(def ^:private sql:get-file-migrations
"SELECT name FROM file_migration WHERE file_id = ? ORDER BY created_at ASC")
(defn resolve-applied-migrations
[cfg {:keys [id] :as file}]
(let [conn (db/get-connection cfg)]
(assoc file :migrations
(->> (db/plan conn [sql:get-file-migrations id])
(transduce xf:map-name conj (d/ordered-set))
(not-empty)))))
(defn upsert-migrations!
"Persist or update file migrations. Return the updated/inserted number
of rows"
[conn {:keys [id] :as file}]
(let [migrations (or (-> file meta ::fmg/migrated)
(-> file :migrations not-empty)
fmg/available-migrations)
columns [:file-id :name]
rows (mapv (fn [name] [id name]) migrations)]
(-> (db/insert-many! conn :file-migration columns rows
{::db/return-keys false
::sql/on-conflict-do-nothing true})
(db/get-update-count))))

View file

@ -429,7 +429,13 @@
:fn (mg/resource "app/migrations/sql/0135-mod-team-invitation-table.sql")} :fn (mg/resource "app/migrations/sql/0135-mod-team-invitation-table.sql")}
{:name "0136-mod-comments-mentions.sql" {:name "0136-mod-comments-mentions.sql"
:fn (mg/resource "app/migrations/sql/0136-mod-comments-mentions.sql")}]) :fn (mg/resource "app/migrations/sql/0136-mod-comments-mentions.sql")}
{:name "0137-add-file-migration-table.sql"
:fn (mg/resource "app/migrations/sql/0137-add-file-migration-table.sql")}
{:name "0138-mod-file-data-fragment-table.sql"
:fn (mg/resource "app/migrations/sql/0138-mod-file-data-fragment-table.sql")}])
(defn apply-migrations! (defn apply-migrations!
[pool name migrations] [pool name migrations]

View file

@ -0,0 +1,7 @@
CREATE TABLE file_migration (
file_id uuid NOT NULL REFERENCES file(id) ON DELETE CASCADE DEFERRABLE INITIALLY DEFERRED,
name text NOT NULL,
created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
PRIMARY KEY(file_id, name)
);

View file

@ -0,0 +1,2 @@
ALTER TABLE file_data_fragment
ALTER CONSTRAINT file_data_fragment_file_id_fkey DEFERRABLE INITIALLY DEFERRED;

View file

@ -22,6 +22,7 @@
[app.db :as db] [app.db :as db]
[app.db.sql :as-alias sql] [app.db.sql :as-alias sql]
[app.features.fdata :as feat.fdata] [app.features.fdata :as feat.fdata]
[app.features.file-migrations :as feat.fmigr]
[app.loggers.audit :as-alias audit] [app.loggers.audit :as-alias audit]
[app.loggers.webhooks :as-alias webhooks] [app.loggers.webhooks :as-alias webhooks]
[app.rpc :as-alias rpc] [app.rpc :as-alias rpc]
@ -243,7 +244,8 @@
(when (contains? (:features file) "fdata/pointer-map") (when (contains? (:features file) "fdata/pointer-map")
(feat.fdata/persist-pointers! cfg id)) (feat.fdata/persist-pointers! cfg id))
file))) (feat.fmigr/upsert-migrations! conn file)
(feat.fmigr/resolve-applied-migrations cfg file))))
(defn get-file (defn get-file
[{:keys [::db/conn ::wrk/executor] :as cfg} id [{:keys [::db/conn ::wrk/executor] :as cfg} id
@ -264,6 +266,7 @@
{::db/check-deleted (not include-deleted?) {::db/check-deleted (not include-deleted?)
::db/remove-deleted (not include-deleted?) ::db/remove-deleted (not include-deleted?)
::sql/for-update lock-for-update?}) ::sql/for-update lock-for-update?})
(feat.fmigr/resolve-applied-migrations cfg)
(feat.fdata/resolve-file-data cfg)) (feat.fdata/resolve-file-data cfg))
;; NOTE: we perform the file decoding in a separate thread ;; NOTE: we perform the file decoding in a separate thread

View file

@ -6,13 +6,13 @@
(ns app.rpc.commands.files-create (ns app.rpc.commands.files-create
(:require (:require
[app.binfile.common :as bfc]
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.features :as cfeat] [app.common.features :as cfeat]
[app.common.schema :as sm] [app.common.schema :as sm]
[app.common.types.file :as ctf] [app.common.types.file :as ctf]
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.features.fdata :as feat.fdata]
[app.loggers.audit :as-alias audit] [app.loggers.audit :as-alias audit]
[app.loggers.webhooks :as-alias webhooks] [app.loggers.webhooks :as-alias webhooks]
[app.rpc :as-alias rpc] [app.rpc :as-alias rpc]
@ -21,7 +21,6 @@
[app.rpc.doc :as-alias doc] [app.rpc.doc :as-alias doc]
[app.rpc.permissions :as perms] [app.rpc.permissions :as perms]
[app.rpc.quotes :as quotes] [app.rpc.quotes :as quotes]
[app.util.blob :as blob]
[app.util.pointer-map :as pmap] [app.util.pointer-map :as pmap]
[app.util.services :as sv] [app.util.services :as sv]
[app.util.time :as dt] [app.util.time :as dt]
@ -59,23 +58,8 @@
:deleted-at deleted-at :deleted-at deleted-at
:create-page create-page :create-page create-page
:page-id page-id}) :page-id page-id})
file (-> (bfc/insert-file! cfg file)
file (if (contains? features "fdata/objects-map") (bfc/decode-row))]
(feat.fdata/enable-objects-map file)
file)
file (if (contains? features "fdata/pointer-map")
(feat.fdata/enable-pointer-map file)
file)]
(db/insert! conn :file
(-> file
(update :data blob/encode)
(update :features db/encode-pgarray conn "text"))
{::db/return-keys false})
(when (contains? features "fdata/pointer-map")
(feat.fdata/persist-pointers! cfg (:id file)))
(->> (assoc params :file-id (:id file) :role :owner) (->> (assoc params :file-id (:id file) :role :owner)
(create-file-role! conn)) (create-file-role! conn))

View file

@ -19,6 +19,7 @@
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.features.fdata :as feat.fdata] [app.features.fdata :as feat.fdata]
[app.features.file-migrations :as feat.fmigr]
[app.http.errors :as errors] [app.http.errors :as errors]
[app.loggers.audit :as audit] [app.loggers.audit :as audit]
[app.loggers.webhooks :as webhooks] [app.loggers.webhooks :as webhooks]
@ -204,37 +205,28 @@
{:keys [profile-id file features changes session-id skip-validate] :as params}] {:keys [profile-id file features changes session-id skip-validate] :as params}]
(let [;; Retrieve the file data (let [;; Retrieve the file data
file (feat.fmigr/resolve-applied-migrations cfg file)
file (feat.fdata/resolve-file-data cfg file) file (feat.fdata/resolve-file-data cfg file)
file (assoc file :features file (assoc file :features
(-> features (-> features
(set/difference cfeat/frontend-only-features) (set/difference cfeat/frontend-only-features)
(set/union (:features file)))) (set/union (:features file))))]
;; We create a new lexycal scope for clearly delimit the result of
;; executing this update file operation and all its side effects
(let [file (px/invoke! executor
(fn []
;; Process the file data on separated thread for avoid to do ;; Process the file data on separated thread for avoid to do
;; the CPU intensive operation on vthread. ;; the CPU intensive operation on vthread.
file (px/invoke! executor
(fn []
(binding [cfeat/*current* features (binding [cfeat/*current* features
cfeat/*previous* (:features file)] cfeat/*previous* (:features file)]
(update-file-data! cfg file (update-file-data! cfg file
process-changes-and-validate process-changes-and-validate
changes skip-validate))))] changes skip-validate))))]
(when (feat.fdata/offloaded? file) (feat.fmigr/upsert-migrations! conn file)
(let [storage (sto/resolve cfg ::db/reuse-conn true)]
(some->> (:data-ref-id file) (sto/touch-object! storage))))
(persist-file! cfg file) (persist-file! cfg file)
(let [params (assoc params :file file)
response {:revn (:revn file)
:lagged (get-lagged-changes conn params)}
features (db/create-array conn "text" (:features file))
deleted-at (if (::snapshot-data file)
(dt/plus timestamp (cf/get-deletion-delay))
(dt/plus timestamp (dt/duration {:hours 1})))]
;; Insert change (xlog) with deleted_at in a future data for ;; Insert change (xlog) with deleted_at in a future data for
;; make them automatically eleggible for GC once they expires ;; make them automatically eleggible for GC once they expires
(db/insert! conn :file-change (db/insert! conn :file-change
@ -243,19 +235,27 @@
:profile-id profile-id :profile-id profile-id
:created-at timestamp :created-at timestamp
:updated-at timestamp :updated-at timestamp
:deleted-at deleted-at :deleted-at (if (::snapshot-data file)
(dt/plus timestamp (cf/get-deletion-delay))
(dt/plus timestamp (dt/duration {:hours 1})))
:file-id (:id file) :file-id (:id file)
:revn (:revn file) :revn (:revn file)
:version (:version file) :version (:version file)
:features features :features (:features file)
:label (::snapshot-label file) :label (::snapshot-label file)
:data (::snapshot-data file) :data (::snapshot-data file)
:changes (blob/encode changes)} :changes (blob/encode changes)}
{::db/return-keys false}) {::db/return-keys false})
;; Send asynchronous notifications ;; Send asynchronous notifications
(send-notifications! cfg params) (send-notifications! cfg params file))
(when (feat.fdata/offloaded? file)
(let [storage (sto/resolve cfg ::db/reuse-conn true)]
(some->> (:data-ref-id file) (sto/touch-object! storage))))
(let [response {:revn (:revn file)
:lagged (get-lagged-changes conn params)}]
(vary-meta response assoc ::audit/replace-props (vary-meta response assoc ::audit/replace-props
{:id (:id file) {:id (:id file)
:name (:name file) :name (:name file)
@ -265,9 +265,10 @@
(defn update-file! (defn update-file!
"A public api that allows apply a transformation to a file with all context setup." "A public api that allows apply a transformation to a file with all context setup."
[cfg file-id update-fn & args] [{:keys [::db/conn] :as cfg} file-id update-fn & args]
(let [file (get-file cfg file-id) (let [file (get-file cfg file-id)
file (apply update-file-data! cfg file update-fn args)] file (apply update-file-data! cfg file update-fn args)]
(feat.fmigr/upsert-migrations! conn file)
(persist-file! cfg file))) (persist-file! cfg file)))
(def ^:private sql:get-file (def ^:private sql:get-file
@ -295,8 +296,7 @@
It also updates the project modified-at attr." It also updates the project modified-at attr."
[{:keys [::db/conn ::timestamp]} file] [{:keys [::db/conn ::timestamp]} file]
(let [features (db/create-array conn "text" (:features file)) (let [;; The timestamp can be nil because this function is also
;; The timestamp can be nil because this function is also
;; intended to be used outside of this module ;; intended to be used outside of this module
modified-at (or timestamp (dt/now))] modified-at (or timestamp (dt/now))]
@ -309,7 +309,7 @@
{:revn (:revn file) {:revn (:revn file)
:data (:data file) :data (:data file)
:version (:version file) :version (:version file)
:features features :features (:features file)
:data-backend nil :data-backend nil
:data-ref-id nil :data-ref-id nil
:modified-at modified-at :modified-at modified-at
@ -368,38 +368,16 @@
(-> file (-> file
(assoc ::snapshot-data snapshot) (assoc ::snapshot-data snapshot)
(assoc ::snapshot-label label))) (assoc ::snapshot-label label)))
file) file)]
file (cond-> file (bfc/encode-file cfg file))))
(contains? cfeat/*current* "fdata/objects-map")
(feat.fdata/enable-objects-map)
(contains? cfeat/*current* "fdata/pointer-map")
(feat.fdata/enable-pointer-map)
:always
(update :data blob/encode))]
(feat.fdata/persist-pointers! cfg id)
file)))
(defn- get-file-libraries (defn- get-file-libraries
"A helper for preload file libraries, mainly used for perform file "A helper for preload file libraries, mainly used for perform file
semantical and structural validation" semantical and structural validation"
[{:keys [::db/conn] :as cfg} file] [{:keys [::db/conn] :as cfg} file]
(->> (files/get-file-libraries conn (:id file)) (->> (files/get-file-libraries conn (:id file))
(into [file] (map (fn [{:keys [id]}] (into [file] (map #(bfc/get-file cfg (:id %))))
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)
pmap/*tracked* nil]
;; We do not resolve the objects maps here
;; because there is a lower probability that all
;; shapes needed to be loded into memory, so we
;; leeave it on lazy status
(-> (files/get-file cfg id :migrate? false)
(update :data feat.fdata/process-pointers deref) ; ensure all pointers resolved
(update :data feat.fdata/process-objects (partial into {}))
(fmg/migrate-file))))))
(d/index-by :id))) (d/index-by :id)))
(defn- soft-validate-file-schema! (defn- soft-validate-file-schema!
@ -494,7 +472,7 @@
(vec))) (vec)))
(defn- send-notifications! (defn- send-notifications!
[cfg {:keys [file team changes session-id] :as params}] [cfg {:keys [team changes session-id] :as params} file]
(let [lchanges (filter library-change? changes) (let [lchanges (filter library-change? changes)
msgbus (::mbus/msgbus cfg)] msgbus (::mbus/msgbus cfg)]

View file

@ -56,8 +56,8 @@
(vswap! bfc/*state* update :index bfc/update-index fmeds :id) (vswap! bfc/*state* update :index bfc/update-index fmeds :id)
;; Process and persist file ;; Process and persist file
(let [file (->> (bfc/process-file file) (let [file (bfc/process-file file)]
(bfc/save-file! cfg))] (bfc/insert-file! cfg file ::db/return-keys false)
;; The file profile creation is optional, so when no profile is ;; The file profile creation is optional, so when no profile is
;; present (when this function is called from profile less ;; present (when this function is called from profile less
@ -86,7 +86,7 @@
fmeds)] fmeds)]
(db/insert! conn :file-media-object params ::db/return-keys false)) (db/insert! conn :file-media-object params ::db/return-keys false))
(bfc/decode-file cfg file)))) file)))
(def ^:private (def ^:private
schema:duplicate-file schema:duplicate-file

View file

@ -210,7 +210,7 @@
([system i {:keys [profile-id project-id] :as params}] ([system i {:keys [profile-id project-id] :as params}]
(dm/assert! "expected uuid" (uuid? profile-id)) (dm/assert! "expected uuid" (uuid? profile-id))
(dm/assert! "expected uuid" (uuid? project-id)) (dm/assert! "expected uuid" (uuid? project-id))
(db/run! system (db/tx-run! system
(fn [system] (fn [system]
(let [features (cfeat/get-enabled-features cf/flags)] (let [features (cfeat/get-enabled-features cf/flags)]
(files.create/create-file system (files.create/create-file system

View file

@ -6,4 +6,7 @@
(ns app.common.files.defaults) (ns app.common.files.defaults)
;; DEPRECATED: this number should not be touched anymore, it is
;; conserved for backward compatibility with all the existing files,
;; but new files are using a new file migration tracking mechanism
(def version 67) (def version 67)

View file

@ -30,91 +30,88 @@
[app.common.types.shape :as cts] [app.common.types.shape :as cts]
[app.common.types.shape.shadow :as ctss] [app.common.types.shape.shadow :as ctss]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[clojure.set :as set]
[cuerdas.core :as str])) [cuerdas.core :as str]))
#?(:cljs (l/set-level! :info)) #?(:cljs (l/set-level! :info))
(declare ^:private migrations) (declare ^:private available-migrations)
(declare ^:private migration-up-index)
(declare ^:private migration-down-index)
(def version cfd/version) (def version cfd/version)
(defmulti migrate-data
"A reduce function that responsible to apply a migration identified by `id`."
(fn [_data id] id))
(defn need-migration? (defn need-migration?
[file] [file]
(or (nil? (:version file)) (or (nil? (:version file))
(not= cfd/version (:version file)))) (not= cfd/version (:version file))
(not= available-migrations (:migrations file))))
(defn- apply-migrations (def xf:map-name
[data migrations from-version] (map :name))
(loop [migrations migrations (defn migrate
data data] [{:keys [id] :as file}]
(if-let [[to-version migrate-fn] (first migrations)]
(let [migrate-fn (or migrate-fn identity)] (let [diff
(l/trc :hint "migrate file" (set/difference available-migrations (:migrations file))
:op (if (>= from-version to-version) "down" "up")
:file-id (str (:id data))
:version to-version)
(recur (rest migrations)
(migrate-fn data)))
data)))
(defn migrate-data
[data migrations from-version to-version]
(if (= from-version to-version)
data data
(let [migrations (if (< from-version to-version) (reduce migrate-data (:data file) diff)
(->> migrations
(drop-while #(<= (get % :id) from-version))
(take-while #(<= (get % :id) to-version))
(map (juxt :id :migrate-up)))
(->> (reverse migrations)
(drop-while #(> (get % :id) from-version))
(take-while #(> (get % :id) to-version))
(map (juxt :id :migrate-down))))]
(apply-migrations data migrations from-version))))
(defn fix-version data
"Fixes the file versioning numbering"
[{:keys [version] :as file}]
(if (int? version)
file
(let [version (or (-> file :data :version) 0)]
(-> file
(assoc :version version)
(update :data dissoc :version)))))
(defn migrate-file
[{:keys [id data features version] :as file}]
(binding [cfeat/*new* (atom #{})]
(let [version (or version (:version data))
file (-> file
(assoc :version cfd/version)
(update :data (fn [data]
(-> data (-> data
(assoc :id id) (assoc :id id)
(dissoc :version) (dissoc :version))]
(migrate-data migrations version cfd/version))))
(-> file
(assoc :data data)
(update :migrations set/union diff)
(vary-meta assoc ::migrated (not-empty diff)))))
(defn- generate-migrations-from-version
"A function that generates new format migration from the old,
version based migration system"
[version]
(let [xform (comp
(take-while #(<= % version))
(map #(str "legacy-" %))
(filter #(contains? available-migrations %)))
result (transduce xform conj (d/ordered-set) (range 1 65))]
result))
(defn migrate-file
[file]
(binding [cfeat/*new* (atom #{})]
(let [version (or (:version file)
(-> file :data :version))]
(-> file
(assoc :version cfd/version)
(update :migrations
(fn [migrations]
(if (nil? migrations)
(generate-migrations-from-version version)
migrations)))
(migrate)
(update :features (fnil into #{}) (deref cfeat/*new*)) (update :features (fnil into #{}) (deref cfeat/*new*))
;; NOTE: in some future we can consider to apply ;; NOTE: in some future we can consider to apply
;; a migration to the whole database and remove ;; a migration to the whole database and remove
;; this code from this function that executes on ;; this code from this function that executes on
;; each file migration operation ;; each file migration operation
(update :features cfeat/migrate-legacy-features))] (update :features cfeat/migrate-legacy-features)))))
(if (or (not= version (:version file))
(not= features (:features file)))
(vary-meta file assoc ::migrated true)
file))))
(defn migrated? (defn migrated?
[file] [file]
(true? (-> file meta ::migrated))) (boolean (-> file meta ::migrated)))
;; -- MIGRATIONS -- ;; -- MIGRATIONS --
(defn migrate-up-2 (defmethod migrate-data "legacy-2"
"Ensure that all :shape attributes on shapes are vectors" [data _]
[data]
(letfn [(update-object [object] (letfn [(update-object [object]
(d/update-when object :shapes (d/update-when object :shapes
(fn [shapes] (fn [shapes]
@ -126,9 +123,8 @@
(update data :pages-index update-vals update-page))) (update data :pages-index update-vals update-page)))
(defn migrate-up-3 (defmethod migrate-data "legacy-3"
"Changes paths formats" [data _]
[data]
(letfn [(migrate-path [shape] (letfn [(migrate-path [shape]
(if-not (contains? shape :content) (if-not (contains? shape :content)
(let [content (gsp/segments->content (:segments shape) (:close? shape)) (let [content (gsp/segments->content (:segments shape) (:close? shape))
@ -180,10 +176,10 @@
(update data :pages-index update-vals update-page))) (update data :pages-index update-vals update-page)))
(defn migrate-up-5 ;; Put the id of the local file in :component-file in instances of
"Put the id of the local file in :component-file in instances of ;; local components
local components" (defmethod migrate-data "legacy-5"
[data] [data _]
(letfn [(update-object [object] (letfn [(update-object [object]
(if (and (some? (:component-id object)) (if (and (some? (:component-id object))
(nil? (:component-file object))) (nil? (:component-file object)))
@ -195,9 +191,10 @@
(update data :pages-index update-vals update-page))) (update data :pages-index update-vals update-page)))
(defn migrate-up-6 ;; Fixes issues with selrect/points for shapes with width/height =
"Fixes issues with selrect/points for shapes with width/height = 0 (line-like paths)" ;; 0 (line-like paths)
[data] (defmethod migrate-data "legacy-6"
[data _]
(letfn [(fix-line-paths [shape] (letfn [(fix-line-paths [shape]
(if (= (:type shape) :path) (if (= (:type shape) :path)
(let [{:keys [width height]} (grc/points->rect (:points shape))] (let [{:keys [width height]} (grc/points->rect (:points shape))]
@ -221,9 +218,9 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-7 ;; Remove interactions pointing to deleted frames
"Remove interactions pointing to deleted frames" (defmethod migrate-data "legacy-7"
[data] [data _]
(letfn [(update-object [page object] (letfn [(update-object [page object]
(d/update-when object :interactions (d/update-when object :interactions
(fn [interactions] (fn [interactions]
@ -234,9 +231,9 @@
(update data :pages-index update-vals update-page))) (update data :pages-index update-vals update-page)))
(defn migrate-up-8 ;; Remove groups without any shape, both in pages and components
"Remove groups without any shape, both in pages and components" (defmethod migrate-data "legacy-8"
[data] [data _]
(letfn [(clean-parents [obj deleted?] (letfn [(clean-parents [obj deleted?]
(d/update-when obj :shapes (d/update-when obj :shapes
(fn [shapes] (fn [shapes]
@ -275,8 +272,8 @@
(update :pages-index update-vals clean-container) (update :pages-index update-vals clean-container)
(update :components update-vals clean-container)))) (update :components update-vals clean-container))))
(defn migrate-up-9 (defmethod migrate-data "legacy-9"
[data] [data _]
(letfn [(find-empty-groups [objects] (letfn [(find-empty-groups [objects]
(->> (vals objects) (->> (vals objects)
(filter (fn [shape] (filter (fn [shape]
@ -303,14 +300,14 @@
(recur (cpc/process-changes data changes)) (recur (cpc/process-changes data changes))
data))))) data)))))
(defn migrate-up-10 (defmethod migrate-data "legacy-10"
[data] [data _]
(letfn [(update-page [page] (letfn [(update-page [page]
(d/update-in-when page [:objects uuid/zero] dissoc :points :selrect))] (d/update-in-when page [:objects uuid/zero] dissoc :points :selrect))]
(update data :pages-index update-vals update-page))) (update data :pages-index update-vals update-page)))
(defn migrate-up-11 (defmethod migrate-data "legacy-11"
[data] [data _]
(letfn [(update-object [objects shape] (letfn [(update-object [objects shape]
(if (cfh/frame-shape? shape) (if (cfh/frame-shape? shape)
(d/update-when shape :shapes (fn [shapes] (d/update-when shape :shapes (fn [shapes]
@ -323,8 +320,8 @@
(update data :pages-index update-vals update-page))) (update data :pages-index update-vals update-page)))
(defn migrate-up-12 (defmethod migrate-data "legacy-12"
[data] [data _]
(letfn [(update-grid [grid] (letfn [(update-grid [grid]
(cond-> grid (cond-> grid
(= :auto (:size grid)) (= :auto (:size grid))
@ -335,9 +332,9 @@
(update data :pages-index update-vals update-page))) (update data :pages-index update-vals update-page)))
(defn migrate-up-13 ;; Add rx and ry to images
"Add rx and ry to images" (defmethod migrate-data "legacy-13"
[data] [data _]
(letfn [(fix-radius [shape] (letfn [(fix-radius [shape]
(if-not (or (contains? shape :rx) (contains? shape :r1)) (if-not (or (contains? shape :rx) (contains? shape :r1))
(-> shape (-> shape
@ -355,8 +352,8 @@
(update data :pages-index update-vals update-page))) (update data :pages-index update-vals update-page)))
(defn migrate-up-14 (defmethod migrate-data "legacy-14"
[data] [data _]
(letfn [(process-shape [shape] (letfn [(process-shape [shape]
(let [fill-color (str/upper (:fill-color shape)) (let [fill-color (str/upper (:fill-color shape))
fill-opacity (:fill-opacity shape)] fill-opacity (:fill-opacity shape)]
@ -386,9 +383,8 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-16 (defmethod migrate-data "legacy-16"
"Add fills and strokes" [data _]
[data]
(letfn [(assign-fills [shape] (letfn [(assign-fills [shape]
(let [attrs {:fill-color (:fill-color shape) (let [attrs {:fill-color (:fill-color shape)
:fill-color-gradient (:fill-color-gradient shape) :fill-color-gradient (:fill-color-gradient shape)
@ -433,8 +429,8 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-17 (defmethod migrate-data "legacy-17"
[data] [data _]
(letfn [(affected-object? [object] (letfn [(affected-object? [object]
(and (cfh/image-shape? object) (and (cfh/image-shape? object)
(some? (:fills object)) (some? (:fills object))
@ -462,9 +458,9 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-18 ;; Remove position-data to solve a bug with the text positioning
"Remove position-data to solve a bug with the text positioning" (defmethod migrate-data "legacy-18"
[data] [data _]
(letfn [(update-object [object] (letfn [(update-object [object]
(cond-> object (cond-> object
(cfh/text-shape? object) (cfh/text-shape? object)
@ -477,8 +473,8 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-19 (defmethod migrate-data "legacy-19"
[data] [data _]
(letfn [(update-object [object] (letfn [(update-object [object]
(cond-> object (cond-> object
(and (cfh/text-shape? object) (and (cfh/text-shape? object)
@ -493,8 +489,8 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-25 (defmethod migrate-data "legacy-25"
[data] [data _]
(some-> cfeat/*new* (swap! conj "fdata/shape-data-type")) (some-> cfeat/*new* (swap! conj "fdata/shape-data-type"))
(letfn [(update-object [object] (letfn [(update-object [object]
(if (cfh/root? object) (if (cfh/root? object)
@ -508,8 +504,8 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-26 (defmethod migrate-data "legacy-26"
[data] [data _]
(letfn [(update-object [object] (letfn [(update-object [object]
(cond-> object (cond-> object
(nil? (:transform object)) (nil? (:transform object))
@ -525,8 +521,8 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-27 (defmethod migrate-data "legacy-27"
[data] [data _]
(letfn [(update-object [object] (letfn [(update-object [object]
(cond-> object (cond-> object
(contains? object :main-instance?) (contains? object :main-instance?)
@ -556,8 +552,8 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-28 (defmethod migrate-data "legacy-28"
[data] [data _]
(letfn [(update-object [objects object] (letfn [(update-object [objects object]
(let [frame-id (:frame-id object) (let [frame-id (:frame-id object)
calculated-frame-id calculated-frame-id
@ -582,8 +578,8 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-29 (defmethod migrate-data "legacy-29"
[data] [data _]
(letfn [(valid-ref? [ref] (letfn [(valid-ref? [ref]
(or (uuid? ref) (or (uuid? ref)
(nil? ref))) (nil? ref)))
@ -617,8 +613,8 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-31 (defmethod migrate-data "legacy-31"
[data] [data _]
(letfn [(update-object [object] (letfn [(update-object [object]
(cond-> object (cond-> object
(contains? object :use-for-thumbnail?) (contains? object :use-for-thumbnail?)
@ -631,8 +627,8 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-32 (defmethod migrate-data "legacy-32"
[data] [data _]
(some-> cfeat/*new* (swap! conj "fdata/shape-data-type")) (some-> cfeat/*new* (swap! conj "fdata/shape-data-type"))
(letfn [(update-object [object] (letfn [(update-object [object]
(as-> object object (as-> object object
@ -650,8 +646,8 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-33 (defmethod migrate-data "legacy-33"
[data] [data _]
(letfn [(update-object [object] (letfn [(update-object [object]
;; Ensure all root objects are well formed shapes. ;; Ensure all root objects are well formed shapes.
(if (= (:id object) uuid/zero) (if (= (:id object) uuid/zero)
@ -670,8 +666,8 @@
(-> data (-> data
(update :pages-index update-vals update-container)))) (update :pages-index update-vals update-container))))
(defn migrate-up-34 (defmethod migrate-data "legacy-34"
[data] [data _]
(letfn [(update-object [object] (letfn [(update-object [object]
(if (or (cfh/path-shape? object) (if (or (cfh/path-shape? object)
(cfh/bool-shape? object)) (cfh/bool-shape? object))
@ -683,8 +679,8 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-36 (defmethod migrate-data "legacy-36"
[data] [data _]
(letfn [(update-container [container] (letfn [(update-container [container]
(d/update-when container :objects (fn [objects] (d/update-when container :objects (fn [objects]
(if (contains? objects nil) (if (contains? objects nil)
@ -694,13 +690,12 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-37 (defmethod migrate-data "legacy-37"
"Clean nil values on data" [data _]
[data]
(d/without-nils data)) (d/without-nils data))
(defn migrate-up-38 (defmethod migrate-data "legacy-38"
[data] [data _]
(letfn [(fix-gradient [{:keys [type] :as gradient}] (letfn [(fix-gradient [{:keys [type] :as gradient}]
(if (string? type) (if (string? type)
(assoc gradient :type (keyword type)) (assoc gradient :type (keyword type))
@ -727,8 +722,8 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-39 (defmethod migrate-data "legacy-39"
[data] [data _]
(letfn [(update-shape [shape] (letfn [(update-shape [shape]
(cond (cond
(and (cfh/bool-shape? shape) (and (cfh/bool-shape? shape)
@ -749,8 +744,8 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-40 (defmethod migrate-data "legacy-40"
[data] [data _]
(letfn [(update-shape [{:keys [content shapes] :as shape}] (letfn [(update-shape [{:keys [content shapes] :as shape}]
;; Fix frame shape that in reallity is a path shape ;; Fix frame shape that in reallity is a path shape
(if (and (cfh/frame-shape? shape) (if (and (cfh/frame-shape? shape)
@ -773,8 +768,8 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-41 (defmethod migrate-data "legacy-41"
[data] [data _]
(letfn [(update-shape [shape] (letfn [(update-shape [shape]
(cond (cond
(or (cfh/bool-shape? shape) (or (cfh/bool-shape? shape)
@ -806,8 +801,8 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-42 (defmethod migrate-data "legacy-42"
[data] [data _]
(letfn [(update-object [object] (letfn [(update-object [object]
(if (and (or (cfh/frame-shape? object) (if (and (or (cfh/frame-shape? object)
(cfh/group-shape? object) (cfh/group-shape? object)
@ -826,8 +821,8 @@
(def ^:private valid-fill? (def ^:private valid-fill?
(sm/lazy-validator ::cts/fill)) (sm/lazy-validator ::cts/fill))
(defn migrate-up-43 (defmethod migrate-data "legacy-43"
[data] [data _]
(letfn [(number->string [v] (letfn [(number->string [v]
(if (number? v) (if (number? v)
(str v) (str v)
@ -855,8 +850,8 @@
(def ^:private valid-shadow? (def ^:private valid-shadow?
(sm/lazy-validator ::ctss/shadow)) (sm/lazy-validator ::ctss/shadow))
(defn migrate-up-44 (defmethod migrate-data "legacy-44"
[data] [data _]
(letfn [(fix-shadow [shadow] (letfn [(fix-shadow [shadow]
(let [color (if (string? (:color shadow)) (let [color (if (string? (:color shadow))
{:color (:color shadow) {:color (:color shadow)
@ -875,8 +870,8 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-45 (defmethod migrate-data "legacy-45"
[data] [data _]
(letfn [(fix-shape [shape] (letfn [(fix-shape [shape]
(let [frame-id (or (:frame-id shape) (let [frame-id (or (:frame-id shape)
uuid/zero) uuid/zero)
@ -890,8 +885,8 @@
(-> data (-> data
(update :pages-index update-vals update-container)))) (update :pages-index update-vals update-container))))
(defn migrate-up-46 (defmethod migrate-data "legacy-46"
[data] [data _]
(letfn [(update-object [object] (letfn [(update-object [object]
(dissoc object :thumbnail)) (dissoc object :thumbnail))
@ -901,8 +896,8 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-47 (defmethod migrate-data "legacy-47"
[data] [data _]
(letfn [(fix-shape [page shape] (letfn [(fix-shape [page shape]
(let [file {:id (:id data) :data data} (let [file {:id (:id data) :data data}
component-file (:component-file shape) component-file (:component-file shape)
@ -924,8 +919,8 @@
(-> data (-> data
(update :pages-index update-vals update-page)))) (update :pages-index update-vals update-page))))
(defn migrate-up-48 (defmethod migrate-data "legacy-48"
[data] [data _]
(letfn [(fix-shape [shape] (letfn [(fix-shape [shape]
(let [swap-slot (ctk/get-swap-slot shape)] (let [swap-slot (ctk/get-swap-slot shape)]
(if (and (some? swap-slot) (if (and (some? swap-slot)
@ -938,9 +933,9 @@
(-> data (-> data
(update :pages-index update-vals update-page)))) (update :pages-index update-vals update-page))))
(defn migrate-up-49 ;; Remove hide-in-viewer for shapes that are origin or destination of an interaction
"Remove hide-in-viewer for shapes that are origin or destination of an interaction" (defmethod migrate-data "legacy-49"
[data] [data _]
(letfn [(update-object [destinations object] (letfn [(update-object [destinations object]
(cond-> object (cond-> object
(or (:interactions object) (or (:interactions object)
@ -958,13 +953,13 @@
(update data :pages-index update-vals update-page))) (update data :pages-index update-vals update-page)))
(defn migrate-up-50 ;; This migration mainly fixes paths with curve-to segments
"This migration mainly fixes paths with curve-to segments ;; without :c1x :c1y :c2x :c2y properties. Additionally, we found a
without :c1x :c1y :c2x :c2y properties. Additionally, we found a ;; case where the params instead to be plain hash-map, is a points
case where the params instead to be plain hash-map, is a points ;; instance. This migration normalizes all params to plain map.
instance. This migration normalizes all params to plain map."
[data] (defmethod migrate-data "legacy-50"
[data _]
(let [update-segment (let [update-segment
(fn [{:keys [command params] :as segment}] (fn [{:keys [command params] :as segment}]
(let [params (into {} params) (let [params (into {} params)
@ -1008,17 +1003,15 @@
(def ^:private valid-color? (def ^:private valid-color?
(sm/lazy-validator ::ctc/color)) (sm/lazy-validator ::ctc/color))
(defn migrate-up-51 (defmethod migrate-data "legacy-51"
"This migration fixes library invalid colors" [data _]
[data]
(let [update-colors (let [update-colors
(fn [colors] (fn [colors]
(into {} (filter #(-> % val valid-color?) colors)))] (into {} (filter #(-> % val valid-color?) colors)))]
(update data :colors update-colors))) (update data :colors update-colors)))
(defn migrate-up-52 (defmethod migrate-data "legacy-52"
"Fixes incorrect value on `layout-wrap-type` prop" [data _]
[data]
(letfn [(update-shape [shape] (letfn [(update-shape [shape]
(if (= :no-wrap (:layout-wrap-type shape)) (if (= :no-wrap (:layout-wrap-type shape))
(assoc shape :layout-wrap-type :nowrap) (assoc shape :layout-wrap-type :nowrap)
@ -1029,10 +1022,15 @@
(update data :pages-index update-vals update-page))) (update data :pages-index update-vals update-page)))
(defn migrate-up-54
"Fixes shapes with invalid colors in shadow: it first tries a non (defmethod migrate-data "legacy-53"
destructive fix, and if it is not possible, then, shadow is removed" [data _]
[data] (migrate-data data "legacy-26"))
;; Fixes shapes with invalid colors in shadow: it first tries a non
;; destructive fix, and if it is not possible, then, shadow is removed
(defmethod migrate-data "legacy-54"
[data _]
(letfn [(fix-shadow [shadow] (letfn [(fix-shadow [shadow]
(update shadow :color d/without-nils)) (update shadow :color d/without-nils))
@ -1048,9 +1046,9 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-55 ;; This migration moves page options to the page level
"This migration moves page options to the page level" (defmethod migrate-data "legacy-55"
[data] [data _]
(let [update-page (let [update-page
(fn [{:keys [options] :as page}] (fn [{:keys [options] :as page}]
(cond-> page (cond-> page
@ -1077,8 +1075,8 @@
(update data :pages-index d/update-vals update-page))) (update data :pages-index d/update-vals update-page)))
(defn migrate-up-56 (defmethod migrate-data "legacy-56"
[data] [data _]
(letfn [(fix-fills [object] (letfn [(fix-fills [object]
(d/update-when object :fills (partial filterv valid-fill?))) (d/update-when object :fills (partial filterv valid-fill?)))
@ -1105,8 +1103,8 @@
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-57 (defmethod migrate-data "legacy-57"
[data] [data _]
(letfn [(fix-thread-positions [positions] (letfn [(fix-thread-positions [positions]
(reduce-kv (fn [result id {:keys [position] :as data}] (reduce-kv (fn [result id {:keys [position] :as data}]
(let [data (cond (let [data (cond
@ -1131,8 +1129,8 @@
(update :pages-index dissoc nil) (update :pages-index dissoc nil)
(update :pages-index update-vals update-page)))) (update :pages-index update-vals update-page))))
(defn migrate-up-59 (defmethod migrate-data "legacy-59"
[data] [data _]
(letfn [(fix-touched [elem] (letfn [(fix-touched [elem]
(cond-> elem (string? elem) keyword)) (cond-> elem (string? elem) keyword))
@ -1146,8 +1144,8 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-62 (defmethod migrate-data "legacy-62"
[data] [data _]
(let [xform-cycles-ids (let [xform-cycles-ids
(comp (filter #(= (:id %) (:shape-ref %))) (comp (filter #(= (:id %) (:shape-ref %)))
(map :id)) (map :id))
@ -1179,8 +1177,8 @@
(update data :components update-vals update-component))) (update data :components update-vals update-component)))
(defn migrate-up-65 (defmethod migrate-data "legacy-65"
[data] [data _]
(let [update-object (let [update-object
(fn [object] (fn [object]
(d/update-when object :plugin-data d/without-nils)) (d/update-when object :plugin-data d/without-nils))
@ -1197,8 +1195,8 @@
(d/update-when :typographies update-vals update-object) (d/update-when :typographies update-vals update-object)
(d/update-when :components update-vals update-object)))) (d/update-when :components update-vals update-object))))
(defn migrate-up-66 (defmethod migrate-data "legacy-66"
[data] [data _]
(letfn [(update-object [object] (letfn [(update-object [object]
(if (and (:rx object) (not (:r1 object))) (if (and (:rx object) (not (:r1 object)))
(-> object (-> object
@ -1215,8 +1213,8 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(defn migrate-up-67 (defmethod migrate-data "legacy-67"
[data] [data _]
(letfn [(update-object [object] (letfn [(update-object [object]
(d/update-when object :shadow #(into [] (reverse %)))) (d/update-when object :shadow #(into [] (reverse %))))
@ -1227,57 +1225,57 @@
(update :pages-index update-vals update-container) (update :pages-index update-vals update-container)
(update :components update-vals update-container)))) (update :components update-vals update-container))))
(def migrations (def available-migrations
"A vector of all applicable migrations" (into (d/ordered-set)
[{:id 2 :migrate-up migrate-up-2} ["legacy-2"
{:id 3 :migrate-up migrate-up-3} "legacy-3"
{:id 5 :migrate-up migrate-up-5} "legacy-5"
{:id 6 :migrate-up migrate-up-6} "legacy-6"
{:id 7 :migrate-up migrate-up-7} "legacy-7"
{:id 8 :migrate-up migrate-up-8} "legacy-8"
{:id 9 :migrate-up migrate-up-9} "legacy-9"
{:id 10 :migrate-up migrate-up-10} "legacy-10"
{:id 11 :migrate-up migrate-up-11} "legacy-11"
{:id 12 :migrate-up migrate-up-12} "legacy-12"
{:id 13 :migrate-up migrate-up-13} "legacy-13"
{:id 14 :migrate-up migrate-up-14} "legacy-14"
{:id 16 :migrate-up migrate-up-16} "legacy-16"
{:id 17 :migrate-up migrate-up-17} "legacy-17"
{:id 18 :migrate-up migrate-up-18} "legacy-18"
{:id 19 :migrate-up migrate-up-19} "legacy-19"
{:id 25 :migrate-up migrate-up-25} "legacy-25"
{:id 26 :migrate-up migrate-up-26} "legacy-26"
{:id 27 :migrate-up migrate-up-27} "legacy-27"
{:id 28 :migrate-up migrate-up-28} "legacy-28"
{:id 29 :migrate-up migrate-up-29} "legacy-29"
{:id 31 :migrate-up migrate-up-31} "legacy-31"
{:id 32 :migrate-up migrate-up-32} "legacy-32"
{:id 33 :migrate-up migrate-up-33} "legacy-33"
{:id 34 :migrate-up migrate-up-34} "legacy-34"
{:id 36 :migrate-up migrate-up-36} "legacy-36"
{:id 37 :migrate-up migrate-up-37} "legacy-37"
{:id 38 :migrate-up migrate-up-38} "legacy-38"
{:id 39 :migrate-up migrate-up-39} "legacy-39"
{:id 40 :migrate-up migrate-up-40} "legacy-40"
{:id 41 :migrate-up migrate-up-41} "legacy-41"
{:id 42 :migrate-up migrate-up-42} "legacy-42"
{:id 43 :migrate-up migrate-up-43} "legacy-43"
{:id 44 :migrate-up migrate-up-44} "legacy-44"
{:id 45 :migrate-up migrate-up-45} "legacy-45"
{:id 46 :migrate-up migrate-up-46} "legacy-46"
{:id 47 :migrate-up migrate-up-47} "legacy-47"
{:id 48 :migrate-up migrate-up-48} "legacy-48"
{:id 49 :migrate-up migrate-up-49} "legacy-49"
{:id 50 :migrate-up migrate-up-50} "legacy-50"
{:id 51 :migrate-up migrate-up-51} "legacy-51"
{:id 52 :migrate-up migrate-up-52} "legacy-52"
{:id 53 :migrate-up migrate-up-26} "legacy-53"
{:id 54 :migrate-up migrate-up-54} "legacy-54"
{:id 55 :migrate-up migrate-up-55} "legacy-55"
{:id 56 :migrate-up migrate-up-56} "legacy-56"
{:id 57 :migrate-up migrate-up-57} "legacy-57"
{:id 59 :migrate-up migrate-up-59} "legacy-59"
{:id 62 :migrate-up migrate-up-62} "legacy-62"
{:id 65 :migrate-up migrate-up-65} "legacy-65"
{:id 66 :migrate-up migrate-up-66} "legacy-66"
{:id 67 :migrate-up migrate-up-67}]) "legacy-67"]))

View file

@ -92,7 +92,9 @@
[:is-shared {:optional true} ::sm/boolean] [:is-shared {:optional true} ::sm/boolean]
[:data {:optional true} schema:data] [:data {:optional true} schema:data]
[:version :int] [:version :int]
[:features ::cfeat/features]]) [:features ::cfeat/features]
[:migrations {:optional true}
[::sm/set :string]]])
(sm/register! ::data schema:data) (sm/register! ::data schema:data)
(sm/register! ::file schema:file) (sm/register! ::file schema:file)

View file

@ -9,105 +9,18 @@
[app.common.data :as d] [app.common.data :as d]
[app.common.files.migrations :as cfm] [app.common.files.migrations :as cfm]
[app.common.pprint :as pp] [app.common.pprint :as pp]
[app.common.uuid :as uuid]
[clojure.test :as t])) [clojure.test :as t]))
(t/deftest test-generic-migration-subsystem-1 (defmethod cfm/migrate-data "test/1" [data _] (update data :sum inc))
(let [migrations [{:id 1 :migrate-up (comp inc inc) :migrate-down (comp dec dec)} (defmethod cfm/migrate-data "test/2" [data _] (update data :sum inc))
{:id 2 :migrate-up (comp inc inc) :migrate-down (comp dec dec)} (defmethod cfm/migrate-data "test/3" [data _] (update data :sum inc))
{:id 3 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
{:id 4 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
{:id 5 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
{:id 6 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
{:id 7 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
{:id 8 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
{:id 9 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
{:id 10 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
{:id 11 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
{:id 12 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
{:id 13 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}]]
(t/testing "migrate up 1" (t/deftest generic-migration-subsystem-1
(let [result (cfm/migrate-data 0 migrations 0 2)] (let [migrations (into (d/ordered-set) ["test/1" "test/2" "test/3"])]
(t/is (= result 4)))) (with-redefs [cfm/available-migrations migrations]
(let [file {:data {:sum 1}
(t/testing "migrate up 2" :id 1
(let [result (cfm/migrate-data 0 migrations 0 20)] :migrations (d/ordered-set "test/1")}
(t/is (= result 26)))) file' (cfm/migrate file)]
(t/is (= cfm/available-migrations (:migrations file')))
(t/testing "migrate down 1" (t/is (= 3 (:sum (:data file'))))))))
(let [result (cfm/migrate-data 12 migrations 6 3)]
(t/is (= result 6))))
(t/testing "migrate down 2"
(let [result (cfm/migrate-data 12 migrations 6 0)]
(t/is (= result 0))))))
(t/deftest test-migration-8-1
(let [page-id (uuid/custom 0 0)
objects [{:type :rect :id (uuid/custom 1 0)}
{:type :group
:id (uuid/custom 1 1)
:selrect {}
:shapes [(uuid/custom 1 2) (uuid/custom 1 0)]}
{:type :group
:id (uuid/custom 1 2)
:selrect {}
:shapes [(uuid/custom 1 3)]}
{:type :group
:id (uuid/custom 1 3)
:selrect {}
:shapes [(uuid/custom 1 4)]}
{:type :group
:id (uuid/custom 1 4)
:selrect {}
:shapes [(uuid/custom 1 5)]}
{:type :path :id (uuid/custom 1 5)}]
data {:pages-index {page-id {:objects (d/index-by :id objects)}}
:components {}}
res (cfm/migrate-data data cfm/migrations 7 8)]
(t/is (= data res))))
(t/deftest test-migration-8-2
(let [page-id (uuid/custom 0 0)
objects [{:type :rect :id (uuid/custom 1 0)}
{:type :group
:id (uuid/custom 1 1)
:selrect {}
:shapes [(uuid/custom 1 2) (uuid/custom 1 0)]}
{:type :group
:id (uuid/custom 1 2)
:selrect {}
:shapes [(uuid/custom 1 3)]}
{:type :group
:id (uuid/custom 1 3)
:selrect {}
:shapes [(uuid/custom 1 4)]}
{:type :group
:id (uuid/custom 1 4)
:selrect {}
:shapes []}
{:type :path :id (uuid/custom 1 5)}]
data {:pages-index {page-id {:objects (d/index-by :id objects)}}
:components {}}
expect (-> data
(update-in [:pages-index page-id :objects] dissoc
(uuid/custom 1 2)
(uuid/custom 1 3)
(uuid/custom 1 4))
(update-in [:pages-index page-id :objects (uuid/custom 1 1) :shapes]
(fn [shapes]
(let [id (uuid/custom 1 2)]
(into [] (remove #(= id %)) shapes)))))
res (cfm/migrate-data data cfm/migrations 7 8)]
;; (pprint res)
;; (pprint expect)
(t/is (= expect res))))