github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-10-29 14:00:37 +00:00
Code Issues Packages Projects Releases Wiki Activity

🐛 Fix the defects the engine design read found

Browse Source 
Depth gate: the compare reads the op log and applies the depth gate
before it derives the branch, the same order merge and update from
main use, so a log too deep to replay refuses before the derive runs.
The refusal names the materialise and the delete, the two remedies the
gates do not refuse, in the hint and in the notification copy.

Resolutions: the conflict answers of merge-file-branch and
update-branch-from-main carry the main revision the conflicts were
computed against, and the client sends it as expected-main-revn when
resolutions are applied before the dialog's diff fetch returns.

Libraries: absorbing skips branch files, so unpublishing or deleting a
shared library writes no payload on a branch and the branch keeps its
own link; a soft-deleted library resolves nothing there until the
branch's next update from main brings main's absorbed copies. The
absorbed write passes the file's features to update-file!, which the
hand-built params dropped, so the pointer-map fragments the absorption
regenerates are persisted and no payload references a fragment no
write produced.

Queries: the project file count, the team file count, the list of
files that use a library, and the socket-REPL team duplication skip
branch files.

Snapshots: the branch refusal lives in check-restorable!, which the
restore command calls before its backup snapshot and the two
socket-REPL restore helpers reach through restore!.

Migration 0155: the base_branch_revn backfill repositions only the
rows whose branch file carries a data payload, so a re-run changes
nothing on the branches the op-log model creates.

Tests: the branch merge tests run in JavaScript, which the common test
runner lists; new backend tests pin the gates, the absorption skip,
the query filters, the restore refusals, the migration re-run, and the
conflict answers' revision; a new frontend test pins the token the
senders carry with resolutions.

AI-assisted-by: mixed models
Signed-off-by: Álvaro Tejero Cantero <alvorithm@teje.ro>
This commit is contained in:
Álvaro Tejero Cantero 2026-10-04 00:49:24 +02:00
parent 2458bdb88b
commit b0e01ef2ef
No known key found for this signature in database
17 changed files with 778 additions and 56 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
backend/src/app/binfile/common.clj
View File

