mirror of
https://github.com/penpot/penpot.git
synced 2026-10-29 05:50:35 +00:00
d57cdb4588
* ✨ Add async test helpers and the with-mocks* macro Backport of the test scaffolding that the persistence retry work needs, taken from staging. Purely additive: no existing helper changes behavior, so the suite result is unchanged (740 tests, 0 failures). - frontend-tests.helpers.async: ->promise, await-response, settle, observe and wait-for. wait-for checks immediately and then polls one macrotask at a time, bounded, so it fails instead of hanging. - mock/with-mocks*: installs mocks with set! and evaluates its body in a generated ^:async fn, so the test reads sequentially and there is no done to thread. Evaluates to a promise. - mock/asap and mock/run-mocked: run-mocked awaits the body and restores the originals always, in that order, reporting a rejection or a non-promise return as an :error. The matching change that made with-mocks defer its body via asap is NOT backported: it would force all 58 existing uses across 14 files into done-chained contexts, which is a separate refactor. AI-assisted-by: space-bunny-free * ✨ Add an error report governor with compact payloads One browser session could emit an unbounded number of identical error reports, and a dropped connection was reported as an application defect with the full payload. Both are fixed here, in one place, because the persistence retry work that follows depends on the new submit-report contract. - A report governor in app.main.errors. Each report carries a fingerprint (report-name|type|code|hint|first stack frame); the first occurrence is always emitted, repeats inside a 2 minute window are counted, and the next emitted report carries them as :occurrences. The cache is bounded by evicting the oldest entry, so memory stays fixed. - flash reserves the report before generating it, so a suppressed occurrence never pays the report-building cost. Its whole body now runs inside one ts/schedule callback, a reporting or notification failure is logged instead of propagating, and it returns a total promise so tests can await it. - generate-report accepts :format :compact|:full. The compact payload keeps the context header plus type, code and uri, and skips the stack, the ex-data dump (it can carry request headers) and the last-events list. - environment-error-types is derived from rp/retryable-types, so the transport classification has a single source of truth. Environment failures are audit-only handled-exceptions and never reach the exception page or the alerts. :offline gets its own handler instead of falling through to :default. :occurrences travels inside the audit event :props, which the backend schema accepts as a free-form map, so no backend change is needed. The dedup governor test file is new: 7 tests over the fingerprint, the pure reservation decision, and the flash pipeline. Relates to #11726, #11743 AI-assisted-by: space-bunny-free * ♻️ Answer commit refusals with an empty stream commit-changes used to return nil when it refused to build a commit, which forced every caller that wanted to observe the outcome to special-case nil. It now returns an empty stream, so a refusal and an empty result look the same and callers can subscribe uniformly. Only the refusal branch changes: the accepted branch already answered with (rx/of commit). Potok treats a nil watch result as "nothing", so both spellings were already correct at the store level. The 57 call sites that wrap this event in rx/of are unaffected. They hold the ::commit-changes event itself, not the value its watch returns, so they keep processing exactly as before. AI-assisted-by: space-bunny-free * ✨ Retry transient saves with backoff and a reconnect notice Any failed update-file landed on the same path: the queue halted in :error, the retained changes were flushed away, and the user was told to reload. A dropped connection and a revoked permission are not the same thing, so they now take different paths. transient-error? splits them, checking :type and :cause-type because persistence-failed wraps the original cause. Transient failures enter a :retrying episode: the head commit stays queued and resends with backoff at 2s, 8s and 20s, then falls through to today's terminal path. Everything else is terminal and keeps the exact :error path. - Resends rotate the ::request-id stamp only once the old request has left active-requests, carry the same :commit-id, and never double send while one request is in flight. - Retry timers carry an episode token; a timer whose episode was superseded stays silent instead of sending or failing. - One tagged reconnect notice per episode, hidden by tag on save and on terminal failure. Recovery is silent. - The browser online event re-enters the runner, but only for a live :retrying episode, guarded by exists? js/window. - wait-persisted-or-error waits through :retrying instead of cutting the wait short. The episode keeps its :run-id, so a new local edit only joins the queue. Re-entering the runner on every edit would bypass the backoff and spend one attempt per batched commit. The retry test namespace is new: 13 tests over the classification, the backoff schedule, stamp rotation, stale tokens and the notice lifecycle. Relates to #11724 AI-assisted-by: space-bunny-free * 🐛 Fix stalled saves that never answer and edits lost on leave Two holes the retry work did not close. An update-file request that never gets an answer kept its attempt stamp forever, so the queue could not move and the user saw a saving state that never resolved. The request now has a 7 minute timeout that fails it as a transient network error, which hands it to the retry path instead of blocking. The timeout is longer than the 5 minute stall threshold on purpose: the stalled report must fire before the retry, not instead of it. The leave-page warning also had gaps. It now tracks unsaved edits directly, through sync-unload-guard, which holds :persistence in st/ongoing-tasks while edits sit in the buffer or the queue. Edits kept in the queue after a failed save keep the guard on too, so closing the tab warns instead of dropping them. store.cljs guards its ongoing-tasks watcher with exists? js/window, because the new tests exercise it without a window. Four new tests: three for the guard across buffering, an in-flight save and a retained edit, and one for a hung request that must resend and save. Closes #12223 AI-assisted-by: space-bunny-free * 🐛 Skip the save when a missing font cannot be remapped fix-deleted-fonts emitted text and typography changes even when no replacement font existed, so opening a page that uses a deleted custom font rewrote identical content and cleared position-data on every visit. Every visit became a save with nothing to save. Both loops now compare the remapped value with the original and emit nothing when they match. The remapped path is unchanged. Two new tests cover the no-replacement case and the remapped case. Closes #12151 AI-assisted-by: space-bunny-free * ✨ Add a debug helper that simulates an intermediary response A save that never reaches the backend is hard to reproduce: you need a proxy, a captive portal or a CDN in the way. This wraps fetch and answers the named API method with a status and a body that carries no Penpot error code, leaving every other request alone. Without a duration the simulation is spent after answering one call. With one it answers every matching call for that long, which is how to watch the save retry, warn, keep retrying and finally recover. debug.simulateHttpError('update-file') debug.simulateHttpError('get-comment-threads', 403) debug.simulateHttpError('update-file', 524, 120) debug.clearHttpErrorSimulation() Dev-only and self-contained: no production path reads it. AI-assisted-by: space-bunny-free * 🌐 Add the save retry and connection error strings Three strings the new persistence and error paths need: - errors.save-retrying, shown once per retry episode while the queue resends a queued save after a connection loss. - workspace.header.retrying, the save indicator state for an episode in progress. - errors.connection-error, shown by the network and offline handlers, which no longer fall through to the generic message. Added to en.po only. The translations script also normalizes every other locale and drops 439 strings that were already stale before this work; that belongs in its own maintenance pass, not in a backport. AI-assisted-by: space-bunny-free * 🐛 Report save failures as unhandled when they are our defect flash-persistence reported every failure it did not delegate as handled-exception, including the ones that are plainly our fault. A validation failure means the client sent something the server refused, yet it landed in the audit log with a name that skips the internal reports and the alerts. Nobody was paged. The report type now follows the cause. :validation, :server-error and :internal report as unhandled-exception, so they alert. The rest are unchanged. Two exclusions are deliberate: - Environment failures stay handled. They reach this point after the retry budget is spent, and the user's connection is not our bug. - :assertion stays handled, because its own handler already reports it that way and the two paths should not disagree. The cause type is read from :cause-type first, since persistence-failed wraps the original under :type :persistence. Reading :type alone would match the wrapper every time and change nothing. The user still gets the same sticky toast and report link; only the audit event name moves. The test that asserted a validation failure is "still notified" now asserts which event name it gets, across the bare and wrapped shapes, the environment types that must stay handled, and an unclassified one. AI-assisted-by: space-bunny-free * 🐛 Unblock persistence when opening a file after a terminal failure A terminal save failure set the state to :error and left the queue alone. recover-persistence only resumed for :save-permission-denied, so for every other terminal code both of its branches were false and it emitted nothing. Leaving and reopening the same file therefore changed nothing: the editor stayed halted until a reload, which rebuilds the whole store and loses the queue anyway. The path had two jobs under one name. initialize-persistence fires when the workspace view mounts and tears down the previous subscription; recover-persistence fires when a file is opened or the role changes. They are now separate: initialization picks up a queue left behind by a previous session, and deliberately does not lift a halt, so undeliverable edits are released when the user acts rather than when the view mounts. Recovery lifts the halt by releasing what can never be saved. release-failed-file drops every queued commit of the file that failed, then resume-persistence clears the error and settles an empty queue to :saved. Retaining them until that point is deliberate: it is what keeps wait-persisted-or-error rejecting, which is what stops workspace/versions.cljs from building a snapshot out of unsaved edits. Releasing at failure time would make waiters resolve instead. Permission loss is treated as permanent too, which the previous exception got wrong. The backend raises :not-found for a missing edit permission, so a resend does not succeed — it routes the user to the exception page. The old branch made that reachable: it resumed the save whenever the cached can-edit flag said yes, and the server disagreed. The only case where the flag can return to true is a team switch, where the queue is gone anyway, so nothing real is lost by releasing. Because the queue is shared, dropping the failed file is also what lets the other files' pending edits drain. One file that cannot be saved no longer blocks everything else. Tests: the failure retains the queue and notifies once, recovery releases it without replaying, a failed file does not block a second one, permission loss is released rather than resumed, and initialization leaves a halt alone. AI-assisted-by: space-bunny-free * ✨ Offer a reload on the save failure toast A terminal save failure stops autosave for the whole session, but the toast asked the user to reload without offering the reload. It listed five implied actions, none of them reachable from the banner, and it never said that the changes could not be saved. flash now takes a :links vector of actions, appended after the download link that :report-link? produces, so a caller can add recovery actions without reaching into the report handling. flash-persistence passes a reload built from labels.reload-page and location.reload, the pattern already used elsewhere in the app for a full restart. The message now says what happened, what is lost, and what to do about it: autosave has stopped for this session, the changes since the last successful save cannot be saved, and either reloading or leaving the file and opening it again restarts it. Naming both matters, because the toast links are easy to miss. Saying the edits are lost is not optional: recovery releases them, so without it the user finds out when they come back to the file. Translated in en.po and es.po only. The translations script would also normalize all 40 locales and drop entries that were already stale, which is a maintenance pass of its own. The reload callback cannot be invoked under the test runner, since js/location does not exist there, so it is covered by its label and by being callable. Whether the reload works is a manual check. AI-assisted-by: space-bunny-free * 🐛 Classify the responses the backend never wrote A reply written by a proxy instead of the backend carries no Penpot error code, so handle-response raised it as :internal. A 504 on a save skipped the retry cycle and stopped autosave at once, and because :internal reports as unhandled, it raised an alert. In a standard deployment this is how a slow save ends: nginx answers 504 after 300s, before the client's 7 minute timeout fires. The status now decides the type: - 504 and the Cloudflare 520-524 family raise :gateway-error, which joins retryable-types. Saves retry with backoff like 502 and 503, GETs retry, and a save that spends its retries reports as handled, because the report rules derive from the same set. - 429 raises :rate-limit, and any other error status :unexpected-response. Neither retries; both show a toast instead of the error page. - :internal is kept for a response below 400 that does not decode. Bodies we cannot read are cut to 500 characters, since proxy error pages run to tens of kilobytes. Tests: classification and retries per status, the transport handlers keep the page, a 504 and a 524 built by the real handle-response go through the save path and land on a retry, and the new types stay handled once the retries are spent. AI-assisted-by: claude-opus-5-5 * ✨ Keep retrying failed saves on a slow cycle Once the three backoff retries were spent, a save that failed on the connection stopped autosave like any terminal failure, and opening a file again dropped its edits. A connection that comes back after a minute lost the work all the same. A transport failure that outlasts the backoff now arms a slow cycle: one silent resend every 30s, until a save lands or 24h have passed since the failure started. The cycle stops when persistence restarts, the queue resumes another way, or the workspace closes. A save that keeps failing slowly is not resent for a day. A gateway that answers 504 after its own timeout may leave the backend applying the save, so each resend can cost the whole save again, and the failing file holds back every other file's queued edits. An attempt that fails after 90s or more counts as a slow failure; at three, the slow cycle stops sending the commit and the save fails as before. Fast failures, such as being offline, never count. - The first failure shows a toast that says the changes are kept and keep being sent, with no reload link, since a reload loses them. A save that lands hides it. - Opening a file sends a queue still inside its retry window once more instead of releasing it. Failures outside the window, and every non-transport failure, are still released. - A freshly loaded file gets back the queued edits of its version, so reopening it shows the changes that are still waiting to be saved. An edit that no longer applies to the loaded data leaves the file as the server sent it, so the file still opens; the edits stay queued. - A commit whose earlier request is no longer in flight is simply sent again under the same commit id: changes are idempotent, so there is no unknown-outcome guard any more. A request still in flight still blocks a parallel send. flash takes a :tag so the save failure toast can be hidden by tag. Tests: the spent backoff arms the slow cycle, a 504 arms it, a terminal failure does not, the cycle stops when the window closes or at the slow failure limit, recovery resends instead of releasing, reopening restores only the loaded file's edits and survives one that no longer applies, and the retrying toast offers no reload. * 🐛 Turn off the leave-page warning when failed edits are released The leave-page warning only followed the queue on appends and discards. Opening a file again releases the edits of a file that failed for good, but that release changed the queue without either event, so the warning stayed on with nothing left to save. Leaving the page asked about unsaved changes until the next save went through. The warning now also follows the release. Tests: releasing the last failed edit turns the warning off. * 🐛 Stop retrying failed saves outside the workspace Leaving the workspace was meant to stop the slow retry cycle, but only a cycle already armed stopped. A backoff timer kept firing after the user left, and a backoff spent outside the workspace armed a slow cycle that kept sending for up to a day from the dashboard. Those sends check the edit permission of whatever team is open, so a switch to a team where the user only views failed the queued edits for good, and the next file they opened dropped them. Leaving the workspace now suspends retries. A pending backoff timer goes stale, and while suspended a transport failure schedules no backoff, a spent backoff arms no slow cycle and the online event sends nothing. The edits stay queued and a request in flight still lands. Opening a file lifts the suspension and resends a retrying save whose backoff was cut short; a role change does not lift it. Tests: leaving stops a pending backoff, a failure after leaving schedules no retry and ignores the online event, a backoff spent outside the workspace arms no slow cycle, and opening a file saves the held edit in each case. --------- Co-authored-by: alonso.torres <alonso.torres@kaleidos.net>
739 lines
25 KiB
Clojure
739 lines
25 KiB
Clojure
;; 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 debug
|
|
(:require
|
|
[app.common.data :as d]
|
|
[app.common.data.macros :as dm]
|
|
[app.common.exceptions :as ex]
|
|
[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.pprint :as pp]
|
|
[app.common.render-wasm.helpers :as wasm.h]
|
|
[app.common.render-wasm.mem :as wasm.mem]
|
|
[app.common.render-wasm.wasm :as wasm]
|
|
[app.common.transit :as t]
|
|
[app.common.types.component :as ctk]
|
|
[app.common.types.components-list :as ctkl]
|
|
[app.common.types.container :as ctn]
|
|
[app.common.types.file :as ctf]
|
|
[app.common.uuid :as uuid]
|
|
[app.main.data.changes :as dwc]
|
|
[app.main.data.common :as dcm]
|
|
[app.main.data.dashboard.shortcuts]
|
|
[app.main.data.helpers :as dsh]
|
|
[app.main.data.preview :as dp]
|
|
[app.main.data.viewer.shortcuts]
|
|
[app.main.data.workspace :as dw]
|
|
[app.main.data.workspace.common :as dwcm]
|
|
[app.main.data.workspace.path.shortcuts]
|
|
[app.main.data.workspace.selection :as dws]
|
|
[app.main.data.workspace.shortcuts]
|
|
[app.main.data.workspace.undo :as dwu]
|
|
[app.main.errors :as errors]
|
|
[app.main.repo :as rp]
|
|
[app.main.store :as st]
|
|
[app.util.debug :as dbg]
|
|
[app.util.dom :as dom]
|
|
[app.util.http :as http]
|
|
[beicon.v2.core :as rx]
|
|
[cljs.pprint :refer [pprint]]
|
|
[cuerdas.core :as str]
|
|
[potok.v2.core :as ptk]
|
|
[promesa.core :as p]))
|
|
|
|
(l/set-level! :debug)
|
|
|
|
(defn- coerce-keyword
|
|
"Coerce `v` to a keyword when it is a string or keyword, nil otherwise."
|
|
[v]
|
|
(when (or (keyword? v) (string? v))
|
|
(keyword v)))
|
|
|
|
(defn ^:export set-logging
|
|
([level]
|
|
(let [level (coerce-keyword level)]
|
|
(if (l/valid-level? level)
|
|
(l/set-level! "app" level)
|
|
(js/console.warn "ignoring invalid log level:" (pr-str level)))))
|
|
([ns level]
|
|
(let [ns (coerce-keyword ns)
|
|
level (coerce-keyword level)]
|
|
(if (and (l/valid-logger? (some-> ns name))
|
|
(l/valid-level? level))
|
|
(l/set-level! (name ns) level)
|
|
(js/console.warn "ignoring invalid logging config:" (pr-str ns) (pr-str level))))))
|
|
|
|
;; These events are excluded when we activate the :events flag
|
|
(def debug-exclude-events
|
|
#{:app.main.data.workspace.notifications/handle-pointer-update
|
|
:app.main.data.workspace.notifications/handle-pointer-send
|
|
:app.main.data.websocket/send-message
|
|
:app.main.data.workspace.selection/change-hover-state})
|
|
|
|
(defn enable!
|
|
[option]
|
|
(dbg/enable! option)
|
|
(case option
|
|
:events
|
|
(set! st/*debug-events* true)
|
|
|
|
:events-times
|
|
(set! st/*debug-events-time* true)
|
|
|
|
nil)
|
|
(js* "app.main.reinit()"))
|
|
|
|
(defn disable!
|
|
[option]
|
|
(dbg/disable! option)
|
|
(case option
|
|
:events
|
|
(set! st/*debug-events* false)
|
|
|
|
:events-times
|
|
(set! st/*debug-events-time* false)
|
|
|
|
nil)
|
|
(js* "app.main.reinit()"))
|
|
|
|
(defn ^:export toggle-debug
|
|
[name]
|
|
(let [option (keyword name)]
|
|
(if (dbg/enabled? option)
|
|
(disable! option)
|
|
(enable! option))))
|
|
|
|
(defn ^:export debug-all
|
|
[]
|
|
(reset! dbg/state dbg/options)
|
|
(js* "app.main.reinit()"))
|
|
|
|
(defn ^:export debug-none
|
|
[]
|
|
(reset! dbg/state #{})
|
|
(js* "app.main.reinit()"))
|
|
|
|
(defn ^:export tap
|
|
"Transducer function that can execute a side-effect `effect-fn` per input"
|
|
[effect-fn]
|
|
(fn [rf]
|
|
(fn
|
|
([] (rf))
|
|
([result] (rf result))
|
|
([result input]
|
|
(effect-fn input)
|
|
(rf result input)))))
|
|
|
|
(defn ^:export logjs
|
|
([str] (tap (partial logjs str)))
|
|
([str val]
|
|
(js/console.log str (json/->js val))
|
|
val))
|
|
|
|
(defn- wasm-read-len-prefixed-utf8
|
|
"Reads a `[u32 byte_len][utf8 bytes...]` buffer returned by WASM and frees it.
|
|
Returns a JS string (possibly empty)."
|
|
[ptr]
|
|
(when (and ptr (not (zero? ptr)))
|
|
(let [heap-u8 (wasm.mem/get-heap-u8)
|
|
heap-u32 (wasm.mem/get-heap-u32)
|
|
len (aget heap-u32 (wasm.mem/->offset-32 ptr))
|
|
start (+ ptr 4)
|
|
end (+ start len)
|
|
decoder (js/TextDecoder. "utf-8")
|
|
text (.decode decoder (.subarray heap-u8 start end))]
|
|
(wasm.mem/free)
|
|
text)))
|
|
|
|
(defn ^:export wasmCaptureFrames
|
|
[amount]
|
|
(let [module wasm/internal-module
|
|
f (when module (unchecked-get module "_capture_frames"))]
|
|
(if (fn? f)
|
|
(wasm.h/call module "_capture_frames" amount)
|
|
(js/console.warn "[debug] render-wasm module not ready or missing _render_stats"))))
|
|
|
|
(defn ^:export wasmRenderStats
|
|
[]
|
|
(let [module wasm/internal-module
|
|
f (when module (unchecked-get module "_render_stats"))]
|
|
(if (fn? f)
|
|
(wasm.h/call module "_render_stats")
|
|
(js/console.warn "[debug] render-wasm module not ready or missing _render_stats"))))
|
|
|
|
(defn ^:export wasmAtlasConsole
|
|
"Logs the current render-wasm atlas as an image in the JS console (if present)."
|
|
[]
|
|
(let [module wasm/internal-module
|
|
f (when module (unchecked-get module "_debug_atlas_console"))]
|
|
(if (fn? f)
|
|
(wasm.h/call module "_debug_atlas_console")
|
|
(js/console.warn "[debug] render-wasm module not ready or missing _debug_atlas_console"))))
|
|
|
|
(defn ^:export wasmAtlasBase64
|
|
"Returns the atlas PNG base64 (empty string if missing/empty)."
|
|
[]
|
|
(let [module wasm/internal-module
|
|
f (when module (unchecked-get module "_debug_atlas_base64"))]
|
|
(if (fn? f)
|
|
(let [ptr (wasm.h/call module "_debug_atlas_base64")
|
|
s (or (wasm-read-len-prefixed-utf8 ptr) "")]
|
|
s)
|
|
(do
|
|
(js/console.warn "[debug] render-wasm module not ready or missing _debug_atlas_base64")
|
|
""))))
|
|
|
|
(defn ^:export wasmSurfaceConsole
|
|
"Logs the render-wasm surface id as an image in the JS console."
|
|
[id]
|
|
(let [module wasm/internal-module
|
|
f (when module (unchecked-get module "_debug_surface_console"))]
|
|
(if (fn? f)
|
|
(wasm.h/call module "_debug_surface_console" id)
|
|
(js/console.warn "[debug] render-wasm module not ready or missing _debug_surface_console"))))
|
|
|
|
(defn ^:export wasmCacheConsole
|
|
"Logs the current render-wasm cache surface as an image in the JS console."
|
|
[]
|
|
(let [module wasm/internal-module
|
|
f (when module (unchecked-get module "_debug_cache_console"))]
|
|
(if (fn? f)
|
|
(wasm.h/call module "_debug_cache_console")
|
|
(js/console.warn "[debug] render-wasm module not ready or missing _debug_cache_console"))))
|
|
|
|
(defn ^:export wasmCacheBase64
|
|
"Returns the cache surface PNG base64 (empty string if missing/empty)."
|
|
[]
|
|
(let [module wasm/internal-module
|
|
f (when module (unchecked-get module "_debug_cache_base64"))]
|
|
(if (fn? f)
|
|
(let [ptr (wasm.h/call module "_debug_cache_base64")
|
|
s (or (wasm-read-len-prefixed-utf8 ptr) "")]
|
|
s)
|
|
(do
|
|
(js/console.warn "[debug] render-wasm module not ready or missing _debug_cache_base64")
|
|
""))))
|
|
|
|
(when (exists? js/window)
|
|
(set! (.-dbg ^js js/window) json/->js)
|
|
(set! (.-pp ^js js/window) pprint))
|
|
|
|
(defonce widget-style "
|
|
background: black;
|
|
bottom: 10px;
|
|
color: white;
|
|
height: 20px;
|
|
padding-left: 8px;
|
|
position: absolute;
|
|
right: 10px;
|
|
width: 40px;
|
|
z-index: 99999;
|
|
opacity: 0.5;
|
|
")
|
|
|
|
(defn ^:export dump-state []
|
|
(logjs "state" @st/state)
|
|
nil)
|
|
|
|
(defn ^:export dump-data []
|
|
(let [fdata (-> (dsh/lookup-file @st/state)
|
|
(get :data))]
|
|
(logjs "file-data" fdata)
|
|
nil))
|
|
|
|
(defn ^:export dump-buffer []
|
|
(logjs "last-events" @st/last-events)
|
|
nil)
|
|
|
|
(defn ^:export get-state [str-path]
|
|
(let [path (->> (str/split str-path " ")
|
|
(map d/read-string)
|
|
vec)]
|
|
(js/console.log (clj->js (get-in @st/state path))))
|
|
nil)
|
|
|
|
(defn dump-objects'
|
|
[state]
|
|
(let [objects (dsh/lookup-page-objects state)]
|
|
(logjs "objects" objects)
|
|
nil))
|
|
|
|
(defn ^:export dump-objects
|
|
[]
|
|
(dump-objects' @st/state))
|
|
|
|
(defn get-object
|
|
[state name]
|
|
(let [objects (dsh/lookup-page-objects state)
|
|
result (or (d/seek (fn [shape] (= name (:name shape))) (vals objects))
|
|
(get objects (uuid/parse name)))]
|
|
result))
|
|
|
|
(defn ^:export dump-object
|
|
[name]
|
|
(clj->js (get-object @st/state name)))
|
|
|
|
(defn get-selected
|
|
[state]
|
|
(dsh/lookup-selected state))
|
|
|
|
(defn ^:export dump-selected
|
|
[]
|
|
(let [objects (dsh/lookup-page-objects @st/state)
|
|
result (->> (get-selected @st/state) (map #(get objects %)))]
|
|
(logjs "selected" result)
|
|
nil))
|
|
|
|
|
|
(defn ^:export dump-selected-edn
|
|
[]
|
|
(let [objects (dsh/lookup-page-objects @st/state)
|
|
result (->> (get-selected @st/state) (map #(get objects %)))]
|
|
(pp/pprint result {:length 30 :level 30})
|
|
nil))
|
|
|
|
(defn ^:export preview-selected
|
|
[]
|
|
(st/emit! (dp/open-preview-selected)))
|
|
|
|
(defn ^:export parent
|
|
[]
|
|
(let [objects (dsh/lookup-page-objects @st/state)
|
|
selected-id (first (dsh/get-selected-ids @st/state))
|
|
parent-id (dm/get-in objects [selected-id :parent-id])]
|
|
(when-let [parent (get objects parent-id)]
|
|
(js/console.log (str (:name parent) " - " (:id parent))))
|
|
nil))
|
|
|
|
(defn ^:export frame
|
|
[]
|
|
(let [objects (dsh/lookup-page-objects @st/state)
|
|
selected-id (first (dsh/get-selected-ids @st/state))
|
|
frame-id (dm/get-in objects [selected-id :frame-id])]
|
|
(when-let [frame (get objects frame-id)]
|
|
(js/console.log (str (:name frame) " - " (:id frame))))
|
|
nil))
|
|
|
|
(defn ^:export select-by-object-id
|
|
[object-id]
|
|
(let [[_ page-id shape-id _] (str/split object-id #"/")]
|
|
(st/emit! (dcm/go-to-workspace :page-id (uuid/parse page-id)))
|
|
(st/emit! (dws/select-shape (uuid/parse shape-id)))))
|
|
|
|
(defn ^:export select-by-id
|
|
[shape-id]
|
|
(st/emit! (dws/select-shape (uuid/parse shape-id))))
|
|
|
|
(defn dump-tree'
|
|
([state] (dump-tree' state false false false))
|
|
([state show-ids] (dump-tree' state show-ids false false))
|
|
([state show-ids show-touched] (dump-tree' state show-ids show-touched false))
|
|
([state show-ids show-touched show-modified]
|
|
(let [page-id (get state :current-page-id)
|
|
file (dsh/lookup-file state)
|
|
libraries (get state :files)]
|
|
(ctf/dump-tree file page-id libraries {:show-ids show-ids
|
|
:show-touched show-touched
|
|
:show-modified show-modified}))))
|
|
(defn ^:export dump-tree
|
|
([] (dump-tree' @st/state))
|
|
([show-ids] (dump-tree' @st/state show-ids false false))
|
|
([show-ids show-touched] (dump-tree' @st/state show-ids show-touched false))
|
|
([show-ids show-touched show-modified] (dump-tree' @st/state show-ids show-touched show-modified)))
|
|
|
|
(defn ^:export dump-subtree'
|
|
([state shape-id] (dump-subtree' state shape-id false false false))
|
|
([state shape-id show-ids] (dump-subtree' state shape-id show-ids false false))
|
|
([state shape-id show-ids show-touched] (dump-subtree' state shape-id show-ids show-touched false))
|
|
([state shape-id show-ids show-touched show-modified]
|
|
(let [page-id (get state :current-page-id)
|
|
file (dsh/lookup-file state)
|
|
libraries (get state :files)
|
|
shape-id (if (some? shape-id)
|
|
(uuid/parse shape-id)
|
|
(first (dsh/lookup-selected state)))]
|
|
(if (some? shape-id)
|
|
(ctf/dump-subtree file page-id shape-id libraries {:show-ids show-ids
|
|
:show-touched show-touched
|
|
:show-modified show-modified})
|
|
(println "no selected shape")))))
|
|
|
|
(defn ^:export dump-subtree
|
|
([shape-id] (dump-subtree' @st/state shape-id))
|
|
([shape-id show-ids] (dump-subtree' @st/state shape-id show-ids false false))
|
|
([shape-id show-ids show-touched] (dump-subtree' @st/state shape-id show-ids show-touched false))
|
|
([shape-id show-ids show-touched show-modified] (dump-subtree' @st/state shape-id show-ids show-touched show-modified)))
|
|
|
|
(defn ^:export apply-changes
|
|
"Takes a Transit JSON changes"
|
|
[^string changes*]
|
|
|
|
(let [file-id (:current-file-id @st/state)
|
|
changes (t/decode-str changes*)]
|
|
(st/emit! (dwc/commit-changes {:redo-changes changes
|
|
:undo-changes []
|
|
:save-undo? true
|
|
:file-id file-id}))))
|
|
|
|
(defn ^:export fetch-apply
|
|
[^string url]
|
|
(-> (p/let [response (js/fetch url)]
|
|
(.text response))
|
|
(p/then apply-changes)))
|
|
|
|
(def ^:private simulated-error-body
|
|
"Stands in for the error page a proxy or CDN writes when it answers instead
|
|
of the backend."
|
|
"<html><head><title>Simulated error</title></head><body>simulated intermediary response</body></html>")
|
|
|
|
(defonce ^:private pending-http-error (atom nil))
|
|
|
|
(defn- simulated-status
|
|
"Status to answer `uri` with, or nil to let the request through. A
|
|
simulation without a deadline answers one call; one with a deadline answers
|
|
every matching call until it runs out."
|
|
[uri]
|
|
(let [{:keys [method status until]} @pending-http-error]
|
|
(when (and (some? method)
|
|
(str/includes? uri (str "/api/main/methods/" method)))
|
|
(cond
|
|
(nil? until) (do (reset! pending-http-error nil) status)
|
|
(< (js/Date.now) until) status
|
|
:else (do (reset! pending-http-error nil) nil)))))
|
|
|
|
;; The original fetch and the wrapper standing in for it, or nil when unhooked.
|
|
(defonce ^:private http-error-hook (atom nil))
|
|
|
|
(defn- install-http-error-hook!
|
|
[]
|
|
(when (nil? @http-error-hook)
|
|
(let [original (unchecked-get js/globalThis "fetch")
|
|
wrapper (fn [input params]
|
|
(let [uri (if (string? input) input (unchecked-get input "url"))]
|
|
(if-let [status (simulated-status uri)]
|
|
(p/resolved (js/Response. simulated-error-body
|
|
#js {:status status
|
|
:headers #js {"content-type" "text/html"}}))
|
|
(.call original js/globalThis input params))))]
|
|
(reset! http-error-hook {:original original :wrapper wrapper})
|
|
(unchecked-set js/globalThis "fetch" wrapper))))
|
|
|
|
(defn- remove-http-error-hook!
|
|
[]
|
|
(when-let [{:keys [original wrapper]} @http-error-hook]
|
|
;; Restore only while the wrapper is still installed, so a later
|
|
;; wrapper survives.
|
|
(when (identical? wrapper (unchecked-get js/globalThis "fetch"))
|
|
(unchecked-set js/globalThis "fetch" original))
|
|
(reset! http-error-hook nil)))
|
|
|
|
(defn ^:export simulateHttpError
|
|
"Answers calls to an API method with `status` and a body that carries no
|
|
Penpot error code, the way a CDN or a corporate proxy does. Every other
|
|
request goes through untouched.
|
|
|
|
Without `seconds` the simulation is spent once it answers one call. With
|
|
`seconds` it answers every matching call for that long, which is how to
|
|
watch a save retry, warn, keep retrying and finally recover.
|
|
|
|
debug.simulateHttpError('update-file')
|
|
debug.simulateHttpError('get-comment-threads', 403)
|
|
debug.simulateHttpError('update-file', 524, 120)"
|
|
([method]
|
|
(simulateHttpError method 524 nil))
|
|
([method status]
|
|
(simulateHttpError method status nil))
|
|
([method status seconds]
|
|
(install-http-error-hook!)
|
|
(let [until (when (and (number? seconds) (pos? seconds))
|
|
(+ (js/Date.now) (* 1000 seconds)))]
|
|
(reset! pending-http-error {:method method
|
|
:status status
|
|
:until until})
|
|
(if (some? until)
|
|
(str "every " method " call will be answered with " status
|
|
" for the next " seconds " seconds")
|
|
(str "the next " method " call will be answered with " status)))))
|
|
|
|
(defn ^:export clearHttpErrorSimulation
|
|
"Stops a running simulation and takes the wrapper off `fetch`."
|
|
[]
|
|
(reset! pending-http-error nil)
|
|
(remove-http-error-hook!)
|
|
"requests reach the backend again")
|
|
|
|
(defn ^:export reset-viewport
|
|
[]
|
|
(st/emit!
|
|
dw/reset-zoom
|
|
(dw/update-viewport-position {:x (constantly 0) :y (constantly 0)})))
|
|
|
|
(defn ^:export hide-ui
|
|
[]
|
|
(st/emit!
|
|
(dw/toggle-layout-flag :hide-ui)))
|
|
|
|
|
|
(defn ^:export shortcuts
|
|
[]
|
|
|
|
(letfn [(print-shortcuts [shortcuts]
|
|
(.table js/console
|
|
(->> shortcuts
|
|
(map (fn [[key {:keys [command]}]]
|
|
[(d/name key)
|
|
(if (vector? command)
|
|
(str/join " | " command)
|
|
command)]))
|
|
(into {})
|
|
(clj->js))))]
|
|
(let [style "font-weight: bold; font-size: 1.25rem;"]
|
|
(.log js/console "%c Dashboard" style)
|
|
(print-shortcuts app.main.data.dashboard.shortcuts/shortcuts)
|
|
|
|
(.log js/console "%c Workspace" style)
|
|
(print-shortcuts app.main.data.workspace.shortcuts/shortcuts)
|
|
|
|
(.log js/console "%c Path" style)
|
|
(print-shortcuts app.main.data.workspace.path.shortcuts/shortcuts)
|
|
|
|
(.log js/console "%c Viewer" style)
|
|
(print-shortcuts app.main.data.viewer.shortcuts/shortcuts)))
|
|
nil)
|
|
|
|
(defn ^:export nodeStats
|
|
[]
|
|
(let [root-node (dom/query ".viewport .render-shapes")
|
|
num-nodes (->> (dom/seq-nodes root-node) count)]
|
|
#js {:number num-nodes}))
|
|
|
|
(defn modif->js
|
|
[modif-tree objects]
|
|
(clj->js (into {}
|
|
(map (fn [[k v]]
|
|
[(get-in objects [k :name]) v]))
|
|
modif-tree)))
|
|
|
|
(defn ^:export dump-modifiers
|
|
[]
|
|
(let [objects (dsh/lookup-page-objects @st/state)
|
|
modifiers (:workspace-modifiers @st/state)]
|
|
(js/console.log (modif->js modifiers objects))
|
|
nil))
|
|
|
|
(defn ^:export set-workspace-read-only
|
|
[read-only?]
|
|
(st/emit! (dwcm/set-workspace-read-only read-only?)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; REPAIR & VALIDATION
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; Validation and repair
|
|
|
|
(defn ^:export validate
|
|
([] (validate nil))
|
|
([shape-id]
|
|
(let [file (dsh/lookup-file @st/state)
|
|
libraries (get @st/state :files)]
|
|
(try
|
|
(->> (if-let [shape-id (some-> shape-id uuid/parse)]
|
|
(let [page (dm/get-in file [:data :pages-index (get @st/state :current-page-id)])]
|
|
(cfv/validate-shape shape-id file page libraries))
|
|
(cfv/validate-file file libraries))
|
|
(group-by :code)
|
|
(clj->js))
|
|
(catch :default cause
|
|
(ex/print-throwable cause))))))
|
|
|
|
(defn ^:export validate-schema
|
|
[]
|
|
(try
|
|
(let [file (dsh/lookup-file @st/state)]
|
|
(cfv/validate-file-schema! file))
|
|
(catch :default cause
|
|
(ex/print-throwable cause))))
|
|
|
|
(defn ^:export repair
|
|
[reload?]
|
|
(st/emit!
|
|
(ptk/reify ::repair-current-file
|
|
ptk/EffectEvent
|
|
(effect [_ state _]
|
|
(let [features (:features state)
|
|
sid (:session-id state)
|
|
|
|
file (dsh/lookup-file state)
|
|
libs (get state :files)
|
|
|
|
errors (cfv/validate-file file libs)
|
|
_ (l/dbg :hint "repair current file" :errors (count errors))
|
|
|
|
changes (cfr/repair-file file libs errors)
|
|
|
|
params {:id (:id file)
|
|
:revn (:revn file)
|
|
:vern (:vern file)
|
|
:session-id sid
|
|
:changes changes
|
|
:features features
|
|
:skip-validate true}]
|
|
|
|
(->> (rp/cmd! :update-file params)
|
|
(rx/subs! (fn [_]
|
|
(when reload?
|
|
(dom/reload-current-window)))
|
|
(fn [cause]
|
|
(ex/print-throwable cause)))))))))
|
|
|
|
(defn ^:export fix-orphan-shapes
|
|
[]
|
|
(st/emit! (dw/fix-orphan-shapes)))
|
|
|
|
(defn ^:export find-components-norefs
|
|
[]
|
|
(st/emit! (dw/find-components-norefs)))
|
|
|
|
(defn- set-shape-ref*
|
|
[id shape-ref]
|
|
(ptk/reify ::set-shape-ref
|
|
ptk/WatchEvent
|
|
(watch [_ _ _]
|
|
(let [shape-id (uuid/parse id)
|
|
shape-ref (uuid/parse shape-ref)]
|
|
(rx/of (dw/update-shape shape-id {:shape-ref shape-ref}))))))
|
|
|
|
(defn ^:export set-shape-ref
|
|
[id shape-ref]
|
|
(st/emit! (set-shape-ref* id shape-ref)))
|
|
|
|
(defn ^:export network-averages
|
|
[]
|
|
(.log js/console (clj->js @http/network-averages)))
|
|
|
|
|
|
(defn print-last-exception
|
|
[]
|
|
(some-> errors/last-exception ex/print-throwable))
|
|
|
|
|
|
(defn ^:export dbg
|
|
[o]
|
|
(app.common.pprint/pprint o {:level 100 :length 100}))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; PRUNE UNRELATED ITEMS
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defn- get-related-ids
|
|
"Given a `context` map (:pindex, :fdata) and a `[page-id id]` pair, returns
|
|
the set of `[page-id id]` pairs directly related to it, NOT recursively:
|
|
- its children (including itself)
|
|
- its ancestors
|
|
- the main instance `[page-id id]` of its component, if it's inside a
|
|
component copy of a component defined in the current file (libraries
|
|
are ignored)
|
|
|
|
Ids are only unique within a page, so every id is always tracked together
|
|
with the page it belongs to."
|
|
[{:keys [pindex fdata]} [page-id id]]
|
|
(let [page-objects (-> (get pindex page-id) :objects)
|
|
shape (get page-objects id)]
|
|
(if (nil? shape)
|
|
#{}
|
|
(let [related (-> #{}
|
|
(into (map (partial vector page-id) (cfh/get-parent-ids page-objects id)))
|
|
(into (map (partial vector page-id) (cfh/get-children-ids-with-self page-objects id))))
|
|
head (when (ctk/in-component-copy? shape)
|
|
(ctn/get-head-shape page-objects shape))
|
|
component (when (and (some? head) (= (:component-file head) (:id fdata)))
|
|
(ctkl/get-component fdata (:component-id head)))]
|
|
(cond-> related
|
|
(some? component)
|
|
(conj [(:main-instance-page component) (:main-instance-id component)]))))))
|
|
|
|
(defn ^:export prune-unrelated-items
|
|
"This function is DESTRUCTIVE. It deletes from the current file all the pages and layers unrelated to the selection.
|
|
It is used to isolate bugs"
|
|
[]
|
|
(let [state @st/state
|
|
current-pid (:current-page-id state)
|
|
selected (get-selected state)
|
|
|
|
fdata (dsh/lookup-file-data state)
|
|
pindex (:pages-index fdata)
|
|
|
|
context {:pindex pindex
|
|
:fdata fdata}
|
|
|
|
related
|
|
(loop [related (into #{} (map (partial vector current-pid)) selected)]
|
|
(let [expanded (->> related
|
|
(reduce (fn [acc pair] (into acc (get-related-ids context pair)))
|
|
related)
|
|
(remove (fn [[_ id]] (= id uuid/zero)))
|
|
set)]
|
|
(if (= expanded related)
|
|
related
|
|
(recur expanded))))
|
|
|
|
related-by-page
|
|
(reduce (fn [acc [page-id id]] (update acc page-id (fnil conj #{}) id))
|
|
{}
|
|
related)
|
|
|
|
unrelated-pages
|
|
(->> (:pages fdata)
|
|
(remove (fn [page-id] (seq (get related-by-page page-id))))
|
|
vec)
|
|
|
|
unrelated-items-by-page
|
|
(->> (:pages fdata)
|
|
(remove (set unrelated-pages))
|
|
(map (fn [page-id]
|
|
(let [page-related (get related-by-page page-id #{})
|
|
ids (->> (get pindex page-id)
|
|
:objects
|
|
keys
|
|
(remove #{uuid/zero})
|
|
(remove page-related)
|
|
set)]
|
|
[page-id ids])))
|
|
(filter (fn [[_ ids]] (seq ids)))
|
|
vec)
|
|
|
|
items-to-delete
|
|
(reduce + (map (comp count second) unrelated-items-by-page))]
|
|
|
|
(js/console.log (str "Pages to delete: " (count unrelated-pages)
|
|
", items to delete: " items-to-delete))
|
|
(.table js/console
|
|
(->> unrelated-items-by-page
|
|
(mapcat (fn [[page-id ids]]
|
|
(let [objects (-> (get pindex page-id) :objects)]
|
|
(map (fn [id]
|
|
{:page-id (str page-id)
|
|
:id (str id)
|
|
:name (:name (get objects id))})
|
|
ids))))
|
|
(clj->js)))
|
|
(when (and (or (seq unrelated-pages) (pos? items-to-delete))
|
|
(js/confirm (str "Delete " (count unrelated-pages) " unrelated page(s) and "
|
|
items-to-delete " unrelated item(s)?")))
|
|
(let [undo-id (js/Symbol)]
|
|
(apply st/emit!
|
|
(concat
|
|
[(dwu/start-undo-transaction undo-id)]
|
|
(map dw/delete-page unrelated-pages)
|
|
(map (fn [[page-id ids]]
|
|
(dw/delete-shapes page-id ids))
|
|
unrelated-items-by-page)
|
|
[(dwu/commit-undo-transaction undo-id)]))))
|
|
nil)) |