🐛 Fix problem with stalled saves (#12223)

This commit is contained in:
Alonso Torres 2026-10-11 19:54:40 +02:00 committed by GitHub
parent da2652f1dd
commit ecc5f11d96
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
4 changed files with 168 additions and 30 deletions

View File

@ -20,6 +20,7 @@
[app.main.errors :as errors]
[app.main.refs :as refs]
[app.main.repo :as rp]
[app.main.store :as st]
[app.util.i18n :refer [tr]]
[beicon.v2.core :as rx]
[potok.v2.core :as ptk]))
@ -38,6 +39,8 @@
(def ^:private saving-stall-timeout-ms (* 5 60 1000))
(def ^:private saving-check-interval-ms 30000)
(def ^:private save-wait-timeout-ms (* 2 60 1000))
;; Longer than the stall threshold so a hung save is reported before it is retried.
(def ^:private save-request-timeout-ms (* 7 60 1000))
(defn terminal-status?
"True when a persistence snapshot releases waiters: a failed save, or
@ -383,6 +386,13 @@
:features features}]
;; 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
;; retry path resends it instead of blocking the queue.
(rx/timeout save-request-timeout-ms
(rx/throw (ex-info "The save request timed out"
{:type :network
:code :save-request-timeout
:file-id file-id})))
(rx/take 1)
;; A response that carries no revision, including one that never
;; arrived, is treated as a failed save rather than a saved file.
@ -552,6 +562,17 @@
(rx/of (run-persistence-task))
(rx/empty))))))
(defn- sync-unload-guard
"Turns the browser's leave-page warning on while edits are unsaved:
buffered, queued, or retained after a failed save."
[buffered?]
(ptk/reify ::sync-unload-guard
ptk/EffectEvent
(effect [_ state _]
(if (or buffered? (seq (dm/get-in state [:persistence :queue])))
(swap! st/ongoing-tasks conj :persistence)
(swap! st/ongoing-tasks disj :persistence)))))
(defn initialize-persistence
[]
(ptk/reify ::initialize-persistence
@ -560,6 +581,9 @@
(log/debug :hint "initialize persistence")
(let [stoper-s (rx/filter (ptk/type? ::initialize-persistence) stream)
;; True while local commits wait in the buffer for the next flush.
buffered? (volatile! false)
local-commits-s
(->> stream
(rx/filter dch/commit?)
@ -602,6 +626,19 @@
(rx/map #(ptk/data-event ::persistence-notification))
(rx/take-until stoper-s))
;; Syncs the leave-page warning on every local commit and on every
;; queue change (append after a flush, discard after a save).
(->> (rx/merge
(rx/of false)
(->> local-commits-s
(rx/map (fn [_] (vreset! buffered? true))))
(->> stream
(rx/filter #(or (ptk/type? ::append-commit %)
(ptk/type? ::discard-commit %)))
(rx/map (fn [_] @buffered?))))
(rx/map sync-unload-guard)
(rx/take-until stoper-s))
(->> local-commits-s
(rx/debounce 200)
(rx/map (fn [_]
@ -614,6 +651,7 @@
(->> local-commits-s
(rx/take-until stoper-s)
(rx/buffer-until notifier-s)
(rx/tap (fn [_] (vreset! buffered? false)))
(rx/mapcat merge-commit)
(rx/map append-commit)
(rx/finalize (fn []

View File

@ -84,6 +84,7 @@
(let [buffer (atom [])
omitset #{:potok.v2.core/undefined
:app.main.data.workspace.persistence/update-persistence-status
:app.main.data.persistence/sync-unload-guard
:app.main.data.websocket/send-message
:app.main.data.workspace.notifications/handle-pointer-send
:app.main.router/assign-exception}]
@ -145,6 +146,8 @@
(add-watch ongoing-tasks ::ongoing-tasks
(fn [_ _ _ events]
(if (empty? events)
(obj/set! js/window "onbeforeunload" nil)
(obj/set! js/window "onbeforeunload" (constantly false)))))
;; No `window` outside the browser.
(when (exists? js/window)
(if (empty? events)
(obj/set! js/window "onbeforeunload" nil)
(obj/set! js/window "onbeforeunload" (constantly false))))))

View File

@ -44,8 +44,9 @@
:undo-changes []}))
(defn- with-persistence
"Async fixture for the persistence tests: mocks the transport and flash, and
runs `f` with persistence initialized.
"Async fixture for the persistence tests: mocks the transport, flash and
the leave-page task set (`:tasks`), and runs `f` with persistence
initialized.
Evaluates to a promise resolving once `f` settles and teardown completes;
`await` it from an `^:async` test.
@ -60,22 +61,24 @@
response (rx/subject)
failures (atom [])
requests (atom [])
tasks (atom #{})
store (ptk/store {:state {:current-file-id file-id
:permissions {:can-edit true}
:files {file-id {:id file-id :revn 0}}}
:on-error #(t/is false (str %))})]
(mock/with-mocks*
{rp/cmd! (mock/stub (fn [cmd params]
(swap! requests conj [cmd params])
(if respond
(respond cmd params)
(->> response (rx/take 1) (rx/observe-on :async)))))
errors/flash (fn [& {:keys [cause]}]
(swap! failures conj cause))}
{rp/cmd! (mock/stub (fn [cmd params]
(swap! requests conj [cmd params])
(if respond
(respond cmd params)
(->> response (rx/take 1) (rx/observe-on :async)))))
errors/flash (fn [& {:keys [cause]}]
(swap! failures conj cause))
st/ongoing-tasks tasks}
(try
(ptk/emit! store (dps/initialize-persistence))
(await (f {:file-id file-id :response response :failures failures
:requests requests :store store}))
:requests requests :store store :tasks tasks}))
(finally
(rx/dispose! store)
(rx/end! response))))))
@ -455,7 +458,8 @@
(swap! causes conj cause)
"report")
st/emit! (mock/stub (fn [& emitted] (swap! events into emitted)))
rt/get-current-href (constantly "https://penpot.example.com/#/workspace")}
rt/get-current-href (constantly "https://penpot.example.com/#/workspace")
st/ongoing-tasks (atom #{})}
(try
(ptk/emit! store (dps/initialize-persistence))
;; Phase 1 — the first stall reports once.
@ -485,3 +489,33 @@
(rx/dispose! store)
(rx/end! ticks)
(rx/end! response)))))))
;; Scenario: the first send never answers. The request timeout fails it as
;; a transient error, and the retry resends the same commit and saves. The
;; timeout is shortened by wrapping the real operator. Proves: a hung save
;; does not block the queue.
(t/deftest ^:async hung-save-request-times-out-and-retries
(let [calls (atom 0)
timeouts (atom [])
timeout rx/timeout]
(await
(with-persistence
(^:async fn [{:keys [file-id requests store]}]
(await
(mock/with-mocks*
{rx/timer (mock/stub (fn [_] (rx/of :tick)))
rx/timeout (mock/stub (fn [ms with ob]
(swap! timeouts conj ms)
(timeout 0 with ob)))}
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(and (= :saved (get-in @store [:persistence :status]))
(empty? (get-in @store [:persistence :queue])))
"the retry saves the file"))
(t/is (= 2 (count @requests)) "hung send plus one retry")
(t/is (apply = (map (comp :commit-id second) @requests))
"both sends carry the same commit id")
(t/is (= [420000 420000] @timeouts) "every send gets the 7 minute timeout"))))
(fn [_ _]
(if (= 1 (swap! calls inc))
(rx/subject)
(rx/of {:revn 1})))))))

