🐛 Fix migrations set decoding

that causes incorrect migration ordering on the table

backend/src/app/srepl/main.clj

@@ -15,7 +15,7 @@
    [app.common.features :as cfeat]
    [app.common.files.validate :as cfv]
    [app.common.logging :as l]
-   [app.common.pprint :as p]
+   [app.common.pprint :as pp]
    [app.common.schema :as sm]
    [app.common.spec :as us]
    [app.common.time :as ct]
@@ -58,7 +58,7 @@
 (defn print-tasks
   []
   (let [tasks (:app.worker/registry main/system)]
-    (p/pprint (keys tasks) :level 200)))
+    (pp/pprint (keys tasks) :level 200)))
 
 (defn run-task!
   ([tname]
@@ -130,18 +130,18 @@
 (defn reset-password!
   "Reset a password to a specific one for a concrete user or all users
   if email is `:all` keyword."
-  [& {:keys [email password] :or {password "123123"} :as params}]
-  (when-not email
-    (throw (IllegalArgumentException. "email is mandatory")))
+  [& {:keys [email password]}]
+  (assert (string? email) "expected email")
+  (assert (string? password) "expected password")
 
   (some-> main/system
           (db/tx-run!
            (fn [{:keys [::db/conn] :as system}]
-             (let [password (derive-password password)]
-               (if (= email :all)
-                 (db/exec! conn ["update profile set password=?" password])
-                 (let [email (str/lower email)]
-                   (db/exec! conn ["update profile set password=? where email=?" password email]))))))))
+             (let [password (derive-password password)
+                   email    (str/lower email)]
+               (-> (db/exec-one! conn ["update profile set password=? where email=?" password email])
+                   (db/get-update-count)
+                   (pos?)))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; FEATURES
@@ -531,6 +531,18 @@
         (assoc :max-jobs 1)
         (process!))))
 
+
+(defn mark-file-as-trimmed
+  [id]
+  (let [id (h/parse-uuid id)]
+    (db/tx-run! main/system (fn [cfg]
+                              (-> (db/update! cfg :file
+                                              {:has-media-trimmed true}
+                                              {:id id}
+                                              {::db/return-keys false})
+                                  (db/get-update-count)
+                                  (pos?))))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; DELETE/RESTORE OBJECTS (WITH CASCADE, SOFT)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

@@ -234,7 +234,7 @@
               shape))
 
           (update-container [container]
-            (update container :objects d/update-vals fix-line-paths))]
+            (d/update-when container :objects d/update-vals fix-line-paths))]
 
     (-> data
         (update :pages-index d/update-vals update-container)
@@ -288,7 +288,9 @@
               (let [[deleted objects] (clean-objects objects)]
                 (if (and (pos? deleted) (< n 1000))
                   (recur (inc n) objects)
-                  (assoc container :objects objects)))))]
+                  (-> container
+                      (assoc :objects objects)
+                      (d/without-nils))))))]
 
     (-> data
         (update :pages-index d/update-vals clean-container)
@@ -386,21 +388,20 @@
                 (dissoc :fill-color :fill-opacity))))
 
           (update-container [container]
-            (if (contains? container :objects)
-              (loop [objects (:objects container)
-                     shapes  (->> (vals objects)
-                                  (filter cfh/image-shape?))]
-                (if-let [shape (first shapes)]
-                  (let [{:keys [id frame-id] :as shape'} (process-shape shape)]
-                    (if (identical? shape shape')
-                      (recur objects (rest shapes))
-                      (recur (-> objects
-                                 (assoc id shape')
-                                 (d/update-when frame-id dissoc :thumbnail))
-                             (rest shapes))))
-                  (assoc container :objects objects)))
-              container))]
-
+            (loop [objects (:objects container)
+                   shapes  (->> (vals objects)
+                                (filter cfh/image-shape?))]
+              (if-let [shape (first shapes)]
+                (let [{:keys [id frame-id] :as shape'} (process-shape shape)]
+                  (if (identical? shape shape')
+                    (recur objects (rest shapes))
+                    (recur (-> objects
+                               (assoc id shape')
+                               (d/update-when frame-id dissoc :thumbnail))
+                           (rest shapes))))
+                (-> container
+                    (assoc :objects objects)
+                    (d/without-nils)))))]
     (-> data
         (update :pages-index d/update-vals update-container)
         (d/update-when :components d/update-vals update-container))))
@@ -1621,6 +1622,50 @@
         (update :pages-index d/update-vals update-container)
         (d/update-when :components d/update-vals update-container))))
 
+(defmethod migrate-data "0016-clear-pages-and-shapes"
+  [data _]
+  (letfn [(fix-invalid-shape [objects id shape]
+            ;; This function ensures that we don't have completly
+            ;; invalid shapes; i3f non-shape instance if found, we
+            ;; suppose it is a map and proceed to sanitize to a valid
+            ;; shape preserving all properties as possible; if the
+            ;; result shape is still invalid, we replace the shape
+            ;; with a dummy rectangle;
+            ;;
+            ;; This apprach is less destructive and does not need any
+            ;; parents manipulation
+            (if (cts/shape? shape)
+              objects
+              (let [shape (-> shape
+                              (assoc :id id)
+                              (update :type #(d/nilv % :rect))
+                              (cts/setup-shape))]
+                (if (cts/valid-shape? shape)
+                  (assoc objects id shape)
+                  (assoc objects id (cts/setup-shape {:type :rect}))))))
+
+          (update-container [container]
+            (-> container
+                (d/update-when :name #(d/nilv % ""))
+                (d/update-when :objects (fn [objects]
+                                          (reduce-kv fix-invalid-shape objects objects)))))]
+
+    (-> data
+        (update :pages-index d/update-vals update-container)
+        (d/update-when :components d/update-vals update-container))))
+
+(defmethod migrate-data "0017-clear-components-nil-objects"
+  [data _]
+
+  ;; Because of a bug in migrations, several files have migrations
+  ;; applied in an incorrect order and because of other bug on old
+  ;; migrations, some files have components with `:objects` with `nil`
+  ;; as value; this migration fixes it.
+
+  (letfn [(update-container [container]
+            (d/without-nils container))]
+    (d/update-when data :components d/update-vals update-container)))
+
 (def available-migrations
   (into (d/ordered-set)
         ["legacy-2"
@@ -1691,4 +1736,6 @@
          "0012-fix-position-data"
          "0013-fix-component-path"
          "0014-fix-tokens-lib-duplicate-ids"
-         "0015-clear-invalid-strokes-and-fills"]))
+         "0015-clear-invalid-strokes-and-fills"
+         "0016-clear-pages-and-shapes"
+         "0017-clear-components-nil-objects"]))

common/src/app/common/schema.cljc

@@ -420,7 +420,7 @@
   :min 0
   :max 1
   :compile
-  (fn [{:keys [kind max min] :as props} children _]
+  (fn [{:keys [kind max min ordered] :as props} children _]
     (let [kind  (or (last children) kind)
 
           pred
@@ -456,18 +456,23 @@
             (fn [value]
               (every? pred value)))
 
+          empty-set
+          (if ordered
+            (d/ordered-set)
+            #{})
+
           decode
           (fn [v]
             (cond
               (string? v)
               (let [v  (str/split v #"[\s,]+")]
-                (into #{} xf:filter-word-strings v))
+                (into empty-set xf:filter-word-strings v))
 
               (set? v)
               v
 
               (coll? v)
-              (into #{} v)
+              (into empty-set v)
 
               :else
               v))

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

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