♻️ Refactor file data migrations subsystem (#5692)

* ♻️ Refactor file data migrations subsystem

* 📎 Add backend scripts/run helper script

backend/scripts/run

@@ -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 "$@";

backend/src/app/binfile/common.clj

@@ -23,6 +23,7 @@
    [app.db.sql :as sql]
    [app.features.components-v2 :as feat.compv2]
    [app.features.fdata :as feat.fdata]
+   [app.features.file-migrations :as feat.fmigr]
    [app.loggers.audit :as-alias audit]
    [app.loggers.webhooks :as-alias webhooks]
    [app.storage :as sto]
@@ -58,6 +59,7 @@
 (def file-attrs
   #{:id
     :name
+    :migrations
     :features
     :project-id
     :is-shared
@@ -154,13 +156,17 @@
   pointers, run migrations and return plain vanilla file map"
   [cfg {:keys [id] :as file}]
   (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)]
-    (-> (feat.fdata/resolve-file-data cfg file)
-        (update :features db/decode-pgarray #{})
-        (update :data blob/decode)
-        (update :data feat.fdata/process-pointers deref)
-        (update :data feat.fdata/process-objects (partial into {}))
-        (update :data assoc :id id)
-        (fmg/migrate-file))))
+    (let [file (->> file
+                    (feat.fmigr/resolve-applied-migrations cfg)
+                    (feat.fdata/resolve-file-data cfg))]
+
+      (-> file
+          (update :features db/decode-pgarray #{})
+          (update :data blob/decode)
+          (update :data feat.fdata/process-pointers deref)
+          (update :data feat.fdata/process-objects (partial into {}))
+          (update :data assoc :id id)
+          (fmg/migrate-file)))))
 
 (defn get-file
   "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 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
   [{:keys [id] :as file}]
   (-> file
-      (fix-version)
       (update :data (fn [fdata]
                       (-> fdata
                           (assoc :id id)
@@ -441,7 +436,7 @@
                           (update :colors relink-colors)
                           (d/without-nils))))))
 
