From 863c7cab1b48d8e9a6607a792ff2d7d824283c9b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C3=81lvaro=20Tejero=20Cantero?= Date: Thu, 1 Oct 2026 03:34:35 +0200 Subject: [PATCH] :bug: Fix the defects the review of the branch commands found The source notes on files_branch.clj listed 32 review findings. This commit fixes the 21 that are defects of the code; each fix carries a regression test that failed before it and passes after. Concurrency: merge, update from main, rename, archive and delete now re-read the branch row under the advisory lock and work off that row, so a concurrent merge or update can no longer leave a ten-year base pin behind or release a superseded base twice. Delete and archive take the branch file lock, create and reopen of a pull request refuse a branch that a concurrent merge closed, and create checks the branch quota under the lock. Merge, update and delete publish their msgbus messages only after the transaction commits. Merge, update and materialize re-validate after the repair: merge and update refuse a result that stays invalid, materialize logs it. The change log row carries the repair changes, and the three paths drop the cached file summary under :redis-cache. Contracts: a :conflict refusal answers 409 instead of 500, resolution values must be :main or :branch, and update from main accepts the expected-main-revn token the frontend now sends from a loaded diff. Smaller fixes: create refuses a blank name, writes no file_data row, and a rename reaches the branch file's own name. Deleting a kept merged branch keeps its merged status. get-branch-diff reports the creation time of the current base snapshot. Rename, archive and delete report their duration and outcome. An image used only by a library colour is copied into the target file. Dead fallbacks and dead deleted-at checks are gone. AI-assisted-by: claude-opus-5-5 --- backend/src/app/binfile/common.clj | 26 + backend/src/app/http/errors.clj | 5 + backend/src/app/rpc/commands/files_branch.clj | 389 +++++-- .../app/rpc/commands/files_pull_request.clj | 135 ++- backend/src/app/rpc/commands/files_update.clj | 6 +- .../backend_tests/http_middleware_test.clj | 15 + .../rpc_file_branch_oplog_test.clj | 125 ++- .../backend_tests/rpc_file_branch_test.clj | 973 +++++++++++++++++- .../rpc_file_pull_request_test.clj | 147 +++ common/src/app/common/files/branch_merge.cljc | 12 +- .../src/app/main/data/workspace/branches.cljs | 68 +- 11 files changed, 1700 insertions(+), 201 deletions(-) diff --git a/backend/src/app/binfile/common.clj b/backend/src/app/binfile/common.clj index 6b3ecde538..30f1369b20 100644 --- a/backend/src/app/binfile/common.clj +++ b/backend/src/app/binfile/common.clj @@ -992,6 +992,32 @@ (fdata/upsert! cfg file-data-params) nil)) +(defn insert-file-row! + "Insert only the `file` row of a new file, without writing the + `file_data` payload row. Used for branch creation: a branch stores no + data, so the create step must skip `encode-file` (its pointer-map + transform would write `file_data` rows for the branch) and the data + upsert. Returns nil." + [{:keys [::db/conn]} file & {:as opts}] + (when (:migrations file) + (fmigr/upsert-migrations! conn file)) + + (let [file-params (-> file + (d/update-when :features into-array) + (file->params))] + (try + (db/insert! conn :file + file-params + (assoc opts ::db/return-keys false)) + (catch org.postgresql.util.PSQLException cause + (if (db/duplicate-key-error? cause) + (ex/raise :type :not-found + :code :object-not-found + :hint "file already exists" + :cause cause) + (throw cause))))) + nil) + (defn update-file-row! "Update only the `file` row of an existing file, without touching `file_data`. Used for branch file saves: a branch stores no data, so diff --git a/backend/src/app/http/errors.clj b/backend/src/app/http/errors.clj index e8b103c417..778f6a6fd5 100644 --- a/backend/src/app/http/errors.clj +++ b/backend/src/app/http/errors.clj @@ -164,6 +164,11 @@ {::yres/status 404 ::yres/body (ex-data err)}) +(defmethod handle-error :conflict + [err _ _] + {::yres/status 409 + ::yres/body (ex-data err)}) + (defmethod handle-error :nitrate-unavailable [err request _] (binding [l/*context* (request->context request)] diff --git a/backend/src/app/rpc/commands/files_branch.clj b/backend/src/app/rpc/commands/files_branch.clj index a92d4fa361..4fa3e36f81 100644 --- a/backend/src/app/rpc/commands/files_branch.clj +++ b/backend/src/app/rpc/commands/files_branch.clj @@ -29,6 +29,7 @@ [app.common.uuid :as uuid] [app.config :as cf] [app.db :as db] + [app.db.sql :as-alias sql] [app.features.fdata :as fdata] [app.features.file-snapshots :as fsnap] [app.features.logical-deletion :as ldel] @@ -224,9 +225,16 @@ (defn- unpaired-media-rows "Full file_media_object rows of `file-id` that are used by `data` but have no counterpart in `pairs` — media added on this side since branching. - They must be copied into the target file when the merge/update applies." + They must be copied into the target file when the merge/update applies. + + The used set is `cfh/collect-used-media` plus the library-color `:image` + ids it does not see but `bm/remap-refs` rewrites." [cfg file-id data pairs] - (let [used (into #{} (remove pairs) (cfh/collect-used-media data))] + (let [used (into #{} + (remove pairs) + (into (cfh/collect-used-media data) + (keep #(get-in % [:image :id])) + (vals (:colors data))))] (if (seq used) (->> (db/exec! cfg [sql:media-rows-by-id (db/create-array (db/get-connection cfg) "uuid" used)]) @@ -328,9 +336,11 @@ (defn- delete-branch! "Logically delete a branch and its branch file (with the team's deletion - delay), release the base snapshot, schedule the file object GC and notify - the branch file's open clients. Must run inside a transaction." - [{:keys [::mbus/msgbus ::db/conn] :as cfg} + delay), release the base snapshot, schedule the file object GC and + return the msgbus notification for the branch file's open clients — + the caller publishes it, and only once the transaction has committed + (`tx-run-notify!`). Must run inside a transaction." + [{:keys [::db/conn] :as cfg} {:keys [id branch-file-id] :as branch} {:keys [profile-id session-id status]}] (let [team (teams/get-team conn :profile-id profile-id :file-id branch-file-id) @@ -351,16 +361,23 @@ (wrk/submit! {::db/conn conn ::wrk/task :delete-object ::wrk/params {:object :file :deleted-at dt :id branch-file-id}}) - (mbus/pub! msgbus - :topic branch-file-id - :message {:type :file-deleted - :file-id branch-file-id - :profile-id profile-id - :session-id session-id}) - nil)) + {:topic branch-file-id + :message {:type :file-deleted + :file-id branch-file-id + :profile-id profile-id + :session-id session-id}})) ;; --- COMMAND: create-file-branch +(defn- check-branch-name! + "Refuse a blank branch name. Shared by creation and rename so the API + cannot create a branch the rename would refuse." + [name] + (when (str/blank? name) + (ex/raise :type :validation + :code :invalid-branch-name + :hint "branch name cannot be blank"))) + (def ^:private schema:create-file-branch [:map {:title "create-file-branch"} [:file-id ::sm/uuid] @@ -380,6 +397,7 @@ [:create-file-branch/global]]} [cfg {:keys [::rpc/profile-id file-id name description]}] (check-branching-enabled!) + (check-branch-name! name) (files/check-edition-permissions! cfg profile-id file-id) (let [tpoint (ct/tpoint) @@ -392,14 +410,6 @@ :hint "branches of branches are not supported" :file-id file-id)) - (-> cfg - (assoc ::quotes/profile-id profile-id) - (assoc ::quotes/project-id (:project-id file-row)) - (assoc ::quotes/team-id (:team-id project)) - (assoc ::quotes/file-id file-id) - (quotes/check! {::quotes/id ::quotes/branches-per-file} - {::quotes/id ::quotes/branches-per-team})) - (db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}] (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"]) @@ -410,6 +420,20 @@ ;; base) are taken from the SAME state of main. (db/xact-lock! conn file-id) + ;; The quota check runs INSIDE the transaction and + ;; AFTER the lock: two creators racing for the last + ;; branch slot serialize on the lock, and the loser's + ;; count must see the winner's committed row. + ;; `quotes/check!` reads through `::db/conn`, so it + ;; counts on this transaction's connection. + (-> cfg + (assoc ::quotes/profile-id profile-id) + (assoc ::quotes/project-id (:project-id file-row)) + (assoc ::quotes/team-id (:team-id project)) + (assoc ::quotes/file-id file-id) + (quotes/check! {::quotes/id ::quotes/branches-per-file} + {::quotes/id ::quotes/branches-per-team})) + ;; 1. Materialize the merge base: a system snapshot of ;; main, kept long-lived so it is not pruned by the ;; snapshot GC while the branch is open (it is @@ -441,7 +465,7 @@ meta-id (uuid/next)] - (bfc/insert-file! cfg branch-file {::db/return-keys false}) + (bfc/insert-file-row! cfg branch-file {::db/return-keys false}) ;; 3. Mark the new file row as a branch so it is ;; hidden from the project/team file listings. @@ -543,7 +567,7 @@ `base-revn` — the two revns are independent counters and must never be mixed." [{:keys [branch-revn source-revn base-revn base-branch-revn]}] - [(max 0 (- branch-revn (or base-branch-revn base-revn))) + [(max 0 (- branch-revn base-branch-revn)) (max 0 (- source-revn base-revn))]) (defn- branch-id-map @@ -782,7 +806,7 @@ [{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id branch-id direction]}] (check-branching-enabled!) (let [branch (db/get* conn :file-branch {:id branch-id})] - (when (or (nil? branch) (some? (:deleted-at branch))) + (when (nil? branch) (ex/raise :type :not-found :code :branch-not-found :hint "unable to find branch with the provided id" @@ -803,6 +827,13 @@ (:data branch-file) (branch-id-map cfg (:branch-file-id branch) (:source-file-id branch))) base-data (branch-base-data branch-file) + ;; when the CURRENT merge-base snapshot row was created: the + ;; base moves whenever `update-branch-from-main` repositions it, + ;; and a pinned base carries a future `deleted-at` + base-at (:created-at (db/get* conn :file-change + {:id (:base-snapshot-id branch)} + {::sql/columns [:created-at] + ::db/remove-deleted false})) ;; only the branch->main direction may be bounded to the pages ;; the branch touched: the other direction is main's changes and ;; nothing here knows which pages those are @@ -810,17 +841,36 @@ (when-let [pages (affected-pages log)] {:only-pages pages}))] ;; `:meta` carries the "when" of each side so the resolution UI can show - ;; how recent main/branch are (base is pinned at branch creation), plus + ;; how recent main/branch are (base is the snapshot its + ;; `base-snapshot-id` currently points at), plus ;; `:main-revn` so the client can do optimistic concurrency on merge ;; (`expected-main-revn`). The last editor's identity is intentionally ;; omitted: files do not store a reliable "modified-by". (-> (bm/compute-merge base-data main-data branch-data dir opts) - (assoc :meta {:base-at (:created-at branch) + (assoc :meta {:base-at base-at :main-at (:modified-at main-file) :branch-at (:modified-at branch-file) :main-revn (:revn main-file)}) (audited tpoint :compare))))) +;; --- Helpers: post-commit notification +;; +;; `app.db` offers no post-commit hook and `db/tx-run!` has committed +;; when it returns, so the messages a transaction collects in `messages` +;; leave here, right after the commit: a client that reloads on one of +;; them reads the committed state, and a rolled back transaction +;; publishes nothing. + +(defn- tx-run-notify! + "Run `f` in a transaction, then publish the `messages` it collected (a + volatile of `{:topic .. :message ..}` maps) and return its result." + [cfg msgbus messages f] + (let [result (db/tx-run! cfg f)] + (run! (fn [{:keys [topic message]}] + (mbus/pub! msgbus :topic topic :message message)) + @messages) + result)) + ;; --- COMMAND: merge-file-branch (def ^:private schema:merge-file-branch @@ -829,12 +879,12 @@ ;; conflict resolutions keyed by entity id (uuid) or, for structural ;; conflicts, a keyword id like :active-themes. A resolution is either a ;; whole-entity choice (:main/:branch) or a per-attr map {attr -> side}. - [:resolutions {:optional true} [:map-of :any [:or :keyword [:map-of :keyword :keyword]]]] + [:resolutions {:optional true} [:map-of :any [:or [:enum :main :branch] [:map-of :keyword [:enum :main :branch]]]]] [:expected-main-revn {:optional true} ::sm/int] ;; when false (the default) the branch and its file are logically ;; deleted right after a successful merge, in the SAME transaction (so ;; merged copies do not pile up); when true the branch is kept as - ;; "merged" and can be inspected/restored from the archived list. + ;; "merged", staying readable with status merged until it is deleted. [:keep-branch {:optional true} ::sm/boolean]]) (sv/defmethod ::merge-file-branch @@ -857,7 +907,7 @@ {:keys [::rpc/profile-id ::rpc/session-id branch-id resolutions expected-main-revn keep-branch]}] (check-branching-enabled!) (let [branch (db/get* cfg :file-branch {:id branch-id})] - (when (or (nil? branch) (some? (:deleted-at branch))) + (when (nil? branch) (ex/raise :type :not-found :code :branch-not-found :branch-id branch-id)) @@ -868,12 +918,15 @@ (let [tpoint (ct/tpoint) main-id (:source-file-id branch) - branch-file-id (:branch-file-id branch)] + branch-file-id (:branch-file-id branch) + messages (volatile! [])] ;; Only editors of main can integrate (same rule as Figma). (files/check-edition-permissions! cfg profile-id main-id) - (db/tx-run! + (tx-run-notify! cfg + msgbus + messages (fn [{:keys [::db/conn] :as cfg}] ;; Serialize against concurrent edits/merges on BOTH files (same ;; advisory lock the normal update-file path takes; stable order @@ -882,7 +935,19 @@ ;; the branch is marked merged (and possibly deleted) below. (run! (partial db/xact-lock! conn) (sort [main-id branch-file-id])) - (let [main-file (-> (bfc/get-file cfg main-id :realize? true) + ;; the row read before the lock is stale by now: a competing + ;; merge, delete or archive may have committed while these + ;; locks were taken, so everything below works off the row as + ;; it stands under the lock + (let [branch (or (db/get* conn :file-branch {:id branch-id}) + (ex/raise :type :not-found + :code :branch-not-found + :branch-id branch-id)) + _ (when (not= "open" (:status branch)) + (ex/raise :type :validation + :code :branch-not-open + :branch-id branch-id)) + main-file (-> (bfc/get-file cfg main-id :realize? true) (check-file-size-limits! :merge)) _ (-> (branch-log cfg branch-file-id) (check-oplog-depth-limit! branch-file-id :merge)) @@ -942,8 +1007,9 @@ :status "merged" :deleted-at (ct/in-future delay)}) (when-not keep-branch - (delete-branch! cfg branch {:profile-id profile-id - :session-id session-id}))))] + (vswap! messages conj + (delete-branch! cfg branch {:profile-id profile-id + :session-id session-id})))))] (cond (seq unresolved) (audited {:status :conflicts :conflicts conflicts} tpoint :merge) @@ -990,10 +1056,24 @@ (update :data #(cpc/process-changes % changes))) libs (bfc/get-resolved-file-libraries cfg merged) errors (not-empty (cfv/validate-file merged libs)) - merged (if errors - (update merged :data cpc/process-changes - (cfr/repair-file merged libs errors)) - merged)] + repair (if errors + (cfr/repair-file merged libs errors) + []) + merged (cond-> merged + (seq repair) + (update :data cpc/process-changes repair)) + + ;; the validator, not the merge, decides + ;; validity: the repaired result goes back + ;; to it, and whatever stays broken refuses + ;; the merge and rolls the transaction back + errors (when errors + (not-empty (cfv/validate-file merged libs)))] + (when errors + (ex/raise :type :validation + :code :merge-result-invalid + :hint "the merge result still has validation errors after the repair" + :codes (into [] (comp (map :code) (distinct)) errors))) ;; Change log (xlog), GC-eligible after the delay. (db/insert! conn :file-change @@ -1007,19 +1087,22 @@ :revn (:revn merged) :version (:version merged) :features (into-array (:features merged)) - :changes (blob/encode (vec changes))} + :changes (blob/encode (into (vec changes) repair))} {::db/return-keys false}) (fupd/persist-file! (assoc cfg ::fupd/timestamp ts) merged) + (when (contains? cf/flags :redis-cache) + (fupd/invalidate-caches! cfg merged)) + (finish-branch! ts) - (mbus/pub! msgbus - :topic main-id - :message {:type :file-merged - :file-id main-id - :session-id session-id - :revn (:revn merged)}) + (vswap! messages conj + {:topic main-id + :message {:type :file-merged + :file-id main-id + :session-id session-id + :revn (:revn merged)}}) (audited {:status :merged :revn (:revn merged) :source-file-id main-id} tpoint :merge)))))))))))))) @@ -1031,7 +1114,8 @@ [:branch-id ::sm/uuid] ;; resolutions in UI terms: id -> :main (take main) | :branch (keep ;; branch) | {attr -> side} (per-attr) - [:resolutions {:optional true} [:map-of :any [:or :keyword [:map-of :keyword :keyword]]]]]) + [:resolutions {:optional true} [:map-of :any [:or [:enum :main :branch] [:map-of :keyword [:enum :main :branch]]]]] + [:expected-main-revn {:optional true} ::sm/int]]) (defn- persist-branch-update! "Persist the result of an update-from-main integration on a branch @@ -1079,27 +1163,47 @@ ::climit/id [[:update-branch-from-main/by-profile ::rpc/profile-id] [:update-branch-from-main/global]]} [{:keys [::mbus/msgbus] :as cfg} - {:keys [::rpc/profile-id ::rpc/session-id branch-id resolutions]}] + {:keys [::rpc/profile-id ::rpc/session-id branch-id resolutions expected-main-revn]}] (check-branching-enabled!) (let [branch (db/get* cfg :file-branch {:id branch-id})] - (when (or (nil? branch) (some? (:deleted-at branch))) + (when (nil? branch) (ex/raise :type :not-found :code :branch-not-found :branch-id branch-id)) (when (not= "open" (:status branch)) (ex/raise :type :validation :code :branch-not-open :branch-id branch-id)) (let [tpoint (ct/tpoint) branch-file-id (:branch-file-id branch) - main-id (:source-file-id branch)] + main-id (:source-file-id branch) + messages (volatile! [])] ;; Editing the branch -> need edition permissions on the branch file. (files/check-edition-permissions! cfg profile-id branch-file-id) - (db/tx-run! + (tx-run-notify! cfg + msgbus + messages (fn [{:keys [::db/conn] :as cfg}] (db/xact-lock! conn branch-file-id) - (let [main-file (-> (bfc/get-file cfg main-id :realize? true) + ;; the row read before the lock is stale by now: a competing + ;; merge, delete or archive may have committed while this lock + ;; was taken, so everything below works off the row as it + ;; stands under the lock + (let [branch (or (db/get* conn :file-branch {:id branch-id}) + (ex/raise :type :not-found + :code :branch-not-found + :branch-id branch-id)) + _ (when (not= "open" (:status branch)) + (ex/raise :type :validation + :code :branch-not-open + :branch-id branch-id)) + main-file (-> (bfc/get-file cfg main-id :realize? true) (check-file-size-limits! :update-from-main)) + _ (when (and (some? expected-main-revn) + (not= expected-main-revn (:revn main-file))) + (ex/raise :type :conflict + :code :file-modified + :hint "main was modified, recompute the diff and retry")) _ (-> (branch-log cfg branch-file-id) (check-oplog-depth-limit! branch-file-id :update-from-main)) branch-file (bfc/get-file cfg branch-file-id :realize? true) @@ -1146,7 +1250,7 @@ ;; (revn moved since the base was last positioned) branch-diverged? (pos? (- (:revn branch-file) - (or (:base-branch-revn branch) (:base-revn branch)))) + (:base-branch-revn branch))) reposition-base! (fn [ts branch-revn] @@ -1246,10 +1350,24 @@ (update :data #(cpc/process-changes % applied))) libs (bfc/get-resolved-file-libraries cfg updated) errors (not-empty (cfv/validate-file updated libs)) - updated (if errors - (update updated :data cpc/process-changes - (cfr/repair-file updated libs errors)) - updated)] + repair (if errors + (cfr/repair-file updated libs errors) + []) + updated (cond-> updated + (seq repair) + (update :data cpc/process-changes repair)) + + ;; the validator, not the update, decides + ;; validity: the repaired result goes back to + ;; it, and whatever stays broken refuses the + ;; update and rolls the transaction back + errors (when errors + (not-empty (cfv/validate-file updated libs)))] + (when errors + (ex/raise :type :validation + :code :update-result-invalid + :hint "the update result still has validation errors after the repair" + :codes (into [] (comp (map :code) (distinct)) errors))) (db/insert! conn :file-change {:id (uuid/next) @@ -1262,7 +1380,7 @@ :revn (:revn updated) :version (:version updated) :features (into-array (:features updated)) - :changes (blob/encode (vec applied))} + :changes (blob/encode (into (vec applied) repair))} {::db/return-keys false}) ;; SQUASH: the new base (main's current state) @@ -1282,14 +1400,17 @@ :hint "the update produces branch-only changes that cannot be replayed" :kinds (vec unsupported))) (persist-branch-update! cfg updated ts branch-id net-changes)) + + (when (contains? cf/flags :redis-cache) + (fupd/invalidate-caches! cfg updated)) (reposition-base! ts (:revn updated)) - (mbus/pub! msgbus - :topic branch-file-id - :message {:type :file-merged - :file-id branch-file-id - :session-id session-id - :revn (:revn updated)}) + (vswap! messages conj + {:topic branch-file-id + :message {:type :file-merged + :file-id branch-file-id + :session-id session-id + :revn (:revn updated)}}) (audited {:status :updated :revn (:revn updated)} tpoint :update-from-main))))))))))))) @@ -1348,14 +1469,30 @@ (let [libs (bfc/get-resolved-file-libraries cfg file) errors (not-empty (cfv/validate-file file libs)) - file (if errors - (update file :data cpc/process-changes - (cfr/repair-file file libs errors)) - file)] + repair (if errors + (cfr/repair-file file libs errors) + []) + file (cond-> file + (seq repair) + (update :data cpc/process-changes repair)) + + ;; the exit door never strands a user: the repaired + ;; result goes back to the validator, and whatever + ;; stays broken is logged, never refused + errors (when errors + (not-empty (cfv/validate-file file libs)))] + + (when errors + (l/wrn :hint "materialised file still has validation errors" + :file-id (str file-id) + :codes (into [] (comp (map :code) (distinct)) errors))) ;; the derived state becomes the file's own payload (fupd/persist-file! (assoc cfg ::fupd/timestamp ts) file) + (when (contains? cf/flags :redis-cache) + (fupd/invalidate-caches! cfg file)) + ;; from here the ordinary paths apply (db/update! conn :file {:is-branch false} @@ -1469,23 +1606,34 @@ ::db/transaction true} [{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id id name description]}] (check-branching-enabled!) - (when (and (some? name) (str/blank? name)) - (ex/raise :type :validation - :code :invalid-branch-name - :hint "branch name cannot be blank")) - (let [branch (db/get* conn :file-branch {:id id})] - (when (or (nil? branch) (some? (:deleted-at branch))) + (when (some? name) + (check-branch-name! name)) + (let [tpoint (ct/tpoint) + branch (db/get* conn :file-branch {:id id})] + (when (nil? branch) (ex/raise :type :not-found :code :branch-not-found :branch-id id)) (files/check-edition-permissions! cfg profile-id (:branch-file-id branch)) - (db/update! conn :file-branch - (cond-> {:updated-at (ct/now)} - (some? name) (assoc :name name) - (some? description) (assoc :description description)) - {:id id} - {::db/return-keys false}) - {:id id - :name (or name (:name branch)) - :description (or description (:description branch))})) + ;; Serialize against a merge of the same branch (which locks the + ;; branch file) and re-read the row under the lock: the branch may + ;; be merged and gone by now. + (db/xact-lock! conn (:branch-file-id branch)) + (let [branch (db/get* conn :file-branch {:id id})] + (when (nil? branch) + (ex/raise :type :not-found :code :branch-not-found :branch-id id)) + (db/update! conn :file-branch + (cond-> {:updated-at (ct/now)} + (some? name) (assoc :name name) + (some? description) (assoc :description description)) + {:id id} + {::db/return-keys false}) + ;; the branch file carries its own name (set from the branch name + ;; at creation), so a rename has to reach the file row too + (when (some? name) + (files/rename-file conn {:id (:branch-file-id branch) :name name})) + (audited {:id id + :name (or name (:name branch)) + :description (or description (:description branch))} + tpoint :rename-branch)))) ;; --- COMMAND: archive-file-branch @@ -1501,27 +1649,36 @@ ::db/transaction true} [{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id id archived]}] (check-branching-enabled!) - (let [branch (db/get* conn :file-branch {:id id})] - (when (or (nil? branch) (some? (:deleted-at branch))) + (let [tpoint (ct/tpoint) + branch (db/get* conn :file-branch {:id id})] + (when (nil? branch) (ex/raise :type :not-found :code :branch-not-found :branch-id id)) - (when (= "merged" (:status branch)) - (ex/raise :type :validation :code :branch-merged :branch-id id)) (files/check-edition-permissions! cfg profile-id (:branch-file-id branch)) - (let [status (if (false? archived) "open" "archived")] - (db/update! conn :file-branch - {:status status :updated-at (ct/now)} - {:id id} - {::db/return-keys false}) - ;; archiving hides the branch from the default flow, so its review - ;; sandbox has no reason to stay open either - (when (= "archived" status) - (let [team (teams/get-team conn :profile-id profile-id - :file-id (:branch-file-id branch)) - dt (ct/in-future (ldel/get-deletion-delay team))] - (close-branch-pull-requests! cfg id {:profile-id profile-id - :status "closed" - :deleted-at dt}))) - {:id id :status status}))) + ;; Serialize against a merge of the same branch (which locks the + ;; branch file) and re-read the row under the lock: the branch may + ;; be merged and gone by now. + (db/xact-lock! conn (:branch-file-id branch)) + (let [branch (db/get* conn :file-branch {:id id})] + (when (nil? branch) + (ex/raise :type :not-found :code :branch-not-found :branch-id id)) + (when (= "merged" (:status branch)) + (ex/raise :type :validation :code :branch-merged :branch-id id)) + (let [status (if (false? archived) "open" "archived")] + (db/update! conn :file-branch + {:status status :updated-at (ct/now)} + {:id id} + {::db/return-keys false}) + ;; archiving hides the branch from the default flow, so its review + ;; sandbox has no reason to stay open either + (when (= "archived" status) + (let [team (teams/get-team conn :profile-id profile-id + :file-id (:branch-file-id branch)) + dt (ct/in-future (ldel/get-deletion-delay team))] + (close-branch-pull-requests! cfg id {:profile-id profile-id + :status "closed" + :deleted-at dt}))) + (audited {:id id :status status} tpoint + (if (false? archived) :restore-branch :archive-branch)))))) ;; --- COMMAND: delete-file-branch @@ -1536,16 +1693,30 @@ {::doc/added "2.16" ::webhooks/event? true ::sm/params schema:delete-file-branch} - [cfg {:keys [::rpc/profile-id ::rpc/session-id id]}] + [{:keys [::mbus/msgbus] :as cfg} {:keys [::rpc/profile-id ::rpc/session-id id]}] (check-branching-enabled!) - (let [branch (db/get* cfg :file-branch {:id id})] - (when (or (nil? branch) (some? (:deleted-at branch))) + (let [tpoint (ct/tpoint) + branch (db/get* cfg :file-branch {:id id}) + messages (volatile! [])] + (when (nil? branch) (ex/raise :type :not-found :code :branch-not-found :branch-id id)) (files/check-edition-permissions! cfg profile-id (:branch-file-id branch)) - (db/tx-run! + (tx-run-notify! cfg - (fn [cfg] - (delete-branch! cfg branch {:profile-id profile-id - :session-id session-id - :status "archived"}) - {:status :deleted})))) + msgbus + messages + (fn [{:keys [::db/conn] :as cfg}] + ;; Serialize against a merge of the same branch (which locks both + ;; files): without the lock a delete can commit while the merge + ;; runs, and the merge then deletes the branch a second time. The + ;; row is re-read under the lock: the branch may be gone by now. + (db/xact-lock! conn (:branch-file-id branch)) + (let [branch (db/get* conn :file-branch {:id id})] + (when (nil? branch) + (ex/raise :type :not-found :code :branch-not-found :branch-id id)) + ;; no `:status` here: a delete keeps the status the row carries + ;; (deleting a kept merged branch must not rewrite "merged") + (vswap! messages conj + (delete-branch! cfg branch {:profile-id profile-id + :session-id session-id})) + (audited {:status :deleted} tpoint :delete-branch)))))) diff --git a/backend/src/app/rpc/commands/files_pull_request.clj b/backend/src/app/rpc/commands/files_pull_request.clj index e4cf59d2d8..1c6ee5785f 100644 --- a/backend/src/app/rpc/commands/files_pull_request.clj +++ b/backend/src/app/rpc/commands/files_pull_request.clj @@ -261,7 +261,7 @@ :code :invalid-pull-request-title :hint "pull request title cannot be blank")) (let [branch (db/get* cfg :file-branch {:id branch-id})] - (when (or (nil? branch) (some? (:deleted-at branch))) + (when (nil? branch) (ex/raise :type :not-found :code :branch-not-found :branch-id branch-id)) @@ -298,64 +298,81 @@ ;; concurrent create-pull-request on the same branch. (db/xact-lock! conn branch-file-id) - (when (db/exec-one! conn [sql:get-open-pull-request-for-branch branch-id]) - (ex/raise :type :validation - :code :pull-request-already-exists - :hint "the branch already has an open pull request" - :branch-id branch-id)) + ;; Serialize against a merge of the same branch (which locks + ;; the branch file) and re-read the row under the lock: the + ;; branch may be merged and gone by now, so the stale row read + ;; before the transaction is dropped and everything below + ;; derives from the fresh one. + (let [branch (db/get* conn :file-branch {:id branch-id}) + branch-file-id (:branch-file-id branch) + target-id (:source-file-id branch)] + (when (nil? branch) + (ex/raise :type :not-found + :code :branch-not-found + :branch-id branch-id)) + (when (not= "open" (:status branch)) + (ex/raise :type :validation + :code :branch-not-open + :branch-id branch-id)) - (let [branch-file (bfc/get-file cfg branch-file-id :realize? true) - snapshot (pin-review-snapshot! cfg branch-file title profile-id) - pr-id (uuid/next) - ts (ct/now)] + (when (db/exec-one! conn [sql:get-open-pull-request-for-branch branch-id]) + (ex/raise :type :validation + :code :pull-request-already-exists + :hint "the branch already has an open pull request" + :branch-id branch-id)) - (db/insert! conn :file-pull-request - {:id pr-id - :file-branch-id branch-id - :source-file-id branch-file-id - :target-file-id target-id - :title title - :description description - :created-by profile-id - :status "open" - :review-snapshot-id (:id snapshot) - :review-revn (:revn branch-file) - :review-updated-at ts} - {::db/return-keys false}) + (let [branch-file (bfc/get-file cfg branch-file-id :realize? true) + snapshot (pin-review-snapshot! cfg branch-file title profile-id) + pr-id (uuid/next) + ts (ct/now)] - (doseq [reviewer-id reviewers] - (db/insert! conn :file-pull-request-review - {:pull-request-id pr-id - :profile-id reviewer-id} - {::db/return-keys false})) + (db/insert! conn :file-pull-request + {:id pr-id + :file-branch-id branch-id + :source-file-id branch-file-id + :target-file-id target-id + :title title + :description description + :created-by profile-id + :status "open" + :review-snapshot-id (:id snapshot) + :review-revn (:revn branch-file) + :review-updated-at ts} + {::db/return-keys false}) - (send-review-request-emails! conn - {:id pr-id - :source-file-id branch-file-id - :title title - :description description} - {:team-id team-id - :actor-id profile-id - :branch-name (:name branch) - :target-name (:name target-row) - :reviewers reviewers}) + (doseq [reviewer-id reviewers] + (db/insert! conn :file-pull-request-review + {:pull-request-id pr-id + :profile-id reviewer-id} + {::db/return-keys false})) - (mbus/pub! msgbus - :topic target-id - :message {:type :pull-request-created - :file-id target-id - :pull-request-id pr-id - :profile-id profile-id}) + (send-review-request-emails! conn + {:id pr-id + :source-file-id branch-file-id + :title title + :description description} + {:team-id team-id + :actor-id profile-id + :branch-name (:name branch) + :target-name (:name target-row) + :reviewers reviewers}) - {:id pr-id - :file-branch-id branch-id - :source-file-id branch-file-id - :target-file-id target-id - :title title - :description description - :status "open" - :review-revn (:revn branch-file) - :reviewers reviewers}))))))) + (mbus/pub! msgbus + :topic target-id + :message {:type :pull-request-created + :file-id target-id + :pull-request-id pr-id + :profile-id profile-id}) + + {:id pr-id + :file-branch-id branch-id + :source-file-id branch-file-id + :target-file-id target-id + :title title + :description description + :status "open" + :review-revn (:revn branch-file) + :reviewers reviewers})))))))) ;; --- COMMAND QUERY: get-file-pull-requests @@ -813,7 +830,6 @@ (let [branch (db/get* cfg :file-branch {:id (:file-branch-id pr)})] (when (or (nil? branch) - (some? (:deleted-at branch)) (not= "open" (:status branch))) (ex/raise :type :validation :code :branch-not-open @@ -825,6 +841,17 @@ (fn [{:keys [::db/conn] :as cfg}] (db/xact-lock! conn (:source-file-id pr)) + ;; Serialize against a merge of the same branch (which locks the + ;; branch file) and re-read the row under the lock: the branch + ;; may be merged and gone by now. + (let [branch (db/get* conn :file-branch {:id (:file-branch-id pr)})] + (when (or (nil? branch) + (not= "open" (:status branch))) + (ex/raise :type :validation + :code :branch-not-open + :hint "the pull request's branch is no longer open" + :pull-request-id id))) + (when (db/exec-one! conn [sql:get-open-pull-request-for-branch (:file-branch-id pr)]) (ex/raise :type :validation :code :pull-request-already-exists diff --git a/backend/src/app/rpc/commands/files_update.clj b/backend/src/app/rpc/commands/files_update.clj index e559bc2411..22cbebd630 100644 --- a/backend/src/app/rpc/commands/files_update.clj +++ b/backend/src/app/rpc/commands/files_update.clj @@ -45,12 +45,12 @@ (declare ^:private update-file*) (declare ^:private process-changes-and-validate) (declare ^:private take-snapshot?) -(declare ^:private invalidate-caches!) ;; PUBLIC API; intended to be used outside of this module (declare update-file!) (declare update-file-data!) (declare persist-file!) +(declare invalidate-caches!) (declare ^:private persist-branch-file!) (declare get-file) @@ -400,7 +400,9 @@ nil)) -(defn- invalidate-caches! +(defn invalidate-caches! + "Drop the cached library summary of `file`. Every write path that + persists a file calls it under the `:redis-cache` flag." [cfg {:keys [id] :as file}] (rds/run! cfg (fn [{:keys [::rds/conn]}] (let [key (files/file-summary-cache-key id)] diff --git a/backend/test/backend_tests/http_middleware_test.clj b/backend/test/backend_tests/http_middleware_test.clj index cc644a0221..c00ae08ce1 100644 --- a/backend/test/backend_tests/http_middleware_test.clj +++ b/backend/test/backend_tests/http_middleware_test.clj @@ -669,3 +669,18 @@ (t/is (= "safe user-facing hint" (:hint body))) (t/is (nil? (:state body))) (t/is (nil? (:path body))))) + +(t/deftest conflict-error-answers-409 + ;; A `:type :conflict` refusal (`:file-modified` on merge/update-from-main, + ;; `:file-locked` and restore `:file-modified` on snapshots) answers 409 + ;; carrying its own ex-data; without a `:conflict` method it fell to the + ;; default handler: 500 with `:type :server-error`, logged as unhandled. + (let [cause (ex-info "conflict" + {:type :conflict + :code :file-modified + :hint "main was modified, recompute the diff and retry"}) + response (http-errors/handle cause {}) + body (::yres/body response)] + (t/is (= 409 (::yres/status response))) + (t/is (= :conflict (:type body))) + (t/is (= :file-modified (:code body))))) diff --git a/backend/test/backend_tests/rpc_file_branch_oplog_test.clj b/backend/test/backend_tests/rpc_file_branch_oplog_test.clj index ca5c2fbfe7..50ed29f7e2 100644 --- a/backend/test/backend_tests/rpc_file_branch_oplog_test.clj +++ b/backend/test/backend_tests/rpc_file_branch_oplog_test.clj @@ -17,6 +17,7 @@ [app.common.types.shape :as cts] [app.common.uuid :as uuid] [app.config :as cf] + [app.db :as db] [app.rpc :as-alias rpc] [app.util.blob :as blob] [backend-tests.helpers :as th] @@ -64,9 +65,7 @@ branch-file-id (:branch-file-id create)] (t/testing "the branch file stores no real data" - (let [rows (stored-data-rows branch-file-id)] - (t/is (= 1 (count rows))) - (t/is (empty? (-> rows first :data blob/decode :pages))))) + (t/is (empty? (stored-data-rows branch-file-id)))) (t/testing "the op log starts empty" (t/is (empty? (oplog-rows branch-file-id)))) @@ -106,9 +105,7 @@ (blob/decode (:changes (first rows))))))) (t/testing "the stored data payload never grew" - (let [rows (stored-data-rows branch-file-id)] - (t/is (= 1 (count rows))) - (t/is (empty? (-> rows first :data blob/decode :pages))))) + (t/is (empty? (stored-data-rows branch-file-id)))) (t/testing "the derived state carries the branch edit" (let [out (th/command! {::th/type :get-file @@ -638,4 +635,118 @@ (t/is (= revn-before (:revn (th/db-get :file {:id branch-file-id})))) (t/is (= xlog-before (count (th/db-query :file-change {:file-id branch-file-id}))))) (t/testing "the branch still stores no data payload" - (t/is (= 1 (count (stored-data-rows branch-file-id))))))))) + (t/is (empty? (stored-data-rows branch-file-id)))))))) + +;;; --- Regression tests + +(t/deftest create-checks-the-branch-quota-inside-the-lock + ;; Two designers racing for the LAST branch slot of one file: the + ;; loser is refused only if its quota count runs inside the + ;; transaction, after the advisory lock, where it sees the winner's + ;; committed branch. A count taken outside the lock lets both creates + ;; read "one slot left" and both insert. + (with-redefs [cf/flags (conj cf/flags :branching)] + (let [profile1 (th/create-profile* 1 {:is-active true}) + profile2 (th/create-profile* 2 {:is-active true}) + proj-id (:default-project-id profile1) + file (th/create-file* 1 {:profile-id (:id profile1) + :project-id proj-id + :is-shared false}) + file-id (:id file) + ;; the racer is a second designer: the per-profile climit + ;; serializes one designer's creates against themselves + _ (th/create-file-role* {:file-id file-id + :profile-id (:id profile2) + :role :editor}) + real-lock db/xact-lock! + raced? (atom false)] + + (with-redefs [cf/get (th/config-get-mock {:quotes-branches-per-file 1}) + db/xact-lock! + (fn [conn n] + ;; on first entry into the transaction the racer + ;; runs to completion (its own transaction, its own + ;; connection, committed) BEFORE the outer create + ;; takes the advisory lock + (when (compare-and-set! raced? false true) + (t/is (nil? (:error (th/command! + {::th/type :create-file-branch + ::rpc/profile-id (:id profile2) + :file-id file-id + :name "racer"}))))) + (real-lock conn n))] + (let [out (th/command! {::th/type :create-file-branch + ::rpc/profile-id (:id profile1) + :file-id file-id + :name "outer"}) + data (ex-data (:error out)) + rows (th/db-query :file-branch {:source-file-id file-id})] + + (t/testing "the loser is refused with the quota error" + (t/is (some? (:error out))) + (t/is (= :restriction (:type data))) + (t/is (= :max-quote-reached (:code data)))) + + (t/testing "exactly the racer's branch exists" + (t/is (= 1 (count rows))) + (t/is (= (:id profile2) (:created-by (first rows)))))))))) + +(t/deftest create-refuses-a-blank-branch-name + ;; `::update-file-branch` refuses a blank name; creation used to + ;; accept one, leaving behind a branch the rename would reject. + (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}) + out (th/command! {::th/type :create-file-branch + ::rpc/profile-id (:id profile) + :file-id (:id file) + :name " "}) + data (ex-data (:error out))] + (t/is (some? (:error out))) + (t/is (= :validation (:type data))) + (t/is (= :invalid-branch-name (:code data))) + (t/is (empty? (th/db-query :file-branch {:source-file-id (:id file)})))))) + +(t/deftest create-writes-no-file-data-row + ;; The create docstring promises a branch file with NO data payload, + ;; and `pp:vcs:eht-derived-branch-never-persists-data` forbids the + ;; row: a payload on a branch file invites a third writer into a + ;; derived state that already has two. Only materializing the branch + ;; into an ordinary file creates it. + (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 (create-branch* profile (:id file) "no-payload") + branch-file-id (:branch-file-id create) + color-id (uuid/random)] + + (t/testing "creation writes no file_data row at all" + (t/is (empty? (th/db-query :file-data {:file-id branch-file-id})))) + + (t/testing "the branch still saves to its op log, without a payload" + (apply-change* profile branch-file-id + {:type :add-color + :color {:id color-id :name "C" :color "#112233" :opacity 1}}) + (t/is (= 1 (count (oplog-rows branch-file-id)))) + (t/is (empty? (stored-data-rows branch-file-id)))) + + (t/testing "the branch still reads" + (let [out (th/command! {::th/type :get-file + ::rpc/profile-id (:id profile) + :id branch-file-id})] + (t/is (nil? (:error out))) + (t/is (contains? (-> out :result :data :colors) color-id)))) + + (t/testing "materialize is what creates the payload row" + (let [out (th/command! {::th/type :materialize-file-branch + ::rpc/profile-id (:id profile) + :file-id branch-file-id})] + (t/is (nil? (:error out))) + (t/is (= :materialized (-> out :result :status)))) + (t/is (some? (th/db-get :file-data {:file-id branch-file-id :type "main"}))))))) diff --git a/backend/test/backend_tests/rpc_file_branch_test.clj b/backend/test/backend_tests/rpc_file_branch_test.clj index c8db98b875..86efd5393f 100644 --- a/backend/test/backend_tests/rpc_file_branch_test.clj +++ b/backend/test/backend_tests/rpc_file_branch_test.clj @@ -9,17 +9,21 @@ [app.binfile.common :as bfc] [app.common.features :as cfeat] [app.common.files.branch-merge :as bm] + [app.common.files.repair :as cfr] [app.common.files.validate :as cfv] [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.msgbus :as mbus] [app.rpc :as-alias rpc] [app.storage :as sto] + [app.util.blob :as blob] [backend-tests.helpers :as th] [clojure.string :as str] - [clojure.test :as t])) + [clojure.test :as t] + [promesa.exec.bulkhead :as pbh])) (t/use-fixtures :once th/state-init) (t/use-fixtures :each th/database-reset) @@ -764,6 +768,109 @@ (t/is (some? error)) (t/is (= :file-modified (-> error ex-data :code))))))) +(t/deftest merge-refuses-typo-in-resolution-values + (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)] + + ;; 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 "typo"})) + branch-id (:id create) + branch-file-id (:branch-file-id create)] + + ;; main edits the color -> green; branch edits it -> blue (conflict) + (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 "a typo in a whole-entity resolution value is refused" + (let [out (th/command! {::th/type :merge-file-branch + ::rpc/profile-id (:id profile) + :branch-id branch-id + :resolutions {cid :brnach}}) + error (:error out)] + (t/is (some? error)) + (t/is (= :validation (:type (ex-data error)))) + (t/is (= :params-validation (:code (ex-data error)))))) + + (t/testing "a typo in a per-attr value is refused, not silently read as main" + (let [out (th/command! {::th/type :merge-file-branch + ::rpc/profile-id (:id profile) + :branch-id branch-id + :resolutions {cid {:color :brnach}}}) + error (:error out)] + (t/is (some? error)) + (t/is (= :validation (:type (ex-data error)))) + ;; nothing was integrated: the branch is still open + (t/is (= "open" (:status (first (th/db-query :file-branch {:id branch-id}))))))) + + (t/testing "well-typed per-attr values still resolve" + (let [out (th/command! {::th/type :merge-file-branch + ::rpc/profile-id (:id profile) + :branch-id branch-id + :resolutions {cid {:color :branch}}})] + (t/is (nil? (:error out))) + (t/is (= :merged (-> out :result :status)))) + (let [out (th/command! {::th/type :get-file + ::rpc/profile-id (:id profile) + :id (:id file)})] + (t/is (= "#0000ff" (get-in out [:result :data :colors cid :color]))))))))) + +(t/deftest update-refuses-stale-expected-main-revn + (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}) + create (:result (th/command! {::th/type :create-file-branch + ::rpc/profile-id (:id profile) + :file-id (:id file) + :name "stale-update"})) + branch-id (:id create) + branch-file-id (:branch-file-id create) + cid (uuid/random)] + + ;; main advances after the branch was created + (apply-change* profile (:id file) + {:type :add-color :color {:id cid :name "M" :color "#00ff00" :opacity 1}}) + + (t/testing "a stale token is refused and the branch is unchanged" + (let [out (th/command! {::th/type :update-branch-from-main + ::rpc/profile-id (:id profile) + :branch-id branch-id + :expected-main-revn 9999}) + error (:error out)] + (t/is (some? error)) + (t/is (= :file-modified (-> error ex-data :code)))) + (let [out (th/command! {::th/type :get-file + ::rpc/profile-id (:id profile) + :id branch-file-id})] + (t/is (nil? (:error out))) + (t/is (not (contains? (-> out :result :data :colors) cid))))) + + (t/testing "the current token lets the update through" + (let [mf (th/db-get :file {:id (:id file)}) + out (th/command! {::th/type :update-branch-from-main + ::rpc/profile-id (:id profile) + :branch-id branch-id + :expected-main-revn (:revn mf)})] + (t/is (nil? (:error out))) + (t/is (= :updated (-> out :result :status)))) + (let [out (th/command! {::th/type :get-file + ::rpc/profile-id (:id profile) + :id branch-file-id})] + (t/is (contains? (-> out :result :data :colors) cid))))))) + (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}) @@ -925,6 +1032,129 @@ (t/is (= (:id file) (:file-id row))) (t/is (= (:id sobj2) (:media-id row))))))))) +(t/deftest merge-copies-colour-image-media-into-main + (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)) + + create (:result (th/command! {::th/type :create-file-branch + ::rpc/profile-id (:id profile) + :file-id (:id file) + :name "colour-image"})) + branch-id (:id create) + branch-file-id (:branch-file-id create) + + ;; media ADDED on the branch, used ONLY by a library colour: the + ;; colorpicker upload registers no :media entry, the row is + ;; referenced from the colour's :image id alone + sobj (sto/put-object! storage {::sto/content (sto/content "colour-image") + :bucket :file-media-object + :content-type "image/png"}) + fmo (th/create-file-media-object* {:file-id branch-file-id + :name "colour.png" + :mtype "image/png" + :media-id (:id sobj)}) + cid (uuid/random) + out (apply-change* profile branch-file-id + {:type :add-color + :color {:id cid :name "Brand" + :image {:id (:id fmo) + :width 100 :height 100 + :mtype "image/png"} + :opacity 1}})] + + (t/is (nil? (:error out))) + + (let [out (th/command! {::th/type :merge-file-branch + ::rpc/profile-id (:id profile) + :branch-id branch-id + :keep-branch true})] + (t/is (nil? (:error out))) + (t/is (= :merged (-> out :result :status)))) + + (let [out (th/command! {::th/type :get-file + ::rpc/profile-id (:id profile) + :id (:id file)}) + img-id (get-in out [:result :data :colors cid :image :id])] + (t/is (some? img-id)) + ;; the colour's image is a row owned by MAIN (a copy), not the + ;; branch's row (which dies with the branch file) + (t/is (not= (:id fmo) img-id)) + (let [row (th/db-get :file-media-object {:id img-id})] + (t/is (= (:id file) (:file-id row))) + (t/is (= (:id sobj) (:media-id row)))))))) + +(t/deftest update-from-main-copies-colour-image-media-into-branch + (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)) + + create (:result (th/command! {::th/type :create-file-branch + ::rpc/profile-id (:id profile) + :file-id (:id file) + :name "colour-image"})) + branch-id (:id create) + branch-file-id (:branch-file-id create) + + ;; media ADDED on MAIN after forking, used only by a library colour + sobj (sto/put-object! storage {::sto/content (sto/content "main-colour-image") + :bucket :file-media-object + :content-type "image/png"}) + fmo (th/create-file-media-object* {:file-id (:id file) + :name "main-colour.png" + :mtype "image/png" + :media-id (:id sobj)}) + cid (uuid/random) + out (apply-change* profile (:id file) + {:type :add-color + :color {:id cid :name "Brand" + :image {:id (:id fmo) + :width 100 :height 100 + :mtype "image/png"} + :opacity 1}})] + + (t/is (nil? (:error out))) + + (let [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 (= :updated (-> out :result :status)))) + + (let [out (th/command! {::th/type :get-file + ::rpc/profile-id (:id profile) + :id branch-file-id}) + img-id (get-in out [:result :data :colors cid :image :id])] + (t/is (some? img-id)) + ;; the colour's image keeps resolving to the right content (an + ;; inherited ref names MAIN's row: a branch stores no data, its + ;; document is the base snapshot plus the op log) + (let [row (th/db-get :file-media-object {:id img-id})] + (t/is (= (:id sobj) (:media-id row))))) + + (t/testing "the row is copied into the branch under a fresh id" + (let [[copy] (th/db-query :file-media-object + {:file-id branch-file-id + :media-id (:id sobj)})] + (t/is (some? copy)) + (t/is (not= (:id fmo) (:id copy))))) + + (t/testing "the update logs no phantom branch change" + ;; the colour image id must be re-pointed at the copy like every + ;; other ref (`bm/remap-changes`); left in main's frame it makes + ;; the colour differ from the new base and lands in the op log + (t/is (empty? (th/db-query :file-branch-change {:branch-id branch-id}))))))) + (t/deftest materialize-branch-into-an-ordinary-file (with-redefs [cf/flags (conj cf/flags :branching)] (let [profile (th/create-profile* 1 {:is-active true}) @@ -1292,3 +1522,744 @@ (t/is (= "materialize" (:branch-operation props))) (t/is (= "materialized" (:branch-outcome props))) (t/is (int? (:branch-duration-ms props)))))))) + +(t/deftest delete-serializes-against-a-concurrent-merge + ;; the delete must take the advisory lock the merge takes and re-read + ;; the branch under it: a merge that wins the race marks the branch + ;; merged and deletes it, so a delete arriving afterwards must refuse + ;; instead of deleting the branch a second time. + (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}) + create (:result (th/command! {::th/type :create-file-branch + ::rpc/profile-id (:id profile) + :file-id (:id file) + :name "contested"})) + branch-id (:id create) + branch-file-id (:branch-file-id create) + cid (uuid/random)] + (apply-change* profile branch-file-id + {:type :add-color :color {:id cid :name "C" :color "#112233" :opacity 1}}) + (let [orig-lock db/xact-lock! + merging? (atom false) + merged (atom nil)] + (with-redefs [db/xact-lock! + (fn [conn id] + ;; the first lock the delete takes is the signal: + ;; merge the same branch through the pool in its + ;; own transaction BEFORE the delete locks + (when (compare-and-set! merging? false true) + (reset! merged (th/command! {::th/type :merge-file-branch + ::rpc/profile-id (:id profile) + :branch-id branch-id}))) + (orig-lock conn id))] + (let [out (th/command! {::th/type :delete-file-branch + ::rpc/profile-id (:id profile) + :id branch-id})] + (t/is (= :branch-not-found (-> out :error ex-data :code))) + (t/is (= :merged (-> @merged :result :status))) + ;; the merge's deletion is the only one: the row still says + ;; the branch was merged + (let [[row] (th/db-query :file-branch {:id branch-id})] + (t/is (= "merged" (:status row))) + (t/is (some? (:deleted-at row)))))))))) + +(t/deftest delete-keeps-the-status-the-branch-carries + ;; deleting a kept merged branch must not rewrite its status: the + ;; record is the only place left that says the branch was merged + (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}) + create (:result (th/command! {::th/type :create-file-branch + ::rpc/profile-id (:id profile) + :file-id (:id file) + :name "kept"})) + branch-id (:id create) + branch-file-id (:branch-file-id create) + cid (uuid/random)] + (apply-change* profile branch-file-id + {:type :add-color :color {:id cid :name "C" :color "#112233" :opacity 1}}) + (let [out (th/command! {::th/type :merge-file-branch + ::rpc/profile-id (:id profile) + :branch-id branch-id + :keep-branch true})] + (t/is (= :merged (-> out :result :status)))) + (let [out (th/command! {::th/type :delete-file-branch + ::rpc/profile-id (:id profile) + :id branch-id})] + (t/is (nil? (:error out))) + (t/is (= :deleted (-> out :result :status)))) + (let [[row] (th/db-query :file-branch {:id branch-id})] + (t/is (= "merged" (:status row))) + (t/is (some? (:deleted-at row))))))) + +(t/deftest rename-reaches-the-branch-file-name + ;; the branch file carries its own name (set from the branch name at + ;; creation), so a rename that changes only the branch row leaves the + ;; views that show the file's name on the old one + (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 "old-name"})) + branch-id (:id create) + branch-file-id (:branch-file-id create)] + + (let [out (th/command! {::th/type :update-file-branch + ::rpc/profile-id (:id profile) + :id branch-id + :name "new-name"})] + (t/is (nil? (:error out)))) + + (let [[frow] (th/db-query :file {:id branch-file-id})] + (t/is (= "new-name" (:name frow))))))) + +(t/deftest small-branch-mutations-record-duration-and-outcome + (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 "audited"})) + branch-id (:id create)] + + (t/testing "a rename carries its operation, outcome and duration" + (let [out (th/command! {::th/type :update-file-branch + ::rpc/profile-id (:id profile) + :id branch-id + :name "audited-rename"}) + props (-> out :result meta :app.loggers.audit/props)] + (t/is (nil? (:error out))) + (t/is (= "rename-branch" (:branch-operation props))) + (t/is (= "ok" (:branch-outcome props))) + (t/is (int? (:branch-duration-ms props))))) + + (t/testing "archiving reports archive-branch, restoring restore-branch" + (let [out (th/command! {::th/type :archive-file-branch + ::rpc/profile-id (:id profile) + :id branch-id}) + props (-> out :result meta :app.loggers.audit/props)] + (t/is (nil? (:error out))) + (t/is (= "archive-branch" (:branch-operation props))) + (t/is (= "archived" (:branch-outcome props))) + (t/is (int? (:branch-duration-ms props)))) + (let [out (th/command! {::th/type :archive-file-branch + ::rpc/profile-id (:id profile) + :id branch-id + :archived false}) + props (-> out :result meta :app.loggers.audit/props)] + (t/is (nil? (:error out))) + (t/is (= "restore-branch" (:branch-operation props))) + (t/is (= "open" (:branch-outcome props))) + (t/is (int? (:branch-duration-ms props))))) + + (t/testing "a delete reports delete-branch and its outcome" + (let [out (th/command! {::th/type :delete-file-branch + ::rpc/profile-id (:id profile) + :id branch-id}) + props (-> out :result meta :app.loggers.audit/props)] + (t/is (nil? (:error out))) + (t/is (= "delete-branch" (:branch-operation props))) + (t/is (= "deleted" (:branch-outcome props))) + (t/is (int? (:branch-duration-ms props)))))))) + +(t/deftest base-at-follows-the-repositioned-base + (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 "meta"})) + branch-id (:id create)] + + ;; main moves after the fork... + (apply-change* profile (:id file) + {:type :add-color + :color {:id (uuid/random) :name "M" :color "#00ff00" :opacity 1}}) + + ;; ...and the update repositions the merge base to a new snapshot + (let [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 (= :updated (-> out :result :status)))) + + (let [brow (first (th/db-query :file-branch {:id branch-id})) + base (first (th/db-query :file-change {:id (:base-snapshot-id brow)})) + meta (:meta (:result (th/command! {::th/type :get-branch-diff + ::rpc/profile-id (:id profile) + :branch-id branch-id})))] + ;; `:base-at` is when the CURRENT base snapshot row was created... + (t/is (= (:created-at base) (:base-at meta))) + ;; ...which is after the branch was created + (t/is (ct/is-after? (:base-at meta) (:created-at brow))))))) + +;;; --- The validator decides what the repair leaves behind + +(defn- synthetic-validation-error + "One validation error that no repair stub fixes." + [file] + [{:code :parent-not-found + :hint "synthetic validation error" + :file-id (:id file) + :shape-id (uuid/random)}]) + +(defn- validate-once + "Stub for `cfv/validate-file` that reports the synthetic error on the + first call and nothing on the calls after it, so the repair runs and + what it leaves behind is only seen by the re-validation." + [] + (let [calls (atom 0)] + (fn [file _libs] + (when (= 1 (swap! calls inc)) + (synthetic-validation-error file))))) + +(defn- newest-xlog + "Decode the changes of the newest change-log (xlog) row written for a + file. Snapshot rows carry no changes and are skipped." + [file-id] + (->> (th/db-query :file-change {:file-id file-id}) + (filter #(some? (:changes %))) + (sort-by :revn) + (last) + (:changes) + (blob/decode))) + +(t/deftest merge-and-update-refuse-an-unrepairable-result + ;; the validator, not the merge, decides: what the repair cannot fix + ;; refuses the operation and the transaction rolls back instead of + ;; being persisted as if the repair had fixed it + (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}) + create (:result (th/command! {::th/type :create-file-branch + ::rpc/profile-id (:id profile) + :file-id (:id file) + :name "unrepairable"})) + branch-id (:id create) + branch-file-id (:branch-file-id create) + branch-color (uuid/random) + main-color (uuid/random) + + ;; validation reports an error the repair cannot fix: the + ;; repair produces no changes and the re-validation still + ;; reports the same error + unfixable (fn [file _libs] (synthetic-validation-error file)) + no-repair (fn [_file _libs _errors] [])] + + (t/testing "the merge refuses and leaves main and the branch untouched" + (apply-change* profile branch-file-id + {:type :add-color + :color {:id branch-color :name "B" :color "#112233" :opacity 1}}) + + (with-redefs [cfv/validate-file unfixable + cfr/repair-file no-repair] + (let [out (th/command! {::th/type :merge-file-branch + ::rpc/profile-id (:id profile) + :branch-id branch-id}) + data (ex-data (:error out))] + (t/is (some? (:error out))) + (t/is (= :validation (:type data))) + (t/is (= :merge-result-invalid (:code data))) + (t/is (= [:parent-not-found] (:codes data))) + (t/is (some? (:hint data))))) + + (let [colors (-> (th/command! {::th/type :get-file + ::rpc/profile-id (:id profile) + :id (:id file)}) + :result :data :colors)] + (t/is (empty? colors))) + + (let [[row] (th/db-query :file-branch {:id branch-id})] + (t/is (= "open" (:status row))))) + + (t/testing "the update refuses and leaves the branch untouched" + (apply-change* profile (:id file) + {:type :add-color + :color {:id main-color :name "M" :color "#445566" :opacity 1}}) + + (let [[base] (th/db-query :file-branch {:id branch-id})] + (with-redefs [cfv/validate-file unfixable + cfr/repair-file no-repair] + (let [out (th/command! {::th/type :update-branch-from-main + ::rpc/profile-id (:id profile) + :branch-id branch-id}) + data (ex-data (:error out))] + (t/is (some? (:error out))) + (t/is (= :validation (:type data))) + (t/is (= :update-result-invalid (:code data))) + (t/is (= [:parent-not-found] (:codes data))))) + + (let [colors (-> (th/command! {::th/type :get-file + ::rpc/profile-id (:id profile) + :id branch-file-id}) + :result :data :colors)] + (t/is (contains? colors branch-color)) + (t/is (not (contains? colors main-color)))) + + (let [[row] (th/db-query :file-branch {:id branch-id})] + (t/is (= "open" (:status row))) + (t/is (= (:base-revn base) (:base-revn row)))))) + + (t/testing "materialize never refuses: the exit door lets the user out" + (with-redefs [cfv/validate-file unfixable + cfr/repair-file no-repair] + (let [out (th/command! {::th/type :materialize-file-branch + ::rpc/profile-id (:id profile) + :file-id branch-file-id})] + (t/is (nil? (:error out))) + (t/is (= :materialized (-> out :result :status))) + (t/is (true? (-> out :result :changed))))) + + (let [row (th/db-get :file {:id branch-file-id})] + (t/is (false? (:is-branch row)))))))) + +(t/deftest the-change-log-carries-the-repair-changes + ;; the xlog row records what was applied to the file: the computed + ;; changes AND the repair changes, in application order. A client that + ;; catches up through lagged changes must end up with the stored file. + (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}) + create (:result (th/command! {::th/type :create-file-branch + ::rpc/profile-id (:id profile) + :file-id (:id file) + :name "logged-repair"})) + branch-id (:id create) + branch-file-id (:branch-file-id create) + page-id (uuid/random) + + ;; the repair renames the file's first page: one known change, + ;; captured so the log can be compared against it. The name is + ;; per scenario so the first scenario's repair (which the + ;; update's squash turns into a branch op) cannot stand in for + ;; the second one's repair + repairs (atom []) + repair! (fn [name] + (fn [file _libs _errors] + (let [change {:type :mod-page + :id (first (get-in file [:data :pages])) + :name name}] + (swap! repairs conj change) + [change])))] + + (t/testing "the update's xlog row carries the repair changes" + (apply-change* profile (:id file) + {:type :add-color + :color {:id (uuid/random) :name "M" :color "#445566" :opacity 1}}) + + (with-redefs [cfv/validate-file (validate-once) + cfr/repair-file (repair! "repaired-update")] + (let [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 (= :updated (-> out :result :status))))) + + (t/is (some #(= (first @repairs) %) (newest-xlog branch-file-id)))) + + (t/testing "the merge's xlog row carries the repair changes" + (reset! repairs []) + (apply-change* profile branch-file-id + {:type :add-page :id page-id :name "from-branch"}) + + (with-redefs [cfv/validate-file (validate-once) + cfr/repair-file (repair! "repaired-merge")] + (let [out (th/command! {::th/type :merge-file-branch + ::rpc/profile-id (:id profile) + :branch-id branch-id})] + (t/is (nil? (:error out))) + (t/is (= :merged (-> out :result :status))))) + + (t/is (some #(= (first @repairs) %) (newest-xlog (:id file)))))))) + +(t/deftest merge-update-and-materialize-invalidate-the-summary-cache + ;; the file summary cache is dropped by every write path; the branch + ;; writes are write paths too or the summary describes the pre-merge + ;; file until the next ordinary save + (with-redefs [cf/flags (conj cf/flags :branching :redis-cache)] + (let [profile (th/create-profile* 1 {:is-active true}) + proj-id (:default-project-id profile) + ;; random file ids: the cache outlives the test database reset, + ;; and a deterministic id would carry a previous run's summary + file (th/create-file* 1 {:id (uuid/random) + :profile-id (:id profile) + :project-id proj-id}) + create (:result (th/command! {::th/type :create-file-branch + ::rpc/profile-id (:id profile) + :file-id (:id file) + :name "cache-merge"})) + branch-id (:id create) + branch-file-id (:branch-file-id create) + + file2 (th/create-file* 2 {:id (uuid/random) + :profile-id (:id profile) + :project-id proj-id}) + create2 (:result (th/command! {::th/type :create-file-branch + ::rpc/profile-id (:id profile) + :file-id (:id file2) + :name "cache-update"})) + b2-id (:id create2) + b2-fid (:branch-file-id create2) + + summary (fn [id] + (:result (th/command! {::th/type :get-file-summary + ::rpc/profile-id (:id profile) + :id id})))] + + (t/testing "the merge drops the cached summary of main" + (apply-change* profile branch-file-id + {:type :add-color + :color {:id (uuid/random) :name "B" :color "#112233" :opacity 1}}) + + ;; the cache now describes the pre-merge main + (t/is (= 0 (-> (summary (:id file)) :colors :count))) + + (let [out (th/command! {::th/type :merge-file-branch + ::rpc/profile-id (:id profile) + :branch-id branch-id})] + (t/is (nil? (:error out))) + (t/is (= :merged (-> out :result :status)))) + + (t/is (= 1 (-> (summary (:id file)) :colors :count)))) + + (t/testing "the update drops the cached summary of the branch" + (apply-change* profile (:id file2) + {:type :add-color + :color {:id (uuid/random) :name "M" :color "#445566" :opacity 1}}) + + ;; the cache now describes the pre-update branch + (t/is (= 0 (-> (summary b2-fid) :colors :count))) + + (let [out (th/command! {::th/type :update-branch-from-main + ::rpc/profile-id (:id profile) + :branch-id b2-id})] + (t/is (nil? (:error out))) + (t/is (= :updated (-> out :result :status)))) + + (t/is (= 1 (-> (summary b2-fid) :colors :count)))) + + (t/testing "materialize drops the cached summary of the file" + ;; materializing alone persists what the file already derives, so + ;; the repair is what makes the stored state differ from the + ;; cached summary + (with-redefs [cfv/validate-file (validate-once) + cfr/repair-file (fn [_file _libs _errors] + [{:type :add-color + :color {:id (uuid/random) + :name "R" + :color "#778899" + :opacity 1}}])] + (let [out (th/command! {::th/type :materialize-file-branch + ::rpc/profile-id (:id profile) + :file-id b2-fid})] + (t/is (nil? (:error out))) + (t/is (= :materialized (-> out :result :status))))) + + (t/is (= 2 (-> (summary b2-fid) :colors :count))))))) + +;;; --- The branch row is re-read under the advisory lock +;; +;; The commands read the `file_branch` row before `db/tx-run!`. A +;; command that commits between that read and the advisory lock leaves +;; the stale row in play, so the row is re-read under the lock and only +;; that one is trusted. Each interleaving below runs the competing +;; command through the pool (its own transaction, committed) on the +;; FIRST `db/xact-lock!` call of the outer command, i.e. before the +;; outer one holds any lock. +;; +;; The RPC concurrency limiter caps `:merge-file-branch/global` and +;; `:update-branch-from-main/global` at one permit each, and would +;; serialize two same-kind commands completely (the nested one could +;; never run inside the outer one's transaction), hiding the lock-level +;; race these tests target; the interleaved tests run with the bulkhead +;; transparent. + +(defn- transparent-climit + "The bulkhead made transparent (see the section note above)." + [_limiter handler] + (handler)) + +(t/deftest merge-refuses-a-branch-merged-under-the-lock + ;; two merges of one open branch: the winner commits before the + ;; outer merge takes any lock. The outer merge must refuse instead of + ;; trusting its stale "open" row and deleting the branch the winner + ;; kept. + (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}) + create (:result (th/command! {::th/type :create-file-branch + ::rpc/profile-id (:id profile) + :file-id (:id file) + :name "contested"})) + branch-id (:id create) + branch-file-id (:branch-file-id create) + cid (uuid/random)] + (apply-change* profile branch-file-id + {:type :add-color :color {:id cid :name "C" :color "#112233" :opacity 1}}) + (let [orig-lock db/xact-lock! + raced? (atom false) + merged (atom nil)] + (with-redefs [pbh/invoke! transparent-climit + db/xact-lock! + (fn [conn id] + ;; the winning merge runs to completion BEFORE + ;; the outer one takes any lock, and keeps the + ;; branch so the outer merge still has its file + (when (compare-and-set! raced? false true) + (reset! merged (th/command! {::th/type :merge-file-branch + ::rpc/profile-id (:id profile) + :branch-id branch-id + :keep-branch true}))) + (orig-lock conn id))] + (let [out (th/command! {::th/type :merge-file-branch + ::rpc/profile-id (:id profile) + :branch-id branch-id})] + (t/is (= :branch-not-open (-> out :error ex-data :code))))) + (t/is (= :merged (-> @merged :result :status))) + (t/testing "main holds the first merge's revn only" + (t/is (= (-> @merged :result :revn) + (:revn (first (th/db-query :file {:id (:id file)})))))) + (t/testing "the branch the winning merge kept is still kept" + (let [[row] (th/db-query :file-branch {:id branch-id})] + (t/is (= "merged" (:status row))) + (t/is (nil? (:deleted-at row))))))))) + +(t/deftest merge-releases-the-base-the-lock-shows + ;; the merge releases the base snapshot pin (on the delete path), and + ;; the id must come from the row as it stands under the lock: an + ;; update-from-main that repositions the base while the merge waits + ;; must not leave the new base pinned for ten years while the + ;; superseded one is released a second time + (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}) + create (:result (th/command! {::th/type :create-file-branch + ::rpc/profile-id (:id profile) + :file-id (:id file) + :name "base-race"})) + branch-id (:id create) + branch-file-id (:branch-file-id create) + old-base (:base-snapshot-id (first (th/db-query :file-branch {:id branch-id}))) + cid (uuid/random) + mid (uuid/random)] + ;; the branch carries its own change and main moves ahead, so the + ;; competing update really repositions the merge base + (apply-change* profile branch-file-id + {:type :add-color :color {:id cid :name "C" :color "#112233" :opacity 1}}) + (apply-change* profile (:id file) + {:type :add-color :color {:id mid :name "M" :color "#332211" :opacity 1}}) + (let [orig-lock db/xact-lock! + raced? (atom false) + superseded (atom nil)] + (with-redefs [db/xact-lock! + (fn [conn id] + ;; before the merge takes any lock, an update + ;; from main repositions the merge base and + ;; releases the pin the branch carried so far + (when (compare-and-set! raced? false true) + (t/is (nil? (:error (th/command! {::th/type :update-branch-from-main + ::rpc/profile-id (:id profile) + :branch-id branch-id})))) + (reset! superseded + (:deleted-at (first (th/db-query :file-change {:id old-base}))))) + (orig-lock conn id))] + (let [out (th/command! {::th/type :merge-file-branch + ::rpc/profile-id (:id profile) + :branch-id branch-id})] + (t/is (nil? (:error out))) + (t/is (= :merged (-> out :result :status))))) + (let [brow (first (th/db-query :file-branch {:id branch-id})) + cur (first (th/db-query :file-change {:id (:base-snapshot-id brow)})) + old (first (th/db-query :file-change {:id old-base}))] + (t/is (not= old-base (:base-snapshot-id brow))) + ;; the merge released the CURRENT base snapshot... + (t/is (some? (:deleted-at cur))) + (t/is (ct/is-before? (:deleted-at cur) (ct/in-future {:days 400}))) + ;; ...and left the superseded one where the update left it + (t/is (= @superseded (:deleted-at old)))))))) + +(t/deftest update-releases-the-base-the-lock-shows + ;; the same stale base id on the update path: the second of two + ;; overlapping updates from main must release the base the first one + ;; created, not the one it superseded + (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}) + create (:result (th/command! {::th/type :create-file-branch + ::rpc/profile-id (:id profile) + :file-id (:id file) + :name "update-race"})) + branch-id (:id create) + old-base (:base-snapshot-id (first (th/db-query :file-branch {:id branch-id}))) + mid (uuid/random)] + (apply-change* profile (:id file) + {:type :add-color :color {:id mid :name "M" :color "#332211" :opacity 1}}) + (let [orig-lock db/xact-lock! + raced? (atom false) + first-base (atom nil) + superseded (atom nil)] + (with-redefs [pbh/invoke! transparent-climit + db/xact-lock! + (fn [conn id] + ;; the first update runs to completion BEFORE + ;; the second one takes any lock: it repositions + ;; the merge base and releases the old pin + (when (compare-and-set! raced? false true) + (t/is (nil? (:error (th/command! {::th/type :update-branch-from-main + ::rpc/profile-id (:id profile) + :branch-id branch-id})))) + (let [brow (first (th/db-query :file-branch {:id branch-id}))] + (reset! first-base (:base-snapshot-id brow)) + (reset! superseded + (:deleted-at (first (th/db-query :file-change {:id old-base})))))) + (orig-lock conn id))] + (let [out (th/command! {::th/type :update-branch-from-main + ::rpc/profile-id (:id profile) + :branch-id branch-id})] + (t/is (= :updated (-> out :result :status))))) + (let [brow (first (th/db-query :file-branch {:id branch-id})) + cur (first (th/db-query :file-change {:id (:base-snapshot-id brow)})) + prev (first (th/db-query :file-change {:id @first-base})) + old (first (th/db-query :file-change {:id old-base}))] + (t/is (not= @first-base (:base-snapshot-id brow))) + ;; the second update released the base the first one created + (t/is (some? (:deleted-at prev))) + (t/is (ct/is-before? (:deleted-at prev) (ct/in-future {:days 400}))) + ;; the superseded one is not released twice... + (t/is (= @superseded (:deleted-at old))) + ;; ...and the base the branch now points at stays pinned + (t/is (not (ct/is-before? (:deleted-at cur) (ct/in-future {:days 400}))))))))) + +;;; --- Messages leave only after the transaction commits +;; +;; A message sent from inside the transaction tells clients about state +;; they cannot read yet, and a rolled back transaction would tell them +;; about something that never happened. The stub below records, at +;; publish time, what ANOTHER connection sees. + +(t/deftest delete-notifies-only-after-the-commit + (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}) + create (:result (th/command! {::th/type :create-file-branch + ::rpc/profile-id (:id profile) + :file-id (:id file) + :name "notify"})) + branch-id (:id create) + seen (atom [])] + (with-redefs [mbus/pub! + (fn [_ & {:keys [topic message]}] + (swap! seen conj {:topic topic + :message message + :branch (first (th/db-query :file-branch {:id branch-id}))}))] + (let [out (th/command! {::th/type :delete-file-branch + ::rpc/profile-id (:id profile) + :id branch-id})] + (t/is (nil? (:error out))) + (t/is (= :deleted (-> out :result :status))))) + (let [[{:keys [message branch]}] @seen] + (t/is (= 1 (count @seen))) + (t/is (= :file-deleted (:type message))) + ;; the deletion was already committed when the message left + (t/is (some? (:deleted-at branch))))))) + +(t/deftest merge-notifies-only-after-the-commit + (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}) + create (:result (th/command! {::th/type :create-file-branch + ::rpc/profile-id (:id profile) + :file-id (:id file) + :name "notify-merge"})) + branch-id (:id create) + branch-file-id (:branch-file-id create) + cid (uuid/random) + seen (atom [])] + (t/is (nil? (:error (apply-change* profile branch-file-id + {:type :add-color :color {:id cid :name "C" :color "#112233" :opacity 1}})))) + (with-redefs [mbus/pub! + (fn [_ & {:keys [message]}] + (swap! seen conj {:message message + :main-revn (:revn (first (th/db-query :file {:id (:id file)})))}))] + ;; a refused merge publishes nothing + (let [out (th/command! {::th/type :merge-file-branch + ::rpc/profile-id (:id profile) + :branch-id branch-id + :expected-main-revn 9999})] + (t/is (= :file-modified (-> out :error ex-data :code))) + (t/is (empty? @seen))) + ;; the kept branch means :file-merged is the only message + (let [out (th/command! {::th/type :merge-file-branch + ::rpc/profile-id (:id profile) + :branch-id branch-id + :keep-branch true})] + (t/is (= :merged (-> out :result :status)))) + (let [[{:keys [message main-revn]}] @seen] + (t/is (= 1 (count @seen))) + (t/is (= :file-merged (:type message))) + ;; the merge was already committed when the message left + (t/is (= (:revn message) main-revn))))))) + +(t/deftest update-notifies-only-after-the-commit + (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}) + create (:result (th/command! {::th/type :create-file-branch + ::rpc/profile-id (:id profile) + :file-id (:id file) + :name "notify-update"})) + branch-id (:id create) + branch-file-id (:branch-file-id create) + mid (uuid/random) + seen (atom [])] + (t/is (nil? (:error (apply-change* profile (:id file) + {:type :add-color :color {:id mid :name "M" :color "#332211" :opacity 1}})))) + (with-redefs [mbus/pub! + (fn [_ & {:keys [topic message]}] + (swap! seen conj {:topic topic + :message message + :branch-revn (:revn (first (th/db-query :file {:id branch-file-id})))}))] + (let [out (th/command! {::th/type :update-branch-from-main + ::rpc/profile-id (:id profile) + :branch-id branch-id})] + (t/is (= :updated (-> out :result :status)))) + (let [[{:keys [topic message branch-revn]}] @seen] + (t/is (= 1 (count @seen))) + (t/is (= :file-merged (:type message))) + (t/is (= branch-file-id topic)) + ;; the update was already committed when the message left + (t/is (= (:revn message) branch-revn))))))) diff --git a/backend/test/backend_tests/rpc_file_pull_request_test.clj b/backend/test/backend_tests/rpc_file_pull_request_test.clj index 375faa066b..539c3740a4 100644 --- a/backend/test/backend_tests/rpc_file_pull_request_test.clj +++ b/backend/test/backend_tests/rpc_file_pull_request_test.clj @@ -11,6 +11,7 @@ [app.common.time :as ct] [app.common.uuid :as uuid] [app.config :as cf] + [app.db :as db] [app.rpc :as-alias rpc] [backend-tests.helpers :as th] [clojure.string :as str] @@ -511,6 +512,152 @@ (let [[row] (th/db-query :file-pull-request {:id (:id pr)})] (t/is (= "closed" (:status row))))))))) +(t/deftest create-serializes-against-a-concurrent-merge + ;; the create must re-read the branch under the advisory lock: a merge + ;; that wins the race closes the branch while the create waits for the + ;; lock, so a create arriving afterwards must refuse instead of opening + ;; a review over a branch that is already merged and gone. + (with-redefs [cf/flags pr-flags] + (let [author (th/create-profile* 1 {:is-active true}) + file (th/create-file* 1 {:profile-id (:id author) + :project-id (:default-project-id author)}) + branch (create-branch* author file "contested") + branch-id (:id branch) + branch-file-id (:branch-file-id branch)] + (add-color* author branch-file-id "Brand") + (let [orig-lock db/xact-lock! + merging? (atom false) + merged (atom nil)] + (with-redefs [db/xact-lock! + (fn [conn id] + ;; the first lock the create takes is the signal: + ;; merge the same branch through the pool in its + ;; own transaction BEFORE the create locks + (when (compare-and-set! merging? false true) + (reset! merged (th/command! {::th/type :merge-file-branch + ::rpc/profile-id (:id author) + :branch-id branch-id}))) + (orig-lock conn id))] + (let [out (th/command! {::th/type :create-pull-request + ::rpc/profile-id (:id author) + :branch-id branch-id + :title "review me"})] + (t/is (= :merged (-> @merged :result :status))) + (t/is (= :branch-not-found (-> out :error ex-data :code))) + (t/is (= [] (th/db-query :file-pull-request {:file-branch-id branch-id}))))))))) + +(t/deftest reopen-serializes-against-a-concurrent-merge + ;; the reopen must re-read the branch under the advisory lock too: the + ;; merge that wins the race closes the branch under the closed pull + ;; request's feet, so a reopen arriving afterwards must refuse instead + ;; of reviving a review over a branch that is already merged and gone. + (with-redefs [cf/flags pr-flags] + (let [author (th/create-profile* 1 {:is-active true}) + file (th/create-file* 1 {:profile-id (:id author) + :project-id (:default-project-id author)}) + branch (create-branch* author file "contested") + branch-id (:id branch) + branch-file-id (:branch-file-id branch)] + (add-color* author branch-file-id "Brand") + (let [pr (:result (create-pr* author branch-id {}))] + (t/is (nil? (:error (th/command! {::th/type :close-pull-request + ::rpc/profile-id (:id author) + :id (:id pr)})))) + (let [orig-lock db/xact-lock! + merging? (atom false) + merged (atom nil)] + (with-redefs [db/xact-lock! + (fn [conn id] + ;; the first lock the reopen takes is the signal: + ;; merge the same branch through the pool in its + ;; own transaction BEFORE the reopen locks + (when (compare-and-set! merging? false true) + (reset! merged (th/command! {::th/type :merge-file-branch + ::rpc/profile-id (:id author) + :branch-id branch-id}))) + (orig-lock conn id))] + (let [out (th/command! {::th/type :reopen-pull-request + ::rpc/profile-id (:id author) + :id (:id pr)})] + (t/is (= :merged (-> @merged :result :status))) + (t/is (= :branch-not-open (-> out :error ex-data :code))) + (t/is (= "closed" (:status (first (th/db-query :file-pull-request {:id (:id pr)})))))))))))) + +(t/deftest create-serializes-against-a-kept-concurrent-merge + ;; same race, but the merge keeps the branch: its row stays readable + ;; with status "merged" and its file is not deleted, so without the + ;; re-read the create sails past the stale status check and INSERTS a + ;; pull request for a branch the merge already closed. + (with-redefs [cf/flags pr-flags] + (let [author (th/create-profile* 1 {:is-active true}) + file (th/create-file* 1 {:profile-id (:id author) + :project-id (:default-project-id author)}) + branch (create-branch* author file "contested") + branch-id (:id branch) + branch-file-id (:branch-file-id branch)] + (add-color* author branch-file-id "Brand") + (let [orig-lock db/xact-lock! + merging? (atom false) + merged (atom nil)] + (with-redefs [db/xact-lock! + (fn [conn id] + ;; the first lock the create takes is the signal: + ;; merge the same branch through the pool in its + ;; own transaction BEFORE the create locks + (when (compare-and-set! merging? false true) + (reset! merged (th/command! {::th/type :merge-file-branch + ::rpc/profile-id (:id author) + :branch-id branch-id + :keep-branch true}))) + (orig-lock conn id))] + (let [out (th/command! {::th/type :create-pull-request + ::rpc/profile-id (:id author) + :branch-id branch-id + :title "review me"})] + (t/is (= :merged (-> @merged :result :status))) + (t/is (= "merged" (:status (first (th/db-query :file-branch {:id branch-id}))))) + (t/is (= :branch-not-open (-> out :error ex-data :code))) + (t/is (= [] (th/db-query :file-pull-request {:file-branch-id branch-id}))))))))) + +(t/deftest reopen-serializes-against-a-kept-concurrent-merge + ;; same race for the reopen: the kept merge leaves the branch row + ;; readable with status "merged", so without the re-read the reopen + ;; sails past the stale status check and REOPENS the closed pull + ;; request over a branch the merge already closed. + (with-redefs [cf/flags pr-flags] + (let [author (th/create-profile* 1 {:is-active true}) + file (th/create-file* 1 {:profile-id (:id author) + :project-id (:default-project-id author)}) + branch (create-branch* author file "contested") + branch-id (:id branch) + branch-file-id (:branch-file-id branch)] + (add-color* author branch-file-id "Brand") + (let [pr (:result (create-pr* author branch-id {}))] + (t/is (nil? (:error (th/command! {::th/type :close-pull-request + ::rpc/profile-id (:id author) + :id (:id pr)})))) + (let [orig-lock db/xact-lock! + merging? (atom false) + merged (atom nil)] + (with-redefs [db/xact-lock! + (fn [conn id] + ;; the first lock the reopen takes is the signal: + ;; merge the same branch through the pool in its + ;; own transaction BEFORE the reopen locks + (when (compare-and-set! merging? false true) + (reset! merged (th/command! {::th/type :merge-file-branch + ::rpc/profile-id (:id author) + :branch-id branch-id + :keep-branch true}))) + (orig-lock conn id))] + (let [out (th/command! {::th/type :reopen-pull-request + ::rpc/profile-id (:id author) + :id (:id pr)})] + (t/is (= :merged (-> @merged :result :status))) + (t/is (= "merged" (:status (first (th/db-query :file-branch {:id branch-id}))))) + (t/is (= :branch-not-open (-> out :error ex-data :code))) + (t/is (= "closed" (:status (first (th/db-query :file-pull-request {:id (:id pr)})))))))))))) + (t/deftest closed-pull-requests-listing (with-redefs [cf/flags pr-flags] (let [author (th/create-profile* 1 {:is-active true}) diff --git a/common/src/app/common/files/branch_merge.cljc b/common/src/app/common/files/branch_merge.cljc index e602add9df..945a54907c 100644 --- a/common/src/app/common/files/branch_merge.cljc +++ b/common/src/app/common/files/branch_merge.cljc @@ -684,10 +684,11 @@ Every payload `compute-changes` can emit is covered. `relink-refs` walks a whole map, so `:obj`, `:page`, `:params`, and a component's `:objects` are - complete on their own. The two payloads it cannot see are the values that - ARE the reference: a media object's `:id` (its `:media-id` is a storage key - and must not be touched), and an operation value that is the reference - itself. Token changes are left alone: no id in `id-map` is a token id." + complete on their own. The payloads it cannot see are the values that ARE + the reference: a media object's `:id` (its `:media-id` is a storage key and + must not be touched), a library color's `:image` id, and an operation value + that is the reference itself. Token changes are left alone: no id in + `id-map` is a token id." [changes id-map] (if (empty? id-map) changes @@ -698,6 +699,9 @@ (uuid? (:id (:object change))) (update-in [:object :id] lookup) + (uuid? (get-in change [:color :image :id])) + (update-in [:color :image :id] lookup) + (seq (:operations change)) (update :operations #(mapv (fn [op] (remap-op op id-map)) %)))) changes)))) diff --git a/frontend/src/app/main/data/workspace/branches.cljs b/frontend/src/app/main/data/workspace/branches.cljs index 0e771b1415..ea18012d93 100644 --- a/frontend/src/app/main/data/workspace/branches.cljs +++ b/frontend/src/app/main/data/workspace/branches.cljs @@ -459,34 +459,54 @@ (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 - resolution modal in update mode; with resolutions, applies them." + resolution modal in update mode; with resolutions, applies them. + + When the current diff in state is this branch's `:main->branch` diff, + 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`)." ([branch] (update-branch-from-main branch nil)) ([branch resolutions] (ptk/reify ::update-branch-from-main ptk/WatchEvent - (watch [_ _ _] - (rx/concat - (rx/of (ev/event {::ev/name "update-branch-from-main"})) - (->> (rp/cmd! :update-branch-from-main (cond-> {:branch-id (:id branch)} - (seq resolutions) (assoc :resolutions resolutions))) - (rx/mapcat - (fn [{:keys [status conflicts]}] - (case status - ;; the open branch file just changed server-side: hard-reload - ;; it so the pulled changes are shown - :updated (rx/of (ntf/success (tr "workspace.branches.update.success")) - (reload-file-window)) - ;; the returned conflicts are authoritative: they are the very - ;; ones the command computes `resolved?` against, and the diff - ;; the modal could fetch on its own is computed in another id - ;; frame, which can disagree with them (vcs:tp-update-conflict-frame) - :conflicts (rx/of (open-conflict-resolutions {:branch branch - :mode :update - :conflicts conflicts})) - :unsupported (rx/of (ntf/warn (tr "workspace.branches.update.unsupported"))) - (rx/of (ntf/error (tr "workspace.branches.update.error")))))) - (rx/catch (fn [cause] - (rx/of (refusal-notification cause (tr "workspace.branches.update.error"))))))))))) + (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]))] + (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]}] + (case status + ;; the open branch file just changed server-side: hard-reload + ;; it so the pulled changes are shown + :updated (rx/of (ntf/success (tr "workspace.branches.update.success")) + (reload-file-window)) + ;; the returned conflicts are authoritative: they are the very + ;; ones the command computes `resolved?` against, and the diff + ;; the modal could fetch on its own is computed in another id + ;; frame, which can disagree with them (vcs:tp-update-conflict-frame) + :conflicts (rx/of (open-conflict-resolutions {:branch branch + :mode :update + :conflicts conflicts})) + :unsupported (rx/of (ntf/warn (tr "workspace.branches.update.unsupported"))) + (rx/of (ntf/error (tr "workspace.branches.update.error")))))) + (rx/catch + (fn [cause] + (if (= :file-modified (:code (ex-data cause))) + ;; main moved under our feet: reload the diff so the + ;; user resolves against the current state (no + ;; update-specific "main moved" key exists, so this + ;; reuses merge's) + (rx/of (ntf/warn (tr "workspace.branches.merge.main-moved")) + (fetch-branch-diff branch-id :main->branch)) + (rx/of (refusal-notification cause (tr "workspace.branches.update.error"))))))))))))) (defn set-conflict-resolution "Choose `:main` or `:branch` for a whole conflicting entity (by id). This