Merge remote-tracking branch 'origin/staging' into develop

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]))
@@ -251,40 +251,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
-  xform:collect-media-id
-  (comp
-   (map :objects)
-   (mapcat vals)
-   (mapcat (fn [obj]
-             ;; 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).
-             (sequence
-              (keep :id)
-              (concat [(:fill-image obj)
-                       (:metadata obj)]
-                      (map :fill-image (:fills obj))
-                      (map :stroke-image (:strokes obj))
-                      (->> (:content obj)
-                           (tree-seq map? :children)
-                           (mapcat :fills)
-                           (map :fill-image))))))))
+(defn update-media-references!
+  "Given a file and a coll of media-refs, check if all provided
+  references are correct or fix them in-place"
+  [{:keys [::db/conn] :as cfg} {file-id :id :as file} media-refs]
+  (let [missing-index
+        (reduce (fn [result {:keys [id] :as fmo}]
+                  (assoc result id
+                         (-> fmo
+                             (assoc :id (uuid/next))
+                             (assoc :file-id file-id)
+                             (dissoc :created-at)
+                             (dissoc :deleted-at))))
+                {}
+                (db/exec! conn [sql:get-missing-media-references
+                                (->> (into #{} xf-map-id media-refs)
+                                     (db/create-array conn "uuid"))
+                                file-id]))
 
-(defn collect-used-media
-  "Given a fdata (file data), returns all media references."
-  [data]
-  (-> #{}
-      (into xform:collect-media-id (vals (:pages-index data)))
-      (into xform:collect-media-id (vals (:components data)))
-      (into (keys (:media data)))))
+        lookup-index
+        (fn [id]
+          (if-let [mobj (get missing-index id)]
+            (do
+              (l/trc :hint "lookup index"
+                     :file-id (str file-id)
+                     :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(?)")]
 
@@ -337,48 +362,7 @@
   replace the old :component-file reference with the new
   ones, using the provided file-index."
   [data]
-  (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)
-              (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)))
+  (cfh/relink-media-refs data lookup-index))
 
 (defn- relink-media
   "A function responsible of process the :media attr of file data and