-(defn- encode-file
+(defn encode-file
   [{:keys [::db/conn] :as cfg} {:keys [id] :as file}]
   (let [file (if (contains? (:features file) "fdata/objects-map")
                (feat.fdata/enable-objects-map file)
@@ -458,7 +453,7 @@
         (update :features db/encode-pgarray conn "text")
         (update :data blob/encode))))
 
-(defn- file->params
+(defn get-params-from-file
   [file]
   (let [params {:has-media-trimmed (:has-media-trimmed file)
                 :ignore-sync-until (:ignore-sync-until file)
@@ -481,16 +476,17 @@
 
 (defn insert-file!
   "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)
-                   (file->params))]
-    (db/insert! conn :file params {::db/return-keys true})))
+                   (get-params-from-file))]
+    (db/insert! conn :file params opts)))
 
 (defn update-file!
   "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)
-        params (-> (file->params file)
+        params (-> (get-params-from-file file)
                    (dissoc :id))]
 
     ;; If file was already offloaded, we touch the underlying storage
@@ -498,12 +494,13 @@
     (when (feat.fdata/offloaded? file)
       (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!
   "Applies all the final validations and perist the file, binfile
   specific, should not be used outside of binfile domain"
-  [{:keys [::timestamp] :as cfg} file]
+  [{:keys [::timestamp] :as cfg} file & {:as opts}]
 
   (dm/assert!
    "expected valid timestamp"
@@ -530,9 +527,9 @@
         (when (ex/exception? 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
   added to the state for a posterior migration step."
   [cfg {:keys [id features] :as file}]

backend/src/app/binfile/v1.clj

@@ -561,7 +561,7 @@
           (vswap! bfc/*state* update :pending-to-migrate (fnil conj []) [feature file-id']))
 
         (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'))))
 

backend/src/app/binfile/v2.clj

@@ -297,7 +297,7 @@
                         (set/difference (:features 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)]
     (let [thumbnail (-> thumbnail

backend/src/app/binfile/v3.clj

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

backend/src/app/db/sql.clj

@@ -39,7 +39,10 @@
 
 (defn insert-many
   [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)))
 
 (defn select

backend/src/app/features/components_v2.clj

@@ -1630,9 +1630,19 @@
             fdata (migrate-graphics fdata)]
         (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
   [file]
-  (let [file (fmg/fix-version file)]
+  (let [file (fix-version* file)]
     (if (> (:version file) 22)
       (assoc file :version 22)
       file)))

backend/src/app/features/file_migrations.clj

@@ -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))))

backend/src/app/migrations.clj

@@ -429,7 +429,13 @@
     :fn (mg/resource "app/migrations/sql/0135-mod-team-invitation-table.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!
   [pool name migrations]

backend/src/app/migrations/sql/0137-add-file-migration-table.sql

@@ -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)
+);

backend/src/app/migrations/sql/0138-mod-file-data-fragment-table.sql

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

backend/src/app/rpc/commands/files.clj

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

backend/src/app/rpc/commands/files_create.clj

@@ -6,13 +6,13 @@
 
 (ns app.rpc.commands.files-create
   (:require
+   [app.binfile.common :as bfc]
    [app.common.data.macros :as dm]
    [app.common.features :as cfeat]
    [app.common.schema :as sm]
    [app.common.types.file :as ctf]
    [app.config :as cf]
    [app.db :as db]
-   [app.features.fdata :as feat.fdata]
    [app.loggers.audit :as-alias audit]
    [app.loggers.webhooks :as-alias webhooks]
    [app.rpc :as-alias rpc]
@@ -21,7 +21,6 @@
    [app.rpc.doc :as-alias doc]
    [app.rpc.permissions :as perms]
    [app.rpc.quotes :as quotes]
-   [app.util.blob :as blob]
    [app.util.pointer-map :as pmap]
    [app.util.services :as sv]
    [app.util.time :as dt]
@@ -48,34 +47,19 @@
 
   (binding [pmap/*tracked* (pmap/create-tracked)
             cfeat/*current* features]
-    (let [file     (ctf/make-file {:id id
-                                   :project-id project-id
-                                   :name name
-                                   :revn revn
-                                   :is-shared is-shared
-                                   :features features
-                                   :ignore-sync-until ignore-sync-until
-                                   :modified-at modified-at
-                                   :deleted-at deleted-at
-                                   :create-page create-page
-                                   :page-id page-id})
-
-          file     (if (contains? features "fdata/objects-map")
-                     (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)))
+    (let [file (ctf/make-file {:id id
+                               :project-id project-id
+                               :name name
+                               :revn revn
+                               :is-shared is-shared
+                               :features features
+                               :ignore-sync-until ignore-sync-until
+                               :modified-at modified-at
+                               :deleted-at deleted-at
+                               :create-page create-page
+                               :page-id page-id})
+          file (-> (bfc/insert-file! cfg file)
+                   (bfc/decode-row))]
 
       (->> (assoc params :file-id (:id file) :role :owner)
            (create-file-role! conn))

backend/src/app/rpc/commands/files_update.clj

@@ -19,6 +19,7 @@
    [app.config :as cf]
    [app.db :as db]
    [app.features.fdata :as feat.fdata]
+   [app.features.file-migrations :as feat.fmigr]
    [app.http.errors :as errors]
    [app.loggers.audit :as audit]
    [app.loggers.webhooks :as webhooks]
@@ -204,36 +205,27 @@
    {:keys [profile-id file features changes session-id skip-validate] :as params}]
 
   (let [;; Retrieve the file data
-        file (feat.fdata/resolve-file-data cfg file)
+        file  (feat.fmigr/resolve-applied-migrations cfg file)
+        file  (feat.fdata/resolve-file-data cfg file)
+        file  (assoc file :features
+                     (-> features
+                         (set/difference cfeat/frontend-only-features)
+                         (set/union (:features file))))]
 
-        file (assoc file :features
-                    (-> features
-                        (set/difference cfeat/frontend-only-features)
-                        (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
+                             ;; the CPU intensive operation on vthread.
+                             (binding [cfeat/*current*  features
+                                       cfeat/*previous* (:features file)]
+                               (update-file-data! cfg file
+                                                  process-changes-and-validate
+                                                  changes skip-validate))))]
 
-        ;; Process the file data on separated thread for avoid to do
-        ;; the CPU intensive operation on vthread.
-        file  (px/invoke! executor
-                          (fn []
-                            (binding [cfeat/*current*  features
-                                      cfeat/*previous* (:features file)]
-                              (update-file-data! cfg file
-                                                 process-changes-and-validate
-                                                 changes skip-validate))))]
-
-    (when (feat.fdata/offloaded? file)
-      (let [storage (sto/resolve cfg ::db/reuse-conn true)]
-        (some->> (:data-ref-id file) (sto/touch-object! storage))))
-
-    (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})))]
+      (feat.fmigr/upsert-migrations! conn file)
+      (persist-file! cfg file)
 
       ;; Insert change (xlog) with deleted_at in a future data for
       ;; make them automatically eleggible for GC once they expires
@@ -243,19 +235,27 @@
                    :profile-id profile-id
                    :created-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)
                    :revn (:revn file)
                    :version (:version file)
-                   :features features
+                   :features (:features file)
                    :label (::snapshot-label file)
                    :data (::snapshot-data file)
                    :changes (blob/encode changes)}
                   {::db/return-keys false})
 
       ;; 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
                  {:id         (:id file)
                   :name       (:name file)
@@ -265,9 +265,10 @@
 
 (defn update-file!
   "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)
         file (apply update-file-data! cfg file update-fn args)]
+    (feat.fmigr/upsert-migrations! conn file)
     (persist-file! cfg file)))
 
 (def ^:private sql:get-file
@@ -295,8 +296,7 @@
 
   It also updates the project modified-at attr."
   [{:keys [::db/conn ::timestamp]} file]
-  (let [features (db/create-array conn "text" (:features file))
-        ;; The timestamp can be nil because this function is also
+  (let [;; The timestamp can be nil because this function is also
         ;; intended to be used outside of this module
         modified-at (or timestamp (dt/now))]
 
@@ -309,7 +309,7 @@
                 {:revn (:revn file)
                  :data (:data file)
                  :version (:version file)
-                 :features features
+                 :features (:features file)
                  :data-backend nil
                  :data-ref-id nil
                  :modified-at modified-at
@@ -368,38 +368,16 @@
                    (-> file
                        (assoc ::snapshot-data snapshot)
                        (assoc ::snapshot-label label)))
-                 file)
+                 file)]
 
-          file (cond-> 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)))
+      (bfc/encode-file cfg file))))
 
 (defn- get-file-libraries
   "A helper for preload file libraries, mainly used for perform file
   semantical and structural validation"
   [{:keys [::db/conn] :as cfg} file]
   (->> (files/get-file-libraries conn (:id file))
-       (into [file] (map (fn [{:keys [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))))))
+       (into [file] (map #(bfc/get-file cfg (:id %))))
        (d/index-by :id)))
 
 (defn- soft-validate-file-schema!
@@ -494,7 +472,7 @@
        (vec)))
 
 (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)
         msgbus   (::mbus/msgbus cfg)]
 

backend/src/app/rpc/commands/management.clj

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

backend/test/backend_tests/helpers.clj

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

common/src/app/common/files/defaults.cljc

@@ -6,4 +6,7 @@
 
 (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)

common/src/app/common/files/migrations.cljc

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

common/src/app/common/types/file.cljc

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

common/test/common_tests/files_migrations_test.cljc

@@ -9,105 +9,18 @@
    [app.common.data :as d]
    [app.common.files.migrations :as cfm]
    [app.common.pprint :as pp]
-   [app.common.uuid :as uuid]
    [clojure.test :as t]))
 
-(t/deftest test-generic-migration-subsystem-1
-  (let [migrations [{:id 1 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
-                    {:id 2 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
-                    {: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)}]]
+(defmethod cfm/migrate-data "test/1" [data _] (update data :sum inc))
+(defmethod cfm/migrate-data "test/2" [data _] (update data :sum inc))
+(defmethod cfm/migrate-data "test/3" [data _] (update data :sum inc))
 
-    (t/testing "migrate up 1"
-      (let [result (cfm/migrate-data 0 migrations 0 2)]
-        (t/is (= result 4))))
-
-    (t/testing "migrate up 2"
-      (let [result (cfm/migrate-data 0 migrations 0 20)]
-        (t/is (= result 26))))
-
-    (t/testing "migrate down 1"
-      (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))))
+(t/deftest generic-migration-subsystem-1
+  (let [migrations (into (d/ordered-set) ["test/1" "test/2" "test/3"])]
+    (with-redefs [cfm/available-migrations migrations]
+      (let [file  {:data {:sum 1}
+                   :id 1
+                   :migrations (d/ordered-set "test/1")}
+            file' (cfm/migrate file)]
+        (t/is (= cfm/available-migrations (:migrations file')))
+        (t/is (= 3 (:sum (:data file'))))))))