Merge branch 'iop-vc-recorded-media-pairs' into iop-vc-preview

backend/src/app/binfile/common.clj

@@ -295,7 +295,7 @@
            END")
 
 (def ^:private sql:get-branch-changes
-  "SELECT changes, data_version
+  "SELECT changes, data_version, media_id_map
      FROM file_branch_change
     WHERE file_id = ?
       AND deleted_at IS NULL
@@ -309,6 +309,16 @@
   (->> (db/exec! conn [sql:get-branch-changes branch-file-id])
        (mapv (fn [{:keys [changes]}] (blob/decode changes)))))
 
+(defn get-branch-change-media-maps
+  "The media id maps the branch's op log rows carry, in the stored (as
+  applied) direction {old-id -> new-id}: the remap a save's media fix-up
+  or an update from main applied, one map per row, oldest first. A nil
+  element means the row carries no stamp: either it was written before
+  the column existed, or it recorded the empty map explicitly."
+  [{:keys [::db/conn] :as cfg} branch-file-id]
+  (->> (db/exec! conn [sql:get-branch-changes branch-file-id])
+       (mapv #(some-> (:media-id-map %) db/decode-transit-pgobject))))
+
 (defn- migrate-detached
   "Migrate `file` in memory with `migrate-fn`, called as
   `(migrate-fn file libs)`, under the bindings `migrate-file` sets up.

backend/src/app/migrations.clj

@@ -526,7 +526,10 @@
     :fn (mg/resource "app/migrations/sql/0156-add-file-pull-request-tables.sql")}
 
    {:name "0157-add-file-branch-change-table"
-    :fn (mg/resource "app/migrations/sql/0157-add-file-branch-change-table.sql")}])
+    :fn (mg/resource "app/migrations/sql/0157-add-file-branch-change-table.sql")}
+
+   {:name "0159-add-file-branch-change-media-id-map"
+    :fn (mg/resource "app/migrations/sql/0159-add-file-branch-change-media-id-map.sql")}])
 
 (defn apply-migrations!
   [pool name migrations]

backend/src/app/migrations/sql/0159-add-file-branch-change-media-id-map.sql

@@ -0,0 +1,16 @@
+-- A branch's media pairing, recorded by the writes that establish it.
+--
+-- Every `file_branch_change` row carries the media id map the save or
+-- the update from main that wrote it applied (`media_id_map`): an
+-- `update-media-references!` fix-up on a save copies a foreign media row
+-- into the branch under a fresh id, and an update from main re-points
+-- main's media rows at the branch's copies. The stored direction is the
+-- one the write applied ({old-id -> new-id}, the branch's own id is the
+-- new one), because that is what both writers hold; the comparison
+-- readers (`files_branch.clj::branch-id-map` and the base normalization)
+-- invert it to rebuild {branch-media-id -> main-media-id}, and
+-- `files_branch.clj::media-pairs` stays as the fallback for rows written
+-- before the column existed.
+
+ALTER TABLE file_branch_change
+  ADD COLUMN IF NOT EXISTS media_id_map jsonb;

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

@@ -221,6 +221,23 @@
                {}
                from-gs)))
 
+(defn- branch-media-pairs
+  "The branch->main media pairs the comparison and the merge run on,
+  from the branch's own record: every op log row stamps the media id map
+  the write that produced it applied (`bfc/get-branch-change-media-maps`),
+  in the as-applied direction {old-id -> new-id}, so the union of the
+  inverted stamps IS the pairing the branch established with its source.
+  A row written before the stamps existed comes back without one, and a
+  log with any such row cannot certify the full pairing: the
+  content-identity heuristic (`media-pairs`) replaces it for the whole
+  log. It describes the same pairings from the rows present on both
+  files."
+  [cfg branch-file-id source-file-id]
+  (let [maps (bfc/get-branch-change-media-maps cfg branch-file-id)]
+    (if (or (nil? (seq maps)) (some nil? maps))
+      (media-pairs cfg branch-file-id source-file-id)
+      (reduce (fn [acc m] (merge acc (set/map-invert m))) {} maps))))
+
 (def ^:private sql:media-rows-by-id
   "SELECT * FROM file_media_object WHERE id = ANY(?) AND deleted_at IS NULL")
 
