🐛 Update media references after instantiation of a component (#5652)

🐛 Update media references after instantiation of a component

CHANGES.md

@@ -8,6 +8,8 @@
 - Fix exception on importing some templates from templates slider
 - Consolidate adding share button to workspace
 - Fix problem when pasting text [Taiga #9929](https://tree.taiga.io/project/penpot/issue/9929)
+- Fix incorrect media reference handling on component instantiation
+
 
 ## 2.4.2
 

backend/src/app/binfile/common.clj

@@ -12,6 +12,7 @@
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
    [app.common.features :as cfeat]
+   [app.common.files.helpers :as cfh]
    [app.common.files.migrations :as fmg]
    [app.common.files.validate :as fval]
    [app.common.logging :as l]
@@ -29,7 +30,6 @@
    [app.util.time :as dt]
    [app.worker :as-alias wrk]
    [clojure.set :as set]
-   [clojure.walk :as walk]
    [cuerdas.core :as str]
    [datoteka.fs :as fs]
    [datoteka.io :as io]))
@@ -241,40 +241,65 @@
             :data nil}
            {::sql/columns [:media-id :file-id :revn]}))
 
+(def ^:private sql:get-missing-media-references
+  "SELECT fmo.*
+     FROM file_media_object AS fmo
+    WHERE fmo.id = ANY(?::uuid[])
+      AND file_id != ?")
 
-(def ^:private
+(defn update-media-references!
-  xform:collect-media-id
+  "Given a file and a coll of media-refs, check if all provided
-  (comp
+  references are correct or fix them in-place"
-   (map :objects)
+  [{:keys [::db/conn] :as cfg} {file-id :id :as file} media-refs]
-   (mapcat vals)
+  (let [missing-index
-   (mapcat (fn [obj]
+        (reduce (fn [result {:keys [id] :as fmo}]
-             ;; NOTE: because of some bug, we ended with
+                  (assoc result id
-             ;; many shape types having the ability to
+                         (-> fmo
-             ;; have fill-image attribute (which initially
+                             (assoc :id (uuid/next))
-             ;; designed for :path shapes).
+                             (assoc :file-id file-id)
-             (sequence
+                             (dissoc :created-at)
-              (keep :id)
+                             (dissoc :deleted-at))))
-              (concat [(:fill-image obj)
+                {}
-                       (:metadata obj)]
+                (db/exec! conn [sql:get-missing-media-references
-                      (map :fill-image (:fills obj))
+                                (->> (into #{} xf-map-id media-refs)
-                      (map :stroke-image (:strokes obj))
+                                     (db/create-array conn "uuid"))
-                      (->> (:content obj)
+                                file-id]))
-                           (tree-seq map? :children)
-                           (mapcat :fills)
-                           (map :fill-image))))))))
 
-(defn collect-used-media
+        lookup-index
-  "Given a fdata (file data), returns all media references."
+        (fn [id]
-  [data]
+          (if-let [mobj (get missing-index id)]
-  (-> #{}
+            (do
-      (into xform:collect-media-id (vals (:pages-index data)))
+              (l/trc :hint "lookup index"
-      (into xform:collect-media-id (vals (:components data)))
+                     :file-id (str file-id)
-      (into (keys (:media data)))))
+                     :snap-id (str (:snapshot-id file))
+                     :id (str id)
+                     :result (str (get mobj :id)))
+              (get mobj :id))
+
+            id))
+
+        update-shapes
+        (fn [data {:keys [page-id shape-id]}]
+          (d/update-in-when data [:pages-index page-id :objects shape-id] cfh/relink-media-refs lookup-index))
+
+        file
+        (update file :data #(reduce update-shapes % media-refs))]
+
+    (doseq [[old-id item] missing-index]
+      (l/dbg :hint "create missing references"
+             :file-id (str file-id)
+             :snap-id (str (:snapshot-id file))
+             :old-id (str old-id)
+             :id (str (:id item)))
+      (db/insert! conn :file-media-object item
+                  {::db/return-keys false}))
+
+    file))
 
 (defn get-file-media
   [cfg {:keys [data id] :as file}]
   (db/run! cfg (fn [{:keys [::db/conn]}]
-                 (let [ids (collect-used-media data)
+                 (let [ids (cfh/collect-used-media data)
                        ids (db/create-array conn "uuid" ids)
                        sql (str "SELECT * FROM file_media_object WHERE id = ANY(?)")]
 
@@ -327,48 +352,7 @@
   replace the old :component-file reference with the new
   ones, using the provided file-index."
   [data]
-  (letfn [(process-map-form [form]
+  (cfh/relink-media-refs data lookup-index))
-            (cond-> form
-              ;; Relink image shapes
-              (and (map? (:metadata form))
-                   (= :image (:type form)))
-              (update-in [:metadata :id] lookup-index)
-
-              ;; Relink paths with fill image
-              (map? (:fill-image form))
-              (update-in [:fill-image :id] lookup-index)
-
-              ;; This covers old shapes and the new :fills.
-              (uuid? (:fill-color-ref-file form))
-              (update :fill-color-ref-file lookup-index)
-
-              ;; This covers the old shapes and the new :strokes
-              (uuid? (:stroke-color-ref-file form))
-              (update :stroke-color-ref-file lookup-index)
-
-              ;; This covers all text shapes that have typography referenced
-              (uuid? (:typography-ref-file form))
-              (update :typography-ref-file lookup-index)
-
-              ;; This covers the component instance links
-              (uuid? (:component-file form))
-              (update :component-file lookup-index)
-
-              ;; This covers the shadows and grids (they have directly
-              ;; the :file-id prop)
-              (uuid? (:file-id form))
-              (update :file-id lookup-index)))
-
-          (process-form [form]
-            (if (map? form)
-              (try
-                (process-map-form form)
-                (catch Throwable cause
-                  (l/warn :hint "failed form" :form (pr-str form) ::l/sync? true)
-                  (throw cause)))
-              form))]
-
-    (walk/postwalk process-form data)))
 
 (defn- relink-media
   "A function responsible of process the :media attr of file data and

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

@@ -6,6 +6,7 @@
 
 (ns app.rpc.commands.files-update
   (:require
+   [app.binfile.common :as bfc]
    [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.features :as cfeat]
@@ -415,19 +416,37 @@
       (l/error :hint "file validation error"
                :cause cause))))
 
+
 (defn- process-changes-and-validate
   [cfg file changes skip-validate]
   (let [;; WARNING: this ruins performance; maybe we need to find
         ;; some other way to do general validation
-        libs (when (and (or (contains? cf/flags :file-validation)
+        libs
-                            (contains? cf/flags :soft-file-validation))
+        (when (and (or (contains? cf/flags :file-validation)
-                        (not skip-validate))
+                       (contains? cf/flags :soft-file-validation))
-               (get-file-libraries cfg file))
+                   (not skip-validate))
+          (get-file-libraries cfg file))
 
-        file (-> (files/check-version! file)
+
-                 (update :revn inc)
+        ;; The main purpose of this atom is provide a contextual state
-                 (update :data cpc/process-changes changes)
+        ;; for the changes subsystem where optionally some hints can
-                 (update :data d/without-nils))]
+        ;; be provided for the changes processing. Right now we are
+        ;; using it for notify about the existence of media refs when
+        ;; a new shape is added.
+        state
+        (atom {})
+
+        file
+        (binding [cpc/*state* state]
+          (-> (files/check-version! file)
+              (update :revn inc)
+              (update :data cpc/process-changes changes)
+              (update :data d/without-nils)))
+
+        file
+        (if-let [media-refs (-> @state :media-refs not-empty)]
+          (bfc/update-media-references! cfg file media-refs)
+          file)]
 
     (binding [pmap/*tracked* nil]
       (when (contains? cf/flags :soft-file-validation)

backend/src/app/srepl/fixes.clj

@@ -53,7 +53,7 @@
   fixes all not propertly referenced file-media-object for a file"
   [{:keys [id data] :as file} & _]
   (let [conn  (db/get-connection h/*system*)
-        used  (bfc/collect-used-media data)
+        used  (cfh/collect-used-media data)
         ids   (db/create-array conn "uuid" used)
         sql   (str "SELECT * FROM file_media_object WHERE id = ANY(?)")
         rows  (db/exec! conn [sql ids])

backend/src/app/tasks/file_gc.clj

@@ -10,7 +10,7 @@
   file is eligible to be garbage collected after some period of
   inactivity (the default threshold is 72h)."
   (:require
-   [app.binfile.common :as bfc]
+   [app.common.files.helpers :as cfh]
    [app.common.files.migrations :as fmg]
    [app.common.files.validate :as cfv]
    [app.common.logging :as l]
@@ -54,7 +54,7 @@
 (def ^:private xf:collect-used-media
   (comp
    (map :data)
-   (mapcat bfc/collect-used-media)))
+   (mapcat cfh/collect-used-media)))
 
 (defn- clean-file-media!
   "Performs the garbage collection of file media objects."

backend/test/backend_tests/rpc_file_test.clj

@@ -1658,3 +1658,174 @@
             components (get-in result [:data :components])]
         (t/is (not (contains? components c-id)))))))
 
+
+
+
+(defn add-file-media-object
+  [& {:keys [profile-id file-id]}]
+  (let [mfile  {:filename "sample.jpg"
+                :path (th/tempfile "backend_tests/test_files/sample.jpg")
+                :mtype "image/jpeg"
+                :size 312043}
+        params {::th/type :upload-file-media-object
+                ::rpc/profile-id profile-id
+                :file-id file-id
+                :is-local true
+                :name "testfile"
+                :content mfile}
+        out    (th/command! params)]
+
+    ;; (th/print-result! out)
+    (t/is (nil? (:error out)))
+    (:result out)))
+
+
+
+(t/deftest file-gc-with-media-assets-and-absorb-library
+  (let [storage (:app.storage/storage th/*system*)
+        profile (th/create-profile* 1)
+
+        file-1  (th/create-file* 1 {:profile-id (:id profile)
+                                    :project-id (:default-project-id profile)
+                                    :is-shared true})
+
+        file-2  (th/create-file* 2 {:profile-id (:id profile)
+                                    :project-id (:default-project-id profile)
+                                    :is-shared false})
+
+        fmedia  (add-file-media-object :profile-id (:id profile) :file-id (:id file-1))
+
+
+        rel     (th/link-file-to-library*
+                 {:file-id (:id file-2)
+                  :library-id (:id file-1)})
+
+        s-id-1  (uuid/random)
+        s-id-2  (uuid/random)
+        c-id    (uuid/random)
+
+        f1-page-id (first (get-in file-1 [:data :pages]))
+        f2-page-id (first (get-in file-2 [:data :pages]))
+
+        fills
+        [{:fill-image
+          {:id (:id fmedia)
+           :name "test"
+           :width 200
+           :height 200}}]]
+
+    ;; Update file library inserting new component
+    (update-file!
+     :file-id (:id file-1)
+     :profile-id (:id profile)
+     :revn 0
+     :vern 0
+     :changes
+     [{:type :add-obj
+       :page-id f1-page-id
+       :id s-id-1
+       :parent-id uuid/zero
+       :frame-id uuid/zero
+       :components-v2 true
+       :obj (cts/setup-shape
+             {:id s-id-1
+              :name "Board"
+              :frame-id uuid/zero
+              :parent-id uuid/zero
+              :type :frame
+              :fills fills
+              :main-instance true
+              :component-root true
+              :component-file (:id file-1)
+              :component-id c-id})}
+      {:type :add-component
+       :path ""
+       :name "Board"
+       :main-instance-id s-id-1
+       :main-instance-page f1-page-id
+       :id c-id
+       :anotation nil}])
+
+    ;; Instanciate a component in a different file
+    (update-file!
+     :file-id (:id file-2)
+     :profile-id (:id profile)
+     :revn 0
+     :vern 0
+     :changes
+     [{:type :add-obj
+       :page-id f2-page-id
+       :id s-id-2
+       :parent-id uuid/zero
+       :frame-id uuid/zero
+       :components-v2 true
+       :obj (cts/setup-shape
+             {:id s-id-2
+              :name "Board"
+              :frame-id uuid/zero
+              :parent-id uuid/zero
+              :type :frame
+              :fills fills
+              :main-instance false
+              :component-root true
+              :component-file (:id file-1)
+              :component-id c-id})}])
+
+    ;; Check that file media object references are present for both objects
+    ;; the original one and the instance.
+    (let [rows (th/db-exec! ["SELECT * FROM file_media_object ORDER BY created_at ASC"])]
+      (t/is (= 2 (count rows)))
+      (t/is (= (:id file-1) (:file-id (get rows 0))))
+      (t/is (= (:id file-2) (:file-id (get rows 1))))
+      (t/is (every? (comp nil? :deleted-at) rows)))
+
+    ;; Check if the underlying media reference on shape is different
+    ;; from the instantiation
+    (let [data {::th/type :get-file
+                ::rpc/profile-id (:id profile)
+                :id (:id file-2)}
+          out  (th/command! data)]
+
+      (t/is (th/success? out))
+      (let [result (:result out)
+            fill   (get-in result [:data :pages-index f2-page-id :objects s-id-2 :fills 0 :fill-image])]
+        (t/is (some? fill))
+        (t/is (not= (:id fill) (:id fmedia)))))
+
+    ;; Run the file-gc on file and library
+    (t/is (true? (th/run-task! :file-gc {:min-age 0 :file-id (:id file-1)})))
+    (t/is (true? (th/run-task! :file-gc {:min-age 0 :file-id (:id file-2)})))
+
+    ;; Now proceed to delete file and absorb it
+    (let [data {::th/type :delete-file
+                ::rpc/profile-id (:id profile)
+                :id (:id file-1)}
+          out  (th/command! data)]
+      (t/is (th/success? out)))
+
+    (th/run-task! :delete-object
+                  {:object :file
+                   :deleted-at (dt/now)
+                   :id (:id file-1)})
+
+    ;; Check that file media object references are marked all for deletion
+    (let [rows (th/db-exec! ["SELECT * FROM file_media_object ORDER BY created_at ASC"])]
+      ;; (pp/pprint rows)
+      (t/is (= 2 (count rows)))
+
+      (t/is (= (:id file-1) (:file-id (get rows 0))))
+      (t/is (some? (:deleted-at (get rows 0))))
+
+      (t/is (= (:id file-2) (:file-id (get rows 1))))
+      (t/is (nil? (:deleted-at (get rows 1)))))
+
+    (th/run-task! :objects-gc
+                  {:min-age 0})
+
+    (let [rows (th/db-exec! ["SELECT * FROM file_media_object ORDER BY created_at ASC"])]
+      (t/is (= 1 (count rows)))
+
+      (t/is (= (:id file-2) (:file-id (get rows 0))))
+      (t/is (nil? (:deleted-at (get rows 0)))))))
+
+

common/src/app/common/files/changes.cljc

@@ -484,6 +484,11 @@
   modification."
   nil)
 
+(def ^:dynamic *state*
+  "A general purpose state to signal some out of order operations
+  to the processor backend."
+  nil)
+
 (defmulti process-change (fn [_ change] (:type change)))
 (defmulti process-operation (fn [_ op] (:type op)))
 
@@ -617,12 +622,38 @@
 
 ;; --- Shape / Obj
 
+;; The main purpose of this is ensure that all created shapes has
+;; valid media references; so for make sure of it, we analyze each
+;; shape added via `:add-obj` change for media usage, and if shape has
+;; media refs, we put that media refs on the check list (on the
+;; *state*) which will subsequently be processed and all incorrect
+;; references will be corrected.  The media ref is anything that can
+;; be pointing to a file-media-object on the shape, per example we
+;; have fill-image, stroke-image, etc.
+
+(defn- collect-shape-media-refs
+  [state obj page-id]
+  (let [media-refs
+        (-> (cfh/collect-shape-media-refs obj)
+            (not-empty))
+
+        xform
+        (map (fn [id]
+               {:page-id page-id
+                :shape-id (:id obj)
+                :id id}))]
+
+    (update state :media-refs into xform media-refs)))
+
 (defmethod process-change :add-obj
   [data {:keys [id obj page-id component-id frame-id parent-id index ignore-touched]}]
   (let [update-container
         (fn [container]
           (ctst/add-shape id obj container frame-id parent-id index ignore-touched))]
 
+    (when *state*
+      (swap! *state* collect-shape-media-refs obj page-id))
+
     (if page-id
       (d/update-in-when data [:pages-index page-id] update-container)
       (d/update-in-when data [:components component-id] update-container))))

common/src/app/common/files/helpers.cljc

@@ -12,6 +12,7 @@
    [app.common.schema :as sm]
    [app.common.uuid :as uuid]
    [clojure.set :as set]
+   [clojure.walk :as walk]
    [cuerdas.core :as str]))
 
 #?(:clj (set! *warn-on-reflection* true))
@@ -533,6 +534,86 @@
        (get-position-on-parent objects)
        inc))
 
+(defn collect-shape-media-refs
+  "Collect all media refs on the provided shape. Returns a set of ids"
+  [shape]
+  (sequence
+   (keep :id)
+   ;; NOTE: because of some bug, we ended with
+   ;; many shape types having the ability to
+   ;; have fill-image attribute (which initially
+   ;; designed for :path shapes).
+   (concat [(:fill-image shape)
+            (:metadata shape)]
+           (map :fill-image (:fills shape))
+           (map :stroke-image (:strokes shape))
+           (->> (:content shape)
+                (tree-seq map? :children)
+                (mapcat :fills)
+                (map :fill-image)))))
+
+(def ^:private
+  xform:collect-media-refs
+  "A transducer for collect media-id usage across a container (page or
+  component)"
+  (comp
+   (map :objects)
+   (mapcat vals)
+   (mapcat collect-shape-media-refs)))
+
+(defn collect-used-media
+  "Given a fdata (file data), returns all media references used in the
+  file data"
+  [data]
+  (-> #{}
+      (into xform:collect-media-refs (vals (:pages-index data)))
+      (into xform:collect-media-refs (vals (:components data)))
+      (into (keys (:media data)))))
+
+(defn relink-media-refs
+  "A function responsible to analyze all file data and replace the
+  old :component-file reference with the new ones, using the provided
+  file-index."
+  [data lookup-index]
+  (letfn [(process-map-form [form]
+            (cond-> form
+              ;; Relink image shapes
+              (and (map? (:metadata form))
+                   (= :image (:type form)))
+              (update-in [:metadata :id] lookup-index)
+
+              ;; Relink paths with fill image
+              (map? (:fill-image form))
+              (update-in [:fill-image :id] lookup-index)
+
+              ;; This covers old shapes and the new :fills.
+              (uuid? (:fill-color-ref-file form))
+              (update :fill-color-ref-file lookup-index)
+
+              ;; This covers the old shapes and the new :strokes
+              (uuid? (:stroke-color-ref-file form))
+              (update :stroke-color-ref-file lookup-index)
+
+              ;; This covers all text shapes that have typography referenced
+              (uuid? (:typography-ref-file form))
+              (update :typography-ref-file lookup-index)
+
+              ;; This covers the component instance links
+              (uuid? (:component-file form))
+              (update :component-file lookup-index)
+
+              ;; This covers the shadows and grids (they have directly
+              ;; the :file-id prop)
+              (uuid? (:file-id form))
+              (update :file-id lookup-index)))
+
+          (process-form [form]
+            (if (map? form)
+              (process-map-form form)
+              form))]
+
+    (walk/postwalk process-form data)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; SHAPES ORGANIZATION (PATH MANAGEMENT)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;