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

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)
-                            (contains? cf/flags :soft-file-validation))
-                        (not skip-validate))
-               (get-file-libraries cfg file))
+        libs
+        (when (and (or (contains? cf/flags :file-validation)
+                       (contains? cf/flags :soft-file-validation))
+                   (not skip-validate))
+          (get-file-libraries cfg file))
 
-        file (-> (files/check-version! file)
-                 (update :revn inc)
-                 (update :data cpc/process-changes changes)
-                 (update :data d/without-nils))]
+
+        ;; The main purpose of this atom is provide a contextual state
+        ;; for the changes subsystem where optionally some hints can
+        ;; 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."