@ -852,7 +852,8 @@
(def ^:private sql:get-team-files-ids
"SELECT f.id FROM file AS f
JOIN project AS p ON (p.id = f.project_id)
WHERE p.team_id = ?")
WHERE p.team_id = ?
AND f.is_branch IS FALSE")
(defn get-team-files-ids
"Get a set of file ids for the specified team-id"

14
backend/src/app/features/file_snapshots.clj
View File

@ -60,6 +60,7 @@
f.revn,
f.modified_at,
f.deleted_at,
f.is_branch,
fd.backend AS backend,
fd.metadata AS metadata
FROM file AS f
@ -313,6 +314,17 @@
(db/get-update-count)
(pos?))))
(defn check-restorable!
"Refuse to restore a snapshot onto a branch file. A branch file's data
is derived from the branch base and the operation log, so a restore
would persist a `file_data` row that no read path consults."
[{:keys [id is-branch]}]
(when is-branch
(ex/raise :type :validation
:code :branch-file-cant-be-restored
:hint "branch file data is derived from the branch base and the operation log; restore the snapshot on the source file or update the branch from main instead"
:file-id id)))
(defn restore!
[{:keys [::db/conn] :as cfg} file-id snapshot-id]
(let [lock-sql (str sql:get-minimal-file " FOR UPDATE OF f SKIP LOCKED")
@ -323,6 +335,8 @@
:code :file-locked
:hint "the file is currently locked by another operation, retry later"))
(check-restorable! row)
(let [file (d/update-when row :metadata fdata/decode-metadata)
vern (rand-int Integer/MAX_VALUE)

17
backend/src/app/migrations/sql/0155-add-file-branch-table.sql
View File

@ -45,8 +45,21 @@ ALTER TABLE file_branch
ADD COLUMN IF NOT EXISTS base_branch_revn bigint NOT NULL DEFAULT 0;
-- backfill: at creation both counters coincide, so base_revn is the best
-- available approximation for rows created before the column existed
UPDATE file_branch SET base_branch_revn = base_revn WHERE base_branch_revn = 0;
-- available approximation for rows created before the column existed.
-- The rows this is for kept the copy model, where the branch file
-- persisted its own data payload; an op-log branch stores no payload and
-- legitimately starts its own counter at 0, so the payload's existence
-- is what tells the two apart, and the statement changes nothing on a
-- re-run (a renamed re-registration re-applies the whole file).
UPDATE file_branch fb
SET base_branch_revn = fb.base_revn
FROM file f
WHERE fb.branch_file_id = f.id
AND fb.base_branch_revn = 0
AND EXISTS (SELECT 1
FROM file_data fd
WHERE fd.file_id = f.id
AND fd.deleted_at IS NULL);
CREATE INDEX IF NOT EXISTS file_branch__source_file_id__idx
ON file_branch(source_file_id) WHERE deleted_at IS NULL;

39
backend/src/app/rpc/commands/files.clj
View File

@ -749,7 +749,8 @@
FROM file_library_rel AS flr
JOIN file AS f ON (f.id = flr.file_id)
WHERE flr.library_file_id = ?
AND (f.deleted_at IS NULL OR f.deleted_at > now())")
AND (f.deleted_at IS NULL OR f.deleted_at > now())
AND f.is_branch IS FALSE")
(defn get-library-file-references
[conn file-id]
@ -932,14 +933,34 @@
;; --- MUTATION COMMAND: set-file-shared
;; Absorption skips branch files. A branch stores no data payload, so an
;; absorption written to one would land in a `file_data` row that no read
;; consults. An open branch reaches main's absorbed copies on its next
;; update from main. Until then an unpublished library still resolves in
;; the branch through the branch's own link, which `set-file-shared`
;; keeps, and a soft-deleted library resolves nothing in the branch. A
;; branch file keeps `is_branch` while its deletion is pending, so the
;; filter also skips a deleted branch, whose derive would fail on its
;; deleted `file_branch` row. A materialised file is no longer a branch
;; and absorbs like any other file.
(def ^:private sql:get-referenced-files
"SELECT f.id
FROM file_library_rel AS flr
INNER JOIN file AS f ON (f.id = flr.file_id)
WHERE flr.library_file_id = ?
AND (f.deleted_at IS NULL OR f.deleted_at > now())
AND f.is_branch IS FALSE
ORDER BY f.created_at ASC;")
;; The unpublish unlinks the files that absorbed the library. A branch
;; keeps its link (see `sql:get-referenced-files`).
(def ^:private sql:unlink-absorbed-files
"DELETE FROM file_library_rel AS flr
USING file AS f
WHERE f.id = flr.file_id
AND flr.library_file_id = ?
AND f.is_branch IS FALSE")
(defn- absorb-library-by-file
[cfg ldata file-id]
@ -957,12 +978,14 @@
:library-id (str (:id ldata))
:file-id (str file-id))
(bfc/update-file! cfg {:id file-id
:migrations (:migrations file)
:revn (inc (:revn file))
:data (:data file)
:modified-at (ct/now)
:has-media-trimmed false}))))
;; the file as read, features included: the absorbed data carries
;; pointer maps whose ids `absorb-assets` regenerated, and without
;; `:features` the encode below would skip the pointer persistence
;; and leave those fragments unwritten
(bfc/update-file! cfg (assoc file
:revn (inc (:revn file))
:modified-at (ct/now)
:has-media-trimmed false)))))
(defn- absorb-library*
"Find all files using a shared library, and absorb all library assets
@ -1014,7 +1037,7 @@
;; perform all required validations.
(let [file (-> (absorb-library cfg id)
(assoc :is-shared false))]
(db/delete! conn :file-library-rel {:library-file-id id})
(db/exec-one! conn [sql:unlink-absorbed-files id])
(db/update! conn :file
{:is-shared false
:modified-at (ct/now)}

32
backend/src/app/rpc/commands/files_branch.clj
View File

@ -127,7 +127,7 @@
(ex/raise :type :restriction
:code :branching-oplog-limit-exceeded
:hint (str "this branch has " depth " changes in its op log and the limit is "
limit "; merge it, or materialise it into an ordinary file")
limit "; materialise it into an ordinary file, or delete it")
:operation operation
:branch-file-id branch-file-id
:limit limit
@ -872,10 +872,10 @@
dir (or direction :branch->main)
main-file (-> (bfc/get-file cfg (:source-file-id branch) :realize? true)
(check-file-size-limits! :compare))
branch-file (bfc/get-file cfg (:branch-file-id branch)
:realize? true :include-base-data? true)
log (-> (branch-log cfg (:branch-file-id branch))
(check-oplog-depth-limit! (:branch-file-id branch) :compare))
branch-file (bfc/get-file cfg (:branch-file-id branch)
:realize? true :include-base-data? true)
main-data (:data main-file)
branch-data (bm/remap-refs
(:data branch-file)
@ -946,9 +946,10 @@
"Merge a branch into its source file (main).
Conflicts that `resolutions` leaves unresolved make the command return
`{:status :conflicts}`; a resolved conflict merges the side its
resolution picks, per entity or per attr. Change kinds the engine
cannot translate (`bm/unsupported-kinds`) make it return
`{:status :conflicts}`, with the `:main-revn` they were computed against
so the retry can pass it as `expected-main-revn`; a resolved conflict
merges the side its resolution picks, per entity or per attr. Change
kinds the engine cannot translate (`bm/unsupported-kinds`) make it return
`{:status :unsupported}` so no change is silently dropped. Otherwise it
takes a safety snapshot of main, applies the merge to main through the
production change pipeline, marks the branch merged and notifies open
@ -1068,7 +1069,8 @@
:session-id session-id})))))]
(cond
(seq unresolved)
(audited {:status :conflicts :conflicts conflicts} tpoint :merge)
(audited {:status :conflicts :conflicts conflicts :main-revn (:revn main-file)}
tpoint :merge)
:else
(let [{:keys [changes unsupported]}
@ -1219,12 +1221,13 @@
(sv/defmethod ::update-branch-from-main
"Bring the changes main received since the merge base into the branch
(the reverse direction of a merge). Returns `{:status :conflicts}` when
main and the branch diverged on the same entity and it is not resolved
in `resolutions`, or `{:status :unsupported}` for change kinds not yet
translatable. On success it applies main's changes (and any conflicts
resolved to main) to the branch, takes a safety snapshot, and
repositions the merge base to the current state of main."
(the reverse direction of a merge). Returns `{:status :conflicts}` (with
the `:main-revn` they were computed against) when main and the branch
diverged on the same entity and it is not resolved in `resolutions`, or
`{:status :unsupported}` for change kinds not yet translatable. On
success it applies main's changes (and any conflicts resolved to main)
to the branch, takes a safety snapshot, and repositions the merge base
to the current state of main."
{::doc/added "2.16"
::webhooks/event? true
::sm/params schema:update-branch-from-main
@ -1378,7 +1381,8 @@
(cond
(seq unresolved)
(audited {:status :conflicts :conflicts conflicts} tpoint :update-from-main)
(audited {:status :conflicts :conflicts conflicts :main-revn (:revn main-file)}
tpoint :update-from-main)
:else
;; target = branch, source = main -> changes that bring main's

12
backend/src/app/rpc/commands/files_snapshot.clj
View File

@ -119,14 +119,10 @@
(files/check-edition-permissions! pool profile-id file-id)
(let [file (bfc/get-file cfg file-id)
;; A branch file's data payload is derived from the branch base
;; and the operation log; restoring would persist a `file_data`
;; row no read path consults.
_ (when (:is-branch file)
(ex/raise :type :validation
:code :branch-file-cant-be-restored
:hint "branch file data is derived from the branch base and the operation log; restore the snapshot on the source file or update the branch from main instead"
:file-id file-id))
;; `fsnap/restore!` refuses a branch file too. The command
;; refuses before it takes the backup snapshot below, which is
;; committed whatever the restore's outcome.
_ (fsnap/check-restorable! file)
team (teams/get-team pool
:profile-id profile-id

6
backend/src/app/rpc/commands/projects.clj
View File

@ -82,9 +82,11 @@
coalesce(tpp.is_pinned, false) as is_pinned,
(SELECT count(*) FROM file AS f
WHERE f.project_id = p.id
AND f.deleted_at is null) AS count,
AND f.deleted_at is null
AND f.is_branch IS FALSE) AS count,
(SELECT count(*) FROM file AS f
WHERE f.project_id = p.id) AS total_count
WHERE f.project_id = p.id
AND f.is_branch IS FALSE) AS total_count
FROM project AS p
INNER JOIN team AS t ON (t.id = p.team_id)
LEFT JOIN team_project_profile_rel AS tpp

2
backend/src/app/rpc/commands/teams.clj
View File

@ -457,7 +457,7 @@
(def sql:team-stats
"select (select count(*) from project where team_id = ?) as projects,
(select count(*) from file as f join project as p on (p.id = f.project_id) where p.team_id = ?) as files")
(select count(*) from file as f join project as p on (p.id = f.project_id) where p.team_id = ? and f.is_branch is false) as files")
(defn get-team-stats
[conn team-id]

71
backend/test/backend_tests/branch_file_queries_test.clj Normal file
View File

@ -0,0 +1,71 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns backend-tests.branch-file-queries-test
"Regression tests for the queries that count or list a team's files: a
branch file is a hidden copy of its main file, so none of them may
count it, list it, or copy it as an ordinary file."
(:require
[app.binfile.common :as bfc]
[app.common.data :as d]
[app.config :as cf]
[app.db :as db]
[app.rpc :as-alias rpc]
[backend-tests.helpers :as th]
[clojure.test :as t]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(t/deftest counts-and-listings-skip-branch-files
(with-redefs [cf/flags (conj cf/flags :branching)]
(let [profile (th/create-profile* 1 {:is-active true})
team-id (:default-team-id profile)
proj-id (:default-project-id profile)
library (th/create-file* 1 {:profile-id (:id profile)
:project-id proj-id
:is-shared true})
main (th/create-file* 2 {:profile-id (:id profile)
:project-id proj-id
:is-shared false})
_ (th/link-file-to-library* {:file-id (:id main) :library-id (:id library)})
out (th/command! {::th/type :create-file-branch
::rpc/profile-id (:id profile)
:file-id (:id main)
:name "hidden"})
branch-id (-> out :result :branch-file-id)]
(t/is (nil? (:error out)))
;; the branch copied main's link to the library
(t/is (seq (th/db-query :file-library-rel {:file-id branch-id
:library-file-id (:id library)})))
(t/testing "the project counts the library and main only"
(let [out (th/command! {::th/type :get-projects
::rpc/profile-id (:id profile)
:team-id team-id})
proj (d/seek #(= proj-id (:id %)) (:result out))]
(t/is (nil? (:error out)))
(t/is (= 2 (:count proj)))
(t/is (= 2 (:total-count proj)))))
(t/testing "the team stats count the library and main only"
(let [out (th/command! {::th/type :get-team-stats
::rpc/profile-id (:id profile)
:team-id team-id})]
(t/is (nil? (:error out)))
(t/is (= 2 (-> out :result :files)))))
(t/testing "the unpublish dialog lists main only"
(let [out (th/command! {::th/type :get-library-file-references
::rpc/profile-id (:id profile)
:file-id (:id library)})]
(t/is (nil? (:error out)))
(t/is (= [(:id main)] (mapv :id (:result out))))))
(t/testing "a team duplication copies the library and main only"
(t/is (= #{(:id library) (:id main)}
(db/run! th/*system* bfc/get-team-files-ids team-id)))))))

246
backend/test/backend_tests/branch_payload_writers_test.clj
View File

@ -11,9 +11,13 @@
is invisible to every read path and silently desynchronises the
derived state."
(:require
[app.common.features :as cfeat]
[app.common.time :as ct]
[app.common.types.shape :as cts]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.features.file-snapshots :as fsnap]
[app.rpc :as-alias rpc]
[app.srepl.helpers :as h]
[backend-tests.helpers :as th]
@ -54,6 +58,92 @@
(get :file-id))))
(into #{})))
(defn- branch-row-id
"The `file_branch` row id of a live branch file."
[branch-file-id]
(:id (th/db-get :file-branch {:branch-file-id branch-file-id})))
(defn- apply-change!
[profile file-id change]
(let [file (th/db-get :file {:id file-id})
out (th/command! {::th/type :update-file
::rpc/profile-id (:id profile)
:id file-id
:session-id (uuid/random)
:revn (:revn file)
:vern (:vern file)
:features cfeat/supported-features
:changes [change]})]
(t/is (nil? (:error out)))))
(defn- file-data
"The `:data` of a file as the read path serves it: derived for a
branch file."
[profile file-id]
(let [out (th/command! {::th/type :get-file
::rpc/profile-id (:id profile)
:id file-id})]
(t/is (nil? (:error out)))
(-> out :result :data)))
(defn- linked-library-ids
"The libraries a file resolves, as the workspace reads them."
[profile file-id]
(let [out (th/command! {::th/type :get-file-libraries
::rpc/profile-id (:id profile)
:file-id file-id})]
(t/is (nil? (:error out)))
(into #{} (map :id) (:result out))))
(defn- update-from-main!
[profile branch-file-id]
(let [out (th/command! {::th/type :update-branch-from-main
::rpc/profile-id (:id profile)
:branch-id (branch-row-id branch-file-id)})]
(t/is (nil? (:error out)))
(t/is (= :updated (-> out :result :status)))))
(defn- fill-ref-file
[data {:keys [page-id shape-id]}]
(get-in data [:pages-index page-id :objects shape-id :fills 0 :fill-color-ref-file]))
(defn- setup-library-use!
"A shared library publishing one colour, and a main file linked to it
whose one shape fills with that colour."
[profile]
(let [library (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared true})
main (create-file profile 2)
color-id (uuid/random)
shape-id (uuid/random)
page-id (-> (file-data profile (:id main)) :pages first)]
(apply-change! profile (:id library)
{:type :add-color
:color {:id color-id :name "Brand" :color "#ff0000" :opacity 1}})
(th/link-file-to-library* {:file-id (:id main) :library-id (:id library)})
(apply-change! profile (:id main)
{: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 "Branded" :type :rect
:parent-id uuid/zero :frame-id uuid/zero})
(assoc :fills [{:fill-color "#ff0000"
:fill-opacity 1
:fill-color-ref-id color-id
:fill-color-ref-file (:id library)}]))})
{:library-id (:id library)
:main-id (:id main)
:main main
:color-id color-id
:page-id page-id
:shape-id shape-id}))
(t/deftest process-file!-refuses-branch-file
;; The admin repair entry points (`app.http.debug` file-repair and
;; `app.srepl.main/repair-file!`) both run through `process-file!`,
@ -115,3 +205,159 @@
(t/is (false? result))
(t/is (empty? (payload-rows branch-id)))
(t/is (false? (:has-media-trimmed (th/db-get :file {:id branch-id}))))))))
(t/deftest unpublish-library-skips-branch
;; Unpublishing a library absorbs its assets into the files that use it
;; through `bfc/update-file!`, a write a branch must never take. The
;; branch keeps its link instead, so the unpublished library still
;; resolves there, and its next update from main brings main's
;; absorbed copy.
(with-redefs [cf/flags (conj cf/flags :branching)]
(let [profile (th/create-profile* 1 {:is-active true})
{:keys [library-id main-id main color-id] :as ids} (setup-library-use! profile)
branch-id (create-branch! profile main "absorb")
revn (:revn (th/db-get :file {:id branch-id}))
out (th/command! {::th/type :set-file-shared
::rpc/profile-id (:id profile)
:id library-id
:is-shared false})]
(t/is (nil? (:error out)))
(t/testing "main absorbs the colour and drops its link"
(let [data (file-data profile main-id)]
(t/is (some? (get-in data [:colors color-id])))
(t/is (= main-id (fill-ref-file data ids))))
(t/is (not (contains? (linked-library-ids profile main-id) library-id))))
(t/testing "the branch writes nothing and still resolves the library"
(t/is (empty? (payload-rows branch-id)))
(t/is (empty? (th/db-query :file-branch-change {:file-id branch-id})))
(t/is (= revn (:revn (th/db-get :file {:id branch-id}))))
(t/is (= library-id (fill-ref-file (file-data profile branch-id) ids)))
(t/is (contains? (linked-library-ids profile branch-id) library-id))
(t/is (some? (get-in (file-data profile library-id) [:colors color-id]))))
(t/testing "the next update from main brings main's absorbed copy"
(update-from-main! profile branch-id)
(let [data (file-data profile branch-id)]
(t/is (some? (get-in data [:colors color-id])))
(t/is (not= library-id (fill-ref-file data ids))))
(t/is (empty? (payload-rows branch-id)))))))
(t/deftest unpublish-library-skips-deleted-branch
;; A deleted branch keeps its own library links until collection, and
;; its derive raises once its `file_branch` row carries the deletion.
;; The unpublish must not reach it.
(with-redefs [cf/flags (conj cf/flags :branching)]
(let [profile (th/create-profile* 1 {:is-active true})
{:keys [library-id main-id main color-id]} (setup-library-use! profile)
branch-id (create-branch! profile main "deleted")]
(t/is (nil? (:error (th/command! {::th/type :delete-file-branch
::rpc/profile-id (:id profile)
:id (branch-row-id branch-id)}))))
;; the deletion is pending and the branch still links the library
(t/is (some? (:deleted-at (th/db-get :file {:id branch-id}
{::db/remove-deleted false}))))
(t/is (seq (th/db-query :file-library-rel {:file-id branch-id
:library-file-id library-id})))
(let [out (th/command! {::th/type :set-file-shared
::rpc/profile-id (:id profile)
:id library-id
:is-shared false})]
(t/is (nil? (:error out))))
(t/is (some? (get-in (file-data profile main-id) [:colors color-id])))
(t/is (empty? (payload-rows branch-id))))))
(t/deftest delete-library-skips-branch
;; The deletion task absorbs a shared library into the files still
;; linked to it; a project deletion keeps those links. A branch
;; resolves nothing through the soft-deleted library until its next
;; update from main brings main's absorbed copy.
(with-redefs [cf/flags (conj cf/flags :branching)]
(let [profile (th/create-profile* 1 {:is-active true})
{:keys [library-id main-id main color-id] :as ids} (setup-library-use! profile)
branch-id (create-branch! profile main "absorb")
revn (:revn (th/db-get :file {:id branch-id}))]
(th/run-task! :delete-object {:object :file
:deleted-at (ct/now)
:id library-id})
;; the task logs an absorption error instead of raising it, so
;; main's absorbed copy is what proves the absorption ran
(let [data (file-data profile main-id)]
(t/is (some? (get-in data [:colors color-id])))
(t/is (= main-id (fill-ref-file data ids))))
(t/testing "the branch writes nothing and resolves nothing until the update"
(t/is (empty? (payload-rows branch-id)))
(t/is (empty? (th/db-query :file-branch-change {:file-id branch-id})))
(t/is (= revn (:revn (th/db-get :file {:id branch-id}))))
(t/is (= library-id (fill-ref-file (file-data profile branch-id) ids)))
(t/is (not (contains? (linked-library-ids profile branch-id) library-id))))
(t/testing "the next update from main brings main's absorbed copy"
(update-from-main! profile branch-id)
(let [data (file-data profile branch-id)]
(t/is (some? (get-in data [:colors color-id])))
(t/is (not= library-id (fill-ref-file data ids))))
(t/is (empty? (payload-rows branch-id)))))))
(defn- refusal
"The `ex-data` of what `f` raised, or `:no-error`."
[f]
(try
(f)
:no-error
(catch Throwable cause
(or (ex-data cause) (some-> (ex-cause cause) ex-data)))))
(t/deftest restore!-refuses-branch-file
;; The socket-REPL restore of one file
;; (`app.srepl.main/restore-file-snapshot!`) calls `fsnap/restore!`
;; directly, past the check of the RPC command.
(with-redefs [cf/flags (conj cf/flags :branching)]
(let [profile (th/create-profile* 1 {:is-active true})
file (create-file profile 1)
branch-id (create-branch! profile file "restore-me")
snap (:result (th/command! {::th/type :create-file-snapshot
::rpc/profile-id (:id profile)
:file-id branch-id
:label "branch-version"}))
revn (:revn (th/db-get :file {:id branch-id}))
error (refusal #(db/tx-run! th/*system* fsnap/restore! branch-id (:id snap)))]
(t/is (uuid? (:id snap)))
(t/is (= :validation (:type error)))
(t/is (= :branch-file-cant-be-restored (:code error)))
(t/is (empty? (payload-rows branch-id)))
(t/is (= revn (:revn (th/db-get :file {:id branch-id})))))))
(t/deftest restore-team-snapshot!-refuses-branch-file
;; The socket-REPL team restore reaches every file of the team,
;; branch files included, through `fsnap/restore!`.
(with-redefs [cf/flags (conj cf/flags :branching)]
(let [profile (th/create-profile* 1 {:is-active true})
team-id (:default-team-id profile)
file (create-file profile 1)
branch-id (create-branch! profile file "team-restore")]
;; the team restore wants the label on every file of the team
(doseq [file-id [(:id file) branch-id]]
(t/is (nil? (:error (th/command! {::th/type :create-file-snapshot
::rpc/profile-id (:id profile)
:file-id file-id
:label "before"})))))
(let [revn (:revn (th/db-get :file {:id (:id file)}))
error (refusal #(db/tx-run! th/*system* h/restore-team-snapshot! team-id "before"))]
(t/is (= :validation (:type error)))
(t/is (= :branch-file-cant-be-restored (:code error)))
(t/is (empty? (payload-rows branch-id)))
;; the refusal rolls the whole team restore back
(t/is (= revn (:revn (th/db-get :file {:id (:id file)}))))))))

169
backend/test/backend_tests/rpc_file_branch_test.clj
View File

@ -23,6 +23,7 @@
[app.rpc.commands.files-branch-policies :as fbp]
[app.storage :as sto]
[app.util.blob :as blob]
[app.util.migrations :as mg]
[backend-tests.helpers :as th]
[clojure.string :as str]
[clojure.test :as t]
@ -874,6 +875,65 @@
:id branch-file-id})]
(t/is (contains? (-> out :result :data :colors) cid)))))))
(t/deftest conflict-responses-carry-the-main-revn
;; A `:conflicts` response is what a resolving client works from, so it
;; names the revision of main its conflicts were computed against. The
;; client sends that revision back as `expected-main-revn` with its
;; resolutions, and a main that moved meanwhile is refused.
(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})
cid (uuid/random)
main-revn (fn [] (:revn (th/db-get :file {:id (:id file)})))]
;; color exists on main before branching (base = red)
(apply-change* profile (:id file)
{:type :add-color :color {:id cid :name "Brand" :color "#ff0000" :opacity 1}})
(let [create (:result (th/command! {::th/type :create-file-branch
::rpc/profile-id (:id profile)
:file-id (:id file)
:name "conflicting"}))
branch-id (:id create)
branch-file-id (:branch-file-id create)]
;; main edits the color -> green; branch edits it -> blue (conflict).
;; Main moves past the revision the branch was cut at, so the
;; revision a response names is the current one, not the base's.
(apply-change* profile (:id file)
{:type :mod-color :color {:id cid :name "Brand" :color "#00ff00" :opacity 1}})
(apply-change* profile branch-file-id
{:type :mod-color :color {:id cid :name "Brand" :color "#0000ff" :opacity 1}})
(t/testing "an update that stops on conflicts names main's revision"
(let [revn (main-revn)
out (th/command! {::th/type :update-branch-from-main
::rpc/profile-id (:id profile)
:branch-id branch-id})]
(t/is (nil? (:error out)))
(t/is (= :conflicts (-> out :result :status)))
(t/is (= revn (-> out :result :main-revn)))))
(t/testing "a merge that stops on conflicts names main's revision"
(let [revn (main-revn)
out (th/command! {::th/type :merge-file-branch
::rpc/profile-id (:id profile)
:branch-id branch-id})]
(t/is (nil? (:error out)))
(t/is (= :conflicts (-> out :result :status)))
(t/is (= revn (-> out :result :main-revn)))
(t/testing "and the merge accepts that revision back with resolutions"
(let [retry (th/command! {::th/type :merge-file-branch
::rpc/profile-id (:id profile)
:branch-id branch-id
:resolutions {cid :branch}
:expected-main-revn (-> out :result :main-revn)})]
(t/is (nil? (:error retry)))
(t/is (= :merged (-> retry :result :status)))))))))))
(t/deftest revn-gate-survives-update-from-main
(with-redefs [cf/flags (conj cf/flags :branching)]
(let [profile (th/create-profile* 1 {:is-active true})
@ -1433,6 +1493,54 @@
(t/is (= 1 (:actual data)))
(t/is (str/includes? (:hint data) "materialise")))))))))
(t/deftest oplog-depth-gate-refuses-a-compare-before-the-derive
;; The derive replays the whole op log, so it is the cost the depth gate
;; bounds. A compare over a log beyond the limit must refuse before it
;; pays for one, and its hint must not offer a merge, which the same
;; gate refuses.
(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
:is-shared false})
create (:result (th/command! {::th/type :create-file-branch
::rpc/profile-id (:id profile)
:file-id (:id file)
:name "deep-log"}))
branch-id (:id create)
branch-file-id (:branch-file-id create)
derive @#'bfc/branch-file-data
derives (atom 0)
compare! (fn []
(with-redefs [bfc/branch-file-data (fn [& args]
(swap! derives inc)
(apply derive args))]
(th/command! {::th/type :get-branch-diff
::rpc/profile-id (:id profile)
:branch-id branch-id})))]
(apply-change* profile branch-file-id
{:type :add-page :id (uuid/random) :name "one"})
(t/testing "under the limit the compare derives the branch"
(let [out (compare!)]
(t/is (nil? (:error out)))
(t/is (pos? @derives) "the probe saw no derive, so its zero below proves nothing")))
(t/testing "over the limit the compare refuses before the derive"
(reset! derives 0)
(with-redefs [cf/get (th/config-get-mock {:branching-max-oplog-changes 0})]
(let [out (compare!)
data (ex-data (:error out))]
(t/is (= :restriction (:type data)))
(t/is (= :branching-oplog-limit-exceeded (:code data)))
(t/is (= :compare (:operation data)))
(t/is (= 1 (:actual data)))
(t/is (zero? @derives) "the refused compare derived the branch first")
(t/is (str/includes? (:hint data) "materialise"))
(t/is (not (str/includes? (:hint data) "merge")))))))))
(t/deftest published-limits-are-the-ones-the-gates-enforce
(let [profile (th/create-profile* 1 {:is-active true})
limits (fn [] (th/command! {::th/type :get-branching-limits
@ -2650,6 +2758,67 @@
(compare!)
(t/is (= :ignore (get @seen :same-parent-reorder)))))))
(t/deftest re-running-the-branch-migration-leaves-oplog-branches-alone
;; The branch table migration carries a backfill for the copy model it
;; predates: rows whose branch file persisted its own data payload.
;; An op-log branch stores no payload and legitimately starts its own
;; counter at 0, so a re-run of the file (a renamed re-registration
;; re-applies every statement) must not touch it, while it still
;; repositions a copy-model row.
(with-redefs [cf/flags (conj cf/flags :branching)]
(let [profile (th/create-profile* 1 {:is-active true})
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})
;; main must have work for the backfill to have anything to
;; reposition to: a fresh file's revn is 0, and the backfill
;; copies base_revn, main's revision at branch creation
_ (th/command! {::th/type :update-file
::rpc/profile-id (:id profile)
:id (:id file)
:session-id (uuid/random)
:revn (:revn (th/db-get :file {:id (:id file)}))
:vern (:vern (th/db-get :file {:id (:id file)}))
:features cfeat/supported-features
:changes [{:type :add-color
:color {:id (uuid/random)
:name "counter"
:color "#ff0000"
:opacity 1}}]})
oplog-branch (-> (th/command! {::th/type :create-file-branch
::rpc/profile-id (:id profile)
:file-id (:id file)
:name "oplog-branch"})
:result)
copy-branch (-> (th/command! {::th/type :create-file-branch
::rpc/profile-id (:id profile)
:file-id (:id file)
:name "copy-branch"})
:result)
migrate-again (fn []
((mg/resource "app/migrations/sql/0155-add-file-branch-table.sql")
th/*pool*))
counter (fn [branch-id]
(:base-branch-revn (th/db-get :file-branch {:id branch-id})))]
;; both branches start with their own counter at 0
(t/is (zero? (counter (:id oplog-branch))))
(t/is (zero? (counter (:id copy-branch))))
;; the copy-model row: its branch file carries a data payload, the
;; shape the backfill was written for
(th/db-insert! :file-data
{:file-id (:branch-file-id copy-branch)
:id (:branch-file-id copy-branch)
:type "main"
:data (blob/encode {:pages []})})
(migrate-again)
;; the op-log branch keeps its own counter; the copy-model row is
;; repositioned onto main's revision
(t/is (zero? (counter (:id oplog-branch))))
(t/is (pos? (counter (:id copy-branch)))))))
(t/deftest summary-cache-key-changes-with-policies
;; Two different policies must never share a cached summary: the key
;; hashes the policies the value was computed under.

5
backend/test/backend_tests/rpc_file_snapshot_test.clj
View File

@ -331,4 +331,7 @@
(t/is (uuid? (:id snap)))
(t/is (some? (:error out)))
(t/is (= :branch-file-cant-be-restored (th/ex-code (:error out))))
(t/is (empty? (th/db-query :file-data {:file-id branch-id :type "main"}))))))
(t/is (empty? (th/db-query :file-data {:file-id branch-id :type "main"})))
;; the command refuses before it takes its backup snapshot, which
;; would be committed whatever the restore's outcome
(t/is (empty? (th/db-query :file-change {:file-id branch-id :created-by "system"}))))))

2
common/test/common_tests/runner.cljc
View File

@ -16,6 +16,7 @@
[common-tests.buffer-test]
[common-tests.colors-test]
[common-tests.data-test]
[common-tests.files-branch-merge-test]
[common-tests.files-builder-test]
[common-tests.files-changes-test]
[common-tests.files-migrations-0025-test]
@ -117,6 +118,7 @@
'common-tests.buffer-test
'common-tests.colors-test
'common-tests.data-test
'common-tests.files-branch-merge-test
'common-tests.files-builder-test
'common-tests.files-changes-test
'common-tests.files-migrations-0025-test

59
frontend/src/app/main/data/workspace/branches.cljs
View File

@ -441,21 +441,41 @@
ones the command's own `resolved?` matches against, while the diff the modal
can fetch on its own is computed in another id space and may list a
different set, or none at all. Keeping them in the store also lets the
bulk actions resolve the same set the modal shows."
[{:keys [branch mode conflicts]}]
bulk actions resolve the same set the modal shows.
`main-revn` is main's revn when the command computed those conflicts. It
is stored with them because the modal's own diff fetch can still be in
flight when the user applies; see `conflict-main-revn`."
[{:keys [branch mode conflicts main-revn]}]
(ptk/reify ::open-conflict-resolutions
ptk/UpdateEvent
(update [_ state]
(assoc state :workspace-branch-conflicts
{:branch-id (:id branch)
:mode mode
:conflicts (vec conflicts)}))
:conflicts (vec conflicts)
:main-revn main-revn}))
ptk/WatchEvent
(watch [_ _ _]
(rx/of (modal/show :branch-conflicts {:branch branch
:mode mode
:conflicts conflicts})))))
(defn- conflict-main-revn
"Main's revn when the server computed the conflict set stored for
`branch-id`, or nil when the stored set belongs to another branch.
The resolution modal fetches its own diff when it opens, and that fetch
replaces the loaded diff with a loading state until it answers. The user
can resolve every conflict and apply inside that window, so merge and
update fall back to this revn: resolutions never leave without the token
that lets the server refuse them when main has moved (`:file-modified`).
Main's revn is the same in both directions, so the mode does not matter."
[state branch-id]
(let [conflicts-st (:workspace-branch-conflicts state)]
(when (= branch-id (:branch-id conflicts-st))
(:main-revn conflicts-st))))
(defn update-branch-from-main
"Bring main's changes into the branch (reverse of merge). `branch` is the
branch row. With conflicts and no `resolutions`, opens the conflict
@ -465,7 +485,9 @@
its main revn is sent as `expected-main-revn` so the server refuses to
apply resolutions computed against a stale diff (`:file-modified`); in
that case the diff is re-fetched and the user is asked to review it
again (same as `merge-branch`)."
again (same as `merge-branch`). Resolutions sent before that diff has
loaded carry the revn of the conflict answer instead
(`conflict-main-revn`)."
([branch] (update-branch-from-main branch nil))
([branch resolutions]
(ptk/reify ::update-branch-from-main
@ -473,16 +495,18 @@
(watch [_ state _]
(let [branch-id (:id branch)
diff-st (:workspace-branch-diff state)
main-revn (when (and (= branch-id (:branch-id diff-st))
(= :main->branch (:direction diff-st)))
(get-in diff-st [:diff :meta :main-revn]))]
main-revn (or (when (and (= branch-id (:branch-id diff-st))
(= :main->branch (:direction diff-st)))
(get-in diff-st [:diff :meta :main-revn]))
(when (seq resolutions)
(conflict-main-revn state branch-id)))]
(rx/concat
(rx/of (ev/event {::ev/name "update-branch-from-main"}))
(->> (rp/cmd! :update-branch-from-main (cond-> {:branch-id branch-id}
(seq resolutions) (assoc :resolutions resolutions)
(some? main-revn) (assoc :expected-main-revn main-revn)))
(rx/mapcat
(fn [{:keys [status conflicts]}]
(fn [{:keys [status conflicts] :as answer}]
(case status
;; the open branch file just changed server-side: hard-reload
;; it so the pulled changes are shown
@ -494,7 +518,8 @@
;; space, which can disagree with them
:conflicts (rx/of (open-conflict-resolutions {:branch branch
:mode :update
:conflicts conflicts}))
:conflicts conflicts
:main-revn (:main-revn answer)}))
:unsupported (rx/of (ntf/warn (tr "workspace.branches.update.unsupported")))
(rx/of (ntf/error (tr "workspace.branches.update.error"))))))
(rx/catch
@ -563,8 +588,9 @@
When the current diff in state belongs to this branch, its main revn is
sent as `expected-main-revn` so the server refuses to apply resolutions
computed against a stale diff (`:file-modified`); in that case the diff
is re-fetched and the user is asked to review it again. Unresolved
conflicts open the resolution modal."
is re-fetched and the user is asked to review it again. Resolutions sent
before that diff has loaded carry the revn of the conflict answer instead
(`conflict-main-revn`). Unresolved conflicts open the resolution modal."
([branch] (merge-branch branch nil))
([branch {:keys [resolutions keep-branch]}]
(assert (uuid? (:id branch)) "expected a branch row with a valid `:id`")
@ -573,8 +599,10 @@
(watch [_ state _]
(let [branch-id (:id branch)
diff-st (:workspace-branch-diff state)
main-revn (when (= branch-id (:branch-id diff-st))
(get-in diff-st [:diff :meta :main-revn]))]
main-revn (or (when (= branch-id (:branch-id diff-st))
(get-in diff-st [:diff :meta :main-revn]))
(when (seq resolutions)
(conflict-main-revn state branch-id)))]
(rx/concat
(rx/of (ev/event {::ev/name "merge-branch"}))
(->> (rp/cmd! :merge-file-branch
@ -583,7 +611,7 @@
keep-branch (assoc :keep-branch true)
(some? main-revn) (assoc :expected-main-revn main-revn)))
(rx/mapcat
(fn [{:keys [status source-file-id conflicts]}]
(fn [{:keys [status source-file-id conflicts] :as answer}]
(case status
;; the merged result lives in main: take the user there
;; to see it (navigate if elsewhere, hard-reload if
@ -594,7 +622,8 @@
(show-merge-result source-file-id))
:conflicts (rx/of (open-conflict-resolutions {:branch branch
:mode :merge
:conflicts conflicts}))
:conflicts conflicts
:main-revn (:main-revn answer)}))
:unsupported (rx/of (ntf/warn (tr "workspace.branches.merge.unsupported")))
(rx/of (ntf/error (tr "workspace.branches.merge.error"))))))
(rx/catch

146
frontend/test/frontend_tests/data/workspace_branches_test.cljs Normal file
View File

@ -0,0 +1,146 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns frontend-tests.data.workspace-branches-test
(:require
[app.common.uuid :as uuid]
[app.main.data.workspace.branches :as dwb]
[app.main.repo :as rp]
[beicon.v2.core :as rx]
[cljs.test :as t :include-macros true]
[frontend-tests.helpers.mock :as mock]
[potok.v2.core :as ptk]))
(def ^:private conflict-revn
"Main's revn in the conflict answer of the faked merge/update command."
7)
(defn- cmd-stub
"Fake `rp/cmd!` that records every call into `calls`. The branch diff
fetch never answers, so the diff stays loading. A merge or update without
resolutions answers with one conflict computed at `conflict-revn`; one
with resolutions answers nothing."
[calls conflict-id]
(mock/stub (fn [cmd params]
(swap! calls conj [cmd params])
(cond
(= cmd :get-branch-diff) (rx/subject)
(seq (:resolutions params)) (rx/empty)
:else (rx/of {:status :conflicts
:conflicts [{:id conflict-id}]
:main-revn conflict-revn})))))
(defn- make-store
[]
(ptk/store {:state {}
:on-error (fn [cause] (t/is false (str cause)))}))
(defn- branch-cmd
[mode]
(if (= mode :update) :update-branch-from-main :merge-file-branch))
(defn- open-conflicts!
"Ask for a `mode` (`:merge` or `:update`) of `branch` and let the conflict
answer open the modal, which then fetches its own diff in its direction,
as `branch-conflicts-dialog*` does on mount."
[store mode branch]
(ptk/emit! store (if (= mode :update)
(dwb/update-branch-from-main branch)
(dwb/merge-branch branch)))
(ptk/emit! store (dwb/fetch-branch-diff (:id branch)
(if (= mode :update) :main->branch :branch->main))))
(defn- apply-resolutions!
"Resolve every conflict to main and press Apply, as the modal does."
[store mode branch]
(ptk/emit! store (dwb/set-all-resolutions :main))
(let [resolutions (get-in @store [:workspace-branch-diff :resolutions])]
(ptk/emit! store (if (= mode :update)
(dwb/update-branch-from-main branch resolutions)
(dwb/merge-branch branch {:resolutions resolutions})))))
(defn- last-params
"Params of the last merge or update call recorded in `calls`."
[calls mode]
(->> @calls
(filter #(= (branch-cmd mode) (first %)))
(last)
(second)))
(t/deftest resolutions-applied-before-the-diff-loads-send-the-conflict-revn
(t/async done
(let [calls (atom [])
conflict-id (uuid/next)]
(mock/with-mocks
{rp/cmd! (cmd-stub calls conflict-id)}
(fn [done']
(doseq [mode [:merge :update]]
(t/testing (name mode)
(let [branch {:id (uuid/next)}
store (make-store)]
(reset! calls [])
(open-conflicts! store mode branch)
(t/is (= :loading (get-in @store [:workspace-branch-diff :status]))
"the modal's diff fetch has not answered")
(apply-resolutions! store mode branch)
(let [params (last-params calls mode)]
(t/is (= {conflict-id :main} (:resolutions params)))
(t/is (= conflict-revn (:expected-main-revn params))
"the resolutions carry the revn of the conflict answer"))
(rx/dispose! store))))
(done'))
done))))
(t/deftest the-loaded-diff-revn-wins-over-the-conflict-revn
(t/async done
(let [calls (atom [])
conflict-id (uuid/next)]
(mock/with-mocks
{rp/cmd! (cmd-stub calls conflict-id)}
(fn [done']
(doseq [mode [:merge :update]]
(t/testing (name mode)
(let [branch {:id (uuid/next)}
store (make-store)]
(reset! calls [])
(open-conflicts! store mode branch)
;; the modal's diff fetch answers, computed at a newer main
(ptk/emit! store (dwb/update-branch-diff {:status :loaded
:diff {:meta {:main-revn 9}}}))
(apply-resolutions! store mode branch)
(t/is (= 9 (:expected-main-revn (last-params calls mode))))
(rx/dispose! store))))
(done'))
done))))
(t/deftest no-resolutions-without-a-loaded-diff-send-no-revn
(t/async done
(let [calls (atom [])
conflict-id (uuid/next)]
(mock/with-mocks
{rp/cmd! (cmd-stub calls conflict-id)}
(fn [done']
(doseq [mode [:merge :update]]
(t/testing (name mode)
(let [branch {:id (uuid/next)}
store (make-store)]
(reset! calls [])
(open-conflicts! store mode branch)
(t/is (not (contains? (last-params calls mode) :expected-main-revn))
"the first request has neither resolutions nor a diff")
;; ask again while the diff is loading, with the conflict
;; answer's revn already stored
(ptk/emit! store (if (= mode :update)
(dwb/update-branch-from-main branch)
(dwb/merge-branch branch)))
(let [params (last-params calls mode)]
(t/is (= 2 (count (filter #(= (branch-cmd mode) (first %)) @calls))))
(t/is (not (contains? params :resolutions)))
(t/is (not (contains? params :expected-main-revn))
"the stored revn only travels with resolutions"))
(rx/dispose! store))))
(done'))
done))))

2
frontend/test/frontend_tests/runner.cljs
View File

@ -21,6 +21,7 @@
[frontend-tests.data.svg-upload-test]
[frontend-tests.data.uploads-test]
[frontend-tests.data.viewer-test]
[frontend-tests.data.workspace-branches-test]
[frontend-tests.data.workspace-colors-test]
[frontend-tests.data.workspace-comments-test]
[frontend-tests.data.workspace-context-menu-test]
@ -162,6 +163,7 @@
'frontend-tests.data.svg-upload-test
'frontend-tests.data.uploads-test
'frontend-tests.data.viewer-test
'frontend-tests.data.workspace-branches-test
'frontend-tests.data.workspace-colors-test
'frontend-tests.data.workspace-comments-test
'frontend-tests.data.workspace-context-menu-test

9
frontend/translations/en.po
View File

@ -6856,8 +6856,8 @@ msgstr "A file with more than %s pages can't be branched."
#: src/app/main/ui/workspace/sidebar/branches.cljs
msgid "workspace.branches.limits.size.changes"
msgstr ""
"A branch that has collected more than %s changes can't be compared or "
"merged. Merge it, or turn it into an ordinary file."
"A branch that has collected more than %s changes can't be compared, merged "
"or updated from main. Turn it into an ordinary file to keep its content."
#: src/app/main/ui/workspace/sidebar/branches.cljs
msgid "workspace.branches.limits.size.loading"
@ -6932,8 +6932,9 @@ msgstr "This file has more pages than branching supports (%s)."
#: src/app/main/data/workspace/branches.cljs
msgid "workspace.branches.limits.refuse-changes"
msgstr ""
"This branch has collected more changes than a comparison supports (%s). "
"Merge it, or turn it into an ordinary file."
"This branch has collected more changes than branching supports (%s). It "
"can't be compared, merged or updated from main. Turn it into an ordinary "
"file to keep its content, or delete it."
#: src/app/main/data/workspace/branches.cljs
msgid "workspace.branches.limits.refuse-nested"