github/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2026-11-02 16:10:42 +00:00
Code Issues Packages Projects Releases Wiki Activity

✨ Keep the valid commits of a save that fails validation

Browse Source 
A save whose changes failed validation was rejected as a whole: autosave
stopped, the edits made after it piled up unsent, and a reload lost
them all, the valid ones included.

The frontend now sends each commit of a save as its own group with its
commit id (:changes-with-metadata). When applying and validating all of
them at once fails, the backend searches by bisection for the first
commit that fails, keeps the commits before it and answers with
:rejected (that commit and every later one). Only the kept changes are
stored, snapshotted and broadcast, so other users never see the rejected
ones. Flat :changes and groups without ids stay all-or-nothing; database
and network errors still fail the whole request. A rejection without an
error type is reported as an internal error.

The frontend rolls the file back to what the server holds: it undoes
every pending commit of that file, applies again the remote changes that
arrived meanwhile, and redoes the kept commits. Undoing only the
rejected commits would write stale values over a peer's later change to
the same attribute. The rejected and later commits leave the queue, the
buffer and the undo history, and a warning that hides after ten seconds
tells the user. The pure bookkeeping lives in
app.main.data.persistence.commits.

The pending notice of a commit the rollback dropped no longer leaves the
save status at pending, which made "Pin this version" hang and fail.

Debug tools drive these cases by hand: debug.commitInvalidChange() makes a
save fail validation, holdSaves() delays the answers, failNextSave() and
failNextRollback() fail them on purpose (backend flag debug-save-faults),
and persistenceState() shows the queue.
This commit is contained in:
alonso.torres 2026-10-16 15:58:17 +02:00
parent 46f66517de
commit 4ffc598de7
23 changed files with 2391 additions and 198 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.serena/memories/backend/subtleties.md
View File

