🐛 Fix objects-map and pointer-map issues on file crud

backend/src/app/features/fdata.clj

@@ -27,7 +27,7 @@
         (update :data (fn [fdata]
                         (-> fdata
                             (update :pages-index update-vals update-fn)
-                            (update :components update-vals update-fn))))
+                            (d/update-when :components update-vals update-fn))))
         (update :features conj "fdata/objects-map"))))
 
 (defn process-objects
@@ -110,6 +110,6 @@
       (update :data (fn [fdata]
                       (-> fdata
                           (update :pages-index update-vals pmap/wrap)
-                          (update :components pmap/wrap))))
+                          (d/update-when :components pmap/wrap))))
 
       (update :features conj "fdata/pointer-map")))

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

@@ -226,23 +226,37 @@
   [{:keys [::db/conn] :as cfg} {:keys [id] :as file}]
   (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)
             pmap/*tracked* (pmap/create-tracked)]
-    (let [file (fmg/migrate-file file)]
+    (let [;; For avoid unnecesary overhead of creating multiple pointers and
+          ;; handly internally with objects map in their worst case (when
+          ;; probably all shapes and all pointers will be readed in any
+          ;; case), we just realize/resolve them before applying the
+          ;; migration to the file
+          file (-> file
+                   (update :data feat.fdata/process-pointers deref)
+                   (update :data feat.fdata/process-objects (partial into {}))
+                   (fmg/migrate-file))
 
-      ;; NOTE: when file is migrated, we break the rule of no perform
+          ;; When file is migrated, we break the rule of no perform
           ;; mutations on get operations and update the file with all
           ;; migrations applied
           ;;
-      ;; NOTE: the following code will not work on read-only mode, it
+          ;; WARN: he following code will not work on read-only mode,
-      ;; is a known issue; we keep is not implemented until we really
+          ;; it is a known issue; we keep is not implemented until we
-      ;; need this
+          ;; really need this.
-      (when (fmg/migrated? file)
+          file (if (contains? (:features file) "fdata/objects-map")
+                 (feat.fdata/enable-objects-map file)
+                 file)
+          file (if (contains? (:features file) "fdata/pointer-map")
+                 (feat.fdata/enable-pointer-map file)
+                 file)]
+
       (db/update! conn :file
                   {:data (blob/encode (:data file))
                    :features (db/create-array conn "text" (:features file))}
                   {:id id})
 
       (when (contains? (:features file) "fdata/pointer-map")
-          (feat.fdata/persist-pointers! cfg id)))
+        (feat.fdata/persist-pointers! cfg id))
 
       file)))
 
@@ -266,7 +280,7 @@
                             ::db/remove-deleted (not include-deleted?)
                             ::sql/for-update lock-for-update?})
                    (decode-row))]
-    (if migrate?
+    (if (and migrate? (fmg/need-migration? file))
       (migrate-file cfg file)
       file)))
 

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

@@ -18,14 +18,12 @@
    [app.loggers.audit :as-alias audit]
    [app.loggers.webhooks :as-alias webhooks]
    [app.rpc :as-alias rpc]
-   [app.rpc.commands.files :as files]
    [app.rpc.commands.projects :as projects]
    [app.rpc.commands.teams :as teams]
    [app.rpc.doc :as-alias doc]
    [app.rpc.permissions :as perms]
    [app.rpc.quotes :as quotes]
    [app.util.blob :as blob]
-   [app.util.objects-map :as omap]
    [app.util.pointer-map :as pmap]
    [app.util.services :as sv]
    [app.util.time :as dt]
@@ -50,37 +48,42 @@
    "expected a valid connection"
    (db/connection? conn))
 
+  (binding [pmap/*tracked* (pmap/create-tracked)
+            cfeat/*current* features]
     (let [id       (or id (uuid/next))
 
-        pointers (pmap/create-tracked)
+          data     (if create-page
-        pmap?    (contains? features "fdata/pointer-map")
-        omap?    (contains? features "fdata/objects-map")
-
-        data     (binding [pmap/*tracked* pointers
-                           cfeat/*current* features
-                           cfeat/*wrap-with-objects-map-fn* (if omap? omap/wrap identity)
-                           cfeat/*wrap-with-pointer-map-fn* (if pmap? pmap/wrap identity)]
-                   (if create-page
                      (ctf/make-file-data id)
-                     (ctf/make-file-data id nil)))
+                     (ctf/make-file-data id nil))
 
-        features (->> (set/difference features cfeat/frontend-only-features)
+          file     {:id id
-                      (db/create-array conn "text"))
-
-        file     (db/insert! conn :file
-                             (d/without-nils
-                              {:id id
                     :project-id project-id
                     :name name
                     :revn revn
                     :is-shared is-shared
-                               :data (blob/encode data)
+                    :data data
                     :features features
                     :ignore-sync-until ignore-sync-until
                     :modified-at modified-at
-                               :deleted-at deleted-at}))]
+                    :deleted-at deleted-at}
 
-    (binding [pmap/*tracked* pointers]
+          file     (if (contains? features "fdata/objects-map")
+                     (feat.fdata/enable-objects-map file)
+                     file)
+
+          file     (if (contains? features "fdata/pointer-map")
+                     (feat.fdata/enable-pointer-map file)
+                     file)
+
+          file     (d/without-nils file)]
+
+      (db/insert! conn :file
+                  (-> file
+                      (update :data blob/encode)
+                      (update :features db/encode-pgarray conn "text"))
+                  {::db/return-keys false})
+
+      (when (contains? features "fdata/pointer-map")
         (feat.fdata/persist-pointers! cfg id))
 
       (->> (assoc params :file-id id :role :owner)
@@ -90,7 +93,7 @@
                   {:modified-at (dt/now)}
                   {:id project-id})
 
-    (files/decode-row file)))
+      file)))
 
 (def ^:private schema:create-file
   [:map {:title "create-file"}

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

@@ -292,9 +292,20 @@
   (let [file (update file :data (fn [data]
                                   (-> data
                                       (blob/decode)
-                                      (assoc :id (:id file))
+                                      (assoc :id (:id file)))))
-                                      (fmg/migrate-data)
+
-                                      (d/without-nils))))
+        ;; For avoid unnecesary overhead of creating multiple pointers
+        ;; and handly internally with objects map in their worst
+        ;; case (when probably all shapes and all pointers will be
+        ;; readed in any case), we just realize/resolve them before
+        ;; applying the migration to the file
+        file (if (fmg/need-migration? file)
+               (-> file
+                   (update :data feat.fdata/process-pointers deref)
+                   (update :data feat.fdata/process-objects (partial into {}))
+                   (fmg/migrate-file))
+               file)
+
 
         ;; WARNING: this ruins performance; maybe we need to find
         ;; some other way to do general validation
@@ -305,14 +316,20 @@
                     (into [file] (map (fn [{:keys [id]}]
                                         (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)
                                                   pmap/*tracked* nil]
+                                          ;; We do not resolve the objects maps here
+                                          ;; because there is a lower probability that all
+                                          ;; shapes needed to be loded into memory, so we
+                                          ;; leeave it on lazy status
                                           (-> (files/get-file cfg id :migrate? false)
                                               (update :data feat.fdata/process-pointers deref) ; ensure all pointers resolved
                                               (fmg/migrate-file))))))
                     (d/index-by :id)))
 
+
         file (-> (files/check-version! file)
                  (update :revn inc)
-                 (update :data cpc/process-changes changes))]
+                 (update :data cpc/process-changes changes)
+                 (update :data d/without-nils))]
 
     (when (contains? cf/flags :soft-file-validation)
       (soft-validate-file! file libs))
@@ -329,12 +346,10 @@
       (val/validate-file-schema! file))
 
     (cond-> file
-      (and (contains? cfeat/*current* "fdata/objects-map")
+      (contains? cfeat/*current* "fdata/objects-map")
-           (not (contains? cfeat/*previous* "fdata/objects-map")))
       (feat.fdata/enable-objects-map)
 
-      (and (contains? cfeat/*current* "fdata/pointer-map")
+      (contains? cfeat/*current* "fdata/pointer-map")
-           (not (contains? cfeat/*previous* "fdata/pointer-map")))
       (feat.fdata/enable-pointer-map)
 
       :always

backend/src/app/util/pointer_map.clj

@@ -166,32 +166,36 @@
 
   (assoc [this key val]
     (when-not loaded? (load! this))
-    (let [odata (assoc odata key val)
+    (let [odata' (assoc odata key val)]
-          mdata (assoc mdata :created-at (dt/now))
+      (if (identical? odata odata')
+        this
+        (let [mdata (assoc mdata :created-at (dt/now))
               id    (if modified? id (uuid/next))
               pmap  (PointerMap. id
                                  mdata
-                             odata
+                                 odata'
                                  true
                                  true)]
           (some-> *tracked* (swap! assoc id pmap))
-      pmap))
+          pmap))))
 
   (assocEx [_ _ _]
     (throw (UnsupportedOperationException. "method not implemented")))
 
   (without [this key]
     (when-not loaded? (load! this))
-    (let [odata (dissoc odata key)
+    (let [odata' (dissoc odata key)]
-          mdata (assoc mdata :created-at (dt/now))
+      (if (identical? odata odata')
+        this
+        (let [mdata (assoc mdata :created-at (dt/now))
               id    (if modified? id (uuid/next))
               pmap  (PointerMap. id
                                  mdata
-                             odata
+                                 odata'
                                  true
                                  true)]
           (some-> *tracked* (swap! assoc id pmap))
-      pmap))
+          pmap))))
 
   Counted
   (count [this]
@@ -206,6 +210,8 @@
 (defn create
   ([]
    (let [id    (uuid/next)
+
+
          mdata (assoc *metadata* :created-at (dt/now))
          pmap  (PointerMap. id mdata {} true true)]
      (some-> *tracked* (swap! assoc id pmap))
@@ -225,7 +231,15 @@
     (do
       (some-> *tracked* (swap! assoc (get-id data) data))
       data)
-    (into (create) data)))
+    (let [mdata (assoc (meta data) :created-at (dt/now))
+          id    (uuid/next)
+          pmap  (PointerMap. id
+                             mdata
+                             data
+                             true
+                             true)]
+      (some-> *tracked* (swap! assoc id pmap))
+      pmap)))
 
 (fres/add-handlers!
  {:name "penpot/pointer-map/v1"

backend/test/backend_tests/rpc_file_test.clj

@@ -166,18 +166,21 @@
          :name "test"
          :id page-id}])
 
-      ;; Check the number of fragments
+      ;; The file-gc should mark for remove unused fragments
-      (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
-        (t/is (= 2 (count rows))))
-
-      ;; Check the number of fragments
-      (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
-        (t/is (= 2 (count rows))))
-
-      ;; The file-gc should remove unused fragments
       (let [res (th/run-task! :file-gc {:min-age 0})]
         (t/is (= 1 (:processed res))))
 
+      ;; Check the number of fragments
+      (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
+        (t/is (= 2 (count rows))))
+
+      ;; The objects-gc should remove unused fragments
+      (let [res (th/run-task! :objects-gc {:min-age 0})]
+        (t/is (= 0 (:processed res))))
+
+      ;; Check the number of fragments
+      (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
+        (t/is (= 2 (count rows))))
 
       ;; Add shape to page that should add a new fragment
       (update-file!
@@ -202,10 +205,14 @@
       (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
         (t/is (= 3 (count rows))))
 
-      ;; The file-gc should remove unused fragments
+      ;; The file-gc should mark for remove unused fragments
       (let [res (th/run-task! :file-gc {:min-age 0})]
         (t/is (= 1 (:processed res))))
 
+      ;; The objects-gc should remove unused fragments
+      (let [res (th/run-task! :objects-gc {:min-age 0})]
+        (t/is (= 0 (:processed res))))
+
       ;; Check the number of fragments; should be 3 because changes
       ;; are also holding pointers to fragments;
       (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
@@ -235,8 +242,6 @@
       (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
         (t/is (= 2 (count rows)))))))
 
-
-
 (t/deftest file-gc-task-with-thumbnails
   (letfn [(add-file-media-object [& {:keys [profile-id file-id]}]
             (let [mfile  {:filename "sample.jpg"

common/src/app/common/data.cljc

@@ -7,7 +7,7 @@
 (ns app.common.data
   "A collection if helpers for working with data structures and other
   data resources."
-  (:refer-clojure :exclude [read-string hash-map merge name update-vals
+  (:refer-clojure :exclude [read-string hash-map merge name
                             parse-double group-by iteration concat mapcat
                             parse-uuid max min])
   #?(:cljs

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

@@ -31,6 +31,10 @@
 
 (defmulti migrate :version)
 
+(defn need-migration?
+  [{:keys [data]}]
+  (> cfd/version (:version data 0)))
+
 (defn migrate-data
   ([data] (migrate-data data version))
   ([data to-version]

common/src/app/common/types/page.cljc

@@ -7,7 +7,6 @@
 (ns app.common.types.page
   (:require
    [app.common.data :as d]
-   [app.common.features :as cfeat]
    [app.common.schema :as sm]
    [app.common.types.color :as-alias ctc]
    [app.common.types.grid :as ctg]
@@ -71,13 +70,9 @@
 
 (defn make-empty-page
   [id name]
-  (let [wrap-objects-fn cfeat/*wrap-with-objects-map-fn*
-        wrap-pointer-fn cfeat/*wrap-with-pointer-map-fn*]
   (-> empty-page-data
       (assoc :id id)
-        (assoc :name name)
+      (assoc :name name)))
-        (update :objects wrap-objects-fn)
-        (wrap-pointer-fn))))
 
 ;; --- Helpers for flow