@@ -283,7 +300,7 @@
               :branch-id (:id branch)))
   (when-some [data (some->> (fsnap/get-snapshot cfg source-file-id base-snapshot-id)
                             (bfc/migrate-branch-base cfg))]
-    (bm/remap-refs data (media-pairs cfg branch-file-id source-file-id))))
+    (bm/remap-refs data (branch-media-pairs cfg branch-file-id source-file-id))))
 
 (defn- branch-base-data
   "The comparison's `base`: the merge-base document that a branch file
@@ -304,7 +321,7 @@
           (ex/raise :type :assertion
                     :code :branch-base-data-missing
                     :hint "the branch file was read without `:include-base-data? true`"))
-      (bm/remap-refs (media-pairs cfg id source-file-id))))
+      (bm/remap-refs (branch-media-pairs cfg id source-file-id))))
 
 (defn- release-base-snapshot!
   "Reschedule a branch's base snapshot for normal deletion: it is pinned
@@ -593,9 +610,9 @@
 (defn- branch-id-map
   "Reference-normalization map for diffing/merging a branch against its
   source: the branch file id plus the branch->source media pairs (see
-  `media-pairs`)."
+  `branch-media-pairs`)."
   [cfg branch-file-id source-file-id]
-  (-> (media-pairs cfg branch-file-id source-file-id)
+  (-> (branch-media-pairs cfg branch-file-id source-file-id)
       (assoc branch-file-id source-file-id)))
 
 (def ^:private scoped-change-types
@@ -1021,7 +1038,7 @@
                  ;; refs) and the paired media ids; media ADDED on the
                  ;; branch gets fresh ids pre-allocated here — the rows are
                  ;; copied into main only if the merge actually applies.
-                 pairs       (media-pairs cfg branch-file-id main-id)
+                 pairs       (branch-media-pairs cfg branch-file-id main-id)
                  new-media   (unpaired-media-rows cfg branch-file-id (:data branch-file) pairs)
                  fresh-map   (into {} (map (fn [row] [(:id row) (uuid/next)])) new-media)
                  id-map      (-> pairs
@@ -1213,8 +1230,14 @@
   main-side ops (which would otherwise be double-applied on read).
 
   The squash is computed between documents `bfc/get-file` read at the
-  current data version, so its row records that version."
-  [{:keys [::db/conn] :as cfg} file ts branch-id changes]
+  current data version, so its row records that version.
+
+  The row also stamps the media id map the update applied, as applied
+  ({main-media-id -> branch-media-id}): the squashed changes were
+  computed against main's document moved into the branch's id space, so
+  the pairing the log describes after the squash is the one the stamps
+  rebuild (`branch-media-pairs`), not the content identity heuristic."
+  [{:keys [::db/conn] :as cfg} file ts branch-id changes media-map]
   (let [file (-> file
                  (dissoc ::snapshot)
                  (assoc :modified-at ts)
@@ -1231,6 +1254,7 @@
                    :file-id (:id file)
                    :revn (:revn file)
                    :changes (blob/encode (vec changes))
+                   :media-id-map (some-> (not-empty media-map) db/tjson)
                    :data-version (fmg/data-version)
                    :created-at ts
                    :updated-at ts}
@@ -1330,7 +1354,10 @@
                  ;; the change reaches the branch. Media ADDED on main has no
                  ;; branch row yet, so it gets a fresh id here and its row is
                  ;; copied below only if the update applies.
-                 pairs       (media-pairs cfg main-id branch-file-id)
+                 ;; the WRITE direction ({main-media-id -> branch-media-id})
+                 ;; is the inverse of the comparison's pairs
+                 pairs       (set/map-invert
+                              (branch-media-pairs cfg branch-file-id main-id))
                  new-media   (unpaired-media-rows cfg main-id main-raw pairs)
                  fresh-map   (into {} (map (fn [row] [(:id row) (uuid/next)])) new-media)
                  ;; the branch's OWN id space: every media row the branch
@@ -1539,7 +1566,13 @@
                                        :code :unsupported-update-squash
                                        :hint "the update produces branch-only changes that cannot be replayed"
                                        :kinds (vec unsupported)))
-                           (persist-branch-update! cfg updated ts branch-id net-changes))
+                           ;; the net row carries the media id map the
+                           ;; update applied: the log it replaces was
+                           ;; written against the OLD merge base, and
+                           ;; the squash is what names the branch's
+                           ;; pairing with main from now on
+                           (persist-branch-update! cfg updated ts branch-id
+                                                   net-changes media-map))
 
                          (when (contains? cf/flags :redis-cache)
                            (fupd/invalidate-caches! cfg updated))

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