View File

@ -88,10 +88,11 @@
:on-error #(swap! errors conj %)})]
(mock/with-mocks*
{rp/cmd! (mock/stub (fn [cmd params]
(let [req (->> response (rx/take 1) (rx/observe-on :async))]
(swap! requests conj {:cmd cmd :params params :req req})
req)))}
{rp/cmd! (mock/stub (fn [cmd params]
(let [req (->> response (rx/take 1) (rx/observe-on :async))]
(swap! requests conj {:cmd cmd :params params :req req})
req)))
st/ongoing-tasks (atom #{})}
(try
(await (run-read-only-phases store response requests file-id read-only-event errors))
(finally
@ -193,7 +194,8 @@
(let [m (apply hash-map params)]
(swap! reports conj m)
(when (fn? (:report m))
((:report m)))))}
((:report m)))))
st/ongoing-tasks (atom #{})}
(try
(ptk/emit! store (dps/initialize-persistence))
(await (f {:clock clock :ticks ticks :response response :requests requests
@ -359,7 +361,8 @@
(let [subscription (.subscribe ticks subscriber)]
(fn []
(rx/dispose! subscription)
(swap! active-timers dec)))))))}
(swap! active-timers dec)))))))
st/ongoing-tasks (atom #{})}
(try
(ptk/emit! store (dps/initialize-persistence))
(t/is (= 1 @active-timers))
@ -434,8 +437,9 @@
;; assert block is preceded by `wait-for` on its leading signal (or a bare
;; `settle` tick when it asserts only absence).
(defn- with-persistence
"Async fixture for the persistence tests: mocks the transport and flash, and
runs `f` with persistence initialized.
"Async fixture for the persistence tests: mocks the transport, flash and
the leave-page task set (`:tasks`), and runs `f` with persistence
initialized.
Evaluates to a promise resolving once `f` settles and teardown completes;
`await` it from an `^:async` test.
@ -450,22 +454,24 @@
response (rx/subject)
failures (atom [])
requests (atom [])
tasks (atom #{})
store (ptk/store {:state {:current-file-id file-id
:permissions {:can-edit true}
:files {file-id {:id file-id :revn 0}}}
:on-error #(t/is false (str %))})]
(mock/with-mocks*
{rp/cmd! (mock/stub (fn [cmd params]
(swap! requests conj [cmd params])
(if respond
(respond cmd params)
(->> response (rx/take 1) (rx/observe-on :async)))))
errors/flash (fn [& {:keys [cause]}]
(swap! failures conj cause))}
{rp/cmd! (mock/stub (fn [cmd params]
(swap! requests conj [cmd params])
(if respond
(respond cmd params)
(->> response (rx/take 1) (rx/observe-on :async)))))
errors/flash (fn [& {:keys [cause]}]
(swap! failures conj cause))
st/ongoing-tasks tasks}
(try
(ptk/emit! store (dps/initialize-persistence))
(await (f {:file-id file-id :response response :failures failures
:requests requests :store store}))
:requests requests :store store :tasks tasks}))
(finally
(rx/dispose! store)
(rx/end! response))))))
@ -791,3 +797,60 @@
(t/is (= :saved (get-in @store [:persistence :status])))
(t/is (empty? (get-in @store [:persistence :queue]))))
(fn [_ _] (rx/of {:revn 1})))))
;; Leave-page guard tests.
;; Scenario: an edit is buffered, then sent, then saved. The leave-page
;; guard turns on with the buffered edit, stays on while the save is in
;; flight, and turns off once it lands. Proves: unsaved edits always keep
;; the browser's leave-page warning on.
(t/deftest ^:async unsaved-edits-keep-the-leave-page-guard
(await
(with-persistence
(^:async fn [{:keys [file-id response requests store tasks]}]
(ptk/emit! store (local-commit file-id))
(await (async/wait-for #(contains? @tasks :persistence)
"a buffered edit turns the guard on"))
(ptk/emit! store ::dps/force-persist)
(await (async/wait-for #(seq @requests) "the edit is sent"))
(t/is (contains? @tasks :persistence) "the guard stays on while the save is in flight")
(rx/push! response {:revn 1})
(await (async/wait-for #(not (contains? @tasks :persistence))
"the save turns the guard off"))
(t/is (= :saved (get-in @store [:persistence :status])))))))
;; Scenario: a second edit arrives while the first is being saved, and the
;; first save lands while the second edit is still in the buffer. The queue
;; is empty at that point, yet the guard stays on until the second edit is
;; saved. Proves: edits waiting in the buffer keep the leave-page warning on.
(t/deftest ^:async edits-buffered-during-a-save-keep-the-leave-page-guard
(await
(with-persistence
(^:async fn [{:keys [file-id response requests store tasks]}]
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(= 1 (count @requests)) "the first edit is sent"))
(ptk/emit! store (local-commit file-id))
(rx/push! response {:revn 1})
(await (async/wait-for #(empty? (get-in @store [:persistence :queue]))
"the first save lands"))
(await (async/settle))
(t/is (contains? @tasks :persistence) "the buffered edit keeps the guard on")
(ptk/emit! store ::dps/force-persist)
(await (async/wait-for #(= 2 (count @requests)) "the buffered edit is sent"))
(rx/push! response {:revn 2})
(await (async/wait-for #(not (contains? @tasks :persistence))
"the second save turns the guard off"))
(t/is (empty? (get-in @store [:persistence :queue])))))))
;; Scenario: the save fails terminally. The edit stays queued, and so does
;; the guard. Proves: retained edits are not dropped silently on leave.
(t/deftest ^:async failed-save-keeps-the-leave-page-guard
(await
(with-persistence
(^:async fn [{:keys [file-id store tasks]}]
(ptk/emit! store (local-commit file-id) ::dps/force-persist)
(await (async/wait-for #(= :error (get-in @store [:persistence :status]))
"the save fails"))
(t/is (= 1 (count (get-in @store [:persistence :queue]))))
(t/is (contains? @tasks :persistence) "the guard stays on for retained edits"))
(fn [_ _] (rx/throw (ex-info "invalid" {:type :validation}))))))