mirror of
https://github.com/penpot/penpot.git
synced 2026-10-29 05:50:35 +00:00
🐛 Fix the open defects of the branching tech preview
Merge engine: a same-parent reorder, an addition under a parent main deleted, and a branch deleting a container main edited each lost work silently. Each now follows a policy read from backend/resources/app/branch-merge-policies.edn, re-read when the file changes, with the defaults: merge the reorder, and raise a conflict on the deleted parent or container. Added siblings keep the branch's order. A :mov-page index counts the target's full page list, a cleared page background reaches main, a per-attribute resolution can remove an attribute, and a token set reorder survives a rename on the other side. Conflict payloads name :main and :branch by document in both directions. Reorder detection costs nothing measurable on a page of 20,201 objects. Data versions: each op-log row records the data version it was written at, the branch replays its log in segments and migrates the document at each boundary, and the comparison base is migrated like main and the branch, so an upgrade no longer shows as false conflicts. Writers: a binfile import, an admin repair, file GC and a snapshot restore refuse a branch file, whose payload nothing reads, and the branch base pin cannot be renamed into a user snapshot. A branch save runs the ordinary media fix-up and logs the rewritten references. An update from main deletes the branch's copy of media main deleted and squashes no phantom media changes. Commands and UI: the pull-request commands publish their messages after the commit, the listing takes one connection per comparison and shows a warning instead of "in sync" when a comparison fails, materialize takes :branch-file-id, and a dashboard fetch that never answers ends in an error state instead of a spinner, with a refetch on reconnect. backend/dev/branch_merge_cases.clj builds one example file per merge policy case for demonstrating the alternatives. Two models wrote this change, claude-opus-5-5 and mimo-v2.6-pro, and the work switched between them, so the trailer reads mixed models. AI-assisted-by: mixed models
This commit is contained in:
Álvaro Tejero Cantero
parent
f6dc4bed2d
commit
8e62644741
305
backend/dev/branch_merge_cases.clj
Normal file
305
backend/dev/branch_merge_cases.clj
Normal file
@ -0,0 +1,305 @@
|
||||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS INC Sucursal en España SL
|
||||
|
||||
(ns branch-merge-cases
|
||||
"Ready-made branch-merge policy scenarios.
|
||||
|
||||
`create!` builds one file per tree-shape case in a new project of the
|
||||
profile's default team, with main and a branch already diverged:
|
||||
open the branch in the UI, press Compare to see the case, press Merge
|
||||
to trigger it. Every file name says its case.
|
||||
|
||||
The cases:
|
||||
|
||||
(a) the branch reorders one parent's children (Compare shows the
|
||||
child-order change; a `:merge` applies it as a `:mov-objects`
|
||||
change, `:refuse` refuses naming the parent, `:ignore` drops
|
||||
it silently)
|
||||
(b) main and the branch reorder the same parent differently
|
||||
(`:merge` makes it a conflict on the parent)
|
||||
(c) main deletes the frame P and the branch adds a shape inside P
|
||||
(d) the branch deletes the frame F and main recolours F's child C
|
||||
and adds N inside F
|
||||
(e) the branch adds three siblings in the order A, B, C (a merge
|
||||
must keep that order)
|
||||
|
||||
HOW TO RUN IT
|
||||
|
||||
The builder runs in the backend's own REPL inside the devenv, so the
|
||||
files it creates are ordinary files in the database the UI serves:
|
||||
|
||||
1. `.devenv/devenv repl` on the host bridges the container's backend
|
||||
nREPL (port 6064, the default `scripts/nrepl-eval.mjs` connects
|
||||
to). The bridge and its constraints are described in
|
||||
`.devenv/USAGE.md` (\"The entry point and the pieces behind it\").
|
||||
2. From the repo root, evaluate (the nREPL session persists between
|
||||
invocations, so the second call sees the loaded namespace):
|
||||
|
||||
node scripts/nrepl-eval.mjs '(require (quote branch-merge-cases))'
|
||||
node scripts/nrepl-eval.mjs \\
|
||||
'(branch-merge-cases/create! {:email \"you@example.com\" :project-name \"20261001-branch-merge-policies\"})'
|
||||
|
||||
The email is the devenv test account's, readable from
|
||||
`~/.config/penpot-devenv/test-account.json` (`.email`; never print
|
||||
its password). The call returns `{:project ... :files [...]}` and
|
||||
prints the created files with their ids.
|
||||
|
||||
If the backend process predates the branch-merge policy code, load it
|
||||
first (the compare path then binds the policies file around every
|
||||
comparison):
|
||||
|
||||
node scripts/nrepl-eval.mjs \\
|
||||
'(require (quote app.rpc.commands.files-branch-policies) (quote app.rpc.commands.files-branch))'
|
||||
|
||||
HOW TO FLIP A POLICY
|
||||
|
||||
Edit `backend/resources/app/branch-merge-policies.edn` (or whatever
|
||||
file `:branch-merge-policies-file` /
|
||||
`PENPOT_BRANCH_MERGE_POLICIES_FILE` names), save it, and press
|
||||
Compare again: the backend re-reads the file whenever its mtime
|
||||
changes — no restart. The alternatives:
|
||||
|
||||
:same-parent-reorder :merge | :refuse | :ignore
|
||||
:addition-under-deleted-parent :conflict | :refuse | :reparent-to-ancestor | :page-root
|
||||
:container-delete-over-main-edits :conflict | :expand | :cascade
|
||||
|
||||
An invalid file logs a warning and the engine runs the built-in
|
||||
defaults until the file is fixed."
|
||||
(:require
|
||||
[app.common.features :as cfeat]
|
||||
[app.common.time :as ct]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.uuid :as uuid]
|
||||
[app.db :as db]
|
||||
[app.loggers.audit :as audit]
|
||||
[app.rpc :as-alias rpc]
|
||||
[app.system :as sys]
|
||||
[clojure.pprint :refer [print-table]]
|
||||
[clojure.string :as str]))
|
||||
|
||||
;; --- Plumbing: the same RPC command functions the API serves, run on
|
||||
;; the live system map (`app.system/sys/system`).
|
||||
|
||||
(defn- command!
|
||||
"Run the registered RPC command `type` with `params` the way the RPC
|
||||
middleware does: the params carry the profile id and the request
|
||||
time. Audit is skipped — its middleware wants the HTTP request of a
|
||||
real call, and the RPC tests drive commands the same way."
|
||||
[type params]
|
||||
(let [[_ method-fn] (get-in sys/system [:app.rpc/methods type])]
|
||||
(when-not method-fn
|
||||
(throw (ex-info (str "rpc method not found: " (name type)) {:type type})))
|
||||
(with-redefs [audit/prepare-rpc-event (fn [& _] nil)
|
||||
audit/submit (constantly nil)]
|
||||
(method-fn (assoc params :app.rpc/request-at (ct/now))))))
|
||||
|
||||
(defn- get-profile
|
||||
[email]
|
||||
(or (db/get* sys/system :profile {:email (str/lower-case email)})
|
||||
(throw (ex-info "no profile for this email" {:email email}))))
|
||||
|
||||
(defn- file-row
|
||||
[file-id]
|
||||
(db/get* sys/system :file {:id file-id}))
|
||||
|
||||
(defn- page-id-of
|
||||
[profile-id file-id]
|
||||
(-> (command! :get-file {:app.rpc/profile-id profile-id :id file-id})
|
||||
:data :pages first))
|
||||
|
||||
(defn- update!
|
||||
"Apply `changes` to `file-id` through the ordinary update-file RPC —
|
||||
which is what the editor sends and what routes a branch file's saves
|
||||
into its op log."
|
||||
[profile-id file-id changes]
|
||||
(let [{:keys [revn vern]} (file-row file-id)]
|
||||
(command! :update-file
|
||||
{:app.rpc/profile-id profile-id
|
||||
:id file-id
|
||||
:session-id (uuid/next)
|
||||
:revn revn
|
||||
:vern vern
|
||||
:features cfeat/supported-features
|
||||
:changes (vec changes)})))
|
||||
|
||||
;; --- The change vocabulary the editor emits
|
||||
|
||||
(defn- shape
|
||||
[id name type parent-id frame-id]
|
||||
(cts/setup-shape {:id id :name name :type type
|
||||
:parent-id parent-id :frame-id frame-id}))
|
||||
|
||||
(defn- add-obj
|
||||
[page-id {:keys [id parent-id frame-id] :as obj}]
|
||||
{:type :add-obj
|
||||
:page-id page-id
|
||||
:id id
|
||||
:parent-id parent-id
|
||||
:frame-id frame-id
|
||||
:obj obj})
|
||||
|
||||
(defn- del-obj
|
||||
[page-id id]
|
||||
{:type :del-obj :page-id page-id :id id})
|
||||
|
||||
(defn- mod-obj
|
||||
[page-id id operations]
|
||||
{:type :mod-obj :page-id page-id :id id :operations (vec operations)})
|
||||
|
||||
(defn- reorder-children
|
||||
[page-id parent-id shapes]
|
||||
{:type :reorder-children
|
||||
:page-id page-id
|
||||
:parent-id parent-id
|
||||
:shapes (vec shapes)})
|
||||
|
||||
;; --- The cases: each returns {:file-name :branch-name :base :branch
|
||||
;; :main}, where `base` is main's content before the fork and
|
||||
;; `:branch`/`:main` are the diverging edits after it — each a function
|
||||
;; of the page id returning a change vector.
|
||||
|
||||
(defn- case-reorder-branch-only
|
||||
"The branch reorders the children of the parent frame P; main is
|
||||
untouched."
|
||||
[]
|
||||
(let [parent (uuid/next)
|
||||
c1 (uuid/next)
|
||||
c2 (uuid/next)
|
||||
c3 (uuid/next)]
|
||||
{:file-name "(a) same-parent reorder on the branch only"
|
||||
:branch-name "reorder"
|
||||
:base (fn [page-id]
|
||||
[(add-obj page-id (shape parent "parent" :frame uuid/zero uuid/zero))
|
||||
(add-obj page-id (shape c1 "child-1" :rect parent parent))
|
||||
(add-obj page-id (shape c2 "child-2" :rect parent parent))
|
||||
(add-obj page-id (shape c3 "child-3" :rect parent parent))])
|
||||
:branch (fn [page-id]
|
||||
[(reorder-children page-id parent [c2 c3 c1])])
|
||||
:main nil}))
|
||||
|
||||
(defn- case-reorder-both-sides
|
||||
"Main and the branch reorder the same parent frame's children into
|
||||
two different orders."
|
||||
[]
|
||||
(let [parent (uuid/next)
|
||||
c1 (uuid/next)
|
||||
c2 (uuid/next)
|
||||
c3 (uuid/next)]
|
||||
{:file-name "(b) both sides reorder one parent differently"
|
||||
:branch-name "reorder-diverging"
|
||||
:base (fn [page-id]
|
||||
[(add-obj page-id (shape parent "parent" :frame uuid/zero uuid/zero))
|
||||
(add-obj page-id (shape c1 "child-1" :rect parent parent))
|
||||
(add-obj page-id (shape c2 "child-2" :rect parent parent))
|
||||
(add-obj page-id (shape c3 "child-3" :rect parent parent))])
|
||||
:branch (fn [page-id]
|
||||
[(reorder-children page-id parent [c3 c1 c2])])
|
||||
:main (fn [page-id]
|
||||
[(reorder-children page-id parent [c2 c3 c1])])}))
|
||||
|
||||
(defn- case-add-under-deleted-parent
|
||||
"Main deletes the frame P while the branch adds a shape inside it."
|
||||
[]
|
||||
(let [parent (uuid/next)
|
||||
child (uuid/next)
|
||||
added (uuid/next)]
|
||||
{:file-name "(c) main deletes frame P, branch adds a shape inside P"
|
||||
:branch-name "add-under-deleted"
|
||||
:base (fn [page-id]
|
||||
[(add-obj page-id (shape parent "P" :frame uuid/zero uuid/zero))
|
||||
(add-obj page-id (shape child "child" :rect parent parent))])
|
||||
:branch (fn [page-id]
|
||||
[(add-obj page-id (shape added "added-inside-P" :rect parent parent))])
|
||||
:main (fn [page-id]
|
||||
[(del-obj page-id parent)])}))
|
||||
|
||||
(defn- case-delete-container-over-main-edits
|
||||
"The branch deletes the frame F while main recolours F's child C and
|
||||
adds N inside F."
|
||||
[]
|
||||
(let [frame (uuid/next)
|
||||
child (uuid/next)
|
||||
added (uuid/next)]
|
||||
{:file-name "(d) branch deletes frame F, main recolours child C and adds N inside F"
|
||||
:branch-name "delete-container"
|
||||
:base (fn [page-id]
|
||||
[(add-obj page-id (shape frame "F" :frame uuid/zero uuid/zero))
|
||||
(add-obj page-id (shape child "C" :rect frame frame))])
|
||||
:branch (fn [page-id]
|
||||
[(del-obj page-id frame)])
|
||||
:main (fn [page-id]
|
||||
[(mod-obj page-id child
|
||||
[{:type :set
|
||||
:attr :fills
|
||||
:val [{:fill-color "#ff0000" :fill-opacity 1}]}])
|
||||
(add-obj page-id (shape added "N" :rect frame frame))])}))
|
||||
|
||||
(defn- case-addition-order
|
||||
"The branch adds three siblings under the frame S, in the order A, B,
|
||||
C — a merge must keep that order."
|
||||
[]
|
||||
(let [frame (uuid/next)
|
||||
a (uuid/next)
|
||||
b (uuid/next)
|
||||
c (uuid/next)]
|
||||
{:file-name "(e) branch adds three siblings in the order A, B, C"
|
||||
:branch-name "add-three"
|
||||
:base (fn [page-id]
|
||||
[(add-obj page-id (shape frame "S" :frame uuid/zero uuid/zero))])
|
||||
:branch (fn [page-id]
|
||||
[(add-obj page-id (shape a "sibling-A" :rect frame frame))
|
||||
(add-obj page-id (shape b "sibling-B" :rect frame frame))
|
||||
(add-obj page-id (shape c "sibling-C" :rect frame frame))])
|
||||
:main nil}))
|
||||
|
||||
(defn- create-case!
|
||||
"Create the case's file, write its base content on main, fork the
|
||||
branch, then apply the two diverging edits. Returns the file ids."
|
||||
[profile-id project-id {:keys [file-name branch-name base branch main]}]
|
||||
(let [file-id (:id (command! :create-file
|
||||
{:app.rpc/profile-id profile-id
|
||||
:project-id project-id
|
||||
:name file-name}))
|
||||
page-id (page-id-of profile-id file-id)
|
||||
_ (when base
|
||||
(update! profile-id file-id (base page-id)))
|
||||
create (command! :create-file-branch
|
||||
{:app.rpc/profile-id profile-id
|
||||
:file-id file-id
|
||||
:name branch-name})
|
||||
branch-id (:id create)]
|
||||
(when branch
|
||||
(update! profile-id (:branch-file-id create) (branch page-id)))
|
||||
(when main
|
||||
(update! profile-id file-id (main page-id)))
|
||||
{:id file-id
|
||||
:name file-name
|
||||
:branch-id branch-id
|
||||
:branch-file-id (:branch-file-id create)}))
|
||||
|
||||
(defn create!
|
||||
"Create the five policy cases as files in a NEW project of the
|
||||
profile's default team. Returns `{:project {:id :name} :files [...]}`
|
||||
and prints the created files with their ids and names."
|
||||
[{:keys [email project-name]}]
|
||||
(when-not (and (string? email) (string? project-name))
|
||||
(throw (ex-info "expected {:email \"..\" :project-name \"..\"}"
|
||||
{:email email :project-name project-name})))
|
||||
(let [profile (get-profile email)
|
||||
project (command! :create-project
|
||||
{:app.rpc/profile-id (:id profile)
|
||||
:team-id (:default-team-id profile)
|
||||
:name project-name})
|
||||
files (mapv (fn [build] (create-case! (:id profile) (:id project) (build)))
|
||||
[case-reorder-branch-only
|
||||
case-reorder-both-sides
|
||||
case-add-under-deleted-parent
|
||||
case-delete-container-over-main-edits
|
||||
case-addition-order])]
|
||||
(println "project:" (:name project) (str (:id project)))
|
||||
(print-table [:id :name :branch-id :branch-file-id] files)
|
||||
{:project {:id (:id project) :name (:name project)}
|
||||
:files files}))
|
||||
47
backend/resources/app/branch-merge-policies.edn
Normal file
47
backend/resources/app/branch-merge-policies.edn
Normal file
@ -0,0 +1,47 @@
|
||||
;; Branch merge policies: the switch that decides how the merge engine
|
||||
;; resolves the three tree-shape cases where a silent default drops work.
|
||||
;;
|
||||
;; This file is re-read whenever its mtime changes, so a policy flip is:
|
||||
;; edit the value here, re-run the compare or merge — no restart. An
|
||||
;; invalid file logs a warning and the engine falls back to the built-in
|
||||
;; defaults (`app.common.files.branch-merge/default-policies`) until the
|
||||
;; file is fixed. A key left out of the map keeps its default.
|
||||
;;
|
||||
;; Every policy is one key with one value; the comments under each key
|
||||
;; list the alternatives with a sentence each.
|
||||
|
||||
{;; --- :same-parent-reorder
|
||||
;; The branch — or both sides — reorders the children of one parent.
|
||||
;;
|
||||
;; :merge detect the child-order change, show it in the compare and
|
||||
;; apply it as a :mov-objects change; both sides reordering
|
||||
;; the same parent differently is a conflict on the parent.
|
||||
;; :refuse the merge/update refuses with :unsupported, naming the
|
||||
;; parent.
|
||||
;; :ignore today's behaviour: the reorder is dropped silently.
|
||||
:same-parent-reorder :merge
|
||||
|
||||
;; --- :addition-under-deleted-parent
|
||||
;; main deleted the frame P while the branch added a shape inside P.
|
||||
;;
|
||||
;; :conflict a :modify-delete conflict on P: :branch
|
||||
;; restores P as the branch has it, addition
|
||||
;; included; :main drops the addition.
|
||||
;; :refuse the merge/update refuses with :unsupported.
|
||||
;; :reparent-to-ancestor place the addition under the nearest
|
||||
;; ancestor main still has.
|
||||
;; :page-root today's behaviour: the addition lands at
|
||||
;; the page root.
|
||||
:addition-under-deleted-parent :conflict
|
||||
|
||||
;; --- :container-delete-over-main-edits
|
||||
;; The branch deleted the container F while main modified or added
|
||||
;; anything inside F's subtree.
|
||||
;;
|
||||
;; :conflict a :delete-modify conflict on F: :branch deletes the
|
||||
;; whole subtree knowingly; :main keeps F and its subtree
|
||||
;; as main has them.
|
||||
;; :expand delete only shapes the branch deleted; main's additions
|
||||
;; move to F's parent.
|
||||
;; :cascade today's behaviour: the whole subtree goes.
|
||||
:container-delete-over-main-edits :conflict}
|
||||
@ -295,7 +295,7 @@
|
||||
END")
|
||||
|
||||
(def ^:private sql:get-branch-changes
|
||||
"SELECT changes
|
||||
"SELECT changes, data_version
|
||||
FROM file_branch_change
|
||||
WHERE file_id = ?
|
||||
AND deleted_at IS NULL
|
||||
@ -309,10 +309,50 @@
|
||||
(->> (db/exec! conn [sql:get-branch-changes branch-file-id])
|
||||
(mapv (fn [{:keys [changes]}] (blob/decode changes)))))
|
||||
|
||||
(defn- migrate-detached
|
||||
"Migrate `file` in memory with `migrate-fn`, called as
|
||||
`(migrate-fn file libs)`, under the bindings `migrate-file` sets up.
|
||||
Persists nothing: the branch derive migrates documents it builds
|
||||
itself, the replayed branch and its merge base, and neither has a
|
||||
row to write back to."
|
||||
[cfg {:keys [id] :as file} migrate-fn]
|
||||
(binding [pmap/*load-fn* (partial fdata/load-pointer cfg id)
|
||||
pmap/*tracked* (pmap/create-tracked)]
|
||||
(migrate-fn file (delay (get-resolved-file-libraries cfg file)))))
|
||||
|
||||
(defn migrate-branch-base
|
||||
"The `:data` of a branch's merge-base snapshot at the current data
|
||||
version. The snapshot keeps the version main had when the base was
|
||||
taken, while `get-file` migrates main and the branch on every read, so
|
||||
a three-way comparison sees one version on all three sides only when
|
||||
the base migrates the same way, with main's libraries. A base already
|
||||
at the current version comes back as it is.
|
||||
|
||||
`snapshot` is a snapshot row with its data decoded: `:file-id`,
|
||||
`:data`, `:version` and the `:migrations` its data holds."
|
||||
[cfg {:keys [file-id data version migrations]}]
|
||||
(let [base {:id file-id
|
||||
:data data
|
||||
:version version
|
||||
:migrations (some-> migrations not-empty set)}]
|
||||
(if (fmg/need-migration? base)
|
||||
(:data (migrate-detached cfg base fmg/migrate-file))
|
||||
data)))
|
||||
|
||||
(defn- branch-file-data
|
||||
"Derive the `:data` of a branch file: the merge-base snapshot plus
|
||||
every op appended to the branch's log, replayed in revn order.
|
||||
|
||||
Each op-log row records the data version its changes were written at.
|
||||
The replay starts from the base at the base's version, and before a
|
||||
row written at a later version it migrates the document to that
|
||||
version, the point where an ordinary file migrates across an upgrade.
|
||||
The document never migrates past the version of the next row, because
|
||||
a migration assumes its input is at the version before it. The file
|
||||
returned carries the version and migration set the replay ended at, so
|
||||
`get-file*` migrates the rest of the way in memory, and a log with no
|
||||
upgrade since the base (the steady state) never migrates at all.
|
||||
|
||||
Returns the file with `:data` decoded (plain maps); callers that asked
|
||||
for `:decode? false` get it re-encoded as bytes so the update-file
|
||||
pipeline (which always blob-decodes) is unaffected.
|
||||
@ -328,10 +368,11 @@
|
||||
ordinary read neither times nor logs anything.
|
||||
|
||||
With `include-base-data?` true the returned file also carries the
|
||||
decoded merge-base document under `::base-data`, which is the value
|
||||
the replay starts from. A caller that is about to compare the branch
|
||||
with its base reads the branch file with that flag and takes the
|
||||
value, and it never decodes the same snapshot a second time."
|
||||
merge-base document under `::base-data`, migrated to the current data
|
||||
version (`migrate-branch-base`), the version `get-file` brings main and
|
||||
the branch to. A caller that is about to compare the branch with its
|
||||
base reads the branch file with that flag and takes the value, and it
|
||||
never decodes the same snapshot a second time."
|
||||
[{:keys [::db/conn] :as cfg} {:keys [id] :as file} decode? include-base-data?]
|
||||
(let [tpoint (ct/tpoint)
|
||||
|
||||
@ -373,27 +414,48 @@
|
||||
|
||||
rows (db/exec! conn [sql:get-branch-changes id])
|
||||
|
||||
;; the decoded merge-base document. It is what the replay starts
|
||||
;; from, and `process-changes` builds its result with persistent
|
||||
;; updates and never writes into its input, so this value stays
|
||||
;; the pre-replay state while `data` becomes the branch. A caller
|
||||
;; that needs the merge base takes this value instead of decoding
|
||||
;; the same snapshot a second time.
|
||||
base-data (:data base)
|
||||
;; the document the replay works on: the merge base at the
|
||||
;; base's data version, under the branch file's identity, so a
|
||||
;; migration on the way resolves the branch's libraries
|
||||
doc (-> file
|
||||
(assoc :data (:data base))
|
||||
(assoc :version (or (:version base) (:version file)))
|
||||
(assoc :migrations (:migrations base)))
|
||||
|
||||
;; the derive replays the log batch by batch, so each batch is
|
||||
;; decoded exactly once. `depth` is the flattened op count, the
|
||||
;; quantity `files_branch.clj::check-oplog-depth-limit!` limits,
|
||||
;; and the one that predicts the cost of the replay.
|
||||
[data depth]
|
||||
(reduce (fn [[data depth] {:keys [changes]}]
|
||||
(let [changes (blob/decode changes)]
|
||||
[(cpc/process-changes data changes)
|
||||
;;
|
||||
;; A row's `data_version` is the version its changes were
|
||||
;; written at; the document migrates to it before the row
|
||||
;; applies, and in the steady state that check is one set
|
||||
;; lookup. A NULL stamp marks a row written before the column
|
||||
;; existed: it replays at the version the document holds, which
|
||||
;; is the base's version, because such rows precede every
|
||||
;; stamped row of their log. That is how the derive replayed
|
||||
;; every row before the column existed.
|
||||
[doc depth]
|
||||
(reduce (fn [[doc depth] {:keys [changes data-version]}]
|
||||
(let [changes (blob/decode changes)
|
||||
doc (if (fmg/need-migration-to? doc data-version)
|
||||
(migrate-detached cfg doc #(fmg/migrate-file-to %1 %2 data-version))
|
||||
doc)]
|
||||
[(update doc :data cpc/process-changes changes)
|
||||
(+ depth (count changes))]))
|
||||
[base-data 0]
|
||||
[doc 0]
|
||||
rows)
|
||||
|
||||
data (if decode? data (blob/encode data))
|
||||
data (cond-> (:data doc)
|
||||
(not decode?) (blob/encode))
|
||||
|
||||
;; the comparison's `base` is the merge base before the replay,
|
||||
;; at the version main and the branch are read at. The replay
|
||||
;; returns the branch's own state in `data`, so a comparison
|
||||
;; handed `data` as its base would compare the branch with
|
||||
;; itself.
|
||||
base-data (when include-base-data?
|
||||
(migrate-branch-base cfg base))
|
||||
|
||||
;; measured once so the log line and the audit props carry the same
|
||||
;; number. The timer covers the re-encode as well when the caller
|
||||
@ -407,20 +469,16 @@
|
||||
:duration-ms duration)
|
||||
|
||||
(-> file
|
||||
;; the derived data is the BASE's data plus the op log, so the
|
||||
;; file carries the base's version and migration set; this keeps
|
||||
;; `need-migration?` quiet while base and main share a version
|
||||
;; and migrates in memory (read-only) only when the base is
|
||||
;; actually stale
|
||||
;; the derived data carries the version and migration set the
|
||||
;; replay ended at: the base's own while no row was written past
|
||||
;; it, which keeps `need-migration?` quiet in the steady state,
|
||||
;; and a later one when the replay crossed an upgrade
|
||||
(assoc :data data)
|
||||
(assoc :version (or (:version base) (:version file)))
|
||||
(cond-> (some? (:migrations base))
|
||||
(assoc :migrations (:migrations base)))
|
||||
(assoc :version (:version doc))
|
||||
(assoc :features (:features doc))
|
||||
(cond-> (some? (:migrations doc))
|
||||
(assoc :migrations (:migrations doc)))
|
||||
(cond-> include-base-data?
|
||||
;; the comparison's `base` is the value the replay started from,
|
||||
;; which is the merge base as decoded. The replay returns the
|
||||
;; branch's own state in `data`, so a comparison handed `data`
|
||||
;; as its base would compare the branch with itself.
|
||||
(assoc ::base-data base-data))
|
||||
;; the numbers travel with the value, because the RPC audit event
|
||||
;; of the read that paid for this derive reads `::audit/props` off
|
||||
@ -432,6 +490,7 @@
|
||||
{:branch-derive-ms duration
|
||||
:branch-oplog-depth depth
|
||||
:branch-oplog-batches (count rows)}))))
|
||||
|
||||
(defn- get-file*
|
||||
[{:keys [::db/conn] :as cfg} id
|
||||
{:keys [migrate?
|
||||
@ -726,7 +785,12 @@
|
||||
|
||||
(defn update-media-references!
|
||||
"Given a file and a coll of media-refs, check if all provided
|
||||
references are correct or fix them in-place"
|
||||
references are correct or fix them in-place. Returns a tuple of the
|
||||
fixed file and the id remapping the fix applied ({foreign-id ->
|
||||
copy-id}): the file data is rewritten in-place, but a caller that
|
||||
persists a change vector instead of the data (the branch save path)
|
||||
has to record the same remap in it, or its derive reproduces the
|
||||
unfixed references."
|
||||
[{:keys [::db/conn] :as cfg} {file-id :id :as file} media-refs]
|
||||
(let [missing-index
|
||||
(reduce (fn [result {:keys [id] :as fmo}]
|
||||
@ -769,7 +833,7 @@
|
||||
(db/insert! conn :file-media-object item
|
||||
{::db/return-keys false}))
|
||||
|
||||
file))
|
||||
[file (update-vals missing-index :id)]))
|
||||
|
||||
(def sql:get-file-media
|
||||
"SELECT * FROM file_media_object WHERE id = ANY(?)")
|
||||
|
||||
@ -1212,6 +1212,11 @@
|
||||
(db/exec! cfg [sql-1 file-id])
|
||||
(db/exec! cfg [sql-2 file-id]))))))
|
||||
|
||||
(def ^:private sql:is-branch-file
|
||||
"SELECT f.is_branch
|
||||
FROM file AS f
|
||||
WHERE f.id = ?")
|
||||
|
||||
(defn- import-file-and-overwrite*
|
||||
[{:keys [::manifest ::bfc/file-id] :as cfg}]
|
||||
|
||||
@ -1221,6 +1226,15 @@
|
||||
:hint "unable to perform in-place update with binfile containing more than 1 file"
|
||||
:manifest manifest))
|
||||
|
||||
;; A branch file's data payload is derived from the branch base and
|
||||
;; the operation log; overwriting it would persist a `file_data` row
|
||||
;; no read path consults.
|
||||
(when (:is-branch (db/exec-one! cfg [sql:is-branch-file file-id]))
|
||||
(ex/raise :type :validation
|
||||
:code :branch-file-cant-be-overwritten
|
||||
:hint "branch file data is derived from the branch base and the operation log and can't be overwritten by an import"
|
||||
:file-id file-id))
|
||||
|
||||
(bfc/configure-database-timeouts! cfg)
|
||||
|
||||
(let [ref-file (bfc/get-minimal-file cfg file-id ::db/for-update true)
|
||||
|
||||
@ -53,6 +53,8 @@
|
||||
:branching-max-pages 500
|
||||
:branching-max-oplog-changes 100000
|
||||
|
||||
:branch-merge-policies-file "resources/app/branch-merge-policies.edn"
|
||||
|
||||
:public-uri "http://localhost:3449"
|
||||
|
||||
:host "localhost"
|
||||
@ -171,6 +173,12 @@
|
||||
[:branching-max-pages {:optional true} ::sm/int]
|
||||
[:branching-max-oplog-changes {:optional true} ::sm/int]
|
||||
|
||||
;; The branch-merge policy switch file: a commented EDN map that
|
||||
;; picks one alternative per policy. Re-read on mtime change, so it
|
||||
;; can be edited while the backend runs. See
|
||||
;; `app.rpc.commands.files-branch-policies`.
|
||||
[:branch-merge-policies-file {:optional true} ::fs/path]
|
||||
|
||||
[:media-max-file-size {:optional true} ::sm/int]
|
||||
[:font-max-file-size {:optional true} ::sm/int]
|
||||
|
||||
|
||||
@ -526,7 +526,10 @@
|
||||
:fn (mg/resource "app/migrations/sql/0156-add-file-pull-request-tables.sql")}
|
||||
|
||||
{:name "0157-add-file-branch-change-table"
|
||||
:fn (mg/resource "app/migrations/sql/0157-add-file-branch-change-table.sql")}])
|
||||
:fn (mg/resource "app/migrations/sql/0157-add-file-branch-change-table.sql")}
|
||||
|
||||
{:name "0158-add-file-branch-change-data-version"
|
||||
:fn (mg/resource "app/migrations/sql/0158-add-file-branch-change-data-version.sql")}])
|
||||
|
||||
(defn apply-migrations!
|
||||
[pool name migrations]
|
||||
|
||||
@ -0,0 +1,18 @@
|
||||
-- The data version each op-log row was written at: the name of the last
|
||||
-- file data migration (`app.common.files.migrations/available-migrations`)
|
||||
-- of the backend that applied the row's changes. A data version is a
|
||||
-- prefix of that list, so its last name identifies it. The branch derive
|
||||
-- (`app.binfile.common/branch-file-data`) replays the log in segments: it
|
||||
-- migrates the document to a row's version before it applies the row, the
|
||||
-- point where an ordinary file migrates across an upgrade.
|
||||
--
|
||||
-- The merge base needs no column of its own: its snapshot row
|
||||
-- (`file_change.migrations`) records the migrations its data holds.
|
||||
--
|
||||
-- NULL marks a row written before this column existed. The derive replays
|
||||
-- such a row at the version the document holds, which is the base's
|
||||
-- version because those rows precede every stamped row of their log. That
|
||||
-- is how the derive replayed every row before this column existed.
|
||||
|
||||
ALTER TABLE file_branch_change
|
||||
ADD COLUMN IF NOT EXISTS data_version text NULL;
|
||||
File diff suppressed because it is too large
Load Diff
103
backend/src/app/rpc/commands/files_branch_policies.clj
Normal file
103
backend/src/app/rpc/commands/files_branch_policies.clj
Normal file
@ -0,0 +1,103 @@
|
||||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS INC Sucursal en España SL
|
||||
|
||||
(ns app.rpc.commands.files-branch-policies
|
||||
"The branch-merge policy switch: reads the policies file and binds its
|
||||
choices around the branch computations that read them.
|
||||
|
||||
The file (`resources/app/branch-merge-policies.edn` by default,
|
||||
`:branch-merge-policies-file` to point elsewhere) is a commented EDN
|
||||
map with one key per policy. It is re-read whenever its mtime changes,
|
||||
so a developer flips a policy by editing the file and re-running the
|
||||
compare or merge — no restart. A key the file leaves out keeps its
|
||||
default (`bm/default-policies`); a file that is unreadable, is not a
|
||||
map, names an unknown policy or picks a value outside
|
||||
`bm/policy-values` logs a warning and falls back to the defaults
|
||||
entirely.
|
||||
|
||||
`with-policies` binds `bm/*policies*` to the effective policies around
|
||||
a computation; `policies-hash` turns them into a cache key component,
|
||||
so summaries computed under different policies never share a cache
|
||||
entry."
|
||||
(:require
|
||||
[app.common.files.branch-merge :as bm]
|
||||
[app.common.logging :as l]
|
||||
[app.config :as cf]
|
||||
[clojure.edn :as edn]
|
||||
[datoteka.fs :as fs]))
|
||||
|
||||
(def ^:private state
|
||||
"Cache of the last load: the file identity (path + mtime) and the
|
||||
policies it yielded. A file is re-read only when its mtime changes."
|
||||
(atom nil))
|
||||
|
||||
(defn- policies-path
|
||||
"The configured policies file, or nil when it does not exist (an
|
||||
unconfigured instance runs the defaults)."
|
||||
[]
|
||||
(let [path (cf/get :branch-merge-policies-file)]
|
||||
(when (and (some? path)
|
||||
(fs/exists? path)
|
||||
(fs/regular-file? path))
|
||||
(fs/path path))))
|
||||
|
||||
(defn- warn-invalid!
|
||||
[path reason]
|
||||
(l/warn :hint "invalid branch merge policies file"
|
||||
:path (str path)
|
||||
:reason reason
|
||||
:fallback "app.common.files.branch-merge/default-policies"
|
||||
::l/sync? true))
|
||||
|
||||
(defn- read-policies
|
||||
"The policies map the file at `path` names — the entries it sets
|
||||
overlay `bm/default-policies` — or nil after a warning when its
|
||||
content is not a valid policies map."
|
||||
[path]
|
||||
(try
|
||||
(let [data (edn/read-string (slurp path))]
|
||||
(if (and (map? data)
|
||||
(every? (fn [[key value]]
|
||||
(contains? (get bm/policy-values key) value))
|
||||
data))
|
||||
(merge bm/default-policies data)
|
||||
(do
|
||||
(warn-invalid! path "not a map of policy keys to allowed values")
|
||||
nil)))
|
||||
(catch Throwable cause
|
||||
(warn-invalid! path (ex-message cause))
|
||||
nil)))
|
||||
|
||||
(defn effective-policies
|
||||
"The policies currently in effect: what the policies file names,
|
||||
re-read on mtime change, `bm/default-policies` when the file is
|
||||
absent or invalid (after a warning)."
|
||||
[]
|
||||
(let [path (policies-path)]
|
||||
(if (nil? path)
|
||||
bm/default-policies
|
||||
(let [mtime (inst-ms (fs/last-modified-time path))
|
||||
cache @state]
|
||||
(if (and (= path (::path cache))
|
||||
(= mtime (::mtime cache)))
|
||||
(::policies cache)
|
||||
(let [policies (or (read-policies path) bm/default-policies)]
|
||||
(reset! state {::path path ::mtime mtime ::policies policies})
|
||||
policies))))))
|
||||
|
||||
(defn policies-hash
|
||||
"Hash of the policies currently bound (`bm/*policies*`), for cache
|
||||
keys: two different policies must never share a cached summary, and a
|
||||
key must hash exactly the policies its value was computed under."
|
||||
[]
|
||||
(hash bm/*policies*))
|
||||
|
||||
(defmacro with-policies
|
||||
"Evaluate `body` with `bm/*policies*` bound to the effective
|
||||
policies — the policies file, re-read on mtime change."
|
||||
[& body]
|
||||
`(binding [bm/*policies* (effective-policies)]
|
||||
~@body))
|
||||
@ -282,15 +282,18 @@
|
||||
(let [target-row (db/get-by-id cfg :file target-id)
|
||||
project (db/get-by-id cfg :project (:project-id target-row))
|
||||
team-id (:team-id project)
|
||||
reviewers (validate-reviewers! cfg team-id profile-id (or reviewers []))]
|
||||
reviewers (validate-reviewers! cfg team-id profile-id (or reviewers []))
|
||||
messages (volatile! [])]
|
||||
|
||||
(-> cfg
|
||||
(assoc ::quotes/profile-id profile-id)
|
||||
(assoc ::quotes/team-id team-id)
|
||||
(quotes/check! {::quotes/id ::quotes/pull-requests-per-team}))
|
||||
|
||||
(db/tx-run!
|
||||
(fbranch/tx-run-notify!
|
||||
cfg
|
||||
msgbus
|
||||
messages
|
||||
(fn [{:keys [::db/conn] :as cfg}]
|
||||
;; Serialize against concurrent update-file on the branch so
|
||||
;; the review snapshot captures a consistent state (same
|
||||
@ -357,12 +360,12 @@
|
||||
:target-name (:name target-row)
|
||||
: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})
|
||||
(vswap! messages conj
|
||||
{: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
|
||||
@ -587,9 +590,12 @@
|
||||
|
||||
(let [team-id (perms/get-team-id-for-file cfg (:target-file-id pr))
|
||||
reviewers (some->> reviewers
|
||||
(validate-reviewers! cfg team-id (:created-by pr)))]
|
||||
(db/tx-run!
|
||||
(validate-reviewers! cfg team-id (:created-by pr)))
|
||||
messages (volatile! [])]
|
||||
(fbranch/tx-run-notify!
|
||||
cfg
|
||||
msgbus
|
||||
messages
|
||||
(fn [{:keys [::db/conn]}]
|
||||
(db/update! conn :file-pull-request
|
||||
(cond-> {:updated-at (ct/now)}
|
||||
@ -622,12 +628,12 @@
|
||||
:target-name (:target-name row)
|
||||
:reviewers added})))))
|
||||
|
||||
(mbus/pub! msgbus
|
||||
:topic (:target-file-id pr)
|
||||
:message {:type :pull-request-updated
|
||||
:file-id (:target-file-id pr)
|
||||
:pull-request-id id
|
||||
:profile-id profile-id})
|
||||
(vswap! messages conj
|
||||
{:topic (:target-file-id pr)
|
||||
:message {:type :pull-request-updated
|
||||
:file-id (:target-file-id pr)
|
||||
:pull-request-id id
|
||||
:profile-id profile-id}})
|
||||
|
||||
{:id id
|
||||
:title (or title (:title pr))
|
||||
@ -651,7 +657,8 @@
|
||||
::climit/id [[:update-pull-request-snapshot/global]]}
|
||||
[{:keys [::mbus/msgbus] :as cfg} {:keys [::rpc/profile-id id]}]
|
||||
(check-pull-requests-enabled!)
|
||||
(let [pr (get-pull-request* cfg id)]
|
||||
(let [pr (get-pull-request* cfg id)
|
||||
messages (volatile! [])]
|
||||
(when (not= "open" (:status pr))
|
||||
(ex/raise :type :validation
|
||||
:code :pull-request-not-open
|
||||
@ -661,8 +668,10 @@
|
||||
;; creating the pull request
|
||||
(files/check-edition-permissions! cfg profile-id (:source-file-id pr))
|
||||
|
||||
(db/tx-run!
|
||||
(fbranch/tx-run-notify!
|
||||
cfg
|
||||
msgbus
|
||||
messages
|
||||
(fn [{:keys [::db/conn] :as cfg}]
|
||||
;; serialize against concurrent update-file on the branch so the
|
||||
;; new snapshot captures a consistent state
|
||||
@ -688,12 +697,12 @@
|
||||
{:id id}
|
||||
{::db/return-keys false})
|
||||
|
||||
(mbus/pub! msgbus
|
||||
:topic (:target-file-id pr)
|
||||
:message {:type :pull-request-updated
|
||||
:file-id (:target-file-id pr)
|
||||
:pull-request-id id
|
||||
:profile-id profile-id})
|
||||
(vswap! messages conj
|
||||
{:topic (:target-file-id pr)
|
||||
:message {:type :pull-request-updated
|
||||
:file-id (:target-file-id pr)
|
||||
:pull-request-id id
|
||||
:profile-id profile-id}})
|
||||
|
||||
{:id id :review-revn (:revn branch-file) :updated true})))))))
|
||||
|
||||
@ -717,15 +726,18 @@
|
||||
[{:keys [::mbus/msgbus] :as cfg}
|
||||
{:keys [::rpc/profile-id id state comment]}]
|
||||
(check-pull-requests-enabled!)
|
||||
(let [pr (get-pull-request* cfg id)]
|
||||
(let [pr (get-pull-request* cfg id)
|
||||
messages (volatile! [])]
|
||||
(when (not= "open" (:status pr))
|
||||
(ex/raise :type :validation
|
||||
:code :pull-request-not-open
|
||||
:pull-request-id id))
|
||||
(files/check-read-permissions! cfg profile-id (:target-file-id pr))
|
||||
|
||||
(db/tx-run!
|
||||
(fbranch/tx-run-notify!
|
||||
cfg
|
||||
msgbus
|
||||
messages
|
||||
(fn [{:keys [::db/conn]}]
|
||||
(let [review (db/get* conn :file-pull-request-review
|
||||
{:pull-request-id id :profile-id profile-id})]
|
||||
@ -743,13 +755,13 @@
|
||||
{:pull-request-id id :profile-id profile-id}
|
||||
{::db/return-keys false})
|
||||
|
||||
(mbus/pub! msgbus
|
||||
:topic (:target-file-id pr)
|
||||
:message {:type :pull-request-review-submitted
|
||||
:file-id (:target-file-id pr)
|
||||
:pull-request-id id
|
||||
:profile-id profile-id
|
||||
:state state})
|
||||
(vswap! messages conj
|
||||
{:topic (:target-file-id pr)
|
||||
:message {:type :pull-request-review-submitted
|
||||
:file-id (:target-file-id pr)
|
||||
:pull-request-id id
|
||||
:profile-id profile-id
|
||||
:state state}})
|
||||
|
||||
{:id id
|
||||
:profile-id profile-id
|
||||
@ -772,15 +784,18 @@
|
||||
::sm/params schema:close-pull-request}
|
||||
[{:keys [::mbus/msgbus] :as cfg} {:keys [::rpc/profile-id id]}]
|
||||
(check-pull-requests-enabled!)
|
||||
(let [pr (get-pull-request* cfg id)]
|
||||
(let [pr (get-pull-request* cfg id)
|
||||
messages (volatile! [])]
|
||||
(when (not= "open" (:status pr))
|
||||
(ex/raise :type :validation
|
||||
:code :pull-request-not-open
|
||||
:pull-request-id id))
|
||||
(check-author-or-admin! cfg profile-id pr)
|
||||
|
||||
(db/tx-run!
|
||||
(fbranch/tx-run-notify!
|
||||
cfg
|
||||
msgbus
|
||||
messages
|
||||
(fn [{:keys [::db/conn] :as cfg}]
|
||||
(let [team (teams/get-team conn :profile-id profile-id
|
||||
:file-id (:target-file-id pr))
|
||||
@ -795,12 +810,12 @@
|
||||
{::db/return-keys false})
|
||||
(release-review-snapshot! cfg pr (ct/in-future delay))
|
||||
|
||||
(mbus/pub! msgbus
|
||||
:topic (:target-file-id pr)
|
||||
:message {:type :pull-request-closed
|
||||
:file-id (:target-file-id pr)
|
||||
:pull-request-id id
|
||||
:profile-id profile-id})
|
||||
(vswap! messages conj
|
||||
{:topic (:target-file-id pr)
|
||||
:message {:type :pull-request-closed
|
||||
:file-id (:target-file-id pr)
|
||||
:pull-request-id id
|
||||
:profile-id profile-id}})
|
||||
|
||||
{:id id :status "closed"})))))
|
||||
|
||||
@ -820,7 +835,8 @@
|
||||
::sm/params schema:reopen-pull-request}
|
||||
[{:keys [::mbus/msgbus] :as cfg} {:keys [::rpc/profile-id id]}]
|
||||
(check-pull-requests-enabled!)
|
||||
(let [pr (get-pull-request* cfg id)]
|
||||
(let [pr (get-pull-request* cfg id)
|
||||
messages (volatile! [])]
|
||||
(when (not= "closed" (:status pr))
|
||||
(ex/raise :type :validation
|
||||
:code :pull-request-not-closed
|
||||
@ -836,8 +852,10 @@
|
||||
:hint "the pull request's branch is no longer open"
|
||||
:pull-request-id id))
|
||||
|
||||
(db/tx-run!
|
||||
(fbranch/tx-run-notify!
|
||||
cfg
|
||||
msgbus
|
||||
messages
|
||||
(fn [{:keys [::db/conn] :as cfg}]
|
||||
(db/xact-lock! conn (:source-file-id pr))
|
||||
|
||||
@ -872,12 +890,12 @@
|
||||
{:id id}
|
||||
{::db/return-keys false})
|
||||
|
||||
(mbus/pub! msgbus
|
||||
:topic (:target-file-id pr)
|
||||
:message {:type :pull-request-updated
|
||||
:file-id (:target-file-id pr)
|
||||
:pull-request-id id
|
||||
:profile-id profile-id})
|
||||
(vswap! messages conj
|
||||
{:topic (:target-file-id pr)
|
||||
:message {:type :pull-request-updated
|
||||
:file-id (:target-file-id pr)
|
||||
:pull-request-id id
|
||||
:profile-id profile-id}})
|
||||
|
||||
{:id id :status "open" :review-revn (:revn branch-file)}))))))
|
||||
|
||||
|
||||
@ -118,6 +118,16 @@
|
||||
;; Check permissions and read current file state (short-lived, outside restore transaction)
|
||||
(files/check-edition-permissions! pool profile-id file-id)
|
||||
(let [file (bfc/get-file cfg file-id)
|
||||
|
||||
;; A branch file's data payload is derived from the branch base
|
||||
;; and the operation log; restoring would persist a `file_data`
|
||||
;; row no read path consults.
|
||||
_ (when (:is-branch file)
|
||||
(ex/raise :type :validation
|
||||
:code :branch-file-cant-be-restored
|
||||
:hint "branch file data is derived from the branch base and the operation log; restore the snapshot on the source file or update the branch from main instead"
|
||||
:file-id file-id))
|
||||
|
||||
team (teams/get-team pool
|
||||
:profile-id profile-id
|
||||
:file-id file-id)
|
||||
@ -161,6 +171,14 @@
|
||||
[{:keys [::db/conn]} {:keys [::rpc/profile-id id label]}]
|
||||
(let [snapshot (fsnap/get-minimal-snapshot conn id)]
|
||||
(files/check-edition-permissions! conn profile-id (:file-id snapshot))
|
||||
|
||||
(when (not= (:created-by snapshot) "user")
|
||||
(ex/raise :type :validation
|
||||
:code :system-snapshots-cant-be-renamed
|
||||
:file-id (:file-id snapshot)
|
||||
:snapshot-id id
|
||||
:profile-id profile-id))
|
||||
|
||||
(fsnap/update! conn (assoc snapshot :label label))))
|
||||
|
||||
(def ^:private schema:remove-file-snapshot
|
||||
|
||||
@ -10,6 +10,7 @@
|
||||
[app.common.data :as d]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.features :as cfeat]
|
||||
[app.common.files.branch-merge :as bm]
|
||||
[app.common.files.changes :as cpc]
|
||||
[app.common.files.migrations :as fmg]
|
||||
[app.common.files.validate :as val]
|
||||
@ -252,7 +253,12 @@
|
||||
revn
|
||||
(get file :revn)
|
||||
|
||||
file
|
||||
;; The changes application runs the media fix-up, which may
|
||||
;; rewrite the media references. It returns the change vector
|
||||
;; as fixed: that is the vector a branch appends to its op
|
||||
;; log, the state its derive reproduces. The xlog row below
|
||||
;; keeps the client's changes, exactly as on an ordinary save.
|
||||
[file op-changes]
|
||||
(binding [cfeat/*current* features
|
||||
cfeat/*previous* (:features file)]
|
||||
(update-file-data! cfg file
|
||||
@ -290,7 +296,7 @@
|
||||
{::db/return-keys false})
|
||||
|
||||
(if (:is-branch file)
|
||||
(persist-branch-file! cfg file changes)
|
||||
(persist-branch-file! cfg file op-changes)
|
||||
(persist-file! cfg file))
|
||||
|
||||
(when (contains? cf/flags :redis-cache)
|
||||
@ -362,7 +368,17 @@
|
||||
and the `file` row (revn, version, features, modified-at) plus the
|
||||
project modified-at are updated as usual, without any `file_data`
|
||||
write. The transient `file_change` xlog row (inserted by the caller)
|
||||
keeps the lagged-changes machinery working unchanged."
|
||||
keeps the lagged-changes machinery working unchanged.
|
||||
|
||||
The vector stores the media fix-up the save ran: `update-file*` passes
|
||||
the changes as rewritten by `process-changes-and-validate`, so the
|
||||
derive reproduces the copied media rows and their references.
|
||||
|
||||
The row records the data version the changes were applied at:
|
||||
`update-file-data!` migrates the document to the current version
|
||||
before it applies them, and the derive
|
||||
(`app.binfile.common/branch-file-data`) migrates its replay to that
|
||||
version before it applies the row."
|
||||
[{:keys [::db/conn ::timestamp] :as cfg} file changes]
|
||||
(let [modified-at (or timestamp (ct/now))
|
||||
|
||||
@ -392,6 +408,7 @@
|
||||
:file-id (:id file)
|
||||
:revn (:revn file)
|
||||
:changes (blob/encode changes)
|
||||
:data-version (fmg/data-version)
|
||||
:created-at modified-at
|
||||
:updated-at modified-at}
|
||||
{::db/return-keys false})
|
||||
@ -493,10 +510,16 @@
|
||||
(update :data cpc/process-changes changes)
|
||||
(update :data d/without-nils)))
|
||||
|
||||
file
|
||||
;; The media fix-up copies the foreign media rows into the file
|
||||
;; and rewrites the references on the file data. A branch
|
||||
;; persists no data: its state is the change vector, so the same
|
||||
;; rewrite is recorded in it and the derive reproduces the fix
|
||||
;; (`bm/remap-changes` is a no-op with an empty remap).
|
||||
[file op-changes]
|
||||
(if-let [media-refs (-> @state :media-refs not-empty)]
|
||||
(bfc/update-media-references! cfg file media-refs)
|
||||
file)]
|
||||
(let [[file media-index] (bfc/update-media-references! cfg file media-refs)]
|
||||
[file (bm/remap-changes changes media-index)])
|
||||
[file changes])]
|
||||
|
||||
(binding [pmap/*tracked* nil]
|
||||
(when (contains? cf/flags :soft-file-validation)
|
||||
@ -513,7 +536,7 @@
|
||||
(not skip-validate))
|
||||
(val/validate-file-schema! file)))
|
||||
|
||||
file))
|
||||
[file op-changes]))
|
||||
|
||||
(defn- take-snapshot?
|
||||
"Defines the rule when file `data` snapshot should be saved."
|
||||
|
||||
@ -10,6 +10,7 @@
|
||||
(:require
|
||||
[app.binfile.common :as bfc]
|
||||
[app.common.data :as d]
|
||||
[app.common.exceptions :as ex]
|
||||
[app.common.files.migrations :as fmg]
|
||||
[app.common.files.validate :as cfv]
|
||||
[app.common.time :as ct]
|
||||
@ -159,6 +160,15 @@
|
||||
:lock-for-update? true
|
||||
:realize? true)
|
||||
|
||||
;; A branch file's data payload is derived from the branch base
|
||||
;; and the operation log; processing it would persist a
|
||||
;; `file_data` row no read path consults.
|
||||
_ (when (:is-branch file)
|
||||
(ex/raise :type :validation
|
||||
:code :branch-file-cant-be-processed
|
||||
:hint "branch file data is derived from the branch base and the operation log; process the source file instead"
|
||||
:file-id file-id))
|
||||
|
||||
libs (when with-libraries?
|
||||
(bfc/get-resolved-file-libraries system file))
|
||||
|
||||
|
||||
@ -36,7 +36,7 @@
|
||||
having the same media object associated with two different files;"
|
||||
[cfg file]
|
||||
(let [media-refs (collect-media-refs (:data file))]
|
||||
(bfc/update-media-references! cfg file media-refs)))
|
||||
(first (bfc/update-media-references! cfg file media-refs))))
|
||||
|
||||
(def ^:private sql:get-files
|
||||
"SELECT f.id
|
||||
|
||||
@ -229,13 +229,21 @@
|
||||
(defn- process-file!
|
||||
[cfg {:keys [file-id] :as props}]
|
||||
(if-let [file (get-file cfg props)]
|
||||
(let [file (->> file
|
||||
(bfl/clean-file)
|
||||
(clean-media! cfg)
|
||||
(clean-fragments! cfg))
|
||||
file (assoc file :has-media-trimmed true)]
|
||||
(bfc/update-file! cfg file)
|
||||
true)
|
||||
(if (:is-branch file)
|
||||
(do
|
||||
;; A branch file's data payload is derived from the branch base
|
||||
;; and the operation log; cleaning it would persist a
|
||||
;; `file_data` row no read path consults.
|
||||
(l/wrn :hint "skip branch file cleaning"
|
||||
:file-id (str file-id))
|
||||
false)
|
||||
(let [file (->> file
|
||||
(bfl/clean-file)
|
||||
(clean-media! cfg)
|
||||
(clean-fragments! cfg))
|
||||
file (assoc file :has-media-trimmed true)]
|
||||
(bfc/update-file! cfg file)
|
||||
true))
|
||||
|
||||
(do
|
||||
(l/dbg :hint "skip cleaning, criteria does not match" :file-id (str file-id))
|
||||
|
||||
@ -25,6 +25,7 @@
|
||||
WHERE f.has_media_trimmed IS false
|
||||
AND f.modified_at < ?
|
||||
AND f.deleted_at IS NULL
|
||||
AND f.is_branch IS FALSE
|
||||
ORDER BY f.modified_at DESC
|
||||
FOR UPDATE OF f
|
||||
SKIP LOCKED")
|
||||
|
||||
@ -2488,3 +2488,46 @@
|
||||
(t/is (= (str (first result) "/" thumb-page-id "/" thumb-frame-id "/" thumb-tag)
|
||||
(:object-id thumb)))
|
||||
(t/is (some? (:media-id thumb)))))))
|
||||
|
||||
;; -----------------------------------------------------------------------------
|
||||
;; Branch target protection
|
||||
;; -----------------------------------------------------------------------------
|
||||
|
||||
(t/deftest import-overwrite-refuses-branch-file
|
||||
;; A branch file's data payload is derived from its merge base and op
|
||||
;; log, so an in-place import would write a `file_data` main row that
|
||||
;; no read path consults.
|
||||
(with-redefs [cf/flags (conj cf/flags :branching)]
|
||||
(let [profile (th/create-profile* 1)
|
||||
file (prepare-simple-file profile)
|
||||
output (tmp/tempfile :suffix ".zip")]
|
||||
|
||||
(v3/export-files!
|
||||
(-> th/*system*
|
||||
(assoc ::bfc/ids #{(:id file)})
|
||||
(assoc ::bfc/export-type :detach-libraries))
|
||||
(io/output-stream output))
|
||||
|
||||
(let [out (th/command! {::th/type :create-file-branch
|
||||
::rpc/profile-id (:id profile)
|
||||
:file-id (:id file)
|
||||
:name "import-target"})
|
||||
branch-id (:branch-file-id (:result out))
|
||||
|
||||
error
|
||||
(try
|
||||
(-> th/*system*
|
||||
(assoc ::bfc/project-id (:default-project-id profile))
|
||||
(assoc ::bfc/profile-id (:id profile))
|
||||
(assoc ::bfc/team-id (:default-team-id profile))
|
||||
(assoc ::bfc/file-id branch-id)
|
||||
(assoc ::bfc/input output)
|
||||
(v3/import-files!))
|
||||
:no-error
|
||||
(catch Throwable e
|
||||
(or (ex-data e) (some-> (ex-cause e) ex-data))))]
|
||||
|
||||
(t/is (uuid? branch-id))
|
||||
(t/is (= :validation (:type error)))
|
||||
(t/is (= :branch-file-cant-be-overwritten (:code error)))
|
||||
(t/is (empty? (th/db-query :file-data {:file-id branch-id :type "main"})))))))
|
||||
|
||||
117
backend/test/backend_tests/branch_payload_writers_test.clj
Normal file
117
backend/test/backend_tests/branch_payload_writers_test.clj
Normal file
@ -0,0 +1,117 @@
|
||||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS SUBSIDIARY SL
|
||||
|
||||
(ns backend-tests.branch-payload-writers-test
|
||||
"Regression tests for the writers that must never persist a branch
|
||||
file's `file_data` payload: `branch-file-data` derives the branch
|
||||
from its merge base snapshot plus the op log, so a persisted main row
|
||||
is invisible to every read path and silently desynchronises the
|
||||
derived state."
|
||||
(:require
|
||||
[app.common.time :as ct]
|
||||
[app.config :as cf]
|
||||
[app.db :as db]
|
||||
[app.rpc :as-alias rpc]
|
||||
[app.srepl.helpers :as h]
|
||||
[backend-tests.helpers :as th]
|
||||
[clojure.test :as t]))
|
||||
|
||||
(t/use-fixtures :once th/state-init)
|
||||
(t/use-fixtures :each th/database-reset)
|
||||
|
||||
(defn- create-branch!
|
||||
[profile file name]
|
||||
(let [out (th/command! {::th/type :create-file-branch
|
||||
::rpc/profile-id (:id profile)
|
||||
:file-id (:id file)
|
||||
:name name})]
|
||||
(t/is (nil? (:error out)))
|
||||
(:branch-file-id (:result out))))
|
||||
|
||||
(defn- create-file
|
||||
[profile index]
|
||||
(th/create-file* index {:profile-id (:id profile)
|
||||
:project-id (:default-project-id profile)
|
||||
:is-shared false}))
|
||||
|
||||
(defn- payload-rows
|
||||
"The `file_data` main rows of a file: the payload a branch file must
|
||||
never have."
|
||||
[file-id]
|
||||
(th/db-query :file-data {:file-id file-id :type "main"}))
|
||||
|
||||
(defn- scheduled-gc-file-ids
|
||||
"The file ids of the `file-gc` tasks submitted so far."
|
||||
[]
|
||||
(->> (th/db-query :task {:name "file-gc"})
|
||||
(map (fn [{:keys [props]}]
|
||||
(-> (if (db/pgobject? props)
|
||||
(db/decode-transit-pgobject props)
|
||||
props)
|
||||
(get :file-id))))
|
||||
(into #{})))
|
||||
|
||||
(t/deftest process-file!-refuses-branch-file
|
||||
;; The admin repair entry points (`app.http.debug` file-repair and
|
||||
;; `app.srepl.main/repair-file!`) both run through `process-file!`,
|
||||
;; which persists through `bfc/update-file!`; on a branch that writes
|
||||
;; a payload row no read path consults.
|
||||
(with-redefs [cf/flags (conj cf/flags :branching)]
|
||||
(let [profile (th/create-profile* 1 {:is-active true})
|
||||
file (create-file profile 1)
|
||||
branch-id (create-branch! profile file "repair-me")
|
||||
|
||||
error
|
||||
(try
|
||||
;; same shape as `app.srepl.main/repair-file!` and the
|
||||
;; debug file-repair route: the helper runs on a
|
||||
;; transaction-bound system
|
||||
(db/tx-run! th/*system*
|
||||
h/process-file!
|
||||
branch-id
|
||||
(fn [file _] (assoc file :name "repaired")))
|
||||
:no-error
|
||||
(catch Throwable cause
|
||||
(or (ex-data cause) (some-> (ex-cause cause) ex-data))))]
|
||||
|
||||
(t/is (uuid? branch-id))
|
||||
(t/is (= :validation (:type error)))
|
||||
(t/is (= :branch-file-cant-be-processed (:code error)))
|
||||
(t/is (empty? (payload-rows branch-id))))))
|
||||
|
||||
(t/deftest file-gc-scheduler-never-selects-branch-files
|
||||
(with-redefs [cf/flags (conj cf/flags :branching)]
|
||||
(let [profile (th/create-profile* 1 {:is-active true})
|
||||
file (create-file profile 1)
|
||||
branch-id (create-branch! profile file "gc-candidate")
|
||||
threshold (ct/in-past {:days 8})]
|
||||
|
||||
;; both files look eligible: untrimmed and idle past the delay
|
||||
(doseq [file-id [(:id file) branch-id]]
|
||||
(th/db-update! :file
|
||||
{:modified-at threshold
|
||||
:has-media-trimmed false}
|
||||
{:id file-id}))
|
||||
|
||||
(t/is (map? (th/run-task! :file-gc-scheduler {})))
|
||||
|
||||
(t/is (= #{(:id file)} (scheduled-gc-file-ids))))))
|
||||
|
||||
(t/deftest file-gc-task-skips-branch-file
|
||||
;; Defensive counterpart of the scheduler guard: a file-gc run that
|
||||
;; reaches a branch file anyway must clean nothing and persist
|
||||
;; nothing.
|
||||
(with-redefs [cf/flags (conj cf/flags :branching)]
|
||||
(let [profile (th/create-profile* 1 {:is-active true})
|
||||
file (create-file profile 1)
|
||||
branch-id (create-branch! profile file "gc-skip")]
|
||||
|
||||
(th/db-update! :file {:has-media-trimmed false} {:id branch-id})
|
||||
|
||||
(let [result (th/run-task! :file-gc {:file-id branch-id})]
|
||||
(t/is (false? result))
|
||||
(t/is (empty? (payload-rows branch-id)))
|
||||
(t/is (false? (:has-media-trimmed (th/db-get :file {:id branch-id}))))))))
|
||||
@ -12,13 +12,16 @@
|
||||
invariants on top of the behaviour covered by
|
||||
`backend-tests.rpc-file-branch-test`."
|
||||
(:require
|
||||
[app.common.data :as d]
|
||||
[app.common.features :as cfeat]
|
||||
[app.common.files.migrations :as fmg]
|
||||
[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.rpc :as-alias rpc]
|
||||
[app.storage :as sto]
|
||||
[app.util.blob :as blob]
|
||||
[backend-tests.helpers :as th]
|
||||
[clojure.string :as str]
|
||||
@ -268,7 +271,7 @@
|
||||
::rpc/profile-id (:id profile)
|
||||
:id branch-file-id})]
|
||||
(t/is (= "#00ff00" (get-in out [:result :data :pages-index page-id
|
||||
:objects shape-id :fills 0 :fill-color]))))
|
||||
:objects shape-id :fills 0 :fill-color]))))
|
||||
;; main's own change arrives through the repositioned base, so the
|
||||
;; net the update writes is empty. A ref left in main's frame would
|
||||
;; make this shape differ from the new base and put it in the log.
|
||||
@ -303,18 +306,17 @@
|
||||
::rpc/profile-id (:id profile)
|
||||
:id branch-file-id})]
|
||||
(t/is (= "#0000ff" (get-in out [:result :data :pages-index page-id
|
||||
:objects shape-id :fills 0 :fill-color])))))))))
|
||||
:objects shape-id :fills 0 :fill-color])))))))))
|
||||
|
||||
(t/deftest update-resolutions-are-document-keyed
|
||||
;; A resolution names a DOCUMENT, not the role the merge engine happened to
|
||||
;; hand it. In an update from main the engine runs with the branch as
|
||||
;; `theirs` and main as `ours` (`branch_merge.cljc::compute-merge*`), so
|
||||
;; `branch_merge.cljc::three-way-entities` writes the branch's value under
|
||||
;; the key named `:main` and main's value under the key named `:branch`.
|
||||
;; The client re-keys the conflicts it displays and sends resolutions in
|
||||
;; document terms; the command inverts them before applying
|
||||
;; (`files_branch.clj::update-branch-from-main`). This test pins that
|
||||
;; contract at the command boundary: `:main` brings main's value into the
|
||||
;; hand it. `branch_merge.cljc::compute-merge` reports every conflict with
|
||||
;; main's value under `:main` and the branch's under `:branch` in both
|
||||
;; directions, and the command applies each resolution in those same terms
|
||||
;; (`files_branch.clj::update-branch-from-main` inverts it before
|
||||
;; `branch_merge.cljc::compute-changes`, which runs with main as the source
|
||||
;; and the branch as the target). This test pins that contract at the
|
||||
;; command boundary: `:main` brings main's value into the
|
||||
;; branch, `:branch` keeps the branch's value, and a per-attribute map
|
||||
;; obeys the same vocabulary for the attribute it names.
|
||||
;;
|
||||
@ -746,7 +748,473 @@
|
||||
(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})]
|
||||
:branch-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"})))))))
|
||||
|
||||
;;; --- Data versions across an upgrade
|
||||
;;
|
||||
;; A test-only file migration stands for a Penpot upgrade. Rebinding
|
||||
;; `fmg/available-migrations` to the real list plus this name is the
|
||||
;; upgrade: files written before the rebinding sit at the old data
|
||||
;; version. The migration turns the color group separator "/" into " / "
|
||||
;; and, like every real migration, assumes its input is at the old
|
||||
;; version, so it corrupts a path already in the new format. A replay
|
||||
;; that applies a segment at the wrong version shows up as a doubled
|
||||
;; separator or an unspaced one.
|
||||
|
||||
(def ^:private test-migration "9999-test-spaced-color-path")
|
||||
|
||||
(defmethod fmg/migrate-data "9999-test-spaced-color-path"
|
||||
[data _]
|
||||
(d/update-when data :colors update-vals
|
||||
(fn [color]
|
||||
(d/update-when color :path str/replace "/" " / "))))
|
||||
|
||||
(defn- read-file
|
||||
[profile file-id]
|
||||
(let [out (th/command! {::th/type :get-file
|
||||
::rpc/profile-id (:id profile)
|
||||
:id file-id})]
|
||||
(t/is (nil? (:error out)))
|
||||
(:result out)))
|
||||
|
||||
;; `:modified-at` is the time each apply touched the color, which differs
|
||||
;; between two files that went through the same history
|
||||
(defn- colors-of
|
||||
[file]
|
||||
(update-vals (-> file :data :colors) #(dissoc % :modified-at)))
|
||||
|
||||
(t/deftest branch-replays-each-op-at-the-data-version-it-was-written-at
|
||||
;; The reference is an ordinary file that goes through the same history:
|
||||
;; an op before the upgrade, the upgrade, an op after it. An ordinary
|
||||
;; file is migrated between the two ops, so the branch derive must
|
||||
;; migrate its document at the same point.
|
||||
(with-redefs [cf/flags (conj cf/flags :branching)]
|
||||
(let [profile (th/create-profile* 1 {:is-active true})
|
||||
proj-id (:default-project-id profile)
|
||||
main (th/create-file* 1 {:profile-id (:id profile)
|
||||
:project-id proj-id
|
||||
:is-shared false})
|
||||
ordinary (th/create-file* 2 {:profile-id (:id profile)
|
||||
:project-id proj-id
|
||||
:is-shared false})
|
||||
upgraded (conj fmg/available-migrations test-migration)
|
||||
c1 (uuid/random)
|
||||
c2 (uuid/random)
|
||||
c3 (uuid/random)
|
||||
seed {:type :add-color
|
||||
:color {:id c1 :name "One" :path "Brand/One" :color "#111111" :opacity 1}}
|
||||
old-op {:type :add-color
|
||||
:color {:id c2 :name "Two" :path "Brand/Two" :color "#222222" :opacity 1}}
|
||||
;; written by an editor that read the migrated document
|
||||
new-op {:type :add-color
|
||||
:color {:id c3 :name "Three" :path "Brand / Three" :color "#333333" :opacity 1}}]
|
||||
|
||||
(apply-change* profile (:id main) seed)
|
||||
(apply-change* profile (:id ordinary) seed)
|
||||
|
||||
(let [branch-file-id (:branch-file-id (create-branch* profile (:id main) "straddle"))]
|
||||
(apply-change* profile branch-file-id old-op)
|
||||
(apply-change* profile (:id ordinary) old-op)
|
||||
|
||||
(with-redefs [fmg/available-migrations upgraded]
|
||||
(apply-change* profile branch-file-id new-op)
|
||||
(apply-change* profile (:id ordinary) new-op)
|
||||
|
||||
(let [expected (colors-of (read-file profile (:id ordinary)))
|
||||
derived (colors-of (read-file profile branch-file-id))]
|
||||
(t/testing "the reference holds every path in the new format"
|
||||
(t/is (= ["Brand / One" "Brand / Two" "Brand / Three"]
|
||||
(mapv #(get-in expected [% :path]) [c1 c2 c3]))))
|
||||
|
||||
(t/testing "the branch derives the document the ordinary file holds"
|
||||
(t/is (= expected derived)))))))))
|
||||
|
||||
(t/deftest merge-after-an-upgrade-compares-against-a-migrated-base
|
||||
;; The branch renames a color before the upgrade and main never touches
|
||||
;; it. After the upgrade main and the branch read migrated, so the base
|
||||
;; must read migrated too, or main's migrated path reads as an edit and
|
||||
;; the rename as a modify-modify conflict.
|
||||
(with-redefs [cf/flags (conj cf/flags :branching)]
|
||||
(let [profile (th/create-profile* 1 {:is-active true})
|
||||
proj-id (:default-project-id profile)
|
||||
main (th/create-file* 1 {:profile-id (:id profile)
|
||||
:project-id proj-id
|
||||
:is-shared false})
|
||||
upgraded (conj fmg/available-migrations test-migration)
|
||||
c1 (uuid/random)]
|
||||
|
||||
(apply-change* profile (:id main)
|
||||
{:type :add-color
|
||||
:color {:id c1 :name "One" :path "Brand/One" :color "#111111" :opacity 1}})
|
||||
|
||||
(let [create (create-branch* profile (:id main) "rename-before-upgrade")]
|
||||
(apply-change* profile (:branch-file-id create)
|
||||
{:type :mod-color
|
||||
:color {:id c1 :name "Uno" :path "Brand/One" :color "#111111" :opacity 1}})
|
||||
|
||||
(with-redefs [fmg/available-migrations upgraded]
|
||||
(t/testing "the compare reports the rename as a clean change"
|
||||
(let [out (th/command! {::th/type :get-branch-diff
|
||||
::rpc/profile-id (:id profile)
|
||||
:branch-id (:id create)})]
|
||||
(t/is (nil? (:error out)))
|
||||
(t/is (= 0 (-> out :result :stats :conflicts)))))
|
||||
|
||||
(t/testing "the merge reports no conflict and applies the rename"
|
||||
(let [out (th/command! {::th/type :merge-file-branch
|
||||
::rpc/profile-id (:id profile)
|
||||
:branch-id (:id create)})]
|
||||
(t/is (nil? (:error out)))
|
||||
(t/is (= :merged (-> out :result :status)))
|
||||
(t/is (empty? (-> out :result :conflicts))))
|
||||
(t/is (= {:name "Uno" :path "Brand / One"}
|
||||
(-> (colors-of (read-file profile (:id main)))
|
||||
(get c1)
|
||||
(select-keys [:name :path]))))))))))
|
||||
|
||||
(t/deftest steady-state-branch-reads-run-no-migration
|
||||
;; No upgrade since the branch was cut: base, op log, main and branch
|
||||
;; share one data version, so reading, comparing and merging the branch
|
||||
;; must not run a migration, not even an empty one (the schema check at
|
||||
;; the end of `fmg/migrate` walks the whole document).
|
||||
(with-redefs [cf/flags (conj cf/flags :branching)]
|
||||
(let [profile (th/create-profile* 1 {:is-active true})
|
||||
proj-id (:default-project-id profile)
|
||||
main (th/create-file* 1 {:profile-id (:id profile)
|
||||
:project-id proj-id
|
||||
:is-shared false})
|
||||
create (create-branch* profile (:id main) "steady")
|
||||
branch-file-id (:branch-file-id create)
|
||||
real-migrate fmg/migrate
|
||||
real-migrate-data fmg/migrate-data
|
||||
calls (atom 0)]
|
||||
|
||||
(with-redefs [fmg/migrate (fn [& args]
|
||||
(swap! calls inc)
|
||||
(apply real-migrate args))
|
||||
fmg/migrate-data (fn [data id]
|
||||
(swap! calls inc)
|
||||
(real-migrate-data data id))]
|
||||
(apply-change* profile branch-file-id
|
||||
{:type :add-color
|
||||
:color {:id (uuid/random) :name "A" :path "Brand/A" :color "#111111" :opacity 1}})
|
||||
(apply-change* profile branch-file-id
|
||||
{:type :add-color
|
||||
:color {:id (uuid/random) :name "B" :path "Brand/B" :color "#222222" :opacity 1}})
|
||||
(apply-change* profile (:id main)
|
||||
{:type :add-color
|
||||
:color {:id (uuid/random) :name "M" :path "Brand/M" :color "#333333" :opacity 1}})
|
||||
|
||||
(read-file profile branch-file-id)
|
||||
(t/is (= :updated (-> (th/command! {::th/type :update-branch-from-main
|
||||
::rpc/profile-id (:id profile)
|
||||
:branch-id (:id create)})
|
||||
:result :status)))
|
||||
(t/is (nil? (:error (th/command! {::th/type :get-branch-diff
|
||||
::rpc/profile-id (:id profile)
|
||||
:branch-id (:id create)}))))
|
||||
(let [out (th/command! {::th/type :merge-file-branch
|
||||
::rpc/profile-id (:id profile)
|
||||
:branch-id (:id create)})]
|
||||
(t/is (nil? (:error out)))
|
||||
(t/is (= :merged (-> out :result :status))))
|
||||
|
||||
(t/is (zero? @calls))))))
|
||||
|
||||
(t/deftest update-from-main-after-an-upgrade-compares-against-a-migrated-base
|
||||
;; Same history as the merge case, integrated the other way: main's
|
||||
;; migrated path must not read as a main-side edit of the color the
|
||||
;; branch renamed.
|
||||
(with-redefs [cf/flags (conj cf/flags :branching)]
|
||||
(let [profile (th/create-profile* 1 {:is-active true})
|
||||
proj-id (:default-project-id profile)
|
||||
main (th/create-file* 1 {:profile-id (:id profile)
|
||||
:project-id proj-id
|
||||
:is-shared false})
|
||||
upgraded (conj fmg/available-migrations test-migration)
|
||||
c1 (uuid/random)
|
||||
c2 (uuid/random)]
|
||||
|
||||
(apply-change* profile (:id main)
|
||||
{:type :add-color
|
||||
:color {:id c1 :name "One" :path "Brand/One" :color "#111111" :opacity 1}})
|
||||
|
||||
(let [create (create-branch* profile (:id main) "update-after-upgrade")]
|
||||
(apply-change* profile (:branch-file-id create)
|
||||
{:type :mod-color
|
||||
:color {:id c1 :name "Uno" :path "Brand/One" :color "#111111" :opacity 1}})
|
||||
|
||||
(with-redefs [fmg/available-migrations upgraded]
|
||||
;; main's own work after the upgrade gives the update something
|
||||
;; to bring in
|
||||
(apply-change* profile (:id main)
|
||||
{:type :add-color
|
||||
:color {:id c2 :name "Two" :path "Brand / Two" :color "#222222" :opacity 1}})
|
||||
|
||||
(let [out (th/command! {::th/type :update-branch-from-main
|
||||
::rpc/profile-id (:id profile)
|
||||
:branch-id (:id create)})]
|
||||
(t/is (nil? (:error out)))
|
||||
(t/is (= :updated (-> out :result :status)))
|
||||
(t/is (empty? (-> out :result :conflicts))))
|
||||
|
||||
(t/testing "the branch keeps its rename and gains main's color"
|
||||
(let [colors (colors-of (read-file profile (:branch-file-id create)))]
|
||||
(t/is (= {:name "Uno" :path "Brand / One"}
|
||||
(select-keys (get colors c1) [:name :path])))
|
||||
(t/is (= {:name "Two" :path "Brand / Two"}
|
||||
(select-keys (get colors c2) [:name :path]))))))))))
|
||||
|
||||
(t/deftest branch-replays-an-unstamped-row-at-the-base-version
|
||||
;; A row written before `file_branch_change.data_version` existed has
|
||||
;; no stamp. Such rows precede every stamped row and were written over
|
||||
;; the base, so the derive replays them at the base's version, as it did
|
||||
;; before the column existed.
|
||||
(with-redefs [cf/flags (conj cf/flags :branching)]
|
||||
(let [profile (th/create-profile* 1 {:is-active true})
|
||||
proj-id (:default-project-id profile)
|
||||
main (th/create-file* 1 {:profile-id (:id profile)
|
||||
:project-id proj-id
|
||||
:is-shared false})
|
||||
ordinary (th/create-file* 2 {:profile-id (:id profile)
|
||||
:project-id proj-id
|
||||
:is-shared false})
|
||||
upgraded (conj fmg/available-migrations test-migration)
|
||||
c1 (uuid/random)
|
||||
c2 (uuid/random)
|
||||
old-op {:type :add-color
|
||||
:color {:id c1 :name "One" :path "Brand/One" :color "#111111" :opacity 1}}
|
||||
new-op {:type :add-color
|
||||
:color {:id c2 :name "Two" :path "Brand / Two" :color "#222222" :opacity 1}}
|
||||
branch-file-id (:branch-file-id (create-branch* profile (:id main) "unstamped"))]
|
||||
|
||||
(apply-change* profile branch-file-id old-op)
|
||||
(apply-change* profile (:id ordinary) old-op)
|
||||
(th/db-update! :file-branch-change {:data-version nil} {:file-id branch-file-id})
|
||||
|
||||
(with-redefs [fmg/available-migrations upgraded]
|
||||
(apply-change* profile branch-file-id new-op)
|
||||
(apply-change* profile (:id ordinary) new-op)
|
||||
|
||||
(t/is (= [nil test-migration]
|
||||
(->> (oplog-rows branch-file-id)
|
||||
(sort-by :revn)
|
||||
(mapv :data-version))))
|
||||
(t/is (= (colors-of (read-file profile (:id ordinary)))
|
||||
(colors-of (read-file profile branch-file-id))))))))
|
||||
|
||||
(t/deftest update-from-main-conflict-sides-name-the-documents
|
||||
;; `update-branch-from-main` reports its conflicts in document terms:
|
||||
;; `:main` carries main's value and `:branch` the branch's, whatever the
|
||||
;; direction the engine ran in. Resolving the conflict to `:branch` then
|
||||
;; keeps the branch's value end to end.
|
||||
(with-redefs [cf/flags (conj cf/flags :branching)]
|
||||
(let [profile (th/create-profile* 1 {:is-active true})
|
||||
proj-id (:default-project-id profile)
|
||||
branch-fill "#bb0000"
|
||||
main-fill "#00bb00"
|
||||
fills (fn [color] [{:fill-color color :fill-opacity 1}])
|
||||
file (th/create-file* 1 {:profile-id (:id profile)
|
||||
:project-id proj-id
|
||||
:is-shared false})
|
||||
main-id (:id file)
|
||||
page-id (-> (th/command! {::th/type :get-file
|
||||
::rpc/profile-id (:id profile)
|
||||
:id main-id})
|
||||
:result :data :pages first)
|
||||
shape-id (uuid/random)
|
||||
color-id (uuid/random)]
|
||||
|
||||
;; the shape enters the merge base before the fork
|
||||
(apply-change* profile main-id
|
||||
{:type :add-obj
|
||||
:page-id page-id
|
||||
:id shape-id
|
||||
:parent-id uuid/zero
|
||||
:frame-id uuid/zero
|
||||
:obj (-> (cts/setup-shape
|
||||
{:id shape-id :name "Coded" :type :rect
|
||||
:parent-id uuid/zero :frame-id uuid/zero})
|
||||
(assoc :fills (fills "#000000")))})
|
||||
|
||||
(let [create (create-branch* profile main-id "update-conflict-sides")
|
||||
branch-id (:id create)
|
||||
branch-file-id (:branch-file-id create)
|
||||
read-fill (fn []
|
||||
(get-in (th/command! {::th/type :get-file
|
||||
::rpc/profile-id (:id profile)
|
||||
:id branch-file-id})
|
||||
[:result :data :pages-index page-id :objects shape-id
|
||||
:fills 0 :fill-color]))]
|
||||
|
||||
;; the same attribute diverges on the two sides
|
||||
(apply-change* profile branch-file-id
|
||||
{:type :mod-obj
|
||||
:page-id page-id
|
||||
:id shape-id
|
||||
:operations [{:type :set :attr :fills :val (fills branch-fill)}]})
|
||||
(apply-change* profile main-id
|
||||
{:type :mod-obj
|
||||
:page-id page-id
|
||||
:id shape-id
|
||||
:operations [{:type :set :attr :fills :val (fills main-fill)}]})
|
||||
;; main also gains a change the branch never touched, so the update
|
||||
;; has something of main's to apply and takes the write path
|
||||
(apply-change* profile main-id
|
||||
{:type :add-color
|
||||
:color {:id color-id :name "Main-only"
|
||||
:color "#336699" :opacity 1}})
|
||||
|
||||
(t/testing "the conflict names the two documents"
|
||||
(let [out (th/command! {::th/type :update-branch-from-main
|
||||
::rpc/profile-id (:id profile)
|
||||
:branch-id branch-id})
|
||||
c (first (-> out :result :conflicts))]
|
||||
(t/is (= :conflicts (-> out :result :status)))
|
||||
(t/is (= shape-id (:id c)))
|
||||
(t/is (= main-fill (get-in c [:main :fills 0 :fill-color])))
|
||||
(t/is (= branch-fill (get-in c [:branch :fills 0 :fill-color])))
|
||||
(t/is (= {:main (fills main-fill) :branch (fills branch-fill)}
|
||||
(get-in c [:changed-attrs :fills])))))
|
||||
|
||||
(t/testing "resolved to :branch, the branch keeps its own value"
|
||||
(let [out (th/command! {::th/type :update-branch-from-main
|
||||
::rpc/profile-id (:id profile)
|
||||
:branch-id branch-id
|
||||
:resolutions {shape-id :branch}})]
|
||||
(t/is (nil? (:error out)))
|
||||
(t/is (= :updated (-> out :result :status))))
|
||||
(t/is (= branch-fill (read-fill))))))))
|
||||
|
||||
;; --- media fix-up on branch saves
|
||||
|
||||
(defn- foreign-media-setup
|
||||
"The media fix-up scenario: a save into the branch adds an image shape
|
||||
referencing a `file_media_object` row ANOTHER file owns, the case the
|
||||
server-side media fix-up handles on an ordinary save. Returns the
|
||||
pieces the assertions need."
|
||||
[]
|
||||
(let [profile (th/create-profile* 1 {:is-active true})
|
||||
proj-id (:default-project-id profile)
|
||||
file (th/create-file* 1 {:profile-id (:id profile)
|
||||
:project-id proj-id
|
||||
:is-shared false})
|
||||
foreign (th/create-file* 2 {:profile-id (:id profile)
|
||||
:project-id proj-id
|
||||
:is-shared false})
|
||||
storage (-> (:app.storage/storage th/*system*)
|
||||
(assoc :app.storage/backend :fs))
|
||||
sobj (sto/put-object! storage {::sto/content (sto/content "foreign-image")
|
||||
:bucket :file-media-object
|
||||
:content-type "image/png"})
|
||||
fmo (th/create-file-media-object* {:file-id (:id foreign)
|
||||
:name "foreign.png"
|
||||
:mtype "image/png"
|
||||
:media-id (:id sobj)})
|
||||
create (create-branch* profile (:id file) "media-fixup")
|
||||
branch-file-id (:branch-file-id create)
|
||||
page-id (-> (read-file profile branch-file-id) :data :pages first)
|
||||
shape-id (uuid/random)]
|
||||
|
||||
(apply-change* profile branch-file-id
|
||||
{:type :add-obj
|
||||
:page-id page-id
|
||||
:id shape-id
|
||||
:parent-id uuid/zero
|
||||
:frame-id uuid/zero
|
||||
:obj (cts/setup-shape
|
||||
{:id shape-id :name "Image" :type :image
|
||||
:parent-id uuid/zero :frame-id uuid/zero
|
||||
:metadata {:id (:id fmo)
|
||||
:width 100 :height 100
|
||||
:mtype "image/png"}})})
|
||||
|
||||
{:profile profile
|
||||
:main-id (:id file)
|
||||
:branch-id (:id create)
|
||||
:branch-file-id branch-file-id
|
||||
:page-id page-id
|
||||
:shape-id shape-id
|
||||
:fmo-id (:id fmo)}))
|
||||
|
||||
(defn- media-ref
|
||||
"The media row id a shape references: image shapes carry it in
|
||||
`:metadata`, fill images in their `:fills`."
|
||||
[obj]
|
||||
(or (get-in obj [:metadata :id])
|
||||
(get-in obj [:fills 0 :fill-image :id])))
|
||||
|
||||
(defn- derived-obj
|
||||
[profile file-id page-id shape-id]
|
||||
(-> (read-file profile file-id)
|
||||
:data :pages-index (get page-id) :objects (get shape-id)))
|
||||
|
||||
(t/deftest branch-save-fixes-foreign-media-refs-in-the-op-log
|
||||
;; An ordinary save carries the media fix-up with its payload: the
|
||||
;; foreign row is copied into the saving file and the reference is
|
||||
;; rewritten. A branch stores no payload — the change vector IS the
|
||||
;; state — so the rewrite has to land in the change vector before the
|
||||
;; op is appended, or the derive reproduces the foreign reference and
|
||||
;; the copied row is left unreferenced.
|
||||
(with-redefs [cf/flags (conj cf/flags :branching)]
|
||||
(let [{:keys [profile branch-file-id page-id shape-id fmo-id]}
|
||||
(foreign-media-setup)
|
||||
|
||||
stored-ref
|
||||
(-> (oplog-rows branch-file-id)
|
||||
first :changes blob/decode first :obj media-ref)
|
||||
|
||||
derived-ref
|
||||
(-> (derived-obj profile branch-file-id page-id shape-id)
|
||||
media-ref)]
|
||||
|
||||
(t/testing "the op log records the rewritten reference"
|
||||
(t/is (= 1 (count (oplog-rows branch-file-id))))
|
||||
(t/is (uuid? stored-ref))
|
||||
(t/is (not= fmo-id stored-ref)))
|
||||
|
||||
(t/testing "the derive reproduces the reference the op records"
|
||||
(t/is (= stored-ref derived-ref)))
|
||||
|
||||
(t/testing "the derived branch references a media row it owns"
|
||||
(let [row (th/db-get :file-media-object {:id derived-ref})]
|
||||
(t/is (some? row))
|
||||
(t/is (= branch-file-id (:file-id row)))))
|
||||
|
||||
(t/testing "the copied row is the referenced one, not an orphan"
|
||||
(let [rows (th/db-query :file-media-object {:file-id branch-file-id})]
|
||||
(t/is (= 1 (count rows)))
|
||||
(t/is (= derived-ref (:id (first rows)))))))))
|
||||
|
||||
(t/deftest merge-carries-the-fixed-media-into-main
|
||||
;; The fix-up's copy is owned by the branch file, so the merge must
|
||||
;; carry the row into main and point main's shape at a row main owns.
|
||||
;; With the reference left foreign, `files_branch.clj::unpaired-media-rows`
|
||||
;; drops the row (it filters by branch ownership) and main ends up
|
||||
;; referencing media it does not own.
|
||||
(with-redefs [cf/flags (conj cf/flags :branching)]
|
||||
(let [{:keys [profile main-id branch-id branch-file-id page-id shape-id]}
|
||||
(foreign-media-setup)
|
||||
|
||||
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 [ref (-> (derived-obj profile main-id page-id shape-id) media-ref)
|
||||
row (th/db-get :file-media-object {:id ref})]
|
||||
(t/is (some? row))
|
||||
(t/is (= main-id (:file-id row))))
|
||||
|
||||
;; the branch keeps deriving its own state from the kept op log
|
||||
(let [ref (-> (derived-obj profile branch-file-id page-id shape-id) media-ref)
|
||||
row (th/db-get :file-media-object {:id ref})]
|
||||
(t/is (some? row))
|
||||
(t/is (= branch-file-id (:file-id row)))))))
|
||||
|
||||
@ -11,6 +11,7 @@
|
||||
[app.common.files.branch-merge :as bm]
|
||||
[app.common.files.repair :as cfr]
|
||||
[app.common.files.validate :as cfv]
|
||||
[app.common.logging :as l]
|
||||
[app.common.time :as ct]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.uuid :as uuid]
|
||||
@ -18,6 +19,8 @@
|
||||
[app.db :as db]
|
||||
[app.msgbus :as mbus]
|
||||
[app.rpc :as-alias rpc]
|
||||
[app.rpc.commands.files-branch :as fbranch]
|
||||
[app.rpc.commands.files-branch-policies :as fbp]
|
||||
[app.storage :as sto]
|
||||
[app.util.blob :as blob]
|
||||
[backend-tests.helpers :as th]
|
||||
@ -1136,9 +1139,9 @@
|
||||
: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)
|
||||
;; the colour's image keeps resolving to the right content (the
|
||||
;; document names the branch's own paired copy: the base is pinned
|
||||
;; in the branch's frame and the op log replays over it)
|
||||
(let [row (th/db-get :file-media-object {:id img-id})]
|
||||
(t/is (= (:id sobj) (:media-id row)))))
|
||||
|
||||
@ -1192,7 +1195,7 @@
|
||||
(t/testing "materialize persists the derived state and drops the branch"
|
||||
(let [out (th/command! {::th/type :materialize-file-branch
|
||||
::rpc/profile-id (:id profile)
|
||||
:file-id branch-file-id})]
|
||||
:branch-file-id branch-file-id})]
|
||||
(t/is (nil? (:error out)))
|
||||
(t/is (= :materialized (-> out :result :status)))
|
||||
(t/is (true? (-> out :result :changed))))
|
||||
@ -1232,7 +1235,7 @@
|
||||
(t/testing "materializing again is a no-op"
|
||||
(let [out (th/command! {::th/type :materialize-file-branch
|
||||
::rpc/profile-id (:id profile)
|
||||
:file-id branch-file-id})]
|
||||
:branch-file-id branch-file-id})]
|
||||
(t/is (nil? (:error out)))
|
||||
(t/is (= :materialized (-> out :result :status)))
|
||||
(t/is (false? (-> out :result :changed)))))))))
|
||||
@ -1516,7 +1519,7 @@
|
||||
:name "audited-exit"})
|
||||
out (th/command! {::th/type :materialize-file-branch
|
||||
::rpc/profile-id (:id profile)
|
||||
:file-id (-> created :result :branch-file-id)})
|
||||
:branch-file-id (-> created :result :branch-file-id)})
|
||||
props (-> out :result meta :app.loggers.audit/props)]
|
||||
(t/is (nil? (:error out)))
|
||||
(t/is (= "materialize" (:branch-operation props)))
|
||||
@ -1825,7 +1828,7 @@
|
||||
cfr/repair-file no-repair]
|
||||
(let [out (th/command! {::th/type :materialize-file-branch
|
||||
::rpc/profile-id (:id profile)
|
||||
:file-id branch-file-id})]
|
||||
:branch-file-id branch-file-id})]
|
||||
(t/is (nil? (:error out)))
|
||||
(t/is (= :materialized (-> out :result :status)))
|
||||
(t/is (true? (-> out :result :changed)))))
|
||||
@ -1973,7 +1976,7 @@
|
||||
:opacity 1}}])]
|
||||
(let [out (th/command! {::th/type :materialize-file-branch
|
||||
::rpc/profile-id (:id profile)
|
||||
:file-id b2-fid})]
|
||||
:branch-file-id b2-fid})]
|
||||
(t/is (nil? (:error out)))
|
||||
(t/is (= :materialized (-> out :result :status)))))
|
||||
|
||||
@ -2263,3 +2266,404 @@
|
||||
(t/is (= branch-file-id topic))
|
||||
;; the update was already committed when the message left
|
||||
(t/is (= (:revn message) branch-revn)))))))
|
||||
|
||||
(t/deftest materialize-takes-the-branch-file-id
|
||||
;; `:branch-file-id` names the branch FILE — the id `::create-file-branch`
|
||||
;; returns under that same key — while the sibling commands take the
|
||||
;; `file_branch` row id. The old generic `:file-id` name is refused by
|
||||
;; the schema.
|
||||
(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 "to-materialize"}))
|
||||
branch-file-id (:branch-file-id create)]
|
||||
|
||||
(t/testing "the old :file-id param is refused by the schema"
|
||||
(let [{:keys [error]} (th/command! {::th/type :materialize-file-branch
|
||||
::rpc/profile-id (:id profile)
|
||||
:file-id branch-file-id})]
|
||||
(t/is (some? error))
|
||||
(t/is (th/ex-of-type? error :validation))
|
||||
(t/is (th/ex-of-code? error :params-validation)))
|
||||
;; refused before the handler runs, so the branch is untouched
|
||||
(t/is (true? (:is-branch (th/db-get :file {:id branch-file-id})))))
|
||||
|
||||
(t/testing "materialize runs on :branch-file-id"
|
||||
(let [{:keys [error result]} (th/command! {::th/type :materialize-file-branch
|
||||
::rpc/profile-id (:id profile)
|
||||
:branch-file-id branch-file-id})]
|
||||
(t/is (nil? error))
|
||||
(t/is (= :materialized (:status result)))
|
||||
(t/is (true? (:changed result))))))))
|
||||
|
||||
;;; --- A comparison that cannot be made is never "in sync"
|
||||
;;
|
||||
;; The listing is read-only: it cannot repair anything, and merge and
|
||||
;; update DO refuse loudly when the merge base cannot be resolved. So
|
||||
;; the row carries the error marker and no counts at all: zeros read as
|
||||
;; "in sync", and a branch that cannot be compared is not in sync.
|
||||
|
||||
(t/deftest missing-base-snapshot-lists-an-error-marker
|
||||
(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 "lost-base"}))
|
||||
branch-id (:id create)
|
||||
branch-file-id (:branch-file-id create)]
|
||||
|
||||
;; the branch diverged, so the listing pays for the comparison
|
||||
(t/is (nil? (:error (apply-change* profile branch-file-id
|
||||
{:type :add-color
|
||||
:color {:id (uuid/random)
|
||||
:name "Brand"
|
||||
:color "#ff0000"
|
||||
:opacity 1}}))))
|
||||
|
||||
;; the merge-base snapshot is gone
|
||||
(let [base (:base-snapshot-id (first (th/db-query :file-branch {:id branch-id})))]
|
||||
(t/is (some? base))
|
||||
(th/db-delete! :file-change {:id base})
|
||||
(t/is (empty? (th/db-query :file-change {:id base}))))
|
||||
|
||||
(let [out (th/command! {::th/type :get-file-branches
|
||||
::rpc/profile-id (:id profile)
|
||||
:file-id (:id file)})
|
||||
row (first (filter #(= branch-id (:id %)) (:result out)))]
|
||||
(t/is (nil? (:error out)))
|
||||
(t/is (some? row))
|
||||
(t/is (true? (:diff-error row)) "the row does not carry the error marker")
|
||||
(t/is (nil? (:ahead row)))
|
||||
(t/is (nil? (:behind row)))
|
||||
(t/is (nil? (:conflicts row)))))))
|
||||
|
||||
;;; --- The listing holds no pooled connection across the comparisons
|
||||
;;
|
||||
;; Each comparison takes its own connection and returns it before the
|
||||
;; next one starts: the listing query uses one, the comparisons use one
|
||||
;; each, and none of them is held while the others run.
|
||||
|
||||
(t/deftest listing-compare-takes-a-connection-per-diff
|
||||
(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* (fn [name]
|
||||
(:result (th/command! {::th/type :create-file-branch
|
||||
::rpc/profile-id (:id profile)
|
||||
:file-id (:id file)
|
||||
:name name})))
|
||||
branches [(create* "one") (create* "two")]]
|
||||
|
||||
;; both branches diverged, so the listing compares both
|
||||
(doseq [branch branches]
|
||||
(t/is (nil? (:error (apply-change* profile (:branch-file-id branch)
|
||||
{:type :add-color
|
||||
:color {:id (uuid/random)
|
||||
:name "Brand"
|
||||
:color "#ff0000"
|
||||
:opacity 1}})))))
|
||||
|
||||
(let [orig-open db/open
|
||||
orig-compute fbranch/branch-diff-counts!
|
||||
checkouts (atom [])
|
||||
runs (atom [])]
|
||||
(with-redefs [db/open
|
||||
(fn [system-or-pool]
|
||||
(let [conn (orig-open system-or-pool)]
|
||||
(swap! checkouts conj conn)
|
||||
conn))
|
||||
|
||||
fbranch/branch-diff-counts!
|
||||
(fn [cfg main-data branch]
|
||||
(let [conn (db/get-connection cfg)
|
||||
prev (:conn (peek @runs))]
|
||||
(swap! runs conj
|
||||
{:conn conn
|
||||
;; the previous comparison's connection
|
||||
;; is back in the pool by now
|
||||
:prev-closed? (or (nil? prev)
|
||||
(.isClosed ^java.sql.Connection prev))
|
||||
;; every connection handed out so far and
|
||||
;; still checked out at this moment
|
||||
:held (into []
|
||||
(remove #(.isClosed ^java.sql.Connection %))
|
||||
@checkouts)}))
|
||||
(orig-compute cfg main-data branch))]
|
||||
(t/is (nil? (:error (th/command! {::th/type :get-file-branches
|
||||
::rpc/profile-id (:id profile)
|
||||
:file-id (:id file)})))))
|
||||
|
||||
(t/is (= 2 (count @runs)) "both branches were compared")
|
||||
;; every comparison runs with a connection of its own
|
||||
(t/is (apply distinct? (map :conn @runs))
|
||||
"two comparisons shared one connection")
|
||||
(t/is (every? :prev-closed? (rest @runs))
|
||||
"a connection is held across the comparisons")
|
||||
;; ...and while it runs, its own is the only one checked out: the
|
||||
;; listing's and the previous comparison's are back in the pool
|
||||
(t/is (every? (fn [{:keys [conn held]}] (= [conn] held)) @runs)
|
||||
"a connection is held while the comparisons run")))))
|
||||
|
||||
;;; --- Media pairing: the branch holds its own copies
|
||||
|
||||
(defn- squashed-log-types
|
||||
"Change types the branch's op log (`file_branch_change`) carries after
|
||||
the squash an update-from-main performs."
|
||||
[branch-id]
|
||||
(into []
|
||||
(mapcat (fn [row] (map :type (blob/decode (:changes row)))))
|
||||
(th/db-query :file-branch-change {:branch-id branch-id})))
|
||||
|
||||
(def ^:private media-change-types
|
||||
#{:add-media :mod-media :del-media})
|
||||
|
||||
(t/deftest update-from-main-deletes-the-paired-media-copy
|
||||
;; main deletes a media object the branch holds as a paired copy: the
|
||||
;; delete travels through `bm/remap-changes` with the pair map and must
|
||||
;; name the branch's copy, not main's row — the branch holds neither the
|
||||
;; id the change was computed with nor a second copy of the content
|
||||
(with-redefs [cf/flags (conj cf/flags :branching)]
|
||||
(let [profile (th/create-profile* 1 {:is-active true})
|
||||
proj-id (:default-project-id profile)
|
||||
file (th/create-file* 1 {:profile-id (:id profile)
|
||||
:project-id proj-id})
|
||||
storage (-> (:app.storage/storage th/*system*)
|
||||
(assoc :app.storage/backend :fs))
|
||||
sobj (sto/put-object! storage {::sto/content (sto/content "shared-image")
|
||||
:bucket :file-media-object
|
||||
:content-type "image/png"})
|
||||
fmo (th/create-file-media-object* {:file-id (:id file)
|
||||
:name "shared.png"
|
||||
:media-id (:id sobj)})
|
||||
_ (apply-change* profile (:id file)
|
||||
{:type :add-media
|
||||
:object {:id (:id fmo) :name "shared.png"
|
||||
:media-id (:id sobj)
|
||||
:width 100 :height 100
|
||||
:mtype "image/png"}})
|
||||
create (:result (th/command! {::th/type :create-file-branch
|
||||
::rpc/profile-id (:id profile)
|
||||
:file-id (:id file)
|
||||
:name "paired-delete"}))
|
||||
branch-id (:id create)
|
||||
branch-file-id (:branch-file-id create)
|
||||
branch-media (fn []
|
||||
(let [out (th/command! {::th/type :get-file
|
||||
::rpc/profile-id (:id profile)
|
||||
:id branch-file-id})]
|
||||
(-> out :result :data :media)))]
|
||||
;; a main-side change so the first update reaches the write path and
|
||||
;; copies main's row into the branch
|
||||
(t/is (nil? (:error (apply-change* profile (:id file)
|
||||
{:type :add-color
|
||||
:color {:id (uuid/random) :name "C1"
|
||||
:color "#112233" :opacity 1}}))))
|
||||
(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))))
|
||||
|
||||
(t/testing "the branch holds the media as its own paired copy"
|
||||
(let [[media] (vals (branch-media))]
|
||||
(t/is (= 1 (count (vals (branch-media)))))
|
||||
(t/is (some? media))
|
||||
(t/is (not= (:id fmo) (:id media)))
|
||||
(t/is (= (:id sobj)
|
||||
(:media-id (th/db-get :file-media-object {:id (:id media)}))))))
|
||||
|
||||
(t/testing "deleting it on main deletes the branch's copy"
|
||||
(t/is (nil? (:error (apply-change* profile (:id file)
|
||||
{:type :del-media :id (:id fmo)}))))
|
||||
(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))))
|
||||
(t/is (empty? (branch-media)))))))
|
||||
|
||||
(t/deftest repeated-updates-squash-no-phantom-media
|
||||
;; a second update from main must not squash media changes the branch
|
||||
;; never made: the write re-points main's media rows at the branch's
|
||||
;; copies, and the squashed log compares the updated branch with main's
|
||||
;; state — if one side is re-pointed and the other is not, the paired
|
||||
;; media reads as deleted+added on every update
|
||||
(with-redefs [cf/flags (conj cf/flags :branching)]
|
||||
(let [profile (th/create-profile* 1 {:is-active true})
|
||||
proj-id (:default-project-id profile)
|
||||
storage (-> (:app.storage/storage th/*system*)
|
||||
(assoc :app.storage/backend :fs))
|
||||
add-media-on-main! (fn [file name]
|
||||
(let [sobj (sto/put-object! storage {::sto/content (sto/content name)
|
||||
:bucket :file-media-object
|
||||
:content-type "image/png"})
|
||||
fmo (th/create-file-media-object* {:file-id (:id file)
|
||||
:name name
|
||||
:media-id (:id sobj)})]
|
||||
(apply-change* profile (:id file)
|
||||
{:type :add-media
|
||||
:object {:id (:id fmo) :name name
|
||||
:media-id (:id sobj)
|
||||
:width 100 :height 100
|
||||
:mtype "image/png"}})))
|
||||
add-color-on-main! (fn [file]
|
||||
(apply-change* profile (:id file)
|
||||
{:type :add-color
|
||||
:color {:id (uuid/random) :name "C"
|
||||
:color "#112233" :opacity 1}}))
|
||||
update! (fn [branch-id]
|
||||
(th/command! {::th/type :update-branch-from-main
|
||||
::rpc/profile-id (:id profile)
|
||||
:branch-id branch-id}))]
|
||||
|
||||
(t/testing "media added on main after the fork"
|
||||
(let [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 "after-fork"}))
|
||||
branch-id (:id create)]
|
||||
(t/is (nil? (:error (add-media-on-main! file "after.png"))))
|
||||
(t/is (= :updated (-> (update! branch-id) :result :status)))
|
||||
(t/is (empty? (filter media-change-types (squashed-log-types branch-id))))
|
||||
;; again, with and without new main changes
|
||||
(t/is (nil? (:error (add-color-on-main! file))))
|
||||
(t/is (= :updated (-> (update! branch-id) :result :status)))
|
||||
(t/is (empty? (filter media-change-types (squashed-log-types branch-id))))
|
||||
(t/is (= :updated (-> (update! branch-id) :result :status)))
|
||||
(t/is (empty? (filter media-change-types (squashed-log-types branch-id))))))
|
||||
|
||||
(t/testing "media present before the fork"
|
||||
(let [file (th/create-file* 2 {:profile-id (:id profile)
|
||||
:project-id proj-id})
|
||||
_ (t/is (nil? (:error (add-media-on-main! file "before.png"))))
|
||||
create (:result (th/command! {::th/type :create-file-branch
|
||||
::rpc/profile-id (:id profile)
|
||||
:file-id (:id file)
|
||||
:name "before-fork"}))
|
||||
branch-id (:id create)]
|
||||
;; a main-side change so the update reaches the write path
|
||||
(t/is (nil? (:error (add-color-on-main! file))))
|
||||
(t/is (= :updated (-> (update! branch-id) :result :status)))
|
||||
(t/is (empty? (filter media-change-types (squashed-log-types branch-id))))
|
||||
;; again, with and without new main changes
|
||||
(t/is (nil? (:error (add-color-on-main! file))))
|
||||
(t/is (= :updated (-> (update! branch-id) :result :status)))
|
||||
(t/is (empty? (filter media-change-types (squashed-log-types branch-id))))
|
||||
(t/is (= :updated (-> (update! branch-id) :result :status)))
|
||||
(t/is (empty? (filter media-change-types (squashed-log-types branch-id)))))))))
|
||||
|
||||
;; --- The branch-merge policy switch ---
|
||||
;;
|
||||
;; `resources/app/branch-merge-policies.edn` picks one alternative per
|
||||
;; policy; the backend re-reads it on mtime change and binds the result
|
||||
;; around every compare, merge, update and listing computation. These
|
||||
;; tests pin what a developer flipping that file relies on.
|
||||
|
||||
(t/deftest policies-file-invalid-falls-back-to-defaults
|
||||
;; An invalid policies file must not take a merge down with it: it
|
||||
;; logs a warning and the engine runs the built-in defaults.
|
||||
(let [path (doto (java.io.File/createTempFile "branch-policies-" ".edn")
|
||||
(.deleteOnExit))
|
||||
logged (volatile! [])
|
||||
run (fn [content mtime]
|
||||
(spit path content)
|
||||
(.setLastModified path mtime)
|
||||
(vreset! logged [])
|
||||
(with-redefs [cf/config (assoc cf/config
|
||||
:branch-merge-policies-file (str path))
|
||||
;; `l/warn` expands to `emit-log`, so this
|
||||
;; captures what the loader logs
|
||||
l/emit-log (fn [props _cause _context _logger level _sync?]
|
||||
(let [props (if (delay? props) @props props)]
|
||||
(vswap! logged conj
|
||||
{:level level
|
||||
:props (into {} props)})))]
|
||||
(fbp/effective-policies)))
|
||||
warned? (fn []
|
||||
(some (fn [record]
|
||||
(and (= :warn (:level record))
|
||||
(= "invalid branch merge policies file"
|
||||
(:hint (:props record)))))
|
||||
@logged))]
|
||||
|
||||
;; a value outside the policy's alternatives is invalid
|
||||
(t/is (= bm/default-policies (run "{:same-parent-reorder :not-an-alternative}"
|
||||
1700000000000)))
|
||||
(t/is (warned?))
|
||||
|
||||
;; a file that is not a policy map at all is invalid the same way
|
||||
(t/is (= bm/default-policies (run "[1 2 3]" 1700000001000)))
|
||||
(t/is (warned?))))
|
||||
|
||||
(t/deftest policies-file-reloads-on-mtime-change
|
||||
;; Editing the policies file changes the effective policy the very
|
||||
;; next compare reads — no restart: the loader re-reads on mtime
|
||||
;; change and binds the result around the comparison.
|
||||
(with-redefs [cf/flags (conj cf/flags :branching)]
|
||||
(let [profile (th/create-profile* 1 {:is-active true})
|
||||
file (th/create-file* 1 {:profile-id (:id profile)
|
||||
:project-id (:default-project-id profile)
|
||||
:is-shared false})
|
||||
branch-id (-> (th/command! {::th/type :create-file-branch
|
||||
::rpc/profile-id (:id profile)
|
||||
:file-id (:id file)
|
||||
:name "policies-reload"})
|
||||
:result :id)
|
||||
path (doto (java.io.File/createTempFile "branch-policies-" ".edn")
|
||||
(.deleteOnExit))
|
||||
seen (volatile! nil)
|
||||
write! (fn [content mtime]
|
||||
(spit path content)
|
||||
(.setLastModified path mtime))
|
||||
compare! (fn []
|
||||
(let [out (th/command! {::th/type :get-branch-diff
|
||||
::rpc/profile-id (:id profile)
|
||||
:branch-id branch-id})]
|
||||
(t/is (nil? (:error out)))))]
|
||||
|
||||
(write! "{:same-parent-reorder :refuse}" 1700000000000)
|
||||
(with-redefs [cf/config (assoc cf/config
|
||||
:branch-merge-policies-file (str path))
|
||||
bm/compute-merge (fn [& _]
|
||||
(vreset! seen bm/*policies*)
|
||||
{:changes [] :conflicts []})]
|
||||
(compare!)
|
||||
(t/is (= :refuse (get @seen :same-parent-reorder)))
|
||||
|
||||
;; the same file, edited in place so its mtime moves, is picked
|
||||
;; up by the next compare: the switch needs no restart
|
||||
(write! "{:same-parent-reorder :ignore}" 1700000001000)
|
||||
(compare!)
|
||||
(t/is (= :ignore (get @seen :same-parent-reorder)))))))
|
||||
|
||||
(t/deftest summary-cache-key-changes-with-policies
|
||||
;; Two different policies must never share a cached summary: the key
|
||||
;; hashes the policies the value was computed under.
|
||||
(let [row {:base-snapshot-id (uuid/random) :source-revn 1 :branch-revn 2}
|
||||
key-of (fn [policies]
|
||||
(binding [bm/*policies* policies]
|
||||
(#'fbranch/summary-cache-key row)))
|
||||
k-default (key-of bm/default-policies)
|
||||
k-ignore (key-of (assoc bm/default-policies :same-parent-reorder :ignore))
|
||||
k-expand (key-of (assoc bm/default-policies :container-delete-over-main-edits :expand))]
|
||||
|
||||
;; the key is stable for the same policies …
|
||||
(t/is (= k-default (key-of bm/default-policies)))
|
||||
;; … and distinct for different ones
|
||||
(t/is (not= k-default k-ignore))
|
||||
(t/is (not= k-default k-expand))
|
||||
(t/is (not= k-ignore k-expand))))
|
||||
|
||||
@ -12,6 +12,8 @@
|
||||
[app.common.uuid :as uuid]
|
||||
[app.config :as cf]
|
||||
[app.db :as db]
|
||||
[app.email :as eml]
|
||||
[app.msgbus :as mbus]
|
||||
[app.rpc :as-alias rpc]
|
||||
[backend-tests.helpers :as th]
|
||||
[clojure.string :as str]
|
||||
@ -738,3 +740,123 @@
|
||||
error (:error out)]
|
||||
(t/is (some? error))
|
||||
(t/is (= :branching-disabled (-> error ex-data :code)))))
|
||||
|
||||
(t/deftest pull-request-commands-notify-only-after-the-commit
|
||||
(with-redefs [cf/flags pr-flags]
|
||||
(let [author (th/create-profile* 1 {:is-active true})
|
||||
reviewer (th/create-profile* 2 {:is-active true})
|
||||
file (th/create-file* 1 {:profile-id (:id author)
|
||||
:project-id (:default-project-id author)})]
|
||||
(th/create-team-role* {:team-id (:default-team-id author)
|
||||
:profile-id (:id reviewer)
|
||||
:role :editor})
|
||||
(let [branch (create-branch* author file "notify")
|
||||
bfid (:branch-file-id branch)
|
||||
actors {:author (:id author) :reviewer (:id reviewer)}
|
||||
;; one case per mutation; at the very moment `mbus/pub!`
|
||||
;; fires, `:view` reads the row ANOTHER pool connection sees
|
||||
;; and `:expected` is the state that must already be visible
|
||||
;; there (the transaction has committed)
|
||||
cases
|
||||
[{:label "create-pull-request"
|
||||
:type :create-pull-request
|
||||
:actor :author
|
||||
:params (fn [_] {:branch-id (:id branch)
|
||||
:title "review me"
|
||||
:reviewers [(:id reviewer)]})
|
||||
:message-type :pull-request-created
|
||||
:view (fn [id] (select-keys (th/db-get :file-pull-request {:id id})
|
||||
[:status]))
|
||||
:expected (constantly {:status "open"})}
|
||||
|
||||
{:label "update-pull-request"
|
||||
:type :update-pull-request
|
||||
:actor :author
|
||||
:params (fn [id] {:id id :title "renamed"})
|
||||
:message-type :pull-request-updated
|
||||
:view (fn [id] (select-keys (th/db-get :file-pull-request {:id id})
|
||||
[:title]))
|
||||
:expected (constantly {:title "renamed"})}
|
||||
|
||||
{:label "update-pull-request-snapshot"
|
||||
:type :update-pull-request-snapshot
|
||||
:actor :author
|
||||
;; the sandbox only republishes when the branch moved
|
||||
:before (fn [] (add-color* author bfid "Extra"))
|
||||
:params (fn [id] {:id id})
|
||||
:message-type :pull-request-updated
|
||||
:view (fn [id] (select-keys (th/db-get :file-pull-request {:id id})
|
||||
[:review-revn]))
|
||||
:expected (fn [_] {:review-revn (:revn (th/db-get :file {:id bfid}))})}
|
||||
|
||||
{:label "submit-pull-request-review"
|
||||
:type :submit-pull-request-review
|
||||
:actor :reviewer
|
||||
:params (fn [id] {:id id :state "approved" :comment "ship it"})
|
||||
:message-type :pull-request-review-submitted
|
||||
:view (fn [id] (select-keys (th/db-get :file-pull-request-review
|
||||
{:pull-request-id id
|
||||
:profile-id (:id reviewer)})
|
||||
[:state :reviewed-revn]))
|
||||
:expected (fn [id] {:state "approved"
|
||||
:reviewed-revn (:review-revn (th/db-get :file-pull-request {:id id}))})}
|
||||
|
||||
{:label "close-pull-request"
|
||||
:type :close-pull-request
|
||||
:actor :author
|
||||
:params (fn [id] {:id id})
|
||||
:message-type :pull-request-closed
|
||||
:view (fn [id] (select-keys (th/db-get :file-pull-request {:id id})
|
||||
[:status]))
|
||||
:expected (constantly {:status "closed"})}
|
||||
|
||||
{:label "reopen-pull-request"
|
||||
:type :reopen-pull-request
|
||||
:actor :author
|
||||
:params (fn [id] {:id id})
|
||||
:message-type :pull-request-updated
|
||||
:view (fn [id] (select-keys (th/db-get :file-pull-request {:id id})
|
||||
[:status]))
|
||||
:expected (constantly {:status "open"})}]]
|
||||
(loop [cases cases
|
||||
pr-id nil]
|
||||
(when-some [{:keys [label type actor before params message-type view expected]}
|
||||
(first cases)]
|
||||
(let [seen (atom [])
|
||||
_ (when before (before))
|
||||
out (with-redefs [mbus/pub!
|
||||
(fn [_ & {:keys [message]}]
|
||||
(swap! seen conj {:message message
|
||||
:row (view (:pull-request-id message))}))]
|
||||
(th/command! (merge {::th/type type
|
||||
::rpc/profile-id (actors actor)}
|
||||
(params pr-id))))]
|
||||
(t/is (nil? (:error out)) (str label " runs"))
|
||||
(let [{:keys [message row]} (first @seen)]
|
||||
(t/is (= 1 (count @seen)) (str label " publishes once"))
|
||||
(t/is (= message-type (:type message)) (str label " message type"))
|
||||
(t/is (= (expected (:pull-request-id message)) row)
|
||||
(str label " publishes only after the commit")))
|
||||
(recur (rest cases) (or pr-id (-> out :result :id))))))))))
|
||||
|
||||
(t/deftest rolled-back-pull-request-commands-notify-nothing
|
||||
(with-redefs [cf/flags pr-flags]
|
||||
(let [author (th/create-profile* 1 {:is-active true})
|
||||
reviewer (th/create-profile* 2 {:is-active true})
|
||||
file (th/create-file* 1 {:profile-id (:id author)
|
||||
:project-id (:default-project-id author)})]
|
||||
(th/create-team-role* {:team-id (:default-team-id author)
|
||||
:profile-id (:id reviewer)
|
||||
:role :editor})
|
||||
(let [branch (create-branch* author file "rollback")
|
||||
seen (atom [])]
|
||||
;; the reviewer emails are queued inside the transaction: make
|
||||
;; that queueing fail after the pull request row is written
|
||||
(with-redefs [mbus/pub! (fn [_ & {:keys [message]}]
|
||||
(swap! seen conj message))
|
||||
eml/send! (fn [_] (throw (IllegalStateException. "boom")))]
|
||||
(let [out (create-pr* author (:id branch) {:reviewers [(:id reviewer)]})]
|
||||
(t/is (some? (:error out)))))
|
||||
(t/is (empty? @seen))
|
||||
(t/is (empty? (th/db-query :file-pull-request
|
||||
{:file-branch-id (:id branch)})))))))
|
||||
|
||||
@ -220,3 +220,115 @@
|
||||
;; (th/print-result! out)
|
||||
(t/is (nil? (:error out)))
|
||||
(t/is (true? (:result out)))))))
|
||||
|
||||
(t/deftest snapshots-rename-guard
|
||||
;; Renaming a snapshot the user does not own must not convert it into
|
||||
;; a user snapshot: `fsnap/update!` flips `:created-by` to the caller
|
||||
;; and clears `:deleted-at`, so an unguarded rename makes the branch
|
||||
;; base pin (and any other system snapshot) deletable.
|
||||
(with-redefs [cf/flags (conj cf/flags :branching)]
|
||||
(let [profile (th/create-profile* 1 {:is-active true})
|
||||
file (th/create-file* 1 {:profile-id (:id profile)
|
||||
:project-id (:default-project-id profile)
|
||||
:is-shared false})
|
||||
|
||||
branch (:result (th/command! {::th/type :create-file-branch
|
||||
::rpc/profile-id (:id profile)
|
||||
:file-id (:id file)
|
||||
:name "rename-pin"}))
|
||||
|
||||
;; the pin is a system snapshot, so it carries a future
|
||||
;; deleted-at and only shows up without the deleted filter
|
||||
pin (th/db-get :file-change
|
||||
{:file-id (:id file)
|
||||
:label "branch-base/rename-pin"}
|
||||
{::db/remove-deleted false})]
|
||||
|
||||
(t/testing "the branch base pin is a system snapshot"
|
||||
(t/is (uuid? (:branch-file-id branch)))
|
||||
(t/is (uuid? (:id pin)))
|
||||
(t/is (= "system" (:created-by pin))))
|
||||
|
||||
(t/testing "renaming the branch base pin is refused"
|
||||
(let [out (th/command! {::th/type :update-file-snapshot
|
||||
::rpc/profile-id (:id profile)
|
||||
:id (:id pin)
|
||||
:label "stolen-label"})]
|
||||
(t/is (some? (:error out)))
|
||||
(t/is (= :system-snapshots-cant-be-renamed (th/ex-code (:error out))))))
|
||||
|
||||
(t/testing "the pin keeps its label and system ownership"
|
||||
(let [pin (th/db-get :file-change {:id (:id pin)} {::db/remove-deleted false})]
|
||||
(t/is (= "branch-base/rename-pin" (:label pin)))
|
||||
(t/is (= "system" (:created-by pin)))))
|
||||
|
||||
(t/testing "the pin is still not deletable"
|
||||
(let [out (th/command! {::th/type :delete-file-snapshot
|
||||
::rpc/profile-id (:id profile)
|
||||
:file-id (:id file)
|
||||
:id (:id pin)})]
|
||||
(t/is (some? (:error out)))
|
||||
(t/is (= :system-snapshots-cant-be-deleted (th/ex-code (:error out))))))
|
||||
|
||||
(t/testing "other system snapshots are refused the same way"
|
||||
;; restoring creates a system backup snapshot of the current
|
||||
;; state; renaming it must not adopt it either
|
||||
(let [file2 (th/create-file* 2 {:profile-id (:id profile)
|
||||
:project-id (:default-project-id profile)
|
||||
:is-shared false})
|
||||
user-snap (:result (th/command! {::th/type :create-file-snapshot
|
||||
::rpc/profile-id (:id profile)
|
||||
:file-id (:id file2)
|
||||
:label "user-version"}))]
|
||||
|
||||
(t/is (nil? (:error (th/command! {::th/type :restore-file-snapshot
|
||||
::rpc/profile-id (:id profile)
|
||||
:file-id (:id file2)
|
||||
:id (:id user-snap)}))))
|
||||
|
||||
(let [backup (th/db-get :file-change
|
||||
{:file-id (:id file2)
|
||||
:created-by "system"}
|
||||
{::db/remove-deleted false})
|
||||
out (th/command! {::th/type :update-file-snapshot
|
||||
::rpc/profile-id (:id profile)
|
||||
:id (:id backup)
|
||||
:label "stolen-backup"})]
|
||||
(t/is (uuid? (:id backup)))
|
||||
(t/is (some? (:error out)))
|
||||
(t/is (= :system-snapshots-cant-be-renamed (th/ex-code (:error out))))
|
||||
(t/is (= "system" (:created-by (th/db-get :file-change {:id (:id backup)}
|
||||
{::db/remove-deleted false}))))))))))
|
||||
|
||||
(t/deftest snapshots-restore-guard
|
||||
;; Restoring onto a branch file would write the restored document as
|
||||
;; the branch's own `file_data` payload and advance its revn, while
|
||||
;; `branch-file-data` keeps deriving from the branch base and the op
|
||||
;; log and never reads that payload: the branch silently
|
||||
;; desynchronises.
|
||||
(with-redefs [cf/flags (conj cf/flags :branching)]
|
||||
(let [profile (th/create-profile* 1 {:is-active true})
|
||||
file (th/create-file* 1 {:profile-id (:id profile)
|
||||
:project-id (:default-project-id profile)
|
||||
:is-shared false})
|
||||
branch (:result (th/command! {::th/type :create-file-branch
|
||||
::rpc/profile-id (:id profile)
|
||||
:file-id (:id file)
|
||||
:name "restore-target"}))
|
||||
branch-id (:branch-file-id branch)
|
||||
|
||||
snap (:result (th/command! {::th/type :create-file-snapshot
|
||||
::rpc/profile-id (:id profile)
|
||||
:file-id branch-id
|
||||
:label "branch-version"}))
|
||||
|
||||
out (th/command! {::th/type :restore-file-snapshot
|
||||
::rpc/profile-id (:id profile)
|
||||
:file-id branch-id
|
||||
:id (:id snap)})]
|
||||
|
||||
(t/is (uuid? branch-id))
|
||||
(t/is (uuid? (:id snap)))
|
||||
(t/is (some? (:error out)))
|
||||
(t/is (= :branch-file-cant-be-restored (th/ex-code (:error out))))
|
||||
(t/is (empty? (th/db-query :file-data {:file-id branch-id :type "main"}))))))
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -63,29 +63,96 @@
|
||||
(def xf:map-name
|
||||
(map :name))
|
||||
|
||||
(defn data-version
|
||||
"The current data version: the name of the last available migration.
|
||||
A document holds the set of migrations applied to it and `migrate`
|
||||
applies the available ones it lacks in list order, so a data version
|
||||
is a prefix of `available-migrations` and its last name identifies it."
|
||||
[]
|
||||
(first (rseq available-migrations)))
|
||||
|
||||
(defn- migration-ordinal
|
||||
"Sort key of a migration name in `available-migrations`: every
|
||||
`legacy-N` name precedes every numbered `NNNN-...` name, and each
|
||||
family sorts by its number. Nil for a name that follows neither
|
||||
pattern."
|
||||
[name]
|
||||
(if-let [[_ n] (re-matches #"legacy-(\d+)" name)]
|
||||
[0 (d/parse-integer n)]
|
||||
(when-let [[_ n] (re-find #"^(\d+)" name)]
|
||||
[1 (d/parse-integer n)])))
|
||||
|
||||
(defn data-version-migrations
|
||||
"The migrations that make up data version `version`: the prefix of
|
||||
`available-migrations` that ends at that name.
|
||||
|
||||
A migration removed from the list (a revert) leaves a recorded
|
||||
version with no position to cut at. The prefix then ends at the
|
||||
nearest earlier available name, by the number the name carries; a
|
||||
name with the same number is not earlier, because it replaces the
|
||||
removed one. The migrations past the cut apply at the next version
|
||||
boundary or at the end, as they would on an ordinary file. A removed
|
||||
name that carries no number yields an empty set."
|
||||
[version]
|
||||
(if (contains? available-migrations version)
|
||||
(reduce (fn [result name]
|
||||
(let [result (conj result name)]
|
||||
(if (= name version)
|
||||
(reduced result)
|
||||
result)))
|
||||
(d/ordered-set)
|
||||
available-migrations)
|
||||
(if-let [ordinal (migration-ordinal version)]
|
||||
(into (d/ordered-set)
|
||||
(take-while #(neg? (compare (migration-ordinal %) ordinal)))
|
||||
available-migrations)
|
||||
(d/ordered-set))))
|
||||
|
||||
(defn need-migration-to?
|
||||
"True when `file` has not reached data version `version`. A nil
|
||||
`version` names no version and needs nothing. A file that already
|
||||
holds the version's last migration has reached it, which costs one
|
||||
set lookup."
|
||||
[file version]
|
||||
(let [migrations (:migrations file)]
|
||||
(and (some? version)
|
||||
(not (contains? migrations version))
|
||||
(boolean
|
||||
(->> migrations
|
||||
(set/difference (data-version-migrations version))
|
||||
(not-empty))))))
|
||||
|
||||
(defn migrate
|
||||
[{:keys [id] :as file} libs]
|
||||
"Apply to `file` the migrations of `target` (all available ones by
|
||||
default) it has not applied yet, in list order. The file data schema
|
||||
describes the current data version only, so the result is checked
|
||||
against it only when `target` is the whole list."
|
||||
([file libs]
|
||||
(migrate file libs available-migrations))
|
||||
([{:keys [id] :as file} libs target]
|
||||
(let [diff
|
||||
(set/difference target (:migrations file))
|
||||
|
||||
(let [diff
|
||||
(set/difference available-migrations (:migrations file))
|
||||
data (-> (:data file)
|
||||
(assoc :libs libs))
|
||||
|
||||
data (-> (:data file)
|
||||
(assoc :libs libs))
|
||||
data
|
||||
(reduce migrate-data data diff)
|
||||
|
||||
data
|
||||
(reduce migrate-data data diff)
|
||||
data
|
||||
(cond-> (-> data
|
||||
(assoc :id id)
|
||||
(dissoc :version)
|
||||
(dissoc :libs))
|
||||
;; `target` is a prefix of the list, so equal counts mean
|
||||
;; the whole list
|
||||
(= (count target) (count available-migrations))
|
||||
(ctf/check-file-data))]
|
||||
|
||||
data
|
||||
(-> data
|
||||
(assoc :id id)
|
||||
(dissoc :version)
|
||||
(dissoc :libs)
|
||||
(ctf/check-file-data))]
|
||||
|
||||
(-> file
|
||||
(assoc :data data)
|
||||
(update :migrations set/union diff)
|
||||
(vary-meta assoc ::migrated (not-empty diff)))))
|
||||
(-> file
|
||||
(assoc :data data)
|
||||
(update :migrations set/union diff)
|
||||
(vary-meta assoc ::migrated (not-empty diff))))))
|
||||
|
||||
(defn generate-migrations-from-version
|
||||
"A function that generates new format migration from the old,
|
||||
@ -98,8 +165,8 @@
|
||||
result (transduce xform conj (d/ordered-set) (range 1 (inc cfd/version)))]
|
||||
result))
|
||||
|
||||
(defn migrate-file
|
||||
[file libs]
|
||||
(defn- migrate-file*
|
||||
[file libs target]
|
||||
(binding [cfeat/*new* (atom #{})]
|
||||
(let [version
|
||||
(or (:version file) (-> file :data :version))
|
||||
@ -119,7 +186,7 @@
|
||||
;; from this function that executes on each file
|
||||
;; migration operation
|
||||
(update :features cfeat/migrate-legacy-features)
|
||||
(migrate libs)
|
||||
(migrate libs target)
|
||||
(update :features (fnil into #{}) (deref cfeat/*new*)))]
|
||||
|
||||
;; NOTE: When we have no previous migrations, we report all
|
||||
@ -129,6 +196,18 @@
|
||||
(vary-meta file assoc ::migrated (:migrations file))
|
||||
file))))
|
||||
|
||||
(defn migrate-file
|
||||
[file libs]
|
||||
(migrate-file* file libs available-migrations))
|
||||
|
||||
(defn migrate-file-to
|
||||
"Migrate `file` up to data version `version` instead of the current
|
||||
one. A document replayed from an op log moves through the versions
|
||||
its ops were written at, the way an ordinary file moves through
|
||||
them across upgrades."
|
||||
[file libs version]
|
||||
(migrate-file* file libs (data-version-migrations version)))
|
||||
|
||||
(defn migrated?
|
||||
[file]
|
||||
(boolean (-> file meta ::migrated)))
|
||||
|
||||
@ -8,6 +8,9 @@
|
||||
(:require
|
||||
[app.common.files.branch-merge :as bm]
|
||||
[app.common.files.changes :as cfc]
|
||||
[app.common.types.page :as ctp]
|
||||
[app.common.types.shape :as cts]
|
||||
[app.common.types.shape-tree :as ctst]
|
||||
[app.common.types.tokens-lib :as ctob]
|
||||
[app.common.uuid :as uuid]
|
||||
[clojure.test :as t]))
|
||||
@ -70,13 +73,17 @@
|
||||
(t/is (= 0 (-> r :stats :modified)))))
|
||||
|
||||
(t/deftest shape-with-only-structural-change-hidden
|
||||
;; a shape whose ONLY diff is structural/derived (here children reorder)
|
||||
;; is not reported as modified in the summary.
|
||||
(let [base (mkdata {:s1 {:id :s1 :name "A" :shapes [:c1 :c2]}})
|
||||
branch (mkdata {:s1 {:id :s1 :name "A" :shapes [:c2 :c1]}})
|
||||
r (bm/compute-merge base base branch :branch->main)]
|
||||
(t/is (= [] (:changes r)))
|
||||
(t/is (= 0 (-> r :stats :modified)))))
|
||||
;; under `:same-parent-reorder :ignore` a shape whose ONLY diff is a
|
||||
;; children reorder is not reported, and the merge emits nothing for it
|
||||
;; (the reorder is lost; see the `same-parent-reorder-*` tests for the
|
||||
;; other alternatives)
|
||||
(binding [bm/*policies* (assoc bm/default-policies :same-parent-reorder :ignore)]
|
||||
(let [base (mkdata {:s1 {:id :s1 :name "A" :shapes [:c1 :c2]}})
|
||||
branch (mkdata {:s1 {:id :s1 :name "A" :shapes [:c2 :c1]}})
|
||||
r (bm/compute-merge base base branch :branch->main)]
|
||||
(t/is (= [] (:changes r)))
|
||||
(t/is (= 0 (-> r :stats :modified)))
|
||||
(t/is (= [] (:changes (bm/compute-changes base base branch)))))))
|
||||
|
||||
(t/deftest derived-attrs-stripped-containment-kept-and-merged
|
||||
;; SUMMARY strips only derived/cache attrs (:shapes/:selrect/:points), so
|
||||
@ -994,3 +1001,456 @@
|
||||
(t/is (= selrect (get-in c [:branch :selrect])))
|
||||
(t/is (= "MAIN" (get-in c [:main :name])))
|
||||
(t/is (= "BRANCH" (get-in c [:branch :name])))))
|
||||
|
||||
(t/deftest main->branch-conflict-sides-name-the-documents
|
||||
;; A conflict descriptor names the DOCUMENTS in both directions: `:main`
|
||||
;; is main's value and `:branch` the branch's, the `:changed-attrs`
|
||||
;; pairs included.
|
||||
(let [base (mkdata {:s1 {:id :s1 :name "A" :fill "red"}})
|
||||
main (mkdata {:s1 {:id :s1 :name "A" :fill "green"}})
|
||||
branch (mkdata {:s1 {:id :s1 :name "A" :fill "blue"}})
|
||||
r (bm/compute-merge base main branch :main->branch)
|
||||
c (first (:conflicts r))]
|
||||
(t/is (= 1 (-> r :stats :conflicts)))
|
||||
(t/is (= :modify-modify (:reason c)))
|
||||
(t/is (= "green" (get-in c [:main :fill])))
|
||||
(t/is (= "blue" (get-in c [:branch :fill])))
|
||||
(t/is (= {:main "green" :branch "blue"} (get-in c [:changed-attrs :fill])))))
|
||||
|
||||
(t/deftest delete-reasons-name-the-same-side-in-both-directions
|
||||
;; `:delete-modify` names the branch's deletion against main's
|
||||
;; modification, `:modify-delete` the branch's modification against
|
||||
;; main's deletion — the same meaning in both directions.
|
||||
(let [base (mkdata {:s1 {:id :s1 :name "A" :fill "red"}})
|
||||
main (mkdata {:s1 {:id :s1 :name "A" :fill "green"}})
|
||||
branch (mkdata {})
|
||||
r (bm/compute-merge base main branch :main->branch)
|
||||
c (first (:conflicts r))]
|
||||
(t/is (= 1 (-> r :stats :conflicts)))
|
||||
(t/is (= :delete-modify (:reason c)))
|
||||
(t/is (= "green" (get-in c [:main :fill])))
|
||||
(t/is (nil? (:branch c))))
|
||||
(let [base (mkdata {:s1 {:id :s1 :name "A" :fill "red"}})
|
||||
main (mkdata {})
|
||||
branch (mkdata {:s1 {:id :s1 :name "A" :fill "blue"}})
|
||||
r (bm/compute-merge base main branch :main->branch)
|
||||
c (first (:conflicts r))]
|
||||
(t/is (= 1 (-> r :stats :conflicts)))
|
||||
(t/is (= :modify-delete (:reason c)))
|
||||
(t/is (nil? (:main c)))
|
||||
(t/is (= "blue" (get-in c [:branch :fill])))))
|
||||
|
||||
(t/deftest remap-changes-rewrites-a-del-media-id
|
||||
;; the id map carries the two file ids and the media ids (`media-pairs`
|
||||
;; plus the fresh ids of the copied rows). Of the change types
|
||||
;; `compute-changes` emits with a top-level `:id`, only `:del-media`'s
|
||||
;; names a media object, a reference through that map; its `:id` is the
|
||||
;; whole payload and `relink-refs` cannot see it. The others name
|
||||
;; entities the two files share by id (colour, typography, component,
|
||||
;; shape, page), never a media row, so they must come out untouched —
|
||||
;; re-pointing one through a media-pair map would corrupt it.
|
||||
(let [media-old (uuid/next)
|
||||
media-new (uuid/next)
|
||||
color-id (uuid/next)
|
||||
typo-id (uuid/next)
|
||||
comp-id (uuid/next)
|
||||
shape-id (uuid/next)
|
||||
page-id (uuid/next)
|
||||
changes [{:type :del-media :id media-old}
|
||||
{:type :add-media :object {:id media-old :media-id media-old
|
||||
:name "img" :width 1 :height 1
|
||||
:mtype "image/png"}}
|
||||
{:type :mod-media :object {:id media-old :name "renamed"}}
|
||||
{:type :del-color :id color-id}
|
||||
{:type :del-typography :id typo-id}
|
||||
{:type :del-component :id comp-id}
|
||||
{:type :del-obj :page-id page-id :id shape-id
|
||||
:ignore-touched true}]
|
||||
out (bm/remap-changes changes {media-old media-new})]
|
||||
(t/is (= media-new (:id (nth out 0))))
|
||||
(t/is (= media-new (get-in (nth out 1) [:object :id])))
|
||||
(t/is (= media-new (get-in (nth out 2) [:object :id])))
|
||||
(t/is (= color-id (:id (nth out 3))))
|
||||
(t/is (= typo-id (:id (nth out 4))))
|
||||
(t/is (= comp-id (:id (nth out 5))))
|
||||
(t/is (= shape-id (:id (nth out 6))))))
|
||||
|
||||
;;; --- Tree-shape policies (`bm/*policies*`) ---
|
||||
|
||||
(defn- add-tree-shape
|
||||
"Add a real shape (`cts/setup-shape`) under `parent` (nil = page root)
|
||||
at `index` (nil = on top)."
|
||||
[page id parent type name index]
|
||||
(let [parent (or parent uuid/zero)
|
||||
pobj (get-in page [:objects parent])
|
||||
frame-id (if (= :frame (:type pobj)) parent (:frame-id pobj))
|
||||
shape (cts/setup-shape {:id id :type type :name name
|
||||
:x 0 :y 0 :width 10 :height 10})]
|
||||
(ctst/add-shape id shape page frame-id parent index true)))
|
||||
|
||||
(defn- tree-data
|
||||
"File data with one page built from `specs`, each `[id parent type
|
||||
name]`, parents first. The shapes are real, so `cfc/process-changes`
|
||||
validates the merged tree."
|
||||
[& specs]
|
||||
(let [pid (uuid/custom 7 1)
|
||||
page (reduce (fn [page [id parent type name]]
|
||||
(add-tree-shape page id parent type name nil))
|
||||
(ctp/make-empty-page {:id pid :name "Page 1"})
|
||||
specs)]
|
||||
{:pages [pid] :pages-index {pid page}
|
||||
:colors {} :typographies {} :components {} :media {}}))
|
||||
|
||||
(defn- tree-page-id [data] (first (:pages data)))
|
||||
(defn- tree-objects [data] (get-in data [:pages-index (tree-page-id data) :objects]))
|
||||
(defn- tree-children [data id] (get-in (tree-objects data) [id :shapes]))
|
||||
|
||||
(defn- tree-edit
|
||||
[data f & args]
|
||||
(apply update-in data [:pages-index (tree-page-id data) :objects] f args))
|
||||
|
||||
(defn- tree-add
|
||||
[data id parent type name & {:keys [index]}]
|
||||
(update-in data [:pages-index (tree-page-id data)] add-tree-shape id parent type name index))
|
||||
|
||||
(defn- tree-delete
|
||||
[data id]
|
||||
(update-in data [:pages-index (tree-page-id data)] ctst/delete-shape id true))
|
||||
|
||||
(defn- merged
|
||||
"Merge `branch` into `main` under `resolutions` and apply the changes
|
||||
to main through the production change pipeline."
|
||||
[base main branch resolutions]
|
||||
(let [{:keys [changes unsupported]} (bm/compute-changes base main branch resolutions)]
|
||||
{:unsupported unsupported
|
||||
:changes changes
|
||||
:data (cfc/process-changes main changes)}))
|
||||
|
||||
(defn- policies
|
||||
[k v]
|
||||
(assoc bm/default-policies k v))
|
||||
|
||||
(t/deftest same-parent-reorder-merge-is-shown-and-applied
|
||||
;; ws1: base and main hold [A B] in F and the branch [B A]. Under the
|
||||
;; default `:merge` the reorder is a modification of F and lands.
|
||||
(let [f (uuid/next) a (uuid/next) b (uuid/next) m (uuid/next)
|
||||
base (tree-data [f nil :frame "F"] [a f :rect "A"] [b f :rect "B"])
|
||||
branch (tree-edit base assoc-in [f :shapes] [b a])
|
||||
r (bm/compute-merge base base branch :branch->main)
|
||||
entry (first (:changes r))
|
||||
{:keys [data unsupported]} (merged base base branch {})]
|
||||
(t/is (= 1 (-> r :stats :modified)))
|
||||
(t/is (= [f] (mapv :id (:changes r))))
|
||||
(t/is (= {:main [a b] :branch [b a]} (get-in entry [:changed-attrs :shapes])))
|
||||
(t/is (empty? unsupported))
|
||||
(t/is (= [b a] (tree-children data f)))
|
||||
|
||||
(t/testing "main adding a child to F is not a conflict and keeps its slot"
|
||||
(let [main (tree-add base m f :rect "M")
|
||||
r (bm/compute-merge base main branch :branch->main)]
|
||||
(t/is (= [] (:conflicts r)))
|
||||
(t/is (= [b a m] (tree-children (:data (merged base main branch {})) f)))))
|
||||
|
||||
(t/testing "update from main reports and applies main's reorder"
|
||||
(let [main (tree-edit base assoc-in [f :shapes] [b a])
|
||||
r (bm/compute-merge base main base :main->branch)]
|
||||
(t/is (= {:main [b a] :branch [a b]}
|
||||
(get-in (first (:changes r)) [:changed-attrs :shapes])))
|
||||
(t/is (= [b a] (tree-children (:data (merged base base main {})) f)))))))
|
||||
|
||||
(t/deftest same-parent-reorder-merge-both-sides-conflict
|
||||
;; both sides reorder F differently: a conflict on F whose resolution
|
||||
;; picks the order
|
||||
(let [f (uuid/next) a (uuid/next) b (uuid/next) c (uuid/next)
|
||||
base (tree-data [f nil :frame "F"] [a f :rect "A"] [b f :rect "B"] [c f :rect "C"])
|
||||
main (tree-edit base assoc-in [f :shapes] [c a b])
|
||||
branch (tree-edit base assoc-in [f :shapes] [b a c])
|
||||
{:keys [conflicts]} (bm/compute-merge base main branch :branch->main)
|
||||
cf (first conflicts)]
|
||||
(t/is (= [[f :modify-modify]] (mapv (juxt :id :reason) conflicts)))
|
||||
(t/is (= {:main [c a b] :branch [b a c]} (get-in cf [:changed-attrs :shapes])))
|
||||
(t/is (= [b a c] (tree-children (:data (merged base main branch {f :branch})) f)))
|
||||
(t/is (= [c a b] (tree-children (:data (merged base main branch {f :main})) f)))
|
||||
(t/is (= [b a c] (tree-children (:data (merged base main branch {f {:shapes :branch}})) f)))))
|
||||
|
||||
(t/deftest same-parent-reorder-refuse
|
||||
;; `:refuse`: the reorder is an `:unsupported` entry naming F, so the
|
||||
;; merge refuses
|
||||
(binding [bm/*policies* (policies :same-parent-reorder :refuse)]
|
||||
(let [f (uuid/next) a (uuid/next) b (uuid/next)
|
||||
base (tree-data [f nil :frame "F"] [a f :rect "A"] [b f :rect "B"])
|
||||
branch (tree-edit base assoc-in [f :shapes] [b a])
|
||||
r (bm/compute-merge base base branch :branch->main)]
|
||||
(t/is (= [{:kind :shape-order :status :unsupported :id f :page-id (tree-page-id base)
|
||||
:label "F" :policy :same-parent-reorder}]
|
||||
(:changes r)))
|
||||
(t/is (= #{:shape-order} (bm/unsupported-kinds (:changes r))))
|
||||
(t/is (= #{:shape-order} (:unsupported (bm/compute-changes base base branch {})))))))
|
||||
|
||||
(t/deftest same-parent-reorder-ignore
|
||||
;; `:ignore`: the reorder is invisible and the merge loses it
|
||||
(binding [bm/*policies* (policies :same-parent-reorder :ignore)]
|
||||
(let [f (uuid/next) a (uuid/next) b (uuid/next)
|
||||
base (tree-data [f nil :frame "F"] [a f :rect "A"] [b f :rect "B"])
|
||||
branch (tree-edit base assoc-in [f :shapes] [b a])
|
||||
r (bm/compute-merge base base branch :branch->main)]
|
||||
(t/is (= {:added 0 :modified 0 :deleted 0 :conflicts 0} (:stats r)))
|
||||
(t/is (= [a b] (tree-children (:data (merged base base branch {})) f))))))
|
||||
|
||||
(t/deftest added-siblings-keep-the-branch-order
|
||||
;; ws1: main adds Z at index 0 of F, the branch adds siblings to F. The
|
||||
;; merged F holds the branch's siblings in the branch's order.
|
||||
(let [f (uuid/custom 9 100)
|
||||
z (uuid/custom 9 200)
|
||||
ss (mapv #(uuid/custom 9 %) (range 1 9))
|
||||
base (tree-data [f nil :frame "F"])
|
||||
main (tree-add base z f :rect "Z" :index 0)
|
||||
branch (reduce (fn [d [i s]] (tree-add d s f :rect (str "S" i)))
|
||||
base (map-indexed vector ss))
|
||||
out (tree-children (:data (merged base main branch {})) f)]
|
||||
(t/is (= ss (filterv (set ss) out)))
|
||||
(t/is (= (inc (count ss)) (count out)))))
|
||||
|
||||
(t/deftest addition-under-deleted-parent-conflict
|
||||
;; ws1: main deletes frame P, the branch adds M inside P. Default
|
||||
;; `:conflict`: a `:modify-delete` conflict on P; `:branch` restores P as
|
||||
;; the branch has it, `:main` drops M.
|
||||
(let [p (uuid/next) c (uuid/next) m (uuid/next)
|
||||
base (tree-data [p nil :frame "P"] [c p :rect "C"])
|
||||
main (tree-delete base p)
|
||||
branch (tree-add base m p :rect "M")
|
||||
r (bm/compute-merge base main branch :branch->main)
|
||||
cf (first (:conflicts r))]
|
||||
(t/is (= [[p :modify-delete]] (mapv (juxt :id :reason) (:conflicts r))))
|
||||
(t/is (= [{:id m :label "M"}] (:subtree-edits cf)))
|
||||
(t/is (= "P" (get-in cf [:branch :name])))
|
||||
(t/is (not-any? #(= m (:id %)) (:changes r)))
|
||||
(let [objs (tree-objects (:data (merged base main branch {p :branch})))]
|
||||
(t/is (= [p] (get-in objs [uuid/zero :shapes])))
|
||||
(t/is (= [c m] (get-in objs [p :shapes])))
|
||||
(t/is (= p (get-in objs [m :parent-id]))))
|
||||
(let [objs (tree-objects (:data (merged base main branch {p :main})))]
|
||||
(t/is (= #{uuid/zero} (set (keys objs)))))))
|
||||
|
||||
(t/deftest addition-under-deleted-parent-conflict-lifts-restores
|
||||
;; ws1: main deletes frame P, the branch renames its child C. The
|
||||
;; conflict sits on P, and `:branch` restores P around C instead of
|
||||
;; putting C on the page root.
|
||||
(let [p (uuid/next) c (uuid/next)
|
||||
base (tree-data [p nil :frame "P"] [c p :rect "C"])
|
||||
main (tree-delete base p)
|
||||
branch (tree-edit base assoc-in [c :name] "C renamed")
|
||||
r (bm/compute-merge base main branch :branch->main)]
|
||||
(t/is (= [[p :modify-delete]] (mapv (juxt :id :reason) (:conflicts r))))
|
||||
(t/is (= [{:id c :label "C renamed"}] (:subtree-edits (first (:conflicts r)))))
|
||||
(let [objs (tree-objects (:data (merged base main branch {p :branch})))]
|
||||
(t/is (= [p] (get-in objs [uuid/zero :shapes])))
|
||||
(t/is (= p (get-in objs [c :parent-id])))
|
||||
(t/is (= "C renamed" (get-in objs [c :name]))))))
|
||||
|
||||
(t/deftest addition-under-deleted-parent-refuse
|
||||
;; `:refuse`: the addition is an `:unsupported` entry naming P, and so
|
||||
;; is a restore that would lose its parent
|
||||
(binding [bm/*policies* (policies :addition-under-deleted-parent :refuse)]
|
||||
(let [p (uuid/next) c (uuid/next) m (uuid/next)
|
||||
base (tree-data [p nil :frame "P"] [c p :rect "C"])
|
||||
main (tree-delete base p)
|
||||
branch (tree-add base m p :rect "M")
|
||||
r (bm/compute-merge base main branch :branch->main)]
|
||||
(t/is (= [{:kind :shape-orphan :status :unsupported :id p :page-id (tree-page-id base)
|
||||
:label "P" :policy :addition-under-deleted-parent :shapes [m]}]
|
||||
(filterv #(= :unsupported (:status %)) (:changes r))))
|
||||
(t/is (= #{:shape-orphan} (:unsupported (bm/compute-changes base main branch {}))))
|
||||
(let [branch (tree-edit base assoc-in [c :name] "C renamed")]
|
||||
(t/is (= [[c :modify-delete]]
|
||||
(mapv (juxt :id :reason) (:conflicts (bm/compute-merge base main branch :branch->main)))))
|
||||
(t/is (= #{:shape-orphan} (:unsupported (bm/compute-changes base main branch {c :branch}))))
|
||||
(t/is (empty? (:unsupported (bm/compute-changes base main branch {c :main}))))))))
|
||||
|
||||
(t/deftest addition-under-deleted-parent-reparent-to-ancestor
|
||||
;; `:reparent-to-ancestor`: main deletes P inside board G; the branch's
|
||||
;; addition M and a restored C land under G, where P was
|
||||
(binding [bm/*policies* (policies :addition-under-deleted-parent :reparent-to-ancestor)]
|
||||
(let [g (uuid/next) h (uuid/next) p (uuid/next) c (uuid/next) m (uuid/next)
|
||||
base (tree-data [g nil :frame "G"] [h g :rect "H"] [p g :frame "P"] [c p :rect "C"])
|
||||
main (tree-delete base p)
|
||||
branch (tree-add base m p :rect "M")
|
||||
r (bm/compute-merge base main branch :branch->main)
|
||||
{:keys [data unsupported]} (merged base main branch {})
|
||||
objs (tree-objects data)]
|
||||
(t/is (= [] (:conflicts r)))
|
||||
(t/is (empty? unsupported))
|
||||
(t/is (= [h m] (get-in objs [g :shapes])))
|
||||
(t/is (= g (get-in objs [m :parent-id])))
|
||||
(t/is (= g (get-in objs [m :frame-id])))
|
||||
(let [branch (tree-edit base assoc-in [c :name] "C renamed")
|
||||
objs (tree-objects (:data (merged base main branch {c :branch})))]
|
||||
(t/is (= [h c] (get-in objs [g :shapes])))
|
||||
(t/is (= g (get-in objs [c :frame-id])))))))
|
||||
|
||||
(t/deftest addition-under-deleted-parent-page-root
|
||||
;; `:page-root`: the addition falls back to the page root
|
||||
(binding [bm/*policies* (policies :addition-under-deleted-parent :page-root)]
|
||||
(let [p (uuid/next) c (uuid/next) m (uuid/next)
|
||||
base (tree-data [p nil :frame "P"] [c p :rect "C"])
|
||||
main (tree-delete base p)
|
||||
branch (tree-add base m p :rect "M")
|
||||
objs (tree-objects (:data (merged base main branch {})))]
|
||||
(t/is (= [] (:conflicts (bm/compute-merge base main branch :branch->main))))
|
||||
(t/is (= [m] (get-in objs [uuid/zero :shapes])))
|
||||
(t/is (= uuid/zero (get-in objs [m :parent-id]))))))
|
||||
|
||||
(defn- container-delete-case
|
||||
"ws1: the branch deletes frame F, main recolours its child C and adds N
|
||||
inside it; D is an untouched child of F and K a sibling of F."
|
||||
[]
|
||||
(let [f (uuid/next) c (uuid/next) d (uuid/next) n (uuid/next) k (uuid/next)
|
||||
base (tree-data [k nil :rect "K"] [f nil :frame "F"] [c f :rect "C"] [d f :rect "D"])
|
||||
main (-> base
|
||||
(tree-edit assoc-in [c :fills] [{:fill-color "#FF0000" :fill-opacity 1}])
|
||||
(tree-add n f :rect "N"))
|
||||
branch (tree-delete base f)]
|
||||
{:f f :c c :d d :n n :k k :base base :main main :branch branch}))
|
||||
|
||||
(t/deftest container-delete-over-main-edits-conflict
|
||||
;; default `:conflict`: one `:delete-modify` conflict on F. `:main` keeps
|
||||
;; F and its subtree as main has them, `:branch` deletes it all.
|
||||
(let [{:keys [f c d n k base main branch]} (container-delete-case)
|
||||
r (bm/compute-merge base main branch :branch->main)]
|
||||
(t/is (= [[f :delete-modify]] (mapv (juxt :id :reason) (:conflicts r))))
|
||||
(t/is (= #{c n} (set (map :id (:subtree-edits (first (:conflicts r)))))))
|
||||
(t/is (= [] (:changes r)))
|
||||
(let [objs (tree-objects (:data (merged base main branch {f :main})))]
|
||||
(t/is (= [k f] (get-in objs [uuid/zero :shapes])))
|
||||
(t/is (= [c d n] (get-in objs [f :shapes])))
|
||||
(t/is (= "#FF0000" (get-in objs [c :fills 0 :fill-color]))))
|
||||
(let [objs (tree-objects (:data (merged base main branch {f :branch})))]
|
||||
(t/is (= #{uuid/zero k} (set (keys objs)))))))
|
||||
|
||||
(t/deftest container-delete-over-main-edits-expand
|
||||
;; `:expand`: only what the branch deleted goes; main's addition N, and
|
||||
;; C when its conflict is resolved to `:main`, move to F's parent where
|
||||
;; F was
|
||||
(binding [bm/*policies* (policies :container-delete-over-main-edits :expand)]
|
||||
(let [{:keys [f c d n k base main branch]} (container-delete-case)
|
||||
r (bm/compute-merge base main branch :branch->main)]
|
||||
(t/is (= [[c :delete-modify]] (mapv (juxt :id :reason) (:conflicts r))))
|
||||
(t/is (= #{f d} (set (map :id (:changes r)))))
|
||||
(let [objs (tree-objects (:data (merged base main branch {c :main})))]
|
||||
(t/is (= [k c n] (get-in objs [uuid/zero :shapes])))
|
||||
(t/is (= #{uuid/zero k c n} (set (keys objs))))
|
||||
(t/is (= uuid/zero (get-in objs [n :frame-id])))
|
||||
(t/is (= "#FF0000" (get-in objs [c :fills 0 :fill-color]))))
|
||||
(let [objs (tree-objects (:data (merged base main branch {c :branch})))]
|
||||
(t/is (= [k n] (get-in objs [uuid/zero :shapes])))))))
|
||||
|
||||
(t/deftest container-delete-over-main-edits-cascade
|
||||
;; `:cascade`: F goes with its whole subtree, main's edits included
|
||||
(binding [bm/*policies* (policies :container-delete-over-main-edits :cascade)]
|
||||
(let [{:keys [f c d k base main branch]} (container-delete-case)
|
||||
r (bm/compute-merge base main branch :branch->main)]
|
||||
(t/is (= [[c :delete-modify]] (mapv (juxt :id :reason) (:conflicts r))))
|
||||
(t/is (= #{f d} (set (map :id (filter #(= :deleted (:status %)) (:changes r))))))
|
||||
(let [objs (tree-objects (:data (merged base main branch {c :main})))]
|
||||
(t/is (= #{uuid/zero k} (set (keys objs))))))))
|
||||
|
||||
;;; --- Regression tests: mov-page indexes ---
|
||||
|
||||
(t/deftest compute-changes-page-order-counts-full-pages
|
||||
;; `:mov-page :index` counts the FULL :pages vector as it is when the op
|
||||
;; runs: a page main added keeps its slot while the common pages reorder
|
||||
;; to branch's order around it. Counting the common-pages order instead
|
||||
;; pushed such a page out of its slot (to the end).
|
||||
(let [p1 (uuid/next) p2 (uuid/next) p3 (uuid/next) x (uuid/next)
|
||||
page (fn [id n] {:id id :name n :objects {}})
|
||||
pages3 {p1 (page p1 "P1") p2 (page p2 "P2") p3 (page p3 "P3")}
|
||||
pages4 (assoc pages3 x (page x "X"))
|
||||
order (fn [main-pages]
|
||||
(let [base (pages-data pages3 [p1 p2 p3])
|
||||
main (pages-data pages4 main-pages)
|
||||
branch (pages-data pages3 [p1 p3 p2])
|
||||
{:keys [changes]} (bm/compute-changes base main branch)]
|
||||
(:pages (cfc/process-changes main changes))))]
|
||||
;; main's extra page at the end: the reorder comes out right
|
||||
(t/is (= [p1 p3 p2 x] (order [p1 p2 p3 x])))
|
||||
;; main's extra page interleaved: it keeps its slot
|
||||
(t/is (= [p1 x p3 p2] (order [p1 x p2 p3])))
|
||||
(t/is (= [x p1 p3 p2] (order [x p1 p2 p3])))))
|
||||
|
||||
;;; --- Regression tests: cleared page meta ---
|
||||
|
||||
(t/deftest compute-changes-page-meta-clear-carries-nil
|
||||
;; a branch that renames a page and clears its background must REMOVE the
|
||||
;; background: `mod-page` removes only on an explicit nil, so the change
|
||||
;; carries it — an absent key would leave main's background in place
|
||||
(let [pid (uuid/next)
|
||||
base (pages-data {pid {:id pid :name "P" :objects {} :background "#ff0000"}} [pid])
|
||||
branch (assoc-in base [:pages-index pid] {:id pid :name "Renamed" :objects {}})
|
||||
{:keys [changes unsupported]} (bm/compute-changes base base branch)
|
||||
mod (first (filter #(= :mod-page (:type %)) changes))
|
||||
data' (cfc/process-changes base changes)]
|
||||
(t/is (empty? unsupported))
|
||||
(t/is (= "Renamed" (:name mod)))
|
||||
(t/is (contains? mod :background))
|
||||
(t/is (nil? (:background mod)))
|
||||
(t/is (= "Renamed" (get-in data' [:pages-index pid :name])))
|
||||
(t/is (not (contains? (get-in data' [:pages-index pid]) :background)))))
|
||||
|
||||
;;; --- Regression tests: per-attr resolution on flat collections ---
|
||||
|
||||
(t/deftest compute-changes-per-attr-removes-missing-attr
|
||||
;; main added an :opacity the branch does not carry; resolving that attr
|
||||
;; to :branch takes branch's state, where the attr is ABSENT — the shape
|
||||
;; `schema:library-color` expresses removal with (closed map: optional
|
||||
;; keys, never nil values)
|
||||
(let [cid (uuid/next)
|
||||
base (mkdata {} :colors {cid {:id cid :name "A" :color "#ff0000"}})
|
||||
main (mkdata {} :colors {cid {:id cid :name "A" :color "#ff0000" :opacity 0.5}})
|
||||
branch (mkdata {} :colors {cid {:id cid :name "Brnc" :color "#ff0000"}})
|
||||
{:keys [changes]} (bm/compute-changes base main branch {cid {:name :branch :opacity :branch}})
|
||||
color (-> (group-by :type changes) :mod-color first :color)]
|
||||
(t/is (= "Brnc" (:name color)))
|
||||
(t/is (not (contains? color :opacity)))
|
||||
;; round-trip: the applied color carries no :opacity either
|
||||
(let [data' (cfc/process-changes main changes)]
|
||||
(t/is (not (contains? (get-in data' [:colors cid]) :opacity))))))
|
||||
|
||||
;;; --- Regression tests: token-set order vs renames ---
|
||||
|
||||
(t/deftest compute-changes-token-set-order-after-rename
|
||||
;; main renamed alpha to ALPHA while the branch reordered to [beta alpha]:
|
||||
;; the moves must address the sets by the names they carry AFTER the
|
||||
;; emitted renames settle (main's rename stands), else `move-set` finds no
|
||||
;; set at the stale name and the reorder silently drops
|
||||
(let [a (uuid/next) b (uuid/next)
|
||||
base-lib (-> (ctob/make-tokens-lib)
|
||||
(ctob/add-set (ctob/make-token-set {:id a :name "alpha"}))
|
||||
(ctob/add-set (ctob/make-token-set {:id b :name "beta"})))
|
||||
main-lib (ctob/update-set base-lib a
|
||||
(fn [s] (ctob/make-token-set {:id (ctob/get-id s)
|
||||
:name "ALPHA"
|
||||
:tokens (ctob/get-tokens base-lib a)})))
|
||||
branch-lib (ctob/move-set base-lib ["beta"] ["beta"] ["alpha"] false)
|
||||
{:keys [changes unsupported]} (bm/compute-changes (with-tokens base-lib)
|
||||
(with-tokens main-lib)
|
||||
(with-tokens branch-lib))
|
||||
data' (cfc/process-changes {:tokens-lib main-lib} changes)]
|
||||
(t/is (empty? unsupported))
|
||||
(t/is (seq (filter #(= :move-token-set (:type %)) changes)))
|
||||
;; the reorder survives main's rename
|
||||
(t/is (= ["beta" "ALPHA"] (mapv ctob/get-name (ctob/get-sets (:tokens-lib data')))))))
|
||||
|
||||
;;; --- Regression tests: shape-pass refusals ---
|
||||
|
||||
(t/deftest compute-changes-shape-pass-refusals-surface
|
||||
;; a `:refuse` policy reports its refusals from the shape pass; they must
|
||||
;; reach the caller's `:unsupported` even when the merge summary handed
|
||||
;; to the 5-arity carries none of them — dropping the pass's
|
||||
;; `:unsupported` would silently turn a refused merge into a clean one
|
||||
(binding [bm/*policies* (policies :addition-under-deleted-parent :refuse)]
|
||||
(let [p (uuid/next) c (uuid/next) m (uuid/next)
|
||||
base (tree-data [p nil :frame "P"] [c p :rect "C"])
|
||||
main (tree-delete base p)
|
||||
branch (tree-add base m p :rect "M")
|
||||
{:keys [unsupported]} (bm/compute-changes base main branch {} {:changes [] :conflicts []})]
|
||||
(t/is (= #{:shape-orphan} unsupported)))))
|
||||
|
||||
@ -28,6 +28,52 @@
|
||||
(t/is (= cfm/available-migrations (:migrations file')))
|
||||
(t/is (= 3 (:sum (:data file'))))))))
|
||||
|
||||
(t/deftest data-version-migrations-cut-the-list-at-a-version
|
||||
(let [migrations (into (d/ordered-set)
|
||||
["legacy-2" "legacy-10" "0001-a" "0002-b" "0002-c" "0003-d" "0005b-f"])]
|
||||
(with-redefs [cfm/available-migrations migrations]
|
||||
(t/is (= "0005b-f" (cfm/data-version)))
|
||||
|
||||
(t/testing "an available name ends the prefix at itself"
|
||||
(t/is (= ["legacy-2" "legacy-10" "0001-a" "0002-b"]
|
||||
(vec (cfm/data-version-migrations "0002-b")))))
|
||||
|
||||
(t/testing "a removed name ends the prefix at the nearest earlier number"
|
||||
(t/is (= ["legacy-2" "legacy-10" "0001-a" "0002-b" "0002-c" "0003-d"]
|
||||
(vec (cfm/data-version-migrations "0004-e"))))
|
||||
(t/is (= ["legacy-2"]
|
||||
(vec (cfm/data-version-migrations "legacy-5")))))
|
||||
|
||||
(t/testing "a name with the same number replaces a removed one, so it is not earlier"
|
||||
(t/is (= ["legacy-2" "legacy-10" "0001-a" "0002-b" "0002-c" "0003-d"]
|
||||
(vec (cfm/data-version-migrations "0005-f")))))
|
||||
|
||||
(t/testing "a removed name with no number cuts nothing"
|
||||
(t/is (empty? (cfm/data-version-migrations "unknown")))))))
|
||||
|
||||
(t/deftest migrate-file-to-stops-at-a-version
|
||||
(let [migrations (into (d/ordered-set) ["test/1" "test/2" "test/3"])
|
||||
file {:data {:sum 1}
|
||||
:id 1
|
||||
:migrations (d/ordered-set "test/1")}]
|
||||
;; the file data schema describes the current version only, so a
|
||||
;; document stopped at an older one is not checked against it
|
||||
(with-redefs [cfm/available-migrations migrations
|
||||
ctf/check-file-data (fn [_] (throw (ex-info "checked" {})))]
|
||||
(t/is (cfm/need-migration-to? file "test/2"))
|
||||
(t/is (not (cfm/need-migration-to? file "test/1")))
|
||||
(t/is (not (cfm/need-migration-to? file nil)))
|
||||
|
||||
(let [file' (cfm/migrate-file-to file nil "test/2")]
|
||||
(t/is (= 2 (-> file' :data :sum)))
|
||||
(t/is (= #{"test/1" "test/2"} (set (:migrations file'))))
|
||||
(t/is (not (cfm/need-migration-to? file' "test/2")))
|
||||
(t/is (cfm/need-migration-to? file' "test/3"))
|
||||
|
||||
(t/testing "the step that reaches the current version is checked"
|
||||
(t/is (thrown? #?(:clj Exception :cljs :default)
|
||||
(cfm/migrate-file-to file' nil "test/3"))))))))
|
||||
|
||||
(t/deftest migration-0024b-fix-stroke-cap-placement
|
||||
(let [shape-id (uuid/next)
|
||||
page-id (uuid/next)
|
||||
|
||||
@ -23,9 +23,11 @@
|
||||
[app.main.data.helpers :as dsh]
|
||||
[app.main.data.modal :as modal]
|
||||
[app.main.data.notifications :as ntf]
|
||||
[app.main.data.project :as dpj]
|
||||
[app.main.data.team :as dtm]
|
||||
[app.main.data.websocket :as dws]
|
||||
[app.main.repo :as rp]
|
||||
[app.main.router :as rt]
|
||||
[app.main.store :as st]
|
||||
[app.util.i18n :as i18n :refer [tr]]
|
||||
[app.util.sse :as sse]
|
||||
@ -41,6 +43,8 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(declare fetch-projects)
|
||||
(declare fetch-recent-files)
|
||||
(declare refetch-placeholder-data)
|
||||
(declare process-message)
|
||||
|
||||
(defn initialize
|
||||
@ -63,6 +67,12 @@
|
||||
(->> stream
|
||||
(rx/filter (ptk/type? ::dws/opened))
|
||||
(rx/map #(dws/send initmsg)))
|
||||
(->> stream
|
||||
(rx/filter (ptk/type? ::dws/opened))
|
||||
;; One refetch of the data the placeholder waits for on
|
||||
;; every (re)connection, so a store that never took an
|
||||
;; answer during an outage recovers without a reload.
|
||||
(rx/map (fn [_] (refetch-placeholder-data team-id))))
|
||||
(->> stream
|
||||
(rx/filter (ptk/type? ::dws/message))
|
||||
(rx/map deref)
|
||||
@ -91,11 +101,12 @@
|
||||
(ptk/reify ::projects-fetched
|
||||
ptk/UpdateEvent
|
||||
(update [_ state]
|
||||
(reduce (fn [state {:keys [id] :as project}]
|
||||
;; Replace completely instead of merge to ensure deleted-at is removed
|
||||
(assoc-in state [:projects id] project))
|
||||
state
|
||||
projects))))
|
||||
(-> (reduce (fn [state {:keys [id] :as project}]
|
||||
;; Replace completely instead of merge to ensure deleted-at is removed
|
||||
(assoc-in state [:projects id] project))
|
||||
state
|
||||
projects)
|
||||
(update :dashboard-fetch-failures dissoc ::fetch-projects)))))
|
||||
|
||||
(defn fetch-projects
|
||||
[team-id]
|
||||
@ -103,7 +114,14 @@
|
||||
ptk/WatchEvent
|
||||
(watch [_ _ _]
|
||||
(->> (rp/cmd! :get-projects {:team-id team-id})
|
||||
(rx/map projects-fetched)))))
|
||||
(rx/map projects-fetched)
|
||||
(rx/timeout rp/fetch-timeout-ms
|
||||
(rx/throw (ex-info "fetch timeout" {:type :timeout})))
|
||||
(rx/catch (fn [cause]
|
||||
;; Resolve the placeholder into a failure state
|
||||
;; instead of leaving it spinning forever.
|
||||
(rx/of (fn [state]
|
||||
(assoc-in state [:dashboard-fetch-failures ::fetch-projects] cause)))))))))
|
||||
|
||||
;; --- EVENT: search
|
||||
|
||||
@ -140,7 +158,8 @@
|
||||
(let [files (d/index-by :id files)]
|
||||
(-> state
|
||||
(assoc :recent-files files)
|
||||
(update :files d/merge files))))))
|
||||
(update :files d/merge files)
|
||||
(update :dashboard-fetch-failures dissoc ::fetch-recent-files))))))
|
||||
|
||||
(defn fetch-recent-files
|
||||
([] (fetch-recent-files nil))
|
||||
@ -150,7 +169,31 @@
|
||||
(watch [_ state _]
|
||||
(when-let [team-id (or team-id (:current-team-id state))]
|
||||
(->> (rp/cmd! :get-team-recent-files {:team-id team-id})
|
||||
(rx/map recent-files-fetched)))))))
|
||||
(rx/map recent-files-fetched)
|
||||
(rx/timeout rp/fetch-timeout-ms
|
||||
(rx/throw (ex-info "fetch timeout" {:type :timeout})))
|
||||
(rx/catch (fn [cause]
|
||||
;; Resolve the placeholder into a failure state
|
||||
;; instead of leaving it spinning forever.
|
||||
(rx/of (fn [state]
|
||||
(assoc-in state [:dashboard-fetch-failures ::fetch-recent-files] cause)))))))))))
|
||||
|
||||
;; --- EVENT: refetch-placeholder-data
|
||||
|
||||
(defn- refetch-placeholder-data
|
||||
"One refetch of the data the dashboard placeholder waits for: the team
|
||||
projects and recent files, and the project files when the current
|
||||
screen shows a project."
|
||||
[team-id]
|
||||
(ptk/reify ::refetch-placeholder-data
|
||||
ptk/WatchEvent
|
||||
(watch [_ state _]
|
||||
(let [project-id (some-> (rt/get-params state) :project-id uuid/parse*)]
|
||||
(rx/concat
|
||||
(rx/of (fetch-projects team-id)
|
||||
(fetch-recent-files team-id))
|
||||
(when project-id
|
||||
(rx/of (dpj/fetch-files project-id))))))))
|
||||
|
||||
;; --- EVENT: fetch-template-files
|
||||
|
||||
|
||||
@ -62,6 +62,7 @@
|
||||
(update [_ state]
|
||||
(-> state
|
||||
(update :files merge (d/index-by :id files))
|
||||
(update :dashboard-fetch-failures dissoc ::fetch-files)
|
||||
(d/update-in-when [:projects project-id] (fn [project]
|
||||
(assoc project :count (count files))))))))
|
||||
|
||||
@ -73,7 +74,14 @@
|
||||
(watch [_ state _]
|
||||
(when-let [project-id (or project-id (:current-project-id state))]
|
||||
(->> (rp/cmd! :get-project-files {:project-id project-id})
|
||||
(rx/map (partial files-fetched project-id))))))))
|
||||
(rx/map (partial files-fetched project-id))
|
||||
(rx/timeout rp/fetch-timeout-ms
|
||||
(rx/throw (ex-info "fetch timeout" {:type :timeout})))
|
||||
(rx/catch (fn [cause]
|
||||
;; Resolve the placeholder into a failure state
|
||||
;; instead of leaving it spinning forever.
|
||||
(rx/of (fn [state]
|
||||
(assoc-in state [:dashboard-fetch-failures ::fetch-files] cause)))))))))))
|
||||
|
||||
|
||||
|
||||
|
||||
@ -215,7 +215,8 @@
|
||||
(rx/catch (fn [cause] (rx/of (refusal-notification cause (tr "workspace.branches.lifecycle.error")))))))))
|
||||
|
||||
(defn materialize-branch
|
||||
"Turn a branch into an ordinary file: `file-id` is the branch's FILE, and
|
||||
"Turn a branch into an ordinary file: `branch-file-id` is the branch's
|
||||
FILE (the id `create-file-branch` returns), not the branch row id, and
|
||||
the command persists the branch's derived state as the file's own data
|
||||
payload, drops the op log and clears the branch marker, so every later
|
||||
read and write takes the ordinary route. The content stays; what goes is
|
||||
@ -223,12 +224,12 @@
|
||||
merged into it. The branch row is soft-deleted, so refreshing the panel
|
||||
drops the row and refreshing the context drops the banner when the file
|
||||
that left the branch is the open one."
|
||||
[file-id]
|
||||
(assert (uuid? file-id) "expected valid uuid for `file-id`")
|
||||
[branch-file-id]
|
||||
(assert (uuid? branch-file-id) "expected valid uuid for `branch-file-id`")
|
||||
(ptk/reify ::materialize-branch
|
||||
ptk/WatchEvent
|
||||
(watch [_ _ _]
|
||||
(->> (rp/cmd! :materialize-file-branch {:file-id file-id})
|
||||
(->> (rp/cmd! :materialize-file-branch {:branch-file-id branch-file-id})
|
||||
(rx/mapcat (fn [_] (rx/of (ntf/success (tr "workspace.branches.materialize.success"))
|
||||
(fetch-branches)
|
||||
(fetch-branch-context))))
|
||||
|
||||
@ -59,6 +59,11 @@
|
||||
;; dashboard: open pull requests awaiting the current profile's review
|
||||
(l/derived #(get % :dashboard-pending-reviews) st/state))
|
||||
|
||||
(def fetch-failures
|
||||
;; dashboard: fetches that timed out or failed, keyed by fetch event;
|
||||
;; non-empty while the placeholder waits for data it will not get
|
||||
(l/derived #(get % :dashboard-fetch-failures) st/state))
|
||||
|
||||
(def team
|
||||
(l/derived dsh/lookup-team st/state))
|
||||
|
||||
|
||||
@ -46,6 +46,13 @@
|
||||
{:max-retries 3
|
||||
:base-delay-ms 1000})
|
||||
|
||||
(def fetch-timeout-ms
|
||||
"Milliseconds a fetch may stay unanswered before callers resolve it
|
||||
into a failure state. Conservative: an idempotent request retried
|
||||
under `default-retry-config` legitimately waits up to 15s in back-off
|
||||
alone, so the bound leaves room for the whole retry budget."
|
||||
30000)
|
||||
|
||||
(defn with-retry
|
||||
"Wrap `observable-fn` (a zero-arg function returning an Observable) so
|
||||
that retryable errors are retried up to `:max-retries` times with
|
||||
|
||||
@ -29,6 +29,7 @@
|
||||
[app.main.ui.dashboard.import]
|
||||
[app.main.ui.dashboard.layout-toggle :as lt]
|
||||
[app.main.ui.dashboard.libraries :refer [libraries-page*]]
|
||||
[app.main.ui.dashboard.placeholder :refer [loading-placeholder*]]
|
||||
[app.main.ui.dashboard.projects :refer [projects-section*]]
|
||||
[app.main.ui.dashboard.search :refer [search-page*]]
|
||||
[app.main.ui.dashboard.sidebar :refer [sidebar*]]
|
||||
@ -61,6 +62,8 @@
|
||||
|
||||
permissions (:permissions team)
|
||||
|
||||
failed? (boolean (seq (mf/deref refs/fetch-failures)))
|
||||
|
||||
default-project-id
|
||||
(get default-project :id)
|
||||
|
||||
@ -99,7 +102,7 @@
|
||||
|
||||
(case section
|
||||
:dashboard-recent
|
||||
(when (seq projects)
|
||||
(if (seq projects)
|
||||
[:*
|
||||
[:> projects-section* {:team team
|
||||
:projects projects
|
||||
@ -112,7 +115,10 @@
|
||||
:project-id project-id
|
||||
:team-id team-id
|
||||
:default-project-id default-project-id
|
||||
:content-width @content-width}])])
|
||||
:content-width @content-width}])]
|
||||
;; A failed fetch must stay visible instead of a blank section.
|
||||
(when ^boolean failed?
|
||||
[:> loading-placeholder*]))
|
||||
|
||||
:dashboard-fonts
|
||||
[:> fonts-page* {:team team}]
|
||||
@ -121,7 +127,7 @@
|
||||
[:> font-providers-page* {:team team}]
|
||||
|
||||
:dashboard-files
|
||||
(when project
|
||||
(if project
|
||||
[:*
|
||||
[:> files-section* {:team team
|
||||
:project project
|
||||
@ -132,7 +138,10 @@
|
||||
:team-id team-id
|
||||
:project-id project-id
|
||||
:default-project-id default-project-id
|
||||
:content-width @content-width}])])
|
||||
:content-width @content-width}])]
|
||||
;; A failed fetch must stay visible instead of a blank section.
|
||||
(when ^boolean failed?
|
||||
[:> loading-placeholder*]))
|
||||
|
||||
:dashboard-search
|
||||
[:> search-page* {:team team
|
||||
|
||||
@ -1,5 +1,5 @@
|
||||
;; This Source Code Form is subject to the terms of the Mozilla Public
|
||||
;; License, v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; License v. 2.0. If a copy of the MPL was not distributed with this
|
||||
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
|
||||
;;
|
||||
;; Copyright (c) KALEIDOS INC Sucursal en España SL
|
||||
@ -78,7 +78,13 @@
|
||||
:on-click on-open-branch}
|
||||
[:> i/icon* {:icon-id i/git-branch :size "s"}]
|
||||
[:span {:class (stl/css :branches-popover-name)} (:name b)]
|
||||
[:span {:class (stl/css :branches-popover-counts)}
|
||||
(dm/str "↑" (:ahead b) " ↓" (:behind b))]])]
|
||||
(if (or (:diff-error b) (nil? (:ahead b)))
|
||||
;; the comparison could not be made: the warning stands
|
||||
;; where the counts would, because zeros read as "in sync"
|
||||
[:span {:class (stl/css :branches-popover-error)
|
||||
:title (tr "workspace.branches.counts.error")}
|
||||
[:> i/icon* {:icon-id i/triangle-alert :size "s"}]]
|
||||
[:span {:class (stl/css :branches-popover-counts)}
|
||||
(dm/str "↑" (:ahead b) " ↓" (:behind b))])])]
|
||||
[:> button* {:variant "primary" :icon i/add :on-click on-create}
|
||||
(tr "workspace.branches.new")]]]]))
|
||||
|
||||
@ -84,3 +84,9 @@
|
||||
|
||||
color: var(--color-foreground-secondary);
|
||||
}
|
||||
|
||||
.branches-popover-error {
|
||||
display: inline-flex;
|
||||
align-items: center;
|
||||
color: var(--color-foreground-warning);
|
||||
}
|
||||
|
||||
@ -179,9 +179,12 @@
|
||||
loading? (and (some? (:count project))
|
||||
(not= (:count project) file-count))
|
||||
|
||||
failed? (boolean (seq (mf/deref refs/fetch-failures)))
|
||||
|
||||
empty-state-viewer (and (not can-edit?)
|
||||
(= 0 file-count)
|
||||
(not loading?))
|
||||
(not loading?)
|
||||
(not failed?))
|
||||
|
||||
selected-files (mf/deref refs/selected-files)
|
||||
|
||||
@ -233,7 +236,7 @@
|
||||
(tr "dashboard.empty-placeholder-drafts-subtitle")
|
||||
(tr "dashboard.empty-placeholder-files-subtitle"))}]
|
||||
[:> grid* {:project project
|
||||
:files (if loading? nil files)
|
||||
:files (if (or loading? (and failed? (empty? files))) nil files)
|
||||
:selected-files selected-files
|
||||
:can-edit can-edit?
|
||||
:origin :files
|
||||
|
||||
@ -8,8 +8,10 @@
|
||||
(:require-macros [app.main.style :as stl])
|
||||
(:require
|
||||
[app.main.data.event :as ev]
|
||||
[app.main.refs :as refs]
|
||||
[app.main.store :as st]
|
||||
[app.main.ui.dashboard.import :as udi]
|
||||
[app.main.ui.ds.notifications.context-notification :refer [context-notification*]]
|
||||
[app.main.ui.ds.product.empty-placeholder :refer [empty-placeholder*]]
|
||||
[app.main.ui.ds.product.loader :refer [loader*]]
|
||||
[app.main.ui.icons :as deprecated-icon]
|
||||
@ -135,8 +137,14 @@
|
||||
|
||||
(mf/defc loading-placeholder*
|
||||
[]
|
||||
[:> loader* {:width 32
|
||||
:title (tr "labels.loading")
|
||||
:class (stl/css :placeholder-loader)}
|
||||
[:span {:class (stl/css :placeholder-text)}
|
||||
(tr "dashboard.loading-files")]])
|
||||
(let [failures (mf/deref refs/fetch-failures)]
|
||||
(if (seq failures)
|
||||
;; A fetch that timed out or failed resolves the placeholder into
|
||||
;; a failure state instead of spinning forever.
|
||||
[:> context-notification* {:level :error}
|
||||
(tr "errors.unexpected-error")]
|
||||
[:> loader* {:width 32
|
||||
:title (tr "labels.loading")
|
||||
:class (stl/css :placeholder-loader)}
|
||||
[:span {:class (stl/css :placeholder-text)}
|
||||
(tr "dashboard.loading-files")]])))
|
||||
|
||||
@ -108,9 +108,12 @@
|
||||
loading? (and (pos? (:count project))
|
||||
(empty? files))
|
||||
|
||||
failed? (boolean (seq (mf/deref refs/fetch-failures)))
|
||||
|
||||
is-draft? (:is-default project)
|
||||
empty? (and (not can-edit)
|
||||
(= 0 file-count))
|
||||
(= 0 file-count)
|
||||
(not failed?))
|
||||
|
||||
dstate (mf/deref refs/dashboard-local)
|
||||
edit-id (:project-for-edit dstate)
|
||||
@ -311,7 +314,7 @@
|
||||
|
||||
[:> line-grid* {:project project
|
||||
:team team
|
||||
:files (if loading? nil files)
|
||||
:files (if (or loading? (and failed? (empty? files))) nil files)
|
||||
:create-fn create-file
|
||||
:can-edit can-edit
|
||||
:limit limit
|
||||
|
||||
@ -484,6 +484,18 @@
|
||||
:accept-style :primary
|
||||
:on-accept (fn [_] (st/emit! (dwb/update-branch-from-main branch)))})))
|
||||
|
||||
;; --- Diff counts: known, or honestly unknown
|
||||
;;
|
||||
;; A row whose comparison could not be made carries no counts at all (and
|
||||
;; the `:diff-error` marker), because zeros read as "in sync" and a
|
||||
;; branch that cannot be compared is not in sync. Every surface showing
|
||||
;; the counts shows the comparison warning in their place.
|
||||
|
||||
(defn- counts-error?
|
||||
[row]
|
||||
(or (:diff-error row)
|
||||
(nil? (:ahead row))))
|
||||
|
||||
;; --- Branch info dialog (read-only info card + editable description)
|
||||
|
||||
(mf/defc branch-info-dialog*
|
||||
@ -589,15 +601,20 @@
|
||||
[:div {:class (stl/css :info-row)}
|
||||
[:dt {:class (stl/css :info-key)} (tr "workspace.branches.info.changes")]
|
||||
[:dd {:class (stl/css :info-val :info-counts)}
|
||||
[:span {:class (stl/css :count-ahead)
|
||||
:title (tr "workspace.branches.counts.ahead")}
|
||||
[:> i/icon* {:icon-id i/arrow-up :size "s"}] (dm/str (:ahead branch 0))]
|
||||
[:span {:class (stl/css :count-behind)
|
||||
:title (tr "workspace.branches.counts.behind")}
|
||||
[:> i/icon* {:icon-id i/arrow-down :size "s"}] (dm/str (:behind branch 0))]
|
||||
(when (pos? (:conflicts branch 0))
|
||||
[:span {:class (stl/css :item-badge :badge-conflict)}
|
||||
(tr "workspace.branches.banner.conflicts" (dm/str (:conflicts branch)))])]])
|
||||
(if (counts-error? branch)
|
||||
[:span {:class (stl/css :count-error)
|
||||
:title (tr "workspace.branches.counts.error")}
|
||||
[:> i/icon* {:icon-id i/triangle-alert :size "s"}]]
|
||||
[:*
|
||||
[:span {:class (stl/css :count-ahead)
|
||||
:title (tr "workspace.branches.counts.ahead")}
|
||||
[:> i/icon* {:icon-id i/arrow-up :size "s"}] (dm/str (:ahead branch 0))]
|
||||
[:span {:class (stl/css :count-behind)
|
||||
:title (tr "workspace.branches.counts.behind")}
|
||||
[:> i/icon* {:icon-id i/arrow-down :size "s"}] (dm/str (:behind branch 0))]
|
||||
(when (pos? (:conflicts branch 0))
|
||||
[:span {:class (stl/css :item-badge :badge-conflict)}
|
||||
(tr "workspace.branches.banner.conflicts" (dm/str (:conflicts branch)))])])]])
|
||||
|
||||
(when (:merged-at branch)
|
||||
[:div {:class (stl/css :info-row)}
|
||||
@ -820,14 +837,19 @@
|
||||
[:div {:class (stl/css :branch-entry-aside)}
|
||||
(when (and (not archived?) (not main?))
|
||||
[:div {:class (stl/css :branch-entry-counts)}
|
||||
[:span {:class (stl/css :count-ahead)
|
||||
:title (tr "workspace.branches.counts.ahead")}
|
||||
[:> i/icon* {:icon-id i/arrow-up :size "s"}]
|
||||
(dm/str ahead)]
|
||||
[:span {:class (stl/css :count-behind)
|
||||
:title (tr "workspace.branches.counts.behind")}
|
||||
[:> i/icon* {:icon-id i/arrow-down :size "s"}]
|
||||
(dm/str behind)]])
|
||||
(if (counts-error? entry)
|
||||
[:span {:class (stl/css :count-error)
|
||||
:title (tr "workspace.branches.counts.error")}
|
||||
[:> i/icon* {:icon-id i/triangle-alert :size "s"}]]
|
||||
[:*
|
||||
[:span {:class (stl/css :count-ahead)
|
||||
:title (tr "workspace.branches.counts.ahead")}
|
||||
[:> i/icon* {:icon-id i/arrow-up :size "s"}]
|
||||
(dm/str ahead)]
|
||||
[:span {:class (stl/css :count-behind)
|
||||
:title (tr "workspace.branches.counts.behind")}
|
||||
[:> i/icon* {:icon-id i/arrow-down :size "s"}]
|
||||
(dm/str behind)]])])
|
||||
|
||||
(when-not main?
|
||||
[:> icon-button* {:variant "ghost"
|
||||
@ -843,7 +865,7 @@
|
||||
(when-not archived?
|
||||
[:> dropdown-menu-item* {:class (stl/css :menu-option) :on-click on-compare}
|
||||
(tr "workspace.branches.compare")])
|
||||
(when (and (not archived?) (pos? behind))
|
||||
(when (and (not archived?) (pos? (or behind 0)))
|
||||
[:> dropdown-menu-item* {:class (stl/css :menu-option) :on-click on-update}
|
||||
(tr "workspace.branches.update")])
|
||||
;; review lifecycle: a branch without an open pull request offers to
|
||||
@ -1515,25 +1537,6 @@
|
||||
(map? res) (get res attr)
|
||||
:else nil))
|
||||
|
||||
(defn- document-sides
|
||||
"Re-key one conflict from a `:main->branch` payload's role names to the two
|
||||
documents the resolution modal names, where `:main` holds the branch and
|
||||
`:branch` holds main (`branch-merge.cljc::compute-merge*` feeds the branch
|
||||
as `theirs` and main as `ours` in that direction, and
|
||||
`branch-merge.cljc::three-way-entities` writes `:main` for `theirs`). The
|
||||
base side, the id, the reason and the label read the same in both
|
||||
directions, as do the resolution keywords the commands take, so only the
|
||||
two sides and the values inside `:changed-attrs` move."
|
||||
[conflict]
|
||||
(let [swap (fn [sides] {:main (:branch sides) :branch (:main sides)})]
|
||||
(cond-> (assoc conflict
|
||||
:main (:branch conflict)
|
||||
:branch (:main conflict))
|
||||
(map? (:changed-attrs conflict))
|
||||
(assoc :changed-attrs (into {}
|
||||
(map (fn [[attr sides]] [attr (swap sides)]))
|
||||
(:changed-attrs conflict))))))
|
||||
|
||||
(mf/defc conflict-preview-row*
|
||||
"The BASE · MAIN · BRANCH · RESULT preview strip on top of the detail
|
||||
panel. RESULT updates live as per-property choices change."
|
||||
@ -1603,18 +1606,10 @@
|
||||
;; enable (vcs:tp-update-conflict-frame). Prefer what the command said.
|
||||
conflicts (if (seq conflicts) conflicts (:conflicts diff))
|
||||
|
||||
;; In update mode the payload's two sides arrive role-keyed rather than
|
||||
;; document-keyed: `branch-merge.cljc::compute-merge*` runs the
|
||||
;; `:main->branch` direction with the branch as `theirs` and main as
|
||||
;; `ours`, and `branch-merge.cljc::three-way-entities` names those
|
||||
;; `:main` and `:branch`. Every heading, chip and button below names
|
||||
;; the two documents, so an update hands the branch where the modal
|
||||
;; says main. Re-key the payload once, here: the mode-dependent
|
||||
;; mapping lives in this one binding. Resolutions stay in document
|
||||
;; terms, which is what both commands expect of them.
|
||||
conflicts (if (= mode :update)
|
||||
(mapv document-sides conflicts)
|
||||
conflicts)
|
||||
;; the payload's two sides are document-keyed in both directions:
|
||||
;; `:main` holds main's value and `:branch` the branch's
|
||||
;; (`branch-merge.cljc::compute-merge`), which is what every heading,
|
||||
;; chip and button below names. Resolutions use the same vocabulary.
|
||||
resolutions (or resolutions {})
|
||||
total (count conflicts)
|
||||
resolved (count (filterv #(bm/conflict-resolved? % (get resolutions (:id %))) conflicts))
|
||||
@ -1929,12 +1924,17 @@
|
||||
(let [conflicts (or (:conflicts ctx) 0)]
|
||||
[:div {:class (stl/css :branch-banner-actions)}
|
||||
[:span {:class (stl/css :branch-banner-counts)}
|
||||
[:span {:class (stl/css :count-ahead)
|
||||
:title (tr "workspace.branches.counts.ahead")}
|
||||
[:> i/icon* {:icon-id i/arrow-up :size "s"}] (dm/str (:ahead ctx))]
|
||||
[:span {:class (stl/css :count-behind)
|
||||
:title (tr "workspace.branches.counts.behind")}
|
||||
[:> i/icon* {:icon-id i/arrow-down :size "s"}] (dm/str (:behind ctx))]]
|
||||
(if (counts-error? ctx)
|
||||
[:span {:class (stl/css :count-error)
|
||||
:title (tr "workspace.branches.counts.error")}
|
||||
[:> i/icon* {:icon-id i/triangle-alert :size "s"}]]
|
||||
[:*
|
||||
[:span {:class (stl/css :count-ahead)
|
||||
:title (tr "workspace.branches.counts.ahead")}
|
||||
[:> i/icon* {:icon-id i/arrow-up :size "s"}] (dm/str (:ahead ctx))]
|
||||
[:span {:class (stl/css :count-behind)
|
||||
:title (tr "workspace.branches.counts.behind")}
|
||||
[:> i/icon* {:icon-id i/arrow-down :size "s"}] (dm/str (:behind ctx))]])]
|
||||
|
||||
(when (pos? conflicts)
|
||||
[:span {:class (stl/css :item-badge :badge-conflict)}
|
||||
@ -1952,7 +1952,7 @@
|
||||
:on-click on-resolve}
|
||||
(tr "workspace.branches.conflicts.resolve")]
|
||||
|
||||
(pos? (:behind ctx))
|
||||
(pos? (or (:behind ctx) 0))
|
||||
[:> button* {:variant "primary"
|
||||
:icon i/status-update
|
||||
:on-click on-update}
|
||||
@ -1966,13 +1966,13 @@
|
||||
:on-click on-open-review}
|
||||
(tr "workspace.pull-requests.actions.open-review")]
|
||||
|
||||
(and prs-enabled? (pos? (:ahead ctx)))
|
||||
(and prs-enabled? (pos? (or (:ahead ctx) 0)))
|
||||
[:> button* {:variant "primary"
|
||||
:icon i/git-pull-request-arrow
|
||||
:on-click on-request-review}
|
||||
(tr "workspace.pull-requests.menu.request-review")]
|
||||
|
||||
(pos? (:ahead ctx))
|
||||
(pos? (or (:ahead ctx) 0))
|
||||
[:> button* {:variant "primary"
|
||||
:icon i/git-merge
|
||||
:on-click on-merge}
|
||||
|
||||
@ -204,6 +204,12 @@
|
||||
color: var(--color-accent-primary);
|
||||
}
|
||||
|
||||
.count-error {
|
||||
display: inline-flex;
|
||||
align-items: center;
|
||||
color: var(--color-foreground-warning);
|
||||
}
|
||||
|
||||
// --- Create branch dialog
|
||||
|
||||
.modal-overlay {
|
||||
|
||||
@ -10,6 +10,7 @@
|
||||
[app.config :as cf]
|
||||
[app.main.data.common :as dcm]
|
||||
[app.main.data.dashboard :as dd]
|
||||
[app.main.data.project :as dpj]
|
||||
[app.main.data.websocket :as dws]
|
||||
[app.main.repo :as rp]
|
||||
[app.main.router :as rt]
|
||||
@ -130,3 +131,80 @@
|
||||
(await (async/observe (ptk/watch (dd/initialize team-id) state stream)
|
||||
:on-next #(swap! processed conj (ptk/type %))))))
|
||||
(t/is (= 1 (count (filter #{::dcm/handle-organization-change-sso} @processed))))))
|
||||
|
||||
(t/deftest never-answering-recent-files-fetch-resolves-placeholder-to-failure
|
||||
(t/async done
|
||||
(let [team-id (uuid/next)
|
||||
state {:current-team-id team-id}]
|
||||
(mock/with-mocks
|
||||
{rp/fetch-timeout-ms 50
|
||||
rp/cmd! (mock/stub (fn [_ _] (rx/subject)))}
|
||||
(fn [done']
|
||||
(->> (ptk/watch (dd/fetch-recent-files team-id) state nil)
|
||||
(rx/reduce (fn [state event] (ptk/update event state)) state)
|
||||
;; The guard fails the test instead of spinning when no
|
||||
;; failure state arrives within the bound.
|
||||
(rx/timeout 1000 (rx/throw (ex-info "no failure state within the bound" {})))
|
||||
(rx/subs!
|
||||
(fn [state]
|
||||
(t/is (contains? (:dashboard-fetch-failures state) ::dd/fetch-recent-files)
|
||||
"the placeholder resolves into a failure state"))
|
||||
(fn [cause]
|
||||
(t/is false (str "unexpected error: " cause))
|
||||
(done'))
|
||||
(fn []
|
||||
(done')))))
|
||||
done))))
|
||||
|
||||
(t/deftest never-answering-project-files-fetch-resolves-placeholder-to-failure
|
||||
(t/async done
|
||||
(let [project-id (uuid/next)
|
||||
state {}]
|
||||
(mock/with-mocks
|
||||
{rp/fetch-timeout-ms 50
|
||||
rp/cmd! (mock/stub (fn [_ _] (rx/subject)))}
|
||||
(fn [done']
|
||||
(->> (ptk/watch (dpj/fetch-files project-id) state nil)
|
||||
(rx/reduce (fn [state event] (ptk/update event state)) state)
|
||||
(rx/timeout 1000 (rx/throw (ex-info "no failure state within the bound" {})))
|
||||
(rx/subs!
|
||||
(fn [state]
|
||||
(t/is (contains? (:dashboard-fetch-failures state) ::dpj/fetch-files)
|
||||
"the placeholder resolves into a failure state"))
|
||||
(fn [cause]
|
||||
(t/is false (str "unexpected error: " cause))
|
||||
(done'))
|
||||
(fn []
|
||||
(done')))))
|
||||
done))))
|
||||
|
||||
(t/deftest websocket-reconnect-refetches-placeholder-data
|
||||
(t/async done
|
||||
(let [team-id (uuid/next)
|
||||
project-id (uuid/next)
|
||||
calls (atom [])
|
||||
state {:current-team-id team-id
|
||||
:route {:params {:query {:project-id (str project-id)}}}}
|
||||
store (ptk/store {:state state
|
||||
:on-error (fn [cause] (t/is false (str cause)))})]
|
||||
(mock/with-mocks
|
||||
{rp/cmd! (mock/stub (fn [cmd params]
|
||||
(swap! calls conj [cmd params])
|
||||
(rx/of nil)))}
|
||||
(fn [done']
|
||||
(ptk/emit! store (dd/initialize team-id))
|
||||
(ptk/emit! store (ptk/data-event ::dws/opened {}))
|
||||
(t/is (= 2 (count (filter #(= :get-projects (first %)) @calls)))
|
||||
"the reconnect refetches the team projects exactly once")
|
||||
(t/is (= 1 (count (filter #(= :get-team-recent-files (first %)) @calls)))
|
||||
"the reconnect refetches the recent files exactly once")
|
||||
(t/is (= 1 (count (filter #(= :get-project-files (first %)) @calls)))
|
||||
"the reconnect refetches the project files exactly once")
|
||||
(t/is (= [{:project-id project-id}]
|
||||
(into [] (comp (filter #(= :get-project-files (first %)))
|
||||
(map second))
|
||||
@calls))
|
||||
"the refetched project files are the ones the placeholder waits for")
|
||||
(rx/dispose! store)
|
||||
(done'))
|
||||
done))))
|
||||
|
||||
@ -6696,6 +6696,10 @@ msgstr ""
|
||||
"(shapes, pages, components, colours, typographies, media, and tokens), not "
|
||||
"saves."
|
||||
|
||||
#: src/app/main/ui/workspace/sidebar/branches.cljs:606, src/app/main/ui/workspace/sidebar/branches.cljs:842, src/app/main/ui/workspace/sidebar/branches.cljs:1956, src/app/main/ui/dashboard/branches_popover.cljs:85
|
||||
msgid "workspace.branches.counts.error"
|
||||
msgstr "Couldn't compare this branch with main"
|
||||
|
||||
#: src/app/main/ui/workspace/sidebar/branches.cljs:299
|
||||
msgid "workspace.branches.create.derive-from"
|
||||
msgstr "Derive from"
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user