@ -89,3 +89,4 @@
- Revisions live only in `file_change` and have no `file_data` counterpart. They are born already scheduled for deletion one hour later (`app.rpc.commands.files-update`) and the snapshot paths cannot reach one, because they resolve their row through a `label IS NOT NULL` filter.
- A deletion date is assigned once and never moved: `restore-files` (`app.rpc.commands.files`) unmarks only durable history, the `:file` method of `app.tasks.delete-object` dates only rows that have no date yet, and `objects-gc` collects only rows that carry one. Unmarking a revision leaves it invisible to `objects-gc` for ever, because nothing sets that date again.
- Binfile v1/v3 import and the v3 export `get-file` step run inside one long transaction. They raise `idle_in_transaction_session_timeout` to 30 min (`app.binfile.common/transaction-idle-timeout-ms`) instead of disabling it, so a connection left idle while the ZIP is decoded or the file data is realized is bounded; `statement_timeout` stays at 300 s.
- `update-file` with `:changes-with-metadata` groups that all carry `:commit-id` is partial: fast path applies and validates everything once; on a change failure it bisects the commits for the longest prefix that applies and validates (each attempt applies a prefix from the original data and runs referential integrity + file schema; ~log2 K attempts, none for a single commit, the first attempt's error reused), keeping that prefix (a commit that repairs an earlier one can keep both) and answering 200 with `:rejected {:commit-ids :failed-commit-id :error}`. Only accepted changes reach `file_change`, persistence and the msgbus; a fully rejected request writes and broadcasts nothing (revn unchanged). Flat `:changes` or groups without ids stay all-or-nothing. Before each attempt (`apply-prefix`, which returns `{:file :tracked :refs}` or the cause) `pmap/*tracked*` and the `cpc/*state*` atom are reset to their pre-attempt values (at the end `apply-commits` sets those of the kept prefix): a pointer map already `modified?` keeps its id when changed again, so the failed version would be persisted. DB/IO/interrupt errors and `:not-found` fragments (`change-failure?`) fail the whole request, never reject a commit. With a schema check running (hard schema validation without skip-validate, or soft) and 2+ commits, the touched pages' objects are decoded on the original file first (`decode-objects`; referential validation alone reads few objects, so no pre-decode then): objects-map caches decoded values per instance and a derived map copies the cache, so otherwise every attempt re-decodes the page (~260 ms at 10k shapes). Validation step timings (`with-validation-timing`, upstream `penpot_rpc_update_file_validation_timing` + the `update-file` debug log) come from the first attempt only (retries run with a cfg without metrics and timings); the whole bisection is one `retry` step sample, and the rejection log carries `:attempts`/`:elapsed`.

17
.serena/memories/frontend/cljs-repl.md
View File

@ -49,16 +49,23 @@ Get `team-id` from `(:current-team-id @app.main.store/state)`. Get file ids from
## Runtime patching with `set!`
Some frontend vars are deliberately mutable escape hatches for runtime instrumentation or circular-dependency patching. From `cljs_repl`, use `set!` for temporary debugging of CLJS vars such as `app.main.store/on-event`, `app.main.errors/reload-file`, `app.main.errors/is-plugin-error?`, `app.main.errors/last-report`, or `app.main.errors/last-exception`. These patches affect only the live browser runtime and disappear on reload or recompilation.
Some frontend vars are deliberately mutable escape hatches for runtime instrumentation or circular-dependency patching. From `cljs_repl`, use `set!` for temporary debugging of CLJS vars such as `app.main.errors/reload-file`, `app.main.errors/is-plugin-error?`, `app.main.errors/last-report`, or `app.main.errors/last-exception`. These patches affect only the live browser runtime and disappear on reload or recompilation.
`set!` on `app.main.store/on-event` does nothing at runtime: the store captured the function when it was created. To watch events, subscribe to the store stream and dispose the subscription after:
```clojure
;; Log non-noisy Potok events temporarily.
(set! app.main.store/on-event
(fn [event]
(when (potok.v2.core/event? event)
(.log js/console (potok.v2.core/repr-event event)))))
(def sub
(beicon.v2.core/subs!
(fn [event]
(when (potok.v2.core/event? event)
(.log js/console (potok.v2.core/repr-event event))))
app.main.store/stream))
;; (beicon.v2.core/dispose! sub)
```
`cljs_repl` starts every call in `cljs.user`; begin a call with `(in-ns 'my-ns)` to reuse helpers defined in another namespace.
Restore mutable hooks after debugging, or reload the frontend. Use JVM `alter-var-root` only for JVM Clojure; it is not the normal way to patch live CLJS browser vars.
## Browser-console debug namespace

10
.serena/memories/frontend/workspace-state-persistence-subtleties.md
View File

@ -14,18 +14,20 @@
- `repo/retryable-types` is public and is the single source of truth for the transient transport classification. `persistence/transient-error?` and `errors/environment-error-types` both derive from it; extend that set, never copy it.
- GET retry is limited to transient `:network`, `:bad-gateway`, `:service-unavailable`, `:gateway-error` (504, Cloudflare 52x), and `:offline` errors with exponential backoff. Mutations are not retried.
- A server SSE response is only accepted when the command is configured `:stream?`; otherwise it raises an unexpected-response assertion.
- `rp/cmd!` is a multimethod: to spy on a command from the REPL, `defmethod` it around `(get-method rp/cmd! :default)` and `remove-method` after; `set!` on the var or its arity property breaks every call.
## Commits, undo, persistence
- `commit-changes` refuses to create commits unless `:permissions :can-edit` is true. It captures file revn/vern, selected-before, features, tags, undo group, and translation flag into a `::commit` event. A refusal answers with an empty stream, never nil, so callers subscribe uniformly instead of branching on nil.
- Applying a remote commit first rolls back pending local commits (queued entries, then `[:persistence :buffer]`), applies the remote changes, then replays pending local redo changes. Index updates are emitted for undo, remote redo, and replayed redo paths. Leaving the buffer out makes a remote change to the same attr win locally but lose on the server.
- Applying a remote commit first rolls back the pending local commits of its own file (`pcm/pending-commits`: queued entries, then `[:persistence :buffer]`; other files' commits never touch its data), applies the remote changes, then replays pending local redo changes. Index updates are emitted for undo, remote redo, and replayed redo paths. Leaving the buffer out makes a remote change to the same attr win locally but lose on the server.
- Local commits are independently consumed by undo, persistence, WASM model updates, thumbnail/library watchers, and text position-data recalculation.
- Persistence buffers local commits in the store (`buffer-commit` → `[:persistence :buffer]`): status becomes pending after about 200ms; the 3s debounce or `::force-persist` emits `flush-buffer`, which merges the buffer per file into `append-commit`s, and each append removes its own commits from the buffer (a commit arriving mid-flush stays). `initialize-persistence-state` flushes a leftover buffer. Queue entries keep `:commits` (id, origin, undo-group, redo/undo changes of each merged commit) next to the merged change lists; the merged `:undo-changes` are in forward commit order, so undo per commit through `:commits`.
- Persistence buffers local commits in the store (`buffer-commit` → `[:persistence :buffer]`, stamped with `:remote-seq`): status becomes pending after about 200ms; the 3s debounce or `::force-persist` emits `flush-buffer`, which merges the buffer per file into `append-commit`s, and each append removes its own commits from the buffer (a commit arriving mid-flush stays). `initialize-persistence-state` flushes a leftover buffer. Queue entries (`pcm/queue-entry`) hold the entry keys of the first commit (id, created-at, origin, features, file-id/revn/vern) and `:commits` (id, origin, undo-group, redo/undo changes, remote-seq of each merged commit), no merged change lists; every reader goes through `:commits`. The save sends `:changes-with-metadata`, one group per commit with `:commit-id`, never flat `:changes`.
- A save answered with `:rejected` (backend kept the commits before the first failing one, see `mem:backend/subtleties`) is not a failure: `rollback-rejected` runs before `commit-persisted`. The unit is the undo group (one user action, which can commit to several files, e.g. `update-component` writes the copy's file and the library, and `component-changed` syncs inherit the edit's group; multi-file actions must share a non-nil group): the pure bookkeeping lives in `app.main.data.persistence.commits` (`pcm`): `pcm/rollback-plan` reverts, in the saved file, the pending commits from the first rejected one on, and in any file the pending commits from the first one of a reverted group on, iterating until no new group appears; other files' unrelated commits stay. `pcm/without-rolled-back` drops pending reverted commits from queue entries (partial entries trimmed, empty ones leave the queue) and the buffer; saved commits of a reverted group (the head's kept ones, and `:saved`, which `keep-saved-commits` fills on `discard-commit` with saved commits whose group a pending commit still shares) are undone by a new `save-undo? false` commit (`compensate-commits`, flushed like any edit); for a file whose data is not loaded the undo goes straight to the queue as an entry, nothing applied locally. Per file, `dch/rebase-commits` undoes every pending commit newest first, re-applies the remote changes kept since the oldest pending commit, and redoes the pending commits that stay. Undo changes hold absolute values from commit time, so undoing only the rejected commits would overwrite a peer's later change to the same attr. Remote changes are numbered (`record-remote-changes`, `[:persistence :remote-seq]`) and kept per file under `:remote-changes` only while the file has pending commits; `prune-remote-changes` (discard, release) forgets those at or below the oldest pending stamp, since re-applying them would undo saved edits. Then `dwu/forget-undo-groups` (cut history before the first entry of a reverted commit's undo-group; no match clears it; open transaction emptied), selection pruned and edition mode left when the edited shape is gone (`prune-removed-shapes`; `v2-update-text-shape-content` also skips a missing shape, so the editor's exit commits nothing), `errors/flash` `:unhandled` sticky toast tagged `:persistence-rejected`. `rebase-commits` is not a commit (not saved/broadcast/undoable, commit watchers such as thumbnails do not see it) and falls back to `::dw/reload-current-file` if applying throws. `debug.commitInvalidChange({kind, before, after})` forces such a rejection live.
- Persistence sends revn as the max of the commit revn and locally tracked latest revn; remote commits update that revn tracker.
- Persistence is skipped in version preview/read-only mode or without edit permission.
- A terminal failure halts the queue on purpose: the edits stay queued so `wait-persisted-or-error` keeps rejecting, and `workspace/versions.cljs` relies on that to avoid snapshotting a file whose edits were never saved. `recover-persistence` lifts the halt when a file is opened again or the role changes. A transport failure still inside its retry window (`slow-retry-pending?`) is resent once (`resume-persistence true`), never released; any other halt emits `release-failed-file` (drops every queued commit of the file that failed) then `resume-persistence`. Opening a file also replays the queued edits of its version onto the loaded data (`pending-file-changes` → `restore-pending-changes` in `bundle-fetched`); a replay that throws keeps the server data and the queue. That is what unblocks the editor without a reload; because the queue is shared, dropping the failed file is also what lets other files' pending edits drain. `release-failed-file` runs at recovery time, never at failure time — clearing the error eagerly would make waiters resolve.
- A terminal failure halts the queue on purpose: the edits stay queued so `wait-persisted-or-error` keeps rejecting, and `workspace/versions.cljs` relies on that to avoid snapshotting a file whose edits were never saved. `recover-persistence` lifts the halt when a file is opened again or the role changes. A transport failure still inside its retry window (`slow-retry-pending?`) is resent once (`resume-persistence true`), never released; any other halt emits `release-failed-file` (drops every queued commit of the file that failed) then `resume-persistence`. Opening a file also replays the queued, then buffered, edits of its version onto the loaded data (`pending-file-changes` → `restore-pending-changes` in `bundle-fetched`); a replay that throws keeps the server data and the queue. That is what unblocks the editor without a reload; because the queue is shared, dropping the failed file is also what lets other files' pending edits drain. `release-failed-file` runs at recovery time, never at failure time — clearing the error eagerly would make waiters resolve.
- The split between `initialize-persistence-state` and `recover-persistence` is deliberate: initialization deliberately does NOT lift a halt, so undeliverable edits are released when the user acts, not when the view mounts.
- **Every non-transport terminal save failure is permanent.** There is no "stale but valid" category: permission lost, file gone, and server-rejected changes all fail again on a resend. Losing edit permission is not temporary — the backend raises `:not-found` for it (`check-edition-permissions!` → `perms/make-check-fn`), and `:not-found` routes to the exception page. So `:save-permission-denied` (a client-side `can-edit` check) must never be resumed: replaying the save to discover that routes the user to the exception page. Release it instead.
- **Every non-transport terminal save failure is permanent** (a backend without commit-id groups still answers an invalid batch with a terminal `:validation`). There is no "stale but valid" category: permission lost, file gone, and server-rejected changes all fail again on a resend. Losing edit permission is not temporary — the backend raises `:not-found` for it (`check-edition-permissions!` → `perms/make-check-fn`), and `:not-found` routes to the exception page. So `:save-permission-denied` (a client-side `can-edit` check) must never be resumed: replaying the save to discover that routes the user to the exception page. Release it instead.
- Save failures split transient vs terminal (`transient-error?`: the repo retryable types `:network`/`:offline`/`:bad-gateway`/`:service-unavailable`/`:gateway-error`, plus `:invalid-save-response`, plus save-only `busy-server-error?`: `:rate-limit` (429 from rlimit/climit — a save parked on another save's file lock holds the profile's single `:update-file/by-profile` permit, so the user's saves to other files 429 after 60 s) and backend-written 504 `:server-error` with `:statement-timeout`/`:idle-in-transaction-timeout` (Postgres cancels the lock wait at 300 s, before nginx; rolled back, so resend is safe). Kept out of `rp/retryable-types` on purpose so GETs do not retry them; everything else is terminal). Terminal keeps the `:error` halt + `flash-persistence` path; transient enters a `:retrying` episode: the head commit stays queued and resends with backoff 2s/8s/20s (3 retries, then the `:error` path). A transient failure that outlasts the backoff arms `slow-retry-cycle`: one silent resend (`:recovering`) every `slow-retry-delay-ms` (30s) until a save lands, `retry-give-up-ms` (24h since `:failing-since`) passes, or the head commit collects `max-slow-failures` (3) attempts that failed after `slow-failure-ms` (90s) or more (`:slow-failures`, counted in `persistence-transient-failure` from the attempt's elapsed time): a gateway timeout may leave the backend applying the save, so a save that keeps failing slowly must not be replayed for a day, while fast failures (offline) never count; the cycle stops on `::resume-persistence`, `::initialize-persistence` and `finalize-workspace`. Leaving the workspace also emits `suspend-retries` (`:suspended` in `:persistence`, drops `:retry-token` so a pending backoff timer goes stale): no backoff, slow cycle or `online` resend runs outside the workspace; only `workspace-initialized` (not a role change) lifts it via `recover-persistence` (`opened-file?`), which also resends a `:retrying` episode whose backoff was cut short. Its toast is `errors.save-still-retrying` without a reload link; a landing save hides the failure toast (`errors/persistence-failed-tag`). Replaying a save is safe because changes are idempotent, so there is no unknown-outcome guard: a commit whose earlier request left `active-requests` is simply sent again under the same `:commit-id`; only a request still in flight blocks a resend (`:in-flight` stays silent). Tests hold the slow cycle by stubbing `rx/timer` to never fire for `slow-retry-delay-ms`, or instant timers loop forever. Retry timers carry the episode token; a superseded token stays silent. Status stays `:retrying` through re-entries (`next-status` refuses `:pending`/`:saving` from it); waiters (`wait-persisted-or-error`) wait through it and reject only on `:error`.
- One reconnect notice per episode: sticky toast tagged `:persistence-reconnecting` (single-toast store, re-show replaces), hidden by tag on drain (`:saved`) and on terminal failure; recovery is silent. Header indicator has a `:retrying` state (`workspace.header.retrying`).
- Resume triggers: backoff timer and the browser `online` event (guarded by `exists? js/window`; re-enters the runner only for a live `:retrying` episode). New local edits during `:retrying` only join the queue: the episode keeps its `:run-id`, so `append-commit` does not re-enter, and the live runner (still waiting on the head's `commit-persisted`) sends them after the head. Re-entering on edits would bypass the backoff and spend an attempt per batched commit.

1
backend/scripts/_env
View File

@ -62,6 +62,7 @@ export PENPOT_FLAGS="\
disable-tiered-file-data-storage \
enable-file-validation \
enable-file-schema-validation \
enable-debug-save-faults \
enable-redis-cache \
enable-link-preview \
enable-subscriptions";

394
backend/src/app/rpc/commands/files_update.clj
View File

@ -37,7 +37,8 @@
[app.util.blob :as blob]
[app.util.pointer-map :as pmap]
[app.util.services :as sv]
[clojure.set :as set]))
[clojure.set :as set]
[cuerdas.core :as str]))
(declare ^:private get-lagged-changes)
(declare ^:private send-notifications!)
@ -67,19 +68,36 @@
[:changes-with-metadata {:optional true}
[:vector [:map
[:changes [:vector cpc/schema:change]]
[:commit-id {:optional true} ::sm/uuid]
[:hint-origin {:optional true} :keyword]
[:hint-events {:optional true} [:vector [:string {:max 250}]]]]]]
[:skip-validate {:optional true} ::sm/boolean]])
(def ^:private
schema:update-file-result
[:vector {:title "update-file-result"}
[:map
[:changes [:vector cpc/schema:change]]
[:file-id ::sm/uuid]
[:id ::sm/uuid]
[:revn {:min 0} ::sm/int]
[:session-id ::sm/uuid]]])
[:map {:title "update-file-result"}
;; The revision the file had before this update
[:revn {:min 0} ::sm/int]
;; Every change stored after the incoming revision, this one included
[:lagged
[:vector
[:map
[:changes [:vector cpc/schema:change]]
[:file-id ::sm/uuid]
[:id ::sm/uuid]
[:revn {:min 0} ::sm/int]
[:session-id ::sm/uuid]]]]
;; Commits not saved: the first one that failed and every later one
[:rejected {:optional true}
[:map
[:commit-ids [:vector ::sm/uuid]]
[:failed-commit-id ::sm/uuid]
[:error
[:map
[:type :keyword]
[:code {:optional true} [:maybe :keyword]]
[:hint {:optional true} [:maybe :string]]
[:details {:optional true} [:vector :any]]]]]]])
;; --- HELPERS
@ -161,12 +179,18 @@
(->> changes-with-metadata (mapcat :changes) vec)
(vec changes))
;; Saved commit by commit only when every group names its commit
commits (when (and (seq changes-with-metadata)
(every? :commit-id changes-with-metadata))
changes-with-metadata)
params (-> params
(assoc :profile-id profile-id)
(assoc :features (set/difference features cfeat/frontend-only-features))
(assoc :team team)
(assoc :file file)
(assoc :changes changes))
(assoc :changes changes)
(assoc :commits commits))
cfg (assoc cfg ::timestamp (ct/now)
::validation-timings (atom {}))
@ -253,7 +277,7 @@
Only intended for internal use on this module."
[{:keys [::db/conn ::timestamp] :as cfg}
{:keys [profile-id file team features changes session-id skip-validate] :as params}]
{:keys [profile-id file team features changes commits session-id skip-validate] :as params}]
(binding [pmap/*tracked* (pmap/create-tracked)
pmap/*load-fn* (partial fdata/load-pointer cfg (:id file))]
@ -272,47 +296,57 @@
cfeat/*previous* (:features file)]
(update-file-data! cfg file
process-changes-and-validate
changes skip-validate))
changes commits skip-validate))
;; Only the accepted changes are stored and broadcast
changes (::changes file)
rejected (::rejected file)
params (assoc params :changes changes)
file (dissoc file ::changes ::rejected)
;; A request whose first commit is rejected leaves the file as is
saved? (or (nil? rejected) (seq changes))
snapshot (when saved? (::snapshot file))
deleted-at
(ct/plus timestamp (ct/duration {:hours 1}))]
(when-let [file (::snapshot file)]
(let [deleted-at (ct/plus timestamp (ldel/get-deletion-delay team))
label (str "internal/snapshot/" revn)]
(when snapshot
(fsnap/create! cfg snapshot
{:label (str "internal/snapshot/" revn)
:created-by "system"
:deleted-at (ct/plus timestamp (ldel/get-deletion-delay team))
:profile-id profile-id
:session-id session-id}))
(fsnap/create! cfg file
{:label label
:created-by "system"
:deleted-at deleted-at
:profile-id profile-id
:session-id session-id})))
(when saved?
;; Insert change (xlog) with deleted_at in a future data for
;; make them automatically eleggible for GC once they expires
(db/insert! conn :file-change
{:id (uuid/next)
:session-id session-id
:profile-id profile-id
:created-at timestamp
:updated-at timestamp
:deleted-at deleted-at
:file-id (:id file)
:revn (:revn file)
:version (:version file)
:features (into-array (:features file))
:changes (blob/encode changes)}
{::db/return-keys false})
;; Insert change (xlog) with deleted_at in a future data for
;; make them automatically eleggible for GC once they expires
(db/insert! conn :file-change
{:id (uuid/next)
:session-id session-id
:profile-id profile-id
:created-at timestamp
:updated-at timestamp
:deleted-at deleted-at
:file-id (:id file)
:revn (:revn file)
:version (:version file)
:features (into-array (:features file))
:changes (blob/encode changes)}
{::db/return-keys false})
(persist-file! cfg file)
(persist-file! cfg file)
(when (contains? cf/flags :redis-cache)
(invalidate-caches! cfg file))
(when (contains? cf/flags :redis-cache)
(invalidate-caches! cfg file))
;; Send asynchronous notifications
(send-notifications! cfg params file))
;; Send asynchronous notifications
(send-notifications! cfg params file)
(with-meta {:revn revn :lagged (get-lagged-changes conn params)}
(with-meta (cond-> {:revn revn :lagged (get-lagged-changes conn params)}
(some? rejected)
(assoc :rejected rejected))
{::audit/replace-props
{:id (:id file)
:name (:name file)
@ -324,7 +358,7 @@
;; `modified-at` mirrors `persist-file!`: same `::timestamp`
;; fallback, so both agree to the millisecond when the
;; request timestamp exists.
:revn (:revn file)
:revn (if saved? (:revn file) revn)
:modified-at (or timestamp (ct/now))}}))))
(defn get-file
@ -434,23 +468,197 @@
(l/error :hint "file validation error"
:cause cause))))
(defmacro ^:private with-validation-timing
"Runs `body` and records its time as the validation step `step-key`
(`step-label` in the metric), also when it throws."
[cfg step-key step-label & body]
`(let [t# (ct/tpoint)]
(try
~@body
(finally
(record-validation-timing ~cfg ~step-key ~step-label (inst-ms (t#)))))))
(defn- validate-file
"Validates the entities affected by `changes` and the file schema."
[cfg file libs changes skip-validate]
(binding [pmap/*tracked* nil]
(when (contains? cf/flags :soft-file-validation)
(with-validation-timing cfg :soft-validate-affected-ms "soft-validate-affected"
(soft-validate-file! file libs changes)))
(when (contains? cf/flags :soft-file-schema-validation)
(with-validation-timing cfg :soft-validate-schema-ms "soft-validate-schema"
(soft-validate-file-schema! file)))
(when (and (contains? cf/flags :file-validation)
(not skip-validate))
(with-validation-timing cfg :validate-affected-ms "validate-affected"
(val/validate-file-affected! file libs changes)))
(when (and (contains? cf/flags :file-schema-validation)
(not skip-validate))
(with-validation-timing cfg :validate-schema-ms "validate-schema"
(val/validate-file-schema! file)))))
(def ^:private debug-fault-prefix
"Start of the plugin data key that asks for a debug save fault."
"save-fault:")
(defn- get-debug-fault
"Name of the fault a debug marker in `changes` asks for, or nil. A marker
is a `:set-plugin-data` of the file in the `:penpot-debug` namespace with
no value, so applying it changes nothing."
[changes]
(some (fn [{:keys [type namespace key]}]
(when (and (= :set-plugin-data type)
(= :penpot-debug namespace)
(str/starts-with? key debug-fault-prefix))
(subs key (count debug-fault-prefix))))
changes))
(defn- raise-debug-fault
"Throws the error named `fault`, standing in for a real failure while the
changes are applied."
[fault]
(let [message "debug save fault"]
(case fault
"validation" (ex/raise :type :validation :code :debug-fault :hint message)
"runtime" (throw (RuntimeException. message))
"ex-info" (throw (ex-info message {}))
"assertion" (throw (AssertionError. message))
"sql" (throw (java.sql.SQLException. message))
"io" (throw (java.io.IOException. message))
"interrupted" (throw (InterruptedException. message))
"not-found" (ex/raise :type :not-found :code :object-not-found :hint message)
"stack-overflow" (throw (StackOverflowError. message))
(ex/raise :type :validation :code :unknown-debug-fault :hint fault))))
(defn- apply-changes
"Applies and validates `changes`. With the `debug-save-faults` flag, a
debug marker in them makes this fail with the error it names."
[cfg file libs changes skip-validate]
(when (contains? cf/flags :debug-save-faults)
(some-> (get-debug-fault changes) (raise-debug-fault)))
(let [file (with-validation-timing cfg :process-changes-ms "process-changes"
(update file :data (fn [data]
(-> data
(cpc/process-changes changes)
(d/without-nils)))))]
(validate-file cfg file libs changes skip-validate)
file))
(defn- decode-objects
"Decodes the objects of the pages `changes` touch. Every file derived from
`file` shares them, so each attempt does not decode them again."
[file changes]
(doseq [page-id (into #{} (keep :page-id) changes)]
(let [objects (get-in file [:data :pages-index page-id :objects])]
(doseq [id (keys objects)]
(get objects id)))))
(defn- infrastructure-error?
[cause]
(some (fn [cause]
(or (instance? java.sql.SQLException cause)
(instance? java.io.IOException cause)
(instance? InterruptedException cause)
;; A file fragment that cannot be loaded
(= :not-found (:type (ex-data cause)))))
(take-while some? (iterate ex-cause cause))))
(defn- change-failure?
"True when `cause` comes from applying or validating changes. Only these
reject a commit; any other error fails the whole request."
[cause]
(and (or (instance? Exception cause)
(instance? AssertionError cause))
(not (infrastructure-error? cause))))
(defn- rejection
"Describes `commits` as rejected, the first one failing with `cause`."
[commits cause]
(let [data (ex-data cause)]
{:commit-ids (mapv :commit-id commits)
:failed-commit-id (:commit-id (first commits))
;; An ex-info without a type reports like any unexpected exception
:error (if (:type data)
(cond-> {:type (:type data)
:code (:code data)
:hint (or (:hint data) (ex-message cause))}
(:details data)
(assoc :details (mapv #(dissoc % :shape) (:details data))))
{:type :internal
:code :unexpected-error
:hint (or (ex-message cause) (.getName (class cause)))})}))
(defn- apply-prefix
"Applies and validates the first `n` commits of `attempt`, starting from
its `:file` and its `:tracked` pointers. Returns the resulting `:file`,
with the pointers to persist in `:tracked` and the media refs in `:refs`,
or the cause of the failure."
[{:keys [cfg file libs commits skip-validate state tracked]} n]
(reset! pmap/*tracked* tracked)
(reset! state {})
(let [changes (into [] (comp (take n) (mapcat :changes)) commits)]
(try
(let [file (apply-changes cfg file libs changes skip-validate)]
{:file (assoc file ::changes changes)
:tracked @pmap/*tracked*
:refs @state})
(catch Throwable cause
(when-not (change-failure? cause)
(throw cause))
cause))))
(defn- apply-commits
"Keeps the longest prefix of the `:commits` of `attempt` that applies and
validates, found by bisection, and rejects the rest. `cause` is the
failure of all of them together. Takes about log2 of the commits
attempts; a commit that repairs an earlier one can keep both. Leaves the
pointers and media refs of the kept prefix in place and returns its file,
with the accepted changes in `::changes` and the rejection in
`::rejected`. The whole search is timed as the `retry` step of `cfg`."
[cfg {:keys [file commits state tracked] :as attempt} cause]
(let [tpoint (ct/tpoint)]
(with-validation-timing cfg :retry-ms "retry"
(loop [lo 0
hi (count commits)
cause cause
attempts 0
accepted nil]
(if (> (- hi lo) 1)
(let [mid (quot (+ lo hi) 2)
result (apply-prefix attempt mid)]
(if (instance? Throwable result)
(recur lo mid result (inc attempts) accepted)
(recur mid hi cause (inc attempts) result)))
(let [rejected (subvec commits lo)]
(reset! pmap/*tracked* (:tracked accepted tracked))
(reset! state (:refs accepted {}))
(l/error :hint "update-file commit rejected"
:file-id (str (:id file))
:commit-id (str (:commit-id (first rejected)))
:rejected (count rejected)
:commits (count commits)
:attempts attempts
:elapsed (ct/format-duration (tpoint))
:cause cause)
(assoc (:file accepted (assoc file ::changes []))
::rejected (rejection rejected cause))))))))
(defn- process-changes-and-validate
[cfg file changes skip-validate]
"Applies and validates all `changes` at once. If that fails and there are
`commits`, keeps the longest prefix of them that validates."
[cfg file changes commits skip-validate]
(let [should-resolve-libs?
(and (or (contains? cf/flags :file-validation)
(contains? cf/flags :soft-file-validation))
(not skip-validate))
tlibs
(ct/tpoint)
libs
(try
(when should-resolve-libs?
(bfc/get-resolved-file-libraries cfg file))
(finally
(when should-resolve-libs?
(record-validation-timing cfg :resolve-libs-ms "resolve-libs" (inst-ms (tlibs))))))
(when should-resolve-libs?
(with-validation-timing cfg :resolve-libs-ms "resolve-libs"
(bfc/get-resolved-file-libraries cfg file)))
;; The main purpose of this atom is provide a contextual state
;; for the changes subsystem where optionally some hints can
@ -460,58 +668,46 @@
state
(atom {})
tproc
(ct/tpoint)
;; True when validation reads every object of the touched pages
schema-check?
(or (contains? cf/flags :soft-file-schema-validation)
(and (contains? cf/flags :file-schema-validation)
(not skip-validate)))
file
(try
(let [file
(binding [cpc/*state* state]
(-> (files/check-version! file)
(update :revn inc)
(update :data cpc/process-changes changes)
(update :data d/without-nils)))
(-> (files/check-version! file)
(update :revn inc))
file
(if-let [media-refs (-> @state :media-refs not-empty)]
(bfc/update-media-references! cfg file media-refs)
file)]
file)
(finally
(record-validation-timing cfg :process-changes-ms "process-changes" (inst-ms (tproc)))))]
tracked
@pmap/*tracked*
(binding [pmap/*tracked* nil]
(when (contains? cf/flags :soft-file-validation)
(let [t (ct/tpoint)]
file
(binding [cpc/*state* state]
;; Decoded on `file`, the objects the schema check reads are
;; shared by every retry
(when (and (next commits) schema-check?)
(decode-objects file changes))
(try
(soft-validate-file! file libs changes)
(finally
(record-validation-timing cfg :soft-validate-affected-ms "soft-validate-affected" (inst-ms (t)))))))
(-> (apply-changes cfg file libs changes skip-validate)
(assoc ::changes changes))
(catch Throwable cause
(when-not (and (some? commits)
(change-failure? cause))
(throw cause))
(apply-commits cfg
{;; The retries record no step timings
:cfg (dissoc cfg ::mtx/metrics ::validation-timings)
:file file
:libs libs
:commits (vec commits)
:skip-validate skip-validate
:state state
:tracked tracked}
cause))))]
(when (contains? cf/flags :soft-file-schema-validation)
(let [t (ct/tpoint)]
(try
(soft-validate-file-schema! file)
(finally
(record-validation-timing cfg :soft-validate-schema-ms "soft-validate-schema" (inst-ms (t)))))))
(when (and (contains? cf/flags :file-validation)
(not skip-validate))
(let [t (ct/tpoint)]
(try
(val/validate-file-affected! file libs changes)
(finally
(record-validation-timing cfg :validate-affected-ms "validate-affected" (inst-ms (t)))))))
(when (and (contains? cf/flags :file-schema-validation)
(not skip-validate))
(let [t (ct/tpoint)]
(try
(val/validate-file-schema! file)
(finally
(record-validation-timing cfg :validate-schema-ms "validate-schema" (inst-ms (t))))))))
file))
(if-let [media-refs (-> @state :media-refs not-empty)]
(bfc/update-media-references! cfg file media-refs)
file)))
(defn- take-snapshot?
"Defines the rule when file `data` snapshot should be saved."

44
backend/test/backend_tests/files_update_validation_timing_test.clj
View File

@ -14,6 +14,7 @@
[app.metrics :as mtx]
[app.metrics.definition :as-alias mdef]
[app.rpc.commands.files-update :as files-update]
[app.util.pointer-map :as pmap]
[clojure.test :as t]
[integrant.core :as ig])
(:import
@ -61,11 +62,12 @@
(t/deftest process-changes-and-validate-records-all-steps
(let [metrics (ig/init-key :app.metrics/metrics {:default main/default-metrics})
cfg (test-cfg metrics)]
(binding [cf/flags all-flags]
(binding [cf/flags all-flags
pmap/*tracked* (pmap/create-tracked)]
(with-redefs [bfc/get-resolved-file-libraries (fn [_ _] {})
val/validate-file-affected! (fn [_ _ _] nil)
val/validate-file-schema! (fn [_] nil)]
(let [file (@#'files-update/process-changes-and-validate cfg (test-file) [] nil)
(let [file (@#'files-update/process-changes-and-validate cfg (test-file) [] nil nil)
timings @(::files-update/validation-timings cfg)]
(t/is (map? file))
(t/is (number? (:resolve-libs-ms timings)))
@ -84,7 +86,8 @@
(t/deftest process-changes-and-validate-skips-when-skip-validate
(let [metrics (ig/init-key :app.metrics/metrics {:default main/default-metrics})
cfg (test-cfg metrics)]
(binding [cf/flags all-flags]
(binding [cf/flags all-flags
pmap/*tracked* (pmap/create-tracked)]
(with-redefs [bfc/get-resolved-file-libraries (fn [_ _]
(throw (ex-info "must not resolve libs" {})))
val/validate-file-affected! (fn [_ _ _]
@ -92,7 +95,7 @@
val/validate-file-schema! (fn [_]
(throw (ex-info "must not validate schema" {})))]
;; soft validations still run: they only check flags, not skip-validate
(let [file (@#'files-update/process-changes-and-validate cfg (test-file) [] true)
(let [file (@#'files-update/process-changes-and-validate cfg (test-file) [] nil true)
timings @(::files-update/validation-timings cfg)]
(t/is (map? file))
(t/is (nil? (:resolve-libs-ms timings)))
@ -107,14 +110,15 @@
(t/deftest process-changes-and-validate-records-timing-on-error
(let [metrics (ig/init-key :app.metrics/metrics {:default main/default-metrics})
cfg (test-cfg metrics)]
(binding [cf/flags all-flags]
(binding [cf/flags all-flags
pmap/*tracked* (pmap/create-tracked)]
(with-redefs [bfc/get-resolved-file-libraries (fn [_ _] {})
val/validate-file-affected! (fn [_ _ _]
(throw (ex-info "bad file" {:code :referential-integrity})))
val/validate-file-schema! (fn [_] nil)]
(let [timings-atom (::files-update/validation-timings cfg)]
(t/is (thrown? clojure.lang.ExceptionInfo
(@#'files-update/process-changes-and-validate cfg (test-file) [] nil)))
(@#'files-update/process-changes-and-validate cfg (test-file) [] nil nil)))
;; the failing step still recorded its timing via finally
(t/is (number? (:validate-affected-ms @timings-atom)))
(t/is (number? (:resolve-libs-ms @timings-atom)))
@ -126,3 +130,31 @@
(let [record @#'files-update/record-validation-timing]
(t/is (nil? (record {} :resolve-libs-ms "resolve-libs" 12)))
(t/is (nil? (record {::mtx/metrics nil} :resolve-libs-ms "resolve-libs" 12)))))
(t/deftest retries-record-one-sample-per-step-and-one-retry-sample
(let [metrics (ig/init-key :app.metrics/metrics {:default main/default-metrics})
cfg (test-cfg metrics)
commit (fn [name]
{:commit-id (uuid/next)
:changes [{:type :mod-page :id (uuid/next) :name name}]})
commits [(commit "a") (commit "b") (commit "bad") (commit "c")]]
(binding [cf/flags all-flags
pmap/*tracked* (pmap/create-tracked)]
(with-redefs [bfc/get-resolved-file-libraries (fn [_ _] {})
val/validate-file-affected! (fn [_ _ changes]
(when (some #(= "bad" (:name %)) changes)
(throw (ex-info "bad file" {:type :validation
:code :referential-integrity}))))
val/validate-file-schema! (fn [_] nil)]
(let [file (@#'files-update/process-changes-and-validate
cfg (test-file) (into [] (mapcat :changes) commits) commits nil)
timings @(::files-update/validation-timings cfg)]
(t/is (= (mapv :commit-id (subvec commits 2))
(:commit-ids (::files-update/rejected file))))
(t/is (number? (:retry-ms timings)))
;; The first pass fails at validate-affected, before validate-schema
(doseq [step ["process-changes" "soft-validate-affected" "soft-validate-schema"
"validate-affected" "retry"]]
(t/is (= 1.0 (bucket-value metrics "penpot_rpc_update_file_validation_timing"
["step"] [step] "60000.0"))
(str "expected one sample for step " step))))))))

504
backend/test/backend_tests/rpc_file_update_test.clj Normal file
View File

@ -0,0 +1,504 @@
;; 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.rpc-file-update-test
(:require
[app.common.exceptions :as ex]
[app.common.features :as cfeat]
[app.common.files.changes :as cpc]
[app.common.files.validate :as val]
[app.common.logging :as l]
[app.common.types.shape :as cts]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.msgbus :as mbus]
[app.rpc :as-alias rpc]
[app.util.blob :as blob]
[backend-tests.helpers :as th]
[clojure.test :as t]))
(defn- with-validation
[next]
(with-redefs [cf/flags (conj cf/flags :file-validation :file-schema-validation)]
(next)))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset with-validation)
(defn- create-file
[]
(let [profile (th/create-profile* 1)
file (th/create-file* 1 {:profile-id (:id profile)
:project-id (:default-project-id profile)
:is-shared false})]
{:profile-id (:id profile)
:file-id (:id file)
:page-id (-> file :data :pages first)}))
(defn- add-rect
[page-id id]
{:type :add-obj
:page-id page-id
:id id
:parent-id uuid/zero
:frame-id uuid/zero
:obj (cts/setup-shape {:id id
:type :rect
:name "rect"
:x 0 :y 0 :width 10 :height 10
:parent-id uuid/zero
:frame-id uuid/zero})})
(defn- break-parent
"A change that leaves the shape pointing to a parent that does not exist."
[page-id id]
{:type :mod-obj
:page-id page-id
:id id
:operations [{:type :set :attr :parent-id :val (uuid/next)}]})
(defn- update-file
[{:keys [profile-id file-id]} params]
(th/command! (merge {::th/type :update-file
::rpc/profile-id profile-id
:id file-id
:session-id (uuid/next)
:revn 0
:vern 0
:features cfeat/supported-features}
params)))
(defn- commit
[& changes]
{:commit-id (uuid/next) :changes (vec changes)})
(defn- get-file-data
[{:keys [profile-id file-id]}]
(-> (th/command! {::th/type :get-file
::rpc/profile-id profile-id
:id file-id})
:result
:data))
(defn- get-file-changes
[{:keys [file-id]}]
(->> (th/db-query :file-change {:file-id file-id} {:order-by [:revn]})
(filter :changes)
(mapv #(update % :changes blob/decode))))
(defn- capture-messages
[next]
(let [messages (atom [])]
(with-redefs [mbus/pub! (fn [_ & {:keys [message]}]
(swap! messages conj message))]
(let [out (next)]
{:out out :messages @messages}))))
(t/deftest saves-the-commits-before-the-first-invalid-one
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
shape-c (uuid/next)
commit1 (commit (add-rect page-id shape-a))
commit2 (commit (break-parent page-id shape-a))
commit3 (commit (add-rect page-id shape-c))
{:keys [out messages]}
(capture-messages
#(update-file ctx {:changes-with-metadata [commit1 commit2 commit3]}))]
(t/is (nil? (:error out)))
(t/testing "the response names the rejected commits and the failure"
(let [rejected (-> out :result :rejected)]
(t/is (= [(:commit-id commit2) (:commit-id commit3)] (:commit-ids rejected)))
(t/is (= (:commit-id commit2) (:failed-commit-id rejected)))
(t/is (= :validation (-> rejected :error :type)))
(t/is (= :referential-integrity (-> rejected :error :code)))))
(t/testing "the file holds the accepted commit only"
(let [objects (-> (get-file-data ctx) :pages-index (get page-id) :objects)]
(t/is (= uuid/zero (get-in objects [shape-a :parent-id])))
(t/is (not (contains? objects shape-c)))))
(t/testing "the change log holds the accepted commit only"
(let [rows (get-file-changes ctx)]
(t/is (= 1 (count rows)))
(t/is (= 1 (:revn (first rows))))
(t/is (= (:changes commit1) (:changes (first rows))))))
(t/testing "peers get the accepted commit only"
(let [file-changes (filter #(= :file-change (:type %)) messages)]
(t/is (= 1 (count file-changes)))
(t/is (= (:changes commit1) (:changes (first file-changes))))))))
(t/deftest saves-nothing-when-the-first-commit-is-invalid
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
_ (update-file ctx {:changes [(add-rect page-id shape-a)]})
commit1 (commit (break-parent page-id shape-a))
commit2 (commit (add-rect page-id (uuid/next)))
{:keys [out messages]}
(capture-messages
#(update-file ctx {:revn 1 :changes-with-metadata [commit1 commit2]}))]
(t/is (nil? (:error out)))
(t/is (= [(:commit-id commit1) (:commit-id commit2)]
(-> out :result :rejected :commit-ids)))
(t/is (= 1 (:revn (th/db-get :file {:id (:file-id ctx)}))))
(t/is (= 1 (count (get-file-changes ctx))))
(t/is (empty? messages))))
(t/deftest rejects-a-commit-that-throws-while-applied
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
commit1 (commit (add-rect page-id shape-a))
;; `:add-page` refuses an id+name and a page at once
commit2 (commit {:type :add-page
:id (uuid/next)
:name "page"
:page {:id (uuid/next) :name "page" :objects {}}})
out (update-file ctx {:changes-with-metadata [commit1 commit2]})]
(t/is (nil? (:error out)))
(t/is (= [(:commit-id commit2)] (-> out :result :rejected :commit-ids)))
(t/is (= :conflict (-> out :result :rejected :error :type)))
(t/is (= 1 (:revn (th/db-get :file {:id (:file-id ctx)}))))))
(t/deftest rejects-a-commit-that-only-fails-the-schema
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
shape-c (uuid/next)
commit1 (commit (add-rect page-id shape-a))
commit2 (commit {:type :mod-obj
:page-id page-id
:id shape-a
:operations [{:type :set :attr :name :val "schema-breaker"}]})
commit3 (commit (add-rect page-id shape-c))
validate val/validate-file-schema!
;; Changes and shapes are schema checked while applied, so no real
;; change reaches the file schema check invalid: one is simulated
out (with-redefs [val/validate-file-schema!
(fn [file]
(when (= "schema-breaker"
(get-in file [:data :pages-index page-id :objects shape-a :name]))
(ex/raise :type :validation :code :schema-validation :hint "schema"))
(validate file))]
(update-file ctx {:changes-with-metadata [commit1 commit2 commit3]}))
objects (-> (get-file-data ctx) :pages-index (get page-id) :objects)]
(t/is (nil? (:error out)))
(t/is (= [(:commit-id commit2) (:commit-id commit3)]
(-> out :result :rejected :commit-ids)))
(t/is (= :schema-validation (-> out :result :rejected :error :code)))
(t/is (= "rect" (get-in objects [shape-a :name])))
(t/is (not (contains? objects shape-c)))))
(t/deftest saves-every-commit-when-all-are-valid
(let [{:keys [page-id] :as ctx} (create-file)
out (update-file ctx {:changes-with-metadata [(commit (add-rect page-id (uuid/next)))
(commit (add-rect page-id (uuid/next)))]})]
(t/is (nil? (:error out)))
(t/is (nil? (-> out :result :rejected)))
(t/is (= 1 (:revn (th/db-get :file {:id (:file-id ctx)}))))))
(t/deftest flat-changes-stay-all-or-nothing
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
out (update-file ctx {:changes [(add-rect page-id shape-a)
(break-parent page-id shape-a)]})]
(t/is (= :validation (th/ex-type (:error out))))
(t/is (= 0 (:revn (th/db-get :file {:id (:file-id ctx)}))))))
(t/deftest groups-without-commit-ids-stay-all-or-nothing
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
out (update-file ctx {:changes-with-metadata
[{:changes [(add-rect page-id shape-a)]}
{:changes [(break-parent page-id shape-a)]}]})]
(t/is (= :validation (th/ex-type (:error out))))
(t/is (= 0 (:revn (th/db-get :file {:id (:file-id ctx)}))))))
(t/deftest database-failures-fail-the-whole-request
(let [{:keys [page-id] :as ctx} (create-file)
process cpc/process-changes
calls (atom 0)
out (with-redefs [cpc/process-changes
(fn [& args]
;; The first call is the single pass over
;; every commit; the database fails on the
;; first attempt of the retry. The 3-arity
;; call is the same pass.
(when (and (= 2 (count args))
(= 2 (swap! calls inc)))
(throw (java.sql.SQLException. "connection lost")))
(apply process args))]
(update-file ctx {:changes-with-metadata
[(commit (add-rect page-id (uuid/next)))
(commit {:type :add-page
:id (uuid/next)
:name "page"
:page {:id (uuid/next) :name "page" :objects {}}})]}))]
(t/is (instance? java.sql.SQLException (:error out)))
(t/is (= 0 (:revn (th/db-get :file {:id (:file-id ctx)}))))))
(defn- move-rect
[page-id id x]
{:type :mod-obj
:page-id page-id
:id id
:operations [{:type :set :attr :x :val x}]})
(defn- update-file-counting
"Updates the file and counts the times the changes are applied."
[ctx params]
(let [process cpc/process-changes
calls (atom 0)
out (with-redefs [cpc/process-changes
(fn [& args]
;; The 3-arity call is the same application
(when (= 2 (count args))
(swap! calls inc))
(apply process args))]
(update-file ctx params))]
{:out out :calls @calls}))
(t/deftest bisects-the-commits-to-find-the-invalid-one
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
_ (update-file ctx {:changes [(add-rect page-id shape-a)]})
commits (mapv (fn [i]
(if (= i 5)
(commit (break-parent page-id shape-a))
(commit (move-rect page-id shape-a i))))
(range 16))
{:keys [out calls]}
(update-file-counting ctx {:revn 1 :changes-with-metadata commits})]
(t/is (nil? (:error out)))
(t/is (= (mapv :commit-id (subvec commits 5))
(-> out :result :rejected :commit-ids)))
(t/is (= (:commit-id (nth commits 5))
(-> out :result :rejected :failed-commit-id)))
(t/is (= :referential-integrity (-> out :result :rejected :error :code)))
(t/testing "the single pass plus log2 of the commits attempts"
(t/is (= 5 calls)))
(t/testing "the file holds the commits before the invalid one"
(let [objects (-> (get-file-data ctx) :pages-index (get page-id) :objects)]
(t/is (= uuid/zero (get-in objects [shape-a :parent-id])))
(t/is (= 4 (get-in objects [shape-a :x])))))))
(t/deftest rejects-a-single-commit-without-a-retry
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
_ (update-file ctx {:changes [(add-rect page-id shape-a)]})
commit1 (commit (break-parent page-id shape-a))
{:keys [out calls]}
(update-file-counting ctx {:revn 1 :changes-with-metadata [commit1]})]
(t/is (nil? (:error out)))
(t/is (= [(:commit-id commit1)] (-> out :result :rejected :commit-ids)))
(t/is (= :referential-integrity (-> out :result :rejected :error :code)))
(t/is (= 1 calls))
(t/is (= 1 (:revn (th/db-get :file {:id (:file-id ctx)}))))))
(defn- rename-rect
[page-id id name]
{:type :mod-obj
:page-id page-id
:id id
:operations [{:type :set :attr :name :val name}]})
(defn- wait-for-record
"The first log record whose message hint is `hint`, waiting up to two
seconds for the asynchronous logger to write it."
[records hint]
(loop [tries 0]
(if-let [record (->> @records
(filter #(= hint (get-in % [::l/props :hint])))
(first))]
record
(when (< tries 200)
(Thread/sleep 10)
(recur (inc tries))))))
(t/deftest keeps-fifty-commits-before-the-invalid-one
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
_ (update-file ctx {:changes [(add-rect page-id shape-a)]})
renames (mapv #(commit (rename-rect page-id shape-a (str "name " %))) (range 50))
invalid (commit (break-parent page-id shape-a))
records (atom [])
out (try
(add-watch l/log-record ::capture
(fn [_ _ _ record] (swap! records conj record)))
(update-file ctx {:revn 1 :changes-with-metadata (conj renames invalid)})
(finally
(remove-watch l/log-record ::capture)))]
(t/is (nil? (:error out)))
(t/is (= [(:commit-id invalid)] (-> out :result :rejected :commit-ids)))
(t/testing "the file holds the fifty renames"
(let [objects (-> (get-file-data ctx) :pages-index (get page-id) :objects)]
(t/is (= "name 49" (get-in objects [shape-a :name])))
(t/is (= uuid/zero (get-in objects [shape-a :parent-id])))))
(t/testing "the change log holds the renames in one revision"
(let [rows (get-file-changes ctx)]
(t/is (= 2 (count rows)))
(t/is (= (into [] (mapcat :changes) renames)
(:changes (last rows))))))
(t/testing "the search takes log2 of the commits attempts"
(let [record (wait-for-record records "update-file commit rejected")]
(t/is (some? record))
(t/is (= 51 (get-in record [::l/props :commits])))
(t/is (= 6 (get-in record [::l/props :attempts])))))))
(t/deftest keeps-a-commit-that-repairs-an-earlier-one
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
shape-c (uuid/next)
_ (update-file ctx {:changes [(add-rect page-id shape-a)]})
commit1 (commit (break-parent page-id shape-a))
commit2 (commit {:type :mod-obj
:page-id page-id
:id shape-a
:operations [{:type :set :attr :parent-id :val uuid/zero}]})
commit3 (commit (add-rect page-id shape-c))
commit4 (commit (break-parent page-id shape-c))
out (update-file ctx {:revn 1 :changes-with-metadata [commit1 commit2 commit3 commit4]})
objects (-> (get-file-data ctx) :pages-index (get page-id) :objects)]
(t/is (nil? (:error out)))
(t/is (= [(:commit-id commit4)] (-> out :result :rejected :commit-ids)))
(t/is (= uuid/zero (get-in objects [shape-a :parent-id])))
(t/is (= uuid/zero (get-in objects [shape-c :parent-id])))))
(defn- debug-fault
"A change that asks the backend to fail with `fault` while applied."
[fault]
{:type :set-plugin-data
:object-type :file
:namespace :penpot-debug
:key (str "save-fault:" fault)
:value nil})
(defn- with-debug-faults
[f]
(with-redefs [cf/flags (conj cf/flags :debug-save-faults)]
(f)))
(t/deftest a-debug-fault-rejects-its-commit
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
commit1 (commit (add-rect page-id shape-a))
commit2 (commit (debug-fault "runtime"))
commit3 (commit (add-rect page-id (uuid/next)))
out (with-debug-faults
#(update-file ctx {:changes-with-metadata [commit1 commit2 commit3]}))
objects (-> (get-file-data ctx) :pages-index (get page-id) :objects)]
(t/is (nil? (:error out)))
(t/is (= [(:commit-id commit2) (:commit-id commit3)]
(-> out :result :rejected :commit-ids)))
(t/is (= :internal (-> out :result :rejected :error :type)))
(t/is (contains? objects shape-a))))
(t/deftest a-debug-validation-fault-rejects-like-a-validation-error
(let [{:keys [page-id] :as ctx} (create-file)
out (with-debug-faults
#(update-file ctx {:changes-with-metadata
[(commit (add-rect page-id (uuid/next)))
(commit (debug-fault "validation"))]}))]
(t/is (= :validation (-> out :result :rejected :error :type)))))
(t/deftest a-debug-infrastructure-fault-fails-the-whole-request
(let [{:keys [page-id] :as ctx} (create-file)
out (with-debug-faults
#(update-file ctx {:changes-with-metadata
[(commit (add-rect page-id (uuid/next)))
(commit (debug-fault "sql"))]}))]
(t/is (instance? java.sql.SQLException (:error out)))
(t/is (= 0 (:revn (th/db-get :file {:id (:file-id ctx)}))))))
(t/deftest debug-faults-need-the-flag
(let [{:keys [page-id] :as ctx} (create-file)
out (update-file ctx {:changes-with-metadata
[(commit (add-rect page-id (uuid/next)))
(commit (debug-fault "runtime"))]})]
(t/is (nil? (:error out)))
(t/is (nil? (-> out :result :rejected)))
(t/is (= 1 (:revn (th/db-get :file {:id (:file-id ctx)}))))
(t/is (nil? (:plugin-data (get-file-data ctx))))))
(t/deftest a-rejection-without-an-error-type-reports-an-internal-error
(let [{:keys [page-id] :as ctx} (create-file)
out (with-debug-faults
#(update-file ctx {:changes-with-metadata
[(commit (add-rect page-id (uuid/next)))
(commit (debug-fault "ex-info"))]}))
error (-> out :result :rejected :error)]
(t/is (= :internal (:type error)))
(t/is (= :unexpected-error (:code error)))
(t/is (= "debug save fault" (:hint error)))))
(defn- upload-image
"Uploads an image to the file `file-id` and returns its media object."
[profile-id file-id]
(let [out (th/multipart-command!
{::th/type :upload-file-media-object
::rpc/profile-id profile-id
:file-id file-id
:is-local true
:name "image"
:content {:filename "sample.jpg"
:path (th/tempfile "backend_tests/test_files/sample.jpg")
:mtype "image/jpeg"
:size 312043}})]
(t/is (nil? (:error out)))
(:result out)))
(defn- add-image-rect
"A rect filled with the image of `mobj`."
[page-id id mobj]
(assoc-in (add-rect page-id id)
[:obj :fills]
[{:fill-opacity 1
:fill-image {:id (:id mobj) :width 100 :height 100 :mtype "image/jpeg"}}]))
(t/deftest a-rejected-commit-adds-no-media-references
(let [{:keys [profile-id page-id file-id] :as ctx} (create-file)
other (th/create-file* 2 {:profile-id profile-id
:project-id (:default-project-id (th/db-get :profile {:id profile-id}))
:is-shared false})
;; An image of another file: referencing it copies the media
;; object into this file
mobj (upload-image profile-id (:id other))
shape-a (uuid/next)
shape-b (uuid/next)
commit1 (commit (add-rect page-id shape-a))
commit2 (commit (add-image-rect page-id shape-b mobj)
(break-parent page-id shape-a))
out (update-file ctx {:changes-with-metadata [commit1 commit2]})]
(t/is (nil? (:error out)))
(t/is (= [(:commit-id commit2)] (-> out :result :rejected :commit-ids)))
(t/testing "the rejected image adds no media object to the file"
(t/is (empty? (th/db-query :file-media-object {:file-id file-id}))))
(t/testing "the same image in an accepted commit does"
(let [out (update-file ctx {:revn 1
:changes-with-metadata [(commit (add-image-rect page-id shape-b mobj))]})]
(t/is (nil? (:error out)))
(t/is (nil? (-> out :result :rejected)))
(t/is (= 1 (count (th/db-query :file-media-object {:file-id file-id}))))))))

4
common/src/app/common/flags.cljc
View File

@ -96,6 +96,10 @@
:file-validation
;; Reports the referential integrity validation errors internally.
:soft-file-validation
;; Disabled by default; never enable it in production. Lets a save
;; carry a marker that makes the backend fail it with a chosen error
;; (frontend `debug.failNextSave`).
:debug-save-faults
;; TODO: deprecate this flag and consolidate the code
:frontend-svgo
;; TODO: deprecate this flag and consolidate the code

51
frontend/src/app/main/data/changes.cljs
View File

@ -16,6 +16,8 @@
[app.common.uuid :as uuid]
[app.main.data.event :as ev]
[app.main.data.helpers :as dsh]
[app.main.data.persistence.commits :as pcm]
[app.main.data.workspace :as-alias dw]
[app.main.features :as features]
[app.main.worker :as mw]
[app.render-wasm.api :as wasm.api]
@ -68,15 +70,6 @@
(rx/empty)))
(rx/ignore))))))
(defn- get-pending-commits
"Local commits the server has not saved yet, oldest first: the queued
ones, then the ones still buffered."
[{:keys [persistence]}]
(-> []
(into (map (d/getf (:index persistence))) (:queue persistence))
(into (:buffer persistence))
(not-empty)))
(def ^:private xf:map-page-id
(map :page-id))
@ -201,7 +194,7 @@
ptk/WatchEvent
(watch [_ state _]
(let [pending (when-not local?
(get-pending-commits state))]
(not-empty (pcm/pending-commits (:persistence state) file-id)))]
(rx/concat
(rx/of (apply-changes-localy commit pending))
(if pending
@ -213,6 +206,44 @@
(rx/map (fn [commit] (update-indexes commit :redo-changes)))))
(rx/of (update-indexes commit :redo-changes)))))))))
(defn rebase-commits
"Undoes `undo`, applies `remote` and redoes `redo` on the local data of
`file-id`, commits oldest first. Nothing is saved or added to the undo
history; if the changes fail to apply, the file is reloaded."
[file-id {:keys [undo remote redo]}]
(let [commit {:file-id file-id
:redo-changes (-> []
(into (mapcat :undo-changes) (reverse undo))
(into remote)
(into (mapcat :redo-changes) redo))}
event (apply-changes-localy commit nil)
failed? (volatile! false)]
(ptk/reify ::rebase-commits
ptk/UpdateEvent
(update [_ state]
(if (dsh/lookup-file-data state file-id)
(try
(ptk/update event state)
(catch :default cause
(log/error :hint "unable to rebase commits" :file-id (str file-id) :cause cause)
(vreset! failed? true)
state))
state))
ptk/WatchEvent
(watch [_ state stream]
(cond
@failed?
(rx/of (ptk/event ::dw/reload-current-file))
(dsh/lookup-file-data state file-id)
(rx/merge
(or (ptk/watch event state stream) (rx/empty))
(rx/of (update-indexes commit :redo-changes)))
:else
(rx/empty))))))
(defn- resolve-file-revn
[state file-id]
(:revn (dsh/lookup-file state file-id)))

231
frontend/src/app/main/data/persistence.cljs
View File

@ -17,7 +17,10 @@
[app.main.data.event :as ev]
[app.main.data.helpers :as dsh]
[app.main.data.notifications :as ntf]
[app.main.data.persistence.commits :as pcm]
[app.main.data.workspace :as-alias dw]
[app.main.data.workspace.edition :as dwe]
[app.main.data.workspace.undo :as dwu]
[app.main.errors :as errors]
[app.main.refs :as refs]
[app.main.repo :as rp]
@ -146,7 +149,13 @@
(and (= from :retrying) (#{:pending :saving} to)) from
:else to))
(defn- nothing-to-save?
[{:keys [buffer queue]}]
(and (empty? buffer) (empty? queue)))
(defn- update-status
"Moves persistence to `status`. A delayed :pending notice is ignored
when nothing is left to save (e.g. a rollback already dropped the edit)."
[status]
(ptk/reify ::update-status
ptk/UpdateEvent
@ -156,7 +165,9 @@
(log/trc :hint "update-status"
:from (:status pstate)
:to status)
(let [status (next-status (:status pstate) status)]
(let [status (if (and (= :pending status) (nothing-to-save? pstate))
(:status pstate)
(next-status (:status pstate) status))]
(cond-> (assoc pstate :status status)
(#{:pending :saving} status)
(update :last-progress-at d/nilv (inst-ms (ct/now)))
@ -277,6 +288,21 @@
(effect [_ _ _]
(swap! revn-data update file-id (fnil max 0) revn))))
(defn- record-remote-changes
"Numbers a remote commit and, while `file-id` has pending commits, keeps
its changes for a rollback to apply again."
[file-id changes]
(ptk/reify ::record-remote-changes
ptk/UpdateEvent
(update [_ state]
(update state :persistence
(fn [pstate]
(let [number (inc (:remote-seq pstate 0))]
(cond-> (assoc pstate :remote-seq number)
(seq (pcm/pending-commits pstate file-id))
(update-in [:remote-changes file-id] (fnil conj [])
{:seq number :changes changes}))))))))
(defn- discard-commit
[commit-id]
(ptk/reify ::discard-commit
@ -289,24 +315,27 @@
(pop queue)
(throw (ex-info "invalid state" {})))))
(update :index dissoc commit-id)
(pcm/keep-saved-commits (get-in pstate [:index commit-id]))
(pcm/prune-remote-changes (get-in pstate [:index commit-id :file-id]))
(assoc :last-progress-at (inst-ms (ct/now)))
(dissoc :stall-reported :failing-since :recovering
:slow-failures :attempts :retry-token
:retry-for)))))))
(defn- without-commits
"Removes from `buffer` the commits listed in `commits`."
"`buffer` without `commits`."
[buffer commits]
(let [ids (into #{} (map :id) commits)]
(into [] (remove #(contains? ids (:id %))) buffer)))
(defn- buffer-commit
"Keeps a local commit in the store until the next flush queues it."
"Keeps a local commit in the buffer until the next flush."
[commit]
(ptk/reify ::buffer-commit
ptk/UpdateEvent
(update [_ state]
(update-in state [:persistence :buffer] (fnil conj []) commit))))
(let [number (get-in state [:persistence :remote-seq] 0)]
(update-in state [:persistence :buffer] (fnil conj []) (assoc commit :remote-seq number))))))
(defn- append-commit
"Event used internally to append the current change to the
@ -481,6 +510,97 @@
(d/update-in-when state [:persistence :index (:id commit)]
assoc ::acknowledged true))))
(def ^:private rejected-tag
"Tag of the rejected changes notice."
:persistence-rejected)
(def ^:private rejected-timeout-ms
"How long the rejected changes notice stays; the report is sent anyway."
10000)
(defn- prune-removed-shapes
"Deselects the shapes missing from the current page and leaves edition
mode if the edited one is missing."
[]
(ptk/reify ::prune-removed-shapes
ptk/UpdateEvent
(update [_ state]
(let [objects (dsh/lookup-page-objects state)]
(d/update-in-when state [:workspace-local :selected]
(fn [selected]
(into (empty selected) (filter #(contains? objects %)) selected)))))
ptk/WatchEvent
(watch [_ state _]
(let [edition (dm/get-in state [:workspace-local :edition])]
(if (and (some? edition)
(not (contains? (dsh/lookup-page-objects state) edition)))
(rx/of (dwe/clear-edition-mode))
(rx/empty))))))
(defn- compensate-commits
"Undoes the saved `commits` of `file-id`, newest first. A loaded file gets
a commit, applied locally; the undo of a file that is not loaded goes to
the queue as is."
[origin state file-id commits]
(let [changes (pcm/compensation-changes commits)]
(if (dsh/lookup-file-data state file-id)
(dch/commit-changes (assoc changes
:origin origin
:file-id file-id
:save-undo? false))
(let [{:keys [file-revn file-vern features]} (peek commits)]
(append-commit
(pcm/queue-entry
[(assoc changes
:id (uuid/next)
:created-at (ct/now)
:origin (ptk/type origin)
:file-id file-id
:file-revn file-revn
:file-vern file-vern
:features features
:remote-seq (dm/get-in state [:persistence :remote-seq] 0))]))))))
(defn- rollback-rejected
"Reverts the commits `rejected` in the save of `entry`, the later commits
of its file and the rest of their undo groups. Pending commits are undone
and dropped, saved ones undone by a new commit; the groups leave the undo
history and the user gets a warning."
[{:keys [file-id] :as entry} rejected]
(let [plan (volatile! nil)]
(ptk/reify ::rollback-rejected
ptk/UpdateEvent
(update [_ state]
(let [plan' (pcm/rollback-plan (:persistence state) entry rejected)]
(vreset! plan plan')
(update state :persistence pcm/without-rolled-back entry plan')))
ptk/WatchEvent
(watch [it state _]
(let [{:keys [files compensate groups]} @plan]
(rx/concat
(rx/from (map (fn [[fid plan]] (dch/rebase-commits fid plan)) files))
(rx/from (map (fn [[fid commits]] (compensate-commits it state fid commits))
(group-by :file-id compensate)))
(rx/of (dwu/forget-undo-groups groups)
(prune-removed-shapes)))))
ptk/EffectEvent
(effect [_ _ _]
(let [{:keys [error commit-ids]} rejected]
(errors/flash :cause (ex-info "The server rejected some changes"
(merge error
{:file-id file-id
:commit-ids commit-ids}
(pcm/rollback-summary @plan)))
:type :unhandled
:level :warning
:timeout rejected-timeout-ms
:tag rejected-tag
:report-link? true
:hint (tr "errors.save-rejected-changes-undone")))))))
(defn- update-file-request
"Issues the `update-file` request, tracked as active for its lifetime."
[request-id params]
@ -510,19 +630,30 @@
(not (dm/get-in state [:permissions :can-edit])) :permission-denied
:else :ready)))
(defn- with-changes
"Adds the changes of a queue entry to the save params, one group per
commit so the backend can reject them one by one."
[params {:keys [commits]}]
(assoc params :changes-with-metadata
(mapv (fn [{:keys [id origin redo-changes]}]
(cond-> {:commit-id id :changes (vec redo-changes)}
(keyword? origin)
(assoc :hint-origin origin)))
commits)))
(defn- send-queued-commit
"Sends one queued commit and maps its outcome to persistence events."
[request-id session-id {:keys [id file-id file-revn file-vern changes features] :as commit}]
[request-id session-id {:keys [id file-id file-revn file-vern features] :as commit}]
(let [sent-at (inst-ms (ct/now))
params {:id file-id
:revn (max file-revn (get @revn-data file-id 0))
:vern file-vern
:session-id session-id
:origin (:origin commit)
:created-at (:created-at commit)
:commit-id id
:changes (vec changes)
:features features}]
params (-> {:id file-id
:revn (max file-revn (get @revn-data file-id 0))
:vern file-vern
:session-id session-id
:origin (:origin commit)
:created-at (:created-at commit)
:commit-id id
:features features}
(with-changes commit))]
;; UI read-only mode does not invalidate already queued edits.
(->> (update-file-request request-id params)
;; Fails an unanswered request as a transient network error, so the
@ -536,10 +667,15 @@
;; A response that carries no revision, including one that never
;; arrived, is treated as a failed save rather than a saved file.
(rx/if-empty nil)
(rx/mapcat (fn [{:keys [revn]}]
(rx/mapcat (fn [{:keys [revn rejected]}]
(if (and (int? revn) (<= 0 revn))
(rx/of (update-file-revn file-id revn)
(commit-persisted commit))
(rx/concat
(rx/of (update-file-revn file-id revn))
;; Reverts the rejected commits before the queue moves on
(if (some? rejected)
(rx/of (rollback-rejected commit rejected))
(rx/empty))
(rx/of (commit-persisted commit)))
(rx/throw (ex-info "The save response has no valid revision"
{:type :persistence
:code :invalid-save-response
@ -701,6 +837,7 @@
(update state :persistence
#(-> %
(drop-file-commits file-id)
(pcm/prune-remote-changes file-id)
(dissoc :failing-since :slow-failures)))))))
(defn- queue-needs-a-runner?
@ -717,22 +854,27 @@
(not= :retrying status)))
(defn pending-file-changes
"Queued edits to restore into a freshly loaded file, in queue order.
Only edits of the loaded version belong in its data. A permanently
failed file is excluded because recovery releases its edits."
"Queued and buffered edits to restore into a freshly loaded file, oldest
first. Only edits of the loaded version belong in its data. A
permanently failed file is excluded because recovery releases its edits."
[{:keys [persistence]} {:keys [id vern]}]
(let [{:keys [queue index status error]} persistence
failed-file-id (get-in index [(:commit-id error) :file-id])]
(let [{:keys [queue index buffer status error]} persistence
failed-file-id (get-in index [(:commit-id error) :file-id])
of-file? #(and (= id (:file-id %))
(= vern (:file-vern %)))]
(if (and (= :error status)
(= id failed-file-id)
(not (slow-retry-pending? persistence)))
[]
(into []
(comp (map #(get index %))
(filter #(and (= id (:file-id %))
(= vern (:file-vern %))))
(mapcat :redo-changes))
queue))))
(-> []
(into (comp (map #(get index %))
(filter of-file?)
(mapcat :commits)
(mapcat :redo-changes))
queue)
(into (comp (filter of-file?)
(mapcat :redo-changes))
buffer)))))
(defn- initialize-persistence-state
"Brings persistence to a coherent starting shape when the workspace
@ -762,8 +904,7 @@
:else
(rx/empty))
;; Commits buffered by a previous session are queued now instead of
;; waiting for the next edit.
;; Queues the commits a previous session left buffered
(if (seq buffer)
(rx/of (flush-buffer))
(rx/empty)))))))
@ -819,27 +960,10 @@
:else
(rx/empty)))))))
(def ^:private xf-mapcat-undo
(mapcat :undo-changes))
(def ^:private xf-mapcat-redo
(mapcat :redo-changes))
(def ^:private commit-keys
"What a queue entry keeps of each commit merged into it."
[:id :origin :undo-group :redo-changes :undo-changes])
(defn- merge-commit
[buffer]
(->> (rx/from (group-by :file-id buffer))
(rx/map (fn [[_ [item :as commits]]]
(let [uchg (into [] xf-mapcat-undo commits)
rchg (into [] xf-mapcat-redo commits)]
(-> item
(assoc :undo-changes uchg)
(assoc :redo-changes rchg)
(assoc :changes rchg)
(assoc :commits (mapv #(select-keys % commit-keys) commits))))))))
(rx/map (comp pcm/queue-entry val))))
(defn- flush-buffer
"Queues the buffered commits, merged into one queue entry per file."
@ -960,14 +1084,13 @@
(rx/take-until stoper-s))
;; Syncs the leave-page warning on every buffer and queue change
;; (a buffered commit, an append after a flush, a discard after a
;; save, the release of a failed file).
(->> (rx/merge
(rx/of nil)
(->> stream
(rx/filter #(or (ptk/type? ::buffer-commit %)
(ptk/type? ::append-commit %)
(ptk/type? ::discard-commit %)
(ptk/type? ::rollback-rejected %)
(ptk/type? ::release-failed-file %)))))
(rx/map (fn [_] (sync-unload-guard)))
(rx/take-until stoper-s))
@ -978,8 +1101,7 @@
(update-status :pending)))
(rx/take-until stoper-s))
;; Local commits wait in the store buffer and are queued in small
;; chunks (commits very near in time) on each notification
;; Buffers local commits; each notification queues the buffer
(->> local-commits-s
(rx/map buffer-commit)
(rx/take-until stoper-s))
@ -996,6 +1118,7 @@
(rx/filter dch/commit?)
(rx/map deref)
(rx/filter #(= :remote (:source %)))
(rx/mapcat (fn [{:keys [file-id file-revn] :as commit}]
(rx/of (update-file-revn file-id file-revn))))
(rx/mapcat (fn [{:keys [file-id file-revn redo-changes]}]
(rx/of (record-remote-changes file-id redo-changes)
(update-file-revn file-id file-revn))))
(rx/take-until stoper-s)))))))

177
frontend/src/app/main/data/persistence/commits.cljs Normal file
View File

@ -0,0 +1,177 @@
;; 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 app.main.data.persistence.commits
"Pure functions over the commits of the persistence state: buffered,
queued and saved ones, and the plan to roll some of them back."
(:require
[app.common.data :as d]))
(def ^:private entry-keys
"Keys a queue entry keeps of the first commit merged into it."
[:id :created-at :origin :features :file-id :file-revn :file-vern])
(def ^:private commit-keys
"Keys a queue entry keeps of each of its commits."
[:id :origin :undo-group :redo-changes :undo-changes :remote-seq])
(def ^:private saved-keys
"Keys a saved commit takes from its queue entry."
[:file-id :file-revn :file-vern :features])
(defn queue-entry
"Merges `commits` of one file, oldest first, into a queue entry."
[[commit :as commits]]
(-> (select-keys commit entry-keys)
(assoc :commits (mapv #(select-keys % commit-keys) commits))))
(defn pending-commits
"Unsaved commits of `file-id`, oldest first: queued, then buffered."
[pstate file-id]
(let [file? #(= file-id (:file-id %))
xf:queued (comp (map #(get-in pstate [:index %]))
(filter file?)
(mapcat :commits))]
(-> []
(into xf:queued (:queue pstate))
(into (filter file?) (:buffer pstate)))))
(defn- pending-files
"Files with unsaved commits."
[pstate]
(-> #{}
(into (map #(get-in pstate [:index % :file-id])) (:queue pstate))
(into (map :file-id) (:buffer pstate))))
(defn prune-remote-changes
"Forgets the remote changes of `file-id` older than its oldest pending
commit, which a rollback never applies again."
[pstate file-id]
(if-let [since (some-> (first (pending-commits pstate file-id)) :remote-seq)]
(d/update-in-when pstate [:remote-changes file-id]
(fn [entries] (into [] (filter #(> (:seq %) since)) entries)))
(update pstate :remote-changes dissoc file-id)))
(defn- saved-commits
"The `commits` of `entry` as saved commits, which carry their file."
[entry commits]
(let [file (select-keys entry saved-keys)]
(map #(merge % file) commits)))
(defn keep-saved-commits
"Keeps the saved commits, `entry`'s included, whose undo group a pending
commit shares: if that commit is rejected they are undone too."
[pstate {:keys [commits] :as entry}]
(let [groups (into #{}
(keep :undo-group)
(mapcat #(pending-commits pstate %) (pending-files pstate)))]
(assoc pstate :saved
(into []
(filter #(contains? groups (:undo-group %)))
(concat (:saved pstate) (saved-commits entry commits))))))
(defn- reverted-commits
"Pending commits to revert per file: from the first one that is rejected
in `file-id`, or in an undo group of `groups`, to the last."
[pending file-id rejected kept groups]
(let [reverted?
(fn [fid {:keys [id undo-group]}]
(and (not (contains? kept id))
(or (and (= fid file-id) (contains? rejected id))
(contains? groups undo-group))))
from-first-reverted
(fn [[fid commits]]
(when-let [i (d/index-of-pred commits (partial reverted? fid))]
[fid (subvec commits i)]))]
(into {} (keep from-first-reverted) pending)))
(defn rollback-plan
"How to roll back the save of `entry` that came back `rejected`. Whole
undo groups are reverted, across files and saves.
Each file in `:files` undoes all its pending commits, applies again the
remote changes that came after them and redoes the commits that stay, so
a peer's later value for an attribute survives. Saved commits of a
reverted group go to `:compensate`, to be undone by a new commit."
[pstate {:keys [file-id commits] :as entry} {:keys [commit-ids]}]
(let [rejected (set commit-ids)
accepted (into [] (remove #(contains? rejected (:id %))) commits)
kept (into #{} (map :id) accepted)
pending (into {} (map (juxt identity #(pending-commits pstate %))) (pending-files pstate))
[reverted groups]
(loop [groups #{}]
(let [reverted (reverted-commits pending file-id rejected kept groups)
groups' (into groups (comp (mapcat val) (keep :undo-group)) reverted)]
(if (= groups groups')
[reverted groups]
(recur groups'))))
saved (into (vec (:saved pstate)) (saved-commits entry accepted))
file-plan
(fn [[fid commits]]
(let [all (get pending fid)
since (:remote-seq (first all) 0)
xf:remote (comp (filter #(> (:seq %) since))
(mapcat :changes))]
[fid {:undo all
:remote (into [] xf:remote (get-in pstate [:remote-changes fid]))
:redo (subvec all 0 (- (count all) (count commits)))
:reverted commits}]))]
{:files (into {} (map file-plan) reverted)
:compensate (into [] (filter #(contains? groups (:undo-group %))) saved)
:groups groups}))
(defn rollback-summary
"Counts the commits `plan` reverts and the files they belong to."
[{:keys [files compensate]}]
{:reverted (+ (transduce (map (comp count :reverted val)) + files)
(count compensate))
:files (count (into (set (keys files)) (map :file-id) compensate))})
(defn- drop-commits
"Removes the commits in `ids` from the queue and the buffer; an entry left
empty leaves the queue."
[pstate ids]
(let [dropped? (comp ids :id)
trim (fn [id]
[id (update (get-in pstate [:index id]) :commits
#(into [] (remove dropped?) %))])
trimmed (into {}
(comp (filter #(some dropped? (get-in pstate [:index % :commits])))
(map trim))
(:queue pstate))
emptied (into #{} (comp (filter (comp empty? :commits val)) (map key)) trimmed)]
(-> pstate
(update :queue #(into (empty %) (remove emptied) %))
(update :index #(apply dissoc (merge % trimmed) emptied))
(update :buffer #(into [] (remove dropped?) %)))))
(defn without-rolled-back
"Removes from `pstate` the commits `plan` reverts or compensates. The
in-flight `entry` keeps only the commits that stay saved."
[pstate {:keys [id file-id commits]} {:keys [files compensate]}]
(let [head (into #{} (map :id) commits)
reverted (into #{} (comp (mapcat (comp :reverted val)) (map :id)) files)
compensated (into #{} (map :id) compensate)
unsaved (into reverted compensated)]
(as-> pstate $
(drop-commits $ (into #{} (remove head) reverted))
(d/update-in-when $ [:index id :commits]
(fn [commits]
(into [] (remove (comp unsaved :id)) commits)))
(update $ :saved (fn [saved] (into [] (remove (comp compensated :id)) saved)))
(update $ :remote-changes dissoc file-id)
(reduce prune-remote-changes $ (disj (set (keys files)) file-id)))))
(defn compensation-changes
"Changes that undo the saved `commits` of one file, newest first."
[commits]
{:redo-changes (into [] (mapcat :undo-changes) (reverse commits))
:undo-changes (into [] (mapcat :redo-changes) commits)})

12
frontend/src/app/main/data/workspace/libraries.cljs
View File

@ -908,7 +908,9 @@
ptk/WatchEvent
(watch [it state _]
(log/info :msg "UPDATE-COMPONENT of shape" :id (str id) :undo-group undo-group)
(let [page-id (:current-page-id state)
(let [;; One undo group for the commits in both files
undo-group (or undo-group (uuid/next))
page-id (:current-page-id state)
libraries (dsh/lookup-libraries state)
file (dsh/lookup-file state)
@ -990,7 +992,9 @@
page (dsh/lookup-page state)
shape (ctn/get-shape page shape-id)
component-id (:component-id shape)
undo-id (js/Symbol)]
undo-id (js/Symbol)
;; One undo group for the update and the syncs, in any file
undo-group (or undo-group (uuid/next))]
(rx/of
(dwu/start-undo-transaction undo-id)
(update-component shape-id undo-group)
@ -1013,7 +1017,9 @@
ptk/WatchEvent
(watch [_ state _]
(let [current-file-id (:current-file-id state)
undo-id (js/Symbol)]
undo-id (js/Symbol)
;; One undo group for the syncs of both files
undo-group (or undo-group (uuid/next))]
(rx/of
(dwu/start-undo-transaction undo-id)
(sync-file current-file-id file-id :components component-id undo-group)

11
frontend/src/app/main/data/workspace/texts.cljs
View File

@ -1313,7 +1313,15 @@
(ptk/reify ::v2-update-text-shape-content
ptk/WatchEvent
(watch [it state _]
(if (features/active-feature? state "render-wasm/v1")
(cond
;; The shape is gone (e.g. a rollback): only forget the edit session
(not (contains? (dsh/lookup-page-objects state) id))
(rx/of (fn [state]
(-> state
(update :workspace-new-text-shapes disj id)
(update :workspace-text-session-geom (fnil dissoc {}) id))))
(features/active-feature? state "render-wasm/v1")
(let [;; v3 editor always passes :finalize? from keyword opts; when absent
;; that binds nil and :or defaults do not apply — coerce so undo flags
;; stay strict booleans for changes-builder schema validation.
@ -1437,6 +1445,7 @@
(update :workspace-new-text-shapes disj id)
(update :workspace-text-session-geom (fnil dissoc {}) id)))))))))
:else
(let [modifiers (get-in state [:workspace-text-modifier id])
new-shape? (contains? (:workspace-new-text-shapes state) id)]
(rx/of

21
frontend/src/app/main/data/workspace/undo.cljs
View File

@ -251,6 +251,27 @@
(update-in [:workspace-undo :transactions-pending] dissoc id)
(add-transaction-undo-entry)))))
(defn forget-undo-groups
"Drops the undo history from the first entry of `undo-groups` on, or all
of it if none matches, and empties the open transaction."
[undo-groups]
(ptk/reify ::forget-undo-groups
ptk/UpdateEvent
(update [_ state]
(update state :workspace-undo
(fn [{:keys [items index transaction] :as undo}]
(let [first-index (d/index-of-pred items #(contains? undo-groups (:undo-group %)))]
(cond-> undo
(some? first-index)
(assoc :items (subvec items 0 first-index)
:index (min (d/nilv index -1) (dec first-index)))
(nil? first-index)
(dissoc :items :index)
(some? transaction)
(assoc :transaction empty-tx))))))))
(def reinitialize-undo
"Clears the undo stack, removing all entries and transactions."
(ptk/reify ::reset-undo

9
frontend/src/app/main/errors.cljs
View File

@ -490,7 +490,8 @@
(defn flash
"Show error notification banner and emit error report.
A nil timeout keeps the notification visible until dismissed or replaced.
A `:tag` lets the notification be hidden later by that tag.
A `:tag` lets the notification be hidden later by that tag. `:level`
defaults to `:error`.
The payload format is derived from the cause: environment failures get a
compact report. The audit event name is the canonical one requested by
@ -521,8 +522,8 @@
synchronously from inside an error handler creates a re-entrant
event-processing cycle that can exhaust the JS call stack
(RangeError: Maximum call stack size exceeded)."
[& {:keys [type hint cause timeout tag report-link? links]
:or {type :handled timeout 5000}}]
[& {:keys [type hint cause timeout tag report-link? links level]
:or {type :handled timeout 5000 level :error}}]
(js/Promise.
(fn [resolve _reject]
(ts/schedule
@ -547,7 +548,7 @@
(ntf/show
(cond-> {:content (or ^boolean hint (tr "errors.generic"))
:type :toast
:level :error
:level level
:timeout timeout}
(some? tag)
(assoc :tag tag)

415
frontend/src/debug.cljs
View File

@ -9,11 +9,14 @@
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.files.changes-builder :as pcb]
[app.common.files.helpers :as cfh]
[app.common.files.repair :as cfr]
[app.common.files.validate :as cfv]
[app.common.json :as json]
[app.common.logging :as l]
[app.common.logic.libraries :as cll]
[app.common.path-names :as cpn]
[app.common.pprint :as pp]
[app.common.render-wasm.helpers :as wasm.h]
[app.common.render-wasm.mem :as wasm.mem]
@ -28,6 +31,7 @@
[app.main.data.common :as dcm]
[app.main.data.dashboard.shortcuts]
[app.main.data.helpers :as dsh]
[app.main.data.persistence :as dps]
[app.main.data.preview :as dp]
[app.main.data.viewer.shortcuts]
[app.main.data.workspace :as dw]
@ -614,6 +618,417 @@
[id shape-ref]
(st/emit! (set-shape-ref* id shape-ref)))
;; --- Save faults
(def ^:private rejecting-faults
"Debug faults the backend rejects a commit for."
#{"validation" "runtime" "ex-info" "assertion"})
(def ^:private request-faults
"Debug faults that fail the whole save, as an infrastructure error does."
#{"sql" "io" "interrupted" "not-found" "stack-overflow"})
(defn- debug-plugin-data-change
"A change that removes plugin data `key` of the file, which is never set,
so it changes no data."
[key]
{:type :set-plugin-data
:object-type :file
:namespace :penpot-debug
:key key
:value nil})
(defn- save-fault-marker
"A change that makes the backend fail with `fault` when it applies it
(`debug-save-faults` backend flag). It changes no data."
[fault]
(debug-plugin-data-change (str "save-fault:" fault)))
(defn- fault-error
"Why `fault` is not one of `faults`, or nil if it is."
[fault faults]
(when-not (contains? faults fault)
(str "unknown fault " fault ", expected one of "
(str/join ", " (sort faults)))))
;; Armed `:hold` and `:faults` for update-file calls, and the `:original`
;; method while they wrap it.
(defonce ^:private save-hook (atom {}))
(defn- mark-save
"Adds the fault armed for the file of `params` to the commit it names,
and counts the save against it."
[params]
(let [file-id (:id params)
[old _] (swap-vals! save-hook
(fn [{:keys [faults] :as hook}]
(let [{:keys [times]} (get faults file-id)]
(cond
(nil? times) hook
(> times 1) (update-in hook [:faults file-id :times] dec)
:else (update hook :faults dissoc file-id)))))]
(if-let [{:keys [fault commit]} (get-in old [:faults file-id])]
(let [marker (save-fault-marker fault)
groups (:changes-with-metadata params)]
(if (seq groups)
(update-in params [:changes-with-metadata (min commit (dec (count groups))) :changes]
conj marker)
(update params :changes (fnil conj []) marker)))
params)))
(defn- hooked-update-file
"Sends an update-file call through `send` with the armed fault, and holds
its answer while saves are held."
[send id params]
(let [response (send id (mark-save params))]
(if-let [gate (dm/get-in @save-hook [:hold :gate])]
(rx/mapcat (fn [result]
(rx/map (constantly result) (rx/from gate)))
response)
response)))
(defn- sync-save-hook
"Wraps update-file calls while a hold or a fault is armed, and unwraps
them when none is."
[]
(let [{:keys [hold faults original]} @save-hook
armed? (or (some? hold) (seq faults))]
(cond
(and armed? (nil? original))
(let [original (get-method rp/cmd! :update-file)]
(swap! save-hook assoc :original original)
(-add-method rp/cmd! :update-file
(fn [id params] (hooked-update-file original id params))))
(and (not armed?) (some? original))
(do
(if (identical? original (get-method rp/cmd! :default))
(remove-method rp/cmd! :update-file)
(-add-method rp/cmd! :update-file original))
(swap! save-hook dissoc :original)))))
(defn ^:export releaseSaves
"Answers the held saves now and stops holding new ones."
[]
(when-let [{:keys [gate timer]} (:hold @save-hook)]
(js/clearTimeout timer)
(p/resolve gate nil))
(swap! save-hook dissoc :hold)
(sync-save-hook)
"saves are answered as they arrive")
(defn ^:export holdSaves
"Holds the answers to the saves sent in the next `seconds` (default 5)
until then, or until `debug.releaseSaves()`. The backend applies each
save at once; only the tab waits, so edits made meanwhile stay pending
behind it, as with a slow backend.
debug.holdSaves()
debug.holdSaves(10)"
([] (holdSaves 5))
([seconds]
(releaseSaves)
(swap! save-hook assoc :hold {:gate (p/deferred)
:timer (js/setTimeout releaseSaves (* 1000 seconds))})
(sync-save-hook)
(str "holding the answers to saves for " seconds " seconds")))
(defn ^:export failNextSave
"Makes the backend fail the next `times` saves (default 1) of a file (by
default the open one) with `fault`, from the commit at index `commit`
(default 0) on. Needs the `debug-save-faults` backend flag.
Faults 'validation', 'runtime', 'ex-info' and 'assertion' reject the
commits from that one on; 'sql', 'io', 'interrupted', 'not-found' and
'stack-overflow' fail the whole save, as an infrastructure error does.
A retry is a new save and counts against `times`.
debug.failNextSave({fault: 'sql'})
debug.failNextSave({fault: 'runtime', commit: 2, times: 3, fileId: '…'})"
[options]
(let [{:keys [fault times commit fileId]
:or {times 1 commit 0}} (js->clj options :keywordize-keys true)
file-id (if fileId (uuid/parse fileId) (:current-file-id @st/state))]
(or (fault-error fault (into rejecting-faults request-faults))
(do
(swap! save-hook assoc-in [:faults file-id]
{:fault fault :times times :commit commit})
(sync-save-hook)
(str "the next " times " saves of " file-id " fail with " fault
" from commit " commit " on")))))
(defn ^:export clearSaveFaults
"Disarms every fault armed with `debug.failNextSave`."
[]
(swap! save-hook dissoc :faults)
(sync-save-hook)
"no save fault armed")
(defn- pending-of-file
"Applies `f` to the pending commits of `file-id`, queued and buffered."
[pstate file-id f]
(let [file? #(= file-id (:file-id %))
queued (filter #(file? (get-in pstate [:index %])) (:queue pstate))
buffered #(if (file? %) (f %) %)]
(as-> pstate $
(reduce (fn [pstate id] (update-in pstate [:index id :commits] #(mapv f %))) $ queued)
(update $ :buffer #(mapv buffered %)))))
(defn ^:export failNextRollback
"Makes the undo of the commits pending now in the open file fail if a
rollback reverts them, so the rollback falls back to reloading the
file. Pair it with `debug.holdSaves` to have commits pending.
debug.holdSaves(); debug.commitInvalidChange(); debug.failNextRollback()"
[]
(let [state @st/state
file-id (:current-file-id state)]
(if (empty? (concat (:queue (:persistence state)) (:buffer (:persistence state))))
"nothing is pending: hold the saves and commit something first"
(do
(st/emit!
(ptk/reify ::fail-next-rollback
ptk/UpdateEvent
(update [_ state]
;; A change type with no handler, so applying it throws
(update state :persistence pending-of-file file-id
#(update % :undo-changes (fn [changes]
(into [{:type :debug-fail}] changes)))))))
"the next rollback of the pending commits fails and reloads the file"))))
(defn- get-persistence-summary
"What is pending in the tab and what could block the user."
[state]
(let [{:keys [status queue index buffer saved remote-changes]} (:persistence state)
queued (count (mapcat #(get-in index [% :commits]) queue))
warn? (contains? @st/ongoing-tasks :persistence)
crash? (some? (:exception state))]
{:status status
:queued queued
:buffered (count buffer)
:saved (count saved)
:remoteChanges (count (mapcat val remote-changes))
:leaveWarning warn?
:undoItems (count (dm/get-in state [:workspace-undo :items]))
:edition (some-> (dm/get-in state [:workspace-local :edition]) str)
:crashed crash?
:held (some? (:hold @save-hook))
:faults (count (:faults @save-hook))
:clean (and (contains? #{nil :saved} status)
(zero? queued)
(empty? buffer)
(empty? saved)
(empty? remote-changes)
(not warn?)
(not crash?))}))
(defn ^:export persistenceState
"The save state of the tab: what is pending, the leave-page warning, the
undo history, the edited shape and a crash. `clean` is true when nothing
is pending and nothing blocks the user."
[]
(clj->js (get-persistence-summary @st/state)))
;; --- Invalid changes
(def ^:private invalid-change-kinds
"Ways to break page objects that backend validation rejects, with the
error code each raises."
{"parent" {:code :parent-not-found
:break (fn [objects shape]
(assoc-in objects [(:id shape) :parent-id] (uuid/next)))}
"child" {:code :child-not-found
:break (fn [objects shape]
(update-in objects [(:parent-id shape) :shapes] conj (uuid/next)))}})
(defn- changed-ids
[objects objects']
(into [] (remove #(identical? (get objects %) (get objects' %))) (keys objects')))
(defn- renamed-main-instances
"Main instances whose name differs between `objects` and `objects'`."
[objects objects']
(into []
(comp (map #(get objects' %))
(filter ctk/main-instance?)
(remove #(= (:name %) (:name (get objects (:id %))))))
(changed-ids objects objects')))
(defn- rename-components
"Renames in `data` the components of the main instances renamed in
`objects'`."
[data objects objects']
(reduce (fn [data {:keys [component-id name]}]
(let [[path name] (cpn/split-group-name name)]
(update-in data [:components component-id] assoc :path path :name name)))
data
(renamed-main-instances objects objects')))
(defn- objects-changes
"Changes for the shapes that differ between `objects` and `objects'`."
[origin page-id objects objects']
(-> (pcb/empty-changes origin page-id)
(pcb/with-objects objects)
(pcb/update-shapes (changed-ids objects objects') #(get objects' (:id %)))))
(defn- commit-objects-change
"Commits the shapes that differ between `objects` and `objects'`. A
renamed main instance renames its component too, as validation requires.
`params` go to `commit-changes`."
[origin page-id data objects objects' params]
(dwc/commit-changes
(merge (reduce (fn [changes {:keys [component-id name]}]
(cll/generate-rename-component changes component-id name data))
(objects-changes origin page-id objects objects')
(renamed-main-instances objects objects'))
params)))
(defn- objects-step
"A step that commits the shapes `f` changes in the page objects, with
`params` for `commit-changes`."
([f] (objects-step f nil))
([f params]
(fn [origin page-id data objects]
(let [objects' (f objects)]
[(rename-components data objects objects')
objects'
(commit-objects-change origin page-id data objects objects' params)]))))
(defn- fault-step
"A step that commits a marker the backend fails on with `fault`, with
`params` for `commit-changes`."
[fault params]
(fn [origin _ data objects]
[data
objects
;; A real undo change, so the commit gets an undo entry as others do
(dwc/commit-changes (merge {:origin origin
:redo-changes [(save-fault-marker fault)]
:undo-changes [(debug-plugin-data-change "save-fault-undo")]}
params))]))
(defn ^:export commitInvalidChange
"Commits a change that the backend rejects, on the selected shape or the
first one of the page, with optional valid renames before and after it,
all in one save.
Kinds: 'parent' (the shape points to a missing parent, the default) and
'child' (its parent lists a missing child). With `fault` ('validation',
'runtime', 'ex-info' or 'assertion') the bad commit changes nothing and
the backend fails on it with that error instead (`debug-save-faults`
backend flag). With `undo: false` the bad commit gets no undo entry, so
rolling it back clears the whole undo history.
debug.commitInvalidChange()
debug.commitInvalidChange({kind: 'child', before: 2, after: 1})
debug.commitInvalidChange({fault: 'runtime', before: 1})
debug.commitInvalidChange({undo: false})"
([] (commitInvalidChange nil))
([options]
(let [{:keys [kind fault before after undo]
:or {kind "parent" before 0 after 0 undo true}} (js->clj options :keywordize-keys true)
state @st/state
objects (dsh/lookup-page-objects state)
shape-id (or (first (dm/get-in state [:workspace-local :selected]))
(first (dm/get-in objects [uuid/zero :shapes])))
shape (get objects shape-id)
{:keys [code break]} (get invalid-change-kinds kind)]
(cond
(nil? break)
(str "unknown kind " kind ", expected one of "
(str/join ", " (keys invalid-change-kinds)))
(and (some? fault) (fault-error fault rejecting-faults))
(fault-error fault rejecting-faults)
(nil? shape)
"select a shape, or open a page that has one"
:else
(let [rename (fn [label]
(objects-step #(assoc-in % [shape-id :name] (str (:name shape) " [" label "]"))))
steps (concat (map #(rename (str "before " (inc %))) (range before))
[(if fault
(fault-step fault {:save-undo? undo})
(objects-step #(break % shape) {:save-undo? undo}))]
(map #(rename (str "after " (inc %))) (range after)))]
(st/emit!
(ptk/reify ::commit-invalid-change
ptk/WatchEvent
(watch [it state _]
(let [page-id (:current-page-id state)
commits (->> steps
(reduce (fn [[data objects commits] step]
(let [[data objects commit] (step it page-id data objects)]
[data objects (conj commits commit)]))
[(dsh/lookup-file-data state) (dsh/lookup-page-objects state) []])
(last))]
(rx/concat
(rx/from commits)
;; Saves once all commits are buffered and the 200ms pending debounce passed
(->> (rx/timer 300)
(rx/map (constantly ::dps/force-persist))))))))
(str "committed " (+ before 1 after) " changes on '" (:name shape)
"'; commit " (inc before) " should fail with " (or fault (name code))))))))
(defn- broken-component-change
"A change that points the component of `shape`, or the first one of the
file, to a main instance that does not exist."
[data shape]
(when-let [component-id (or (:component-id shape)
(:id (first (ctkl/components-seq data))))]
{:type :mod-component
:id component-id
:main-instance-id (uuid/next)}))
(defn ^:export saveBrokenData
"Saves, skipping backend validation, data that fails it: the kinds of
`debug.commitInvalidChange` on the selected shape or the first one of the
page, or 'component' (the component of the selected shape, or the first
of the file, points to a missing main instance). Then reloads the tab so
it opens the broken file. Undo with `debug.repair()`.
debug.saveBrokenData({kind: 'child'})
debug.saveBrokenData({kind: 'component'})"
([] (saveBrokenData nil))
([options]
(let [{:keys [kind] :or {kind "parent"}} (js->clj options :keywordize-keys true)
state @st/state
file (dsh/lookup-file state)
page-id (:current-page-id state)
objects (dsh/lookup-page-objects state)
shape (get objects (or (first (dm/get-in state [:workspace-local :selected]))
(first (dm/get-in objects [uuid/zero :shapes]))))
break (get-in invalid-change-kinds [kind :break])
changes (cond
(= "component" kind)
(some-> (broken-component-change (:data file) shape) vector)
(and (some? break) (some? shape))
(:redo-changes (objects-changes nil page-id objects (break objects shape))))]
(cond
(not (:clean (get-persistence-summary state)))
"wait until every change is saved"
(empty? changes)
(str "nothing to break: kinds are " (str/join ", " (keys invalid-change-kinds))
" and component, and they need a shape or a component")
:else
(do
(->> (rp/cmd! :update-file {:id (:id file)
:revn (:revn file)
:vern (:vern file)
:session-id (:session-id state)
:features (:features state)
:changes changes
:skip-validate true})
(rx/subs! (fn [_] (dom/reload-current-window))
(fn [cause] (ex/print-throwable cause))))
(str "saving broken " kind " data, then reloading"))))))
(defn ^:export network-averages
[]
(.log js/console (clj->js @http/network-averages)))

108
frontend/test/frontend_tests/data/persistence_commits_test.cljs Normal file
View File

@ -0,0 +1,108 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns frontend-tests.data.persistence-commits-test
"Tests for the pure commit bookkeeping of persistence
(`app.main.data.persistence.commits`)."
(:require
[app.common.uuid :as uuid]
[app.main.data.persistence.commits :as pcm]
[cljs.test :as t :include-macros true]))
(defn- commit
[file-id undo-group]
{:id (uuid/next)
:file-id file-id
:file-revn 0
:file-vern 0
:features #{}
:source :local
:undo-group undo-group
:redo-changes [{:type :mod-page :id (uuid/next) :name "redo"}]
:undo-changes [{:type :mod-page :id (uuid/next) :name "undo"}]
:remote-seq 0})
(defn- queued
"Persistence state with `entries` queued, in order."
[& entries]
{:queue (into #queue [] (map :id) entries)
:index (into {} (map (juxt :id identity)) entries)})
(t/deftest a-queue-entry-keeps-only-what-a-save-needs
(let [file-id (uuid/next)
c1 (commit file-id (uuid/next))
c2 (commit file-id (uuid/next))
entry (pcm/queue-entry [c1 c2])]
(t/is (= (:id c1) (:id entry)))
(t/is (= file-id (:file-id entry)))
(t/is (not (contains? entry :redo-changes)))
(t/is (= [(:id c1) (:id c2)] (mapv :id (:commits entry))))
(t/is (not (contains? (first (:commits entry)) :source)))))
(t/deftest pending-commits-are-the-queued-then-the-buffered-of-one-file
(let [file-id (uuid/next)
other-id (uuid/next)
c1 (commit file-id nil)
c2 (commit other-id nil)
c3 (commit file-id nil)
pstate (assoc (queued (pcm/queue-entry [c1]) (pcm/queue-entry [c2]))
:buffer [c3])]
(t/is (= [(:id c1) (:id c3)] (mapv :id (pcm/pending-commits pstate file-id))))))
(t/deftest a-rollback-plan-reverts-whole-undo-groups-across-files
(let [file-id (uuid/next)
lib-id (uuid/next)
group (uuid/next)
kept (commit file-id (uuid/next))
bad (commit file-id (uuid/next))
lib-1 (commit lib-id (uuid/next))
lib-2 (commit lib-id (uuid/next))
linked (commit lib-id group)
later (commit file-id group)
saved (assoc (commit lib-id group) :file-id lib-id)
head (pcm/queue-entry [kept bad])
pstate (-> (queued head (pcm/queue-entry [lib-1 linked lib-2]))
(assoc :buffer [later]
:saved [saved]))
plan (pcm/rollback-plan pstate head {:commit-ids [(:id bad)]})]
(t/testing "this file reverts from the rejected commit on"
(t/is (= [(:id bad) (:id later)]
(mapv :id (get-in plan [:files file-id :reverted])))))
(t/testing "the library reverts from the commit that shares a group on"
(t/is (= [(:id linked) (:id lib-2)]
(mapv :id (get-in plan [:files lib-id :reverted]))))
(t/is (= [(:id lib-1)] (mapv :id (get-in plan [:files lib-id :redo])))))
(t/testing "saved commits of a reverted group are compensated"
(t/is (= [(:id saved)] (mapv :id (:compensate plan)))))
(t/is (= {:reverted 5 :files 2} (pcm/rollback-summary plan)))
(t/testing "the rolled back commits leave the queue and the buffer"
(let [pstate' (pcm/without-rolled-back pstate head plan)]
(t/is (= [(:id kept)] (mapv :id (get-in pstate' [:index (:id head) :commits]))))
(t/is (= [(:id lib-1)]
(mapv :id (get-in pstate' [:index (:id lib-1) :commits]))))
(t/is (empty? (:buffer pstate')))
(t/is (empty? (:saved pstate')))))))
(t/deftest an-entry-left-without-commits-leaves-the-queue
(let [file-id (uuid/next)
lib-id (uuid/next)
group (uuid/next)
bad (commit file-id group)
linked (commit lib-id group)
head (pcm/queue-entry [bad])
lib (pcm/queue-entry [linked])
pstate (queued head lib)
plan (pcm/rollback-plan pstate head {:commit-ids [(:id bad)]})
pstate' (pcm/without-rolled-back pstate head plan)]
(t/is (= [(:id head)] (vec (:queue pstate'))) "the in-flight entry stays until it is discarded")
(t/is (not (contains? (:index pstate') (:id lib))))))
(t/deftest compensation-undoes-newest-first
(let [c1 {:redo-changes [:r1] :undo-changes [:u1]}
c2 {:redo-changes [:r2] :undo-changes [:u2]}]
(t/is (= {:redo-changes [:u2 :u1] :undo-changes [:r1 :r2]}
(pcm/compensation-changes [c1 c2])))))

540
frontend/test/frontend_tests/data/persistence_test.cljs
View File

@ -23,8 +23,10 @@
[app.main.data.changes :as dch]
[app.main.data.event :as ev]
[app.main.data.persistence :as dps]
[app.main.data.persistence.commits :as pcm]
[app.main.data.render-wasm :as drw]
[app.main.data.workspace :as dw]
[app.main.data.workspace.undo :as dwu]
[app.main.errors :as errors]
[app.main.refs :as refs]
[app.main.repo :as rp]
@ -66,13 +68,13 @@
:error {:cause-type cause-type :commit-id first-id}
:queue (into #queue [] [first-id next-id other-id])
:index {first-id {:file-id file-id :file-vern 0
:redo-changes [{:type :add-obj :id shape-id :obj shape
:page-id page-id :parent-id uuid/zero
:frame-id uuid/zero}]}
:commits [{:redo-changes [{:type :add-obj :id shape-id :obj shape
:page-id page-id :parent-id uuid/zero
:frame-id uuid/zero}]}]}
next-id {:file-id file-id :file-vern 0
:redo-changes [(rename "Retained rectangle")]}
:commits [{:redo-changes [(rename "Retained rectangle")]}]}
other-id {:file-id (uuid/next) :file-vern 0
:redo-changes [(rename "Another file")]}}}
:commits [{:redo-changes [(rename "Another file")]}]}}}
state {:persistence pstate}
loaded (ptk/update (#'dw/bundle-fetched {:file file :file-id file-id :thumbnails {}})
state)
@ -84,6 +86,33 @@
(t/is (identical? pstate (:persistence loaded))
"restoring the editor must preserve the save queue")))))
;; Scenario: a file loads again while an edit of it waits in the buffer.
;; Proves: buffered edits apply too, after the queued ones, and those of
;; other files do not.
(t/deftest reopening-restores-the-buffered-edits-after-the-queued-ones
(let [file-id (uuid/next)
page-id (uuid/next)
commit-id (uuid/next)
rename (fn [name]
{:type :mod-obj :id uuid/zero :page-id page-id
:operations [{:type :set :attr :name :val name}]})
file {:id file-id
:vern 0
:data {:pages [page-id]
:pages-index {page-id {:id page-id :name "Page"
:objects {uuid/zero
(cts/setup-shape {:id uuid/zero :type :frame})}}}}}
pstate {:status :saving
:queue (into #queue [] [commit-id])
:index {commit-id {:file-id file-id :file-vern 0
:commits [{:redo-changes [(rename "Queued")]}]}}
:buffer [{:file-id file-id :file-vern 0 :redo-changes [(rename "Buffered")]}
{:file-id (uuid/next) :file-vern 0 :redo-changes [(rename "Another file")]}]}
loaded (ptk/update (#'dw/bundle-fetched {:file file :file-id file-id :thumbnails {}})
{:persistence pstate})]
(t/is (= "Buffered"
(get-in loaded [:files file-id :data :pages-index page-id :objects uuid/zero :name])))))
;; Scenario: a queued edit no longer applies to the data the server sent, so
;; replaying it throws. Proves: the file still opens, as the server sent it,
;; and the edits stay queued.
@ -99,8 +128,8 @@
pstate {:status :saving
:queue (into #queue [] [commit-id])
:index {commit-id {:file-id file-id :file-vern 0
:redo-changes [{:type :mod-obj :id uuid/zero :page-id page-id
:operations [{:type :no-longer-supported}]}]}}}
:commits [{:redo-changes [{:type :mod-obj :id uuid/zero :page-id page-id
:operations [{:type :no-longer-supported}]}]}]}}}
loaded (ptk/update (#'dw/bundle-fetched {:file file :file-id file-id :thumbnails {}})
{:persistence pstate})]
(t/is (identical? data (get-in loaded [:files file-id :data])))
@ -771,7 +800,7 @@
(await
(with-persistence
(^:async fn [{:keys [file-id response requests store]}]
(let [commit (assoc @(local-commit file-id) :changes [])
(let [commit (pcm/queue-entry [@(local-commit file-id)])
id (:id commit)]
(ptk/emit! store
#(assoc % :persistence {:queue (conj #queue [] id)
@ -890,7 +919,7 @@
(await
(with-persistence
(^:async fn [{:keys [file-id response requests store]}]
(let [commit (assoc @(local-commit file-id) ::dps/request-id (uuid/next))
(let [commit (assoc (pcm/queue-entry [@(local-commit file-id)]) ::dps/request-id (uuid/next))
id (:id commit)]
(ptk/emit! store
#(assoc % :persistence {:queue (conj #queue [] id)
@ -1201,8 +1230,7 @@
;; Scenario: an edit waits in the buffer when another user's change to the
;; same attribute arrives. The server will apply the remote change first and
;; the buffered edit after it, so the local file must end the same way.
;; Proves: a remote commit is applied under buffered edits too, not only
;; under queued ones.
;; Proves: a remote commit is applied under buffered edits too.
(t/deftest ^:async a-remote-commit-goes-under-buffered-edits
(await
(with-persistence
@ -1228,3 +1256,493 @@
:undo-changes []}))
(await (async/settle))
(t/is (= "Local" (shape-name store file-id page-id shape-id))))))))))
;; Commit boundaries.
;; Scenario: two edits are buffered and saved together. The request carries
;; one group per edit, each with its commit id and its own changes, so the
;; backend can accept or reject them one by one. Proves: merging a buffer
;; for one request keeps the boundaries between commits.
(t/deftest ^:async a-save-sends-each-commit-as-its-own-group
(await
(with-persistence
(^:async fn [{:keys [file-id response requests store]}]
(let [commit1 (local-commit file-id)
commit2 (local-commit file-id)]
(ptk/emit! store commit1 commit2 ::dps/force-persist)
(await (async/wait-for #(= 1 (count @requests)) "both edits go in one save"))
(let [[_ params] (first @requests)]
(t/is (not (contains? params :changes)))
(t/is (= [{:commit-id (:id @commit1) :changes (:redo-changes @commit1)}
{:commit-id (:id @commit2) :changes (:redo-changes @commit2)}]
(:changes-with-metadata params))))
(rx/push! response {:revn 1})
(await (async/wait-for #(= :saved (get-in @store [:persistence :status]))
"the save lands")))))))
;; Rollback of rejected commits.
;; Scenario: the first save carries two commits; while it is in flight a
;; third one is queued, an edit of another file is queued too, and a fourth
;; one waits in the buffer. The server keeps the first commit and rejects
;; the second. The file goes back to the first commit: the rejected one and
;; every later one of that file are undone and dropped from the queue, the
;; buffer and the undo history, while the other file's edit is still sent.
;; Proves: a rejection leaves the file as the server holds it and the queue
;; keeps going.
(t/deftest ^:async a-rejected-save-undoes-the-rejected-commit-and-every-later-one
(await
(with-persistence
(^:async fn [{:keys [file-id response requests store failures]}]
(await
(mock/with-mocks*
{mw/ask! (mock/stub (fn [_] (rx/empty)))}
(let [page-id (uuid/next)
shape-id (uuid/next)
other-id (uuid/next)
commit1 (rename-commit file-id page-id shape-id "A" "B")
commit2 (rename-commit file-id page-id shape-id "B" "C")
commit3 (rename-commit file-id page-id shape-id "C" "D")
commit4 (rename-commit file-id page-id shape-id "D" "E")
other (local-commit other-id)
entry (fn [commit] {:undo-group (:undo-group @commit)
:undo-changes (:undo-changes @commit)
:redo-changes (:redo-changes @commit)
:tags #{}})]
;; The local data already holds the four renames
(ptk/emit! store
#(-> %
(assoc :current-page-id page-id)
(assoc-in [:files file-id :data] (file-data page-id shape-id "E"))
(assoc-in [:files other-id] {:id other-id :revn 0})
(assoc :workspace-undo {:items (mapv entry [commit1 commit2 commit3 commit4])
:index 3})
(assoc-in [:workspace-local :selected] #{shape-id})))
(ptk/emit! store commit1 commit2 ::dps/force-persist)
(await (async/wait-for #(= 1 (count @requests)) "the first two commits are sent"))
(ptk/emit! store commit3 other ::dps/force-persist)
(await (async/wait-for #(= 3 (count (get-in @store [:persistence :queue])))
"the third commit and the other file's edit are queued"))
(ptk/emit! store commit4)
(await (async/wait-for #(seq (get-in @store [:persistence :buffer]))
"the fourth commit is buffered"))
(rx/push! response {:revn 0
:rejected {:commit-ids [(:id @commit2)]
:failed-commit-id (:id @commit2)
:error {:type :validation :code :referential-integrity}}})
(await (async/wait-for #(= 2 (count @requests)) "the other file's edit is sent next"))
(t/is (= "B" (shape-name store file-id page-id shape-id))
"the file holds the commits the server kept")
(t/is (= [other-id] (mapv #(get-in @store [:persistence :index % :file-id])
(get-in @store [:persistence :queue])))
"only the other file's edit is still queued")
(t/is (empty? (get-in @store [:persistence :buffer])))
(t/is (= [(:undo-group @commit1)]
(mapv :undo-group (get-in @store [:workspace-undo :items]))))
(t/is (= 0 (get-in @store [:workspace-undo :index])))
(t/is (= 1 (count @failures)) "the user is told once")
(t/is (= other-id (get-in (second @requests) [1 :id])))
(rx/push! response {:revn 1})
(await (async/wait-for #(= :saved (get-in @store [:persistence :status]))
"the queue drains")))))))))
;; Scenario: an edit is buffered while a save is in flight and the save comes
;; back rejected, so the rollback drops the edit; the 200 ms pending notice
;; of that edit fires afterwards. Proves: with nothing left to save the
;; notice is ignored and the status stays :saved, so waiters such as "Pin
;; this version" are not left hanging.
(t/deftest ^:async a-pending-notice-after-a-rollback-leaves-the-status-saved
(await
(with-persistence
(^:async fn [{:keys [file-id response requests store]}]
(await
(mock/with-mocks*
{mw/ask! (mock/stub (fn [_] (rx/empty)))}
(let [page-id (uuid/next)
shape-id (uuid/next)
commit1 (rename-commit file-id page-id shape-id "A" "B")
commit2 (rename-commit file-id page-id shape-id "B" "C")]
(ptk/emit! store
#(-> %
(assoc :current-page-id page-id)
(assoc-in [:files file-id :data] (file-data page-id shape-id "C"))))
(ptk/emit! store commit1 ::dps/force-persist)
(await (async/wait-for #(= 1 (count @requests)) "the first commit is sent"))
(ptk/emit! store commit2)
(rx/push! response {:revn 0
:rejected {:commit-ids [(:id @commit1)]
:failed-commit-id (:id @commit1)
:error {:type :validation :code :referential-integrity}}})
(await (async/wait-for #(and (= :saved (get-in @store [:persistence :status]))
(empty? (get-in @store [:persistence :buffer])))
"the rollback drops both commits"))
;; The notice the dropped edit scheduled
(ptk/emit! store (#'dps/update-status :pending))
(await (async/settle))
(t/is (= :saved (get-in @store [:persistence :status]))))))))))
(defn- set-attr
[page-id shape-id attr val]
{:type :mod-obj :id shape-id :page-id page-id
:operations [{:type :set :attr attr :val val}]})
(defn- attr-commit
"A local commit of `file-id` that sets `attr` from `from` to `to`."
[file-id page-id shape-id attr from to]
(ptk/data-event ::dch/commit
{:id (uuid/next)
:file-id file-id
:file-revn 0
:file-vern 0
:source :local
:features #{}
:undo-group (uuid/next)
:redo-changes [(set-attr page-id shape-id attr to)]
:undo-changes [(set-attr page-id shape-id attr from)]}))
(defn- remote-commit
[file-id revn changes]
(dch/commit {:file-id file-id
:file-revn revn
:file-vern 0
:source :remote
:save-undo? false
:redo-changes changes
:undo-changes []}))
(defn- shape-attr
[store file-id page-id shape-id attr]
(get-in @store [:files file-id :data :pages-index page-id :objects shape-id attr]))
(def ^:private rejected-second
(fn [commit]
{:revn 0
:rejected {:commit-ids [(:id @commit)]
:failed-commit-id (:id @commit)
:error {:type :validation :code :referential-integrity}}}))
;; Scenario: two edits wait in the buffer, the second one changing the
;; opacity, when a peer's opacity change arrives. The server keeps the first
;; edit and rejects the second. The server holds the peer's opacity, so the
;; local file must too, not the opacity from before the rejected edit.
;; Proves: the rollback applies the peer's changes again over the undone
;; commits.
(t/deftest ^:async a-rollback-keeps-a-peer-change-to-the-same-attribute
(await
(with-persistence
(^:async fn [{:keys [file-id response requests store]}]
(await
(mock/with-mocks*
{mw/ask! (mock/stub (fn [_] (rx/empty)))}
(let [page-id (uuid/next)
shape-id (uuid/next)
commit1 (rename-commit file-id page-id shape-id "A" "B")
commit2 (attr-commit file-id page-id shape-id :opacity 0.5 0.9)]
(ptk/emit! store #(-> %
(assoc :current-page-id page-id)
(assoc-in [:files file-id :data]
(-> (file-data page-id shape-id "B")
(assoc-in [:pages-index page-id :objects shape-id :opacity] 0.9)))))
(ptk/emit! store commit1 commit2)
(await (async/wait-for #(= 2 (count (get-in @store [:persistence :buffer])))
"both edits are buffered"))
(ptk/emit! store (remote-commit file-id 1 [(set-attr page-id shape-id :opacity 0.3)]))
(await (async/settle))
(t/is (= 0.9 (shape-attr store file-id page-id shape-id :opacity))
"the local edit stays on top of the peer's while pending")
(ptk/emit! store ::dps/force-persist)
(await (async/wait-for #(= 1 (count @requests)) "the edits are sent"))
(rx/push! response (rejected-second commit2))
(await (async/wait-for #(= :saved (get-in @store [:persistence :status]))
"the rollback settles"))
(t/is (= 0.3 (shape-attr store file-id page-id shape-id :opacity))
"the peer's opacity, as on the server")
(t/is (= "B" (shape-name store file-id page-id shape-id))
"the kept edit stays"))))))))
;; Scenario: a peer's opacity change arrives while an opacity edit is
;; pending; that edit is saved (on the server it lands after the peer's).
;; Later two new edits are sent and the second is rejected. The rollback
;; must not apply the old peer change again, which would undo the saved
;; edit. Proves: remote changes older than the oldest pending commit are
;; forgotten once the commits pending before them are saved.
(t/deftest ^:async a-rollback-ignores-peer-changes-older-than-the-pending-commits
(await
(with-persistence
(^:async fn [{:keys [file-id response requests store]}]
(await
(mock/with-mocks*
{mw/ask! (mock/stub (fn [_] (rx/empty)))}
(let [page-id (uuid/next)
shape-id (uuid/next)
commit0 (attr-commit file-id page-id shape-id :opacity 0.5 0.7)
commit1 (rename-commit file-id page-id shape-id "A" "B")
commit2 (rename-commit file-id page-id shape-id "B" "C")]
(ptk/emit! store #(-> %
(assoc :current-page-id page-id)
(assoc-in [:files file-id :data]
(-> (file-data page-id shape-id "A")
(assoc-in [:pages-index page-id :objects shape-id :opacity] 0.7)))))
(ptk/emit! store commit0)
(await (async/wait-for #(seq (get-in @store [:persistence :buffer])) "the edit is buffered"))
(ptk/emit! store (remote-commit file-id 1 [(set-attr page-id shape-id :opacity 0.3)]))
(ptk/emit! store ::dps/force-persist)
(await (async/wait-for #(= 1 (count @requests)) "the opacity edit is sent"))
(rx/push! response {:revn 1})
(await (async/wait-for #(= :saved (get-in @store [:persistence :status]))
"the opacity edit is saved"))
(t/is (empty? (get-in @store [:persistence :remote-changes file-id]))
"nothing pending, nothing kept")
(ptk/emit! store
#(assoc-in % [:files file-id :data :pages-index page-id :objects shape-id :name] "C")
commit1 commit2 ::dps/force-persist)
(await (async/wait-for #(= 2 (count @requests)) "the renames are sent"))
(rx/push! response (rejected-second commit2))
(await (async/wait-for #(= "B" (shape-name store file-id page-id shape-id))
"the rejected rename is undone"))
(t/is (= 0.7 (shape-attr store file-id page-id shape-id :opacity))
"the saved opacity edit stays"))))))))
(defn- grouped
"`commit` with its undo group set to `group`: one action that makes
several commits gives them the same undo group."
[commit group]
(ptk/data-event ::dch/commit (assoc @commit :undo-group group)))
(defn- with-library
"Store state holding this file's data and a library file `lib-id` with
one rectangle each, named `name` and `lib-name`."
[file-id lib-id page-id shape-id name lshape-id lib-name]
#(-> %
(assoc :current-page-id page-id)
(assoc-in [:files file-id :data] (file-data page-id shape-id name))
(assoc-in [:files lib-id] {:id lib-id :revn 0 :data (file-data page-id lshape-id lib-name)})))
(defn- sent-changes
"The changes of each group of the `n`th save request."
[requests n]
(mapv :changes (get-in (nth @requests n) [1 :changes-with-metadata])))
;; Scenario: one action makes a commit in this file and one in a library
;; (as updating a main component from a copy does). The library also has an
;; unrelated edit before the action and another after it. This file's save
;; comes back with the action's commit rejected while the library's commits
;; are still queued. Proves: the rejection reverts the whole action, so the
;; library drops its commit of the action and every later one, and keeps
;; the edit made before it.
(t/deftest ^:async a-rejection-reverts-the-pending-commits-of-the-same-action-in-other-files
(await
(with-persistence
(^:async fn [{:keys [file-id response requests store]}]
(await
(mock/with-mocks*
{mw/ask! (mock/stub (fn [_] (rx/empty)))}
(let [lib-id (uuid/next)
page-id (uuid/next)
shape-id (uuid/next)
lshape-id (uuid/next)
group (uuid/next)
commit1 (rename-commit file-id page-id shape-id "A" "B")
commit2 (grouped (rename-commit file-id page-id shape-id "B" "C") group)
before (rename-commit lib-id page-id lshape-id "X" "Y")
linked (grouped (rename-commit lib-id page-id lshape-id "Y" "Z") group)
after (rename-commit lib-id page-id lshape-id "Z" "W")]
(ptk/emit! store (with-library file-id lib-id page-id shape-id "C" lshape-id "W"))
(ptk/emit! store commit1 commit2 before linked after ::dps/force-persist)
(await (async/wait-for #(= 1 (count @requests)) "this file's save is sent"))
(rx/push! response (rejected-second commit2))
(await (async/wait-for #(= 2 (count @requests)) "the library's save is sent next"))
(t/is (= "B" (shape-name store file-id page-id shape-id)))
(t/is (= "Y" (shape-name store lib-id page-id lshape-id))
"the library goes back to the edit made before the action")
(t/is (= lib-id (get-in (second @requests) [1 :id])))
(t/is (= [[(rename page-id lshape-id "Y")]] (sent-changes requests 1))
"only the library's edit made before the action is saved")
(rx/push! response {:revn 1})
(await (async/wait-for #(= :saved (get-in @store [:persistence :status]))
"the queue drains")))))))))
;; Scenario: one action makes a commit in a library and one in this file.
;; The library's is saved first; then this file's save comes back with the
;; action's commit rejected. The library's commit can no longer be dropped.
;; Proves: a new commit undoes the saved part of the rejected action.
(t/deftest ^:async a-rejection-undoes-the-saved-commits-of-the-same-action-with-a-new-commit
(await
(with-persistence
(^:async fn [{:keys [file-id response requests store]}]
(await
(mock/with-mocks*
{mw/ask! (mock/stub (fn [_] (rx/empty)))}
(let [lib-id (uuid/next)
page-id (uuid/next)
shape-id (uuid/next)
lshape-id (uuid/next)
group (uuid/next)
linked (grouped (rename-commit lib-id page-id lshape-id "X" "Y") group)
commit (grouped (rename-commit file-id page-id shape-id "A" "B") group)]
(ptk/emit! store (with-library file-id lib-id page-id shape-id "B" lshape-id "Y"))
(ptk/emit! store linked commit ::dps/force-persist)
(await (async/wait-for #(= 1 (count @requests)) "the library's save is sent first"))
(t/is (= lib-id (get-in (first @requests) [1 :id])))
(rx/push! response {:revn 1})
(await (async/wait-for #(= 2 (count @requests)) "this file's save is sent"))
(rx/push! response (rejected-second commit))
(await (async/wait-for #(seq (get-in @store [:persistence :buffer]))
"a new commit undoes the library's"))
(ptk/emit! store ::dps/force-persist)
(await (async/wait-for #(= 3 (count @requests)) "the new commit is sent"))
(t/is (= lib-id (get-in (nth @requests 2) [1 :id])))
(t/is (= [[(rename page-id lshape-id "X")]] (sent-changes requests 2)))
(t/is (= "A" (shape-name store file-id page-id shape-id)))
(t/is (= "X" (shape-name store lib-id page-id lshape-id)))
(rx/push! response {:revn 2})
(await (async/wait-for #(= :saved (get-in @store [:persistence :status]))
"the queue drains")))))))))
;; Scenario: as above, but the library is no longer loaded when this file's
;; save comes back. Proves: the undo of the library's saved commit is still
;; sent, without touching local data the library no longer has.
(t/deftest ^:async a-rejection-queues-the-undo-of-a-saved-commit-of-a-file-not-loaded
(await
(with-persistence
(^:async fn [{:keys [file-id response requests store]}]
(await
(mock/with-mocks*
{mw/ask! (mock/stub (fn [_] (rx/empty)))}
(let [lib-id (uuid/next)
page-id (uuid/next)
shape-id (uuid/next)
lshape-id (uuid/next)
group (uuid/next)
linked (grouped (rename-commit lib-id page-id lshape-id "X" "Y") group)
commit (grouped (rename-commit file-id page-id shape-id "A" "B") group)]
(ptk/emit! store (with-library file-id lib-id page-id shape-id "B" lshape-id "Y"))
(ptk/emit! store linked commit ::dps/force-persist)
(await (async/wait-for #(= 1 (count @requests)) "the library's save is sent first"))
(rx/push! response {:revn 1})
(await (async/wait-for #(= 2 (count @requests)) "this file's save is sent"))
(ptk/emit! store #(update % :files dissoc lib-id))
(rx/push! response (rejected-second commit))
(await (async/wait-for #(= 3 (count @requests)) "the undo is queued and sent"))
(t/is (= lib-id (get-in (nth @requests 2) [1 :id])))
(t/is (= [[(rename page-id lshape-id "X")]] (sent-changes requests 2)))
(t/is (empty? (get-in @store [:persistence :buffer])))
(t/is (nil? (get-in @store [:files lib-id])) "no local data is made up")
(t/is (= "A" (shape-name store file-id page-id shape-id)))
(rx/push! response {:revn 2})
(await (async/wait-for #(= :saved (get-in @store [:persistence :status]))
"the queue drains")))))))))
;; Scenario: a library edit waits to be saved when a peer's change to this
;; file arrives, and both files have a shape with the same id. Proves: a
;; remote commit goes under the pending commits of its own file only.
(t/deftest ^:async a-remote-commit-ignores-the-pending-commits-of-other-files
(await
(with-persistence
(^:async fn [{:keys [file-id store]}]
(await
(mock/with-mocks*
{mw/ask! (mock/stub (fn [_] (rx/empty)))}
(let [lib-id (uuid/next)
page-id (uuid/next)
shape-id (uuid/next)]
(ptk/emit! store (with-library file-id lib-id page-id shape-id "A" shape-id "Y"))
(ptk/emit! store (rename-commit lib-id page-id shape-id "X" "Y"))
(await (async/wait-for #(seq (get-in @store [:persistence :buffer]))
"the library edit is buffered"))
(ptk/emit! store (remote-commit file-id 1 [(set-attr page-id shape-id :opacity 0.3)]))
(await (async/settle))
(t/is (= 0.3 (shape-attr store file-id page-id shape-id :opacity)))
(t/is (= "A" (shape-name store file-id page-id shape-id))
"the library edit is not replayed on this file"))))))))
;; Scenario: one action makes two commits in this file and the save keeps
;; the first and rejects the second. Proves: the kept commit of the action
;; is undone too, with a new commit, so no action is left half done.
(t/deftest ^:async a-rejection-undoes-the-kept-commits-of-the-same-action
(await
(with-persistence
(^:async fn [{:keys [file-id response requests store]}]
(await
(mock/with-mocks*
{mw/ask! (mock/stub (fn [_] (rx/empty)))}
(let [page-id (uuid/next)
shape-id (uuid/next)
group (uuid/next)
commit1 (grouped (rename-commit file-id page-id shape-id "A" "B") group)
commit2 (grouped (attr-commit file-id page-id shape-id :opacity 1 0.5) group)]
(ptk/emit! store #(-> %
(assoc :current-page-id page-id)
(assoc-in [:files file-id :data]
(-> (file-data page-id shape-id "B")
(assoc-in [:pages-index page-id :objects shape-id :opacity] 0.5)))))
(ptk/emit! store commit1 commit2 ::dps/force-persist)
(await (async/wait-for #(= 1 (count @requests)) "the action is sent"))
(rx/push! response (rejected-second commit2))
(await (async/wait-for #(seq (get-in @store [:persistence :buffer]))
"a new commit undoes the kept one"))
(ptk/emit! store ::dps/force-persist)
(await (async/wait-for #(= 2 (count @requests)) "the new commit is sent"))
(t/is (= [[(rename page-id shape-id "A")]] (sent-changes requests 1)))
(t/is (= "A" (shape-name store file-id page-id shape-id)))
(t/is (= 1 (shape-attr store file-id page-id shape-id :opacity)))
(rx/push! response {:revn 1})
(await (async/wait-for #(= :saved (get-in @store [:persistence :status]))
"the queue drains")))))))))
;; Scenario: the rejected commit added the text being edited. Proves: the
;; rollback leaves edition mode, so the editor does not keep pointing at a
;; shape that no longer exists.
(t/deftest ^:async a-rollback-leaves-the-edition-of-a-removed-shape
(await
(with-persistence
(^:async fn [{:keys [file-id response requests store]}]
(await
(mock/with-mocks*
{mw/ask! (mock/stub (fn [_] (rx/empty)))}
(let [page-id (uuid/next)
shape-id (uuid/next)
text-id (uuid/next)
text (cts/setup-shape {:id text-id :type :text :parent-id uuid/zero :frame-id uuid/zero})
commit (ptk/data-event ::dch/commit
{:id (uuid/next)
:file-id file-id
:file-revn 0
:file-vern 0
:source :local
:features #{}
:undo-group (uuid/next)
:redo-changes [{:type :add-obj :id text-id :page-id page-id
:parent-id uuid/zero :frame-id uuid/zero :obj text}]
:undo-changes [{:type :del-obj :id text-id :page-id page-id}]})]
(ptk/emit! store #(-> %
(assoc :current-page-id page-id)
(assoc-in [:files file-id :data]
(-> (file-data page-id shape-id "A")
(assoc-in [:pages-index page-id :objects text-id] text)
(update-in [:pages-index page-id :objects uuid/zero :shapes] conj text-id)))
(assoc-in [:workspace-local :edition] text-id)))
(ptk/emit! store commit ::dps/force-persist)
(await (async/wait-for #(= 1 (count @requests)) "the new text is sent"))
(rx/push! response (rejected-second commit))
(await (async/wait-for #(nil? (get-in @store [:workspace-local :edition]))
"the rollback leaves edition mode"))
(t/is (nil? (get-in @store [:files file-id :data :pages-index page-id :objects text-id]))))))))))
(t/deftest forgetting-undo-groups-cuts-the-history-at-the-first-match
(let [[g1 g2 g3] (repeatedly 3 uuid/next)
state {:workspace-undo {:items [{:undo-group g1} {:undo-group g2} {:undo-group g3}]
:index 2
:transaction {:undo-group g3 :undo-changes [{:type :mod-page}]}}}
undo (:workspace-undo (ptk/update (dwu/forget-undo-groups #{g2 g3}) state))]
(t/is (= [g1] (mapv :undo-group (:items undo))))
(t/is (= 0 (:index undo)))
(t/is (empty? (get-in undo [:transaction :undo-changes])) "the open transaction is emptied")))
(t/deftest forgetting-undo-groups-clears-the-history-without-a-match
(let [state {:workspace-undo {:items [{:undo-group (uuid/next)}] :index 0}}
undo (:workspace-undo (ptk/update (dwu/forget-undo-groups #{(uuid/next)}) state))]
(t/is (empty? (:items undo)))
(t/is (nil? (:index undo)))))

18
frontend/test/frontend_tests/data/workspace_texts_test.cljs
View File

@ -16,8 +16,10 @@
[app.main.data.workspace.texts :as dwt]
[app.main.data.workspace.texts-events :as dwte]
[app.main.ui.workspace.shapes.text.viewport-texts-html :as vth]
[beicon.v2.core :as rx]
[cljs.test :as t :include-macros true]
[frontend-tests.helpers.state :as ths]))
[frontend-tests.helpers.state :as ths]
[potok.v2.core :as ptk]))
;; ---------------------------------------------------------------------------
;; Helpers
@ -297,6 +299,20 @@
;; schema check runs.
;; ---------------------------------------------------------------------------
;; Scenario: the text editor saves its content after its shape is gone (a
;; rollback removed it while it was being edited). Proves: nothing is
;; committed for a shape that no longer exists.
(t/deftest updating-the-content-of-a-removed-text-commits-nothing
(let [state (-> @(ths/setup-store (cthf/sample-file :file1))
(assoc :features #{}))
event (dwt/v2-update-text-shape-content (uuid/next) (txt/change-text nil "hello")
:finalize? true)
events (atom [])]
(rx/subs! #(swap! events conj %) (ptk/watch event state (rx/subject)))
(t/is (not-any? #(and (ptk/event? %)
(= :app.main.data.workspace.shapes/update-shapes (ptk/type %)))
@events))))
(t/deftest add-typography-normalises-float-line-height
(t/async
done

11
frontend/test/frontend_tests/main_errors_test.cljs
View File

@ -804,6 +804,17 @@
(t/is (= timeout (get-in state [:notification :timeout])))
(t/is (= :visible (get-in state [:notification :status]))))))))
(t/deftest flash-shows-errors-unless-asked-for-another-level
(doseq [[notify level] [[#(errors/flash :hint "Ordinary error") :error]
[#(errors/flash :hint "Undone changes" :level :warning) :warning]]]
(let [scheduled (atom [])
events (atom [])]
(with-redefs [tm/schedule (mock/stub #(swap! scheduled conj %))
st/emit! (mock/stub (fn [& emitted] (swap! events into emitted)))]
(notify)
(doseq [callback @scheduled] (callback))
(t/is (= level (get-in (ptk/update (first @events) {}) [:notification :level])))))))
(t/deftest ^:async persistence-notifications-include-an-error-report-download
(let [scheduled (atom [])
idle-callbacks (atom [])

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

@ -17,6 +17,7 @@
[frontend-tests.data.fix-deleted-fonts-test]
[frontend-tests.data.modal-test]
[frontend-tests.data.nitrate-test]
[frontend-tests.data.persistence-commits-test]
[frontend-tests.data.persistence-retry-test]
[frontend-tests.data.persistence-test]
[frontend-tests.data.profile-test]
@ -162,6 +163,7 @@
'frontend-tests.data.fix-deleted-fonts-test
'frontend-tests.data.modal-test
'frontend-tests.data.nitrate-test
'frontend-tests.data.persistence-commits-test
'frontend-tests.data.persistence-retry-test
'frontend-tests.data.persistence-test
'frontend-tests.data.profile-test

4
frontend/translations/en.po
View File

@ -1768,6 +1768,10 @@ msgid "errors.save-failed"
msgstr ""
"Autosave has stopped for this session, so your changes since the last successful save cannot be saved. Download the report to help us fix it, then reload the page, or leave this file and open it again, to keep editing."
#: src/app/main/data/persistence.cljs
msgid "errors.save-rejected-changes-undone"
msgstr "Some of your latest changes couldn't be saved and were undone. The rest of your work is saved."
#: src/app/main/data/persistence.cljs:310
msgid "errors.save-retrying"
msgstr "Connection lost. Retrying to save your changes."

4
frontend/translations/es.po
View File

@ -1788,6 +1788,10 @@ msgid "errors.save-failed"
msgstr ""
"El autoguardado se ha detenido en esta sesión, así que los cambios desde el último guardado correcto no se podrán guardar. Descarga el informe para ayudarnos a arreglarlo y recarga la página, o sal de este fichero y vuelve a abrirlo, para seguir editando."
#: src/app/main/data/persistence.cljs
msgid "errors.save-rejected-changes-undone"
msgstr "Algunos de tus últimos cambios no se han podido guardar y se han deshecho. El resto de tu trabajo está guardado."
#: src/app/main/errors.cljs
msgid "errors.save-still-retrying"
msgstr ""