@@ -85,6 +85,28 @@
 
 ;; --- HELPERS
 
+(def ^:private sql:media-rows-by-id
+  "SELECT id, file_id FROM file_media_object WHERE id = ANY(?)")
+
+(defn- media-id-map-from-index
+  "The media id map a branch's op log row stamps, from the remap a
+  save's media fix-up applied: `{old-id -> new-id}` restricted to the
+  copies whose source row the branch's source file owns, transit-encoded
+  for the jsonb column. A copy of media from another file is branch-own
+  media with no pairing to record, and only the source's pairing is
+  what a comparison rebuilds from the stamps
+  (`files_branch.clj::branch-media-pairs`)."
+  [conn source-file-id media-index]
+  (when-not (empty? media-index)
+    (let [owners (->> (db/exec! conn [sql:media-rows-by-id
+                                      (db/create-array conn "uuid"
+                                                       (keys media-index))])
+                      (into #{} (comp (filter #(= source-file-id (:file-id %)))
+                                      (map :id))))
+          owned   (fn [id] (contains? owners id))]
+      (some-> (not-empty (into {} (filter (comp owned key)) media-index))
+              db/tjson))))
+
 ;; File changes that affect to the library, and must be notified
 ;; to all clients using it.
 
@@ -258,7 +280,10 @@
           ;; as fixed: that is the vector a branch appends to its op
           ;; log, the state its derive reproduces. The xlog row below
           ;; keeps the client's changes, exactly as on an ordinary save.
