🐛 Guard every reference a branch remap must rewrite

The schema safety net covered shapes only. It now also walks the file
data schema and each change type of the change schema, and fails when
a uuid field is neither a reference the remap rewrites nor classified
as none. Behaviour tests plant an id at every reference and check the
remap rewrites it and keeps every other id.

The nets found two gaps, both fixed: `remap-refs` kept the owning
`:file-id` of each media entry, which `remap-changes` already rewrote
in `:add-media`, and `remap-changes` skipped `:assign` operations of a
`:mod-obj`, which the change schema accepts.

AI-assisted-by: claude-opus-5-5
This commit is contained in:
Álvaro Tejero Cantero 2026-10-28 13:44:12 +01:00
parent 03eb22b945
commit 0c662250dc
No known key found for this signature in database
2 changed files with 444 additions and 18 deletions

View File

@ -1089,9 +1089,11 @@
({old-id -> new-id}): the file and media refs every shape holds
(`cfh/shape-ref-paths` and `cfh/legacy-shape-ref-paths`) and the page
default grid colours (`cfh/relink-containers`), plus the `:media`
collection keys and library-color `:image` ids. It is the same surface
`binfile.common/process-file` remaps when it copies a file. The
document's own `:id` and its `:tokens-source` are rewritten too, so a
collection keys and library-color `:image` ids, the surface
`binfile.common/process-file` remaps when it copies a file. Each media
object's owning `:file-id` is rewritten as well, as `remap-changes`
does for `:add-media` and `:mod-media`. The document's own `:id` and
its `:tokens-source` are rewritten too, so a
document moved into another file's id space names that file as itself,
and a tokens source that named the old file names the new one, which
`set-tokens-source` and `get-effective-tokens-source` read as self.
@ -1118,10 +1120,15 @@
(d/update-when :media
(fn [media]
(reduce-kv (fn [res k v]
(let [id (lookup k)]
(if (= id k)
(let [id (lookup k)
file-id (:file-id v)
owner (some-> file-id lookup)]
(if (and (= id k) (= owner file-id))
res
(-> res (dissoc k) (assoc id (assoc v :id id))))))
(-> res
(dissoc k)
(assoc id (cond-> (assoc v :id id)
(some? file-id) (assoc :file-id owner)))))))
media
media)))
(d/update-when :colors
@ -1137,14 +1144,22 @@
(defn- remap-op
"Rewrite the references of one `:mod-obj` operation through `lookup`.
`shape-set-ops` emits one `:set` per differing attr, so the value is
relinked as that attr of a shape: a reference arrives as the attr's own
value (`:component-file`) or nested in it (`:fills`, `:metadata`, …)."
[{:keys [attr val] :as op} lookup]
(if (and (= :set (:type op)) (some? val))
(let [shape {attr val}
shape' (cfh/relink-shape shape lookup)]
(if (identical? shape shape') op (assoc op :val (get shape' attr))))
A `:set` value is relinked as that attr of a shape: a reference arrives
as the attr's own value (`:component-file`) or nested in it (`:fills`,
`:metadata`, …). An `:assign` value is a partial shape already."
[{:keys [attr val value] :as op} lookup]
(case (:type op)
:set
(if (some? val)
(let [shape {attr val}
shape' (cfh/relink-shape shape lookup)]
(if (identical? shape shape') op (assoc op :val (get shape' attr))))
op)
:assign
(let [value' (cfh/relink-shape value lookup)]
(if (identical? value value') op (assoc op :value value')))
op))
(defn remap-changes
@ -1158,7 +1173,8 @@
Each change type that can carry a reference is relinked where it does:
- `:add-obj`: the `:obj` shape (`cfh/relink-shape`);
- `:mod-obj`: the value of each `:set` operation (`remap-op`);
- `:mod-obj`: the value of each `:set` and `:assign` operation
(`remap-op`);
- `:add-page`: the `:page`, its shapes and default grids
(`cfh/relink-page`);
- `:set-default-grid`: the grid colour of `:params`

View File

@ -5,13 +5,18 @@
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns common-tests.files-ref-paths-test
"Safety net for `cfh/shape-ref-paths`: every uuid the shape schema
declares is either a file or media reference listed there, or a
non-reference listed here."
"Safety nets for the file and media references branching re-points.
Every uuid a schema declares is either a reference the relink rewrites
or a non-reference listed here, for three surfaces: shapes
(`cfh/shape-ref-paths`), the rest of file data (`bm/remap-refs`), and
change payloads (`bm/remap-changes`)."
(:require
[app.common.files.branch-merge :as bm]
[app.common.files.changes :as ch]
[app.common.files.helpers :as cfh]
[app.common.schema :as sm]
[app.common.schema.generators :as sg]
[app.common.types.file :as ctf]
[app.common.types.shape :as cts]
[app.common.uuid :as uuid]
[clojure.set :as set]
@ -267,3 +272,408 @@
(t/deftest relink-objects-preserves-identity
(let [objects (into {} (map (juxt :id identity)) @generated-shapes)]
(t/is (identical? objects (cfh/relink-objects objects identity)))))
;; File data
;;
;; `bm/remap-refs` moves a whole document into another file's id space.
;; Shapes go through `cfh/relink-shape`, which the net above guards; this
;; net guards every other uuid of the document.
(defn- under?
[prefix path]
(and (<= (count prefix) (count path))
(= prefix (subvec path 0 (count prefix)))))
(def ^:private file-data-shape-subtrees
"Shape maps inside file data, classified by the shape net. Component
shapes are declared as plain `:map` (`ctn/schema:container`), so the
walk never reaches them; the page ones it does are skipped here."
[[:pages-index ::vals :objects ::vals]
[:components ::vals :objects ::vals]])
(def ^:private file-data-inventory
"Uuid paths of `ctf/schema:data` outside shapes. The schema omits the
`:media` map that `:add-media` changes fill, so its entries are walked
from `ctf/schema:media`."
(delay
(->> (concat (schema-uuid-paths ctf/schema:data)
(map #(into [:media] %)
(schema-uuid-paths [:map-of ::sm/uuid ctf/schema:media])))
(remove (fn [path] (some #(under? % path) file-data-shape-subtrees)))
(vec))))
(def ^:private file-data-ref-paths
"File data paths `bm/remap-refs` rewrites: each names a file or a media
object."
#{;; file whose tokens lib the document uses
[:tokens-source]
;; library colour image
[:colors ::vals :image :id]
;; page default grid colours (`cfh/relink-page`)
[:pages-index ::vals :default-grids :square :color :ref-file]
[:pages-index ::vals :default-grids :row :color :ref-file]
[:pages-index ::vals :default-grids :column :color :ref-file]
;; media objects: their id, and the file that owns the row
[:media ::keys]
[:media ::vals :id]
[:media ::vals :file-id]})
(def ^:private file-data-undeclared-ref-paths
"References `bm/remap-refs` rewrites that `ctf/schema:data` does not
declare, so the inventory cannot find them; behaviour checks them."
#{;; the document's own id
[:id]
;; legacy grid colour `:file-id` (`cfh/legacy-shape-ref-paths`), and
;; `:saved-grids`, where default grids lived before migration
;; `legacy-55`
[:pages-index ::vals :default-grids ::vals :color :file-id]
[:pages-index ::vals :options :saved-grids ::vals :color :ref-file]
[:pages-index ::vals :options :saved-grids ::vals :color :file-id]})
(def ^:private file-data-non-reference-paths
"File data uuid paths that name no file and no media object."
#{;; page identity and order
[:pages :*]
[:pages-index ::keys]
[:pages-index ::vals :id]
;; shape ids keying the page objects
[:pages-index ::vals :objects ::keys]
;; colour id inside its library
[:pages-index ::vals :default-grids :square :color :ref-id]
[:pages-index ::vals :default-grids :row :color :ref-id]
[:pages-index ::vals :default-grids :column :color :ref-id]
;; prototype flows, guides, and comment positions of a page
[:pages-index ::vals :flows ::keys]
[:pages-index ::vals :flows ::vals :id]
[:pages-index ::vals :flows ::vals :starting-frame]
[:pages-index ::vals :guides ::keys]
[:pages-index ::vals :guides ::vals :id]
[:pages-index ::vals :guides ::vals :frame-id]
[:pages-index ::vals :comment-thread-positions ::keys]
[:pages-index ::vals :comment-thread-positions ::vals :frame-id]
;; asset identity
[:colors ::keys]
[:colors ::vals :id]
[:components ::keys]
[:components ::vals :id]
[:components ::vals :objects ::keys]
[:typographies ::keys]
[:typographies ::vals :id]
;; storage objects behind a media object, not media objects
[:media ::vals :media-id]
[:media ::vals :thumbnail-id]})
(t/deftest every-file-data-uuid-is-classified
(let [known (set/union file-data-ref-paths file-data-non-reference-paths)
missing (vec (remove known @file-data-inventory))]
(t/is (empty? missing)
(str "Unclassified uuid paths in `ctf/schema:data`: " (pr-str missing)
". Add each path that names a file or a media object to"
" `file-data-ref-paths` in this test, and make `bm/remap-refs`"
" rewrite it; add any other path to"
" `file-data-non-reference-paths`."))))
(t/deftest file-data-classification-is-in-schema
(let [found (set @file-data-inventory)]
(t/is (empty? (remove found file-data-ref-paths))
"`file-data-ref-paths` entries absent from the file data schema")
(t/is (empty? (remove found file-data-non-reference-paths))
"`file-data-non-reference-paths` entries absent from the file data schema")
(t/is (empty? (filter found file-data-undeclared-ref-paths))
"`file-data-undeclared-ref-paths` entries the schema now declares: move them to `file-data-ref-paths`")))
(def ^:private file-data-shape-probes
"One reference per shape container, to show `bm/remap-refs` reaches
shapes on pages and in deleted components."
[[:pages-index ::vals :objects ::vals :component-file]
[:components ::vals :objects ::vals :fills :* :fill-image :id]])
(defn- file-data-fixture
"File data with a distinct uuid at every classified path."
[]
(let [id uuid/next
page-id (id)
shape-id (id)
comp-id (id)
cshape (id)
media-id (id)
color-id (id)
typo-id (id)
flow-id (id)
guide-id (id)
thread (id)
grid (fn [] {:color {:ref-id (id) :ref-file (id)}})]
{:id (id)
:tokens-source (id)
:pages [page-id]
:pages-index
{page-id {:id page-id
:objects {shape-id {:id shape-id :component-file (id)}}
:default-grids {:square (assoc-in (grid) [:color :file-id] (id))
:row (grid)
:column (grid)}
:options {:saved-grids {:square {:color {:ref-file (id)
:file-id (id)}}}}
:flows {flow-id {:id flow-id :starting-frame (id)}}
:guides {guide-id {:id guide-id :frame-id (id)}}
:comment-thread-positions {thread {:frame-id (id)}}}}
:colors {color-id {:id color-id :image {:id (id)}}}
:components {comp-id {:id comp-id
:objects {cshape {:id cshape
:fills [{:fill-image {:id (id)}}]}}}}
:typographies {typo-id {:id typo-id}}
:media {media-id {:id media-id
:file-id (id)
:media-id (id)
:thumbnail-id (id)}}}))
(defn- all-uuids
"Every uuid in `x`, map keys included."
[x]
(into #{} (filter uuid?) (tree-seq coll? seq x)))
(t/deftest remap-refs-rewrites-file-data-refs-only
(let [data (file-data-fixture)
ref-paths (concat file-data-ref-paths
file-data-undeclared-ref-paths
file-data-shape-probes)
;; every uuid is renamed, so a kept non-reference proves a skip
id-map (into {} (map (fn [id] [id (uuid/next)])) (all-uuids data))
lookup #(get id-map % %)
result (bm/remap-refs data id-map)]
(t/testing "the fixture holds a uuid at every classified path"
(t/is (empty? (remove #(some uuid? (locate data %))
(concat ref-paths file-data-non-reference-paths)))))
(doseq [path ref-paths]
(t/is (= (set (map lookup (locate data path)))
(set (locate result path)))
(str "reference not rewritten: " (pr-str path))))
(doseq [path file-data-non-reference-paths]
(t/is (= (set (locate data path))
(set (locate result path)))
(str "non-reference changed: " (pr-str path))))))
;; Change payloads
;;
;; `bm/remap-changes` moves a change vector into another file's id space.
;; Paths are `[type & path]`, one per `:multi` branch of `ch/schema:change`.
;; Subtrees another net guards, each through the relink it calls:
;; [:add-obj :obj] `cfh/relink-shape`: the shape net
;; [:add-page :page] `cfh/relink-page`: the shape net and the
;; default grids of the file data net; declared
;; `::sm/any`, so the walk never sees it
;; [:add-component :objects] `cfh/relink-objects`: the shape net;
;; [:mod-component :objects] undeclared, so the walk never sees them
;; [:mod-obj :operations] a `:set` value is any shape attr, declared
;; `::sm/any`: `remap-changes-relinks-mod-obj-set-values`
;; `change-subtree-probes` checks one reference under each.
(def ^:private change-shape-subtrees
[[:add-obj :obj]])
(def ^:private change-inventory
(delay
(let [schema (m/deref-all (sm/schema ch/schema:change))]
(->> (m/children schema)
(mapcat (fn [[type _ child]]
(map #(into [type] %) (schema-uuid-paths child))))
(remove (fn [path] (some #(under? % path) change-shape-subtrees)))
(vec)))))
(def ^:private change-ref-paths
"Change paths `bm/remap-changes` rewrites: each names a file or a media
object."
#{[:set-default-grid :params :color :ref-file]
[:add-color :color :image :id]
[:mod-color :color :image :id]
[:add-media :object :id]
[:add-media :object :file-id]
[:mod-media :object :id]
[:mod-media :object :file-id]
[:del-media :id]
[:set-tokens-source :file-id]
[:set-tokens-source :library-id]})
(def ^:private change-undeclared-ref-paths
"References `bm/remap-changes` rewrites that `ch/schema:change` does
not declare."
#{;; legacy grid colour `:file-id` (`cfh/legacy-shape-ref-paths`)
[:set-default-grid :params :color :file-id]})
(def ^:private change-subtree-probes
[[:add-obj :obj :component-file]
[:add-page :page :objects ::vals :fills :* :fill-image :id]
[:add-page :page :default-grids ::vals :color :ref-file]
[:add-component :objects ::vals :component-file]
[:mod-component :objects ::vals :component-file]])
(def ^:private change-non-reference-paths
"Change uuid paths that name no file and no media object."
#{;; entity identity: shape, page, component, colour, typography
[:add-obj :id]
[:mod-obj :id]
[:del-obj :id]
[:fix-obj :id]
[:add-page :id]
[:mod-page :id]
[:del-page :id]
[:mov-page :id]
[:add-component :id]
[:mod-component :id]
[:del-component :id]
[:restore-component :id]
[:purge-component :id]
[:add-color :color :id]
[:mod-color :color :id]
[:del-color :id]
[:add-typography :typography :id]
[:mod-typography :typography :id]
[:del-typography :id]
;; container and tree position
[:add-obj :page-id]
[:add-obj :component-id]
[:add-obj :frame-id]
[:add-obj :parent-id]
[:mod-obj :page-id]
[:mod-obj :component-id]
[:del-obj :page-id]
[:del-obj :component-id]
[:fix-obj :page-id]
[:fix-obj :component-id]
[:mov-objects :page-id]
[:mov-objects :component-id]
[:mov-objects :parent-id]
[:reorder-children :page-id]
[:reorder-children :component-id]
[:reorder-children :parent-id]
[:reg-objects :page-id]
[:reg-objects :component-id]
[:reg-objects :shapes :*]
[:set-default-grid :page-id]
[:restore-component :page-id]
;; component main instance and variant
[:add-component :main-instance-id]
[:add-component :main-instance-page]
[:add-component :variant-id]
[:mod-component :variant-id]
;; colour id inside its library
[:set-default-grid :params :color :ref-id]
;; guides, flows, comment positions, and plugin data targets
[:set-guide :page-id]
[:set-guide :id]
[:set-guide :params :id]
[:set-guide :params :frame-id]
[:set-flow :page-id]
[:set-flow :id]
[:set-flow :params :id]
[:set-flow :params :starting-frame]
[:set-comment-thread-position :comment-thread-id]
[:set-comment-thread-position :page-id]
[:set-comment-thread-position :frame-id]
[:set-plugin-data :object-id]
[:set-plugin-data :page-id]
;; storage objects behind a media object, not media objects
[:add-media :object :media-id]
[:add-media :object :thumbnail-id]
[:mod-media :object :media-id]
[:mod-media :object :thumbnail-id]
;; ids inside the tokens lib
[:set-token :set-id]
[:set-token :token-id]
[:set-token :attrs :id]
[:set-token-set :id]
[:set-token-set :attrs :id]
[:set-token-set :attrs :tokens ::vals :id]
[:set-token-theme :id]
[:set-token-theme :attrs :id]
[:set-tokens-status :theme-ids ::set]
[:set-tokens-status :set-ids ::set]})
(t/deftest every-change-uuid-is-classified
(let [known (set/union change-ref-paths change-non-reference-paths)
missing (vec (remove known @change-inventory))]
(t/is (empty? missing)
(str "Unclassified uuid paths in `ch/schema:change`, as [type & path]: "
(pr-str missing)
". Add each path that names a file or a media object to"
" `change-ref-paths` in this test, and make `bm/remap-changes`"
" rewrite it for that change type; add any other path to"
" `change-non-reference-paths`."))))
(t/deftest change-classification-is-in-schema
(let [found (set @change-inventory)]
(t/is (empty? (remove found change-ref-paths))
"`change-ref-paths` entries absent from the change schema")
(t/is (empty? (remove found change-non-reference-paths))
"`change-non-reference-paths` entries absent from the change schema")
(t/is (empty? (filter found change-undeclared-ref-paths))
"`change-undeclared-ref-paths` entries the schema now declares: move them to `change-ref-paths`")))
(defn- build-at
"A minimal map holding `v` at `path`."
[path v]
(if-let [[step & more] (seq path)]
(cond
(= :* step) [(build-at more v)]
(= ::set step) #{(build-at more v)}
(= ::keys step) {v {}}
(= ::vals step) {:entry (build-at more v)}
:else {step (build-at more v)})
v))
(defn- remap-at
"Plant `old` at `[type & path]` in a change of that type, remap it with
`{old new}`, and return the values found at the path afterwards."
[[type & path] old new]
(let [change (assoc (build-at path old) :type type)
[out] (bm/remap-changes [change] {old new})]
(locate out path)))
(t/deftest remap-changes-rewrites-refs
(doseq [path (concat change-ref-paths
change-undeclared-ref-paths
change-subtree-probes)]
(let [old (uuid/next)
new (uuid/next)]
(t/is (= [new] (remap-at path old new))
(str "reference not rewritten: " (pr-str path))))))
(t/deftest remap-changes-keeps-non-references
(doseq [path change-non-reference-paths]
(let [old (uuid/next)]
(t/is (= [old] (remap-at path old (uuid/next)))
(str "non-reference changed: " (pr-str path))))))
(t/deftest remap-changes-relinks-mod-obj-set-values
;; `shape-set-ops` emits one `:set` per differing attr, so a reference
;; travels as the value of its top-level shape attr
(doseq [[attr paths] (group-by first @all-ref-paths)]
(let [shape (reduce #(plant %1 %2 uuid/next) {} paths)
id-map (into {} (map (fn [id] [id (uuid/next)])) (uuids-at shape paths))
change {:type :mod-obj
:id (uuid/next)
:page-id (uuid/next)
:operations [{:type :set :attr attr :val (get shape attr)}]}
[out] (bm/remap-changes [change] id-map)
result {attr (get-in out [:operations 0 :val])}]
(t/is (seq id-map) (str "nothing planted under " attr))
(doseq [path paths]
(t/is (= (mapv #(get id-map % %) (locate shape path))
(vec (locate result path)))
(str "`:set " attr "` value not relinked at " (pr-str path)))))))
(t/deftest remap-changes-relinks-mod-obj-assign-values
;; an `:assign` carries a partial shape: every ref path in one value
(let [paths @all-ref-paths
shape (reduce #(plant %1 %2 uuid/next) {} paths)
id-map (into {} (map (fn [id] [id (uuid/next)])) (uuids-at shape paths))
change {:type :mod-obj
:id (uuid/next)
:page-id (uuid/next)
:operations [{:type :assign :value shape}]}
[out] (bm/remap-changes [change] id-map)
result (get-in out [:operations 0 :value])]
(doseq [path paths]
(t/is (= (mapv #(get id-map % %) (locate shape path))
(vec (locate result path)))
(str "`:assign` value not relinked at " (pr-str path))))))