🐛 Repair child ids in a new migration for files that applied 0033

Files that applied 0033 before it repaired child ids never run it
again, so the repair now also runs as 0036-fix-shape-children-ids.
It only rebuilds the objects maps that change, and turns a :shapes
list into a vector.

Tests cover children outside the root walk, legacy components, the
end-to-end load of a broken shared file and the log line of a
skipped file.

AI-assisted-by: claude-opus-5-5

backend/test/backend_tests/rpc_file_test.clj

@@ -9,7 +9,9 @@
    [app.binfile.common :as bfc]
    [app.common.features :as cfeat]
    [app.common.files.changes-builder :as pcb]
+   [app.common.files.migrations :as fmg]
    [app.common.files.tokens :as cfo]
+   [app.common.logging :as l]
    [app.common.pprint :as pp]
    [app.common.thumbnails :as thc]
    [app.common.time :as ct]
@@ -3216,6 +3218,19 @@
     (t/is (= (:id team)
              (get-in (meta (:result out)) [:app.loggers.audit/props :team-id])))))
 
+(defn- wait-for-log-record
+  "The first captured log record whose message hint is `hint`, waiting up
+  to two seconds because logging is asynchronous."
+  [records hint]
+  (loop [tries 0]
+    (if-let [record (->> @records
+                         (filter #(= hint (get-in % [::l/props :hint])))
+                         (first))]
+      record
+      (when (< tries 200)
+        (Thread/sleep 10)
+        (recur (inc tries))))))
+
 (t/deftest get-team-shared-files-skips-files-that-fail-to-load
   (let [profile  (th/create-profile* 1)
         file1    (th/create-file* 1 {:profile-id (:id profile)
@@ -3231,13 +3246,50 @@
     (doseq [cause [(ex-info "broken file" {:type :assertion})
                    (AssertionError. "point instance expected")
                    (StackOverflowError.)]]
-      (let [broken (fn [cfg id]
-                     (if (= id (:id file1))
-                       (throw cause)
-                       (get-file cfg id)))
-            out    (with-redefs-fn {#'files/get-file-with-summary broken}
-                     #(th/command! {::th/type :get-team-shared-files
-                                    ::rpc/profile-id (:id profile)
-                                    :team-id (:default-team-id profile)}))]
+      (let [records (atom [])
+            broken  (fn [cfg id]
+                      (if (= id (:id file1))
+                        (throw cause)
+                        (get-file cfg id)))
+            out     (try
+                      (add-watch l/log-record ::capture
+                                 (fn [_ _ _ record] (swap! records conj record)))
+                      (with-redefs-fn {#'files/get-file-with-summary broken}
+                        #(th/command! {::th/type :get-team-shared-files
+                                       ::rpc/profile-id (:id profile)
+                                       :team-id (:default-team-id profile)}))
+                      (finally
+                        (remove-watch l/log-record ::capture)))]
         (t/is (th/success? out) (str "skips file failing with " (class cause)))
-        (t/is (= #{(:id file2)} (into #{} (map :id) (:result out))))))))
+        (t/is (= #{(:id file2)} (into #{} (map :id) (:result out))))
+        (t/is (= (str (:id file1))
+                 (some-> (wait-for-log-record records "unable to load shared file")
+                         (get-in [::l/props :file-id])))
+              (str "reports file failing with " (class cause)))))))
+
+(t/deftest get-team-shared-files-repairs-invalid-children-ids
+  ;; A stored shared file that lists nil and a dangling id in :shapes and
+  ;; has not run 0033 yet: the migrations repair it on load, so it is
+  ;; listed instead of skipped.
+  (let [profile (th/create-profile* 1)
+        file    (th/create-file* 1 {:profile-id (:id profile)
+                                    :project-id (:default-project-id profile)
+                                    :is-shared true})
+        page-id (first (get-in file [:data :pages]))
+        root    [:data :pages-index page-id :objects uuid/zero :shapes]
+        broken  (-> (bfc/get-file th/*system* (:id file) :realize? true)
+                    (update-in root conj nil (str (uuid/next)))
+                    (assoc :migrations (disj fmg/available-migrations
+                                             "0033-normalize-main-instance-names"
+                                             "0036-fix-shape-children-ids")))
+        _       (db/tx-run! th/*system*
+                            (fn [cfg]
+                              (bfc/update-file! cfg broken ::bfc/reset-migrations? true)))
+        out     (th/command! {::th/type :get-team-shared-files
+                              ::rpc/profile-id (:id profile)
+                              :team-id (:default-team-id profile)})]
+
+    (t/is (th/success? out))
+    (t/is (= #{(:id file)} (into #{} (map :id) (:result out))))
+    (t/is (= [] (get-in (bfc/get-file th/*system* (:id file) :realize? true) root))
+          "the repaired data is stored")))

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

@@ -2223,6 +2223,43 @@
         (update :pages-index d/update-vals update-container)
         (d/update-when :components d/update-vals update-container))))
 
+(defn- repair-shape-children
+  [objects shape]
+  (if-let [shapes (:shapes shape)]
+    (let [shapes' (into []
+                        (comp (keep uuid/coerce)
+                              (filter #(contains? objects %))
+                              (distinct))
+                        shapes)]
+      (if (and (vector? shapes) (= shapes shapes'))
+        shape
+        (assoc shape :shapes shapes')))
+    shape))
+
+(defn- repair-container-children
+  [container]
+  (d/update-when container :objects
+                 (fn [objects]
+                   ;; Only assoc the shapes that change, so an ObjectsMap is
+                   ;; not marked as modified when nothing is repaired.
+                   (reduce-kv (fn [result id shape]
+                                (let [shape' (repair-shape-children objects shape)]
+                                  (if (identical? shape shape')
+                                    result
+                                    (assoc result id shape'))))
+                              objects
+                              objects))))
+
+(defn- repair-children-ids
+  "Old files may list in :shapes child ids stored as strings, nil, or ids
+  that point to no shape. They fail the shape schema and the uuid assert of
+  get-shape, so parse the strings into uuids and drop the rest. This also
+  removes the duplicate that 0032 adds when a child is listed as a string."
+  [data]
+  (-> data
+      (update :pages-index d/update-vals repair-container-children)
+      (d/update-when :components d/update-vals repair-container-children)))
+
 (defmethod migrate-data "0033-normalize-main-instance-names"
   [data _]
   ;; In penpot shape names always have "/" characters normalized with one space between and after,
@@ -2232,29 +2269,9 @@
   ;; Here we normalize the names of all main instances, and a new file integrity validation has
   ;; been added to enforce this from now on.
   ;; Main instances in variants are a special case because they need to match the variant name.
-  ;; Old files may also list in :shapes child ids stored as strings, nil, or ids that point to
-  ;; no shape. They fail the shape schema and the uuid assert of get-shape, so first parse the
-  ;; strings into uuids and drop the rest. This also removes the duplicate that 0032 adds when
-  ;; a child is listed as a string.
-  (letfn [(fix-children [objects shapes]
-            (into []
-                  (comp (keep uuid/coerce)
-                        (filter #(contains? objects %))
-                        (distinct))
-                  shapes))
-
-          (fix-object [objects shape]
-            (if-let [shapes (:shapes shape)]
-              (let [shapes' (fix-children objects shapes)]
-                (if (= shapes shapes')
-                  shape
-                  (assoc shape :shapes shapes')))
-              shape))
-
-          (fix-objects [objects]
-            (d/update-vals objects (partial fix-object objects)))
-
-          (update-shape [container shape-id]
+  ;; Invalid child ids in :shapes would break the walk below, so they are repaired first (see
+  ;; `repair-children-ids`, also run by 0036 for files that already applied this migration).
+  (letfn [(update-shape [container shape-id]
             (let [shape (ctn/get-shape container shape-id)
 
                   shape (cond
@@ -2296,7 +2313,7 @@
 
           (update-container
             [container]
-            (let [container (d/update-when container :objects fix-objects)
+            (let [container (repair-container-children container)
                   root      (ctn/get-container-root container)]
               (if root
                 (update-shape container (:id root))
@@ -2391,6 +2408,12 @@
         (update :pages-index d/update-vals migrate-container)
         (d/update-when :components d/update-vals migrate-container))))
 
+(defmethod migrate-data "0036-fix-shape-children-ids"
+  [data _]
+  ;; 0033 repairs invalid child ids, but files that applied 0033 before the
+  ;; repair was added never run it again, so it runs once more here.
+  (repair-children-ids data))
+
 (def available-migrations
   (into (d/ordered-set)
         ["legacy-2"
@@ -2482,4 +2505,5 @@
          "0032-fix-children-not-in-parent"
          "0033-normalize-main-instance-names"
          "0034-fix-path-content-offset"
-         "0035-fix-shape-svg-attrs-and-defs"]))
+         "0035-fix-shape-svg-attrs-and-defs"
+         "0036-fix-shape-children-ids"]))

common/test/common_tests/files_migrations_test.cljc

@@ -831,6 +831,81 @@
     (t/is (= data' (cfm/migrate-data data' migration-id))
           "migration is idempotent")))
 
+(t/deftest migration-0033-fixes-children-ids-outside-the-root-walk
+  ;; A shape that the page root does not reach is not visited by the
+  ;; walk of 0033, so its children must be repaired before it.
+  (let [migration-id "0033-normalize-main-instance-names"
+        file         (-> (thf/sample-file :file1)
+                         (tho/add-frame-with-child :frame1 :child1)
+                         (tho/add-frame :frame2))
+        frame2-id    (thi/id :frame2)
+        file         (-> file
+                         (ths/update-shape :frame1 :shapes [])
+                         (ths/update-shape :child1 :parent-id (uuid/next))
+                         (ths/update-shape :child1 :shapes [nil (str frame2-id)]))
+        data'        (cfm/migrate-data (ctf/file-data file) migration-id)
+        file'        (assoc file :data data')]
+
+    (t/is (= [frame2-id] (:shapes (ths/get-shape file' :child1))))))
+
+(t/deftest migration-0036-fixes-children-ids-in-legacy-components
+  ;; Legacy components keep their own :objects, which the data schema
+  ;; does not validate shape by shape.
+  (let [migration-id "0036-fix-shape-children-ids"
+        component-id (uuid/next)
+        root-id      (uuid/next)
+        child-id     (uuid/next)
+        data         (-> (ctf/file-data (thf/sample-file :file1))
+                         (assoc-in [:components component-id]
+                                   {:id component-id
+                                    :name "Component"
+                                    :objects {root-id  {:id root-id :shapes [nil (str child-id) (uuid/next)]}
+                                              child-id {:id child-id}}}))
+        data'        (cfm/migrate-data data migration-id)]
+
+    (t/is (= [child-id] (get-in data' [:components component-id :objects root-id :shapes])))))
+
+(t/deftest migration-0036-turns-shapes-lists-into-vectors
+  (let [migration-id "0036-fix-shape-children-ids"
+        file         (-> (thf/sample-file :file1)
+                         (tho/add-frame-with-child :frame1 :child1))
+        child1-id    (thi/id :child1)
+        file         (ths/update-shape file :frame1 :shapes (list child1-id))
+        data'        (cfm/migrate-data (ctf/file-data file) migration-id)
+        shapes       (:shapes (ths/get-shape (assoc file :data data') :frame1))]
+
+    (t/is (vector? shapes))
+    (t/is (= [child1-id] shapes))))
+
+(t/deftest migration-0036-leaves-valid-objects-untouched
+  ;; Nothing to repair: the objects map must be the same instance, so an
+  ;; ObjectsMap is not marked as modified and its page is not rewritten.
+  (let [migration-id "0036-fix-shape-children-ids"
+        file         (-> (thf/sample-file :file1)
+                         (tho/add-frame-with-child :frame1 :child1))
+        page-id      (thf/current-page-id file)
+        data         (ctf/file-data file)
+        data'        (cfm/migrate-data data migration-id)]
+
+    (t/is (identical? (get-in data [:pages-index page-id :objects])
+                      (get-in data' [:pages-index page-id :objects])))))
+
+(t/deftest migration-0036-fixes-children-ids-of-files-that-applied-0033
+  ;; Files that applied 0033 before it repaired children never run it
+  ;; again, so 0036 must repair them.
+  (let [file      (-> (thf/sample-file :file1)
+                      (tho/add-frame-with-child :frame1 :child1))
+        child1-id (thi/id :child1)
+        file      (-> file
+                      (ths/update-shape :frame1 :shapes [(str child1-id) nil])
+                      (assoc :migrations
+                             (disj cfm/available-migrations
+                                   "0036-fix-shape-children-ids")))
+        file'     (cfm/migrate-file file {})]
+
+    (t/is (not (cfm/need-migration? file')) "new migration recorded")
+    (t/is (= [child1-id] (:shapes (ths/get-shape file' :frame1))))))
+
 (t/deftest migration-0033-fixes-children-ids-through-file-migration
   ;; 0032 adds the uuid of a child listed as a string, so the child is
   ;; listed twice before 0033; the file must still pass validation.