-          [file op-changes]
+          ;; `media-index` is the id remapping the fix-up applied
+          ;; ({foreign-id -> copy-id}); a branch stamps it on the op log
+          ;; row so the comparison pairs from the branch's own record.
+          [file op-changes media-index]
           (binding [cfeat/*current*  features
                     cfeat/*previous* (:features file)]
             (update-file-data! cfg file
@@ -296,7 +321,7 @@
                   {::db/return-keys false})
 
       (if (:is-branch file)
-        (persist-branch-file! cfg file op-changes)
+        (persist-branch-file! cfg file op-changes media-index)
         (persist-file! cfg file))
 
       (when (contains? cf/flags :redis-cache)
@@ -378,8 +403,15 @@
   `update-file-data!` migrates the document to the current version
   before it applies them, and the derive
   (`app.binfile.common/branch-file-data`) migrates its replay to that
-  version before it applies the row."
-  [{:keys [::db/conn ::timestamp] :as cfg} file changes]
+  version before it applies the row.
+
+  It also records the media id map the fix-up applied, as applied
+  ({old-id -> new-id}, the branch's copy is the new one), filtered to
+  the copies whose source row the branch's source file owns: a copy of
+  media from another file is branch-own media with no main counterpart,
+  and only the source's pairing is what a comparison rebuilds from the
+  stamps (`files_branch.clj::branch-media-pairs`)."
+  [{:keys [::db/conn ::timestamp] :as cfg} file changes media-index]
   (let [modified-at (or timestamp (ct/now))
 
         file
@@ -408,6 +440,8 @@
                  :file-id (:id file)
                  :revn (:revn file)
                  :changes (blob/encode changes)
+                 :media-id-map (media-id-map-from-index
+                                conn (:source-file-id branch) media-index)
                  :data-version (fmg/data-version)
                  :created-at modified-at
                  :updated-at modified-at}
@@ -514,12 +548,15 @@
         ;; and rewrites the references on the file data. A branch
         ;; persists no data: its state is the change vector, so the same
         ;; rewrite is recorded in it and the derive reproduces the fix
-        ;; (`bm/remap-changes` is a no-op with an empty remap).
-        [file op-changes]
+        ;; (`bm/remap-changes` is a no-op with an empty remap). The
+        ;; remap itself travels out: a branch stamps it on the op log
+        ;; row (`persist-branch-file!`), so the comparison reads the
+        ;; pairing from the branch's own record.
+        [file op-changes media-index]
         (if-let [media-refs (-> @state :media-refs not-empty)]
           (let [[file media-index] (bfc/update-media-references! cfg file media-refs)]
-            [file (bm/remap-changes changes media-index)])
-          [file changes])]
+            [file (bm/remap-changes changes media-index) media-index])
+          [file changes nil])]
 
     (binding [pmap/*tracked* nil]
       (when (contains? cf/flags :soft-file-validation)
@@ -536,7 +573,7 @@
                  (not skip-validate))
         (val/validate-file-schema! file)))
 
-    [file op-changes]))
+    [file op-changes media-index]))
 
 (defn- take-snapshot?
   "Defines the rule when file `data` snapshot should be saved."

backend/test/backend_tests/rpc_file_branch_oplog_test.clj

@@ -21,6 +21,7 @@
    [app.config :as cf]
    [app.db :as db]
    [app.rpc :as-alias rpc]
+   [app.rpc.commands.files-branch :as fbranch]
    [app.storage :as sto]
    [app.util.blob :as blob]
    [backend-tests.helpers :as th]
@@ -1113,6 +1114,234 @@
   (-> (read-file profile file-id)
       :data :pages-index (get page-id) :objects (get shape-id)))
 
+;; --- recorded media id maps -----------------------------------------
+;;
+;; Every op log row stamps the media id map the save or the update that
+;; wrote it applied (`media_id_map`, {old-id -> new-id}, the branch's id
+;; is the new one), so the comparison reads the branch's own record of
+;; which media rows are copies of main's and leaves the content identity
+;; heuristic (`media-pairs`) for logs written before the column existed.
+
+(defn- main-media-setup
+  "The branch-side pairing scenario: an image whose `file_media_object`
+  row MAIN owns is placed on the branch. The save's media fix-up copies
+  the row into the branch under a fresh id, which is the copy the pairs
+  describe. Returns the pieces the assertions need."
+  []
+  (let [profile  (th/create-profile* 1 {:is-active true})
+        proj-id  (:default-project-id profile)
+        file     (th/create-file* 1 {:profile-id (:id profile)
+                                     :project-id proj-id
+                                     :is-shared false})
+        storage  (-> (:app.storage/storage th/*system*)
+                     (assoc :app.storage/backend :fs))
+        sobj     (sto/put-object! storage {::sto/content (sto/content "main-image")
+                                           :bucket :file-media-object
+                                           :content-type "image/png"})
+        fmo      (th/create-file-media-object* {:file-id (:id file)
+                                                :name "main.png"
+                                                :mtype "image/png"
+                                                :media-id (:id sobj)})
+        create   (create-branch* profile (:id file) "media-remap")
+        branch-file-id (:branch-file-id create)
+        page-id  (-> (read-file profile branch-file-id) :data :pages first)
+        shape-id (uuid/random)]
+
+    (let [out (apply-change* profile branch-file-id
+                             {:type :add-obj
+                              :page-id page-id
+                              :id shape-id
+                              :parent-id uuid/zero
+                              :frame-id uuid/zero
+                              :obj (cts/setup-shape
+                                    {:id shape-id :name "Image" :type :image
+                                     :parent-id uuid/zero :frame-id uuid/zero
+                                     :metadata {:id (:id fmo)
+                                                :width 100 :height 100
+                                                :mtype "image/png"}})})]
+      (t/is (nil? (:error out)) "the setup save lands"))
+
+    {:profile profile
+     :main-id (:id file)
+     :branch-id (:id create)
+     :branch-file-id branch-file-id
+     :page-id page-id
+     :shape-id shape-id
+     :fmo-id (:id fmo)}))
+
+(defn- media-id-maps
+  "The stamps the branch's op log rows carry, in stored (as applied)
+  direction."
+  [branch-file-id]
+  (->> (oplog-rows branch-file-id)
+       (mapv #(-> % :media-id-map (db/decode-transit-pgobject)))))
+
+(defn- clear-media-id-maps!
+  "Erase every stamp from the branch's log, the state the pre-column
+  rows were written in."
+  [branch-file-id]
+  (db/exec-one! th/*pool*
+                ["UPDATE file_branch_change SET media_id_map = NULL WHERE file_id = ?"
+                 branch-file-id]))
+
+(t/deftest branch-save-records-the-applied-media-id-map
+  ;; A branch save that copies main's media stamps its op log row with
+  ;; the id remap the fix-up applied, as applied: the source's id maps to
+  ;; the branch's copy.
+  (with-redefs [cf/flags (conj cf/flags :branching)]
+    (let [{:keys [branch-file-id fmo-id]}
+          (main-media-setup)
+
+          [stamp]
+          (->> (media-id-maps branch-file-id)
+               (remove nil?))]
+
+      (t/testing "the op log row carries the remap it applied"
+        (t/is (some? stamp))
+        (t/is (contains? stamp fmo-id))
+        (let [copy-id (get stamp fmo-id)]
+          (t/is (not= fmo-id copy-id))
+          (t/is (= branch-file-id
+                   (:file-id (th/db-get :file-media-object {:id copy-id})))))))))
+
+(t/deftest compare-reads-the-recorded-pairs
+  ;; With the log fully stamped the comparison pairs from the record and
+  ;; the content identity heuristic stays out of it; erasing the stamps
+  ;; (the pre-column state) must give the same summary, through the
+  ;; fallback.
+  (with-redefs [cf/flags (conj cf/flags :branching)]
+    (let [{:keys [profile branch-id branch-file-id]}
+          (main-media-setup)
+
+          diff!
+          (fn []
+            (-> (th/command! {::th/type :get-branch-diff
+                              ::rpc/profile-id (:id profile)
+                              :branch-id branch-id})
+                :result
+                (select-keys [:stats :changes :conflicts])))
+          with-stamps
+          (atom nil)
+          heuristic-runs
+          (atom 0)]
+
+      ;; the diff with the record in place, and the heuristic never
+      ;; consulted while the log is fully stamped
+      (with-redefs [fbranch/media-pairs (fn [& _] (swap! heuristic-runs inc) {})]
+        (reset! with-stamps (diff!)))
+      (t/is (some? @with-stamps))
+      (t/is (zero? @heuristic-runs)
+            "a fully stamped log compares without the heuristic")
+
+      ;; the same data, the stamps gone: the fallback describes the same
+      ;; pairings, so the summary agrees
+      (clear-media-id-maps! branch-file-id)
+      (let [without-stamps (diff!)]
+        (t/is (= @with-stamps without-stamps))))))
+
+(t/deftest update-from-main-records-the-map-it-applied
+  ;; The update applies main's media to the branch in the branch's id
+  ;; space ({main-media-id -> branch-media-id}) and the squash row
+  ;; records that map as applied, so a later comparison rebuilds the
+  ;; branch->main pairs from the record instead of the heuristic.
+  (with-redefs [cf/flags (conj cf/flags :branching)]
+    (let [profile (th/create-profile* 1 {:is-active true})
+          proj-id (:default-project-id profile)
+          file    (th/create-file* 1 {:profile-id (:id profile)
+                                      :project-id proj-id})
+          storage (-> (:app.storage/storage th/*system*)
+                      (assoc :app.storage/backend :fs))
+          sobj    (sto/put-object! storage {::sto/content (sto/content "update-image")
+                                            :bucket :file-media-object
+                                            :content-type "image/png"})
+          fmo     (th/create-file-media-object* {:file-id (:id file)
+                                                 :name "update.png"
+                                                 :media-id (:id sobj)})
+          create  (:result (th/command! {::th/type :create-file-branch
+                                         ::rpc/profile-id (:id profile)
+                                         :file-id (:id file)
+                                         :name "update-map"}))
+          branch-id      (:id create)
+          branch-file-id (:branch-file-id create)]
+
+      ;; main's new media row is referenced by a main-side shape the
+      ;; update applies, so the update copies it into the branch and its
+      ;; map lands in the stamp
+      (t/is (nil? (:error (apply-change* profile (:id file)
+                                         {:type :add-obj
+                                          :page-id (-> (read-file profile (:id file)) :data :pages first)
+                                          :id (uuid/random)
+                                          :parent-id uuid/zero
+                                          :frame-id uuid/zero
+                                          :obj (cts/setup-shape
+                                                {:id (uuid/random) :name "Main image" :type :image
+                                                 :parent-id uuid/zero :frame-id uuid/zero
+                                                 :metadata {:id (:id fmo)
+                                                            :width 100 :height 100
+                                                            :mtype "image/png"}})}))))
+      ;; the branch carries its own change (so the squash writes a net
+      ;; row) and main adds a change of its own (so the update reaches
+      ;; the write path)
+      (t/is (nil? (:error (apply-change* profile branch-file-id
+                                         {:type :add-color
+                                          :color {:id (uuid/random) :name "Branch"
+                                                  :color "#223344" :opacity 1}}))))
+      (t/is (nil? (:error (apply-change* profile (:id file)
+                                         {:type :add-color
+                                          :color {:id (uuid/random) :name "C1"
+                                                  :color "#112233" :opacity 1}}))))
+      (t/is (= :updated (-> (th/command! {::th/type :update-branch-from-main
+                                          ::rpc/profile-id (:id profile)
+                                          :branch-id branch-id})
+                            :result :status)))
+
+      (let [[stamp :as stamps] (media-id-maps branch-file-id)]
+        (t/is (= 1 (count stamps)))
+        (t/is (some? stamp))
+        (t/is (contains? stamp (:id fmo)))
+        (let [copy-id (get stamp (:id fmo))]
+          (t/is (not= (:id fmo) copy-id))
+          (t/is (= branch-file-id
+                   (:file-id (th/db-get :file-media-object {:id copy-id})))))))))
+
+(t/deftest merge-with-recorded-pairs-equals-the-heuristic-merge
+  ;; A merge of a branch whose log carries the recorded pairs produces
+  ;; the same summary and the same merge result the heuristic produced
+  ;; on the same data: the record describes the same pairings.
+  (with-redefs [cf/flags (conj cf/flags :branching)]
+    (let [{:keys [profile branch-id branch-file-id main-id page-id shape-id]}
+          (main-media-setup)
+
+          diff!
+          (fn []
+            (-> (th/command! {::th/type :get-branch-diff
+                              ::rpc/profile-id (:id profile)
+                              :branch-id branch-id})
+                :result
+                (select-keys [:stats :changes :conflicts])))]
+
+      ;; the stamps the saves left, then the same data with them erased:
+      ;; the summaries must agree
+      (let [with-stamps    (diff!)
+            _              (clear-media-id-maps! branch-file-id)
+            without-stamps (diff!)]
+        (t/is (= with-stamps without-stamps)
+              "same summary the heuristic produced"))
+
+      ;; merge the stamped branch and check the merged shape references
+      ;; a media row MAIN owns
+      (let [merge (-> (th/command! {::th/type :merge-file-branch
+                                    ::rpc/profile-id (:id profile)
+                                    :branch-id branch-id
+                                    :keep-branch true})
+                      :result)]
+        (t/is (= :merged (:status merge)))
+        (let [ref (-> (derived-obj profile main-id page-id shape-id)
+                      media-ref)
+              row (th/db-get :file-media-object {:id ref})]
+          (t/is (some? row))
+          (t/is (= main-id (:file-id row))))))))
+
 (t/deftest branch-save-fixes-foreign-media-refs-in-the-op-log
   ;; An ordinary save carries the media fix-up with its payload: the
   ;; foreign row is copied into the saving file and the reference is