From 9ffd2189159d6fa0091fbd61b4f36c5f3ee71847 Mon Sep 17 00:00:00 2001 From: Eva Marco Date: Thu, 15 Oct 2026 09:36:52 +0200 Subject: [PATCH 01/16] :bug: Stop passing tooltip-class to layout item numeric inputs (#12329) The layout item min and max size inputs passed :tooltip-class to numeric-input*, which never reads that prop. It stayed in the rest props and reached the DOM , so React warned about an unknown tooltipClass prop. The class never styled anything. Remove the prop from the four callers and drop the unused .tooltip-wrapper rule. Closes #12311 AI-assisted-by: claude-opus-5-5 --- .../main/ui/workspace/sidebar/options/menus/layout_item.cljs | 4 ---- .../main/ui/workspace/sidebar/options/menus/layout_item.scss | 4 ---- 2 files changed, 8 deletions(-) diff --git a/frontend/src/app/main/ui/workspace/sidebar/options/menus/layout_item.cljs b/frontend/src/app/main/ui/workspace/sidebar/options/menus/layout_item.cljs index 10b9c42db7..659aea2fb3 100644 --- a/frontend/src/app/main/ui/workspace/sidebar/options/menus/layout_item.cljs +++ b/frontend/src/app/main/ui/workspace/sidebar/options/menus/layout_item.cljs @@ -602,7 +602,6 @@ :input-type :min-width :nillable true :applied-token applied-token-to-min-w - :tooltip-class (stl/css :tooltip-wrapper) :value min-w}] [:div {:class (stl/css :layout-item-min-w) @@ -632,7 +631,6 @@ :attr :layout-item-max-w :property (tr "workspace.options.layout-item.layout-item-max-w") :nillable true - :tooltip-class (stl/css :tooltip-wrapper) :applied-token applied-token-to-max-w :value max-w}] @@ -663,7 +661,6 @@ :attr :layout-item-min-h :property (tr "workspace.options.layout-item.layout-item-min-h") :nillable true - :tooltip-class (stl/css :tooltip-wrapper) :applied-token applied-token-to-min-h :value min-h}] @@ -694,7 +691,6 @@ :attr :layout-item-max-h :property (tr "workspace.options.layout-item.layout-item-max-h") :nillable true - :tooltip-class (stl/css :tooltip-wrapper) :applied-token applied-token-to-max-h :value max-h}] diff --git a/frontend/src/app/main/ui/workspace/sidebar/options/menus/layout_item.scss b/frontend/src/app/main/ui/workspace/sidebar/options/menus/layout_item.scss index b362df51d0..52b6a165e3 100644 --- a/frontend/src/app/main/ui/workspace/sidebar/options/menus/layout_item.scss +++ b/frontend/src/app/main/ui/workspace/sidebar/options/menus/layout_item.scss @@ -192,7 +192,3 @@ .inputs-wrapper { grid-column: 1 / span 2; } - -.tooltip-wrapper { - inline-size: 100%; -} From 2cdb5757122bc14eefb047e8eac01e336d2f29cb Mon Sep 17 00:00:00 2001 From: Eva Marco Date: Thu, 15 Oct 2026 09:37:31 +0200 Subject: [PATCH 02/16] :bug: Fix font selector outside click, empty search and tick (#12285) * :bug: Close the font selector when clicking outside it The font selector had no click-outside handling. It only closed with Esc, or when its menu was unmounted, which is why a viewport click (that deselects the text) closed it and a click on the left sidebar, the rulers or the header did not. Listen to click and contextmenu on the document, as the dropdowns do, and close when the target is outside the selector. The listener starts on the next tick so the opening click does not close it, and a target no longer in the document (a font row removed after selecting it) is not taken as an outside click. The token font combobox uses the same component, so it gets the fix too. Closes #12246 AI-assisted-by: claude-opus-5-5 * :bug: Hide the empty Recent section in the font selector The "Recent" heading showed with `(and recent-fonts show-recent)`, but the filtered recent fonts are a vector and an empty one is truthy. So a search with no matches showed the heading over a blank list, and any search showed it over results that are not recent. - Show the "Recent" section only when it has fonts. - Show "No matching fonts" when the search finds nothing. - Square the list's top corners only when it sits under "Recent". Closes #12249 AI-assisted-by: claude-opus-5-5 * :bug: Separate the applied font from the focused one in font selector The tick marked the first search result when the applied font was filtered out, since one value drove both the tick and the font Enter applies. So the tick showed a font that was not applied. The tick and the focus are now two states: - The tick marks the font the text had when the selector opened. - A green border, as in the select dropdowns, marks the font Enter applies. Typing moves it to the first result without previewing it. Arrow keys move it and, once they stop for a moment, preview the font. Previewing every font of a held key flooded the store until React stopped with "Maximum update depth exceeded". - Recent fonts get no border: they are reached with the mouse or by filtering, not with the arrow keys. - Enter applies the focused font. Esc and an outside click undo the preview. Also make the rows fill the list width, so the border is not clipped, and scroll to the focused row only through the virtualized list. Closes #12247 AI-assisted-by: claude-opus-5-5 * :recycle: Refactor typography.scss to the Design System Move typography.scss to the DS tokens and mixins. No visual change intended, except that the rows that took their typography from %asset-element now use the DS body-small (line-height 1.3 instead of 1.4). - Inline the %asset-element and %input-base placeholders, resolving their design-token aliases to DS tokens and using local CSS variables for state colors. - Keep the spacing inputs on %input-element and %button-icon-small, with a TODO: those placeholders style the icon svg and the input elements, and go away when the controls move to the DS numeric-input*, out of scope here. - Use logical properties and DS spacing and size tokens. - Merge the duplicated .typography-sample rule. - Note why the "Ag" samples have no DS typography, and leave TODOs where no DS typography matches exactly. AI-assisted-by: claude-opus-5-5 --- .../sidebar/options/menus/typography.cljs | 156 +++++++++++------- .../sidebar/options/menus/typography.scss | 147 +++++++++++++---- frontend/translations/en.po | 4 + frontend/translations/es.po | 4 + 4 files changed, 222 insertions(+), 89 deletions(-) diff --git a/frontend/src/app/main/ui/workspace/sidebar/options/menus/typography.cljs b/frontend/src/app/main/ui/workspace/sidebar/options/menus/typography.cljs index f4974abc7b..2a6b472977 100644 --- a/frontend/src/app/main/ui/workspace/sidebar/options/menus/typography.cljs +++ b/frontend/src/app/main/ui/workspace/sidebar/options/menus/typography.cljs @@ -291,21 +291,14 @@ (mf/defc font-item* {::mf/wrap [mf/memo]} - [{:keys [font is-current on-click style]}] - (let [item-ref (mf/use-ref) - on-click (mf/use-fn (mf/deps font) #(on-click font))] - - (mf/with-effect [is-current] - (when is-current - (let [element (mf/ref-val item-ref)] - (when-not (dom/is-in-viewport? element) - (dom/scroll-into-view! element))))) - + [{:keys [font is-current is-focused on-click style]}] + (let [on-click (mf/use-fn (mf/deps font) #(on-click font))] [:div {:class (stl/css :font-wrapper) :style style - :ref item-ref :on-click on-click} - [:div {:class (stl/css-case :font-item true :selected is-current)} + [:div {:class (stl/css-case :font-item true + :selected is-current + :focused is-focused)} [:> font-item-preview* {:font font}] (when is-current [:> icon* {:icon-id i/tick @@ -326,11 +319,20 @@ (mf/defc font-selector* [{:keys [on-select on-close current-font show-recent full-size]}] - (let [selected (mf/use-state current-font) + (let [;; The tick marks the font the text had when the selector opened. + ;; The focus (green border) marks the font Enter applies: arrows move + ;; it and preview the font, Esc and an outside click undo the preview + initial-font (mf/with-memo [] current-font) + focused* (mf/use-state current-font) + focused (deref focused*) + previewed? (mf/use-ref false) + preview? (mf/use-ref false) + state* (mf/use-state #(do {:term "" :backends #{}})) state (deref state*) + root (mf/use-ref) flist (mf/use-ref) input (mf/use-ref) @@ -353,52 +355,57 @@ (filter #(contains? installed-ids (:id %))) (filter-fonts state))) - ;; When the active font is not in the filtered results, pre-select - ;; the first match visually so the user can confirm it with Enter — - ;; without live-applying it on every keystroke. - effective-selected - (if (and (seq fonts) (not (d/seek #(= (:id %) (:id @selected)) fonts))) - (first fonts) - @selected) - full-size? (boolean (and full-size show-recent)) - select-next - (mf/use-fn - (mf/deps fonts) - (fn [event] - (dom/stop-propagation event) - (dom/prevent-default event) - (swap! selected get-next-font fonts))) + ;; `recent-fonts` is a vector, so check it with `seq`: an empty one + ;; is truthy and would show the heading over nothing + show-recent? (boolean (and show-recent (seq recent-fonts))) - select-prev + ;; Arrows only move the focus, from its latest value: a held key + ;; fires again before the listener sees the new state. The preview + ;; follows in an effect + focus-and-preview (mf/use-fn (mf/deps fonts) - (fn [event] + (fn [event get-font] (dom/stop-propagation event) (dom/prevent-default event) - (swap! selected get-prev-font fonts))) + (when (seq fonts) + (mf/set-ref-val! preview? true) + (swap! focused* get-font fonts)))) + + on-cancel + (mf/use-fn + (mf/deps initial-font on-select on-close) + (fn [] + (when (mf/ref-val previewed?) + (on-select initial-font)) + (on-close))) on-key-down (mf/use-fn - (mf/deps fonts on-select on-close) + (mf/deps focused focus-and-preview on-cancel on-select on-close) (fn [event] (cond - (kbd/up-arrow? event) (select-prev event) - (kbd/down-arrow? event) (select-next event) - (kbd/esc? event) (on-close) - (kbd/enter? event) - (let [first-result (when-not (d/seek #(= (:id %) (:id @selected)) fonts) - (first fonts))] - (if first-result - (do (on-select first-result) (on-close)) - (on-close))) + (kbd/up-arrow? event) (focus-and-preview event get-prev-font) + (kbd/down-arrow? event) (focus-and-preview event get-next-font) + (kbd/esc? event) (on-cancel) + (kbd/enter? event) (do (when (some? focused) + (on-select focused)) + (on-close)) :else (dom/focus! (mf/ref-val input))))) on-filter-change (mf/use-fn - (fn [event] - (swap! state* assoc :term event))) + (mf/deps state all-fonts) + (fn [term] + ;; Move the focus to the first result, without previewing it. + ;; `swap!` on a `use-state` returns nil, so build the new state here + (let [state (assoc state :term term)] + (reset! state* state) + (mf/set-ref-val! preview? false) + (when (seq term) + (reset! focused* (first (filter-fonts state all-fonts))))))) on-select-and-close (mf/use-fn @@ -407,10 +414,29 @@ (on-select font) (on-close)))] - (mf/with-effect [fonts on-key-down] + (mf/with-effect [on-key-down] (let [key (events/listen js/document "keydown" on-key-down)] #(events/unlistenByKey key))) + ;; Close on an outside click. Starts on the next tick to skip the + ;; opening click; detached targets (a just-selected row) are ignored + (mf/with-effect [on-cancel] + (let [listening? (volatile! false) + on-click (fn [event] + (let [target (dom/get-target event) + node (mf/ref-val root)] + (when (and @listening? + (some? node) + (.-isConnected ^js target) + (not (dom/child? target node))) + (on-cancel)))) + task (tm/schedule #(vreset! listening? true)) + keys [(events/listen js/document "click" on-click) + (events/listen js/document "contextmenu" on-click)]] + (fn [] + (tm/dispose! task) + (run! events/unlistenByKey keys)))) + ;; Materialize the preview sprite into the DOM only while the picker is open ;; (markup is prefetched on workspace load), removing it on close so its ;; ~2000 nodes aren't kept around idle. The attachment is deferred so the @@ -427,16 +453,26 @@ (when-some [n @node*] (fonts/detach-preview-sprite! n)))))) - (mf/with-effect [@selected] + ;; Preview the focused font once the arrows stop for a moment. Applying + ;; every font of a held key floods the store and the text editor with + ;; updates, until React stops with "Maximum update depth exceeded" + (mf/with-effect [focused] + (when (mf/ref-val preview?) + (mf/set-ref-val! preview? false) + (let [task (tm/schedule 100 (fn [] + (mf/set-ref-val! previewed? true) + (on-select focused)))] + #(tm/dispose! task)))) + + ;; The only scroll to the focused row: the list is virtualized, so the row + ;; may not be rendered yet + (mf/with-effect [focused fonts] (let [node (mf/ref-val flist) - index (:index @selected)] + index (d/index-of-pred fonts #(= (:id %) (:id focused)))] ;; This is nil safe operation, do nothing if node or index are ;; invalid. (dom/scroll-to-row node index))) - (mf/with-effect [@selected] - (on-select @selected)) - (mf/with-effect [] (st/emit! (dsc/push-shortcuts :typography {} :workspace)) (fn [] @@ -451,7 +487,8 @@ (dom/scroll-to-position node offset))))) [:div {:class [(stl/css-case :font-selector true - :fonts-on-modal (not full-size?))]} + :fonts-on-modal (not full-size?))] + :ref root} [:div {:class (stl/css-case :font-selector-dropdown true :font-selector-dropdown-full-size full-size?)} [:div {:class (stl/css :header)} @@ -459,7 +496,7 @@ :value (:term state) :auto-focus true :placeholder (tr "workspace.options.search-font")}] - (when (and recent-fonts show-recent) + (when show-recent? [:section {:class (stl/css :show-recent)} [:p {:class (stl/css :header-title)} (tr "workspace.options.recent-fonts")] (for [[idx font] (d/enumerate recent-fonts)] @@ -467,15 +504,21 @@ :font font :style {} :on-click on-select-and-close - :is-current (= (:id font) (:id effective-selected))}])])] + ;; Recent fonts are reached with the mouse or by + ;; filtering, never with the arrow keys, so no focus + :is-current (= (:id font) (:id initial-font))}])])] [:div {:class (stl/css-case :fonts-list true - :fonts-list-full-size full-size?)} + :fonts-list-full-size full-size? + :fonts-list-below-recent show-recent?)} + (when (empty? fonts) + [:p {:class (stl/css :fonts-list-empty)} + (tr "workspace.options.no-font-results")]) [:> rvt/AutoSizer {} (fn [props] (let [width (unchecked-get props "width") height (unchecked-get props "height") - render #(row-renderer fonts effective-selected on-select-and-close %)] + render #(row-renderer fonts (:id initial-font) (:id focused) on-select-and-close %)] (mf/html [:> rvt/List #js {:height height :ref flist @@ -485,7 +528,7 @@ :rowRenderer render}])))]]]])) (defn row-renderer - [fonts selected on-select props] + [fonts current-id focused-id on-select props] (let [index (unchecked-get props "index") key (unchecked-get props "key") style (unchecked-get props "style") @@ -495,7 +538,8 @@ :font font :style style :on-click on-select - :is-current (= (:id font) (:id selected))}]))) + :is-current (= (:id font) current-id) + :is-focused (= (:id font) focused-id)}]))) (mf/defc font-options* [{:keys [values on-change on-blur show-recent full-size-selector]}] diff --git a/frontend/src/app/main/ui/workspace/sidebar/options/menus/typography.scss b/frontend/src/app/main/ui/workspace/sidebar/options/menus/typography.scss index bbfa19734e..ddc47c5b97 100644 --- a/frontend/src/app/main/ui/workspace/sidebar/options/menus/typography.scss +++ b/frontend/src/app/main/ui/workspace/sidebar/options/menus/typography.scss @@ -13,6 +13,8 @@ // Must match BOX_HEIGHT in scripts/build-fonts-preview.js (the sprite bakes each // font name into that box at 1 unit == 1px). +// NOTE: kept in px on purpose, not px2rem(): the sprite is baked in pixels, so +// the box must not scale with the root font size. $font-preview-box-height: 28px; .typography-entry { @@ -72,15 +74,6 @@ $font-preview-box-height: 28px; } } -.typography-sample { - display: flex; - justify-content: center; - align-items: center; - min-inline-size: $sz-24; - block-size: $sz-32; - color: var(--color-foreground-secondary); -} - .typography-name { color: var(--color-foreground-primary); } @@ -113,18 +106,23 @@ $font-preview-box-height: 28px; } .typography-sample-input { + // No DS typography on purpose: the "Ag" sample is drawn in the + // typography's own font + font-size: px2rem(16); + line-height: 1; display: flex; justify-content: center; align-items: center; inline-size: $sz-24; block-size: 100%; - font-size: px2rem(16); - line-height: 1; overflow: hidden; color: var(--color-foreground-primary); } .adv-typography-name { + // TODO: No exact DS typography match found. Rename input of a + // typography; only the font size is set. + // Closest match: body-small (12px). font-size: px2rem(12); color: var(--font-name-wrapper-foreground-color); flex-grow: 1; @@ -155,25 +153,30 @@ $font-preview-box-height: 28px; } .typography-name-wrapper { - @extend %asset-element; + @include t.use-typography("body-small"); display: grid; grid-template-columns: $sz-24 auto 1fr $sz-28; flex: 1; + align-items: center; block-size: $sz-32; inline-size: 100%; padding: 0 0 0 var(--sp-m); + border-radius: $br-8; background-color: var(--color-background-quaternary); + color: var(--color-foreground-primary); margin-block-end: var(--sp-xs); } .typography-sample { + // No DS typography on purpose: the "Ag" sample is drawn in the + // typography's own font + font-size: px2rem(16); + line-height: 1; display: flex; justify-content: center; align-items: center; min-inline-size: $sz-24; - font-size: px2rem(16); - line-height: 1; block-size: $sz-32; padding: 0; overflow: hidden; @@ -186,8 +189,8 @@ $font-preview-box-height: 28px; margin: 0; min-inline-size: px2rem(6); - padding: 8px 0 8px 6px; - max-width: 100%; + padding: var(--sp-s) 0 var(--sp-s) px2rem(6); + max-inline-size: 100%; color: var(--color-foreground-primary); } @@ -210,7 +213,7 @@ $font-preview-box-height: 28px; display: grid; grid-template-columns: 50% 50%; block-size: $sz-32; - padding-left: var(--sp-xs); + padding-inline-start: var(--sp-xs); } .info-label, @@ -235,11 +238,22 @@ $font-preview-box-height: 28px; } .font-option { - @include t.use-typography("body-small"); - @extend %asset-element; + --font-option-background-color: var(--color-background-tertiary); + @include t.use-typography("body-small"); + + display: flex; + align-items: center; + block-size: $sz-32; padding: var(--sp-s); + border-radius: $br-8; + background-color: var(--font-option-background-color); + color: var(--color-foreground-primary); cursor: pointer; + + &:hover { + --font-option-background-color: var(--color-background-quaternary); + } } .font-option-name { @@ -255,15 +269,26 @@ $font-preview-box-height: 28px; } .font-size-options { - @extend %asset-element; + --font-size-options-background-color: var(--color-background-tertiary); + @include t.use-typography("body-small"); + display: flex; flex-grow: 1; + align-items: center; + block-size: $sz-32; inline-size: px2rem(60); margin: 0; padding: 0; border: $b-1 solid var(--color-background-tertiary); + border-radius: $br-8; + background-color: var(--font-size-options-background-color); + color: var(--color-foreground-primary); position: relative; + + &:hover { + --font-size-options-background-color: var(--color-background-quaternary); + } } .font-variant-options { @@ -283,6 +308,9 @@ $font-preview-box-height: 28px; gap: var(--sp-xs); } +// TODO: Kept on the deprecated %input-element and %button-icon-small +// placeholders, which style the icon svg and the input elements. They go +// away when these controls move to the DS numeric-input*. .line-height, .letter-spacing { @extend %input-element; @@ -301,11 +329,22 @@ $font-preview-box-height: 28px; } .text-transform { - @extend %asset-element; + --text-transform-background-color: var(--color-background-tertiary); + @include t.use-typography("body-small"); + + display: flex; + align-items: center; + block-size: $sz-32; inline-size: fit-content; padding: 0; - background-color: var(--color-background-tertiary); + border-radius: $br-8; + background-color: var(--text-transform-background-color); + color: var(--color-foreground-primary); + + &:hover { + --text-transform-background-color: var(--color-background-quaternary); + } } .font-size-select { @@ -320,10 +359,24 @@ $font-preview-box-height: 28px; outline: none; .numeric-input { - @extend %input-base; @include t.use-typography("body-small"); + @include text-ellipsis; + block-size: $sz-28; + inline-size: 100%; + flex-grow: 1; + margin: var(--sp-xxs) 0; padding: 0; + border: none; + border-radius: $br-8; + background: none; + outline: none; + color: var(--color-foreground-primary); + + &[disabled] { + opacity: 0.5; + pointer-events: none; + } } } @@ -332,16 +385,15 @@ $font-preview-box-height: 28px; justify-content: center; align-items: center; position: absolute; - top: calc(-1 * #{px2rem(18)}); - left: 0; - right: 0; + inset-block-start: calc(-1 * #{px2rem(18)}); + inset-inline: 0; block-size: 100%; inline-size: 100%; z-index: var(--z-index-dropdown); } .fonts-on-modal { - top: 0; + inset-block-start: 0; } .show-recent { @@ -377,22 +429,39 @@ $font-preview-box-height: 28px; } .font-wrapper { - padding-bottom: var(--sp-xs); + padding-block-end: var(--sp-xs); cursor: pointer; } .font-item { - @extend %asset-element; + --font-item-background-color: var(--color-background-tertiary); + + @include t.use-typography("body-small"); - width: px2rem(280); - margin-bottom: var(--sp-xs); - border-radius: $br-8; display: flex; + block-size: $sz-32; + inline-size: 100%; + margin-block-end: var(--sp-xs); + padding: var(--sp-s) var(--sp-m); + border-radius: $br-8; + background-color: var(--font-item-background-color); + color: var(--color-foreground-primary); + + &:hover { + --font-item-background-color: var(--color-background-quaternary); + } &.selected { color: var(--color-foreground-primary); } + // The font Enter applies, same border as the focused option of the + // select dropdowns + &.focused { + outline: $b-1 solid var(--color-accent-primary); + outline-offset: calc(-1 * #{$b-1}); + } + // Center & clip so a previewed font's own metrics never grow/overflow the row. align-items: center; overflow: hidden; @@ -448,9 +517,21 @@ $font-preview-box-height: 28px; } .fonts-list-full-size { + border: $b-1 solid var(--color-background-quaternary); +} + +// Joins the list to the "Recent" section above it +.fonts-list-below-recent { border-start-start-radius: 0; border-start-end-radius: 0; - border: $b-1 solid var(--color-background-quaternary); +} + +.fonts-list-empty { + @include t.use-typography("body-small"); + + color: var(--color-foreground-secondary); + margin: 0; + padding: var(--sp-m); } .dropdown-icon { diff --git a/frontend/translations/en.po b/frontend/translations/en.po index eb04aa1bf8..b9a3544478 100644 --- a/frontend/translations/en.po +++ b/frontend/translations/en.po @@ -7711,6 +7711,10 @@ msgstr "More library colors" msgid "workspace.options.more-token-colors" msgstr "More color tokens" +#: src/app/main/ui/workspace/sidebar/options/menus/typography.cljs:502 +msgid "workspace.options.no-font-results" +msgstr "No matching fonts" + #: src/app/main/ui/workspace/sidebar/options/drawing/frame.cljs:117, src/app/main/ui/workspace/sidebar/options/menus/measures.cljs:518 msgid "workspace.options.no-size-preset-results" msgstr "No matching size preset" diff --git a/frontend/translations/es.po b/frontend/translations/es.po index 59bc353113..9adb3cde53 100644 --- a/frontend/translations/es.po +++ b/frontend/translations/es.po @@ -7777,6 +7777,10 @@ msgstr "Más colores de la biblioteca" msgid "workspace.options.more-token-colors" msgstr "Más tokens de color" +#: src/app/main/ui/workspace/sidebar/options/menus/typography.cljs:502 +msgid "workspace.options.no-font-results" +msgstr "No hay fuentes coincidentes" + #: src/app/main/ui/workspace/sidebar/options/drawing/frame.cljs:117, src/app/main/ui/workspace/sidebar/options/menus/measures.cljs:518 msgid "workspace.options.no-size-preset-results" msgstr "No hay tamaños predefinidos coincidentes" From c74d415ddd21c1e51bd9bb82b1ec10755dac6677 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Thu, 15 Oct 2026 10:19:26 +0200 Subject: [PATCH 03/16] :bug: Stop oversized audit events from wedging the archive queue (#12252) * :bug: Stop the export-shapes modal event from dumping all exports The `:export-shapes` modal event carried the full `:exports` vector, each export embedding its shape (path data, geometry, text content). One event reached 1.7 MB, which made the audit archive cron POST a chunk past the proxy body limit and wedge the queue. Build a compact body for that modal instead: total exports, distinct shapes and one count per export type, plus the page name. Other modals keep their props unchanged. Move the modal `:origin` prop to `::ev/origin` so `make-proto-event` records it on the event context as `:event-origin`; the UI still reads the plain prop from the raw state. Add tests for the summary and for the modal origin. AI-assisted-by: deepseek-v4.1-flash * :bug: Bound exception messages in reports and audit events A frontend crash whose message embeds a whole payload (a serialized file) produced a 9.4 MB audit event: the message was repeated in the `:hint` prop, in the report context and in the stack trace. A single event that big wedged the audit archive queue. Bound exception messages at the source: `get-hint` clamps to `max-message-length` (1000 chars), and the CLJS `format-throwable` clamps the message line of the stack trace and honors `:trace-length` (parity with the CLJ version). `report-context` now prints `get-hint` instead of the raw `:hint` from `ex-data`. Fix `first-line` on the JVM: `cuerdas/index-of` returns nil when the substring is missing and `(pos? nil)` throws there (it is false in CLJS), so single-line messages crashed the backend path. AI-assisted-by: deepseek-v4.1-flash --- .serena/memories/audit-log.md | 2 + .serena/memories/clojure/idioms.md | 1 + .../frontend/routing-app-shell-subtleties.md | 1 + common/src/app/common/exceptions.cljc | 39 ++++++++++--- common/test/common_tests/exceptions_test.cljc | 57 +++++++++++++++++++ common/test/common_tests/runner.cljc | 2 + frontend/src/app/main/data/modal.cljs | 27 ++++++++- frontend/src/app/main/errors.cljs | 2 +- .../test/frontend_tests/data/modal_test.cljs | 55 ++++++++++++++++++ .../test/frontend_tests/main_errors_test.cljs | 17 ++++++ frontend/test/frontend_tests/runner.cljs | 2 + 11 files changed, 193 insertions(+), 12 deletions(-) create mode 100644 common/test/common_tests/exceptions_test.cljc create mode 100644 frontend/test/frontend_tests/data/modal_test.cljs diff --git a/.serena/memories/audit-log.md b/.serena/memories/audit-log.md index 8097bd901c..223f370815 100644 --- a/.serena/memories/audit-log.md +++ b/.serena/memories/audit-log.md @@ -260,6 +260,8 @@ Nexus dispatches on `:type`: `"telemetry-events"` batches are coerced and insert Nexus is the long-term store. Every 5 min the `:audit-log-archive` cron takes 128-row chunks of unarchived rows (`FOR UPDATE SKIP LOCKED`, ordered by `created_at`), POSTs them as transit `{:events [...]}` with `x-shared-key: "nexus "` (`:nexus-shared-key`, or derived from the instance secret) and `origin` = public-uri, and marks `archived_at = now()` **only on HTTP 204**, in the same transaction. Anything else is retried next run; flag on but no URI raises `:task-not-configured`. It loops with 100 ms pauses until empty. +A chunk is **one POST** and the task advances only on 204, so a single oversized event wedges the whole queue: a crash report whose message embeds a whole payload (a serialized file, for example) can push the request past the proxy body limit and the rejection blocks every later event until it is pruned by hand. Frontend crash reports are therefore size-bounded at the source (`mem:frontend/routing-app-shell-subtleties`): `app.common.exceptions/get-hint` and the CLJS `format-throwable` clamp exception messages (`max-message-length`). + On the other side, Nexus checks `origin` against its allowlist (403 if not allowed), coerces the events, and inserts them into its own `audit_log` (partitioned by `received_at`, with an incrementing sequence number and `source`). Watch the rename: Penpot's `created-at` is stored as **`received-at`** in Nexus; Nexus's `created-at` is when it was created there. `tracked-at` keeps the origin time. Telemetry batches arriving at `telemetry.penpot.app` land in the same table through the telemetry endpoint above. Concurrent runs are safe: rows are locked with `FOR UPDATE SKIP LOCKED` inside the same transaction that sends and marks them, so two archivers running at once each take different rows. Only rows Nexus acknowledges (HTTP 204) get marked; anything else is retried on the next run. diff --git a/.serena/memories/clojure/idioms.md b/.serena/memories/clojure/idioms.md index a4e9f3af72..cf85848c3a 100644 --- a/.serena/memories/clojure/idioms.md +++ b/.serena/memories/clojure/idioms.md @@ -9,3 +9,4 @@ Behaviors confirmed against the language/stdlib — do not re-derive from assump - Valid: `(defn ^:async f)`, `(defn- ^:async f)`, `(^:async fn [] …)` (the latter is what stock `t/async` generates itself). - `^:async` fns never throw synchronously (rejected promises instead); `try/catch/finally` supported; continuations are microtasks, timers and RxJS schedulers are macrotasks (FIFO). - `!` suffix allowed cases (only exceptions to the no-new-`!` rule in `mem:clojure/design-rules`): mutating public `app.db` API (`insert!`, `update!`, `delete!`, `run!`, `tx-run!`, `exec!`, ...) and fns whose contract is to work over transients (stdlib `conj!`, `assoc!`, `dissoc!`, `disj!`, `persistent!` and custom helpers over them); any further case must be registered here with justification before use. +- `cuerdas.core/index-of` returns `nil` (not `-1`) when the substring is absent, like `clojure.string/index-of`. `(pos? nil)` **throws on the JVM** but evaluates to `false` in CLJS (JS coercion), so `(if (pos? (str/index-of s "\n")) …)` works in the browser and crashes the backend. Guard with `some?` before `pos?` (this was `app.common.exceptions/first-line`). diff --git a/.serena/memories/frontend/routing-app-shell-subtleties.md b/.serena/memories/frontend/routing-app-shell-subtleties.md index 3c370b8f6c..f98b7f626d 100644 --- a/.serena/memories/frontend/routing-app-shell-subtleties.md +++ b/.serena/memories/frontend/routing-app-shell-subtleties.md @@ -16,6 +16,7 @@ - `app.main.errors/submit-report` is governed by a dedup governor: each report carries a fingerprint (`report-name|type|code|hint|first stack frame`; the report name is part of it so a handled report never coalesces with an unhandled/exception-page one), the first occurrence is always emitted, repeats within 2 minutes are counted and included in the next emitted report as `:occurrences`, and the fingerprint cache is bounded (first-inserted entry evicted, FIFO, via `:order` queue) so memory stays fixed. It applies to `handled-exception`, `unhandled-exception` and `exception-page`; a report without an exception cause is ignored and does not consume a reservation. - Errors caused by the environment (`environment-error-types`: `:network`, `:offline`, `:bad-gateway`, `:service-unavailable`, `:nitrate-unavailable`, `:nitrate-not-configured`) are not application defects: they are reported as audit-only `handled-exception` (never `unhandled-exception`/`exception-page`, so they skip internal reports and alerts), with a compact report and a fingerprint that drops the stack frame. `:offline` has its own handler and no longer falls through to `:default`; `:network`/`:offline` show the `errors.connection-error` toast. - `generate-report` accepts an explicit `{:format :compact|:full}` (default `:full`) chosen by its caller (`flash`, `exception-section*`): `:compact` keeps the context header plus type/code/uri, and skips the stack, the `ex-data` dump and the last-events list. It is total: if formatting fails it returns a minimal fallback string instead of nil, so an already reserved emission is never dropped. +- Error messages are bounded at the source: `app.common.exceptions/get-hint` clamps to `max-message-length` (1000 chars) and the CLJS `format-throwable` clamps the message line of the stack trace and honors `:trace-length`. A message can embed a whole payload (a serialized file, for example) and reach megabytes; the bound keeps the audit `:hint` prop and the `:report` string small. The `Context: Hint:` header in `report-context` prints `get-hint` (not the raw `:hint` from `ex-data`) for the same reason. - `flash` runs its whole body (report pipeline first, toast after) inside a single `ts/schedule` callback: nothing executes synchronously on the error handler's stack. The report is reserved before being generated, so suppressed occurrences do not pay the `generate-report` cost; a reporting or notification failure is logged to the console and never propagates, and the toast is still attempted. `flash` returns a total promise (never rejects) resolving with the generated report, or nil when nothing is emitted, once the callback completes; production callers ignore it, tests await it. `flash` derives only the payload format from the cause (`environment-error?` → `:compact`); the audit event name is the canonical one requested by `:type` (`handled-exception`/`unhandled-exception`) and is never reclassified, because external tools filter on those names. `exception-section*` picks `handled-exception`/`exception-page` explicitly per cause; `flash-persistence` only adds the toast hint. ## Store and websocket diff --git a/common/src/app/common/exceptions.cljc b/common/src/app/common/exceptions.cljc index 5a8a9acaec..f27d1d531d 100644 --- a/common/src/app/common/exceptions.cljc +++ b/common/src/app/common/exceptions.cljc @@ -29,6 +29,22 @@ (def ^:dynamic *data-length* 8) (def ^:dynamic *data-level* 8) +(def max-message-length + "Upper bound, in characters, for an exception message surfaced as a hint or + embedded in a formatted stack trace. A message can carry a whole payload (a + serialized file, for instance) and grow to megabytes; only the head helps to + identify the failure, and the rest is noise that bloats reports and the audit + events built from them." + 1000) + +(defn- truncate + "Truncates a string to at most `n` characters, appending an ellipsis when it + had to cut. Values that are not strings pass through unchanged." + [s n] + (if (and (string? s) (> (count s) n)) + (str (subs s 0 n) "...") + s)) + (defmacro error [& {:keys [type hint] :as params}] `(ex-info ~(or hint (name type)) @@ -243,7 +259,7 @@ :cljs (defn format-throwable - [cause & {:as opts}] + [cause & {:keys [trace-length]}] (with-out-str (when-let [exdata (ex-data cause)] (when-let [hint (or (get exdata :hint) @@ -251,7 +267,7 @@ (when (str/index-of hint "\n") (println "Hint:") (println "--------------------") - (println hint) + (println (truncate hint max-message-length)) (println))) (when-let [explain (get exdata ::sm/explain)] @@ -272,14 +288,20 @@ (println)) (when-let [trace (.-stack cause)] - (println "Trace:") - (println "--------------------") - (println (.-stack cause)))))) + (let [lines (str/lines trace) + head (truncate (first lines) max-message-length) + tail (rest lines)] + (println "Trace:") + (println "--------------------") + (when head + (println head)) + (doseq [line (if trace-length (take trace-length tail) tail)] + (println line))))))) (defn first-line [s] (let [break-index (str/index-of s "\n")] - (if (pos? break-index) + (if (and (some? break-index) (pos? break-index)) (subs s 0 break-index) s))) @@ -308,5 +330,6 @@ (defn get-hint [cause] - (or (some-> (ex-data cause) (get :hint) first-line) - (some-> (ex-message cause) first-line))) + (truncate (or (some-> (ex-data cause) (get :hint) first-line) + (some-> (ex-message cause) first-line)) + max-message-length)) diff --git a/common/test/common_tests/exceptions_test.cljc b/common/test/common_tests/exceptions_test.cljc new file mode 100644 index 0000000000..6f9df8da60 --- /dev/null +++ b/common/test/common_tests/exceptions_test.cljc @@ -0,0 +1,57 @@ +;; 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 common-tests.exceptions-test + "Exception message bounding in `app.common.exceptions`. + + A message can carry a whole payload (a serialized file, for instance) and + grow to megabytes. `get-hint` and the CLJS `format-throwable` keep a bounded + head so neither the audit `:hint` prop nor the report can explode." + (:require + #?(:cljs [cuerdas.core :as str]) + [app.common.exceptions :as ex] + [clojure.test :as t])) + +(defn- huge-string + [n] + (apply str (repeat n "x"))) + +(t/deftest first-line-keeps-a-single-line-message-intact-test + (t/is (= "boom" (ex/first-line "boom"))) + (t/is (= "boom" (ex/first-line "boom\nrest of the message")))) + +(t/deftest get-hint-returns-the-first-line-test + (t/is (= "boom" (ex/get-hint (ex-info "boom\nsecond line" {}))))) + +(t/deftest get-hint-prefers-the-ex-data-hint-test + (t/is (= "from-data" (ex/get-hint (ex-info "from-message" {:hint "from-data"}))))) + +(t/deftest get-hint-bounds-a-huge-message-test + (let [huge (huge-string (* 4 ex/max-message-length)) + hint (ex/get-hint (ex-info huge {}))] + (t/is (string? hint)) + (t/is (<= (count hint) (+ ex/max-message-length 3))) + (t/is (= (subs hint 0 32) (subs huge 0 32))))) + +(t/deftest get-hint-bounds-a-huge-ex-data-hint-test + (let [huge (huge-string (* 4 ex/max-message-length)) + hint (ex/get-hint (ex-info "short" {:hint huge}))] + (t/is (<= (count hint) (+ ex/max-message-length 3))) + (t/is (= (subs hint 0 32) (subs huge 0 32))))) + +#?(:cljs + (t/deftest format-throwable-bounds-a-huge-trace-message-test + (let [huge (huge-string (* 4 ex/max-message-length)) + out (ex/format-throwable (ex-info huge {})) + msg (some #(when (str/includes? % (subs huge 0 16)) %) (str/lines out))] + (t/is (some? msg)) + (t/is (<= (count msg) (+ ex/max-message-length 16)))))) + +#?(:cljs + (t/deftest format-throwable-honors-trace-length-test + (let [full (ex/format-throwable (ex-info "boom" {})) + short (ex/format-throwable (ex-info "boom" {}) {:trace-length 1})] + (t/is (< (count (str/lines short)) (count (str/lines full))))))) diff --git a/common/test/common_tests/runner.cljc b/common/test/common_tests/runner.cljc index eb2e3bb1c7..e4cec9b442 100644 --- a/common/test/common_tests/runner.cljc +++ b/common/test/common_tests/runner.cljc @@ -16,6 +16,7 @@ [common-tests.buffer-test] [common-tests.colors-test] [common-tests.data-test] + [common-tests.exceptions-test] [common-tests.files-builder-test] [common-tests.files-changes-test] [common-tests.files-migrations-0025-test] @@ -118,6 +119,7 @@ 'common-tests.buffer-test 'common-tests.colors-test 'common-tests.data-test + 'common-tests.exceptions-test 'common-tests.files-builder-test 'common-tests.files-changes-test 'common-tests.files-migrations-0025-test diff --git a/frontend/src/app/main/data/modal.cljs b/frontend/src/app/main/data/modal.cljs index 458eba37ad..7db55ee4d7 100644 --- a/frontend/src/app/main/data/modal.cljs +++ b/frontend/src/app/main/data/modal.cljs @@ -17,6 +17,19 @@ ;; TODO: rename `:type` to `:name` +(defn- summarize-export-shapes + "Builds a compact body for the `:export-shapes` modal event. We know the + shape of these props here, so instead of dumping every export (each one + carrying its full shape, which can be megabytes) we emit counters: total + exports, distinct shapes and one count per export type." + [props] + (let [exports (:exports props)] + (merge + {:page (:name props) + :num-shapes (count (distinct (map :object-id exports))) + :num-exports (count exports)} + (frequencies (map :type exports))))) + (defn show ([props] (show (uuid/next) (:type props) props)) @@ -26,9 +39,17 @@ (ptk/reify ::show-modal ev/Event (-data [_] - (-> props - (dissoc :type) - (assoc :name type))) + (let [origin (:origin props) + data (if (= type :export-shapes) + (assoc (summarize-export-shapes props) :name type) + (-> props + (dissoc :type) + (assoc :name type)))] + ;; The origin is event metadata, not a prop: sending it as + ;; ::ev/origin makes `make-proto-event` put it on the event context + ;; (`:event-origin`); as a plain `:origin` it only stayed as a prop. + (cond-> (dissoc data :origin) + (some? origin) (assoc ::ev/origin origin)))) ptk/UpdateEvent (update [_ state] diff --git a/frontend/src/app/main/errors.cljs b/frontend/src/app/main/errors.cljs index d2c4976024..3eb4496bfb 100644 --- a/frontend/src/app/main/errors.cljs +++ b/frontend/src/app/main/errors.cljs @@ -192,7 +192,7 @@ (println "Context:") (println "--------------------") (println "Timestamp:" (ct/format-inst (ct/now) :rfc1123)) - (println "Hint: " (or (:hint data) (ex-message cause) "--")) + (println "Hint: " (or (ex/get-hint cause) "--")) (println "Prof ID: " (str (or profile-id "--"))) (println "Team ID: " (str (or team-id "--"))) (when-let [file-id (or (:file-id data) file-id)] diff --git a/frontend/test/frontend_tests/data/modal_test.cljs b/frontend/test/frontend_tests/data/modal_test.cljs new file mode 100644 index 0000000000..e3b0fd4325 --- /dev/null +++ b/frontend/test/frontend_tests/data/modal_test.cljs @@ -0,0 +1,55 @@ +;; 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.modal-test + (:require + [app.common.uuid :as uuid] + [app.main.data.event :as ev] + [app.main.data.modal :as modal] + [cljs.test :as t :include-macros true])) + +(t/deftest export-shapes-modal-event-carries-a-summary + (let [shape-a (uuid/next) + shape-b (uuid/next) + exports [{:object-id shape-a :type :png} + {:object-id shape-a :type :svg} + {:object-id shape-b :type :png}] + event (modal/show :export-shapes + {:exports exports + :origin "workspace:sidebar" + :name "Page 1"}) + data (ev/-data event)] + + (t/testing "the raw exports never leak into the event" + (t/is (not (contains? data :exports)))) + + (t/testing "the event carries counters instead" + (t/is (= 3 (:num-exports data))) + (t/is (= 2 (:num-shapes data))) + (t/is (= 2 (:png data))) + (t/is (= 1 (:svg data)))) + + (t/testing "the modal context is preserved" + (t/is (= "Page 1" (:page data))) + (t/is (= :export-shapes (:name data)))) + + (t/testing "origin is emitted as event metadata, not as a prop" + (t/is (= "workspace:sidebar" (::ev/origin data))) + (t/is (not (contains? data :origin)))))) + +(t/deftest other-modals-keep-their-props + (let [event (modal/show :some-modal {:foo "bar" :items [1 2 3]}) + data (ev/-data event)] + (t/is (= "bar" (:foo data))) + (t/is (= [1 2 3] (:items data))) + (t/is (= :some-modal (:name data))))) + +(t/deftest modal-origin-becomes-event-metadata + (let [event (modal/show :some-modal {:foo "bar" :origin "dashboard"}) + data (ev/-data event)] + (t/is (= "dashboard" (::ev/origin data))) + (t/is (not (contains? data :origin))) + (t/is (= "bar" (:foo data))))) diff --git a/frontend/test/frontend_tests/main_errors_test.cljs b/frontend/test/frontend_tests/main_errors_test.cljs index c622647f84..fd9cfe6450 100644 --- a/frontend/test/frontend_tests/main_errors_test.cljs +++ b/frontend/test/frontend_tests/main_errors_test.cljs @@ -191,6 +191,23 @@ ;; evaluates to a promise, so the body must settle one. (await (async/settle)))))) +(t/deftest ^:async generate-report-bounds-a-huge-exception-message + ;; A message can embed a whole payload (a serialized file) and reach + ;; megabytes. The report must keep a bounded head in both the context and + ;; the trace, so the audit event built from it can never bloat. + (await + (mock/with-mocks* + {st/format-last-events (mock/stub (fn [& _] "(stub last events)")) + rt/get-current-href (constantly "https://penpot.example.com/#/workspace")} + (let [huge (apply str (repeat 200000 "z")) + report (errors/generate-report (js/Error. huge))] + (t/is (string? report)) + (t/is (< (count report) 50000)) + (t/is (not (str/includes? report (subs huge 0 1500)))) + ;; Trailing settle: the body is synchronous, but `with-mocks*` + ;; evaluates to a promise, so the body must settle one. + (await (async/settle)))))) + (t/deftest ^:async connectivity-handlers-report-governed-compact-audit-events ;; Scenario: a network failure and an offline status through the global ;; handler. Each is reported as a governed compact audit event plus its diff --git a/frontend/test/frontend_tests/runner.cljs b/frontend/test/frontend_tests/runner.cljs index 8ab9b7ac6b..7db391183b 100644 --- a/frontend/test/frontend_tests/runner.cljs +++ b/frontend/test/frontend_tests/runner.cljs @@ -14,6 +14,7 @@ [frontend-tests.data.event-test] [frontend-tests.data.exports-assets-test] [frontend-tests.data.fix-deleted-fonts-test] + [frontend-tests.data.modal-test] [frontend-tests.data.nitrate-test] [frontend-tests.data.persistence-retry-test] [frontend-tests.data.persistence-test] @@ -157,6 +158,7 @@ 'frontend-tests.data.dashboard-test 'frontend-tests.data.event-test 'frontend-tests.data.fix-deleted-fonts-test + 'frontend-tests.data.modal-test 'frontend-tests.data.nitrate-test 'frontend-tests.data.persistence-retry-test 'frontend-tests.data.persistence-test From dacc65a37bfbb1f65ff996eda327dfab7ab41298 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Marina=20L=C3=B3pez?= Date: Thu, 15 Oct 2026 12:26:16 +0200 Subject: [PATCH 04/16] :sparkles: Show trial end date on subscription page (#12342) --- frontend/resources/images/icons/hourglass.svg | 6 ++++ .../main/ui/ds/foundations/assets/icon.cljs | 1 + frontend/src/app/main/ui/icons.cljs | 1 + .../app/main/ui/settings/subscription.cljs | 28 ++++++++++++++----- frontend/translations/en.po | 5 +++- frontend/translations/es.po | 5 +++- 6 files changed, 37 insertions(+), 9 deletions(-) create mode 100644 frontend/resources/images/icons/hourglass.svg diff --git a/frontend/resources/images/icons/hourglass.svg b/frontend/resources/images/icons/hourglass.svg new file mode 100644 index 0000000000..f20d4e15f1 --- /dev/null +++ b/frontend/resources/images/icons/hourglass.svg @@ -0,0 +1,6 @@ + + + + + + diff --git a/frontend/src/app/main/ui/ds/foundations/assets/icon.cljs b/frontend/src/app/main/ui/ds/foundations/assets/icon.cljs index da902d690e..991532c963 100644 --- a/frontend/src/app/main/ui/ds/foundations/assets/icon.cljs +++ b/frontend/src/app/main/ui/ds/foundations/assets/icon.cljs @@ -168,6 +168,7 @@ (def ^:icon-id help "help") (def ^:icon-id hide "hide") (def ^:icon-id history "history") +(def ^:icon-id hourglass "hourglass") (def ^:icon-id hsva "hsva") (def ^:icon-id hug-content "hug-content") (def ^:icon-id icon "icon") diff --git a/frontend/src/app/main/ui/icons.cljs b/frontend/src/app/main/ui/icons.cljs index 9e62720d02..7dec276e5d 100644 --- a/frontend/src/app/main/ui/icons.cljs +++ b/frontend/src/app/main/ui/icons.cljs @@ -150,6 +150,7 @@ (def ^:icon help (icon-xref :help)) (def ^:icon hide (icon-xref :hide)) (def ^:icon history (icon-xref :history)) +(def ^:icon hourglass (icon-xref :hourglass)) (def ^:icon hsva (icon-xref :hsva)) (def ^:icon hug-content (icon-xref :hug-content)) (def ^:icon icon (icon-xref :icon)) diff --git a/frontend/src/app/main/ui/settings/subscription.cljs b/frontend/src/app/main/ui/settings/subscription.cljs index b779fc2c70..1ac36461b0 100644 --- a/frontend/src/app/main/ui/settings/subscription.cljs +++ b/frontend/src/app/main/ui/settings/subscription.cljs @@ -469,7 +469,14 @@ (= subscription-type "enterprise") (tr "subscription.settings.enterprise")) subscription-is-trial? - (= (:status subscription) "trialing") + (if nitrate? + (= (:status nitrate-license) "trialing") + (= (:status subscription) "trialing")) + + trial-end-date + (if nitrate? + (ct/format-inst (:trial-end nitrate-license) "d MMMM, yyyy") + (ct/format-inst (:trial-end subscription) "d MMMM, yyyy")) member-since (ct/format-inst (:created-at profile) "d MMMM, yyyy") @@ -699,12 +706,19 @@ [:div {:class (stl/css :membership-container)} (when (or nitrate? (and subscribed-since (not= subscription-type "professional"))) - [:div {:class (stl/css :membership)} - [:> icon* {:class (stl/css :subscription-member) - :icon-id "crown" - :size "m"}] - [:span {:class (stl/css :membership-date)} - (tr "subscription.settings.subscribed-since" subscription-name subscribed-since)]]) + (if subscription-is-trial? + [:div {:class (stl/css :membership)} + [:> icon* {:class (stl/css :subscription-member) + :icon-id "hourglass" + :size "m"}] + [:span {:class (stl/css :membership-date)} + (tr "subscription.settings.trial-ends-on" trial-end-date)]] + [:div {:class (stl/css :membership)} + [:> icon* {:class (stl/css :subscription-member) + :icon-id "crown" + :size "m"}] + [:span {:class (stl/css :membership-date)} + (tr "subscription.settings.subscribed-since" subscription-name subscribed-since)]])) [:div {:class (stl/css :membership)} [:> icon* {:class (stl/css :penpot-member) diff --git a/frontend/translations/en.po b/frontend/translations/en.po index b9a3544478..68f7eb7cbf 100644 --- a/frontend/translations/en.po +++ b/frontend/translations/en.po @@ -5786,7 +5786,7 @@ msgstr "" #: src/app/main/ui/settings/subscription.cljs:714 msgid "subscription.settings.member-since" -msgstr "Penpot member since: %s" +msgstr "Penpot member since: %s." #: src/app/main/ui/settings/subscription.cljs:736, src/app/main/ui/settings/subscription.cljs:751, src/app/main/ui/settings/subscription.cljs:767, src/app/main/ui/settings/subscription.cljs:787 msgid "subscription.settings.more-information" @@ -5856,6 +5856,9 @@ msgstr "Subscribe" msgid "subscription.settings.subscribed-since" msgstr "You've been on the %s plan since %s." +msgid "subscription.settings.trial-ends-on" +msgstr "Your free trial ends on %s." + #: src/app/main/ui/settings/subscription.cljs:399 msgid "subscription.settings.success.dialog.description" msgstr "" diff --git a/frontend/translations/es.po b/frontend/translations/es.po index 9adb3cde53..794f34f57f 100644 --- a/frontend/translations/es.po +++ b/frontend/translations/es.po @@ -5848,7 +5848,7 @@ msgstr "" #: src/app/main/ui/settings/subscription.cljs:714 msgid "subscription.settings.member-since" -msgstr "Miembro de penpot desde: %s" +msgstr "Miembro de penpot desde: %s." #: src/app/main/ui/settings/subscription.cljs:736, src/app/main/ui/settings/subscription.cljs:751, src/app/main/ui/settings/subscription.cljs:767, src/app/main/ui/settings/subscription.cljs:787 msgid "subscription.settings.more-information" @@ -5920,6 +5920,9 @@ msgstr "Suscríbete" msgid "subscription.settings.subscribed-since" msgstr "Llevas en el plan %s desde %s." +msgid "subscription.settings.trial-ends-on" +msgstr "Tu prueba gratuita acaba el %s." + #: src/app/main/ui/settings/subscription.cljs:399 msgid "subscription.settings.success.dialog.description" msgstr "" From a53481c3b7cc37a02850097007e184affac170a6 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Thu, 15 Oct 2026 13:01:18 +0200 Subject: [PATCH 05/16] :sparkles: Enrich backend audit events with team and entity ids (#12233) * :sparkles: Enrich backend audit events with team and entity ids Backend audit events now carry the data a consumer needs to rebuild state without joining production tables: - prepare-rpc-event adds :team-id when the event carries a project or file id; commands that already loaded the team set it themselves. - add-profile-to-team! emits add-team-member on every real insert. - create-project and create-file emit the new row id. - clone-template, import-binfile and duplicate-project emit one event per created entity. - both binfile versions return {:file-ids [...]} from import-files!. Closes #12219 AI-assisted-by: deepseek-v4.1-flash * :sparkles: Emit delete and hard-delete audit events with entity data The event stream must let Nexus rebuild local state without joining production tables. This completes the enrichment with the delete paths: - delete-team keeps returning nil but now carries the deleted row (id, name, timestamps) in the audit props, like delete-project. - create-team adds created-at to its audit props. - delete-profile carries id, email, fullname and deleted-at; its props used to be empty because every param is namespaced. - objects-gc emits hard-delete-team/project/file per purged batch, with the deleted ids, only when the audit log is on. - delete-team-member needs no change: the delete is physical and the params already carry team-id and member-id. The nitrate push-audit-events tests now drop the membership events emitted by their own profile setup before counting. Closes #12219 AI-assisted-by: muse-spark-1.3-free * :sparkles: Announce cascade deletes and missing ids in audit events The :delete-object worker task marked teams, projects and files without leaving any event, so an event-sourced projection kept them alive for weeks. It now emits one cascade-deleted event per execution with every affected id, in the same transaction, only with :audit-log on. Rows purged by objects-gc and snapshot cascades stay silent on purpose. Also: create-team-with-invitations carries the new team id, and update-team-member-role names the demoted member on owner transfers. Closes #12219 AI-assisted-by: muse-spark-1.3-free * :bug: Identify the SREPL profile delete in audit events The SREPL delete-profile! emitted no profile-id and empty props, so the row could not be attributed by any consumer. It now carries the profile id in both fields. delete-team! named the wrong cause in its context. Closes #12219 AI-assisted-by: muse-spark-1.3-free * :bug: Identify the SREPL profile restore in audit events The SREPL restore-profile! emitted no profile-id, so the consumer keyed on the zero profile instead of the restored one. It now carries the profile id like a normal profile event, and no consumer special case is needed. Closes #12219 AI-assisted-by: muse-spark-1.3-free * :bug: Stop attributing SREPL events to the subject profile profile-id names the actor, and SREPL calls have none: setting the subject id blamed the user for an admin action and would have leaked those rows into PostHog as user activity. The subject id stays in props, where the consumer resolves it, and the event profile stays zero. Closes #12219 AI-assisted-by: muse-spark-1.3-free * :sparkles: Expose file analysis data for the nexus pipeline The nexus file-security pipeline needs file content and scheduling state from the backend. This adds a read-only management method, `get-file-for-analysis`, returning the semantic projection of one file (pages, frames, texts, links, interactions; ids as strings; capped with a truncated flag), plus identity, revn, timestamps and share state. No prior projection code existed, so the method ships its own pure `file->projection`. Audit events now carry what the `:local` consumer schedules from: revn and modified-at on update-file, name and timestamps on every create-file emitter, deleted-at on delete-file, and new create/delete-share-link events with file and link ids. AI-assisted-by: muse-spark-1.3-contributor * :recycle: Rename deletion audit events to action names Event names are actions, not past tense: `cascade-deleted` becomes `delete-object-with-cascade` with the same shape and transaction. The three `hard-delete-*` events merge into `hard-delete-objects`: one event per purged chunk carrying only that chunk's entity key (`:team-ids`, `:project-ids` or `:file-ids`), because each GC section purges in its own chunk transactions and a single event could never share them all. Every submit stays inside its delete transaction, `triggered-by` stays annotated, and silent paths stay silent. AI-assisted-by: muse-spark-1.3-contributor * :bug: Read worker parallelism knobs with plain config keys The runner wiring looked up `:app.main/worker-*-parallelism` (namespaced) while the schema and the environment provide plain keys, so `PENPOT_WORKER_DEFAULT_PARALLELISM` and `PENPOT_WORKER_WEBHOOK_PARALLELISM` never applied and workers always ran with the fallback. Read the keys the config holds. AI-assisted-by: muse-spark-1.3-contributor * :bug: Fix binfile audit test with a real file row `submit-file-created-event` reads the light columns back from the row, so the mocked importer must return an existing file id: a phantom id emits no event and the test saw zero `create-file` events. Create the file first and use its id. The audit-log memory now tells both bulk-event helpers apart. AI-assisted-by: muse-spark-1.3-contributor * :bug: Fix audit event fidelity from review findings The review of the audit enrichment found data-fidelity gaps; fix them while the branch is fresh. Membership events now belong to the actor: the flows where the owner adds somebody else pass an explicit actor id, the role is derived from the flags (the table has no role column), and the event carries the request context like its siblings. Also: team-id resolution skips read events, duplicate-project emits the project name and timestamps, delete-profile is idempotent again, the GC tests assert physical purge, and get-file-for-analysis leaves an audit trace. AI-assisted-by: muse-spark-1.3-contributor * :recycle: Nest cascade ids under :cascade in delete event The cascade event carried every affected id flat next to the object identity; nest them under `:cascade` so the payload reads as header plus affected set. The event is an action like its siblings, not a command. Drop the `:audit-log` flag re-check: `submit` already fans out per flag. AI-assisted-by: muse-spark-1.3-contributor * :paperclip: Update copyright name on file header The company name changed; a single header in this branch still carried the old one. Align it with the current form. AI-assisted-by: muse-spark-1.3-contributor * :bug: Fix nil event-id on webhook trigger audit rows process-event generated the row id inside append-audit-entry, so the :process-webhook-event task never received it and the trigger row stored a nil :event-id. Assign the id up-front and share it between the stored row and the worker params; the telemetry shadow row keeps its own id to avoid a PK collision. Add regression tests covering the handoff and the end-to-end trigger row. AI-assisted-by: muse-spark-1.3-contributor --- .serena/memories/audit-log.md | 21 +- backend/src/app/binfile/v1.clj | 4 +- backend/src/app/loggers/audit.clj | 205 +++++++--- backend/src/app/main.clj | 4 +- backend/src/app/rpc.clj | 3 +- backend/src/app/rpc/commands/binfile.clj | 12 +- backend/src/app/rpc/commands/comments.clj | 4 +- backend/src/app/rpc/commands/files.clj | 4 +- backend/src/app/rpc/commands/files_create.clj | 10 +- backend/src/app/rpc/commands/files_share.clj | 14 +- backend/src/app/rpc/commands/files_update.clj | 17 +- backend/src/app/rpc/commands/management.clj | 37 +- backend/src/app/rpc/commands/media.clj | 37 +- backend/src/app/rpc/commands/profile.clj | 9 +- backend/src/app/rpc/commands/projects.clj | 5 +- backend/src/app/rpc/commands/teams.clj | 67 +++- .../app/rpc/commands/teams_invitations.clj | 20 +- backend/src/app/rpc/commands/webhooks.clj | 8 +- backend/src/app/rpc/management/files.clj | 238 +++++++++++ backend/src/app/srepl/main.clj | 5 +- backend/src/app/tasks/delete_object.clj | 53 ++- backend/src/app/tasks/objects_gc.clj | 109 ++++-- .../test/backend_tests/binfile_svg_test.clj | 15 +- .../test/backend_tests/delete_object_test.clj | 107 +++++ backend/test/backend_tests/helpers.clj | 14 + .../backend_tests/loggers_webhooks_test.clj | 40 ++ .../test/backend_tests/objects_gc_test.clj | 121 +++++- backend/test/backend_tests/rpc_audit_test.clj | 150 ++++++- .../test/backend_tests/rpc_binfile_test.clj | 41 +- .../test/backend_tests/rpc_comment_test.clj | 29 ++ .../backend_tests/rpc_file_security_test.clj | 368 ++++++++++++++++++ backend/test/backend_tests/rpc_file_test.clj | 33 ++ .../rpc_management_nitrate_test.clj | 15 + .../backend_tests/rpc_management_test.clj | 56 ++- backend/test/backend_tests/rpc_media_test.clj | 24 ++ .../test/backend_tests/rpc_profile_test.clj | 27 ++ .../test/backend_tests/rpc_project_test.clj | 13 + backend/test/backend_tests/rpc_team_test.clj | 195 ++++++++++ .../test/backend_tests/rpc_webhooks_test.clj | 26 ++ .../test/backend_tests/srepl_main_test.clj | 57 ++- 40 files changed, 2024 insertions(+), 193 deletions(-) create mode 100644 backend/src/app/rpc/management/files.clj create mode 100644 backend/test/backend_tests/delete_object_test.clj create mode 100644 backend/test/backend_tests/rpc_file_security_test.clj diff --git a/.serena/memories/audit-log.md b/.serena/memories/audit-log.md index 223f370815..3739612214 100644 --- a/.serena/memories/audit-log.md +++ b/.serena/memories/audit-log.md @@ -118,6 +118,21 @@ Critical `profile-id` INVARIANT: the event belongs to **whoever made the request The `::audit/profile-id` override goes through `coerce-profile-id`: a string is parsed, anything that cannot become a uuid is dropped (with a warning) and the event falls back to the caller. Do not pass the value raw: `schema:event` needs a uuid and `submit*` swallows the validation error (it only logs, the RPC still succeeds), so a non-uuid override **loses the row silently**. Hand-built events with `event-from-rpc-params` + `submit` (clone template, accept team invitation, `management/nitrate` push-audit-events) do **not** go through that coercion: they must already carry a uuid. +### Team id and entity ids (projection data) + +The event stream is meant to let a consumer (Nexus) rebuild what it needs **without joining production tables**, so events carry the ids a projection keys on: + +- **Team id enrichment.** After `clean-props`, `prepare-rpc-event` calls `enrich-team-id`: when props have no `:team-id` but carry a `:project-id` or `:file-id`, it resolves the team with a local query and adds `:team-id`. It never resolves from `:id` (read commands put the entity id there, and that would add a query to every read), and it skips read events entirely (`get-*` names plus `has-file-libraries`: their events carry no consumer state). Commands that already loaded the team add `:team-id` themselves in `::audit/props` (`delete-file`, comments, media upload, `delete/update-webhook`, `clone-template`, ...), so the resolver does not run. +- **Membership.** `add-profile-to-team!` emits `add-team-member` (props `:team-id`, `:member-id`, `:role`, `:is-owner`, `:is-admin`, `:can-edit`) whenever it actually inserts a row, only with `:audit-log` on, inside the caller's transaction. It covers the flows that add a member with no event of their own (`create-team` owner, invitee added directly when `:email-verification` is off, approved join-request, duplicated team). With `on-conflict-do-nothing?` a conflict returns nil and emits nothing, so an existing membership is reported once. The event belongs to the actor: the two flows where the owner adds somebody else (`create-invitation`, `add-member-to-team`) pass `:actor-id` through a separate `event-opts` arg (never in `params`, which is inserted as-is); everywhere else actor and member coincide. `:role` is derived in the emitter from the flags (inverse of `permissions-for-role`: owner > admin > editor > viewer) because the table has no role column; request context travels in `event-opts` as `:rpc-params`. +- **Created entity ids.** `create-project` and `create-file` add the new row's `:id` (and `:project-id`/`:team-id`) to `::audit/props`, so a projection can key it. +- **Bulk operations.** `clone-template`, `import-binfile` and `duplicate-project` create entities through internal calls that emit nothing on their own; they emit a `create-file` (and `create-project`) per entity (only with `:audit-log`). The import paths go through `audit/submit-file-created-event`, which reads the light columns (`id`, `name`, `project-id`, timestamps, `revn`) back from the row — the file must really exist, a phantom id emits nothing. `duplicate-project` already holds the rows and uses `audit/submit-create-event` directly. Both binfile versions return the same shape from `import-files!` (`{:file-ids [...]}`). +- **Deletes.** `delete-team` still returns nil but carries the deleted row (`:id`, `:name`, `:created-at`, `:modified-at`, `:deleted-at`) in `::audit/props`, like `delete-project`. `delete-profile` carries `:id`, `:email`, `:fullname`, `:created-at`, `:modified-at` and `:deleted-at` (without this its props are empty: every param is namespaced and `clean-props` drops them). `create-team` adds `:created-at` and `:modified-at`. `delete-team-member` needs nothing: the delete is physical and the params already carry `:team-id`/`:member-id`. +- **Hard deletes.** `objects-gc` emits one `hard-delete-objects` event per purged chunk, carrying only that chunk's entity key (`:team-ids`, `:project-ids` or `:file-ids`; one chunk transaction purges a single entity, so one event can never span sections) with context `{:triggered-by "objects-gc"}`, only with `:audit-log` on. No other GC path emits (profiles, fonts, thumbnails); those purges stay silent. +- **SREPL deletes.** `delete-profile!` carries the subject id in props (it used to emit nothing usable); the event profile stays zero because SREPL has no actor. `delete-team!` props already carried the id. Both travel as actions with a `triggered-by: srepl` context. +- **SREPL restores.** `restore-profile!` carries the full row (with id) in props with a zero event profile; `restore-team!` and `restore-project!` already carried their ids. The consumer resolves the subject from props by a uniform rule, with no SREPL special case. +- **Cascades.** The `:delete-object` worker task emits one `delete-object-with-cascade` event per execution, type `action`, with `:object`/`:id`/`:deleted-at` plus the affected ids nested under `:cascade` (`:team-ids`, `:project-ids`, `:file-ids`), in the same transaction. The handler submits unconditionally (`submit` fans out per flag, so no `:audit-log` re-check); the `audit_log` row itself is still only written with `:audit-log` on. Direct calls (objects-gc) and snapshot cascades stay silent on purpose. +- **Ownership.** `create-team-with-invitations` carries the new team `:id` like `create-team`; `update-team-member-role` names the demoted member in `:prev-owner-id` on owner transfers. + Entry points: - `submit`: the normal one (fills defaults, validates, runs inside `tx-run!`, never breaks the RPC). @@ -223,6 +238,8 @@ Webhooks let an external URL get notified when something happens in a team (for One guarantee: sending webhooks never changes the audit event itself. If delivery fails, only the webhook (and its delivery log) is affected; the audit row stays untouched and still gets archived normally. +Every match also writes a `webhook` / `trigger` row to `audit_log` (even with zero matches): its props are `{:name , :event-id , :total-affected }`. `process-event` assigns the origin row id up-front so the trigger can reference it; the telemetry shadow row always gets its own id (reusing it would collide on the PK). + ## 10. Consumers II: error reporters Both `app.loggers.database` and `app.loggers.mattermost` listen to backend `:error` logs **and** frontend crash events (found by the `::audit/event` marker), through a sliding-buffer channel so a flood cannot stall the app. The database one stores them in `server-error-report` (source 3 = backend log, 4 = audit-log origin, 5 = rate-limit); the Mattermost one forwards a short note to `:error-report-webhook` when set. @@ -308,13 +325,15 @@ Config (`backend/src/app/config.clj`): `:audit-log-archive-uri`, `:telemetry-uri - **New backend command that must (or must not) emit**: `wrap-audit` does it alone; to exclude it set `::audit/skip`. To customize props/name/type use result metadata. Add a test mocking `app.loggers.audit/submit` (nil; `helpers.clj` stubs it globally) and assert `:call-args-list` — see `backend_tests/rpc-audit-test.clj` (full-row, telemetry-only, dual, no-op without flags, `insert`, `prepare-rpc-event`) and `rpc-team-test/accept-organization-invitation-audit-event` (three cases, exact props; counts matter: asserting with `first` passes even when a command emits the same name twice). - **New Penpot frontend event**: create the data-event or implement `Event`/`PerformanceEvent` in `app.main.data.event`, with `::name`/`::type`/`::origin`. Honor `skip-audit?` if the action can resume. Remember: with no props schema, **your asserts are the contract**. - **New admin-console event**: server action → add the backend-log call next to the mutation, best-effort so it never breaks the action; browser action → add a new event helper plus its test. +- **Command that creates an entity or already knows its team**: put the new row's `:id` in `::audit/props` (`create-project`/`create-file`) and set `:team-id` when the team is loaded, so the consumer never has to join production tables. For entities created inside an internal call (`clone-template`, `import-binfile`, `duplicate-project`), emit one event per entity: `audit/submit-file-created-event` when only the id is known (it reads the row back), `audit/submit-create-event` when the row is already in hand. - **Never** put secrets in `props`; `clean-props` is a last defense, not an excuse. - **Do not duplicate events**: if the backend already emits an event for an action, do not add a frontend (or admin-console browser) event for the same action — the backend one wins because it is reliable. A second event for the same action is only acceptable with a strong reason (for example the backend cannot see it at all), and then it must be clearly justified. - **Follow the naming policy**: use kebab-case names (`"create-organization"`, not `"createOrganization"`), and before inventing prop keys, look at similar existing events and reuse their key names (`organization-id`, `team-id`, `file-id`, `event-origin`...). Same concept, same key spelling — that is what keeps the data queryable later. ## 15. Code map -- Backend producer: `backend/src/app/loggers/audit.clj` (`submit`, `submit*`, `insert`, `prepare-rpc-event`, `event-from-rpc-params`, telemetry filters), `backend/src/app/rpc.clj` (`wrap-audit`), `backend/src/app/rpc/commands/audit.clj` (`push-audit-events`, `get-environment-data`, deprecated `get-enabled-flags`), `backend/src/app/rpc/management/nitrate.clj` (`push-audit-events` Nitrate→Penpot), `backend/src/app/http/middleware.clj` + `backend/src/app/http/management.clj` (shared-key auth). +- Backend producer: `backend/src/app/loggers/audit.clj` (`submit`, `submit*`, `insert`, `prepare-rpc-event`, `enrich-team-id`, `submit-create-event`, `event-from-rpc-params`, telemetry filters), `backend/src/app/rpc.clj` (`wrap-audit`), `backend/src/app/rpc/commands/audit.clj` (`push-audit-events`, `get-environment-data`, deprecated `get-enabled-flags`), `backend/src/app/rpc/management/nitrate.clj` (`push-audit-events` Nitrate→Penpot), `backend/src/app/http/middleware.clj` + `backend/src/app/http/management.clj` (shared-key auth). +- Membership emitter: `backend/src/app/rpc/commands/teams.clj` (`add-profile-to-team!` → `add-team-member`). - Penpot frontend producer: `frontend/src/app/main/data/event.cljs` (collector, buffer, send), `frontend/src/app/main/repo.cljs` + `frontend/src/app/util/http.cljs` (headers), `frontend/src/app/main/data/nitrate.cljs` (Nitrate membership events). - Admin-console producer (private repo, no paths cited here): server-side organization/subscription events through the management `push-audit-events`, browser-side UI events through the public `push-audit-events`. - Consumers: `backend/src/app/loggers/webhooks.clj`, `backend/src/app/loggers/database.clj`, `backend/src/app/loggers/mattermost.clj`, `backend/src/app/tasks/telemetry.clj`. diff --git a/backend/src/app/binfile/v1.clj b/backend/src/app/binfile/v1.clj index d7468eaa38..83423e771a 100644 --- a/backend/src/app/binfile/v1.clj +++ b/backend/src/app/binfile/v1.clj @@ -482,9 +482,9 @@ (bfm/apply-pending-migrations! cfg) ;; Knowing that the ids of the created files are in index, - ;; just lookup them and return it as a set + ;; just lookup them and return them in the same shape as v3. (let [files (-> bfc/*state* deref :files)] - (into #{} (keep #(get-in @bfc/*state* [:index %])) files)))))) + {:file-ids (into [] (keep #(get-in @bfc/*state* [:index %])) files)}))))) (defmethod read-import :v1 [options] diff --git a/backend/src/app/loggers/audit.clj b/backend/src/app/loggers/audit.clj index 085d402faf..a25e765ba5 100644 --- a/backend/src/app/loggers/audit.clj +++ b/backend/src/app/loggers/audit.clj @@ -234,7 +234,9 @@ (defn- append-audit-entry [cfg params] (let [params (-> params - (assoc :id (uuid/next)) + ;; Keep a pre-assigned id (process-event assigns one so + ;; the webhook task can reference the stored row). + (update :id #(or % (uuid/next))) (update :props db/tjson) (update :context db/tjson) (update :ip-addr db/inet)) @@ -253,62 +255,70 @@ (defn- process-event [cfg event] - (when (contains? cf/flags :audit-log-logger) - (l/log! ::l/logger "app.audit" - ::l/level :info - :profile-id (str (:profile-id event)) - :ip-addr (str (:ip-addr event)) - :type (:type event) - :name (:name event) - :props (json/encode (:props event) :key-fn json/write-camel-key) - :context (json/encode (:context event) :key-fn json/write-camel-key))) + ;; Assign the row id up-front so every sink below shares it: the + ;; stored row and the `:process-webhook-event` task params. The + ;; webhook trigger row links back to its origin event through props + ;; `:event-id`, which used to land nil because the id was generated + ;; inside `append-audit-entry` without reaching the worker params. + (let [event (assoc event :id (or (:id event) (uuid/next)))] + (when (contains? cf/flags :audit-log-logger) + (l/log! ::l/logger "app.audit" + ::l/level :info + :profile-id (str (:profile-id event)) + :ip-addr (str (:ip-addr event)) + :type (:type event) + :name (:name event) + :props (json/encode (:props event) :key-fn json/write-camel-key) + :context (json/encode (:context event) :key-fn json/write-camel-key))) - (when (contains? cf/flags :audit-log) - (append-audit-entry cfg event)) + (when (contains? cf/flags :audit-log) + (append-audit-entry cfg event)) - (when (contains? cf/flags :telemetry) - ;; NOTE: when both audit-log and telemetry are enabled, events are stored - ;; twice: once with full details (above) and once stripped of props and - ;; ip-addr, tagged with source="telemetry" so the telemetry task can - ;; collect and ship them. The profile-id is preserved (UUIDs are already - ;; anonymous random identifiers). Only a safe subset of context fields - ;; is kept: initiator, version, client-version and client-user-agent. - ;; Timestamps are truncated to day precision to avoid leaking exact event - ;; timing. - (let [event (-> event - (filter-telemetry-props) - (filter-telemetry-context) - (update :created-at ct/truncate :days) - (update :tracked-at ct/truncate :days) - (assoc :source "telemetry:backend") - (assoc :ip-addr "0.0.0.0"))] - (append-audit-entry cfg event))) + (when (contains? cf/flags :telemetry) + ;; NOTE: when both audit-log and telemetry are enabled, events are stored + ;; twice: once with full details (above) and once stripped of props and + ;; ip-addr, tagged with source="telemetry" so the telemetry task can + ;; collect and ship them. The profile-id is preserved (UUIDs are already + ;; anonymous random identifiers). Only a safe subset of context fields + ;; is kept: initiator, version, client-version and client-user-agent. + ;; Timestamps are truncated to day precision to avoid leaking exact event + ;; timing. The shadow row gets its own id: reusing the full row id + ;; would collide on the primary key. + (let [event (-> event + (assoc :id (uuid/next)) + (filter-telemetry-props) + (filter-telemetry-context) + (update :created-at ct/truncate :days) + (update :tracked-at ct/truncate :days) + (assoc :source "telemetry:backend") + (assoc :ip-addr "0.0.0.0"))] + (append-audit-entry cfg event))) - (when (and (contains? cf/flags :webhooks) - (::webhooks/event? event)) - (let [batch-key (::webhooks/batch-key event) - batch-timeout (::webhooks/batch-timeout event) - label (dm/str "rpc:" (:name event)) - label (cond - (ifn? batch-key) (dm/str label ":" (batch-key (::rpc/params event))) - (string? batch-key) (dm/str label ":" batch-key) - :else label) - dedupe? (boolean (and batch-key batch-timeout))] + (when (and (contains? cf/flags :webhooks) + (::webhooks/event? event)) + (let [batch-key (::webhooks/batch-key event) + batch-timeout (::webhooks/batch-timeout event) + label (dm/str "rpc:" (:name event)) + label (cond + (ifn? batch-key) (dm/str label ":" (batch-key (::rpc/params event))) + (string? batch-key) (dm/str label ":" batch-key) + :else label) + dedupe? (boolean (and batch-key batch-timeout))] - (wrk/submit! (-> cfg - (assoc ::wrk/task :process-webhook-event) - (assoc ::wrk/queue :webhooks) - (assoc ::wrk/max-retries 0) - (assoc ::wrk/delay (or batch-timeout 0)) - (assoc ::wrk/dedupe dedupe?) - (assoc ::wrk/label label) - (assoc ::wrk/params (-> event - (d/without-qualified) - (dissoc :source) - (dissoc :context) - (dissoc :ip-addr) - (dissoc :type))))))) - event) + (wrk/submit! (-> cfg + (assoc ::wrk/task :process-webhook-event) + (assoc ::wrk/queue :webhooks) + (assoc ::wrk/max-retries 0) + (assoc ::wrk/delay (or batch-timeout 0)) + (assoc ::wrk/dedupe dedupe?) + (assoc ::wrk/label label) + (assoc ::wrk/params (-> event + (d/without-qualified) + (dissoc :source) + (dissoc :context) + (dissoc :ip-addr) + (dissoc :type))))))) + event)) (defn submit* "A public API, lower-level than submit, assumes all required fields are filled" @@ -396,6 +406,47 @@ coerced)) +(def ^:private sql:team-id-by-project + "SELECT id FROM team + WHERE id = (SELECT team_id FROM project WHERE id = ?)") + +(def ^:private sql:team-id-by-file + "SELECT t.id FROM team AS t + JOIN project AS p ON (p.team_id = t.id) + JOIN file AS f ON (f.project_id = p.id) + WHERE f.id = ?") + +(def ^:private read-event-names + "Read commands excluded from team-id resolution on top of the `get-*` + prefix: their events carry no consumer state, so the lookup would only + tax the read path." + #{"has-file-libraries"}) + +(defn- read-event? + [event-name] + (or (str/starts-with? event-name "get-") + (contains? read-event-names event-name))) + +(defn- enrich-team-id + "Adds the team id to the event props when it is missing and can be resolved + locally, so consumers do not have to join production tables. Only events that + already carry a project or file id are considered: read commands put the + entity id under `:id`, and resolving those would add a query to every read." + [cfg event-name props] + (if (or (:team-id props) + (read-event? event-name) + (and (nil? (:project-id props)) + (nil? (:file-id props)))) + props + (let [project-id (:project-id props) + file-id (:file-id props) + team-id (or (when (some? project-id) + (:id (db/exec-one! cfg [sql:team-id-by-project project-id]))) + (when (some? file-id) + (:id (db/exec-one! cfg [sql:team-id-by-file file-id]))))] + (cond-> props + (some? team-id) (assoc :team-id team-id))))) + (defn prepare-rpc-event [cfg mdata params result] (let [resultm (meta result) @@ -410,25 +461,32 @@ (::rpc/profile-id params) uuid/zero) + module (get cfg ::rpc/module) + event-name (or (::name resultm) + (let [sname (::sv/name mdata)] + (if (not= module "main") + (str module "-" sname) + sname))) + props (-> (or (::replace-props resultm) (merge params (::props resultm))) (clean-props)) + ;; Resolve the team locally when the event carries a project or file + ;; id, so the consumers do not need to join production tables. + ;; Reads are excluded: their events carry no consumer state. + props (enrich-team-id cfg event-name props) + context (-> (::context resultm) (merge (prepare-context-from-request request)) (assoc :request-id (::rpc/request-id params)) (d/without-nils)) - ip-addr (inet/parse-request request) - module (get cfg ::rpc/module)] + ip-addr (inet/parse-request request)] {:type (or (::type resultm) (::rpc/type cfg)) - :name (or (::name resultm) - (let [sname (::sv/name mdata)] - (if (not= module "main") - (str module "-" sname) - sname))) + :name event-name :profile-id profile-id :ip-addr ip-addr @@ -485,6 +543,33 @@ (d/without-nils))] (submit* cfg event))) +(defn submit-create-event + "Emits a `create-*` audit event for an entity created as a side effect of a + bulk operation (import, duplicate, clone). Those entities get no event from + their own command, so a local projection cannot key them otherwise. The + event is built by hand and does not pass through `prepare-rpc-event`, so its + props are passed as-is minus nils." + [cfg params event-name props] + (when (contains? cf/flags :audit-log) + (submit cfg + (-> (event-from-rpc-params params) + (assoc :name event-name) + (assoc :props (d/without-nils props)))))) + +(def ^:private sql:get-file-event-columns + "SELECT id, name, project_id, created_at, modified_at, revn + FROM file WHERE id = ?;") + +(defn submit-file-created-event + "Emit a `create-file` event for a file born inside a bulk operation, + with the same prop shape as the `create-file` command event. Only + the file id is needed: the light columns are read back (no data + blob), so projections that key on name, revn or timestamps work. + `extra` carries what the row lacks (the team id)." + [cfg params file-id extra] + (when-let [row (db/exec-one! cfg [sql:get-file-event-columns file-id])] + (submit-create-event cfg params "create-file" (merge row extra)))) + (defn insert "Submit audit event to the collector, intended to be used only from command line helpers because this skips all webhooks and telemetry diff --git a/backend/src/app/main.clj b/backend/src/app/main.clj index d1cff7f2ab..c8898f90e6 100644 --- a/backend/src/app/main.clj +++ b/backend/src/app/main.clj @@ -665,7 +665,7 @@ ::wrk/tenant (cf/get :tenant)} [::default ::wrk/runner] - {::wrk/parallelism (cf/get ::worker-default-parallelism 1) + {::wrk/parallelism (cf/get :worker-default-parallelism 1) ::wrk/queue :default ::wrk/tenant (cf/get :tenant) ::rds/client (ig/ref ::rds/client) @@ -674,7 +674,7 @@ ::db/pool (ig/ref ::db/pool)} [::webhook ::wrk/runner] - {::wrk/parallelism (cf/get ::worker-webhook-parallelism 1) + {::wrk/parallelism (cf/get :worker-webhook-parallelism 1) ::wrk/queue :webhooks ::wrk/tenant (cf/get :tenant) ::rds/client (ig/ref ::rds/client) diff --git a/backend/src/app/rpc.clj b/backend/src/app/rpc.clj index a558315376..e28485181f 100644 --- a/backend/src/app/rpc.clj +++ b/backend/src/app/rpc.clj @@ -426,7 +426,8 @@ (defn- resolve-management-methods [cfg] (let [cfg (assoc cfg ::module "management" ::type "command" ::metrics-id :rpc-management-timing) - mods (cond->> (list 'app.rpc.management.exporter) + mods (cond->> (list 'app.rpc.management.exporter + 'app.rpc.management.files) (contains? cf/flags :admin-console) (cons 'app.rpc.management.nitrate))] diff --git a/backend/src/app/rpc/commands/binfile.clj b/backend/src/app/rpc/commands/binfile.clj index de0d3faadd..c4fc37cb99 100644 --- a/backend/src/app/rpc/commands/binfile.clj +++ b/backend/src/app/rpc/commands/binfile.clj @@ -17,7 +17,7 @@ [app.config :as cf] [app.db :as db] [app.http.sse :as sse] - [app.loggers.audit :as-alias audit] + [app.loggers.audit :as audit] [app.loggers.webhooks :as-alias webhooks] [app.media.validation :as media.v] [app.rpc :as-alias rpc] @@ -91,7 +91,7 @@ ;; --- Command: import-binfile (defn- import-binfile - [{:keys [::db/pool] :as cfg} {:keys [profile-id project-id version name file upload-id]}] + [{:keys [::db/pool] :as cfg} {:keys [profile-id project-id version name file upload-id] :as params}] (let [team (teams/get-team pool :profile-id profile-id @@ -133,6 +133,14 @@ {:id project-id} {::db/return-keys false}) + ;; The imported files get no event from their own command, so emit one per + ;; file inside a single transaction. + (db/tx-run! cfg + (fn [cfg] + (doseq [file-id (:file-ids result)] + (audit/submit-file-created-event cfg params file-id + {:team-id (:id team)})))) + result)) (def ^:private schema:import-binfile diff --git a/backend/src/app/rpc/commands/comments.clj b/backend/src/app/rpc/commands/comments.clj index 9de796a72e..8ca0a165bc 100644 --- a/backend/src/app/rpc/commands/comments.clj +++ b/backend/src/app/rpc/commands/comments.clj @@ -486,7 +486,7 @@ (let [params (assoc params ::file file) thread (db/tx-run! cfg create-comment-thread params)] - (vary-meta thread assoc ::audit/props thread)))) + (vary-meta thread assoc ::audit/props (assoc thread :team-id team-id))))) (defn- create-comment-thread [{:keys [::db/conn] :as cfg} @@ -650,7 +650,7 @@ (send-comment-emails! conn profile comment thread file) - (vary-meta comment assoc ::audit/props comment)))) + (vary-meta comment assoc ::audit/props (assoc comment :team-id team-id))))) ;; --- COMMAND: Update Comment diff --git a/backend/src/app/rpc/commands/files.clj b/backend/src/app/rpc/commands/files.clj index fd313f6170..1679e76204 100644 --- a/backend/src/app/rpc/commands/files.clj +++ b/backend/src/app/rpc/commands/files.clj @@ -1098,7 +1098,9 @@ {::audit/props {:project-id (:project-id file) :name (:name file) :created-at (:created-at file) - :modified-at (:modified-at file)}}))) + :modified-at (:modified-at file) + :deleted-at (:deleted-at file) + :team-id (:id team)}}))) (sv/defmethod ::delete-file {::doc/added "1.17" diff --git a/backend/src/app/rpc/commands/files_create.clj b/backend/src/app/rpc/commands/files_create.clj index d1b14283a5..23959989af 100644 --- a/backend/src/app/rpc/commands/files_create.clj +++ b/backend/src/app/rpc/commands/files_create.clj @@ -137,5 +137,11 @@ {:id team-id} {::db/return-keys false})))) - (-> (create-file cfg params) - (vary-meta assoc ::audit/props {:team-id team-id})))) + (let [file (create-file cfg params)] + (vary-meta file assoc ::audit/props {:id (:id file) + :project-id project-id + :team-id team-id + :name (:name file) + :created-at (:created-at file) + :modified-at (:modified-at file) + :revn (:revn file)})))) diff --git a/backend/src/app/rpc/commands/files_share.clj b/backend/src/app/rpc/commands/files_share.clj index 6643554a06..66bb1447ad 100644 --- a/backend/src/app/rpc/commands/files_share.clj +++ b/backend/src/app/rpc/commands/files_share.clj @@ -12,9 +12,11 @@ [app.common.schema :as sm] [app.common.uuid :as uuid] [app.db :as db] + [app.loggers.audit :as-alias audit] [app.rpc :as-alias rpc] [app.rpc.commands.files :as files] [app.rpc.doc :as-alias doc] + [app.rpc.helpers :as rph] [app.util.services :as sv])) ;; --- MUTATION: Create Share Link @@ -39,7 +41,11 @@ ::db/transaction true} [{:keys [::db/conn]} {:keys [::rpc/profile-id file-id] :as params}] (files/check-edition-permissions! conn profile-id file-id) - (create-share-link conn (assoc params :profile-id profile-id))) + (let [slink (create-share-link conn (assoc params :profile-id profile-id))] + ;; The consumers key share scope by file, so the event carries + ;; both ids; `:file-id` is already in params, `:share-id` is new. + (rph/with-meta slink + {::audit/props {:share-id (:id slink)}}))) (defn create-share-link [conn {:keys [profile-id file-id pages who-comment who-inspect]}] @@ -80,4 +86,8 @@ :hint "You can only delete share-links you created"))) (db/delete! conn :share-link {:id id}) - nil)) + ;; The delete params carry only the link id, so resolve the file + ;; from the row fetched above before it is gone. + (rph/with-meta (rph/wrap) + {::audit/props {:file-id (:file-id slink) + :share-id id}}))) diff --git a/backend/src/app/rpc/commands/files_update.clj b/backend/src/app/rpc/commands/files_update.clj index 9d996c6dd4..373a06717f 100644 --- a/backend/src/app/rpc/commands/files_update.clj +++ b/backend/src/app/rpc/commands/files_update.clj @@ -283,11 +283,18 @@ (with-meta {:revn revn :lagged (get-lagged-changes conn params)} {::audit/replace-props - {:id (:id file) - :name (:name file) - :features (:features file) - :project-id (:project-id file) - :team-id (:team-id file)}})))) + {:id (:id file) + :name (:name file) + :features (:features file) + :project-id (:project-id file) + :team-id (:team-id file) + ;; NOTE: `file` carries the post-update revn here (`revn` + ;; above is the pre-update one kept for the response), and + ;; `modified-at` mirrors `persist-file!`: same `::timestamp` + ;; fallback, so both agree to the millisecond when the + ;; request timestamp exists. + :revn (:revn file) + :modified-at (or timestamp (ct/now))}})))) (defn get-file "Get not-decoded file, only decodes the features set." diff --git a/backend/src/app/rpc/commands/management.clj b/backend/src/app/rpc/commands/management.clj index 62d5a88330..b0ac390b57 100644 --- a/backend/src/app/rpc/commands/management.clj +++ b/backend/src/app/rpc/commands/management.clj @@ -142,12 +142,29 @@ (when (uuid? profile-id) (teams/create-project-role conn profile-id (:id project) :owner)) + ;; The new entities are created by internal calls, so they carry no + ;; event of their own; emit one per entity for a local projection. + (audit/submit-create-event cfg params "create-project" + {:id (:id project) + :team-id (:team-id project) + :name (:name project) + :created-at (:created-at project) + :modified-at (:modified-at project)}) + (doseq [file-id files] (let [params (-> params (dissoc :name) (assoc :file-id file-id) - (assoc :reset-shared-flag false))] - (duplicate-file cfg params))) + (assoc :reset-shared-flag false)) + file (duplicate-file cfg params)] + (audit/submit-create-event cfg params "create-file" + {:id (:id file) + :project-id (:project-id file) + :team-id (:team-id project) + :name (:name file) + :created-at (:created-at file) + :modified-at (:modified-at file) + :revn (:revn file)}))) project)))) @@ -211,7 +228,7 @@ (update :team-id bfc/lookup-index) (assoc :created-at timestamp) (assoc :modified-at timestamp))] - (teams/add-profile-to-team! cfg params {::db/return-keys false}))) + (teams/add-profile-to-team! cfg params))) ;; Duplicate team fonts (doseq [font fonts] @@ -444,14 +461,12 @@ {:id project-id} {::db/return-keys false}) - (let [props (audit/clean-props params)] - (doseq [file-id result] - (let [props (assoc props :id file-id) - event (-> (audit/event-from-rpc-params params) - (assoc :profile-id profile-id) - (assoc :name "create-file") - (assoc :props props))] - (audit/submit cfg event)))))) + (doseq [file-id (:file-ids result)] + (audit/submit-file-created-event + cfg + (assoc params :profile-id profile-id) + file-id + {:team-id (:id team)})))) result)) diff --git a/backend/src/app/rpc/commands/media.clj b/backend/src/app/rpc/commands/media.clj index e914ff3302..1c9e07ed01 100644 --- a/backend/src/app/rpc/commands/media.clj +++ b/backend/src/app/rpc/commands/media.clj @@ -68,27 +68,28 @@ (quotes/check! cfg {::quotes/id ::quotes/media-storage-bytes-per-team ::quotes/profile-id profile-id ::quotes/team-id team-id - ::quotes/incr (:size content)})) + ::quotes/incr (:size content)}) - (db/run! cfg (fn [{:keys [::db/conn] :as cfg}] - ;; We get the minimal file for proper checking if - ;; file is not already deleted - (let [_ (files/get-minimal-file conn file-id) - mobj (create-file-media-object cfg params)] + (db/run! cfg (fn [{:keys [::db/conn] :as cfg}] + ;; We get the minimal file for proper checking if + ;; file is not already deleted + (let [_ (files/get-minimal-file conn file-id) + mobj (create-file-media-object cfg params)] - (db/update! conn :file - {:modified-at (ct/now) - :has-media-trimmed false} - {:id file-id} - {::db/return-keys false}) + (db/update! conn :file + {:modified-at (ct/now) + :has-media-trimmed false} + {:id file-id} + {::db/return-keys false}) - (with-meta mobj - {::audit/replace-props - {:name (:name params) - :file-id file-id - :is-local (:is-local params) - :size (:size content) - :mtype (:mtype content)}}))))) + (with-meta mobj + {::audit/replace-props + {:name (:name params) + :file-id file-id + :team-id team-id + :is-local (:is-local params) + :size (:size content) + :mtype (:mtype content)}})))))) (defn- big-enough-for-thumbnail? "Checks if the provided image info is big enough for diff --git a/backend/src/app/rpc/commands/profile.clj b/backend/src/app/rpc/commands/profile.clj index 686884aeed..82d307bb46 100644 --- a/backend/src/app/rpc/commands/profile.clj +++ b/backend/src/app/rpc/commands/profile.clj @@ -540,7 +540,8 @@ {::doc/added "1.0" ::db/transaction true} [{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id] :as params}] - (let [teams (get-owned-teams conn profile-id) + (let [profile (db/get* conn :profile {:id profile-id} {::db/remove-deleted false}) + teams (get-owned-teams conn profile-id) deleted-at (ct/now)] ;; If we found owned teams with participants, we don't allow @@ -581,6 +582,12 @@ (session/invalidate-all cfg profile-id) (-> (rph/wrap nil) + (rph/with-meta {::audit/props {:id (:id profile) + :email (:email profile) + :fullname (:fullname profile) + :created-at (:created-at profile) + :modified-at (:modified-at profile) + :deleted-at deleted-at}}) (rph/with-transform (session/delete-fn cfg))))) (def sql:get-subscription-editors diff --git a/backend/src/app/rpc/commands/projects.clj b/backend/src/app/rpc/commands/projects.clj index 157b44310a..5c809cfd96 100644 --- a/backend/src/app/rpc/commands/projects.clj +++ b/backend/src/app/rpc/commands/projects.clj @@ -222,8 +222,9 @@ ::quotes/profile-id profile-id ::quotes/team-id team-id}) - (let [params (assoc params :profile-id profile-id)] - (db/tx-run! cfg create-project params))) + (let [params (assoc params :profile-id profile-id) + project (db/tx-run! cfg create-project params)] + (rph/with-meta project {::audit/props {:id (:id project)}}))) ;; --- MUTATION: Toggle Project Pin diff --git a/backend/src/app/rpc/commands/teams.clj b/backend/src/app/rpc/commands/teams.clj index a878018511..0cfb0f2baf 100644 --- a/backend/src/app/rpc/commands/teams.clj +++ b/backend/src/app/rpc/commands/teams.clj @@ -28,6 +28,7 @@ [app.rpc :as-alias rpc] [app.rpc.commands.profile :as profile] [app.rpc.doc :as-alias doc] + [app.rpc.helpers :as rph] [app.rpc.permissions :as perms] [app.rpc.quotes :as quotes] [app.setup :as-alias setup] @@ -563,7 +564,9 @@ team (db/tx-run! cfg create-team params)] (with-meta team - {::audit/props {:id (:id team)}}))) + {::audit/props {:id (:id team) + :created-at (:created-at team) + :modified-at (:modified-at team)}}))) (defn create-default-organization-team @@ -618,10 +621,42 @@ :default-team-id default-team-id})) default-team-id)))))))) +(defn- params->role + "Derive the team role from membership flags, inverse of + `types.team/permissions-for-role`. `team_profile_rel` carries no role + column, so no caller can pass it in `params`: derive it here so the event + always carries one." + [{:keys [is-owner is-admin can-edit]}] + (cond is-owner :owner is-admin :admin can-edit :editor :else :viewer)) + +(defn- submit-membership-event + "Emits an audit event for a new team membership, so the event stream carries + every membership add, including the ones that only happen as a side effect of + another command (team creation, invitation accepted without email roundtrip, + duplicated team). `event-opts` carries what the row lacks: `:actor-id` (the + action owner, defaulting to the member) and `:rpc-params` (request context, + which sibling events get from `prepare-rpc-event`)." + [cfg {:keys [profile-id team-id] :as params} {:keys [actor-id rpc-params]}] + (when (contains? cf/flags :audit-log) + (audit/submit cfg + (-> (audit/event-from-rpc-params (or rpc-params {})) + (assoc :name "add-team-member" + :type "action" + :profile-id (or actor-id profile-id)) + (assoc :props (d/without-nils + {:team-id team-id + :member-id profile-id + :role (params->role params) + :is-owner (boolean (:is-owner params)) + :is-admin (boolean (:is-admin params)) + :can-edit (boolean (:can-edit params))})))))) + (defn add-profile-to-team! ([cfg params] - (add-profile-to-team! cfg params nil)) - ([{:keys [::db/conn] :as cfg} {:keys [:profile-id :team-id] :as params} options] + (add-profile-to-team! cfg params nil nil)) + ([cfg params options] + (add-profile-to-team! cfg params options nil)) + ([{:keys [::db/conn] :as cfg} {:keys [:profile-id :team-id] :as params} options event-opts] (assert (db/connection-map? cfg) "expected cfg with valid connection") (when (contains? cf/flags :admin-console) @@ -631,7 +666,13 @@ (some? (:organization-id membership)) ;; the team do belong to an organization (not (:is-member membership))) ;; the user is not a member of the organization yet (initialize-user-in-organization cfg profile-id (:organization-id membership))))) - (db/insert! conn :team-profile-rel (assoc params :id (uuid/next)) options))) + (let [options (merge options {::db/return-keys [:id]}) + result (db/insert! conn :team-profile-rel (assoc params :id (uuid/next)) options)] + ;; Only emit when a row was actually inserted: with `on-conflict-do-nothing` + ;; an existing membership returns nil and must not be reported twice. + (when (some? result) + (submit-membership-event cfg params event-opts)) + result))) (defn create-team "This is a complete team creation process, it creates the team @@ -894,8 +935,14 @@ ::sm/params schema:delete-team ::db/transaction true} [cfg {:keys [::rpc/profile-id id] :as params}] - (delete-team cfg {:team-id id :profile-id profile-id}) - nil) + (let [team (delete-team cfg {:team-id id :profile-id profile-id})] + ;; The client keeps receiving nil; the audit event carries the deleted row. + (rph/with-meta (rph/wrap) + {::audit/props {:id (:id team) + :name (:name team) + :created-at (:created-at team) + :modified-at (:modified-at team) + :deleted-at (:deleted-at team)}}))) ;; --- Mutation: Team Update Role @@ -962,7 +1009,13 @@ {::doc/added "1.17" ::sm/params schema:update-team-member-role} [cfg {:keys [::rpc/profile-id] :as params}] - (db/tx-run! cfg update-team-member-role (assoc params :profile-id profile-id))) + (db/tx-run! cfg update-team-member-role (assoc params :profile-id profile-id)) + ;; The client keeps receiving nil; when ownership moves, the audit event + ;; names the demoted member so a projection can keep a single owner. + (rph/with-meta (rph/wrap) + (if (= :owner (:role params)) + {::audit/props {:prev-owner-id profile-id}} + {}))) ;; --- Mutation: Delete Team Member diff --git a/backend/src/app/rpc/commands/teams_invitations.clj b/backend/src/app/rpc/commands/teams_invitations.clj index fe8abd5b24..66ac06493d 100644 --- a/backend/src/app/rpc/commands/teams_invitations.clj +++ b/backend/src/app/rpc/commands/teams_invitations.clj @@ -202,7 +202,10 @@ (when (contains? cf/flags :admin-console) (teams/initialize-user-in-organization cfg (:id member) (:id organization) email)) ;; Insert the invited member to the team - (teams/add-profile-to-team! cfg params {::db/on-conflict-do-nothing? true})) + (teams/add-profile-to-team! cfg params + {::db/on-conflict-do-nothing? true} + {:actor-id (:id profile) + :rpc-params params})) ;; If profile is not yet verified, mark it as verified because ;; accepting an invitation link serves as verification. @@ -318,7 +321,7 @@ :role :editor)))) (defn- add-member-to-team - [{:keys [::db/conn] :as cfg} profile team role member] + [{:keys [::db/conn] :as cfg} profile team role member event-opts] (assert (db/connection-map? cfg) "expected cfg with valid connection") @@ -340,7 +343,9 @@ ::quotes/team-id team-id}) ;; Insert the member to the team - (teams/add-profile-to-team! cfg params {::db/on-conflict-do-nothing? true}) + (teams/add-profile-to-team! cfg params + {::db/on-conflict-do-nothing? true} + event-opts) ;; Delete any request (db/delete! conn :team-access-request @@ -438,7 +443,9 @@ (filter #(contains? invitation-emails (key %))) (map (fn [[email member]] (let [role (:role (first (filter #(= (:email %) email) invitation-data)))] - (add-member-to-team cfg profile team role member)))) + (add-member-to-team cfg profile team role member + {:actor-id (:id profile) + :rpc-params params})))) (doall)) invitations)) @@ -593,7 +600,7 @@ :hint "the maximum of invitation on single request is reached" :threshold max-invitations-by-request-threshold)) - (let [props {:name name :features features} + (let [props {:id (:id team) :name name :features features} event (-> (audit/event-from-rpc-params params) (assoc :name "create-team") (assoc :props props))] @@ -609,7 +616,8 @@ (map (fn [email] (assoc params :email email))) (map (partial create-invitation cfg)))] - (vary-meta team assoc ::audit/props {:invitations (count invitations)})))) + (vary-meta team assoc ::audit/props {:id (:id team) + :invitations (count invitations)})))) ;; --- Query: get-team-invitation-token diff --git a/backend/src/app/rpc/commands/webhooks.clj b/backend/src/app/rpc/commands/webhooks.clj index 2476128e7c..f22a693fd2 100644 --- a/backend/src/app/rpc/commands/webhooks.clj +++ b/backend/src/app/rpc/commands/webhooks.clj @@ -14,10 +14,12 @@ [app.common.uuid :as uuid] [app.db :as db] [app.http.client :as http] + [app.loggers.audit :as-alias audit] [app.loggers.webhooks :as webhooks] [app.rpc :as-alias rpc] [app.rpc.commands.teams :refer [check-read-permissions!] :as t] [app.rpc.doc :as-alias doc] + [app.rpc.helpers :as rph] [app.rpc.permissions :as perms] [app.util.services :as sv] [cuerdas.core :as str])) @@ -137,7 +139,8 @@ (let [whook (-> (db/get pool :webhook {:id id}) (decode-row))] (check-webhook-edition-permissions! pool profile-id (:team-id whook)) (validate-webhook! cfg whook params) - (update-webhook! cfg whook params))) + (rph/with-meta (update-webhook! cfg whook params) + {::audit/props {:team-id (:team-id whook)}}))) (def ^:private schema:delete-webhook [:map {:title "delete-webhook"} @@ -151,7 +154,8 @@ (let [whook (-> (db/get conn :webhook {:id id}) decode-row)] (check-webhook-edition-permissions! conn profile-id (:team-id whook)) (db/delete! conn :webhook {:id id}) - nil)) + (rph/with-meta (rph/wrap) + {::audit/props {:team-id (:team-id whook)}}))) ;; --- Query: Webhooks diff --git a/backend/src/app/rpc/management/files.clj b/backend/src/app/rpc/management/files.clj new file mode 100644 index 0000000000..d947ec7549 --- /dev/null +++ b/backend/src/app/rpc/management/files.clj @@ -0,0 +1,238 @@ +;; 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.rpc.management.files + "Read-only file content for the nexus file-security pipeline. + + The single method `get-file-for-analysis` returns the semantic + projection of one file (pages, frames, text, links, interactions): + small, neutral data the decision model consumes. Full file binaries + never cross this boundary. Every call leaves an audit event like any + other management call, so content reads stay traceable; the volume + scales with analyzed files, and the nexus consumer ignores the event." + (:require + [app.binfile.common :as bfc] + [app.common.data :as d] + [app.common.exceptions :as ex] + [app.common.schema :as sm] + [app.common.time :as ct] + [app.common.types.text :as txt] + [app.db :as db] + [app.rpc :as-alias rpc] + [app.rpc.doc :as doc] + [app.util.services :as sv] + [cuerdas.core :as str])) + +(def projection-version 1) + +;; Bounds for the data that crosses to nexus on every sweep. The +;; projection stays small by construction; anything past the caps sets +;; `:truncated?` instead of growing the payload. +(def ^:const max-text-chars 30000) +(def ^:const max-links 1000) +(def ^:const max-interactions 2000) + +(defn- page-shapes + "All shapes of one page with their page id attached." + [{:keys [id objects]}] + (let [page-id (str id)] + (->> (vals objects) + (filter map?) + (map #(assoc % :page-id page-id))))) + +(defn- shape-text + "Plain text of a text shape, or nil when it has none. Never throws: + corrupt content skips the shape instead of failing the file." + [shape] + (when (and (= :text (:type shape)) + (some? (:content shape))) + (let [text (ex/ignoring (txt/content->text (:content shape)))] + (when-not (str/blank? text) + text)))) + +(defn- open-url? + [{:keys [action-type url]}] + (and (= :open-url action-type) + (not (str/blank? url)))) + +(defn file->projection + "Turn decoded file data into the neutral projection the decision + model consumes. Pure: takes the `:data` map, returns plain data + with all ids as strings." + [{:keys [pages pages-index]}] + (let [shapes (mapcat page-shapes + (keep #(get pages-index %) pages)) + frames (into [] + (comp (filter #(= :frame (:type %))) + (map (fn [{:keys [id name page-id]}] + (d/without-nils + {:id (str id) + :page-id page-id + :name name})))) + shapes) + texts (into [] + (comp (map (juxt :id :page-id shape-text)) + (remove #(nil? (nth % 2))) + (map (fn [[id page-id text]] + {:shape-id (str id) + :page-id page-id + :text text}))) + shapes) + ;; Texts are capped by total characters, the unit the model + ;; bills; links and interactions by count. + texts (loop [acc [] + chars 0 + [item & rest] texts] + (cond + (nil? item) + {:items acc :truncated? false} + + (> (+ chars (count (:text item))) max-text-chars) + {:items acc :truncated? true} + + :else + (recur (conj acc item) + (+ chars (count (:text item))) + rest))) + inter (into [] + (comp (mapcat (fn [shape] + (->> (:interactions shape) + (filter map?) + (filter :action-type) + (filter :event-type) + (map #(assoc % :shape-id (:id shape) + :page-id (:page-id shape)))))) + (map (fn [{:keys [shape-id page-id event-type action-type destination url]}] + (d/without-nils + {:shape-id (str shape-id) + :page-id page-id + :event (d/name event-type) + :action (d/name action-type) + :target (or url (some-> destination str))})))) + shapes) + links (into [] + (comp (mapcat (fn [shape] + (->> (:interactions shape) + (filter map?) + (filter open-url?) + (map #(assoc % :shape-id (:id shape) + :page-id (:page-id shape)))))) + (map (fn [{:keys [shape-id page-id url]}] + {:shape-id (str shape-id) + :page-id page-id + :url url}))) + shapes)] + {:version projection-version + :pages (mapv (fn [page-id] + (let [page (get pages-index page-id)] + (d/without-nils + {:id (str page-id) + :name (:name page)}))) + pages) + :frames frames + :texts texts + :links (if (> (count links) max-links) + {:items (subvec links 0 max-links) :truncated? true} + {:items links :truncated? false}) + :interactions (if (> (count inter) max-interactions) + {:items (subvec inter 0 max-interactions) :truncated? true} + {:items inter :truncated? false})})) + +(def ^:private sql:has-share-link + "SELECT EXISTS (SELECT 1 FROM share_link WHERE file_id = ?) AS shared;") + +(def ^:private sql:get-team-id + "SELECT team_id FROM project WHERE id = ?;") + +(def ^:private + schema:get-file-for-analysis-params + [:map {:title "get-file-for-analysis-params"} + [:file-id ::sm/uuid]]) + +(def ^:private schema:projection-page + [:map + [:id :string] + [:name {:optional true} :string]]) + +(def ^:private schema:projection-frame + [:map + [:id :string] + [:page-id :string] + [:name {:optional true} :string]]) + +(def ^:private schema:projection-text + [:map + [:shape-id :string] + [:page-id :string] + [:text :string]]) + +(def ^:private schema:projection-link + [:map + [:shape-id :string] + [:page-id :string] + [:url :string]]) + +(def ^:private schema:projection-interaction + [:map + [:shape-id :string] + [:page-id :string] + [:event :string] + [:action :string] + [:target {:optional true} :string]]) + +(def ^:private schema:projection + [:map {:title "file-projection"} + [:version ::sm/int] + [:pages [:vector schema:projection-page]] + [:frames [:vector schema:projection-frame]] + [:texts [:map + [:items [:vector schema:projection-text]] + [:truncated? :boolean]]] + [:links [:map + [:items [:vector schema:projection-link]] + [:truncated? :boolean]]] + [:interactions [:map + [:items [:vector schema:projection-interaction]] + [:truncated? :boolean]]]]) + +(def ^:private + schema:get-file-for-analysis-result + [:map {:title "get-file-for-analysis-result"} + [:id ::sm/uuid] + [:revn ::sm/int] + [:modified-at ::ct/inst] + [:project-id ::sm/uuid] + [:team-id ::sm/uuid] + [:has-share-link :boolean] + [:projection-version ::sm/int] + [:projection schema:projection]]) + +(sv/defmethod ::get-file-for-analysis + "Get the semantic projection of one file for security analysis. + + Read-only: returns the file identity, revision, share state and the + neutral projection (pages, frames, text, links, interactions). + Called by nexus with the shared-key identity; takes no profile. + Every call leaves an audit event like any other management call." + {::doc/added "2.20" + ::sm/params schema:get-file-for-analysis-params + ::sm/result schema:get-file-for-analysis-result + ::rpc/auth false} + [cfg {:keys [file-id]}] + ;; `realize?` loads the whole object tree eagerly: the projection + ;; walks every shape, so lazy pointers (no `load-fn` bound here) + ;; would fail on first touch. Same choice as the file exporter. + (let [file (bfc/get-file cfg file-id :realize? true) + shared (:shared (db/exec-one! cfg [sql:has-share-link file-id])) + team-id (:team-id (db/exec-one! cfg [sql:get-team-id (:project-id file)]))] + {:id (:id file) + :revn (:revn file) + :modified-at (:modified-at file) + :project-id (:project-id file) + :team-id team-id + :has-share-link (boolean shared) + :projection-version projection-version + :projection (file->projection (:data file))})) diff --git a/backend/src/app/srepl/main.clj b/backend/src/app/srepl/main.clj index b617934c46..8a475e2cae 100644 --- a/backend/src/app/srepl/main.clj +++ b/backend/src/app/srepl/main.clj @@ -782,7 +782,7 @@ :type "action" :props {:id team-id} :context {:triggered-by "srepl" - :cause "explicit call to delete-profile!"} + :cause "explicit call to delete-team!"} :tracked-at tnow}) (wrk/invoke! (-> sys/system @@ -851,6 +851,7 @@ (audit/insert sys/system {:name "delete-profile" :type "action" + :props {:id profile-id} :context {:triggered-by "srepl" :cause "explicit call to delete-profile!"} :tracked-at tnow}) @@ -1039,4 +1040,4 @@ (let [params (-> rel (assoc :id (uuid/next)) (assoc :team-id (:id team)))] - (teams/add-profile-to-team! cfg params {::db/return-keys false})))))))) + (teams/add-profile-to-team! cfg params)))))))) diff --git a/backend/src/app/tasks/delete_object.clj b/backend/src/app/tasks/delete_object.clj index fad5b54a36..abdc4bc5f3 100644 --- a/backend/src/app/tasks/delete_object.clj +++ b/backend/src/app/tasks/delete_object.clj @@ -11,6 +11,7 @@ [app.common.time :as ct] [app.db :as db] [app.db.sql :as-alias sql] + [app.loggers.audit :as audit] [app.rpc.commands.files :as files] [app.rpc.commands.profile :as profile] [app.storage :as sto] @@ -18,6 +19,29 @@ (def ^:dynamic *team-deletion* false) +(def ^:dynamic *cascade* + "Accumulates the ids marked deleted by the current cascade execution, + grouped by entity. Bound by the task entry point; nil on direct calls + (e.g. objects-gc, whose purges are announced by their own procs)." + nil) + +(defn- record + [kind id] + (when (some? *cascade*) + (swap! *cascade* update kind conj id))) + +(defn- top-exists? + "The cascade marks blindly, so an unknown top id would report phantom + rows. Every queue submission and SREPL call names a real row; only + check, never change behavior: a missing row just skips the run." + [{:keys [::db/conn]} {:keys [object id]}] + (let [object (when (some? object) (keyword (name object)))] + (if (contains? #{:team :project :file :profile} object) + (some? (db/get* conn object {:id id} + {::db/remove-deleted false + ::sql/columns [:id]})) + true))) + (defmulti delete-object (fn [_ props] (:object props))) @@ -88,7 +112,9 @@ (db/update! conn :file-tagged-object-thumbnail {:deleted-at deleted-at} {:file-id id} - {::db/return-keys false}))) + {::db/return-keys false}) + + (record :files id))) (defmethod delete-object :project [{:keys [::db/conn] :as cfg} {:keys [id deleted-at]}] @@ -105,7 +131,9 @@ {::db/columns [:id :deleted-at]})] (delete-object cfg (assoc file :object :file - :deleted-at deleted-at)))) + :deleted-at deleted-at))) + + (record :projects id)) (defmethod delete-object :team [{:keys [::db/conn] :as cfg} {:keys [id deleted-at]}] @@ -127,7 +155,9 @@ {::db/columns [:id :deleted-at]})] (delete-object cfg (assoc project :object :project - :deleted-at deleted-at))))) + :deleted-at deleted-at)))) + + (record :teams id)) (defmethod delete-object :profile [{:keys [::db/conn] :as cfg} {:keys [id deleted-at]}] @@ -156,4 +186,19 @@ (defmethod ig/init-key ::handler [_ cfg] (fn [{:keys [props] :as task}] - (db/tx-run! cfg delete-object props))) + (db/tx-run! cfg + (fn [cfg] + (when (top-exists? cfg props) + (binding [*cascade* (atom {:teams [] :projects [] :files []})] + (delete-object cfg props) + (let [{:keys [teams projects files]} @*cascade*] + (when (or (seq teams) (seq projects) (seq files)) + (audit/submit cfg {:name "delete-object-with-cascade" + :type "action" + :props {:object (:object props) + :id (:id props) + :deleted-at (:deleted-at props) + :cascade {:team-ids teams + :project-ids projects + :file-ids files}} + :context {:triggered-by "delete-object"}}))))))))) diff --git a/backend/src/app/tasks/objects_gc.clj b/backend/src/app/tasks/objects_gc.clj index 7ddc210291..1d6f842e30 100644 --- a/backend/src/app/tasks/objects_gc.clj +++ b/backend/src/app/tasks/objects_gc.clj @@ -10,8 +10,10 @@ (:require [app.common.logging :as l] [app.common.time :as ct] + [app.config :as cf] [app.db :as db] [app.features.fdata :as fdata] + [app.loggers.audit :as audit] [app.storage :as sto] [app.tasks.delete-object :as dobj] [integrant.core :as ig])) @@ -27,6 +29,22 @@ ;; reduction is running, so the key is read inside the reducing function: ;; buffering the row itself yields nil columns. +(defn- submit-hard-delete-event + "Emits one hard-delete audit event for the batch of rows just purged + by this task, so a projection of the audit stream can drop its local + rows. Each GC section purges in its own chunk transactions, so each + chunk carries only its own entity key (`:team-ids`, `:project-ids` + or `:file-ids`); a single event spanning sections could never share + their transactions. Runs inside the caller transaction, next to the + deletes: if the purge aborts, the event aborts with it." + [cfg ids-key ids] + (when (contains? cf/flags :audit-log) + (audit/submit cfg + {:name "hard-delete-objects" + :type "command" + :props {ids-key (vec ids)} + :context {:triggered-by "objects-gc"}}))) + (def ^:private sql:get-upload-sessions "SELECT us.id FROM upload_session AS us @@ -179,23 +197,28 @@ [cfg ids] (try (db/tx-run! cfg - (fn [{:keys [::db/conn ::timestamp ::sto/storage]}] + (fn [{:keys [::db/conn ::timestamp ::sto/storage] :as cfg}] (db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"]) - (let [ids (db/create-array conn "uuid" ids)] - (->> (db/exec! conn [sql:lock-teams ids timestamp]) - (reduce (fn [total {:keys [id photo-id deleted-at]}] - (l/trc :obj "team" - :id (str id) - :deleted-at (ct/format-inst deleted-at)) + (let [ids (db/create-array conn "uuid" ids) + [total deleted-ids] + (->> (db/exec! conn [sql:lock-teams ids timestamp]) + (reduce (fn [[total deleted-ids] {:keys [id photo-id deleted-at]}] + (l/trc :obj "team" + :id (str id) + :deleted-at (ct/format-inst deleted-at)) - ;; Mark as deleted the storage object - (some->> photo-id (sto/touch-object! storage)) + ;; Mark as deleted the storage object + (some->> photo-id (sto/touch-object! storage)) - ;; And finally, permanently delete the team. - (let [affected (-> (db/delete! conn :team {:id id}) - (db/get-update-count))] - (+ total affected))) - 0))))) + ;; And finally, permanently delete the team. + (let [affected (-> (db/delete! conn :team {:id id}) + (db/get-update-count))] + [(+ total affected) + (cond-> deleted-ids (pos? affected) (conj id))])) + [0 []]))] + (when (seq deleted-ids) + (submit-hard-delete-event cfg :team-ids deleted-ids)) + total))) (catch Throwable cause (l/err :obj "team" :hint "error on chunk deletion, skipping it" @@ -287,20 +310,25 @@ [cfg ids] (try (db/tx-run! cfg - (fn [{:keys [::db/conn ::timestamp]}] + (fn [{:keys [::db/conn ::timestamp] :as cfg}] (db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"]) - (let [ids (db/create-array conn "uuid" ids)] - (->> (db/exec! conn [sql:lock-projects ids timestamp]) - (reduce (fn [total {:keys [id team-id deleted-at]}] - (l/trc :obj "project" - :id (str id) - :team-id (str team-id) - :deleted-at (ct/format-inst deleted-at)) + (let [ids (db/create-array conn "uuid" ids) + [total deleted-ids] + (->> (db/exec! conn [sql:lock-projects ids timestamp]) + (reduce (fn [[total deleted-ids] {:keys [id team-id deleted-at]}] + (l/trc :obj "project" + :id (str id) + :team-id (str team-id) + :deleted-at (ct/format-inst deleted-at)) - (let [affected (-> (db/delete! conn :project {:id id}) - (db/get-update-count))] - (+ total affected))) - 0))))) + (let [affected (-> (db/delete! conn :project {:id id}) + (db/get-update-count))] + [(+ total affected) + (cond-> deleted-ids (pos? affected) (conj id))])) + [0 []]))] + (when (seq deleted-ids) + (submit-hard-delete-event cfg :project-ids deleted-ids)) + total))) (catch Throwable cause (l/err :obj "project" :hint "error on chunk deletion, skipping it" @@ -336,20 +364,25 @@ [cfg ids] (try (db/tx-run! cfg - (fn [{:keys [::db/conn ::timestamp]}] + (fn [{:keys [::db/conn ::timestamp] :as cfg}] (db/exec-one! conn ["SET LOCAL rules.deletion_protection TO off"]) - (let [ids (db/create-array conn "uuid" ids)] - (->> (db/exec! conn [sql:lock-files ids timestamp]) - (reduce (fn [total {:keys [id deleted-at project-id]}] - (l/trc :obj "file" - :id (str id) - :project-id (str project-id) - :deleted-at (ct/format-inst deleted-at)) + (let [ids (db/create-array conn "uuid" ids) + [total deleted-ids] + (->> (db/exec! conn [sql:lock-files ids timestamp]) + (reduce (fn [[total deleted-ids] {:keys [id deleted-at project-id]}] + (l/trc :obj "file" + :id (str id) + :project-id (str project-id) + :deleted-at (ct/format-inst deleted-at)) - (let [affected (-> (db/delete! conn :file {:id id}) - (db/get-update-count))] - (+ total affected))) - 0))))) + (let [affected (-> (db/delete! conn :file {:id id}) + (db/get-update-count))] + [(+ total affected) + (cond-> deleted-ids (pos? affected) (conj id))])) + [0 []]))] + (when (seq deleted-ids) + (submit-hard-delete-event cfg :file-ids deleted-ids)) + total))) (catch Throwable cause (l/err :obj "file" :hint "error on chunk deletion, skipping it" diff --git a/backend/test/backend_tests/binfile_svg_test.clj b/backend/test/backend_tests/binfile_svg_test.clj index a12d30e895..92fe3f2a0e 100644 --- a/backend/test/backend_tests/binfile_svg_test.clj +++ b/backend/test/backend_tests/binfile_svg_test.clj @@ -374,13 +374,14 @@ of its single media object." [profile file] (let [bundle (export-v1 profile file)] - (let [result (-> th/*system* - (assoc ::bfc/project-id (:default-project-id profile)) - (assoc ::bfc/profile-id (:id profile)) - (assoc ::bfc/input (io/input-stream bundle)) - (v1/import-files!))] - (t/is (= 1 (count result))) - (let [rows (th/db-query :file-media-object {:file-id (first result)}) + (let [result (-> th/*system* + (assoc ::bfc/project-id (:default-project-id profile)) + (assoc ::bfc/profile-id (:id profile)) + (assoc ::bfc/input (io/input-stream bundle)) + (v1/import-files!)) + file-id (first (:file-ids result))] + (t/is (= 1 (count (:file-ids result)))) + (let [rows (th/db-query :file-media-object {:file-id file-id}) storage (:app.storage/storage th/*system*)] (t/is (= 1 (count rows))) (let [object (sto/get-object storage (:media-id (first rows)))] diff --git a/backend/test/backend_tests/delete_object_test.clj b/backend/test/backend_tests/delete_object_test.clj new file mode 100644 index 0000000000..878bea305d --- /dev/null +++ b/backend/test/backend_tests/delete_object_test.clj @@ -0,0 +1,107 @@ +;; 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.delete-object-test + (:require + [app.common.time :as ct] + [app.common.uuid :as uuid] + [app.config :as cf] + [app.db :as db] + [backend-tests.helpers :as th] + [clojure.test :as t] + [mockery.core :refer [with-mocks]])) + +(t/use-fixtures :once th/state-init) +(t/use-fixtures :each th/database-reset) + +(defn- submitted-events + [audit-mock] + (->> (:call-args-list @audit-mock) + (map second))) + +(defn- cascade-events + [audit-mock] + (filter #(= "delete-object-with-cascade" (:name %)) + (submitted-events audit-mock))) + +(t/deftest delete-object-team-cascade-emits-event + ;; The cascade marks the team, its projects and their files; the event + ;; carries every affected id so a projection can follow without reading + ;; production tables. + (with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}] + (with-redefs [cf/flags (conj cf/flags :audit-log)] + (let [profile (th/create-profile* 1 {:is-active true}) + team (th/create-team* 91 {:profile-id (:id profile)}) + project (th/create-project* 91 {:profile-id (:id profile) + :team-id (:id team)}) + file (th/create-file* 91 {:profile-id (:id profile) + :project-id (:id project)}) + deleted-at (ct/now)] + (th/run-task! :delete-object {:object :team + :id (:id team) + :deleted-at deleted-at}) + (t/is (some? (:deleted-at (th/db-get :team {:id (:id team)} + {::db/remove-deleted false})))) + (t/is (some? (:deleted-at (th/db-get :project {:id (:id project)} + {::db/remove-deleted false})))) + (t/is (some? (:deleted-at (th/db-get :file {:id (:id file)} + {::db/remove-deleted false})))) + (let [events (cascade-events audit-mock)] + (t/is (= 1 (count events))) + (t/is (= "action" (:type (first events)))) + (let [props (:props (first events))] + (t/is (= "team" (name (:object props)))) + (t/is (= (:id team) (:id props))) + (t/is (= deleted-at (:deleted-at props))) + (t/is (not (contains? props :team-ids))) + (t/is (not (contains? props :project-ids))) + (t/is (not (contains? props :file-ids))) + (t/is (= #{(:id team)} (set (get-in props [:cascade :team-ids])))) + (t/is (= #{(:default-project-id team) (:id project)} + (set (get-in props [:cascade :project-ids])))) + (t/is (= #{(:id file)} (set (get-in props [:cascade :file-ids])))))))))) + +(t/deftest delete-object-file-cascade-emits-event + (with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}] + (with-redefs [cf/flags (conj cf/flags :audit-log)] + (let [profile (th/create-profile* 1 {:is-active true}) + team (th/create-team* 92 {:profile-id (:id profile)}) + project (th/create-project* 92 {:profile-id (:id profile) + :team-id (:id team)}) + file (th/create-file* 92 {:profile-id (:id profile) + :project-id (:id project)}) + deleted-at (ct/now)] + (th/run-task! :delete-object {:object :file + :id (:id file) + :deleted-at deleted-at}) + (let [events (cascade-events audit-mock)] + (t/is (= 1 (count events))) + (t/is (= "action" (:type (first events)))) + (let [props (:props (first events))] + (t/is (= "file" (name (:object props)))) + (t/is (= (:id file) (:id props))) + (t/is (= [] (get-in props [:cascade :team-ids]))) + (t/is (= [] (get-in props [:cascade :project-ids]))) + (t/is (= [(:id file)] (get-in props [:cascade :file-ids]))))))))) + +(t/deftest delete-object-missing-row-emits-nothing + ;; A cascade over an unknown id marks nothing, so there is nothing to report. + (with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}] + (with-redefs [cf/flags (conj cf/flags :audit-log)] + (th/run-task! :delete-object {:object :team + :id (uuid/next) + :deleted-at (ct/now)}) + (t/is (empty? (:call-args-list @audit-mock)))))) + +(t/deftest delete-object-snapshot-emits-nothing + ;; Snapshots have no projection table; their cascade stays silent. + (with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}] + (with-redefs [cf/flags (conj cf/flags :audit-log)] + (th/run-task! :delete-object {:object :snapshot + :id (uuid/next) + :file-id (uuid/next) + :deleted-at (ct/now)}) + (t/is (empty? (:call-args-list @audit-mock)))))) diff --git a/backend/test/backend_tests/helpers.clj b/backend/test/backend_tests/helpers.clj index 2718e48615..0335369709 100644 --- a/backend/test/backend_tests/helpers.clj +++ b/backend/test/backend_tests/helpers.clj @@ -483,6 +483,20 @@ (let [params (prepare-rpc-params data)] (try-on! (method-fn params))))) +(defn command-raw! + "Like `command!`, but returns the raw result without unwrapping it, so a test + can read the result metadata (for example the audit props a command sets on a + nil result). The HTTP layer unwraps it the same way in production." + [{:keys [::type] :as data}] + (let [[_ method-fn] (get-in *system* [:app.rpc/methods type])] + (when-not method-fn + (ex/raise :type :assertion + :code :rpc-method-not-found + :hint (str/ffmt "rpc method '%' not found" (name type)))) + + (let [params (prepare-rpc-params data)] + (method-fn params)))) + (defn management-command! [{:keys [::type] :as data}] (let [[_ method-fn] (get-in *system* [:app.rpc/management-methods type])] diff --git a/backend/test/backend_tests/loggers_webhooks_test.clj b/backend/test/backend_tests/loggers_webhooks_test.clj index ece038fef7..5bad72051b 100644 --- a/backend/test/backend_tests/loggers_webhooks_test.clj +++ b/backend/test/backend_tests/loggers_webhooks_test.clj @@ -6,9 +6,12 @@ (ns backend-tests.loggers-webhooks-test (:require + [app.common.time :as ct] [app.common.uuid :as uuid] + [app.config :as cf] [app.db :as db] [app.http :as http] + [app.loggers.audit :as audit] [app.storage :as sto] [backend-tests.helpers :as th] [clojure.test :as t] @@ -17,6 +20,12 @@ (t/use-fixtures :once th/state-init) (t/use-fixtures :each th/database-reset) +(defn decode-row + [{:keys [props context] :as row}] + (cond-> row + (db/pgobject? props) (assoc :props (db/decode-transit-pgobject props)) + (db/pgobject? context) (assoc :context (db/decode-transit-pgobject context)))) + (t/deftest process-event-handler-with-no-webhooks (with-mocks [submit-mock {:target 'app.worker/submit! :return nil}] (let [prof (th/create-profile* 1 {:is-active true}) @@ -40,6 +49,37 @@ (t/is (= 1 (:call-count @submit-mock))) (t/is (nil? res))))) +(t/deftest process-event-handler-persists-origin-event-id + ;; End-to-end regression test for the `webhook/trigger` row: its props + ;; `:event-id` must hold the origin event row id. It used to be nil + ;; because `process-event` never forwarded the id to the worker task. + (with-mocks [submit-mock {:target 'app.worker/submit! :return nil}] + (with-redefs [cf/flags #{:audit-log :webhooks}] + (let [prof (th/create-profile* 1 {:is-active true}) + event {:type "action" + :name "delete-project" + :profile-id (:id prof) + :props {:team-id (:default-team-id prof)} + :context {:version "2.0.0" :initiator "app"} + :tracked-at (ct/now) + :created-at (ct/now) + :source "backend" + :app.loggers.webhooks/event? true}] + (audit/submit* th/*system* event) + (let [params (-> @submit-mock :call-args-list ffirst :app.worker/params)] + (t/is (some? (:id params))) + ;; Run the handler the way the worker would. + (th/run-task! :process-webhook-event params) + (let [[origin trigger :as rows] (->> (th/db-exec! ["select * from audit_log order by created_at"]) + (mapv decode-row))] + (t/is (= 2 (count rows))) + (t/is (= "delete-project" (:name origin))) + (t/is (= "webhook" (:name trigger))) + (t/is (= "trigger" (:type trigger))) + (t/is (= "delete-project" (get-in trigger [:props :name]))) + (t/is (= (:id origin) (get-in trigger [:props :event-id]))) + (t/is (= 0 (get-in trigger [:props :total-affected]))))))))) + (t/deftest run-webhook-handler-1 (with-mocks [http-mock {:target 'app.http.client/req :return {:status 200}}] (let [prof (th/create-profile* 1 {:is-active true}) diff --git a/backend/test/backend_tests/objects_gc_test.clj b/backend/test/backend_tests/objects_gc_test.clj index f02a437f4f..5a3052901f 100644 --- a/backend/test/backend_tests/objects_gc_test.clj +++ b/backend/test/backend_tests/objects_gc_test.clj @@ -8,11 +8,14 @@ (:require [app.common.logging :as l] [app.common.time :as ct] + [app.config :as cf] [app.db :as db] + [app.rpc :as-alias rpc] [app.storage :as sto] [app.tasks.objects-gc :as ogc] [backend-tests.helpers :as th] - [clojure.test :as t])) + [clojure.test :as t] + [mockery.core :refer [with-mocks]])) (t/use-fixtures :once th/state-init) (t/use-fixtures :each th/database-reset) @@ -123,3 +126,119 @@ (t/testing "the run finishes" (t/is (pos? (:processed result)))))) + +(defn- submitted-events + [audit-mock] + (->> (:call-args-list @audit-mock) + (map second))) + +(defn- events-named + [audit-mock event-name] + (filter #(= event-name (:name %)) + (submitted-events audit-mock))) + +(t/deftest gc-emits-hard-delete-objects-for-teams + ;; When the GC physically deletes a team, the projection must drop its row, + ;; so the event carries the purged ids. + (with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}] + (with-redefs [cf/flags (conj cf/flags :audit-log)] + (let [profile (th/create-profile* 1 {:is-active true}) + team (th/create-team* 71 {:profile-id (:id profile)})] + (th/command! {::th/type :delete-team + ::rpc/profile-id (:id profile) + :id (:id team)}) + ;; Run the queued cascade so the default project is marked deleted too, + ;; then purge everything the way production does. + (th/run-pending-tasks!) + (th/reset-mock! audit-mock) + (th/run-task! :objects-gc {:skip-delay true}) + (t/is (nil? (th/db-get :team {:id (:id team)} {::db/remove-deleted false}))) + (let [events (filter #(contains? (:props %) :team-ids) + (events-named audit-mock "hard-delete-objects"))] + (t/is (= 1 (count events))) + (let [event (first events)] + (t/is (= "command" (:type event))) + (t/is (= [(:id team)] (get-in event [:props :team-ids]))) + (t/is (= "objects-gc" (get-in event [:context :triggered-by]))))))))) + +(t/deftest gc-emits-hard-delete-objects-for-projects + (with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}] + (with-redefs [cf/flags (conj cf/flags :audit-log)] + (let [profile (th/create-profile* 1 {:is-active true}) + team (th/create-team* 72 {:profile-id (:id profile)}) + project (th/create-project* 72 {:profile-id (:id profile) + :team-id (:id team)})] + (th/command! {::th/type :delete-project + ::rpc/profile-id (:id profile) + :id (:id project)}) + (th/run-pending-tasks!) + (th/reset-mock! audit-mock) + (th/run-task! :objects-gc {:skip-delay true}) + (t/is (nil? (th/db-get :project {:id (:id project)} {::db/remove-deleted false}))) + (let [events (filter #(contains? (:props %) :project-ids) + (events-named audit-mock "hard-delete-objects"))] + (t/is (= 1 (count events))) + (let [event (first events)] + (t/is (= "command" (:type event))) + (t/is (= [(:id project)] (get-in event [:props :project-ids]))) + (t/is (= "objects-gc" (get-in event [:context :triggered-by]))))))))) + +(t/deftest gc-emits-hard-delete-objects-for-files + (with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}] + (with-redefs [cf/flags (conj cf/flags :audit-log)] + (let [profile (th/create-profile* 1 {:is-active true}) + team (th/create-team* 73 {:profile-id (:id profile)}) + project (th/create-project* 73 {:profile-id (:id profile) + :team-id (:id team)}) + file (th/create-file* 73 {:profile-id (:id profile) + :project-id (:id project)})] + (th/command! {::th/type :delete-file + ::rpc/profile-id (:id profile) + :id (:id file)}) + (th/run-pending-tasks!) + (th/reset-mock! audit-mock) + (th/run-task! :objects-gc {:skip-delay true}) + (t/is (nil? (th/db-get :file {:id (:id file)} {::db/remove-deleted false}))) + (let [events (filter #(contains? (:props %) :file-ids) + (events-named audit-mock "hard-delete-objects"))] + (t/is (= 1 (count events))) + (let [event (first events)] + (t/is (= "command" (:type event))) + (t/is (= [(:id file)] (get-in event [:props :file-ids]))) + (t/is (= "objects-gc" (get-in event [:context :triggered-by]))))))))) + +(t/deftest gc-emits-no-event-without-audit-log-flag + ;; The GC must stay silent when the audit log is off, even though the row is + ;; still purged. + (with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}] + (let [profile (th/create-profile* 1 {:is-active true}) + team (th/create-team* 74 {:profile-id (:id profile)})] + (th/command! {::th/type :delete-team + ::rpc/profile-id (:id profile) + :id (:id team)}) + (th/run-pending-tasks!) + (th/reset-mock! audit-mock) + (th/run-task! :objects-gc {:skip-delay true}) + (t/is (nil? (th/db-get :team {:id (:id team)} {::db/remove-deleted false}))) + (t/is (empty? (:call-args-list @audit-mock)))))) + +(t/deftest gc-emits-events-only-for-committed-chunks + (with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}] + (with-redefs [cf/flags (conj cf/flags :audit-log)] + (let [profile (th/create-profile* 1) + rolled-back (create-deleted-file! profile 1 (ct/in-past "30m")) + blocked (create-deleted-file! profile 2 (ct/in-past "20m")) + clean (create-deleted-file! profile 3 (ct/in-past "10m"))] + (block-file! blocked) + (th/reset-mock! audit-mock) + (let [result (th/run-task! :objects-gc {:chunk-size 2}) + events (filter #(contains? (:props %) :file-ids) + (events-named audit-mock "hard-delete-objects"))] + (t/testing "the failed chunk keeps both files" + (t/is (some? (find-file (:id rolled-back)))) + (t/is (some? (find-file (:id blocked))))) + (t/testing "the next chunk commits and reports only its deleted file" + (t/is (nil? (find-file (:id clean)))) + (t/is (pos? (:processed result))) + (t/is (= 1 (count events))) + (t/is (= [(:id clean)] (get-in (first events) [:props :file-ids]))))))))) diff --git a/backend/test/backend_tests/rpc_audit_test.clj b/backend/test/backend_tests/rpc_audit_test.clj index 50ee79f2e8..81ca636dbe 100644 --- a/backend/test/backend_tests/rpc_audit_test.clj +++ b/backend/test/backend_tests/rpc_audit_test.clj @@ -17,6 +17,7 @@ [app.util.services :as sv] [backend-tests.helpers :as th] [clojure.test :as t] + [mockery.core :refer [with-mocks]] [yetti.request])) (t/use-fixtures :once th/state-init) @@ -329,6 +330,58 @@ (t/is (= day-now (:created-at row2))) (t/is (= day-now (:tracked-at row2)))))))) +(t/deftest backend-process-event-forwards-id-to-webhook-task + ;; The `webhook/trigger` row links back to its origin event through + ;; props `:event-id`, so `process-event` must forward the stored row + ;; id to the `:process-webhook-event` worker task. Regression test: + ;; the id used to be generated inside `append-audit-entry` without + ;; ever reaching the worker params, so `:event-id` always landed nil. + (with-mocks [submit-mock {:target 'app.worker/submit! :return nil}] + (with-redefs [cf/flags #{:audit-log :webhooks}] + (let [prof (th/create-profile* 1 {:is-active true}) + event {:type "action" + :name "delete-project" + :profile-id (:id prof) + :props {:team-id (:default-team-id prof)} + :context {:version "2.0.0" :initiator "app"} + :tracked-at (ct/now) + :created-at (ct/now) + :source "backend" + :app.loggers.webhooks/event? true}] + (audit/submit* th/*system* event) + (let [[row :as rows] (->> (th/db-exec! ["select * from audit_log"]) + (mapv decode-row))] + (t/is (= 1 (count rows))) + (t/is (= 1 (:call-count @submit-mock))) + (let [params (-> @submit-mock :call-args-list ffirst :app.worker/params)] + (t/is (some? (:id params))) + (t/is (= (:id row) (:id params))))))))) + +(t/deftest backend-process-event-telemetry-row-gets-own-id + ;; When both `:audit-log` and `:telemetry` are active, the shadow + ;; telemetry row must not reuse the full row id (shared PK), while + ;; the webhook task still carries the full row id. + (with-mocks [submit-mock {:target 'app.worker/submit! :return nil}] + (with-redefs [cf/flags #{:audit-log :telemetry :webhooks}] + (let [prof (th/create-profile* 1 {:is-active true}) + event {:type "action" + :name "delete-project" + :profile-id (:id prof) + :props {:team-id (:default-team-id prof)} + :context {:version "2.0.0" :initiator "app"} + :tracked-at (ct/now) + :created-at (ct/now) + :source "backend" + :app.loggers.webhooks/event? true}] + (audit/submit* th/*system* event) + (let [[row1 row2 :as rows] (->> (th/db-exec! ["select * from audit_log order by source"]) + (mapv decode-row))] + (t/is (= 2 (count rows))) + (t/is (not= (:id row1) (:id row2))) + (let [params (-> @submit-mock :call-args-list ffirst :app.worker/params)] + (t/is (= (:id (first (filter #(= "backend" (:source %)) rows))) + (:id params))))))))) + (t/deftest push-events-disabled-when-no-flags-and-no-telemetry ;; When neither audit-log nor telemetry is enabled, no rows should ;; be stored. @@ -651,17 +704,22 @@ (defn- prepare-event "Call prepare-rpc-event with a bare request, returning the built event." - [caller result] - (let [mdata {::sv/name "test-cmd"} - params {::rpc/profile-id caller - ::rpc/request-id (uuid/next) - ::rpc/request-at (ct/now)} - mock-req (reify - yetti.request/IRequest - (get-header [_ _] nil) - (remote-addr [_] "127.0.0.1")) - params (with-meta params {:app.http/request mock-req})] - (audit/prepare-rpc-event th/*system* mdata params result))) + ([caller result] + (prepare-event caller "test-cmd" result)) + ([caller cmd-name result] + (let [mdata {::sv/name cmd-name} + params {::rpc/profile-id caller + ::rpc/request-id (uuid/next) + ::rpc/request-at (ct/now)} + mock-req (reify + yetti.request/IRequest + (get-header [_ _] nil) + (remote-addr [_] "127.0.0.1")) + params (with-meta params {:app.http/request mock-req})] + ;; Production always resolves commands with `::module` set ("main" or + ;; "management"): the event name (and the read exclusion) depends on it. + (audit/prepare-rpc-event (assoc th/*system* ::rpc/module "main") + mdata params result)))) (t/deftest prepare-rpc-event-ignores-profile-id-from-result ;; An audit event belongs to the caller, never to whatever `:profile-id` @@ -696,6 +754,76 @@ (t/is (= uuid/zero (:profile-id (prepare-event nil {:some-data "value"}))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; PREPARE-RPC-EVENT TEAM-ID ENRICHMENT +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(t/deftest prepare-rpc-event-enriches-team-id-from-project-id + ;; An event that carries a project id resolves its team locally, so the + ;; downstream consumers do not need to join production tables. + (let [profile (th/create-profile* 1 {:is-active true}) + team (th/create-team* 10 {:profile-id (:id profile)}) + project (th/create-project* 10 {:profile-id (:id profile) + :team-id (:id team)}) + result (with-meta {} {::audit/props {:project-id (:id project)}}) + event (prepare-event (:id profile) result)] + (t/is (= (:id team) (get-in event [:props :team-id]))))) + +(t/deftest prepare-rpc-event-enriches-team-id-from-file-id + (let [profile (th/create-profile* 1 {:is-active true}) + team (th/create-team* 11 {:profile-id (:id profile)}) + project (th/create-project* 11 {:profile-id (:id profile) + :team-id (:id team)}) + file (th/create-file* 11 {:profile-id (:id profile) + :project-id (:id project)}) + result (with-meta {} {::audit/props {:file-id (:id file)}}) + event (prepare-event (:id profile) result)] + (t/is (= (:id team) (get-in event [:props :team-id]))))) + +(t/deftest prepare-rpc-event-keeps-existing-team-id + ;; The resolver never overwrites a team id the command already set. + (let [profile (th/create-profile* 1 {:is-active true}) + team (th/create-team* 12 {:profile-id (:id profile)}) + project (th/create-project* 12 {:profile-id (:id profile) + :team-id (:id team)}) + result (with-meta {} {::audit/props {:team-id (:id team) + :project-id (:id project)}}) + event (prepare-event (:id profile) result)] + (t/is (= (:id team) (get-in event [:props :team-id]))))) + +(t/deftest prepare-rpc-event-does-not-resolve-without-project-or-file + ;; Read commands put the entity id under `:id`; enriching those would add a + ;; query to every read event, so the resolver must leave them untouched. + (let [profile (th/create-profile* 1 {:is-active true}) + result (with-meta {} {::audit/props {:id (uuid/next)}}) + event (prepare-event (:id profile) result)] + (t/is (not (contains? (:props event) :team-id))))) + +(t/deftest prepare-rpc-event-resolves-default-team-id + ;; The resolver adds the team id whenever it can resolve it, including the + ;; personal (default) team. + (let [profile (th/create-profile* 1 {:is-active true}) + result (with-meta {} {::audit/props {:project-id (:default-project-id profile)}}) + event (prepare-event (:id profile) result)] + (t/is (= (:default-team-id profile) (get-in event [:props :team-id]))))) + +(t/deftest prepare-rpc-event-skips-team-id-resolution-for-reads + ;; Read events carry no consumer state: resolving their team would add a + ;; query to every read, so `get-*` names (plus the known non-get reads) + ;; are left untouched even when they carry a project or file id. + (let [profile (th/create-profile* 1 {:is-active true}) + team (th/create-team* 13 {:profile-id (:id profile)}) + project (th/create-project* 13 {:profile-id (:id profile) + :team-id (:id team)}) + file (th/create-file* 13 {:profile-id (:id profile) + :project-id (:id project)})] + (doseq [cmd-name ["get-file-fragment" "get-comments" "has-file-libraries"] + props [{:file-id (:id file)} {:project-id (:id project)}]] + (let [result (with-meta {} {::audit/props props}) + event (prepare-event (:id profile) cmd-name result)] + (t/is (not (contains? (:props event) :team-id)) + (str cmd-name " with " (keys props) " must not resolve team-id")))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; PREPARE-RPC-EVENT PROFILE-ID COERCION ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/backend/test/backend_tests/rpc_binfile_test.clj b/backend/test/backend_tests/rpc_binfile_test.clj index b1a144ab70..ccdcc7fafa 100644 --- a/backend/test/backend_tests/rpc_binfile_test.clj +++ b/backend/test/backend_tests/rpc_binfile_test.clj @@ -6,13 +6,17 @@ (ns backend-tests.rpc-binfile-test (:require + [app.binfile.v3 :as bf.v3] [app.common.schema :as sm] [app.common.uuid :as uuid] + [app.config :as cf] + [app.db :as db] [app.rpc :as-alias rpc] [app.rpc.commands.binfile :as binfile] [backend-tests.helpers :as th] [clojure.test :as t] - [datoteka.fs :as fs])) + [datoteka.fs :as fs] + [mockery.core :refer [with-mocks]])) (t/use-fixtures :once th/state-init) (t/use-fixtures :each th/database-reset) @@ -72,3 +76,38 @@ ;; Version 4 should be rejected (t/is (false? (validator (assoc base-params :version 4))) "version 4 should be rejected"))) + +(t/deftest import-binfile-audit-events-carry-entity-ids + ;; The imported files are created inside the importer, so the command emits a + ;; create-file event per file for a local projection. + (with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}] + (with-redefs [cf/flags (conj cf/flags :audit-log)] + (let [profile (th/create-profile* 1 {:is-active true}) + team (th/create-team* 51 {:profile-id (:id profile)}) + project (th/create-project* 51 {:profile-id (:id profile) + :team-id (:id team)}) + ;; A real row: `submit-file-created-event` reads the light + ;; columns back, so a phantom id would emit no event. + file (th/create-file* 99 {:profile-id (:id profile) + :project-id (:id project)}) + file-id (:id file)] + (with-redefs [bf.v3/import-files! (fn [_cfg] {:file-ids [file-id]})] + (#'binfile/import-binfile + th/*system* + {::rpc/profile-id (:id profile) + :profile-id (:id profile) + :project-id (:id project) + :version 3 + :name "imported" + :file {:filename "package.penpot" + :path (th/tempfile "backend_tests/test_files/svg-attrs-camel-case.penpot") + :mtype "application/zip" + :size 1}})) + + (let [events (->> (:call-args-list @audit-mock) + (map second) + (filter #(= "create-file" (:name %))))] + (t/is (= 1 (count events))) + (t/is (= file-id (get-in (first events) [:props :id]))) + (t/is (= (:id project) (get-in (first events) [:props :project-id]))) + (t/is (= (:id team) (get-in (first events) [:props :team-id])))))))) diff --git a/backend/test/backend_tests/rpc_comment_test.clj b/backend/test/backend_tests/rpc_comment_test.clj index ea64723545..0c58687751 100644 --- a/backend/test/backend_tests/rpc_comment_test.clj +++ b/backend/test/backend_tests/rpc_comment_test.clj @@ -478,3 +478,32 @@ :content "member comment" :frame-id uuid/zero})] (t/is (th/success? out)))))) + +(t/deftest comment-audit-events-carry-team-id + ;; Comment events carry the file id, so the resolver could find the team; the + ;; command already has the file with its team id and sets it without a join. + (with-mocks [mock {:target 'app.config/get + :return (th/config-get-mock + {:quotes-teams-per-profile 200})}] + (let [profile (th/create-profile* 1 {:is-active true}) + team (th/create-team* 1 {:profile-id (:id profile)}) + project (th/create-project* 1 {:team-id (:id team) + :profile-id (:id profile)}) + file (th/create-file* 1 {:profile-id (:id profile) + :project-id (:id project)}) + page-id (get-in file [:data :pages 0]) + thread (th/command! {::th/type :create-comment-thread + ::rpc/profile-id (:id profile) + :file-id (:id file) + :page-id page-id + :position (gpt/point 0) + :content "hello" + :frame-id uuid/zero}) + comment (th/command! {::th/type :create-comment + ::rpc/profile-id (:id profile) + :thread-id (get-in thread [:result :id]) + :content "comment"})] + (t/is (= (:id team) + (get-in (meta (:result thread)) [:app.loggers.audit/props :team-id]))) + (t/is (= (:id team) + (get-in (meta (:result comment)) [:app.loggers.audit/props :team-id])))))) diff --git a/backend/test/backend_tests/rpc_file_security_test.clj b/backend/test/backend_tests/rpc_file_security_test.clj new file mode 100644 index 0000000000..15ac56c53d --- /dev/null +++ b/backend/test/backend_tests/rpc_file_security_test.clj @@ -0,0 +1,368 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS INC Sucursal en España SL + +(ns backend-tests.rpc-file-security-test + "Tests for the nexus file-security backend prerequisite: the + `get-file-for-analysis` management method, the semantic projection, + and the audit prop coverage the `:local` consumer schedules from." + (:require + [app.binfile.common :as bfc] + [app.common.features :as cfeat] + [app.common.time :as ct] + [app.common.types.shape :as cts] + [app.common.uuid :as uuid] + [app.loggers.audit :as audit] + [app.rpc :as-alias rpc] + [app.rpc.management.files :as mgmt.files] + [app.util.services :as sv] + [backend-tests.helpers :as th] + [clojure.test :as t] + [yetti.request])) + +(t/use-fixtures :once th/state-init) +(t/use-fixtures :each th/database-reset) + +;; --- Projection unit tests (pure, no database) + +(def ^:private page-id (uuid/random)) +(def ^:private frame-id (uuid/random)) +(def ^:private text-id (uuid/random)) +(def ^:private link-id (uuid/random)) + +(defn- test-data + [objects] + {:pages [page-id] + :pages-index {page-id {:id page-id + :name "Page 1" + :objects objects}}}) + +(t/deftest projection-empty-file + (let [projection (mgmt.files/file->projection (test-data {}))] + (t/is (= 1 (:version projection))) + (t/is (= [{:id (str page-id) :name "Page 1"}] (:pages projection))) + (t/is (= [] (:frames projection))) + (t/is (= {:items [] :truncated? false} (:texts projection))) + (t/is (= {:items [] :truncated? false} (:links projection))) + (t/is (= {:items [] :truncated? false} (:interactions projection))))) + +(t/deftest projection-picks-frames-text-links-and-interactions + (let [data (test-data + {frame-id {:id frame-id :name "Frame" :type :frame} + text-id {:id text-id :name "Text" :type :text + :content {:type "root" + :children [{:type "paragraph" + :children [{:text "hello"} + {:text " world"}]}]}} + link-id {:id link-id :name "Button" :type :rect + :interactions [{:event-type :click + :action-type :open-url + :url "https://phish.example/login"} + {:event-type :click + :action-type :navigate + :destination page-id} + ;; No event, cannot trigger: + ;; collected as link, never + ;; as interaction. + {:action-type :open-url + :url "https://quiet.example"}]}}) + projection (mgmt.files/file->projection data)] + (t/is (= [{:id (str frame-id) :page-id (str page-id) :name "Frame"}] + (:frames projection))) + (t/is (= {:items [{:shape-id (str text-id) + :page-id (str page-id) + :text "hello world"}] + :truncated? false} + (:texts projection))) + (t/is (= {:items [{:shape-id (str link-id) + :page-id (str page-id) + :url "https://phish.example/login"} + {:shape-id (str link-id) + :page-id (str page-id) + :url "https://quiet.example"}] + :truncated? false} + (:links projection))) + (t/is (= {:items [{:shape-id (str link-id) + :page-id (str page-id) + :event "click" + :action "open-url" + :target "https://phish.example/login"} + {:shape-id (str link-id) + :page-id (str page-id) + :event "click" + :action "navigate" + :target (str page-id)}] + :truncated? false} + (:interactions projection))))) + +(t/deftest projection-skips-blank-text-and-corrupt-content + (let [bad-id (uuid/random) + projection (mgmt.files/file->projection + (test-data + {text-id {:id text-id :type :text + :content {:type "root" + :children [{:type "paragraph" + :children [{:text " "}]}]}} + bad-id {:id bad-id :type :text + :content {:type "root" :children 42}}}))] + ;; Blank text contributes nothing; corrupt content skips the shape + ;; instead of failing the file. + (t/is (= {:items [] :truncated? false} (:texts projection))))) + +(t/deftest projection-truncates-links + (let [objects (into {} + (map (fn [i] + (let [id (uuid/random)] + [id {:id id :type :rect + :interactions [{:event-type :click + :action-type :open-url + :url (str "https://example.com/" i)}]}]))) + (range (inc mgmt.files/max-links))) + projection (mgmt.files/file->projection (test-data objects))] + (t/is (= mgmt.files/max-links (count (get-in projection [:links :items])))) + (t/is (true? (get-in projection [:links :truncated?]))) + (t/is (false? (get-in projection [:interactions :truncated?]))))) + +;; --- Management method (through the worker stack) + +(def text-content + {:type "root" + :children [{:type "paragraph-set" + :children [{:type "paragraph" + :children [{:text "cheap meds"}]}]}]}) + +(defn- create-file! + [profile-id project-id] + (let [out (th/command! {::th/type :create-file + ::rpc/profile-id profile-id + :project-id project-id + :name "Shop" + :is-shared false})] + (t/is (nil? (:error out))) + (get-in out [:result :id]))) + +(defn- file-page-id + [file-id] + (get-in (bfc/get-file th/*system* file-id) [:data :pages 0])) + +(defn- update-file! + [profile-id file-id page-id changes revn] + (let [out (th/command! {::th/type :update-file + ::rpc/profile-id profile-id + :id file-id + :session-id (uuid/random) + :revn revn + :vern 0 + :features cfeat/supported-features + :changes changes})] + (t/is (nil? (:error out))) + (:result out))) + +(defn- add-text-shape-change + [page-id shape-id] + [{:type :add-obj + :page-id page-id + :id shape-id + :parent-id uuid/zero + :frame-id uuid/zero + :components-v2 true + :obj (cts/setup-shape + {:id shape-id + :name "Buy now" + :frame-id uuid/zero + :parent-id uuid/zero + :type :text + :content text-content})}]) + +(t/deftest get-file-for-analysis-returns-projection + (let [profile (th/create-profile* 1 {:is-active true}) + team (th/create-team* 1 {:profile-id (:id profile)}) + project (th/create-project* 1 {:profile-id (:id profile) + :team-id (:id team)}) + file-id (create-file! (:id profile) (:id project)) + page-id (file-page-id file-id)] + ;; One edit so revn moves past zero and the file has content. + (update-file! (:id profile) file-id page-id + (add-text-shape-change page-id (uuid/random)) + 0) + (let [out (th/management-command! {::th/type :get-file-for-analysis + :file-id file-id})] + (t/is (nil? (:error out))) + (let [result (:result out)] + (t/is (= file-id (:id result))) + (t/is (= 1 (:revn result))) + (t/is (some? (:modified-at result))) + (t/is (= (:id project) (:project-id result))) + (t/is (= (:id team) (:team-id result))) + (t/is (false? (:has-share-link result))) + (t/is (= mgmt.files/projection-version (:projection-version result))) + (t/is (= "cheap meds" + (-> result :projection :texts :items first :text))))) + ;; A share link flips the share state, no re-edit needed. + (th/command! {::th/type :create-share-link + ::rpc/profile-id (:id profile) + :file-id file-id + :pages #{page-id} + :who-comment "all" + :who-inspect "all"}) + (let [out (th/management-command! {::th/type :get-file-for-analysis + :file-id file-id})] + (t/is (nil? (:error out))) + (t/is (true? (:has-share-link (:result out))))))) + +(t/deftest get-file-for-analysis-rejects-unknown-file + (let [out (th/management-command! {::th/type :get-file-for-analysis + :file-id (uuid/random)})] + (t/is (some? (:error out))) + (t/is (= :not-found (th/ex-type (:error out)))))) + +;; --- Audit prop coverage (through the commands, into real events) +;; +;; NOTE: the test system neutralizes `audit/submit`, so no audit row +;; is ever written. The observable contract of a command is the +;; metadata it sets on its result, which `prepare-rpc-event` turns +;; into the stored event: feed one into the other with the real +;; method metadata and assert the final props. + +(def mock-request + (reify + yetti.request/IRequest + (get-header [_ _] nil) + (remote-addr [_] "127.0.0.1"))) + +(defn- event-for + "Run a main RPC command and return the audit event it would emit." + [type params] + (let [[mdata _] (get-in th/*system* [:app.rpc/methods type]) + result (th/command-raw! (assoc params ::th/type type)) + params (-> params + (assoc ::rpc/request-id (uuid/next) + ::rpc/request-at (ct/now)) + (with-meta {:app.http/request mock-request})) + ;; In production the caller assocs the module before + ;; preparing the event; without it every name would come out + ;; with a leading dash. + cfg (assoc th/*system* ::rpc/module "main")] + (audit/prepare-rpc-event cfg mdata params result))) + +(t/deftest get-file-for-analysis-emits-audit-event + ;; Content reads stay traceable: with the skip gone, the call flows + ;; through `wrap-audit` like any other management method. `wrap-audit` + ;; itself is fixed at system init (no audit flags there), so assert the + ;; metadata flip plus the event shape through `prepare-rpc-event` with + ;; the real method metadata. + (let [profile (th/create-profile* 1 {:is-active true}) + team (th/create-team* 1 {:profile-id (:id profile)}) + project (th/create-project* 1 {:profile-id (:id profile) + :team-id (:id team)}) + file-id (create-file! (:id profile) (:id project)) + [mdata _] (get-in th/*system* [:app.rpc/management-methods :get-file-for-analysis])] + (t/is (not (::audit/skip mdata))) + (let [out (th/management-command! {::th/type :get-file-for-analysis + :file-id file-id}) + result (:result out) + params (-> {:file-id file-id} + (assoc ::rpc/request-id (uuid/next) + ::rpc/request-at (ct/now)) + (with-meta {:app.http/request mock-request})) + cfg (assoc th/*system* ::rpc/module "management") + event (audit/prepare-rpc-event cfg mdata params result)] + (t/is (nil? (:error out))) + (t/is (= "management-get-file-for-analysis" (:name event))) + (t/is (= file-id (get-in event [:props :file-id]))) + (t/is (= (:id team) (get-in event [:props :team-id])))))) + +(t/deftest file-events-carry-scheduling-props + (let [profile (th/create-profile* 2 {:is-active true}) + team (th/create-team* 2 {:profile-id (:id profile)}) + project (th/create-project* 2 {:profile-id (:id profile) + :team-id (:id team)}) + base {::rpc/profile-id (:id profile)}] + (t/testing "create-file" + (let [event (event-for :create-file + (assoc base + :project-id (:id project) + :name "Shop" + :is-shared false)) + props (:props event)] + (t/is (= "create-file" (:name event))) + (t/is (some? (:id props))) + (t/is (= "Shop" (:name props))) + (t/is (some? (:created-at props))) + (t/is (some? (:modified-at props))) + (t/is (= 0 (:revn props))))) + (t/testing "update-file" + ;; A file to edit, created through the command so the event + ;; below belongs to a real row. + (let [created (event-for :create-file + (assoc base + :project-id (:id project) + :name "Edit me" + :is-shared false)) + file-id (get-in created [:props :id]) + page-id (file-page-id file-id) + shape-id (uuid/random) + event (event-for :update-file + (assoc base + :id file-id + :session-id (uuid/random) + :revn 0 + :vern 0 + :features cfeat/supported-features + :changes [{:type :add-obj + :page-id page-id + :id shape-id + :parent-id uuid/zero + :frame-id uuid/zero + :components-v2 true + :obj (cts/setup-shape + {:id shape-id + :name "rect" + :frame-id uuid/zero + :parent-id uuid/zero + :type :rect})}])) + props (:props event)] + (t/is (= "update-file" (:name event))) + (t/is (= file-id (:id props))) + (t/is (= 1 (:revn props))) + (t/is (some? (:modified-at props))))) + (t/testing "share-link create and delete" + (let [created (event-for :create-file + (assoc base + :project-id (:id project) + :name "Shared" + :is-shared false)) + file-id (get-in created [:props :id]) + page-id (file-page-id file-id) + event (event-for :create-share-link + (assoc base + :file-id file-id + :pages #{page-id} + :who-comment "all" + :who-inspect "all")) + props (:props event) + slink-id (:share-id props)] + (t/is (= "create-share-link" (:name event))) + (t/is (= file-id (:file-id props))) + (t/is (some? slink-id)) + (let [event (event-for :delete-share-link + (assoc base :id slink-id)) + props (:props event)] + (t/is (= "delete-share-link" (:name event))) + (t/is (= file-id (:file-id props))) + (t/is (= slink-id (:share-id props)))))) + (t/testing "delete-file" + (let [created (event-for :create-file + (assoc base + :project-id (:id project) + :name "Doomed" + :is-shared false)) + file-id (get-in created [:props :id]) + event (event-for :delete-file + (assoc base :id file-id)) + props (:props event)] + (t/is (= "delete-file" (:name event))) + (t/is (= file-id (:id props))) + (t/is (some? (:deleted-at props))))))) diff --git a/backend/test/backend_tests/rpc_file_test.clj b/backend/test/backend_tests/rpc_file_test.clj index 2ac2bf8424..aadd976c2d 100644 --- a/backend/test/backend_tests/rpc_file_test.clj +++ b/backend/test/backend_tests/rpc_file_test.clj @@ -2782,3 +2782,36 @@ (t/is (th/ex-info? (:error out))) (t/is (th/ex-of-type? (:error out) :validation)) (t/is (th/ex-of-code? (:error out) :params-validation)))) + +(t/deftest delete-file-audit-event-carries-team-id + ;; The event already carries the project id, so the resolver could find the + ;; team; the command has the team row and sets the id without a lookup. + (let [profile (th/create-profile* 1 {:is-active true}) + team (th/create-team* 1 {:profile-id (:id profile)}) + project (th/create-project* 1 {:profile-id (:id profile) + :team-id (:id team)}) + file (th/create-file* 1 {:profile-id (:id profile) + :project-id (:id project)}) + wrapped (th/command-raw! {::th/type :delete-file + ::rpc/profile-id (:id profile) + :id (:id file)})] + (t/is (= (:id team) + (get-in (meta wrapped) [:app.loggers.audit/props :team-id]))))) + +(t/deftest create-file-audit-event-carries-its-id + ;; The command returns the new file but did not emit its id, so a consumer + ;; could not key a local projection. + (let [profile (th/create-profile* 1 {:is-active true}) + team (th/create-team* 1 {:profile-id (:id profile)}) + project (th/create-project* 1 {:profile-id (:id profile) + :team-id (:id team)}) + out (th/command! {::th/type :create-file + ::rpc/profile-id (:id profile) + :project-id (:id project) + :name "foobar" + :is-shared false})] + (t/is (th/success? out)) + (t/is (= (get-in out [:result :id]) + (get-in (meta (:result out)) [:app.loggers.audit/props :id]))) + (t/is (= (:id team) + (get-in (meta (:result out)) [:app.loggers.audit/props :team-id]))))) diff --git a/backend/test/backend_tests/rpc_management_nitrate_test.clj b/backend/test/backend_tests/rpc_management_nitrate_test.clj index a754e45b1c..30ff6a3823 100644 --- a/backend/test/backend_tests/rpc_management_nitrate_test.clj +++ b/backend/test/backend_tests/rpc_management_nitrate_test.clj @@ -1916,6 +1916,9 @@ :type "action"}]} params (with-meta params {::http/request http-request}) + ;; The profile setup above emits membership events; drop them so + ;; only the pushed events are counted below. + _ (th/reset-mock! audit-mock) out (th/management-command! params)] (t/is (nil? (:error out))) (t/is (:called? @audit-mock)) @@ -1936,6 +1939,9 @@ :profile-id (:id prof)}]} params (with-meta params {::http/request http-request}) + ;; The profile setup above emits membership events; drop them so + ;; only the pushed events are asserted below. + _ (th/reset-mock! audit-mock) out (th/management-command! params)] (t/is (nil? (:error out))) (let [[_ event] (:call-args @audit-mock)] @@ -1955,6 +1961,9 @@ :type "action"}]} params (with-meta params {::http/request http-request}) + ;; The profile setup above emits membership events; drop them so + ;; only the pushed events are counted below. + _ (th/reset-mock! audit-mock) out (th/management-command! params)] (t/is (nil? (:error out))) (t/is (= 2 (:call-count @audit-mock))) @@ -1974,6 +1983,9 @@ :foo "bar"}}]} params (with-meta params {::http/request http-request}) + ;; The profile setup above emits membership events; drop them so + ;; only the pushed events are asserted below. + _ (th/reset-mock! audit-mock) out (th/management-command! params)] (t/is (nil? (:error out))) (let [[_ event] (:call-args @audit-mock)] @@ -1998,6 +2010,9 @@ params (with-meta params {::http/request (assoc http-request ::http/auth-key-id :admin-console)}) + ;; The profile setup above emits membership events; drop them so + ;; only the pushed events are asserted below. + _ (th/reset-mock! audit-mock) out (th/management-command! params)] (t/is (nil? (:error out))) (let [[_ event] (:call-args @audit-mock)] diff --git a/backend/test/backend_tests/rpc_management_test.clj b/backend/test/backend_tests/rpc_management_test.clj index 4b449af993..e1f6e81950 100644 --- a/backend/test/backend_tests/rpc_management_test.clj +++ b/backend/test/backend_tests/rpc_management_test.clj @@ -9,6 +9,7 @@ [app.binfile.common :as bfc] [app.common.features :as cfeat] [app.common.pprint :as pp] + [app.common.time :as ct] [app.common.types.shape :as cts] [app.common.uuid :as uuid] [app.config :as cf] @@ -22,7 +23,8 @@ [clojure.test :as t] [cuerdas.core :as str] [datoteka.fs :as fs] - [datoteka.io :as io])) + [datoteka.io :as io] + [mockery.core :refer [with-mocks]])) (t/use-fixtures :once th/state-init) (t/use-fixtures :each th/database-reset) @@ -666,3 +668,55 @@ (t/is (vector? result)) (t/is (= 1 (count result))) (t/is (= "test" (:id (first result))))))) + +(t/deftest clone-template-audit-events-carry-team-id + ;; The per-file `create-file` events are built by hand, so they do not pass + ;; through the generic resolver: the command must copy the team id itself. + (with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}] + (with-redefs [cf/flags (conj cf/flags :audit-log)] + (let [prof (th/create-profile* 1 {:is-active true}) + team (th/create-team* 1 {:profile-id (:id prof)}) + project (th/create-project* 1 {:profile-id (:id prof) + :team-id (:id team)}) + out (th/command! {::th/type :clone-template + ::rpc/profile-id (:id prof) + :project-id (:id project) + :template-id "test"})] + (t/is (th/success? out)) + (th/consume-sse (:result out)) + (let [events (->> (:call-args-list @audit-mock) + (map second) + (filter #(= "create-file" (:name %))))] + (t/is (seq events)) + (t/is (every? #(= (:id team) (get-in % [:props :team-id])) events))))))) + +(t/deftest duplicate-project-audit-events-carry-entity-ids + ;; The duplicated project and files are created by internal calls, so the + ;; command emits one create event per entity for a local projection. + (with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}] + (with-redefs [cf/flags (conj cf/flags :audit-log)] + (let [profile (th/create-profile* 1 {:is-active true}) + team (th/create-team* 52 {:profile-id (:id profile)}) + project (th/create-project* 52 {:profile-id (:id profile) + :team-id (:id team)}) + _file (th/create-file* 52 {:profile-id (:id profile) + :project-id (:id project)}) + out (th/command! {::th/type :duplicate-project + ::rpc/profile-id (:id profile) + :project-id (:id project) + :name "copy"}) + events (->> (:call-args-list @audit-mock) + (map second) + (filter #(contains? #{"create-project" "create-file"} (:name %))))] + (t/is (th/success? out)) + (t/is (some #(and (= "create-project" (:name %)) + (= (get-in out [:result :id]) (get-in % [:props :id])) + (= (:id team) (get-in % [:props :team-id])) + (= "copy" (get-in % [:props :name]))) + events)) + (t/is (some #(and (= "create-file" (:name %)) + (string? (get-in % [:props :name])) + (int? (get-in % [:props :revn])) + (ct/inst? (get-in % [:props :modified-at]))) + events)) + (t/is (every? #(= (:id team) (get-in % [:props :team-id])) events)))))) diff --git a/backend/test/backend_tests/rpc_media_test.clj b/backend/test/backend_tests/rpc_media_test.clj index fb34396a09..985fb68fc2 100644 --- a/backend/test/backend_tests/rpc_media_test.clj +++ b/backend/test/backend_tests/rpc_media_test.clj @@ -1226,3 +1226,27 @@ (t/is (th/ex-info? (:error out))) (t/is (th/ex-of-type? (:error out) :validation)) (t/is (th/ex-of-code? (:error out) :params-validation)))) + +(t/deftest media-audit-event-carries-team-id + ;; The media event carries the file id, so the resolver could find the team; + ;; the command already resolved the team for the quota check and sets it. + (let [prof (th/create-profile* 1) + team (th/create-team* 1 {:profile-id (:id prof)}) + project (th/create-project* 1 {:profile-id (:id prof) + :team-id (:id team)}) + file (th/create-file* 1 {:profile-id (:id prof) + :project-id (:id project) + :is-shared false}) + mfile {:filename "sample.jpg" + :path (th/tempfile "backend_tests/test_files/sample.jpg") + :mtype "image/jpeg" + :size 312043} + out (th/command! {::th/type :upload-file-media-object + ::rpc/profile-id (:id prof) + :file-id (:id file) + :is-local true + :name "testfile" + :content mfile})] + (t/is (th/success? out)) + (t/is (= (:id team) + (get-in (meta (:result out)) [:app.loggers.audit/replace-props :team-id]))))) diff --git a/backend/test/backend_tests/rpc_profile_test.clj b/backend/test/backend_tests/rpc_profile_test.clj index 1bfb54aeee..6200261e86 100644 --- a/backend/test/backend_tests/rpc_profile_test.clj +++ b/backend/test/backend_tests/rpc_profile_test.clj @@ -1802,3 +1802,30 @@ (t/is (th/success? out)) (t/is (= (:id member) event-pid)) (t/is (not= (:id owner) event-pid)))))) + +(t/deftest delete-profile-audit-event-carries-profile-data + ;; The event used to carry empty props because every param is namespaced and + ;; clean-props drops them; the projection needs the deleted identity. + (let [profile (th/create-profile* 1 {:is-active true}) + out (th/command-raw! {::th/type :delete-profile + ::rpc/profile-id (:id profile)}) + props (:app.loggers.audit/props (meta out))] + (t/is (= (:id profile) (:id props))) + (t/is (= "profile1.test@nodomain.com" (:email props))) + (t/is (= "Profile 1" (:fullname props))) + (t/is (ct/inst? (:created-at props))) + (t/is (ct/inst? (:modified-at props))) + (t/is (ct/inst? (:deleted-at props))))) + +(t/deftest delete-profile-is-idempotent + ;; Deleting an already-deleted profile (client retry after a lost response) + ;; succeeds: the row is still there, only marked. + (let [profile (th/create-profile* 1 {:is-active true}) + params {::th/type :delete-profile + ::rpc/profile-id (:id profile)} + first-out (th/command-raw! params)] + (t/is (th/success? first-out)) + (let [second-out (th/command-raw! params)] + (t/is (th/success? second-out)) + (t/is (= (:id profile) + (get-in (meta second-out) [:app.loggers.audit/props :id])))))) diff --git a/backend/test/backend_tests/rpc_project_test.clj b/backend/test/backend_tests/rpc_project_test.clj index f5855a43e8..c27bb31868 100644 --- a/backend/test/backend_tests/rpc_project_test.clj +++ b/backend/test/backend_tests/rpc_project_test.clj @@ -274,3 +274,16 @@ (t/is (th/ex-info? (:error out))) (t/is (th/ex-of-type? (:error out) :validation)) (t/is (th/ex-of-code? (:error out) :params-validation)))) + +(t/deftest create-project-audit-event-carries-its-id + ;; The command returns the new project but did not emit its id, so a consumer + ;; could not key a local projection. + (let [profile (th/create-profile* 1) + team (th/create-team* 1 {:profile-id (:id profile)}) + out (th/command! {::th/type :create-project + ::rpc/profile-id (:id profile) + :team-id (:id team) + :name "test project"})] + (t/is (th/success? out)) + (t/is (= (get-in out [:result :id]) + (get-in (meta (:result out)) [:app.loggers.audit/props :id]))))) diff --git a/backend/test/backend_tests/rpc_team_test.clj b/backend/test/backend_tests/rpc_team_test.clj index ed6520b815..991b380548 100644 --- a/backend/test/backend_tests/rpc_team_test.clj +++ b/backend/test/backend_tests/rpc_team_test.clj @@ -6,8 +6,10 @@ (ns backend-tests.rpc-team-test (:require + [app.common.data :as d] [app.common.logging :as l] [app.common.time :as ct] + [app.common.types.team :as types.team] [app.common.uuid :as uuid] [app.config :as cf] [app.db :as db] @@ -16,6 +18,7 @@ [app.nitrate :as nitrate] [app.rpc :as-alias rpc] [app.rpc.commands.teams :as teams] + [app.rpc.helpers :as rph] [app.storage :as sto] [app.tokens :as tokens] [backend-tests.helpers :as th] @@ -1751,3 +1754,195 @@ ::rpc/profile-id (:id stranger)})] (t/is (th/success? out)) (t/is (nil? (some #(= (:id project) (:id %)) (:result out)))))))) + +(t/deftest create-team-emits-add-team-member-audit-event + ;; Team creation adds the owner through add-profile-to-team!, which used to + ;; leave no membership event. + (with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}] + (with-redefs [cf/flags (conj cf/flags :audit-log)] + (let [owner (th/create-profile* 1 {:is-active true}) + team (th/create-team* 21 {:profile-id (:id owner)}) + events (->> (:call-args-list @audit-mock) + (map second) + (filter #(= "add-team-member" (:name %))) + (filter #(= (:id team) (get-in % [:props :team-id]))))] + (t/is (= 1 (count events))) + (t/is (= (:id owner) (get-in (first events) [:props :member-id]))) + (t/is (true? (get-in (first events) [:props :is-owner]))))))) + +(t/deftest add-team-member-event-skipped-when-membership-exists + ;; Adding an existing member with on-conflict-do-nothing inserts nothing and + ;; must not report a membership that already exists. + (with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}] + (with-redefs [cf/flags (conj cf/flags :audit-log)] + (let [owner (th/create-profile* 1 {:is-active true}) + team (th/create-team* 22 {:profile-id (:id owner)})] + (th/reset-mock! audit-mock) + (db/tx-run! th/*system* + (fn [cfg] + (teams/add-profile-to-team! cfg + {:team-id (:id team) + :profile-id (:id owner)} + {::db/on-conflict-do-nothing? true}))) + (t/is (empty? (:call-args-list @audit-mock))))))) + +(t/deftest no-add-team-member-event-without-audit-log + (with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}] + (let [owner (th/create-profile* 1 {:is-active true}) + _team (th/create-team* 23 {:profile-id (:id owner)}) + events (->> (:call-args-list @audit-mock) + (map second) + (filter #(= "add-team-member" (:name %))))] + (t/is (empty? events))))) + +(t/deftest add-team-member-event-carries-derived-role + ;; `team_profile_rel` has no role column, so no caller can pass it: the + ;; emitter derives it from the flags, inverse of permissions-for-role. + (with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}] + (with-redefs [cf/flags (conj cf/flags :audit-log)] + (let [owner (th/create-profile* 1 {:is-active true}) + team (th/create-team* 26 {:profile-id (:id owner)}) + editor (th/create-profile* 27 {:is-active true}) + admin (th/create-profile* 28 {:is-active true}) + viewer (th/create-profile* 29 {:is-active true})] + (db/tx-run! th/*system* + (fn [cfg] + (doseq [[member role] [[editor :editor] + [admin :admin] + [viewer :viewer]]] + (teams/add-profile-to-team! + cfg + (merge {:team-id (:id team) + :profile-id (:id member)} + (get types.team/permissions-for-role role)))))) + (let [by-member (->> (:call-args-list @audit-mock) + (map second) + (filter #(= "add-team-member" (:name %))) + (d/index-by #(get-in % [:props :member-id])))] + (t/is (= :owner (get-in by-member [(:id owner) :props :role]))) + (t/is (= :editor (get-in by-member [(:id editor) :props :role]))) + (t/is (= :admin (get-in by-member [(:id admin) :props :role]))) + (t/is (= :viewer (get-in by-member [(:id viewer) :props :role])))))))) + +(t/deftest add-team-member-event-carries-request-context + ;; Sibling events built by `prepare-rpc-event` carry the request context; + ;; the hand-built membership event must not lose it when rpc params travel. + (with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}] + (with-redefs [cf/flags (conj cf/flags :audit-log)] + (let [owner (th/create-profile* 1 {:is-active true}) + member (th/create-profile* 2 {:is-active true}) + team (th/create-team* 30 {:profile-id (:id owner)})] + (th/reset-mock! audit-mock) + (db/tx-run! th/*system* + (fn [cfg] + (teams/add-profile-to-team! + cfg + (merge {:team-id (:id team) + :profile-id (:id member)} + (get types.team/permissions-for-role :editor)) + nil + {:rpc-params {::rpc/profile-id (:id owner) + ::rpc/request-id "req-1"}}))) + (let [events (->> (:call-args-list @audit-mock) + (map second) + (filter #(= "add-team-member" (:name %))))] + (t/is (= 1 (count events))) + (t/is (= "req-1" (get-in (first events) [:context :request-id])))))))) + +(t/deftest invitation-direct-add-attributes-event-to-inviter + ;; With email verification off, inviting an existing profile adds the + ;; member directly; the event belongs to the inviter, not the member. + (with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil}] + (with-redefs [cf/flags #{:audit-log}] + (let [owner (th/create-profile* 1 {:is-active true}) + member (th/create-profile* 2 {:is-active true}) + team (th/create-team* 31 {:profile-id (:id owner)})] + (th/reset-mock! audit-mock) + (let [out (th/command! {::th/type :create-team-invitations + ::rpc/profile-id (:id owner) + :team-id (:id team) + :role :editor + :emails [(:email member)]})] + (t/is (th/success? out)) + (let [events (->> (:call-args-list @audit-mock) + (map second) + (filter #(= "add-team-member" (:name %))) + (filter #(= (:id member) (get-in % [:props :member-id]))))] + (t/is (= 1 (count events))) + (t/is (= (:id owner) (:profile-id (first events)))) + (t/is (= :editor (get-in (first events) [:props :role]))))))))) + +(t/deftest create-team-audit-event-carries-created-at + ;; The projection keys the new team on the event id and needs its creation + ;; time from the same event. + (let [profile (th/create-profile* 1 {:is-active true}) + out (th/command-raw! {::th/type :create-team + ::rpc/profile-id (:id profile) + :name "team"}) + props (:app.loggers.audit/props (meta out))] + (t/is (= (:id out) (:id props))) + (t/is (= (:created-at out) (:created-at props))) + (t/is (ct/inst? (:created-at props))) + (t/is (= (:modified-at out) (:modified-at props))) + (t/is (ct/inst? (:modified-at props))))) + +(t/deftest delete-team-audit-event-carries-entity-data + ;; The projection marks the team deleted from this single event, so it needs + ;; the identity, the name and the timestamps. + (let [profile (th/create-profile* 1 {:is-active true}) + team (th/create-team* 31 {:profile-id (:id profile)}) + out (th/command-raw! {::th/type :delete-team + ::rpc/profile-id (:id profile) + :id (:id team)}) + props (:app.loggers.audit/props (meta out))] + ;; The API response is unchanged: the command still returns nil. + (t/is (nil? (rph/unwrap out))) + (t/is (= (:id team) (:id props))) + (t/is (= (:name team) (:name props))) + (t/is (= (:created-at team) (:created-at props))) + (t/is (ct/inst? (:modified-at props))) + (t/is (ct/inst? (:deleted-at props))))) + +(t/deftest create-team-with-invitations-audit-event-carries-team-id + ;; The team is created by an internal call, so both the command event and + ;; the manual event must carry its id for a projection to key it. + (with-mocks [audit-mock {:target 'app.loggers.audit/submit :return nil} + email-mock {:target 'app.email/send! :return nil}] + (with-redefs [cf/flags (conj cf/flags :audit-log)] + (let [profile (th/create-profile* 1 {:is-active true}) + out (th/command-raw! {::th/type :create-team-with-invitations + ::rpc/profile-id (:id profile) + :name "team" + :emails #{"invitee@example.com"} + :role :editor}) + props (:app.loggers.audit/props (meta out)) + events (->> (:call-args-list @audit-mock) + (map second) + (filter #(= "create-team" (:name %))))] + (t/is (= (:id out) (:id props))) + (t/is (= 1 (count events))) + (t/is (= (:id out) (get-in (first events) [:props :id]))))))) + +(t/deftest update-team-member-role-to-owner-names-demoted-member + ;; Promoting a member to owner demotes the actor; the event names them so a + ;; projection can keep a single owner. + (let [owner (th/create-profile* 1 {:is-active true}) + editor (th/create-profile* 2 {:is-active true}) + team (th/create-team* 82 {:profile-id (:id owner)})] + (th/create-team-role* {:team-id (:id team) + :profile-id (:id editor) + :role :editor}) + (let [out (th/command-raw! {::th/type :update-team-member-role + ::rpc/profile-id (:id owner) + :team-id (:id team) + :member-id (:id editor) + :role :editor}) + props (:app.loggers.audit/props (meta out))] + (t/is (nil? (:prev-owner-id props)))) + (let [out (th/command-raw! {::th/type :update-team-member-role + ::rpc/profile-id (:id owner) + :team-id (:id team) + :member-id (:id editor) + :role :owner}) + props (:app.loggers.audit/props (meta out))] + (t/is (= (:id owner) (:prev-owner-id props)))))) diff --git a/backend/test/backend_tests/rpc_webhooks_test.clj b/backend/test/backend_tests/rpc_webhooks_test.clj index 5b15d46111..de5227aeb2 100644 --- a/backend/test/backend_tests/rpc_webhooks_test.clj +++ b/backend/test/backend_tests/rpc_webhooks_test.clj @@ -374,3 +374,29 @@ (t/is (nil? (:result out))) (let [rows (th/db-exec! ["select * from webhook"])] (t/is (= 0 (count rows))))))))))) + +(t/deftest webhook-audit-events-carry-team-id + ;; `update-webhook` and `delete-webhook` have no team id in their params, so + ;; the command copies it from the stored webhook into the audit props. + (with-mocks [http-mock {:target 'app.http.client/req :return {:status 200}}] + (let [prof (th/create-profile* 1 {:is-active true}) + team (th/create-team* 1 {:profile-id (:id prof)}) + whook (-> (th/command! {::th/type :create-webhook + ::rpc/profile-id (:id prof) + :team-id (:id team) + :uri (u/uri "http://example.com") + :mtype "application/json"}) + :result) + upd (th/command! {::th/type :update-webhook + ::rpc/profile-id (:id prof) + :id (:id whook) + :uri (u/uri "http://example.com/updated") + :mtype "application/json" + :is-active true}) + del (th/command-raw! {::th/type :delete-webhook + ::rpc/profile-id (:id prof) + :id (:id whook)})] + (t/is (= (:id team) + (get-in (meta (:result upd)) [:app.loggers.audit/props :team-id]))) + (t/is (= (:id team) + (get-in (meta del) [:app.loggers.audit/props :team-id])))))) diff --git a/backend/test/backend_tests/srepl_main_test.clj b/backend/test/backend_tests/srepl_main_test.clj index 1e2add5361..aebc99c9bf 100644 --- a/backend/test/backend_tests/srepl_main_test.clj +++ b/backend/test/backend_tests/srepl_main_test.clj @@ -11,7 +11,8 @@ [app.system :as sys] [app.worker :as wrk] [backend-tests.helpers :as th] - [clojure.test :as t])) + [clojure.test :as t] + [mockery.core :refer [with-mocks]])) (t/use-fixtures :once th/state-init) (t/use-fixtures :each th/database-reset) @@ -150,3 +151,57 @@ #(srepl/process-deleted-files-cascade :ids [(:id file)]))] (t/is (= [{:object :file :id (:id file)}] (mapv #(select-keys % [:object :id]) (params-of submitted)))))))))) + +(t/deftest delete-profile-emits-identifiable-audit-event + ;; SREPL has no actor, so the event profile stays zero; the subject id in + ;; props is what makes the row attributable. Both insert and cascade are + ;; mocked, so this has no side effects. + (with-mocks [audit-mock {:target 'app.loggers.audit/insert :return nil} + wrk-mock {:target 'app.worker/invoke! :return nil}] + (let [profile (th/create-profile* 1 {:is-active true})] + (srepl/delete-profile! (str (:id profile))) + (let [events (->> (:call-args-list @audit-mock) + (map second))] + (t/is (= 1 (count events))) + (let [event (first events)] + (t/is (= "delete-profile" (:name event))) + (t/is (= "action" (:type event))) + ;; No actor on SREPL calls; insert defaults the missing profile + ;; to the zero one. + (t/is (nil? (:profile-id event))) + (t/is (= (:id profile) (get-in event [:props :id])))))))) + +(t/deftest delete-team-emits-identifiable-audit-event + (with-mocks [audit-mock {:target 'app.loggers.audit/insert :return nil} + wrk-mock {:target 'app.worker/invoke! :return nil}] + (let [profile (th/create-profile* 1 {:is-active true}) + team (th/create-team* 95 {:profile-id (:id profile)})] + (srepl/delete-team! (str (:id team))) + (let [events (->> (:call-args-list @audit-mock) + (map second))] + (t/is (= 1 (count events))) + (let [event (first events)] + (t/is (= "delete-team" (:name event))) + (t/is (= "action" (:type event))) + (t/is (= (:id team) (get-in event [:props :id]))) + (t/is (= "explicit call to delete-team!" + (get-in event [:context :cause])))))))) + +(t/deftest restore-profile-emits-identifiable-audit-event + ;; SREPL has no actor, so the event profile stays zero; the subject id in + ;; props is what makes the row attributable. + (with-mocks [audit-mock {:target 'app.loggers.audit/insert :return nil} + wrk-mock {:target 'app.worker/invoke! :return nil}] + (with-redefs [sys/system th/*system*] + (let [profile (th/create-profile* 1 {:is-active true})] + (srepl/restore-profile! (str (:id profile))) + (let [events (->> (:call-args-list @audit-mock) + (map second))] + (t/is (= 1 (count events))) + (let [event (first events)] + (t/is (= "restore-profile" (:name event))) + (t/is (= "action" (:type event))) + ;; No actor on SREPL calls; insert defaults the missing profile + ;; to the zero one. + (t/is (nil? (:profile-id event))) + (t/is (= (:id profile) (get-in event [:props :id]))))))))) From 0d9b1c48fc1c06f7401161b6c577f172449d0667 Mon Sep 17 00:00:00 2001 From: Eva Marco Date: Thu, 15 Oct 2026 13:23:54 +0200 Subject: [PATCH 06/16] :bug: Fix legacy path migration crash on paths without points (#12357) The legacy-6 migration read the rect of each path from its points and checked whether the width or height was close to zero. A path with missing or empty points has no rect, so the check got nil and threw a NullPointerException. The migration then failed on every load of that file, and get-team-shared-files returned 500 for the whole team, so the "Add library" modal could not open. Treat a missing rect like a degenerate one and rebuild the selrect and points from the path content. Closes #12343 AI-assisted-by: claude-opus-5-5 --- common/src/app/common/files/migrations.cljc | 6 ++- .../common_tests/files_migrations_test.cljc | 42 +++++++++++++++++++ 2 files changed, 46 insertions(+), 2 deletions(-) diff --git a/common/src/app/common/files/migrations.cljc b/common/src/app/common/files/migrations.cljc index dbe0b0abd7..adc25e6cf6 100644 --- a/common/src/app/common/files/migrations.cljc +++ b/common/src/app/common/files/migrations.cljc @@ -223,8 +223,10 @@ [data _] (letfn [(fix-line-paths [shape] (if (= (:type shape) :path) - (let [{:keys [width height]} (grc/points->rect (:points shape))] - (if (or (mth/almost-zero? width) (mth/almost-zero? height)) + ;; A path with missing or empty points has no rect; rebuild + ;; its geometry from the content as for line-like paths. + (let [{:keys [width height] :as rect} (grc/points->rect (:points shape))] + (if (or (nil? rect) (mth/almost-zero? width) (mth/almost-zero? height)) (let [selrect (path.segment/content->selrect (:content shape)) points (grc/rect->points selrect) transform (gmt/matrix) diff --git a/common/test/common_tests/files_migrations_test.cljc b/common/test/common_tests/files_migrations_test.cljc index 0ac8084708..b76f4f369c 100644 --- a/common/test/common_tests/files_migrations_test.cljc +++ b/common/test/common_tests/files_migrations_test.cljc @@ -605,3 +605,45 @@ data' (cfm/migrate-data data migration-id)] (t/is (= [child-id] (get-in data' [:components component-id :objects main-id :shapes]))))) + +(defn- make-path-shape + [shape-id] + (cts/setup-shape {:id shape-id + :type :path + :content [{:command :move-to :params {:x 10 :y 20}} + {:command :line-to :params {:x 110 :y 70}}]})) + +(t/deftest migration-legacy-6-repairs-paths-without-points + (let [migration-id "legacy-6" + page-id (uuid/next) + shape-id (uuid/next) + shape (make-path-shape shape-id)] + + (doseq [points [nil []]] + (let [data {:pages-index {page-id {:objects {shape-id (assoc shape :points points)}}}} + data' (cfm/migrate-data data migration-id) + shape' (get-in data' [:pages-index page-id :objects shape-id])] + + (t/is (= (:points shape) (:points shape')) + (str "points rebuilt from content when they were " (pr-str points))) + (t/is (= (:selrect shape) (:selrect shape')) + "selrect rebuilt from content"))))) + +(t/deftest migration-legacy-6-runs-through-file-migration + ;; A file saved before version 6 runs every migration from legacy-6 on, + ;; and the whole chain must succeed for the file to load. + (let [migration-id "legacy-6" + shape-id (uuid/next) + file (ctf/make-file {:name "Legacy path without points"}) + page-id (first (get-in file [:data :pages])) + shape (-> (make-path-shape shape-id) + (assoc :points [])) + file (-> file + (dissoc :migrations) + (assoc :version 5) + (assoc-in [:data :pages-index page-id :objects shape-id] shape)) + file' (cfm/migrate-file file (delay {}))] + + (t/is (contains? (:migrations file') migration-id) "migration id persisted") + (t/is (= 4 (count (get-in file' [:data :pages-index page-id :objects shape-id :points]))) + "path points repaired before schema validation"))) From 1783f9380d07a0dd6ae980cad9b979a65d39e69f Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Thu, 15 Oct 2026 14:18:57 +0200 Subject: [PATCH 07/16] :sparkles: Scan upload-session chunks in storage gc-touched (#12305) Route upload-session chunk liveness through the mark-time reference scan instead of the delete-time cleanup in gc-deleted. gc-touched now checks upload_session_chunk before marking a chunk, so referenced chunks freeze and only orphans are marked. The freeze path re-verifies references under row locks, which also closes the stale-freeze race for every scanned bucket. gc-deleted drops its upload-session special case: deferred rows keep their mappings until the final give-up, and a live reference aborts the chunk loud. Closes #12302 AI-assisted-by: muse-spark-1.3-contributor --- .serena/memories/backend/storage.md | 5 +- backend/src/app/storage/gc_deleted.clj | 30 +--- backend/src/app/storage/gc_touched.clj | 53 +++++- backend/test/backend_tests/rpc_font_test.clj | 6 +- backend/test/backend_tests/storage_test.clj | 169 ++++++++++++++++++- 5 files changed, 227 insertions(+), 36 deletions(-) diff --git a/.serena/memories/backend/storage.md b/.serena/memories/backend/storage.md index 3d978642df..816e254b2b 100644 --- a/.serena/memories/backend/storage.md +++ b/.serena/memories/backend/storage.md @@ -25,8 +25,9 @@ - Existing object values can remain readable until physical deletion. - `:expired-at` blocks reads after the expiration time. - `del-object!` sets `deleted_at` on live rows only (`deleted_at IS NULL`): a repeated call returns `false`. It does not remove backend content. -- `storage-gc-deleted` removes the database row and backend content after the deletion delay, streaming the pending rows with `db/plan` inside a read-only transaction and deleting them in chunks of 25, each chunk in its own transaction: a chunk that fails (for example, an object a foreign key still references) is logged and skipped instead of aborting the run. A physical-deletion failure inside a chunk defers its rows one day (`deletion_attempts + 1`) and gives up after 7 attempts, accepting the orphan blob; chunk mappings (`upload_session_chunk`) are removed before the `storage_object` rows (NO ACTION foreign keys). +- `storage-gc-deleted` removes the database row and backend content after the deletion delay, streaming the pending rows with `db/plan` inside a read-only transaction and deleting them in chunks of 25, each chunk in its own transaction: a chunk that fails (for example, an object a foreign key still references) is logged and skipped instead of aborting the run. A physical-deletion failure inside a chunk defers its rows one day (`deletion_attempts + 1`) and gives up after 7 attempts, accepting the orphan blob. Deferred rows keep their references until the final give-up. The freeze path re-verifies references under row locks, so a concurrent purge can delay a freeze but never swallow a touch. - `storage-gc-touched` finds references before it sets `deleted_at`. +- Orphan watch: `SELECT COALESCE(metadata->>'bucket', metadata->>'~:bucket') AS bucket, count(*) FROM storage_object so WHERE touched_at IS NULL AND deleted_at IS NULL AND status = 'valid' AND NOT EXISTS (SELECT 1 FROM upload_session_chunk usc WHERE usc.object_id = so.id) GROUP BY 1;` Only the `upload-session` row of that output is a leak signal (its rows always have a mapping or a pending touch/deleted mark); other buckets use domain-table references, not this mapping. - `objects-gc` removes deleted domain rows and touches their storage object IDs. Each proc streams its pending keys with `db/plan` inside a read-only transaction and deletes them in chunks, each chunk in its own transaction with `FOR UPDATE SKIP LOCKED`: a chunk that fails is logged and skipped instead of aborting the run. - Use `::db/reuse-conn true` with `sto/resolve` inside a database transaction. @@ -83,7 +84,7 @@ Since `put-object!` uses backend-specific operations (`impl/resolve-backend` + ` | `profile` | User and team profile photos. References: `profile.photo_id` and `team.photo_id`. | Yes | Authentication required | Reference scan. | | `organization` | Organization logos uploaded by the Nitrate management API. | Yes | Public | No reference scan. A touched object is deleted. | | `tempfile` | Export files and temporary font downloads. | No | Authentication required | No reference scan. A touched object uses a two-hour deletion delay. | -| `upload-session` | Chunked-upload chunks. References: `upload_session_chunk.object_id` and `upload_session_chunk.session_id` (both NO ACTION DEFERRABLE: restrict semantics, procedural deletion). | No | Authentication required | No reference scan. A touched object is deleted after the delay; `gc-deleted` removes mappings before rows. | +| `upload-session` | Chunked-upload chunks. References: `upload_session_chunk.object_id` and `upload_session_chunk.session_id` (both NO ACTION DEFERRABLE: restrict semantics, procedural deletion). | No | Authentication required | Reference scan on `upload_session_chunk.object_id`; a referenced chunk freezes, an orphan is deleted after the delay. Deferred rows keep their mappings until give-up. | | `file-data` | Encoded file data when `file-data-backend` is `storage`. Reference metadata has `storage-ref-id`, `file-id`, and the `file_data` row ID. | Yes | Authentication required | Reference scan. | | `file-data-fragment` | Compatibility value for file-data fragments. The current backend has no dedicated producer for this bucket. | No current write semantics | Public | No touched-object collector case. | | `file-change` | Compatibility value for file changes. Current snapshots store data in `file_data`, not this bucket. | No current write semantics | Authentication required | No touched-object collector case. | diff --git a/backend/src/app/storage/gc_deleted.clj b/backend/src/app/storage/gc_deleted.clj index 6c7e419676..22677ab429 100644 --- a/backend/src/app/storage/gc_deleted.clj +++ b/backend/src/app/storage/gc_deleted.clj @@ -57,18 +57,6 @@ (-> (db/exec-one! conn [sql:delete-sobjects ids]) (db/get-update-count)))) -(def ^:private sql:delete-upload-session-chunks - "DELETE FROM upload_session_chunk - WHERE object_id = ANY(?::uuid[])") - -(defn- delete-upload-session-chunks - "Remove the chunk mappings for the given storage object ids. This must run - before the storage_object rows are deleted: the upload_session_chunk - foreign keys are ON DELETE NO ACTION." - [conn ids] - (let [ids (db/create-array conn "uuid" ids)] - (db/exec-one! conn [sql:delete-upload-session-chunks ids]))) - (def ^:private sql:increment-attempts-and-defer "UPDATE storage_object SET deletion_attempts = deletion_attempts + 1, @@ -117,21 +105,17 @@ :backend (name backend-id))) (when (seq ok-ids) - ;; NOTE: the chunk mappings must be removed before the - ;; storage_object rows (NO ACTION foreign keys). It only affects - ;; objects of the upload-session bucket; for any other bucket the - ;; delete matches no rows. - (delete-upload-session-chunks conn ok-ids) + ;; NOTE: rows arrive here with no live references (the mark-time + ;; scan in gc-touched owns that check, also for the upload-session + ;; bucket). If a NO ACTION reference still exists, this DELETE + ;; aborts the chunk loud instead of breaking anyone silently. (delete-sobjects conn ok-ids)) (when (seq fail-ids) + ;; NOTE: deferred rows keep both their row and their references + ;; (upload-session mappings included) until the final give-up, so + ;; a backend outage does not break live sessions. (increment-attempts-and-defer conn fail-ids) - ;; NOTE: same NO ACTION ordering as above: the give-up DELETE below - ;; removes storage_object rows, so chunk mappings must go first. - ;; Deferred objects keep their rows; only the mapping of a - ;; permanently given-up object disappears early, and that object is - ;; already deleted-marked. - (delete-upload-session-chunks conn fail-ids) (let [given-up (delete-give-up conn fail-ids)] (when (pos? (db/get-update-count given-up)) (l/wrn :hint "giving up on orphan blob after max attempts" diff --git a/backend/src/app/storage/gc_touched.clj b/backend/src/app/storage/gc_touched.clj index f73b6024f1..104f9b7f17 100644 --- a/backend/src/app/storage/gc_touched.clj +++ b/backend/src/app/storage/gc_touched.clj @@ -77,6 +77,15 @@ (-> (db/exec-one! conn [sql:has-file-thumbnail-refs id]) (get :has-refs))) +(def ^:private + sql:has-upload-session-chunk-refs + "SELECT EXISTS (SELECT 1 FROM upload_session_chunk WHERE object_id = ?) AS has_refs") + +(defn- has-upload-session-chunk-refs? + [conn {:keys [id]}] + (-> (db/exec-one! conn [sql:has-upload-session-chunk-refs id]) + (get :has-refs))) + (def sql:exists-file-data-refs "SELECT EXISTS ( SELECT 1 FROM file_data @@ -146,6 +155,31 @@ :id (str id)) sto/default-bucket))) +(def ^:private sql:lock-storage-objects + "SELECT id FROM storage_object WHERE id = ANY(?::uuid[]) ORDER BY id FOR UPDATE") + +(defn- verify-frozen + "Re-checks, holding the row locks, that the about-to-freeze objects are + still referenced. A concurrent purge (mapping delete plus touch) either + commits before the check and the object moves to deletion, or blocks on + the lock and its touch wins last, so no touch is ever swallowed by a + stale freeze. Ids are locked in order to avoid lock-order inversions + between workers. Returns [still-frozen-ids now-deletable-ids]." + [conn has-refs? bucket objects] + (let [by-id (into {} (map (juxt :id identity)) objects) + ids (db/create-array conn "uuid" (sort (keys by-id))) + locked (into #{} (map :id) (db/exec! conn [sql:lock-storage-objects ids]))] + (reduce (fn [[frozen deletable] {:keys [id] :as object}] + (if (and (contains? locked id) (has-refs? conn object)) + [(conj frozen id) deletable] + (do + (l/dbg :id (str id) + :status "delete-after-recheck" + :bucket bucket) + [frozen (conj deletable id)]))) + [#{} #{}] + objects))) + (defn- process-objects [conn has-refs? bucket objects] (loop [to-freeze #{} @@ -157,17 +191,24 @@ (l/dbg :id (str id) :status "freeze" :bucket bucket) - (recur (conj to-freeze id) to-delete (rest objects))) + (recur (conj to-freeze object) to-delete (rest objects))) (do (l/dbg :id (str id) :status "delete" :bucket bucket) (recur to-freeze (conj to-delete id) (rest objects)))) - (do - (some->> (seq to-freeze) (mark-freeze-in-bulk conn)) - (some->> (seq to-delete) (mark-delete-in-bulk conn)) - [(count to-freeze) (count to-delete)])))) + (let [[frozen deletable] (if (seq to-freeze) + (verify-frozen conn has-refs? bucket to-freeze) + [#{} #{}]) + doomed (into to-delete deletable)] + (some->> (seq frozen) (mark-freeze-in-bulk conn)) + (some->> (seq doomed) (mark-delete-in-bulk conn)) + [(count frozen) (count doomed)])))) +;; NOTE: upload-session chunks are 1:1 with their mapping and never +;; shared, but the scan owns the liveness decision anyway: a referenced +;; chunk freezes, so gc-deleted never meets a live NO ACTION reference. +;; The freeze path re-verifies under row locks (see verify-frozen). (defn- process-bucket [conn bucket objects] (cond @@ -178,7 +219,7 @@ (= bucket "profile") (process-objects conn has-profile-refs? bucket objects) (= bucket "file-data") (process-objects conn has-file-data-refs? bucket objects) (= bucket sto/tempfile-bucket) (process-objects conn (constantly false) sto/tempfile-bucket objects) - (= bucket sto/upload-session-bucket) (process-objects conn (constantly false) sto/upload-session-bucket objects) + (= bucket sto/upload-session-bucket) (process-objects conn has-upload-session-chunk-refs? sto/upload-session-bucket objects) (= bucket "organization") (process-objects conn (constantly false) bucket objects) :else (ex/raise :type :internal diff --git a/backend/test/backend_tests/rpc_font_test.clj b/backend/test/backend_tests/rpc_font_test.clj index 90dabf62a0..bd81112bcb 100644 --- a/backend/test/backend_tests/rpc_font_test.clj +++ b/backend/test/backend_tests/rpc_font_test.clj @@ -140,7 +140,7 @@ (let [res (binding [ct/*clock* (ct/fixed-clock (ct/in-future {:hours 3}))] (th/run-task! :storage-gc-touched {}))] - (t/is (= 6 (:freeze res)))) + (t/is (= 8 (:freeze res)))) (let [params {::th/type :delete-font ::rpc/profile-id (:id prof) @@ -209,7 +209,7 @@ (let [res (binding [ct/*clock* (ct/fixed-clock (ct/in-future {:hours 3}))] (th/run-task! :storage-gc-touched {}))] - (t/is (= 6 (:freeze res)))) + (t/is (= 8 (:freeze res)))) (let [params {::th/type :delete-font ::rpc/profile-id (:id prof) @@ -260,7 +260,7 @@ ;; freeze with hours 3 clock (let [res (binding [ct/*clock* (ct/fixed-clock (ct/in-future {:hours 3}))] (th/run-task! :storage-gc-touched {}))] - (t/is (= 6 (:freeze res)))) + (t/is (= 8 (:freeze res)))) (let [params {::th/type :delete-font-variant ::rpc/profile-id (:id prof) :team-id team-id :id (-> out1 :result :id)} diff --git a/backend/test/backend_tests/storage_test.clj b/backend/test/backend_tests/storage_test.clj index abdd8c1503..f85319bc47 100644 --- a/backend/test/backend_tests/storage_test.clj +++ b/backend/test/backend_tests/storage_test.clj @@ -16,6 +16,7 @@ [app.rpc :as-alias rpc] [app.storage :as sto] [app.storage.fs :as-alias sto.fs] + [app.storage.gc-touched :as gc-touched] [app.storage.impl :as impl] [app.storage.s3 :as-alias sto.s3] [app.storage.schema :as stsch] @@ -328,8 +329,10 @@ ;; run the touched gc task (let [res (binding [ct/*clock* (ct/fixed-clock (ct/in-future {:hours 3}))] (th/run-task! :storage-gc-touched {}))] - (t/is (= 5 (:freeze res))) - (t/is (= 1 (:delete res))) + (t/is (= 6 (:freeze res))) + ;; the consumed-but-not-yet-purged session keeps its mapping, + ;; so its chunk freezes instead of being marked + (t/is (= 0 (:delete res))) (let [result-1 (:result out1) result-2 (:result out2)] @@ -1108,6 +1111,168 @@ (t/is (= 1 (:deleted res)))) (t/is (= 0 (:count (th/db-exec-one! ["select count(*) from storage_object"])))))) +(t/deftest upload-session-chunk-frozen-while-referenced + ;; A chunk whose session mapping is still alive must be frozen, not + ;; marked for deletion: the reference scan owns the liveness decision. + (let [prof (th/create-profile* 1) + _ (th/create-project* 1 {:profile-id (:id prof) + :team-id (:default-team-id prof)}) + _ (th/create-file* 1 {:profile-id (:id prof) + :project-id (:default-project-id prof) + :is-shared false}) + mfile {:filename "chunk" + :path (th/tempfile "backend_tests/test_files/sample.jpg") + :mtype "image/jpeg" + :size 312043} + session-id (-> (th/command! {::th/type :create-upload-session + ::rpc/profile-id (:id prof) + :total-chunks 1}) + :result :session-id) + out (th/command! {::th/type :upload-chunk + ::rpc/profile-id (:id prof) + :session-id session-id + :index 0 + :content mfile})] + (t/is (nil? (:error out))) + (t/is (= 1 (:count (th/db-exec-one! ["select count(*) from upload_session_chunk where session_id = ?" + session-id])))) + + ;; the session is neither consumed nor stalled: the mapping is alive + (let [res (binding [ct/*clock* (ct/fixed-clock (ct/in-future {:hours 3}))] + (th/run-task! :storage-gc-touched {}))] + (t/is (= 1 (:freeze res))) + (t/is (= 0 (:delete res)))) + + ;; frozen: untouched, not marked, mapping intact + (t/is (= 0 (:count (th/db-exec-one! ["select count(*) from storage_object where touched_at is not null"])))) + (t/is (= 0 (:count (th/db-exec-one! ["select count(*) from storage_object where deleted_at is not null"])))) + (t/is (= 1 (:count (th/db-exec-one! ["select count(*) from upload_session_chunk where session_id = ?" + session-id])))))) + +(t/deftest upload-session-freeze-reverify + ;; The freeze recheck runs under row locks: an object whose mapping + ;; disappeared (plus a concurrent touch) after the first check is + ;; reclassified to deletion instead of swallowing the touch. + (let [prof (th/create-profile* 1) + _ (th/create-project* 1 {:profile-id (:id prof) + :team-id (:default-team-id prof)}) + _ (th/create-file* 1 {:profile-id (:id prof) + :project-id (:default-project-id prof) + :is-shared false}) + mfile {:filename "chunk" + :path (th/tempfile "backend_tests/test_files/sample.jpg") + :mtype "image/jpeg" + :size 312043} + session-id (-> (th/command! {::th/type :create-upload-session + ::rpc/profile-id (:id prof) + :total-chunks 1}) + :result :session-id) + out (th/command! {::th/type :upload-chunk + ::rpc/profile-id (:id prof) + :session-id session-id + :index 0 + :content mfile}) + object-id (:object-id (th/db-exec-one! ["select object_id from upload_session_chunk where session_id = ?" + session-id])) + check @#'gc-touched/has-upload-session-chunk-refs? + verify @#'gc-touched/verify-frozen] + (t/is (nil? (:error out))) + + ;; mapping alive: stays frozen + (let [[frozen deletable] (db/transact! th/*pool* (fn [conn] (verify conn check "upload-session" [{:id object-id}])))] + (t/is (= #{object-id} frozen)) + (t/is (= #{} deletable))) + + ;; simulate a purge that committed after the first check: mapping + ;; gone, touch bumped + (th/db-exec! ["delete from upload_session_chunk where session_id = ?" session-id]) + (th/db-exec! ["update storage_object set touched_at = ? where id = ?" (ct/now) object-id]) + + ;; recheck moves it to deletion + (let [[frozen deletable] (db/transact! th/*pool* (fn [conn] (verify conn check "upload-session" [{:id object-id}])))] + (t/is (= #{} frozen)) + (t/is (= #{object-id} deletable))))) + +(t/deftest upload-session-gc-deleted-skips-live-mapping + ;; A row marked for deletion while its mapping is still alive must NOT + ;; be reaped silently: the chunk is skipped loud (logged) and retried + ;; once objects-gc purges the session. This pins the mark-time + ;; invariant instead of breaking sessions quietly. + (let [prof (th/create-profile* 1) + _ (th/create-project* 1 {:profile-id (:id prof) + :team-id (:default-team-id prof)}) + _ (th/create-file* 1 {:profile-id (:id prof) + :project-id (:default-project-id prof) + :is-shared false}) + mfile {:filename "chunk" + :path (th/tempfile "backend_tests/test_files/sample.jpg") + :mtype "image/jpeg" + :size 312043} + session-id (-> (th/command! {::th/type :create-upload-session + ::rpc/profile-id (:id prof) + :total-chunks 1}) + :result :session-id) + out (th/command! {::th/type :upload-chunk + ::rpc/profile-id (:id prof) + :session-id session-id + :index 0 + :content mfile}) + object-id (:object-id (th/db-exec-one! ["select object_id from upload_session_chunk where session_id = ?" + session-id]))] + (t/is (nil? (:error out))) + + ;; force the anomaly: mark deleted while the mapping is alive + (th/db-exec! ["update storage_object set deleted_at = ? where id = ?" (ct/now) object-id]) + + (let [res (th/run-task! :storage-gc-deleted {})] + (t/is (= 0 (:deleted res)))) + + ;; row and mapping both intact for the retry + (t/is (= 1 (:count (th/db-exec-one! ["select count(*) from storage_object where id = ?" object-id])))) + (t/is (= 1 (:count (th/db-exec-one! ["select count(*) from upload_session_chunk where session_id = ?" + session-id])))))) + +(t/deftest upload-session-deferred-keeps-mapping + ;; A physical-deletion failure defers the row; the session mapping is + ;; kept so the session survives the backend outage and the blob is + ;; retried the next day. + (let [prof (th/create-profile* 1) + _ (th/create-project* 1 {:profile-id (:id prof) + :team-id (:default-team-id prof)}) + _ (th/create-file* 1 {:profile-id (:id prof) + :project-id (:default-project-id prof) + :is-shared false}) + mfile {:filename "chunk" + :path (th/tempfile "backend_tests/test_files/sample.jpg") + :mtype "image/jpeg" + :size 312043} + session-id (-> (th/command! {::th/type :create-upload-session + ::rpc/profile-id (:id prof) + :total-chunks 1}) + :result :session-id) + out (th/command! {::th/type :upload-chunk + ::rpc/profile-id (:id prof) + :session-id session-id + :index 0 + :content mfile}) + object-id (:object-id (th/db-exec-one! ["select object_id from upload_session_chunk where session_id = ?" + session-id]))] + (t/is (nil? (:error out))) + (th/db-exec! ["update storage_object set deleted_at = ? where id = ?" (ct/now) object-id]) + + (with-mocks [_mock {:target 'app.storage.impl/del-objects-in-bulk + :return (fn [_ ids] (set ids))}] + (let [res (th/run-task! :storage-gc-deleted {})] + (t/is (= 0 (:deleted res))))) + + ;; row kept and deferred one day + (let [row (th/db-exec-one! ["select deletion_attempts, touched_at from storage_object where id = ?" object-id])] + (t/is (= 1 (:deletion-attempts row))) + (t/is (some? (:touched-at row)))) + ;; mapping kept: the session is intact for the retry + (t/is (= 1 (:count (th/db-exec-one! ["select count(*) from upload_session_chunk where session_id = ?" + session-id])))))) + (t/deftest upload-session-consumed-purge ;; An assembled session is marked as consumed and objects-gc purges it ;; right away, without waiting for the stalled threshold. From d57cdb45881a8ab72cd694de22f62507f10dff7e Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Thu, 15 Oct 2026 12:14:32 +0200 Subject: [PATCH 08/16] :rewind: Backport persistence related fixes from staging (#12306) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * :sparkles: 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 * :sparkles: 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 * :recycle: 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 * :sparkles: 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 * :bug: 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 * :bug: 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 * :sparkles: 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 * :globe_with_meridians: 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 * :bug: 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 * :bug: 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 * :sparkles: 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 * :bug: 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 * :sparkles: 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. * :bug: 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. * :bug: 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 --- .serena/memories/clojure/idioms.md | 10 + .../frontend/routing-app-shell-subtleties.md | 8 + .serena/memories/frontend/testing.md | 13 + .../workspace-state-persistence-subtleties.md | 14 +- .../ui/specs/text-editor-v3.spec.js | 7 +- frontend/src/app/main/data/changes.cljs | 40 +- frontend/src/app/main/data/persistence.cljs | 559 ++++++-- frontend/src/app/main/data/workspace.cljs | 24 +- .../data/workspace/fix_deleted_fonts.cljs | 28 +- frontend/src/app/main/errors.cljs | 501 ++++++- frontend/src/app/main/repo.cljs | 61 +- frontend/src/app/main/store.cljs | 9 +- frontend/src/app/main/ui/static.cljs | 20 +- .../app/main/ui/workspace/left_header.cljs | 3 + .../app/main/ui/workspace/left_header.scss | 4 + frontend/src/debug.cljs | 81 ++ .../data/fix_deleted_fonts_test.cljs | 75 ++ .../data/persistence_retry_test.cljs | 884 +++++++++++++ .../frontend_tests/data/persistence_test.cljs | 1178 +++++++++++++---- .../test/frontend_tests/data/repo_test.cljs | 128 +- .../frontend_tests/errors_governor_test.cljs | 403 ++++++ .../test/frontend_tests/helpers/async.cljs | 92 ++ .../test/frontend_tests/helpers/mock.cljc | 86 +- .../test/frontend_tests/main_errors_test.cljs | 869 ++++++++---- frontend/test/frontend_tests/runner.cljs | 6 + frontend/translations/en.po | 19 +- frontend/translations/es.po | 7 +- 27 files changed, 4396 insertions(+), 733 deletions(-) create mode 100644 frontend/test/frontend_tests/data/fix_deleted_fonts_test.cljs create mode 100644 frontend/test/frontend_tests/data/persistence_retry_test.cljs create mode 100644 frontend/test/frontend_tests/errors_governor_test.cljs create mode 100644 frontend/test/frontend_tests/helpers/async.cljs diff --git a/.serena/memories/clojure/idioms.md b/.serena/memories/clojure/idioms.md index c8672aa647..26db315487 100644 --- a/.serena/memories/clojure/idioms.md +++ b/.serena/memories/clojure/idioms.md @@ -8,3 +8,13 @@ assumption; a wrong assumption here already cost a review round. `Long`, so `(int? 5000)` is true. - `integer?` is the general integer predicate; prefer it when any integer kind must match, `int?` only when fixed precision is meant. +- `await` is a `cljs.core` macro asserting `(:async &env)`: it fails at + compile time outside an `^:async` context, never silently. +- The analyzer reads `:async` only from the fn name meta and the `fn` + operator meta; list-level meta is ignored (would make a MetaFn). + `(fn ^:async [] …)` puts the meta on argv (pre/post only, NOT async). +- Valid: `(defn ^:async f)`, `(defn- ^:async f)`, `(^:async fn [] …)` + (the latter is what stock `t/async` generates itself). +- `^:async` fns never throw synchronously (rejected promises instead); + `try/catch/finally` supported; continuations are microtasks, timers and + RxJS schedulers are macrotasks (FIFO). diff --git a/.serena/memories/frontend/routing-app-shell-subtleties.md b/.serena/memories/frontend/routing-app-shell-subtleties.md index cbdc75fcef..d62690ec72 100644 --- a/.serena/memories/frontend/routing-app-shell-subtleties.md +++ b/.serena/memories/frontend/routing-app-shell-subtleties.md @@ -8,6 +8,14 @@ - The root app renders an exception page from `:exception` state before the normal error boundary. `rt/navigated` clears `:exception`. - Frontend error handling treats stale cross-build JS chunk failures specially: messages containing `$cljs$cst$` or `$cljs$core$I` plus undefined/null/not-a-function signatures trigger throttled reload. - Plugin-originated uncaught errors are identified through the plugin runtime hook and logged rather than turning into the global exception page. +- `app.main.errors/submit-report` is governed by a dedup governor: each report carries a fingerprint (`report-name|type|code|hint|first stack frame`; the report name is part of it so a handled report never coalesces with an unhandled/exception-page one), the first occurrence is always emitted, repeats within 2 minutes are counted and included in the next emitted report as `:occurrences`, and the fingerprint cache is bounded (first-inserted entry evicted, FIFO, via `:order` queue) so memory stays fixed. It applies to `handled-exception`, `unhandled-exception` and `exception-page`; a report without an exception cause is ignored and does not consume a reservation. +- Errors caused by the environment (`environment-error-types`: `:network`, `:offline`, `:bad-gateway`, `:service-unavailable`, `:gateway-error`, `:nitrate-unavailable`, `:nitrate-not-configured`) are not application defects: they are reported as audit-only `handled-exception` (never `unhandled-exception`/`exception-page`, so they skip internal reports and alerts), with a compact report and a fingerprint that drops the stack frame. `:offline` has its own handler and no longer falls through to `:default`; `:network`/`:offline`/`:gateway-error` show the `errors.connection-error` toast. +- `repo/handle-response` classifies responses the backend never wrote (body is not a transit map) by status: 504 and Cloudflare 520–524 → `:gateway-error` (retryable, so GETs and saves retry); 429 → `:rate-limit`; any other ≥400 → `:unexpected-response` (both toast-only via `handle-transport-error`, never the exception page). `:internal :unable-to-process-repository-response` is left for a <400 response that does not decode. Uninterpretable bodies are capped at 500 chars in `:data`. +- `generate-report` accepts an explicit `{:format :compact|:full}` (default `:full`) chosen by its caller (`flash`, `exception-section*`): `:compact` keeps the context header plus type/code/uri, and skips the stack, the `ex-data` dump and the last-events list. It is total: if formatting fails it returns a minimal fallback string instead of nil, so an already reserved emission is never dropped. +- `flash` runs its whole body (report pipeline first, toast after) inside a single `ts/schedule` callback: nothing executes synchronously on the error handler's stack. The report is reserved before being generated, so suppressed occurrences do not pay the `generate-report` cost; a reporting or notification failure is logged to the console and never propagates, and the toast is still attempted. `flash` returns a total promise (never rejects) resolving with the generated report, or nil when nothing is emitted, once the callback completes; production callers ignore it, tests await it. `flash` derives only the payload format from the cause (`environment-error?` → `:compact`); the audit event name is the canonical one requested by `:type` (`handled-exception`/`unhandled-exception`) and is never reclassified, because external tools filter on those names. `exception-section*` picks `handled-exception`/`exception-page` explicitly per cause; `flash-persistence` only adds the toast hint. +- `flash` accepts a `:links` vector of `{:label :callback}` actions, appended after the download link that `:report-link?` produces. `flash-persistence` passes a reload link, so a terminal save failure hands the user both the report and the only action that restarts persistence for the session. `labels.reload-page` plus `js/location.reload` is the established full-restart pattern; the link cannot be invoked under the test runner because `js/location` does not exist there, so it is covered by its label and by being callable. +- `flash-persistence` only delegates to another handler for `:authentication`, `:not-found` and `:code :vern-conflict`. Everything else it reports itself, and the report type is derived from the cause: `#{:validation :server-error :internal}` are application defects and report as `unhandled-exception` so they reach the internal reports and the alerts; the rest stay `handled-exception`. `:cause-type` wins over `:type` when classifying, because `persistence-failed` wraps the original cause under `:type :persistence`. Environment failures are deliberately kept handled: they land here after the retry budget is spent and the user's connection is not our bug. `:assertion` is also kept handled, matching its own handler. +- The report governor is global and stateful across tests: two reports with the same fingerprint inside `report-window-ms` collapse. Call `errors/reset-report-governor!` between assertions that expect an emission. ## Store and websocket diff --git a/.serena/memories/frontend/testing.md b/.serena/memories/frontend/testing.md index 1065d48659..d61be3a1bf 100644 --- a/.serena/memories/frontend/testing.md +++ b/.serena/memories/frontend/testing.md @@ -8,6 +8,19 @@ READ `mem:testing` FIRST — it defines the execution discipline (no piping, tee Frontend unit tests live under `frontend/test/frontend_tests/` and use `cljs.test`. They should be deterministic, avoid DOM/UI integration where possible, and mock side effects such as RPC, storage, timers, or network access. +### Async-first stance + +Frontend testing is async-first: everything essentially asynchronous is modeled with a test reproducing the asynchrony, even when the test could be written "synchronously". Sync-passing tests prove nothing about async behavior and rot as soon as an async boundary appears downstream. Consequences: mock through `frontend-tests.helpers.mock`, never `with-redefs`, except unit tests of purely synchronous functions; transport doubles deliver asynchronously (`observe-on :async`) while the test keeps scenario timing (explicit pushes); assertions always follow quiescence (`wait-for` on presence, bare `settle` tick for absence-only blocks), never a trigger. + +### Mock primitives + +- `mock/with-mocks` (callback style, the default): installs with `set!` so mocks survive async boundaries. Body runs immediately and `done'` restores and completes — so the call site must be inside `t/async`, and `done'` is called exactly once (twice only warns; never calling it stalls the run and leaks the mocks). +- `mock/with-mocks*` (preferred for new tests): body forms are wrapped in a generated `^:async` fn and it evaluates to a promise — `await` it, `await` nested scopes too, no `done` in test code. A rejection or a non-promise return is reported as an `:error` by `run-mocked`, which restores the originals in either case. +- `mock/asap` runs `f` on the next macrotask; used to make a scheduled callback fire under test control. +- `mock/stub` wraps fns for arities 0-6 (the `:esm` test build dispatches multi-arity vars as `cljs$core$IFn$_invoke$arity$N`); when the mocked var is variadic-defined (or called with more than 6 args), the call compiles to variadic dispatch, so use a plain variadic `fn` — the stub does not forward variadic. A mock must not call the mocked var again (self-delegation inside a multi-arity function recurses). +- Helpers in `frontend-tests.helpers.async`: `->promise` (single-value observable → promise; beicon has no `to-promise`), `await-response` (subscribe→push→await, atomic), `settle`, `wait-for` (immediate check + bounded poll, fails instead of hanging), `observe` (stream → termination promise; asserts provided, timeout rejects). +- Valid `^:async` placements: `mem:clojure/idioms`. + From `frontend/`: - Full unit test run (always builds, suppressed output): `pnpm run test:quiet`. - Full unit test run (always builds, build output visible): `pnpm run test`. diff --git a/.serena/memories/frontend/workspace-state-persistence-subtleties.md b/.serena/memories/frontend/workspace-state-persistence-subtleties.md index 70f0be8f86..57094e1994 100644 --- a/.serena/memories/frontend/workspace-state-persistence-subtleties.md +++ b/.serena/memories/frontend/workspace-state-persistence-subtleties.md @@ -11,17 +11,27 @@ ## Repo calls - `app.main.repo/send!` uses GET only when the RPC name starts with `get-`, when all params are query params, or for configured special cases. Only GET requests are retried. -- GET retry is limited to transient `:network`, `:bad-gateway`, `:service-unavailable`, and `:offline` errors with exponential backoff. Mutations are not retried. +- `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. ## 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. +- `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, applies the remote changes, then replays pending local redo changes. Index updates are emitted for undo, remote redo, and replayed redo paths. - Local commits are independently consumed by undo, persistence, WASM model updates, thumbnail/library watchers, and text position-data recalculation. - Persistence buffers local commits: status becomes pending after about 200ms, commits are flushed after about 3s or `::force-persist`, and buffered commits are merged per file before `:update-file`. - 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. +- 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. +- Save failures split transient vs terminal (`transient-error?`: the repo retryable types `:network`/`:offline`/`:bad-gateway`/`:service-unavailable`/`:gateway-error` plus `:invalid-save-response`; 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. +- Tests instant-trigger retries by stubbing `rx/timer` (recording delays to assert the schedule); dynamic bindings do not survive `await` continuations, so no dynamic var for delays. +- `save-request-timeout-ms` is 7 minutes and wraps the `update-file` request in `rx/timeout`, failing it as a transient `:network` error so the retry path resends instead of blocking the queue forever. It is deliberately longer than `saving-stall-timeout-ms` (5 min) so the stalled report fires before the retry. +- `sync-unload-guard` keeps `:persistence` in `st/ongoing-tasks` while edits are buffered or queued, which is what holds the browser leave-page warning on. It syncs on `::append-commit`, `::discard-commit` and `::release-failed-file` (every queue change). It is the one effect that must stay in `store.cljs`'s `omitset`, and `store.cljs`'s `ongoing-tasks` watcher is guarded by `exists? js/window` because tests run without a window. - Undo transactions can stay open only temporarily; timed-out pending transactions are force-committed after about 20s. Undo entries are capped at 50. - Undo/redo are ignored while a normal editor/drawing interaction is active, except grid-layout edition handles undo through this path. - After local commits and when render-wasm is active, text shapes get derived `:position-data` recomputed in a separate commit tagged `#{:position-data}`; that tag is excluded from the position-data watcher to avoid loops. diff --git a/frontend/playwright/ui/specs/text-editor-v3.spec.js b/frontend/playwright/ui/specs/text-editor-v3.spec.js index e266224d8c..b9f4dcdeba 100644 --- a/frontend/playwright/ui/specs/text-editor-v3.spec.js +++ b/frontend/playwright/ui/specs/text-editor-v3.spec.js @@ -168,10 +168,13 @@ test.describe("BUG 10934 - Double-clicking a text side handle sets auto-size", ( await workspace.goToWorkspace(); await workspace.waitForFirstRender(); - // Select the text and zoom to fit, so it is fully visible in the viewport + // Select the text and zoom to fit, so it is fully visible in the viewport. + // Wait for the zoom label to change so the handles are at their final spot. await workspace.clickLeafLayer("Fixed text"); + const zoomLabel = page.getByTitle("Zoom", { exact: true }); + const initialZoom = await zoomLabel.innerText(); await page.keyboard.press("Shift+1"); - await workspace.waitForIdle(); + await expect(zoomLabel).not.toHaveText(initialZoom); return workspace; } diff --git a/frontend/src/app/main/data/changes.cljs b/frontend/src/app/main/data/changes.cljs index d849fb95ed..6b902c669b 100644 --- a/frontend/src/app/main/data/changes.cljs +++ b/frontend/src/app/main/data/changes.cljs @@ -246,21 +246,25 @@ ;; Historical previews must not create edits to the live file. Check ;; this when creating commits so previously queued edits can still save. - (when (and (:can-edit permissions) - (not (dm/get-in state [:workspace-global :preview-id]))) - (log/trace :hint "commit-changes" :redo-changes redo-changes) - (let [selected (dm/get-in state [:workspace-local :selected])] - (rx/of (-> params - (assoc :undo-group undo-group) - (assoc :features features) - (assoc :tags tags) - (assoc :stack-undo? stack-undo?) - (assoc :save-undo? save-undo?) - (assoc :file-id file-id) - (assoc :file-revn (resolve-file-revn state file-id)) - (assoc :file-vern (resolve-file-vern state file-id)) - (assoc :undo-changes uchg) - (assoc :redo-changes rchg) - (assoc :selected-before selected) - (assoc :translation? translation?) - (commit))))))))) + ;; Refusals answer with an empty stream (never nil) so callers can + ;; uniformly subscribe and observe termination. + (if (and (:can-edit permissions) + (not (dm/get-in state [:workspace-global :preview-id]))) + (do + (log/trace :hint "commit-changes" :redo-changes redo-changes) + (let [selected (dm/get-in state [:workspace-local :selected])] + (rx/of (-> params + (assoc :undo-group undo-group) + (assoc :features features) + (assoc :tags tags) + (assoc :stack-undo? stack-undo?) + (assoc :save-undo? save-undo?) + (assoc :file-id file-id) + (assoc :file-revn (resolve-file-revn state file-id)) + (assoc :file-vern (resolve-file-vern state file-id)) + (assoc :undo-changes uchg) + (assoc :redo-changes rchg) + (assoc :selected-before selected) + (assoc :translation? translation?) + (commit))))) + (rx/empty)))))) diff --git a/frontend/src/app/main/data/persistence.cljs b/frontend/src/app/main/data/persistence.cljs index adb9f10945..76031e7c85 100644 --- a/frontend/src/app/main/data/persistence.cljs +++ b/frontend/src/app/main/data/persistence.cljs @@ -8,20 +8,27 @@ (:require [app.common.data :as d] [app.common.data.macros :as dm] + [app.common.exceptions :as ex] [app.common.logging :as log] [app.common.time :as ct] [app.common.uuid :as uuid] [app.main.data.changes :as dch] [app.main.data.common :as-alias dc] [app.main.data.helpers :as dsh] + [app.main.data.notifications :as ntf] [app.main.data.workspace :as-alias dw] [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])) (declare ^:private run-persistence-task) +(declare ^:private persist-commit) +(declare ^:private resume-persistence) +(declare ^:private slow-retry-cycle) (log/set-level! :warn) @@ -31,9 +38,40 @@ (def force-persist? #(= % ::force-persist)) +(def slow-retry-delay-ms + "Pause between the attempts of a queue whose backoff is spent: one attempt + per cycle, until it saves or the retry window closes." + 30000) + +(def retry-give-up-ms + "How long a queue that keeps failing on transport errors is sent again." + (* 24 60 60 1000)) + +(def slow-failure-ms + "An attempt that fails after this long may have kept the backend busy, + as a gateway timeout does, so it counts towards `max-slow-failures`." + (* 90 1000)) + +(def max-slow-failures + "Slow failures a queued commit may collect before the slow cycle stops + sending it. Fast failures, such as being offline, never count." + 3) + (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 + a settled (`nil` / `:saved`) empty queue. Anything else — `:pending`, + `:saving` and the `:retrying` episode — keeps waiting." + [{:keys [status queue]}] + (boolean + (or (= status :error) + (and (empty? queue) + (or (nil? status) (= status :saved)))))) (defn wait-persisted-or-error "Returns an observable that emits the first terminal persistence status @@ -42,10 +80,7 @@ ([] (wait-persisted-or-error save-wait-timeout-ms)) ([timeout-ms] (let [base (->> (rx/from-atom refs/persistence {:emit-current-value? true}) - (rx/filter (fn [{:keys [status queue]}] - (or (= status :error) - (and (empty? queue) - (or (nil? status) (= status :saved)))))) + (rx/filter terminal-status?) (rx/take 1) (rx/mapcat (fn [{:keys [status error]}] (if (= status :error) @@ -74,12 +109,15 @@ (rx/concat (rx/of ::force-persist) (wait-persisted timeout-ms)))) (defn- next-status - "Refuses downgrades: a save in progress stays :saving, and a failed save - stays :error until persistence is resumed." + "Refuses downgrades: a save in progress stays :saving, a failed save + stays :error until persistence is resumed, and a retrying episode stays + :retrying until it saves or errors (re-entries send under the episode + instead of resetting it)." [from to] (cond (and (= to :pending) (= from :saving)) from (and (= from :error) (#{:pending :saving} to)) from + (and (= from :retrying) (#{:pending :saving} to)) from :else to)) (defn- update-status @@ -98,14 +136,56 @@ (update :last-progress-at d/nilv (inst-ms (ct/now))) (#{:error :saved} status) - (dissoc :run-id :last-progress-at :stall-reported?)))))))) + (dissoc :run-id :last-progress-at :stall-reported)))))))) + +(defn transient-error? + "True when a save failure is worth retrying with backoff: a transient + transport failure (from the shared `repo/retryable-types` set, which says + nothing about the edits themselves) or an unusable save response. + Everything else (auth, validation, state) is terminal and keeps the + `:error` path. Checked against both `:type` and `:cause-type` because + `persistence-failed` wraps the original cause under `:type :persistence`." + [{:keys [type cause-type code]}] + (boolean + (or (contains? rp/retryable-types type) + (contains? rp/retryable-types cause-type) + (= :invalid-save-response code)))) + +(def ^:private retry-delays-ms + "Backoff delays (ms) between save retries; the count is the retry budget. + A plain value (not a dynamic var): dynamic bindings do not survive `await` + continuations, so tests instant-trigger retries by stubbing `rx/timer`." + [2000 8000 20000]) + +(def ^:private reconnecting-tag + "Tag of the single reconnect notice: re-showing replaces it by + construction (the store holds one toast), and it is hidden by tag on + save or on terminal failure." + :persistence-reconnecting) + +(defn- retry-window-open? + "True while a failing queue may still be sent again." + [pstate] + (let [since (:failing-since pstate)] + (or (nil? since) + (< (- (inst-ms (ct/now)) since) retry-give-up-ms)))) + +(defn- slow-retry-pending? + "True when the queue is halted by a transport failure that the slow retry + cycle keeps sending. A commit whose attempts keep failing slowly is not + sent again: each attempt may cost the backend the whole save." + [{:keys [status error slow-failures] :as pstate}] + (and (= :error status) + (transient-error? error) + (retry-window-open? pstate) + (< (or slow-failures 0) max-slow-failures))) (defn- report-stalled-persistence [now] (ptk/reify ::report-stalled-persistence ptk/UpdateEvent (update [_ state] - (assoc-in state [:persistence :stall-reported?] true)) + (assoc-in state [:persistence :stall-reported] true)) ptk/EffectEvent (effect [_ state _] @@ -113,8 +193,8 @@ commit-id (peek queue) commit (get index commit-id) hint "File saving has made no progress for more than five minutes" - cause (ex-info hint - {:type :persistence + cause (ex/error :type :persistence + :hint hint :code :saving-stalled :file-id (or (:file-id commit) (:current-file-id state)) :commit-id commit-id @@ -123,23 +203,25 @@ :queued-commits (count queue) :elapsed-ms (- now last-progress-at) :can-edit (dm/get-in state [:permissions :can-edit]) - :read-only? (dm/get-in state [:workspace-global :read-only?]) + :read-only (dm/get-in state [:workspace-global :read-only?]) :preview-id (dm/get-in state [:workspace-global :preview-id]) - :render-context-lost? (dm/get-in state [:render-state :lost])})] + :render-context-lost? (dm/get-in state [:render-state :lost]))] (errors/submit-report :event-name "handled-exception" :hint hint - :report (errors/generate-report cause)))))) + :report (fn [] (errors/generate-report cause)) + :cause cause))))) (defn- check-persistence [] (ptk/reify ::check-persistence ptk/WatchEvent (watch [_ state _] - (let [{:keys [status last-progress-at stall-reported?]} (:persistence state) + (let [{:keys [status queue last-progress-at stall-reported]} (:persistence state) now (inst-ms (ct/now))] - (when (and (#{:pending :saving} status) + (when (and (#{:pending :saving :retrying} status) + (seq queue) last-progress-at - (not stall-reported?) + (not stall-reported) (> (- now last-progress-at) saving-stall-timeout-ms)) (rx/of (report-stalled-persistence now))))))) @@ -168,7 +250,9 @@ (throw (ex-info "invalid state" {}))))) (update :index dissoc commit-id) (assoc :last-progress-at (inst-ms (ct/now))) - (dissoc :stall-reported?))))))) + (dissoc :stall-reported :failing-since :recovering + :slow-failures :attempts :retry-token + :retry-for))))))) (defn- append-commit "Event used internally to append the current change to the @@ -190,11 +274,31 @@ ptk/WatchEvent (watch [_ state _] (let [pstate (:persistence state)] + ;; A `:retrying` episode keeps its run id, so a new edit only + ;; joins the queue: the live runner sends it after the head, and + ;; resends stay on the backoff schedule and its attempt budget. (when (and (not= :error (:status pstate)) (= run-id (:run-id pstate))) (rx/of (update-status :saving) (run-persistence-task)))))))) +(defn- drop-file-commits + "Removes every queued commit belonging to `file-id`, together with its + index entry." + [pstate file-id] + (if-not file-id + pstate + (let [dropped (into #{} + (keep (fn [commit-id] + (when (= file-id (get-in pstate [:index commit-id :file-id])) + commit-id))) + (:queue pstate))] + (if (empty? dropped) + pstate + (-> pstate + (update :queue #(into (empty %) (remove dropped) %)) + (update :index #(apply dissoc % dropped))))))) + (defn- persistence-failed [commit-id cause] (ptk/reify ::persistence-failed @@ -212,17 +316,87 @@ :commit-id commit-id :hint (ex-message cause) ::errors/handled? true)) - (dissoc :run-id :last-progress-at :stall-reported?)))))) + (update :failing-since d/nilv (inst-ms (ct/now))) + (dissoc :run-id :last-progress-at :stall-reported + :attempts :retry-token :retry-for)))))) ptk/WatchEvent - (watch [_ _ _] - (rx/of (ptk/data-event ::error cause))) + (watch [_ state stream] + (rx/merge + ;; The terminal toast supersedes the reconnect notice; hide it + ;; explicitly instead of relying on the single-toast replacement. + (rx/of (ptk/data-event ::error cause) + (ntf/hide :tag reconnecting-tag)) + ;; A transport failure that outlasts the backoff can still pass, so + ;; the queue keeps trying at a slow pace. + (let [pstate (:persistence state)] + (if (and (not (:suspended pstate)) + (slow-retry-pending? pstate)) + (slow-retry-cycle stream) + (rx/empty))))) ptk/EffectEvent - (effect [_ _ _] - ;; Report without invoking global handlers that may reload the file or - ;; navigate away before the user can recover the retained changes. - (errors/flash-persistence cause)))) + (effect [_ state _] + ;; A failed slow attempt repeats a failure the user was already warned + ;; about. Report without invoking global handlers that may reload the + ;; file or navigate away before the user can recover the retained + ;; changes. + (let [pstate (:persistence state)] + (when-not (and (:recovering pstate) + (slow-retry-pending? pstate)) + (errors/flash-persistence cause :retrying (slow-retry-pending? pstate))))))) + +(defn- persistence-transient-failure + "Transient save failure: the head commit stays queued and a retry is + scheduled with backoff instead of parking the save in `:error`. Once the + budget (`retry-delays-ms`) is exhausted, or when the failed attempt was + one of the slow cycle, the failure falls through to the `persistence-failed` + path, which schedules the next slow attempt. While retries are suspended + nothing is scheduled: the episode waits for a file to be opened again. + `elapsed-ms` is how long the failed attempt took." + [commit-id cause elapsed-ms] + (ptk/reify ::persistence-transient-failure + ptk/UpdateEvent + (update [_ state] + ;; Always counts (even past the budget): the watch routes on the + ;; stored count, so it must read — never recompute — attempts. + (let [attempts (inc (dm/get-in state [:persistence :attempts] 0))] + (update state :persistence + (fn [pstate] + (-> pstate + (assoc :status :retrying + :attempts attempts + :retry-token (uuid/next) + :retry-for commit-id + :last-progress-at (inst-ms (ct/now))) + (update :failing-since d/nilv (inst-ms (ct/now))) + (cond-> (>= elapsed-ms slow-failure-ms) + (update :slow-failures (fnil inc 0))) + (dissoc :stall-reported)))))) + + ptk/WatchEvent + (watch [_ state _] + (let [{:keys [attempts recovering suspended]} (:persistence state)] + (cond + (or recovering (> attempts (count retry-delays-ms))) + (rx/of (persistence-failed commit-id cause)) + + suspended + (rx/empty) + + :else + (rx/merge + ;; One notice per episode: shown on the first attempt, + ;; re-showing would only replace the identical toast. + (when (= 1 attempts) + (rx/of (ntf/show {:content (tr "errors.save-retrying") + :type :toast + :level :warning + :tag reconnecting-tag}))) + (let [delay-ms (nth retry-delays-ms (dec attempts)) + token (dm/get-in state [:persistence :retry-token])] + (->> (rx/timer delay-ms) + (rx/map (fn [_] (persist-commit commit-id {:token token}))))))))))) (defn- commit-persisted [commit] @@ -234,7 +408,7 @@ (update [_ state] ;; Keep the acknowledgment even if the queue runner has stopped. (d/update-in-when state [:persistence :index (:id commit)] - assoc ::acknowledged? true)))) + assoc ::acknowledged true)))) (defn- update-file-request "Issues the `update-file` request, tracked as active for its lifetime." @@ -255,32 +429,38 @@ "Classifies what should happen with a queued commit before sending it. The attempt stamp and the send decision both read this, so a commit is only ever stamped with a request that is actually going to be sent." - [state commit-id request-id] + [state commit-id] (let [commit (dm/get-in state [:persistence :index commit-id])] (cond (= :error (dm/get-in state [:persistence :status])) :halted (nil? commit) :missing-commit - (::acknowledged? commit) :acknowledged + (::acknowledged commit) :acknowledged (contains? @active-requests (::request-id commit)) :in-flight - (and (::request-id commit) - (not= request-id (::request-id commit))) :unknown-outcome (not (dm/get-in state [:permissions :can-edit])) :permission-denied :else :ready))) (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}] - (let [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}] + (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}] ;; 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. @@ -294,19 +474,31 @@ :code :invalid-save-response :file-id file-id}))))) (rx/catch (fn [cause] - (rx/of (persistence-failed id cause))))))) + (rx/of (if (transient-error? (ex-data cause)) + (persistence-transient-failure + id cause (- (inst-ms (ct/now)) sent-at)) + (persistence-failed id cause)))))))) (defn- persist-commit - [commit-id] + "Sends the queued commit, stamping the attempt first. A commit whose + earlier request is no longer in flight is sent again: changes are + idempotent, so a save the backend already applied can be applied again. + Carries an optional `:token`: retry timers pass the episode token, and a + stale token (superseded episode) stays silent instead of sending or + failing." + [commit-id & {:keys [token]}] (let [request-id (uuid/next)] (ptk/reify ::persist-commit ptk/UpdateEvent (update [_ state] - (if (= :ready (attempt-state state commit-id request-id)) - ;; Record the attempt before starting I/O. An interrupted request - ;; may have reached the server and must not be replayed blindly. - (assoc-in state [:persistence :index commit-id ::request-id] request-id) - state)) + (let [token-ok? (or (nil? token) + (= token (dm/get-in state [:persistence :retry-token])))] + (if (and token-ok? + (= :ready (attempt-state state commit-id))) + ;; Stamp the attempt before any I/O, so a request in flight is + ;; never sent twice in parallel. + (assoc-in state [:persistence :index commit-id ::request-id] request-id) + state))) ptk/WatchEvent (watch [_ state _] @@ -317,17 +509,18 @@ :code code :commit-id commit-id :file-id (:file-id commit)}))))] - (case (attempt-state state commit-id request-id) - :halted (rx/empty) - :missing-commit (fail :missing-commit "A queued save has no change data") - :acknowledged (rx/of (commit-persisted commit)) - ;; The replacement runner listens for the original request's result. - :in-flight (rx/empty) - ;; Even :network and :offline do not prove that the server - ;; skipped the write. Keep the attempt stamp to prevent replay. - :unknown-outcome (fail :save-outcome-unknown "An interrupted save has an unknown outcome") - :permission-denied (fail :save-permission-denied "Edit permission was lost before changes could be saved") - :ready (send-queued-commit request-id (:session-id state) commit))))))) + (if (and (some? token) + (not= token (dm/get-in state [:persistence :retry-token]))) + ;; Stale retry timer: its episode was superseded. Stay silent. + (rx/empty) + (case (attempt-state state commit-id) + :halted (rx/empty) + :missing-commit (fail :missing-commit "A queued save has no change data") + :acknowledged (rx/of (commit-persisted commit)) + ;; The replacement runner listens for the original request's result. + :in-flight (rx/empty) + :permission-denied (fail :save-permission-denied "Edit permission was lost before changes could be saved") + :ready (send-queued-commit request-id (:session-id state) commit)))))))) (defn- run-persistence-task @@ -354,49 +547,199 @@ (rx/filter #(= commit-id (:id %))) (rx/take 1) (rx/mapcat (fn [_] + ;; A save that lands shows the connection + ;; is back: the failure warning goes away. (rx/of (discard-commit commit-id) + (ntf/hide :tag errors/persistence-failed-tag) (run-persistence-task))))) (rx/of (persist-commit commit-id))) (rx/take-until stoper-s))) :else - (rx/of (update-status :saved))))))) + (rx/of (update-status :saved) + (ntf/hide :tag reconnecting-tag))))))) (defn- resume-persistence + "Starts the queue again. A `recovering` resume is an attempt of the slow + cycle, which sends once instead of starting a backoff episode." + ([] (resume-persistence false)) + ([recovering] + (ptk/reify ::resume-persistence + ptk/UpdateEvent + (update [_ state] + (update state :persistence + (fn [pstate] + (-> pstate + (dissoc :error :attempts :retry-token :retry-for) + (assoc :run-id (uuid/next) + :status :saving + :recovering recovering) + (update :last-progress-at d/nilv (inst-ms (ct/now))))))) + ptk/WatchEvent + (watch [_ _ _] + (rx/of (run-persistence-task)))))) + +(defn- slow-retry-cycle + "Resumes a failed queue after `slow-retry-delay-ms`, unless the queue is + resumed some other way, persistence restarts or the workspace closes." + [stream] + (let [stopper-s (rx/merge + (rx/filter (ptk/type? ::resume-persistence) stream) + (rx/filter (ptk/type? ::initialize-persistence) stream) + (rx/filter (ptk/type? ::dw/finalize-workspace) stream))] + (->> (rx/timer slow-retry-delay-ms) + (rx/map (fn [_] (resume-persistence true))) + (rx/take-until stopper-s)))) + +(defn- suspend-retries + "Stops retrying when the workspace closes. A pending backoff timer goes + stale, and no backoff or slow cycle is armed until a file is opened + again. Queued edits stay queued and a request in flight still lands." [] - (ptk/reify ::resume-persistence + (ptk/reify ::suspend-retries ptk/UpdateEvent (update [_ state] (update state :persistence - (fn [pstate] - (-> pstate - (dissoc :error) - (assoc :run-id (uuid/next) :status :saving) - (update :last-progress-at d/nilv (inst-ms (ct/now))))))) - ptk/WatchEvent - (watch [_ _ _] - (rx/of (run-persistence-task))))) + #(-> % + (assoc :suspended true) + (dissoc :retry-token)))))) -(defn- recover-persistence +(defn- restore-retries + "Lets failed saves be retried again once a file is opened." [] - (ptk/reify ::recover-persistence + (ptk/reify ::restore-retries + ptk/UpdateEvent + (update [_ state] + (update state :persistence dissoc :suspended)))) + +(defn- release-failed-file + "Drops the queued commits of the file whose save failed terminally. + + This runs when the user opens a file again, not at failure time. The + failure itself stays visible, because `wait-persisted-or-error` must keep + rejecting: callers use it to avoid snapshotting a file whose edits were + never saved. What must not survive is the halt. Left in place, the failed + commits sit at the head of the queue forever and, because the queue is + shared, they also block the pending edits of every other file." + [] + (ptk/reify ::release-failed-file + ptk/UpdateEvent + (update [_ state] + (let [commit-id (get-in state [:persistence :error :commit-id]) + file-id (get-in state [:persistence :index commit-id :file-id])] + (update state :persistence + #(-> % + (drop-file-commits file-id) + (dissoc :failing-since :slow-failures))))))) + +(defn- queue-needs-a-runner? + "True when the queue still holds commits that nobody is sending. + + The runner does not survive a subscription teardown, so both + initialization and recovery hit this. A halted queue is excluded: the + halt is lifted by `recover-persistence`, which has its own triggers. A + retrying episode is excluded too: its backoff timer owns the recovery, + or `recover-persistence` resumes it when retries were suspended." + [{:keys [queue status]}] + (and (seq queue) + (not= :error status) + (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." + [{:keys [persistence]} {:keys [id vern]}] + (let [{:keys [queue index status error]} persistence + failed-file-id (get-in index [(:commit-id error) :file-id])] + (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)))) + +(defn- initialize-persistence-state + "Brings persistence to a coherent starting shape when the workspace + mounts. + + Deliberately leaves a halted or retrying queue alone. Lifting a halt is + `recover-persistence`'s job, and it waits for the user to open a file, so + doing it here would release edits the moment the view mounts rather than + when the user acts on them." + [] + (ptk/reify ::initialize-persistence-state ptk/WatchEvent (watch [_ state _] - (let [{:keys [queue index status error run-id]} (:persistence state) - commit (get index (peek queue))] + (let [{:keys [queue status run-id]} (:persistence state)] (cond - (and (seq queue) - (or (not= status :error) - (and (= :save-permission-denied (:code error)) - (not (::request-id commit)) - (= (:file-id commit) (:current-file-id state)) - (dm/get-in state [:permissions :can-edit])))) + ;; A commit left queued by a previous session, with no runner. + (queue-needs-a-runner? (:persistence state)) (rx/of (resume-persistence)) + ;; Nothing queued and nothing in flight: there is nothing to save. (and (empty? queue) (not= status :error) (or run-id (#{:pending :saving} status))) - (rx/of (update-status :saved))))))) + (rx/of (update-status :saved)) + + :else + (rx/empty)))))) + +(defn- recover-persistence + "Lifts a halted queue when a file is opened again or the role changes. + + Leaving the workspace suspends retries (`suspend-retries`), so opening a + file (`opened-file?`) restores them, resends a retrying episode whose + backoff was cut short, and sends a failure the slow cycle still covers + (`slow-retry-pending?`) once more instead of dropping it. + + Every other terminal failure is permanent for that file: permission lost, + file gone, or changes the server refuses. None of them can succeed on a + resend, so opening a file releases them instead of replaying them. + Retaining them until here 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. + + A lost permission is not a temporary condition. The backend raises + `:not-found` for it, and replaying the save to find that out routes the + user to the exception page." + [opened-file?] + (ptk/reify ::recover-persistence + ptk/WatchEvent + (watch [_ state _] + (let [{:keys [queue status run-id suspended]} (:persistence state)] + (rx/concat + (if (and opened-file? suspended) + (rx/of (restore-retries)) + (rx/empty)) + (cond + ;; A live retry episode owns its recovery through the backoff + ;; scheduler; resuming here would bypass the attempt budget. + ;; A suspended one has no scheduler left. + (= :retrying status) + (if (and opened-file? suspended) + (rx/of (resume-persistence)) + (rx/empty)) + + (slow-retry-pending? (:persistence state)) + (rx/of (resume-persistence true)) + + (= :error status) + (rx/of (release-failed-file) (resume-persistence)) + + (queue-needs-a-runner? (:persistence state)) + (rx/of (resume-persistence)) + + (and (empty? queue) (or run-id (#{:pending :saving} status))) + (rx/of (update-status :saved)) + + :else + (rx/empty))))))) (def ^:private xf-mapcat-undo (mapcat :undo-changes)) @@ -415,6 +758,31 @@ (assoc :redo-changes rchg) (assoc :changes rchg))))))) +(defn- resume-on-online + "Re-enters the runner for a retrying episode when the browser reports + connectivity back, instead of waiting out the backoff. Terminal failures + stay terminal: only a live `:retrying` episode resumes, never one + suspended outside the workspace." + [] + (ptk/reify ::resume-on-online + ptk/WatchEvent + (watch [_ state _] + (let [{:keys [status queue suspended]} (:persistence state)] + (if (and (seq queue) (= :retrying status) (not suspended)) + (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 @@ -423,6 +791,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?) @@ -440,22 +811,51 @@ (rx/filter #(= % ::force-persist))))] (rx/merge - (rx/of (recover-persistence)) + (rx/of (initialize-persistence-state)) + + (->> stream + (rx/filter (ptk/type? ::dw/finalize-workspace)) + (rx/map (fn [_] (suspend-retries))) + (rx/take-until stoper-s)) (->> stream (rx/filter #(or (ptk/type? ::dc/change-team-role %) (ptk/type? ::dw/workspace-initialized %))) - (rx/map (fn [_] (recover-persistence))) + (rx/map #(recover-persistence (ptk/type? ::dw/workspace-initialized %))) (rx/take-until stoper-s)) (->> (rx/interval saving-check-interval-ms) (rx/map (fn [_] (check-persistence))) (rx/take-until stoper-s)) + ;; The browser knows when connectivity returns: re-enter the + ;; runner for a retrying episode instead of waiting out the + ;; backoff. No `window` outside the browser (tests, SSR). + (or (when (exists? js/window) + (->> (rx/from-event js/window "online") + (rx/map (fn [_] (resume-on-online))) + (rx/take-until stoper-s))) + (rx/empty)) + (->> notifier-s (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, + ;; release of a failed file). + (->> (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 %) + (ptk/type? ::release-failed-file %))) + (rx/map (fn [_] @buffered?)))) + (rx/map sync-unload-guard) + (rx/take-until stoper-s)) + (->> local-commits-s (rx/debounce 200) (rx/map (fn [_] @@ -468,6 +868,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 [] diff --git a/frontend/src/app/main/data/workspace.cljs b/frontend/src/app/main/data/workspace.cljs index bfa0276ce9..128fee32b3 100644 --- a/frontend/src/app/main/data/workspace.cljs +++ b/frontend/src/app/main/data/workspace.cljs @@ -9,6 +9,7 @@ [app.common.attrs :as attrs] [app.common.data :as d] [app.common.data.macros :as dm] + [app.common.files.changes :as cpc] [app.common.files.changes-builder :as pcb] [app.common.files.helpers :as cfh] [app.common.files.variant :as cfv] @@ -321,6 +322,22 @@ :file-id file-id :team-id team-id))))))) +(defn- restore-pending-changes + "Applies the edits still waiting to be saved to a freshly loaded `file`. + An edit that no longer applies to the loaded data leaves the file as the + server sent it; the save queue keeps the edits either way." + [state file] + (let [changes (dps/pending-file-changes state file)] + (if (empty? changes) + file + (try + (update file :data cpc/process-changes changes false) + (catch :default cause + (log/wrn :hint "unable to restore pending changes" + :file-id (dm/str (:id file)) + :cause cause) + file))))) + (defn- bundle-fetched [{:keys [file file-id thumbnails] :as bundle}] (ptk/reify ::bundle-fetched @@ -330,9 +347,10 @@ ptk/UpdateEvent (update [_ state] - (-> state - (assoc :thumbnails (d/update-vals thumbnails (fn [uri] {:uri uri :rendered-at nil}))) - (update :files assoc file-id file))))) + (let [file (restore-pending-changes state file)] + (-> state + (assoc :thumbnails (d/update-vals thumbnails (fn [uri] {:uri uri :rendered-at nil}))) + (update :files assoc file-id file)))))) (defn zoom-to-frame [] diff --git a/frontend/src/app/main/data/workspace/fix_deleted_fonts.cljs b/frontend/src/app/main/data/workspace/fix_deleted_fonts.cljs index 374c163938..fb43c3005f 100644 --- a/frontend/src/app/main/data/workspace/fix_deleted_fonts.cljs +++ b/frontend/src/app/main/data/workspace/fix_deleted_fonts.cljs @@ -65,15 +65,18 @@ [{:keys [objects id]}] (reduce-kv (fn [changes shape-id shape] (if (shape-has-invalid-font-family?? shape) - (conj changes {:type :mod-obj - :id shape-id - :page-id id - :operations [{:type :set - :attr :content - :val (fix-shape-content shape)} - {:type :set - :attr :position-data - :val nil}]}) + (let [fixed-content (fix-shape-content shape)] + (if (not= fixed-content (:content shape)) + (conj changes {:type :mod-obj + :id shape-id + :page-id id + :operations [{:type :set + :attr :content + :val fixed-content} + {:type :set + :attr :position-data + :val nil}]}) + changes)) changes)) [] objects)) @@ -82,8 +85,11 @@ [fdata] (reduce-kv (fn [changes _ typography] (if (has-invalid-font-family? typography) - (conj changes {:type :mod-typography - :typography (fix-typography typography)}) + (let [fixed-typography (fix-typography typography)] + (if (not= fixed-typography typography) + (conj changes {:type :mod-typography + :typography fixed-typography}) + changes)) changes)) [] (:typographies fdata))) diff --git a/frontend/src/app/main/errors.cljs b/frontend/src/app/main/errors.cljs index c2689420de..28e6e54a9b 100644 --- a/frontend/src/app/main/errors.cljs +++ b/frontend/src/app/main/errors.cljs @@ -16,6 +16,7 @@ [app.main.data.nitrate :as dnt] [app.main.data.notifications :as ntf] [app.main.data.workspace :as-alias dw] + [app.main.repo :as rp] [app.main.router :as rt] [app.main.store :as st] [app.main.worker] @@ -127,50 +128,269 @@ ;; Set the main potok error handler (reset! st/on-error on-error) -(defn generate-report +;; --- Environment failures +;; +;; Failures caused by the user's environment (connectivity, a degraded or +;; misconfigured service) are not application defects. They are reported to the +;; audit log as compact events and must never reach the internal error reports +;; (`unhandled-exception`/`exception-page`), which trigger alerts. + +(def environment-error-types + "Error types produced by the environment rather than by an application + defect: the shared transient transport set (`repo/retryable-types`) plus + the nitrate-specific failures." + (into rp/retryable-types #{:nitrate-unavailable + :nitrate-not-configured})) + +(defn environment-error? [cause] + (contains? environment-error-types (:type (ex-data cause)))) + +(defn- report-context + "Common context header for every report format." + [cause] + (let [team-id (:current-team-id @st/state) + file-id (:current-file-id @st/state) + profile-id (:profile-id @st/state) + data (ex-data cause)] + (with-out-str + (println "Context:") + (println "--------------------") + (println "Timestamp:" (ct/format-inst (ct/now) :rfc1123)) + (println "Hint: " (or (:hint data) (ex-message cause) "--")) + (println "Prof ID: " (str (or profile-id "--"))) + (println "Team ID: " (str (or team-id "--"))) + (when-let [file-id (or (:file-id data) file-id)] + (println "File ID: " (str file-id))) + (println "Version: " (:full cf/version)) + (println "HREF: " (rt/get-current-href))))) + +(defn- generate-full-report + "Complete report: context, formatted throwable (including `ex-data`) and the + last events." + [cause] + (with-out-str + (print (report-context cause)) + (println) + + (println + (ex/format-throwable cause)) + (println) + + (println "Last events:") + (println "--------------------") + (println (st/format-last-events)) + (println))) + +(defn- generate-compact-report + "Reduced report for environment failures: context plus the error type, code + and uri. It skips the stack trace, the `ex-data` dump (which may contain + request headers) and the last-events list." + [cause] + (let [data (ex-data cause)] + (with-out-str + (print (report-context cause)) + (println) + (println "Error:") + (println "--------------------") + (println "Type: " (or (:type data) "--")) + (println "Code: " (or (:code data) "--")) + (when-let [uri (:uri data)] + (println "URI: " uri))))) + +(defn generate-report + "Build the report string for `cause`. + + `:format` selects the payload: `:full` (default) includes the formatted + throwable and the last events; `:compact` keeps only the context and the + error type/code/uri, for environment failures. The option is accepted both + as keyword arguments and as a trailing map." + [cause & {:keys [format] :or {format :full}}] (try - (let [team-id (:current-team-id @st/state) - file-id (:current-file-id @st/state) - profile-id (:profile-id @st/state) - data (ex-data cause)] + (case format + :compact (generate-compact-report cause) + (generate-full-report cause)) + (catch :default err + (.error js/console "error on generating report" err) + ;; Keep this function total: `flash` reserves a report slot before + ;; generating it, so returning nil here would consume the slot + ;; without emitting anything. + (str "Report generation failed: " (or (ex-message err) "--") + "\nOriginal hint: " (or (ex/get-hint cause) "--"))))) - (with-out-str - (println "Context:") - (println "--------------------") - (println "Timestamp:" (ct/format-inst (ct/now) :rfc1123)) - (println "Hint: " (or (:hint data) (ex-message cause) "--")) - (println "Prof ID: " (str (or profile-id "--"))) - (println "Team ID: " (str (or team-id "--"))) - (when-let [file-id (or (:file-id data) file-id)] - (println "File ID: " (str file-id))) - (println "Version: " (:full cf/version)) - (println "HREF: " (rt/get-current-href)) - (println) +;; --- Error report governor +;; +;; Bounds the volume of reports emitted by a single browser session. Each +;; report carries a fingerprint; the first occurrence is always emitted and +;; repeated occurrences of the same fingerprint within `report-window-ms` +;; are counted but not emitted. The next emitted report carries the number +;; of occurrences since the previous one as `:occurrences`. The report name +;; is part of the fingerprint, so a handled report never coalesces with an +;; unhandled/exception-page report of the same cause. +;; +;; The fingerprint cache is bounded: when it is full, the fingerprint +;; inserted first is evicted (FIFO order), so memory cannot grow without +;; limit. Eviction drops the evicted fingerprint's pending counter with +;; it, so its next occurrence emits as a fresh report (`:occurrences` +;; 1): a bounded precision trade-off, not an accounting bug. - (println - (ex/format-throwable cause)) - (println) +(def report-window-ms + "Minimum time between two reports with the same fingerprint." + (* 2 60 1000)) - (println "Last events:") - (println "--------------------") - (println (st/format-last-events)) - (println))) - (catch :default cause - (.error js/console "error on generating report" cause) - nil))) +(def max-tracked-fingerprints + "Maximum number of fingerprints kept in the governor cache." + 2000) + +(defn initial-report-state + [] + {:entries {} + :order #queue []}) + +(defonce ^:private report-governor + (atom (initial-report-state))) + +(defn reset-report-governor! + "Testing helper: clear the governor state." + [] + (reset! report-governor (initial-report-state))) + +(defn- label + [v] + (cond + (nil? v) "" + (keyword? v) (name v) + (string? v) v + :else (str v))) + +(defn error-fingerprint + "Stable identity of an error, used to group repeated reports. + + The report name is part of the identity, so a `handled-exception` report + never coalesces with an `unhandled-exception`/`exception-page` report of + the same cause (those two do reach the error reports and alerts). + + Environment failures drop the stack frame: their internal call site is an + implementation detail, and keeping it would fragment the grouping." + [event-name cause] + (let [data (ex-data cause) + ftype (or (:type data) :unknown) + code (or (:code data) :unknown) + hint (or (ex/get-hint cause) "") + base (str (label event-name) "|" (label ftype) "|" (label code) "|" + (str/prune hint 120))] + (if (environment-error? cause) + base + (let [;; A JS stack string starts with "Error: ". The first + ;; actual frame is the first subsequent line shaped like a + ;; frame: skipping the message line and matching on `(` tolerates + ;; wrapper-prepended stacks instead of trusting the position. + frame (or (some->> (.-stack cause) + (str/lines) + (drop 1) + (filter #(str/includes? % "(")) + (first)) + "")] + (str base "|" (str/prune frame 120)))))) + +(defn- evict-oldest + "Drops the fingerprint inserted first. `:order` mirrors the insertion + order of `:entries`, so this is O(1)." + [state] + (let [fingerprint (peek (:order state))] + (-> state + (update :entries dissoc fingerprint) + (update :order pop)))) + +(defn reserve-report* + "Pure decision step of the report governor. + + Given the governor `state`, an error `fingerprint` and the current time in + milliseconds, returns the next governor state with this occurrence's + decision attached: `::emit` tells whether it must be emitted and + `::occurrences` carries the counter (present only when `::emit` is true)." + [state fingerprint now] + (let [entry (get-in state [:entries fingerprint]) + emit? (or (nil? entry) + (>= (- now (:emitted-at entry)) report-window-ms)) + pending (or (:pending entry) 0)] + (cond + ;; New fingerprint: insert it, evicting the oldest when the cache + ;; is full. + (and emit? (nil? entry)) + (let [state (cond-> state + (>= (count (:entries state)) max-tracked-fingerprints) + (evict-oldest))] + (-> state + (assoc-in [:entries fingerprint] {:emitted-at now :pending 0}) + (update :order conj fingerprint) + (assoc ::emit true) + (assoc ::occurrences (inc pending)))) + + ;; Known fingerprint re-emitted after the window: keep its position. + emit? + (-> state + (assoc-in [:entries fingerprint] {:emitted-at now :pending 0}) + (assoc ::emit true) + (assoc ::occurrences (inc pending))) + + ;; Suppressed occurrence: only the counter moves. + :else + (-> state + (update-in [:entries fingerprint :pending] inc) + (assoc ::emit false) + (dissoc ::occurrences))))) + +(defn reserve-report! + "Reserve a slot for a report. Returns the updated governor state, whose + `::emit`/`::occurrences` describe the decision for this occurrence." + [fingerprint now] + (swap! report-governor reserve-report* fingerprint now)) + +(defn- reserve! + "Common reservation step shared by `submit-report` and the `flash` + pipeline: fingerprint the cause and ask the governor. Returns the + occurrence count when this report must be emitted, nil when the + governor suppresses it." + [event-name cause] + (let [state (reserve-report! (error-fingerprint event-name cause) + (inst-ms (ct/now)))] + (when (::emit state) + {:occurrences (::occurrences state)}))) + +(defn- emit-report! + "Emit the audit event for a report that is already reserved by the + governor." + [event-name report hint occurrences] + (st/emit! + (ev/event {::ev/name event-name + :hint hint + :href (rt/get-current-href) + :report report + :occurrences occurrences}))) (defn submit-report - "Report the error report to the audit log subsystem" - [& {:keys [event-name report hint] :or {event-name "unhandled-exception"}}] - (when (and (not (str/empty? hint)) - (string? report) + "Report the error report to the audit log subsystem, subject to the + report governor. + + `cause` must be the exception the report describes: a report without a + cause is ignored (and does not consume a governor reservation), so every + report shares the same fingerprint format. + + `report` is either the report string or a zero-arg function building + it: the function runs only when the governor grants emission, so + suppressed occurrences never pay the report-building cost." + [& {:keys [event-name report hint cause] + :or {event-name "unhandled-exception"}}] + (when (and (ex/exception? cause) + (not (str/empty? hint)) + (or (string? report) (fn? report)) (string? event-name)) - (st/emit! - (ev/event {::ev/name event-name - :hint hint - :href (rt/get-current-href) - :report report})))) + (when-let [{:keys [occurrences]} (reserve! event-name cause)] + (emit-report! event-name + (if (fn? report) (report) report) + hint + occurrences)))) (defn- download-report! [report event] @@ -180,47 +400,148 @@ (dom/trigger-download-uri "report" "text/plain" uri) (ts/schedule-on-idle #(wapi/revoke-uri uri)))) +(defn- report-format + "Payload format for `cause`: compact for environment failures, full + otherwise." + [cause] + (if (environment-error? cause) :compact :full)) + +(defn- emit-flash-report! + "Reserves, generates and emits the flash report. Returns the generated + report string, or nil when nothing is emitted (non-exception cause, + `:silent` type, empty hint or denied governor reservation)." + [type cause] + (when (ex/exception? cause) + (when-let [event-name (case type + :handled "handled-exception" + :unhandled "unhandled-exception" + :silent nil)] + (let [format (report-format cause) + report-hint (ex/get-hint cause)] + (when (and (string? report-hint) (not (str/empty? report-hint))) + (when-let [{:keys [occurrences]} (reserve! event-name cause)] + (let [generated (generate-report cause {:format format})] + (emit-report! event-name + generated + report-hint + occurrences) + generated))))))) + (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. - The notification is scheduled asynchronously (via tm/schedule) to + The payload format is derived from the cause: environment failures get a + compact report. The audit event name is the canonical one requested by + `:type` (`handled-exception`/`unhandled-exception`); it is an external + contract, so flash never reclassifies it. + + The report is reserved before being generated, so repeated errors that + fall inside the governor window do not pay the report-building cost. + With `:report-link?` the toast always carries a download link: when no + report is emitted (suppressed repeat, empty hint, `:silent`), one is + generated for the link alone, without emitting it. + + The whole body (report pipeline first, toast after) runs inside a single + `ts/schedule` callback: nothing report- or toast-related executes + synchronously on the error handler's stack. A failure while reporting or + notifying is logged to the console and never propagates; the toast is + still attempted. + + Returns a promise resolving with the generated report (or nil when + nothing is emitted) once the scheduled callback completes. The promise + is total: it never rejects. Production callers ignore it + (fire-and-forget); it exists so tests can await completion instead of + reasoning about timer order. + + The notification is scheduled asynchronously (via `ts/schedule`) to avoid pushing a new event into the potok store while the store's own error-handling pipeline is still on the call stack. Emitting 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 report-link?] + [& {:keys [type hint cause timeout tag report-link? links] :or {type :handled timeout 5000}}] - (let [report (when (ex/exception? cause) (generate-report cause))] - (when report - (when-let [event-name (case type - :handled "handled-exception" - :unhandled "unhandled-exception" - :silent nil)] - (submit-report :event-name event-name - :report report - :hint (ex/get-hint cause)))) + (js/Promise. + (fn [resolve _reject] + (ts/schedule + (fn [] + (let [report (try (emit-flash-report! type cause) + (catch :default err + (.error js/console "error on emitting report" err) + nil)) + link-report (when report-link? + (or report + (when (ex/exception? cause) + (generate-report cause {:format (report-format cause)})))) + ;; The download link comes first because `:report-link?` is + ;; what puts the report on the toast at all; caller links are + ;; the recovery actions and follow it. + all-links (cond-> [] + link-report + (conj {:label (tr "labels.download" "report.txt") + :callback (partial download-report! link-report)}) + (seq links) (into links))] + (try (st/emit! + (ntf/show + (cond-> {:content (or ^boolean hint (tr "errors.generic")) + :type :toast + :level :error + :timeout timeout} + (some? tag) + (assoc :tag tag) - (ts/schedule - #(st/emit! - (ntf/show - (cond-> {:content (or ^boolean hint (tr "errors.generic")) - :type :toast - :level :error - :timeout timeout} - (and report-link? report) - (assoc :links [{:label (tr "labels.download" "report.txt") - :callback (partial download-report! report)}]))))))) + (seq all-links) + (assoc :links all-links)))) + (catch :default err + (.error js/console "error on emitting toast" err))) + (resolve report))))))) + +(defn- handle-connectivity-error + "Report a failure caused by the user's connectivity. These are audit-only + telemetry with a compact payload: they never reach the internal error + reports and a stack trace adds nothing for a network condition." + [error prefix] + (when-let [cause (::instance error)] + (ex/print-throwable cause :prefix prefix)) + (flash :cause (::instance error) + :type :handled + :hint (tr "errors.connection-error"))) + +(defn- handle-transport-error + "Reports a failure whose answer did not come from the backend. These affect + one request and pass on their own, so the user keeps the page and gets a + toast." + [error prefix] + (when-let [cause (::instance error)] + (ex/print-throwable cause :prefix prefix)) + (flash :cause (::instance error) :type :handled)) (defmethod ptk/handle-error :network [error] ;; Transient network errors (e.g. lost connectivity, DNS failure) ;; should not replace the entire page with an error screen. Show a ;; non-intrusive toast instead and let the user continue working. - (when-let [cause (::instance error)] - (ex/print-throwable cause :prefix "Network Error")) - (flash :cause (::instance error) :type :handled)) + (handle-connectivity-error error "Network Error")) + +(defmethod ptk/handle-error :offline + [error] + ;; Status 0 (browser offline) must not fall through to `:default`: + ;; that would report it as an unhandled application error. + (handle-connectivity-error error "Offline Error")) + +(defmethod ptk/handle-error :gateway-error + [error] + (handle-connectivity-error error "Gateway Error")) + +(defmethod ptk/handle-error :rate-limit + [error] + (handle-transport-error error "Rate Limit Error")) + +(defmethod ptk/handle-error :unexpected-response + [error] + (handle-transport-error error "Unexpected Response")) (def ^:private delegated-persistence-types "Save failure causes routed to their own error handler: retaining the @@ -234,18 +555,72 @@ ;; The retained changes no longer apply to the restored version. (= :vern-conflict code))) +(def ^:private unhandled-persistence-types + "Save failure causes that are application defects, not expected + outcomes: the client asked for something the server refused, or the + server or our own code broke. They must reach the internal reports and + the alerts, so they are reported as unhandled. + Environment failures are deliberately absent: the user's connection is + not our bug, and they land here once the retry budget is spent. + `:assertion` is absent on purpose too, because its own handler already + reports it as handled." + #{:validation :server-error :internal}) + +(defn- persistence-report-type + "The audit event name a save failure gets. `persistence-failed` wraps the + original cause under `:type :persistence` and keeps the real type in + `:cause-type`, so `:cause-type` wins: reading `:type` alone would match the + wrapper and never the cause." + [{:keys [type cause-type]}] + (if (contains? unhandled-persistence-types (or cause-type type)) + :unhandled + :handled)) + +(defn- reload-page-link + "Recovery action for a save failure: reload the window. + + Persistence stops for the session once a save fails terminally, and + reloading is the only way to get a fresh one without the user having to + know they can also leave the file and come back. `location.reload` is the + pattern used elsewhere in the app for a full restart." + [] + {:label (tr "labels.reload-page") + :callback (fn [event] + (dom/prevent-default event) + (js/location.reload))}) + +(def persistence-failed-tag + "Tag of the save failure notification, hidden once a save lands." + :persistence-failed) + (defn flash-persistence - [cause] + "Notifies a save failure. With `:retrying` the failure is transient and + the queue keeps trying in the background, so the toast says the changes + are kept and offers no reload, which would lose them." + [cause & {:keys [retrying]}] (let [data (ex-data cause)] - (if (delegated-persistence-failure? data) + (cond + (delegated-persistence-failure? data) ;; The persistence state wraps the failure and records the original ;; type under :cause-type; dispatch on it to reach the cause's handler. (on-error (-> (exception->error-data cause) (assoc :type (or (:cause-type data) (:type data))))) + + retrying (flash :cause cause - :type :handled + :type (persistence-report-type data) :timeout nil + :tag persistence-failed-tag :report-link? true + :hint (tr "errors.save-still-retrying")) + + :else + (flash :cause cause + :type (persistence-report-type data) + :timeout nil + :tag persistence-failed-tag + :report-link? true + :links [(reload-page-link)] :hint (tr "errors.save-failed"))))) (defmethod ptk/handle-error :persistence diff --git a/frontend/src/app/main/repo.cljs b/frontend/src/app/main/repo.cljs index d4fc1da492..1593692d22 100644 --- a/frontend/src/app/main/repo.cljs +++ b/frontend/src/app/main/repo.cljs @@ -23,12 +23,16 @@ ;; -- Retry helpers ----------------------------------------------------------- -(def ^:private retryable-types +(def retryable-types "Set of error types that are considered transient and safe to retry - for idempotent (GET) requests." + for idempotent (GET) requests. Also the single source of truth for the + transient transport classification consumed by `persistence/transient-error?` + and `errors/environment-error-types`: extend this set (never a copy) + when a new retryable transport failure appears." #{:network ; js/fetch network-level failure :bad-gateway ; 502 :service-unavailable ; 503 + :gateway-error ; 504 and the Cloudflare 52x family :offline}) ; status 0 (browser offline) (defn retryable-error? @@ -76,6 +80,28 @@ ;; -- Response handling ------------------------------------------------------- +(def ^:private gateway-statuses + "Statuses raised by an edge proxy when the request never reached the + backend or its answer never came back." + #{504 ; gateway timeout + 520 ; cloudflare: unknown origin error + 521 ; cloudflare: origin is down + 522 ; cloudflare: connection timed out + 523 ; cloudflare: origin unreachable + 524}) ; cloudflare: origin timed out + +(def ^:private max-body-excerpt + "Number of characters kept from a body that we could not interpret." + 500) + +(defn- body-excerpt + "Keeps the head of an uninterpretable body. Error pages from proxies run + into tens of kilobytes and the excerpt is enough to recognize them." + [body] + (if (and (string? body) (> (count body) max-body-excerpt)) + (str (subs body 0 max-body-excerpt) "...") + body)) + (defn handle-response [{:keys [status body headers uri] :as response}] (cond @@ -118,6 +144,35 @@ (and (>= status 400) (map? body)) (rx/throw (ex-info "http error" (assoc body :uri uri :status status))) + ;; The branches below handle responses the backend never wrote: the + ;; body carries no error code, so the status is all we can read. + + (contains? gateway-statuses status) + (rx/throw + (ex/error :type :gateway-error + :code :gateway-error + :hint "the request did not reach the backend" + :uri uri + :status status)) + + (= 429 status) + (rx/throw + (ex/error :type :rate-limit + :code :rate-limited + :hint "too many requests" + :uri uri + :status status)) + + (>= status 400) + (rx/throw + (ex/error :type :unexpected-response + :code :unexpected-error-response + :hint "unexpected error response" + :uri uri + :status status + :headers headers + :data (body-excerpt body))) + :else (rx/throw (ex/error :type :internal @@ -126,7 +181,7 @@ :uri uri :status status :headers headers - :data body)))) + :data (body-excerpt body))))) (def default-options {:update-file {:query-params [:id]} diff --git a/frontend/src/app/main/store.cljs b/frontend/src/app/main/store.cljs index 8bdff34a65..c7548400ec 100644 --- a/frontend/src/app/main/store.cljs +++ b/frontend/src/app/main/store.cljs @@ -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)))))) diff --git a/frontend/src/app/main/ui/static.cljs b/frontend/src/app/main/ui/static.cljs index b9174d7172..a681944a80 100644 --- a/frontend/src/app/main/ui/static.cljs +++ b/frontend/src/app/main/ui/static.cljs @@ -560,21 +560,25 @@ (mf/defc exception-section* {::mf/private true} [{:keys [data] :as props}] - (let [type (get data :type) - cause (get data ::errors/instance) + (let [type (get data :type) + cause (get data ::errors/instance) + environment (errors/environment-error? cause) - report (mf/with-memo [cause] - (when (ex/exception? cause) - (errors/generate-report cause))) + report (mf/with-memo [cause] + (when (ex/exception? cause) + (errors/generate-report cause {:format (if environment :compact :full)}))) - props (mf/spread-props props {:report report})] + props (mf/spread-props props {:report report})] (mf/with-effect [report type cause] (when (and (ex/exception? cause) (not (contains? #{:not-found :authentication} type))) - (errors/submit-report :event-name "exception-page" + ;; Environment pages are audit-only: they use the canonical + ;; `handled-exception` event instead of `exception-page`. + (errors/submit-report :event-name (if environment "handled-exception" "exception-page") :report report - :hint (ex/get-hint cause)))) + :hint (ex/get-hint cause) + :cause cause))) (case type :not-found diff --git a/frontend/src/app/main/ui/workspace/left_header.cljs b/frontend/src/app/main/ui/workspace/left_header.cljs index 244135c959..34b3ea6161 100644 --- a/frontend/src/app/main/ui/workspace/left_header.cljs +++ b/frontend/src/app/main/ui/workspace/left_header.cljs @@ -115,18 +115,21 @@ :pending (stl/css :status-notification :pending-status) :saving (stl/css :status-notification :saving-status) :saved (stl/css :status-notification :saved-status) + :retrying (stl/css :status-notification :retrying-status) :error (stl/css :status-notification :error-status) (stl/css :status-notification)) :title (case persistence-status :pending (tr "workspace.header.saving") :saving (tr "workspace.header.saving") :saved (tr "workspace.header.saved") + :retrying (tr "workspace.header.retrying") :error (tr "workspace.header.save-error") nil)} (case persistence-status :pending deprecated-icon/status-alert :saving deprecated-icon/status-alert :saved deprecated-icon/status-tick + :retrying deprecated-icon/status-alert :error deprecated-icon/status-wrong nil)] [:div {:class (stl/css :file-name-label)} file-name]])] diff --git a/frontend/src/app/main/ui/workspace/left_header.scss b/frontend/src/app/main/ui/workspace/left_header.scss index 9127ec1270..1275313fcb 100644 --- a/frontend/src/app/main/ui/workspace/left_header.scss +++ b/frontend/src/app/main/ui/workspace/left_header.scss @@ -117,6 +117,10 @@ animation: jump 0.3s ease-out; } + &.retrying-status { + background-color: var(--status-widget-background-color-warning); + } + &.error-status { background-color: var(--status-widget-background-color-error); } diff --git a/frontend/src/debug.cljs b/frontend/src/debug.cljs index fb5cd5b5fe..826c399603 100644 --- a/frontend/src/debug.cljs +++ b/frontend/src/debug.cljs @@ -374,6 +374,87 @@ (.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." + "Simulated errorsimulated intermediary response") + +(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! diff --git a/frontend/test/frontend_tests/data/fix_deleted_fonts_test.cljs b/frontend/test/frontend_tests/data/fix_deleted_fonts_test.cljs new file mode 100644 index 0000000000..b2b5c2e083 --- /dev/null +++ b/frontend/test/frontend_tests/data/fix_deleted_fonts_test.cljs @@ -0,0 +1,75 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS INC Sucursal en España SL + +(ns frontend-tests.data.fix-deleted-fonts-test + (:require + [app.common.test-helpers.files :as cthf] + [app.common.test-helpers.ids-map :as cthi] + [app.common.test-helpers.shapes :as cths] + [app.common.types.shape :as cts] + [app.common.types.text :as txt] + [app.main.data.changes :as dwc] + [app.main.data.workspace.fix-deleted-fonts :as fdf] + [app.main.fonts :as fonts] + [beicon.v2.core :as rx] + [cljs.test :as t :include-macros true] + [frontend-tests.helpers.state :as ths] + [potok.v2.core :as ptk])) + +(t/use-fixtures :each + {:before cthi/reset-idmap!}) + +(def ^:private missing-font-id + "custom-missing-font-id") + +(defn- text-content-with-font + [text font-id font-family] + (-> (cts/setup-shape {:type :text :x 0 :y 0 :grow-type :auto-width}) + :content + (txt/change-text text :font-id font-id :font-family font-family))) + +(defn- file-with-text-shape + [font-id font-family] + (-> (cthf/sample-file :file1 :page-label :page1) + (cths/add-sample-shape :text + {:type :text + :content (text-content-with-font "TEST" + font-id + font-family)}))) + +(defn- watch-fix-deleted-fonts-events + [file] + (let [events (atom []) + store (ths/setup-store file) + state @store] + (when-let [result (ptk/watch (fdf/fix-deleted-fonts-for-page (:id file) + (cthf/current-page-id file)) + state + (rx/empty))] + (->> result (rx/subs! #(swap! events conj %)))) + @events)) + +(t/deftest fix-deleted-fonts-skips-unfixable-missing-font + (let [file (file-with-text-shape missing-font-id "Gibson") + events (watch-fix-deleted-fonts-events file)] + (t/is (empty? events) + "missing custom fonts with no replacement must not commit changes"))) + +(t/deftest fix-deleted-fonts-remaps-when-replacement-exists + (let [replacement-id "custom-gibson-replacement" + cleanup #(swap! fonts/fontsdb dissoc replacement-id)] + (try + (swap! fonts/fontsdb assoc replacement-id + {:id replacement-id + :family "Gibson" + :name "Gibson" + :variants []}) + (let [file (file-with-text-shape missing-font-id "Gibson") + events (watch-fix-deleted-fonts-events file)] + (t/is (= 1 (count events))) + (t/is (ptk/type? ::dwc/commit-changes (first events)))) + (finally + (cleanup))))) diff --git a/frontend/test/frontend_tests/data/persistence_retry_test.cljs b/frontend/test/frontend_tests/data/persistence_retry_test.cljs new file mode 100644 index 0000000000..6bbfbedf47 --- /dev/null +++ b/frontend/test/frontend_tests/data/persistence_retry_test.cljs @@ -0,0 +1,884 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS INC Sucursal en España SL + +(ns frontend-tests.data.persistence-retry-test + "Retry-episode tests for the file persistence save pipeline + (`app.main.data.persistence`). + + Covers the transient-failure retry contract: transient failures resend + the head commit with backoff, the budget bounds the episode, guards + (in-flight, stale token, online resume) prevent double-sends, and hung + resends across governor windows still earn their own stall report." + (:require + [app.common.time :as ct] + [app.common.uuid :as uuid] + [app.main.data.changes :as dch] + [app.main.data.event :as ev] + [app.main.data.persistence :as dps] + [app.main.errors :as errors] + [app.main.repo :as rp] + [app.main.router :as rt] + [app.main.store :as st] + [app.util.i18n :as i18n] + [beicon.v2.core :as rx] + [cljs.test :as t :include-macros true] + [frontend-tests.helpers.async :as async] + [frontend-tests.helpers.mock :as mock] + [potok.v2.core :as ptk])) + +(defn- local-commit + "Builds a synthetic local commit event for `file-id`: a page edit as redo, + no undo, from the `:local` source." + [file-id] + (ptk/data-event ::dch/commit + {:id (uuid/next) + :file-id file-id + :file-revn 0 + :file-vern 0 + :source :local + :features #{} + :redo-changes [{:type :mod-page :id (uuid/next) :name "Edited"}] + :undo-changes []})) + +(defn- with-persistence + "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. + + By default the transport responds through the `:response` subject. Pass a + `respond` function (`(fn [cmd params] observable)`) to drive the transport + response directly instead. Delivery through the subject is asynchronous + (`observe-on :async`): await each effect — via `wait-for` — before + asserting it." + [f & [respond]] + (let [file-id (uuid/next) + 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)) + 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 :tasks tasks})) + (finally + (rx/dispose! store) + (rx/end! response)))))) + +(defn- instant-backoff + "Timer double: the backoff delays fire at once and the slow cycle never + does, so a failure that outlasts the backoff settles in `:error`." + [ms] + (if (= ms dps/slow-retry-delay-ms) + (rx/subject) + (rx/of :tick))) + +(defn- check-failed-save-response + "Feeds `result` as the transport response and asserts the commit stays + queued as a failed save instead of being treated as persisted. Retry + timers fire instantly (stubbed `rx/timer`, slow cycle held), so a + permanently bad answer exhausts the 3-retry budget and lands terminal: `:error` carrying + `:invalid-save-response`, queue intact, exactly 4 sends." + [result] + (with-persistence + (^:async fn [{:keys [file-id requests store]}] + (await + (mock/with-mocks* + {rx/timer (mock/stub instant-backoff)} + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (await (async/wait-for #(and (= :error (get-in @store [:persistence :status])) + (= :invalid-save-response + (get-in @store [:persistence :error :code])) + (= 1 (count (get-in @store [:persistence :queue])))) + "invalid response fails the save")) + (t/is (= :error (get-in @store [:persistence :status]))) + (t/is (= :invalid-save-response (get-in @store [:persistence :error :code]))) + (t/is (= 1 (count (get-in @store [:persistence :queue])))) + (t/is (= 4 (count @requests)) "initial send plus 3 retries")))) + (fn [_ _] result))) + +;; Variant: an empty answer. +(t/deftest ^:async empty-save-response-preserves-the-queue-as-failed + (await (check-failed-save-response (rx/empty)))) + +;; Variant: a nil answer. +(t/deftest ^:async nil-save-response-preserves-the-queue-as-failed + (await (check-failed-save-response (rx/of nil)))) + +;; Variant: a negative revision answer. +(t/deftest ^:async invalid-revision-save-response-preserves-the-queue-as-failed + (await (check-failed-save-response (rx/of {:revn -1})))) + +;; Retry tests. +;; +;; Production contract under test: a transient save failure keeps the head +;; commit queued under `:retrying` and resends it with backoff (2s / 8s / +;; 20s, then terminal). Retry timers are stubbed — instant when the test +;; drives completion, manually fired when it scripts the race — and every +;; stub records its delays so the schedule itself is asserted. +;; +;; Same async pattern as above: triggers stay bare, every assert block is +;; preceded by `wait-for` on its leading signal. + +;; Scenario: the first send fails transiently, the retry succeeds. Both +;; sends carry the same `:commit-id`; the save lands with an empty queue +;; and the episode metadata is cleared. Proves: one transient failure +;; retries the same commit instead of erroring. +(t/deftest ^:async transient-failure-retries-and-saves + (let [calls (atom 0)] + (await + (with-persistence + (^:async fn [{:keys [file-id requests store]}] + (await + (mock/with-mocks* + {rx/timer (mock/stub instant-backoff)} + (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]))) + "retry saves the file")) + (t/is (= :saved (get-in @store [:persistence :status]))) + (t/is (empty? (get-in @store [:persistence :queue]))) + (t/is (= 2 (count @requests)) "failed send plus one retry") + (t/is (apply = (map (comp :commit-id second) @requests)) + "both sends carry the same commit id") + (t/is (nil? (get-in @store [:persistence :attempts])) + "the episode metadata is cleared on success")))) + (fn [_ _] + (if (= 1 (swap! calls inc)) + (rx/throw (ex-info "offline" {:type :offline})) + (rx/of {:revn 1}))))))) + +(defn- check-gateway-response-retries + "Answers the first send with a proxy error page for `status`, built by the + real `rp/handle-response`, and the retry with a valid revision. The save + must take the retry path and land, never halt in `:error`." + [status] + (let [calls (atom 0)] + (with-persistence + (^:async fn [{:keys [file-id failures requests store]}] + (await + (mock/with-mocks* + {rx/timer (mock/stub instant-backoff)} + (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]))) + (str "a " status " is retried and the save lands"))) + (t/is (= 2 (count @requests)) "the proxy error plus one retry") + (t/is (empty? @failures) "a retried proxy error never reaches the failure toast")))) + (fn [_ _] + (if (= 1 (swap! calls inc)) + (rp/handle-response {:status status + :headers {"content-type" "text/html"} + :body "Gateway Timeout" + :uri "https://penpot.example.com/api/main/methods/update-file"}) + (rx/of {:revn 1})))))) + +;; Variant: the proxy in front of the backend timed out. +(t/deftest ^:async gateway-timeout-save-is-retried + (await (check-gateway-response-retries 504))) + +;; Variant: Cloudflare gave up waiting for the origin. +(t/deftest ^:async cloudflare-origin-timeout-save-is-retried + (await (check-gateway-response-retries 524))) + +;; Scenario: every send fails transiently. The 2s / 8s / 20s retries fire +;; and then the failure falls through to the exact terminal path: `:error` +;; carrying the cause, queue intact, one flash. Proves: the budget bounds +;; the episode (4 sends) and exhaustion is today's terminal behavior. +(t/deftest ^:async retry-exhaustion-goes-terminal + (let [delays (atom [])] + (await + (with-persistence + (^:async fn [{:keys [file-id failures requests store]}] + (await + (mock/with-mocks* + {rx/timer (mock/stub (fn [ms] (swap! delays conj ms) (instant-backoff ms)))} + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (await (async/wait-for #(and (= :error (get-in @store [:persistence :status])) + (= 4 (count @requests))) + "retries exhaust into terminal error")) + (t/is (= :error (get-in @store [:persistence :status]))) + (t/is (= :save-failed (get-in @store [:persistence :error :code]))) + (t/is (= 1 (count (get-in @store [:persistence :queue])))) + (t/is (= [2000 8000 20000 dps/slow-retry-delay-ms] @delays) + "the backoff schedule fires in order, then the slow cycle is armed") + (t/is (= 1 (count @failures)) "exhaustion flashes exactly once")))) + (fn [_ _] (rx/throw (ex-info "offline" {:type :offline}))))))) + +;; Scenario: a retry timer fires while the replacement request is still in +;; flight. The timer is driven by hand: fail the first send, let the +;; online signal resend the head (hanging), then fire the pending timer. +;; Proves: the firing is skipped instead of double-sending the same commit. +(t/deftest ^:async retry-skips-resend-while-previous-request-is-in-flight + (let [calls (atom 0) + delays (atom []) + timer-s (rx/subject)] + (await + (with-persistence + (^:async fn [{:keys [file-id requests store]}] + (await + (mock/with-mocks* + {rx/timer (mock/stub (fn [ms] (swap! delays conj ms) timer-s))} + ;; Phase 1 — first send fails transiently; the retry pends on + ;; the hand-fired timer. + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (await (async/wait-for #(= :retrying (get-in @store [:persistence :status])) + "transient failure retries")) + (t/is (= 1 (count @requests))) + ;; Phase 2 — the online signal resends the head under the live + ;; episode (status stays :retrying), hanging in flight. + (ptk/emit! store (#'dps/resume-on-online)) + (await (async/wait-for #(= 2 (count @requests)) "online resends")) + (t/is (= :retrying (get-in @store [:persistence :status]))) + (t/is (= 1 (get-in @store [:persistence :attempts]))) + ;; Phase 3 — the pending timer fires into the in-flight request: + ;; skipped, never a third send. + (rx/push! timer-s :tick) + (await (async/settle)) + (t/is (= 2 (count @requests)) "no double-send while in flight") + (t/is (= :retrying (get-in @store [:persistence :status]))) + (t/is (= 1 (count (get-in @store [:persistence :queue])))) + (rx/end! timer-s)))) + (fn [_ _] + (if (= 1 (swap! calls inc)) + (rx/throw (ex-info "offline" {:type :offline})) + (rx/subject))))))) + +;; Scenario: a persist-commit arrives with a superseded episode token after +;; a transient failure. Without the token guard it would send outside the +;; backoff schedule; with it, nothing happens. Proves: stale retry timers +;; stay silent. +(t/deftest ^:async stale-retry-token-stays-silent + (await + (with-persistence + (^:async fn [{:keys [file-id requests store]}] + (await + (mock/with-mocks* + {rx/timer (mock/stub (fn [_] (rx/subject)))} + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (await (async/wait-for #(= :retrying (get-in @store [:persistence :status])) + "transient failure retries")) + (t/is (= 1 (count @requests))) + (ptk/emit! store (#'dps/persist-commit + (peek (get-in @store [:persistence :queue])) + {:token (uuid/next)})) + (await (async/settle)) + (t/is (= 1 (count @requests)) "stale token sends nothing") + (t/is (= :retrying (get-in @store [:persistence :status]))) + (t/is (nil? (get-in @store [:persistence :error])))))) + (fn [_ _] (rx/throw (ex-info "offline" {:type :offline})))))) + +;; Scenario: a new edit lands while the episode waits on its backoff timer. +;; The edit only joins the queue: nothing is sent and no attempt is spent +;; until the timer fires. The retry then saves the head and the runner +;; sends the new edit after it. Proves: edits during an episode never +;; bypass the backoff nor consume the retry budget. +(t/deftest ^:async new-edit-during-retry-waits-for-the-backoff + (let [calls (atom 0) + delays (atom []) + timer-s (rx/subject)] + (await + (with-persistence + (^:async fn [{:keys [file-id requests store]}] + (await + (mock/with-mocks* + {rx/timer (mock/stub (fn [ms] (swap! delays conj ms) timer-s))} + ;; Phase 1 — first send fails transiently; the retry pends on + ;; the hand-fired timer. + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (await (async/wait-for #(= :retrying (get-in @store [:persistence :status])) + "transient failure retries")) + (t/is (= 1 (count @requests))) + ;; Phase 2 — a new edit joins the queue without resending. + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (await (async/wait-for #(= 2 (count (get-in @store [:persistence :queue]))) + "second edit is queued")) + (await (async/settle)) + (t/is (= 1 (count @requests)) "the edit does not resend the head") + (t/is (= 1 (get-in @store [:persistence :attempts])) "no attempt is spent") + (t/is (= [2000] @delays) "the pending backoff is kept") + (t/is (= :retrying (get-in @store [:persistence :status]))) + ;; Phase 3 — the timer fires: the head saves, then the new edit. + (rx/push! timer-s :tick) + (await (async/wait-for #(and (= :saved (get-in @store [:persistence :status])) + (empty? (get-in @store [:persistence :queue]))) + "both edits save")) + (t/is (= 3 (count @requests)) "failed send, retry, then the new edit") + (let [[first-id retry-id edit-id] (map (comp :commit-id second) @requests)] + (t/is (= first-id retry-id) "the retry resends the head") + (t/is (not= retry-id edit-id) "the new edit is sent after the head")) + (rx/end! timer-s)))) + (fn [_ _] + (if (= 1 (swap! calls inc)) + (rx/throw (ex-info "offline" {:type :offline})) + (rx/of {:revn @calls}))))))) + +;; Scenario: a transient failure raises the reconnect notice; the retry +;; then succeeds. The timer is driven by hand so the test observes the +;; episode mid-flight: one visible notice (the store holds a single toast, +;; so episodes never stack), gone once the save lands. Proves: exactly one +;; notice per episode, hidden on recovery. +(t/deftest ^:async retry-shows-a-single-reconnect-notice-until-saved + (let [calls (atom 0) + timer-s (rx/subject)] + (await + (with-persistence + (^:async fn [{:keys [file-id store]}] + (await + (mock/with-mocks* + {rx/timer (mock/stub (fn [_] timer-s)) + i18n/tr (mock/stub #(str "translated:" %))} + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (await (async/wait-for #(= 1 (get-in @store [:persistence :attempts])) + "first attempt fails into retrying")) + (let [notice (get @store :notification)] + (t/is (map? notice) "a single notice is visible, never stacked")) + (t/is (= :persistence-reconnecting (get-in @store [:notification :tag]))) + (t/is (= "translated:errors.save-retrying" + (get-in @store [:notification :content]))) + (rx/push! timer-s :tick) + (await (async/wait-for #(and (= :saved (get-in @store [:persistence :status])) + (nil? (get @store :notification))) + "save hides the notice")) + (t/is (= :saved (get-in @store [:persistence :status]))) + (t/is (nil? (get @store :notification)) "recovery is silent") + (rx/end! timer-s)))) + (fn [_ _] + (if (= 1 (swap! calls inc)) + (rx/throw (ex-info "offline" {:type :offline})) + (rx/of {:revn 1}))))))) + +;; Scenario: every send fails transiently with instant timers. Exhaustion +;; takes the terminal path, which hides the reconnect notice explicitly +;; before flashing. Proves: no stale notice survives a terminal failure. +(t/deftest ^:async retry-exhaustion-hides-the-reconnect-notice + (await + (with-persistence + (^:async fn [{:keys [file-id store]}] + (await + (mock/with-mocks* + {rx/timer (mock/stub instant-backoff)} + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (await (async/wait-for #(= :error (get-in @store [:persistence :status])) + "retries exhaust into terminal error")) + (t/is (= :error (get-in @store [:persistence :status]))) + (t/is (nil? (get @store :notification)) + "the terminal path hides the reconnect notice")))) + (fn [_ _] (rx/throw (ex-info "offline" {:type :offline})))))) + +;; Scenario: a retrying episode waits on its backoff timer when the browser +;; reports connectivity back. The pending timer never fires, so only the +;; online signal can resume: the head resends under the live episode and, +;; once answered, the file saves. A second online signal with an empty +;; queue sends nothing. Proves: reconnect resumes promptly without +;; terminal failures staying terminal. +(t/deftest ^:async online-event-resumes-a-retrying-episode + (let [calls (atom 0) + timer-s (rx/subject) + second-s (atom nil)] + (await + (with-persistence + (^:async fn [{:keys [file-id requests store]}] + (await + (mock/with-mocks* + {rx/timer (mock/stub (fn [_] timer-s))} + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (await (async/wait-for #(= :retrying (get-in @store [:persistence :status])) + "transient failure retries")) + (t/is (= 1 (count @requests))) + (ptk/emit! store (#'dps/resume-on-online)) + (await (async/wait-for #(= 2 (count @requests)) "online resends")) + (t/is (= 2 (count @requests))) + (t/is (= :retrying (get-in @store [:persistence :status]))) + (t/is (= 1 (get-in @store [:persistence :attempts]))) + (rx/push! @second-s {:revn 1}) + (await (async/wait-for #(and (= :saved (get-in @store [:persistence :status])) + (empty? (get-in @store [:persistence :queue]))) + "resumed save lands")) + (t/is (= :saved (get-in @store [:persistence :status]))) + (ptk/emit! store (#'dps/resume-on-online)) + (await (async/settle)) + (t/is (= 2 (count @requests)) "online with an empty queue sends nothing") + (rx/end! timer-s)))) + (fn [_ _] + (if (= 1 (swap! calls inc)) + (rx/throw (ex-info "offline" {:type :offline})) + (let [s (rx/subject)] (reset! second-s s) s))))))) + +(defn- audit-events + "The audit events (report emissions) out of everything collected through + the `st/emit!` double. Discriminates by `ptk/type`, which is total (never + throws)." + [events] + (filter #(= ::ev/event (ptk/type %)) events)) + +;; Scenario: the `online` event arrives while a retry request is already in +;; flight. The first send fails transiently, the retry timer resends +;; (hanging), then connectivity reports back mid-flight. Proves: the online +;; entry point honors the in-flight guard instead of double-sending — the +;; same guard as the retry-timer path, through `resume-on-online` -> +;; `run-persistence-task`. +(t/deftest ^:async online-event-does-not-resend-an-in-flight-request + (let [calls (atom 0) + timer-s (rx/subject)] + (await + (with-persistence + (^:async fn [{:keys [file-id requests store]}] + (await + (mock/with-mocks* + {rx/timer (mock/stub (fn [_] timer-s))} + ;; Phase 1 — first send fails transiently; the retry pends on + ;; the hand-fired timer. + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (await (async/wait-for #(= :retrying (get-in @store [:persistence :status])) + "transient failure retries")) + (t/is (= 1 (count @requests))) + ;; Phase 2 — the retry timer fires and resends the head, + ;; hanging in flight. + (rx/push! timer-s :tick) + (await (async/wait-for #(= 2 (count @requests)) "retry resends")) + (t/is (= :retrying (get-in @store [:persistence :status]))) + ;; Phase 3 — online arrives mid-flight: silent, never a third send. + (ptk/emit! store (#'dps/resume-on-online)) + (await (async/settle)) + (t/is (= 2 (count @requests)) "online sends nothing while in flight") + (t/is (= :retrying (get-in @store [:persistence :status]))) + (rx/end! timer-s)))) + (fn [_ _] + (if (= 1 (swap! calls inc)) + (rx/throw (ex-info "offline" {:type :offline})) + (rx/subject))))))) + +;; Scenario: the same file stalls twice, more than a governor window apart +;; (scripted clock). Each stall emits its own report: the second is a new +;; episode, not a suppressed duplicate of the first. Proves: identical +;; stall causes coalesce only inside the window. +;; +;; Note: unlike `with-watchdog`, the real `submit-report` runs here (only +;; `generate-report` stays doubled), so the test exercises the governor, +;; the thunk contract and the emit path end to end. +(t/deftest ^:async repeated-stalls-across-windows-emit-each-report + (let [clock (atom 0) + ticks (rx/subject) + response (rx/subject) + requests (atom []) + causes (atom []) + events (atom []) + file-id (uuid/next) + 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 %))})] + (errors/reset-report-governor!) + (await + (mock/with-mocks* + {ct/now (mock/stub #(ct/inst @clock)) + rx/interval (mock/stub (fn [_] ticks)) + rp/cmd! (mock/stub (fn [cmd params] + (swap! requests conj {:cmd cmd :params params}) + (->> response (rx/take 1) (rx/observe-on :async)))) + st/state store + errors/generate-report (fn [cause & _] + (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") + st/ongoing-tasks (atom #{})} + (try + (ptk/emit! store (dps/initialize-persistence)) + ;; Phase 1 — the first stall reports once. + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (reset! clock 300001) + (rx/push! ticks :tick) + (await (async/wait-for #(= 1 (count (audit-events @events))) + "first stall reports")) + (t/is (= 1 (count @requests))) + ;; Phase 2 — the save lands, resetting the stall clock; a new + ;; edit stalls again, over a governor window later. + (rx/push! response {:revn 1}) + (await (async/wait-for #(= :saved (get-in @store [:persistence :status])) + "first save lands")) + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (await (async/wait-for #(= 2 (count @requests)) "second edit is sent")) + (reset! clock (+ 300001 errors/report-window-ms 300001)) + (rx/push! ticks :tick) + (await (async/wait-for #(= 2 (count (audit-events @events))) + "second stall reports")) + (let [audits (audit-events @events)] + (t/is (= 2 (count audits))) + (t/is (= 2 (count @causes)) "each granted stall builds its report") + (t/is (every? #(= 1 (:occurrences (deref %))) audits) + "each stall is a fresh emission, never a coalesced repeat")) + (finally + (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 instant-backoff) + 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}))))))) + +;; --------------------------------------------------------------------------- +;; slow cycle +;; --------------------------------------------------------------------------- + +(defn- slow-cycle-timer + "Timer double: the backoff delays fire at once, and every slow cycle waits + on a subject collected in `cycles`, so the test fires them one by one." + [cycles] + (fn [ms] + (if (= ms dps/slow-retry-delay-ms) + (let [cycle-s (rx/subject)] + (swap! cycles conj cycle-s) + cycle-s) + (rx/of :tick)))) + +;; Scenario: the backoff is spent while the network is down. The queue keeps +;; trying on the slow cycle, one send per cycle, without warning the user +;; again, and saves once the network is back. Proves: a session outlasting +;; the backoff still recovers on its own. +(t/deftest ^:async a-spent-backoff-keeps-trying-on-a-slow-cycle + (let [calls (atom 0) + cycles (atom [])] + (await + (with-persistence + (^:async fn [{:keys [file-id failures requests store]}] + (await + (mock/with-mocks* + {rx/timer (mock/stub (slow-cycle-timer cycles))} + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (await (async/wait-for #(and (= :error (get-in @store [:persistence :status])) + (= 1 (count @cycles))) + "the spent backoff arms the slow cycle")) + (t/is (= 4 (count @requests))) + (t/is (= 1 (count @failures))) + + (rx/push! (last @cycles) :tick) + (await (async/wait-for #(= 2 (count @cycles)) + "a failed slow attempt arms the next cycle")) + (t/is (= 5 (count @requests)) "a slow cycle sends once") + (t/is (= :error (get-in @store [:persistence :status]))) + (t/is (= 1 (count @failures)) "the user is not warned again") + + ;; The warning the first failure left on screen. + (ptk/emit! store #(assoc % :notification {:tag errors/persistence-failed-tag + :level :error})) + (rx/push! (last @cycles) :tick) + (await (async/wait-for #(and (= :saved (get-in @store [:persistence :status])) + (empty? (get-in @store [:persistence :queue]))) + "the slow attempt saves")) + (t/is (= 6 (count @requests))) + (t/is (apply = (map (comp :commit-id second) @requests)) + "every attempt carries the same commit id") + (t/is (nil? (get-in @store [:persistence :recovering]))) + (t/is (nil? (get-in @store [:persistence :failing-since]))) + (t/is (nil? (get @store :notification)) + "the failure warning goes away once the save lands")))) + (fn [_ _] + (if (< (swap! calls inc) 6) + (rx/throw (ex-info "offline" {:type :offline})) + (rx/of {:revn 1}))))))) + +;; Scenario: a gateway error outlasts the backoff, then the proxy recovers. +;; Proves: each gateway status takes the slow cycle and saves the held edit. +(t/deftest ^:async a-gateway-error-arms-the-slow-cycle + (doseq [status [504 520 521 522 523 524]] + (let [calls (atom 0) + cycles (atom [])] + (await + (with-persistence + (^:async fn [{:keys [file-id requests store]}] + (await + (mock/with-mocks* + {rx/timer (mock/stub (slow-cycle-timer cycles))} + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (await (async/wait-for #(= 1 (count @cycles)) + (str status " arms the slow cycle"))) + (t/is (= 4 (count @requests))) + (t/is (= :gateway-error (get-in @store [:persistence :error :cause-type]))) + (t/is (= 1 (count (get-in @store [:persistence :queue])))) + + (rx/push! (last @cycles) :tick) + (await (async/wait-for #(and (= :saved (get-in @store [:persistence :status])) + (empty? (get-in @store [:persistence :queue]))) + (str status " recovers on the slow cycle"))) + (t/is (= 5 (count @requests))) + (t/is (apply = (map (comp :commit-id second) @requests)) + "the slow cycle saves the held commit")))) + (fn [_ _] + (if (<= (swap! calls inc) 4) + (rp/handle-response {:status status :body "Gateway error" :uri "/api"}) + (rx/of {:revn 1})))))))) + +;; Scenario: a save fails for a reason no attempt can get past. Proves: only +;; transport failures arm the slow cycle. +(t/deftest ^:async a-terminal-failure-does-not-arm-the-slow-cycle + (let [cycles (atom [])] + (await + (with-persistence + (^:async fn [{:keys [file-id requests store]}] + (await + (mock/with-mocks* + {rx/timer (mock/stub (slow-cycle-timer cycles))} + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (await (async/wait-for #(= :error (get-in @store [:persistence :status])) + "the save fails")) + (await (async/settle)) + (t/is (= 1 (count @requests))) + (t/is (empty? @cycles))))) + (fn [_ _] (rx/throw (ex-info "Validation failed" {:type :validation}))))))) + +;; Scenario: a gateway answers 504 only after its own timeout, while the +;; backend may still be applying the save. Proves: slow failures below the +;; limit still arm the slow cycle; at the limit the save stops being sent, +;; and opening a file releases it instead of sending it again. +(t/deftest ^:async slow-failures-stop-the-slow-cycle-at-the-limit + (doseq [[slow-count armed?] [[(dec dps/max-slow-failures) true] + [dps/max-slow-failures false]]] + (let [clock (atom 0) + calls (atom 0) + cycles (atom [])] + (await + (with-persistence + (^:async fn [{:keys [file-id requests store]}] + (await + (mock/with-mocks* + {rx/timer (mock/stub (slow-cycle-timer cycles)) + ct/now (mock/stub #(ct/inst @clock))} + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (await (async/wait-for #(= :error (get-in @store [:persistence :status])) + (str slow-count " slow failures spend the backoff"))) + (await (async/settle)) + (t/is (= 4 (count @requests))) + (t/is (= slow-count (get-in @store [:persistence :slow-failures]))) + (t/is (= (if armed? 1 0) (count @cycles)) + (str slow-count " slow failures " (if armed? "arm" "do not arm") " the slow cycle")) + + (when-not armed? + (ptk/emit! store (ptk/data-event :app.main.data.common/change-team-role)) + (await (async/wait-for #(empty? (get-in @store [:persistence :queue])) + "recovery releases the held edit")) + (t/is (= 4 (count @requests)) "the released edit is not sent again"))))) + (fn [_ _] + (when (<= (swap! calls inc) slow-count) + (swap! clock + dps/slow-failure-ms)) + (rp/handle-response {:status 504 :body "Gateway timeout" :uri "/api"}))))))) + +;; Scenario: the slow cycle is still failing when the retry window closes. +;; Proves: the cycle gives up, keeping the edits queued. +(t/deftest ^:async the-slow-cycle-stops-when-the-retry-window-closes + (let [clock (atom 0) + cycles (atom [])] + (await + (with-persistence + (^:async fn [{:keys [file-id requests store]}] + (await + (mock/with-mocks* + {rx/timer (mock/stub (slow-cycle-timer cycles)) + ct/now (mock/stub #(ct/inst @clock))} + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (await (async/wait-for #(= 1 (count @cycles)) "the slow cycle is armed")) + + (reset! clock (+ dps/retry-give-up-ms 1000)) + (rx/push! (last @cycles) :tick) + (await (async/wait-for #(= 5 (count @requests)) "the last slow attempt")) + (await (async/wait-for #(= :error (get-in @store [:persistence :status])) + "the attempt fails")) + (await (async/settle)) + (t/is (= 1 (count @cycles)) "no further cycle is armed") + (t/is (= 1 (count (get-in @store [:persistence :queue]))))))) + (fn [_ _] (rx/throw (ex-info "offline" {:type :offline}))))))) + +;; Scenario: the backoff is spent and the user leaves the workspace, which +;; stops the slow cycle, then opens a file again. Recovery sends the queue +;; once more instead of releasing it, and it saves. Proves: edits held by a +;; transport failure are never dropped by recovery. +(t/deftest ^:async recovery-resends-a-transport-failure-instead-of-releasing-it + (let [calls (atom 0) + cycles (atom [])] + (await + (with-persistence + (^:async fn [{:keys [file-id requests store]}] + (await + (mock/with-mocks* + {rx/timer (mock/stub (slow-cycle-timer cycles))} + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (await (async/wait-for #(= 1 (count @cycles)) "the slow cycle is armed")) + (ptk/emit! store (ptk/data-event :app.main.data.workspace/finalize-workspace)) + (ptk/emit! store (ptk/data-event :app.main.data.common/change-team-role)) + (await (async/wait-for #(and (= :saved (get-in @store [:persistence :status])) + (empty? (get-in @store [:persistence :queue]))) + "recovery saves the held edit")) + (t/is (= 5 (count @requests))) + (t/is (apply = (map (comp :commit-id second) @requests)) + "recovery sends the same commit, not a released queue")))) + (fn [_ _] + (if (< (swap! calls inc) 5) + (rx/throw (ex-info "offline" {:type :offline})) + (rx/of {:revn 1}))))))) + +;; Leaving the workspace tests. + +;; Scenario: a save fails on a transport error and the user leaves the +;; workspace before the backoff fires. The pending retry stays silent, and +;; opening a file sends the held edit again. Proves: the backoff does not +;; run outside the workspace and resumes once a file is opened. +(t/deftest ^:async leaving-the-workspace-stops-the-backoff + (let [calls (atom 0) + timers (atom [])] + (await + (with-persistence + (^:async fn [{:keys [file-id requests store]}] + (await + (mock/with-mocks* + {rx/timer (mock/stub (fn [_] + (let [timer-s (rx/subject)] + (swap! timers conj timer-s) + timer-s)))} + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (await (async/wait-for #(= 1 (count @timers)) "the failure schedules a retry")) + + (ptk/emit! store (ptk/data-event :app.main.data.workspace/finalize-workspace)) + (await (async/wait-for #(get-in @store [:persistence :suspended]) + "leaving the workspace suspends retries")) + (rx/push! (first @timers) :tick) + (await (async/settle)) + (t/is (= 1 (count @requests)) "the pending retry stays silent") + (t/is (= :retrying (get-in @store [:persistence :status]))) + (t/is (= 1 (count (get-in @store [:persistence :queue])))) + + (ptk/emit! store (ptk/data-event :app.main.data.workspace/workspace-initialized)) + (await (async/wait-for #(and (= :saved (get-in @store [:persistence :status])) + (empty? (get-in @store [:persistence :queue]))) + "opening a file saves the held edit")) + (t/is (= 2 (count @requests))) + (t/is (apply = (map (comp :commit-id second) @requests)) + "the same commit is sent again") + (t/is (nil? (get-in @store [:persistence :suspended])))))) + (fn [_ _] + (if (= 1 (swap! calls inc)) + (rx/throw (ex-info "offline" {:type :offline})) + (rx/of {:revn 1}))))))) + +;; Scenario: the user leaves the workspace while a save is in flight, and the +;; save then fails on a transport error. No backoff is scheduled, the online +;; event does not resend, and opening a file does. Proves: a failure that +;; lands outside the workspace waits for the user instead of retrying there. +(t/deftest ^:async a-failure-after-leaving-the-workspace-arms-no-retry + (let [calls (atom 0) + timers (atom []) + first-s (rx/subject)] + (await + (with-persistence + (^:async fn [{:keys [file-id requests store]}] + (await + (mock/with-mocks* + {rx/timer (mock/stub (fn [ms] (swap! timers conj ms) (rx/subject)))} + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (await (async/wait-for #(= 1 (count @requests)) "the edit is sent")) + + (ptk/emit! store (ptk/data-event :app.main.data.workspace/finalize-workspace)) + (await (async/wait-for #(get-in @store [:persistence :suspended]) + "leaving the workspace suspends retries")) + (rx/error! first-s (ex-info "offline" {:type :offline})) + (await (async/wait-for #(= :retrying (get-in @store [:persistence :status])) + "the failure keeps the edit queued")) + (await (async/settle)) + (t/is (empty? @timers) "no backoff is scheduled") + + (ptk/emit! store (#'dps/resume-on-online)) + (await (async/settle)) + (t/is (= 1 (count @requests)) "the online event does not resend") + + (ptk/emit! store (ptk/data-event :app.main.data.workspace/workspace-initialized)) + (await (async/wait-for #(and (= :saved (get-in @store [:persistence :status])) + (empty? (get-in @store [:persistence :queue]))) + "opening a file saves the held edit")) + (t/is (= 2 (count @requests)))))) + (fn [_ _] + (if (= 1 (swap! calls inc)) + first-s + (rx/of {:revn 1}))))))) + +;; Scenario: the last backoff attempt is in flight when the user leaves the +;; workspace, and it fails. The queue halts without arming the slow cycle, +;; and opening a file sends it once more. Proves: the slow cycle never +;; starts outside the workspace. +(t/deftest ^:async a-spent-backoff-outside-the-workspace-arms-no-slow-cycle + (let [calls (atom 0) + cycles (atom []) + last-s (rx/subject)] + (await + (with-persistence + (^:async fn [{:keys [file-id requests store]}] + (await + (mock/with-mocks* + {rx/timer (mock/stub (slow-cycle-timer cycles))} + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (await (async/wait-for #(= 4 (count @requests)) "the last retry is sent")) + + (ptk/emit! store (ptk/data-event :app.main.data.workspace/finalize-workspace)) + (await (async/wait-for #(get-in @store [:persistence :suspended]) + "leaving the workspace suspends retries")) + (rx/error! last-s (ex-info "offline" {:type :offline})) + (await (async/wait-for #(= :error (get-in @store [:persistence :status])) + "the spent backoff halts the queue")) + (await (async/settle)) + (t/is (empty? @cycles) "no slow cycle is armed") + (t/is (= 1 (count (get-in @store [:persistence :queue])))) + + (ptk/emit! store (ptk/data-event :app.main.data.workspace/workspace-initialized)) + (await (async/wait-for #(and (= :saved (get-in @store [:persistence :status])) + (empty? (get-in @store [:persistence :queue]))) + "opening a file saves the held edit")) + (t/is (= 5 (count @requests)))))) + (fn [_ _] + (let [n (swap! calls inc)] + (cond + (< n 4) (rx/throw (ex-info "offline" {:type :offline})) + (= n 4) last-s + :else (rx/of {:revn 1})))))))) diff --git a/frontend/test/frontend_tests/data/persistence_test.cljs b/frontend/test/frontend_tests/data/persistence_test.cljs index 8cdb42789c..9735771305 100644 --- a/frontend/test/frontend_tests/data/persistence_test.cljs +++ b/frontend/test/frontend_tests/data/persistence_test.cljs @@ -5,22 +5,106 @@ ;; Copyright (c) KALEIDOS INC Sucursal en España SL (ns frontend-tests.data.persistence-test + "Tests for the file persistence save pipeline (`app.main.data.persistence`): + read-only saves, the stalled-save watchdog, the core save pipeline + (queueing, failures, recovery), and the transient/terminal failure + classification. Retry-episode behavior lives in + `frontend-tests.data.persistence-retry-test`. + + The watchdog and read-only tests are fully async: `mock/with-mocks*` + installs the doubles, `^:async` bodies `await` observable effects (never + assert straight after a trigger), and completion propagates through + promises — test code threads no `done`. The remaining tests still use + `mock/with-mocks` with an explicit `done` chain." (:require [app.common.time :as ct] + [app.common.types.shape :as cts] [app.common.uuid :as uuid] [app.main.data.changes :as dch] [app.main.data.persistence :as dps] [app.main.data.render-wasm :as drw] + [app.main.data.workspace :as dw] [app.main.errors :as errors] [app.main.repo :as rp] [app.main.store :as st] [app.util.i18n :as i18n] [beicon.v2.core :as rx] [cljs.test :as t :include-macros true] + [frontend-tests.helpers.async :as async] [frontend-tests.helpers.mock :as mock] [potok.v2.core :as ptk])) +(t/deftest reopening-restores-only-the-retained-edits-of-the-loaded-file + (doseq [[status cause-type vern restored?] + [[:retrying nil 0 true] + [:saving nil 0 true] + [:error :offline 0 true] + [:error :validation 0 false] + [:retrying nil 1 false]]] + (t/testing (str status " / " cause-type " / version " vern) + (let [file-id (uuid/next) + page-id (uuid/next) + shape-id (uuid/next) + first-id (uuid/next) + next-id (uuid/next) + other-id (uuid/next) + shape (cts/setup-shape {:id shape-id :type :rect :x 0 :y 0}) + file {:id file-id + :vern vern + :data {:pages [page-id] + :pages-index {page-id {:id page-id :name "Page" + :objects {uuid/zero + (cts/setup-shape {:id uuid/zero :type :frame})}}}}} + rename (fn [name] + {:type :mod-obj :id shape-id :page-id page-id + :operations [{:type :set :attr :name :val name}]}) + pstate {:status status + :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}]} + next-id {:file-id file-id :file-vern 0 + :redo-changes [(rename "Retained rectangle")]} + other-id {:file-id (uuid/next) :file-vern 0 + :redo-changes [(rename "Another file")]}}} + state {:persistence pstate} + loaded (ptk/update (#'dw/bundle-fetched {:file file :file-id file-id :thumbnails {}}) + state) + restored (get-in loaded [:files file-id :data :pages-index page-id :objects shape-id])] + (t/is (= restored? (some? restored))) + (when restored? + (t/is (= "Retained rectangle" (:name restored)) + "queued edits apply in order and exclude other files")) + (t/is (identical? pstate (:persistence loaded)) + "restoring the editor must preserve the save queue"))))) + +;; 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. +(t/deftest reopening-with-an-edit-that-no-longer-applies-keeps-the-server-file + (let [file-id (uuid/next) + page-id (uuid/next) + commit-id (uuid/next) + data {:pages [page-id] + :pages-index {page-id {:id page-id :name "Page" + :objects {uuid/zero + (cts/setup-shape {:id uuid/zero :type :frame})}}}} + file {:id file-id :vern 0 :data data} + 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}]}]}}} + 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]))) + (t/is (identical? pstate (:persistence loaded))))) + (defn- local-commit + "Builds a synthetic local commit event for `file-id`: a page edit as redo, + no undo, from the `:local` source." [file-id] (ptk/data-event ::dch/commit {:id (uuid/next) @@ -32,40 +116,78 @@ :redo-changes [{:type :mod-page :id (uuid/next) :name "Edited"}] :undo-changes []})) -(t/deftest queued-edits-save-during-temporary-read-only-mode - (doseq [read-only-event [(drw/context-lost) - #(assoc-in % [:workspace-global :read-only?] true) - #(assoc % :workspace-global {:read-only? true - :preview-id (uuid/next)})]] - (let [file-id (uuid/next) - response (rx/subject) - errors (atom []) - store (ptk/store {:state {:permissions {:can-edit true} - :files {file-id {:id file-id :revn 0}}} - :on-error #(swap! errors conj %)})] - (with-redefs [rp/cmd! (mock/stub (fn [_ _] (rx/take 1 response)))] - (try - (ptk/emit! store (dps/initialize-persistence) - (local-commit file-id) - read-only-event - ::dps/force-persist) - (rx/push! response {:revn 1}) - (t/is (= :saved (get-in @store [:persistence :status]))) - (t/is (empty? (get-in @store [:persistence :queue]))) +(defn- ^:async run-read-only-phases + "Drives the read-only save scenario presuming asynchronous APIs: every + phase emits its triggers, awaits the transport round-trip, and only + then asserts the observed state." + [store response requests file-id read-only-event errors] + (ptk/emit! store (dps/initialize-persistence) + (local-commit file-id) + read-only-event + ::dps/force-persist) + (await (async/await-response requests response {:revn 1})) + (t/is (= :saved (get-in @store [:persistence :status]))) + (t/is (empty? (get-in @store [:persistence :queue]))) - (ptk/emit! store (drw/context-restored) - #(assoc-in % [:workspace-global :read-only?] false) - (local-commit file-id) - ::dps/force-persist) - (rx/push! response {:revn 2}) - (t/is (= :saved (get-in @store [:persistence :status]))) - (t/is (empty? (get-in @store [:persistence :queue]))) - (t/is (empty? @errors)) - (finally - (rx/dispose! store) - (rx/end! response))))))) + (ptk/emit! store (drw/context-restored) + #(assoc-in % [:workspace-global :read-only?] false) + (local-commit file-id) + ::dps/force-persist) + (await (async/await-response requests response {:revn 2})) + (t/is (= :saved (get-in @store [:persistence :status]))) + (t/is (empty? (get-in @store [:persistence :queue]))) + (t/is (empty? @errors))) -(t/deftest historical-preview-cannot-create-local-commits +(defn- ^:async check-read-only-save + "Saves a queued edit while the file is read-only and verifies that the edit + is persisted once the restriction is lifted. + + Scenario: with persistence initialized, queue an edit, switch the file to + read-only (`read-only-event`), and force persistence — the edit goes out + and is acknowledged. Then restore an editable context, queue another edit + and persist again. Both saves land in order with no reported errors. + Proves: read-only defers writes without dropping them, and resumption + picks up where it left off." + [read-only-event] + (let [file-id (uuid/next) + response (rx/subject) + requests (atom []) + errors (atom []) + store (ptk/store {:state {:permissions {:can-edit true} + :files {file-id {:id file-id :revn 0}}} + :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))) + st/ongoing-tasks (atom #{})} + (try + (await (run-read-only-phases store response requests file-id read-only-event errors)) + (finally + (rx/dispose! store) + (rx/end! response)))))) + +;; Variant: the file goes read-only through render context loss. +(t/deftest ^:async queued-edits-save-after-context-loss + (await (check-read-only-save (drw/context-lost)))) + +;; Variant: the file goes read-only through the workspace flag. +(t/deftest ^:async queued-edits-save-in-read-only-mode + (await (check-read-only-save #(assoc-in % [:workspace-global :read-only?] true)))) + +;; Variant: the file goes read-only through preview mode. +(t/deftest ^:async queued-edits-save-in-read-only-preview-mode + (await (check-read-only-save #(assoc % :workspace-global {:read-only? true + :preview-id (uuid/next)})))) + +;; Scenario: the open file is a historical preview (read-only with a preview +;; id). Attempting a commit there must produce nothing observable: the gate +;; answers refusals with an empty stream (never nil), so the test observes +;; termination instead of branching on nil. Previews cannot create local +;; commits. Proves: the read-only preview gate holds at the watch level. +(t/deftest ^:async historical-preview-cannot-create-local-commits (let [file-id (uuid/next) output (atom []) state {:current-file-id file-id @@ -73,306 +195,796 @@ :files {file-id {:id file-id :revn 0 :vern 0}} :workspace-global {:read-only? true :preview-id (uuid/next)}} event (dch/commit-changes {:redo-changes [] :undo-changes []})] - (when-let [result (ptk/watch event state (rx/empty))] - (->> result (rx/subs! #(swap! output conj %)))) + (await (async/observe (ptk/watch event state (rx/empty)) + :on-next #(swap! output conj %))) (t/is (empty? @output)))) +;; Watchdog: stalled-save detection. +;; +;; Production contract under test (`app.main.data.persistence`, +;; `saving-stall-timeout-ms` = 5 minutes): +;; - A request unanswered past the deadline reports once as +;; `:saving-stalled` (a `handled-exception` audit event) and never +;; repeats for the same stall (`:stall-reported`). +;; - Any completed save resets the clock: a later stall reports again. +;; - Edits queued behind a stall are preserved; an already failed save is +;; not re-reported as a stall. +;; +;; Emulation model — the fixture freezes the three inputs the watchdog +;; reads, so each test scripts time by hand: +;; - clock (`ct/now`): an atom. The test sets the time; time never flows. +;; - ticks (`rx/interval`): a subject. Each push runs one watchdog pass. +;; - network (`rp/cmd!`): answered when the test pushes into `:response` +;; (scenario timing stays in test hands); delivery is asynchronous, so +;; every phase awaits its effects before asserting them. +;; - reports (`errors/generate-report`/`submit-report`): recorded into +;; atoms for assertions; nothing leaves the test. Thunk reports are +;; evaluated through the `generate-report` double, mirroring production +;; (granted reports build, suppressed ones never exist here). +;; +;; Reading the tests below: every assert block is preceded by quiescence — +;; `wait-for` on its presence-conditions, or a bare `settle` tick when it +;; asserts only absence. (defn- with-watchdog + "Async fixture for the persistence watchdog tests: mocks the clock, timers + and RPC transport, and runs `f` with persistence initialized. + + Evaluates to a promise resolving once `f` settles and teardown completes; + `await` it from an `^:async` test. The transport answers when the test + pushes into `:response` (scenario timing stays in test hands); delivery + is asynchronous, so await each effect — via `wait-for` — before asserting + it. `f` is awaited (usually an `^:async` fn)." [f] (let [clock (atom 0) ticks (rx/subject) response (rx/subject) + requests (atom []) reports (atom []) causes (atom []) - render errors/generate-report file-id (uuid/next) 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 %))})] - (with-redefs [ct/now (mock/stub #(ct/inst @clock)) - rx/interval (mock/stub (fn [_] ticks)) - rp/cmd! (mock/stub (fn [_ _] (rx/take 1 response))) - st/state store - errors/generate-report (fn [cause] - (swap! causes conj cause) - (render cause)) - errors/submit-report (fn [& params] - (swap! reports conj (apply hash-map params)))] + (mock/with-mocks* + {ct/now (mock/stub #(ct/inst @clock)) + rx/interval (mock/stub (fn [_] ticks)) + rp/cmd! (mock/stub (fn [cmd params] + (swap! requests conj {:cmd cmd :params params}) + (->> response (rx/take 1) (rx/observe-on :async)))) + st/state store + errors/generate-report (fn [cause & _] + (swap! causes conj cause) + "report") + errors/submit-report (fn [& params] + ;; Mirrors production: a granted report builds + ;; its payload through `generate-report`, so a + ;; thunk report is evaluated here while a + ;; string report is recorded as it arrives. + (let [m (apply hash-map params)] + (swap! reports conj m) + (when (fn? (:report m)) + ((:report m))))) + st/ongoing-tasks (atom #{})} (try (ptk/emit! store (dps/initialize-persistence)) - (f {:clock clock :ticks ticks :response response :causes causes - :reports reports :store store :file-id file-id}) + (await (f {:clock clock :ticks ticks :response response :requests requests + :causes causes :reports reports :store store :file-id file-id})) (finally (rx/dispose! store) (rx/end! ticks) (rx/end! response)))))) -(t/deftest stalled-request-is-reported-once-without-discarding-edits - (with-watchdog - (fn [{:keys [clock ticks reports causes store file-id]}] - (ptk/emit! store (local-commit file-id) ::dps/force-persist) - (reset! clock 300000) - (rx/push! ticks :tick) - (t/is (empty? @reports) "Five minutes must elapse before reporting") +;; Scenario: persistence sits in a non-terminal status with an empty +;; queue past the deadline (a status transition racing the queue drain). +;; The watchdog must stay silent: with nothing queued there is nothing +;; stalled to report. Proves: no false-positive stall reports on an +;; empty queue. +(t/deftest ^:async empty-queue-never-reports-a-stall + (await + (with-watchdog + (^:async fn [{:keys [clock ticks reports store]}] + (ptk/emit! store (#'dps/update-status :pending)) + (reset! clock 300001) + (rx/push! ticks :tick) + (await (async/settle)) + (t/is (empty? @reports) "an empty queue is never a stall"))))) - ;; More local edits must not reset the stalled request's clock. - (reset! clock 300001) - (ptk/emit! store (drw/context-lost) - (local-commit file-id) ::dps/force-persist) - (rx/push! ticks :tick) - (t/is (= 1 (count @reports))) - (t/is (= "handled-exception" (:event-name (first @reports)))) - (let [data (ex-data (first @causes))] - (t/is (= :saving-stalled (:code data))) - (t/is (= file-id (:file-id data))) - (t/is (true? (:render-context-lost? data)))) +;; Scenario: the network hangs. One save goes out and is never answered. +;; Five minutes pass with no report (the deadline is exclusive); one second +;; later, with more edits piled behind the stalled request, the tick reports +;; the stall exactly once — as `handled-exception`, carrying the file id and +;; the lost render context — and later ticks repeat nothing while both edits +;; stay queued. Proves: one report per stall, no lost edits. +(t/deftest ^:async stalled-request-is-reported-once-without-discarding-edits + (await + (with-watchdog + (^:async fn [{:keys [clock ticks reports causes store file-id]}] + ;; Phase 1 — at exactly five minutes the deadline has not elapsed: silence. + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (reset! clock 300000) + (rx/push! ticks :tick) + (await (async/settle)) + (t/is (empty? @reports) "Five minutes must elapse before reporting") - (reset! clock 900000) - (rx/push! ticks :tick) - (t/is (= 1 (count @reports)) "Do not repeat a report for the same stall") - (t/is (= :saving (get-in @store [:persistence :status]))) - (t/is (= 2 (count (get-in @store [:persistence :queue]))))))) + ;; Phase 2 — one second past the deadline the stall reports exactly once. + ;; More local edits must not reset the stalled request's clock. + (reset! clock 300001) + (ptk/emit! store (drw/context-lost) + (local-commit file-id) ::dps/force-persist) + (rx/push! ticks :tick) + (await (async/wait-for #(= 1 (count @reports)) "stall report")) + (t/is (= 1 (count @reports))) + (t/is (= "handled-exception" (:event-name (first @reports)))) + (let [data (ex-data (first @causes))] + (t/is (= :saving-stalled (:code data))) + (t/is (= file-id (:file-id data))) + (t/is (true? (:render-context-lost? data)))) -(t/deftest successful-saves-reset-the-stall-clock-and-allow-a-new-report - (with-watchdog - (fn [{:keys [clock ticks response reports store file-id]}] - (ptk/emit! store (local-commit file-id) ::dps/force-persist - (local-commit file-id) ::dps/force-persist) - (reset! clock 290000) - (rx/push! response {:revn 1}) - (reset! clock 300001) - (rx/push! ticks :tick) - (t/is (empty? @reports) "The queue is making progress") + ;; Phase 3 — long after: no repeat, both edits still queued. + (reset! clock 900000) + (rx/push! ticks :tick) + (await (async/settle)) + (t/is (= 1 (count @reports)) "Do not repeat a report for the same stall") + (t/is (= :saving (get-in @store [:persistence :status]))) + (t/is (= 2 (count (get-in @store [:persistence :queue])))))))) - (reset! clock 590001) - (rx/push! ticks :tick) - (t/is (= 1 (count @reports)) "The second request has now stalled") +;; Scenario: answers arrive, then stop. Two commits share the first request; +;; awaiting its landing advances the queue and starts the second request, so +;; the tick finds progress and stays silent. Left hanging past a fresh +;; deadline it reports once; answering it saves the file and silences the +;; watchdog; a later hang reports again. Proves: progress resets the clock, +;; and every new stall earns its own report. +;; +;; Note the awaits: a push only schedules delivery, so each tick must +;; observe the completed save — awaiting after the push is what separates +;; "answered" from "completed". +(t/deftest ^:async successful-saves-reset-the-stall-clock-and-allow-a-new-report + (await + (with-watchdog + (^:async fn [{:keys [clock ticks reports response store file-id]}] + (ptk/emit! store (local-commit file-id) ::dps/force-persist + (local-commit file-id) ::dps/force-persist) + ;; Phase 1 — two commits share the first request; its landing starts the second. + (reset! clock 290000) + (rx/push! response {:revn 1}) + (await (async/wait-for #(= 1 (count (get-in @store [:persistence :queue]))) + "first save lands, second request starts")) + (reset! clock 300001) + (rx/push! ticks :tick) + (await (async/settle)) + (t/is (empty? @reports) "The queue is making progress") - (rx/push! response {:revn 2}) - (t/is (= :saved (get-in @store [:persistence :status]))) - (reset! clock 1000000) - (rx/push! ticks :tick) - (t/is (= 1 (count @reports)) "A saved file must not be reported") + ;; Phase 2 — the second request hangs past its own fresh deadline. + (reset! clock 590001) + (rx/push! ticks :tick) + (await (async/wait-for #(= 1 (count @reports)) "second request stalls")) + (t/is (= 1 (count @reports)) "The second request has now stalled") - (ptk/emit! store (local-commit file-id) ::dps/force-persist) - (reset! clock 1300001) - (rx/push! ticks :tick) - (t/is (= 2 (count @reports)) "A later stall gets its own report")))) + (rx/push! response {:revn 2}) + (await (async/wait-for #(and (= :saved (get-in @store [:persistence :status])) + (empty? (get-in @store [:persistence :queue]))) + "second save lands")) + (t/is (= :saved (get-in @store [:persistence :status]))) + ;; Phase 3 — answering saves the file: the tick stays silent. + (reset! clock 1000000) + (rx/push! ticks :tick) + (t/is (= 1 (count @reports)) "A saved file must not be reported") -(t/deftest pending-edits-are-monitored-without-extending-the-deadline - (with-watchdog - (fn [{:keys [clock ticks reports store]}] - (rx/push! ticks :tick) - (t/is (empty? @reports) "An idle file must not be reported") - (ptk/emit! store (#'dps/update-status :pending)) - (reset! clock 300001) - (ptk/emit! store (#'dps/update-status :pending)) - (rx/push! ticks :tick) - (t/is (= 1 (count @reports))) - (ptk/emit! store (#'dps/update-status :error)) - (reset! clock 900000) - (rx/push! ticks :tick) - (t/is (= 1 (count @reports)) "Do not report an already failed save")))) + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + ;; Phase 4 — a later hang is a new stall with its own report. + (reset! clock 1300001) + (rx/push! ticks :tick) + (await (async/wait-for #(= 2 (count @reports)) "later stall reports again")) + (t/is (= 2 (count @reports)) "A later stall gets its own report"))))) -(t/deftest reinitializing-persistence-replaces-the-watchdog - (let [active-timers (atom 0) - ticks (rx/subject) - store (ptk/store {:state {} :on-error #(t/is false (str %))})] - (with-redefs [rx/interval (mock/stub - (fn [_] - (rx/create - (fn [subscriber] - (swap! active-timers inc) - (let [subscription (.subscribe ticks subscriber)] - (fn [] - (rx/dispose! subscription) - (swap! active-timers dec)))))))] - (try - (ptk/emit! store (dps/initialize-persistence)) - (t/is (= 1 @active-timers)) - (ptk/emit! store (dps/initialize-persistence)) - (t/is (= 1 @active-timers)) - (finally - (rx/dispose! store) - (rx/end! ticks)))) - (t/is (zero? @active-timers)))) +;; Scenario: no network request exists at all — an edit sits `:pending` +;; locally without being sent. The watchdog still tracks it against the +;; original deadline (re-marking `:pending` does not push it): an idle +;; file never reports, an aged pending edit reports once, and once the +;; save fails outright the watchdog stands down — failures belong to the +;; save path, never twice. Proves: pending edits are watched without +;; extending deadlines, and failures are not re-reported as stalls. +(t/deftest ^:async pending-edits-are-monitored-without-extending-the-deadline + (await + (with-watchdog + (^:async fn [{:keys [clock ticks reports store file-id]}] + ;; Phase 1 — idle: nothing queued, nothing reported. + (rx/push! ticks :tick) + (await (async/settle)) + (t/is (empty? @reports) "An idle file must not be reported") + ;; Phase 2 — a queued (yet unsent) edit ages into one report, and + ;; re-marking pending does not extend its deadline. + (let [id (uuid/next)] + (ptk/emit! store + #(assoc % :persistence {:queue (conj #queue [] id) + :index {id {:id id :file-id file-id}}}))) + (ptk/emit! store (#'dps/update-status :pending)) + (reset! clock 300001) + (ptk/emit! store (#'dps/update-status :pending)) + (rx/push! ticks :tick) + (await (async/wait-for #(= 1 (count @reports)) "pending edit ages into a report")) + (t/is (= 1 (count @reports))) + ;; Phase 3 — an outright failure is not a stall: no second report. + (ptk/emit! store (#'dps/update-status :error)) + (reset! clock 900000) + (rx/push! ticks :tick) + (await (async/settle)) + (t/is (= 1 (count @reports)) "Do not report an already failed save"))))) +;; Scenario: initializing twice must replace the watchdog instead of stacking +;; it — a single active timer at all times, zero after teardown. Proves: +;; reinitialization swaps the timer subscription instead of leaking it. +;; (Fully synchronous bodies need no awaits; the promise shell still +;; guarantees restore and completion.) +(t/deftest ^:async reinitializing-persistence-replaces-the-watchdog + (await + (let [active-timers (atom 0) + ticks (rx/subject) + store (ptk/store {:state {} :on-error #(t/is false (str %))})] + (mock/with-mocks* + {rx/interval (mock/stub + (fn [_] + (rx/create + (fn [subscriber] + (swap! active-timers inc) + (let [subscription (.subscribe ticks subscriber)] + (fn [] + (rx/dispose! subscription) + (swap! active-timers dec))))))) + st/ongoing-tasks (atom #{})} + (try + (ptk/emit! store (dps/initialize-persistence)) + (t/is (= 1 @active-timers)) + (ptk/emit! store (dps/initialize-persistence)) + (t/is (= 1 @active-timers)) + (finally + (rx/dispose! store) + (rx/end! ticks) + (t/is (zero? @active-timers)))))))) + +;; Scenario: the first send fails transiently and the retry resend hangs +;; forever inside the `:retrying` episode. Past the 5-minute deadline the +;; watchdog must still report the stall exactly once — and never repeat +;; it — while the queued edit is preserved. Proves: the watchdog sees +;; hung resends; a `:retrying` episode cannot deadlock silently. +(t/deftest ^:async hung-retry-resend-is-reported-as-a-stall + (let [calls (atom 0) + timer-s (rx/subject)] + (await + (with-watchdog + (^:async fn [{:keys [clock ticks reports causes requests store file-id]}] + (await + (mock/with-mocks* + {rx/timer (mock/stub (fn [_] timer-s)) + rp/cmd! (mock/stub (fn [cmd params] + (swap! requests conj {:cmd cmd :params params}) + (if (= 1 (swap! calls inc)) + (rx/throw (ex-info "offline" {:type :offline})) + ;; The resend hangs forever: the subject + ;; is never answered nor failed. + (rx/subject))))} + ;; Phase 1 — first send fails transiently; the episode parks + ;; on the hand-fired timer. + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (await (async/wait-for #(= :retrying (get-in @store [:persistence :status])) + "transient failure retries")) + (t/is (= 1 (count @requests))) + ;; Phase 2 — the timer fires and the resend goes out, hanging. + (rx/push! timer-s :tick) + (await (async/wait-for #(= 2 (count @requests)) "retry resends")) + (t/is (= :retrying (get-in @store [:persistence :status]))) + ;; Phase 3 — past the deadline the watchdog reports the stall + ;; once, keeping the queued edit. + (reset! clock 300001) + (rx/push! ticks :tick) + (await (async/wait-for #(= 1 (count @reports)) "hung resend stalls")) + (t/is (= 1 (count @reports))) + (t/is (= "handled-exception" (:event-name (first @reports)))) + (t/is (= :saving-stalled (:code (ex-data (first @causes))))) + (t/is (= :retrying (get-in @store [:persistence :status]))) + (t/is (= 1 (count (get-in @store [:persistence :queue])))) + ;; Phase 4 — later ticks repeat nothing for the same stall. + (reset! clock 900000) + (rx/push! ticks :tick) + (await (async/settle)) + (t/is (= 1 (count @reports)) "Do not repeat a report for the same stall") + (rx/end! timer-s)))))))) + +;; Save pipeline tests. +;; +;; Production contract under test (`app.main.data.persistence`): +;; - Commits queue locally and flush in order; every request carries the +;; queued changes exactly once (no resends of active requests, no drops). +;; - Without edit permission nothing is sent and the failure flashes. +;; - Transport failures and malformed answers (`nil`, empty, bad revision) +;; fail the save but preserve the queue for retry. +;; - Initialization recovers gracefully: dangling runners error instead of +;; skipping, unsent commits are picked up, unknown outcomes are sent again +;; under the same commit id. +;; +;; Same async pattern as the watchdog tests: triggers stay bare, every +;; assert block is preceded by `wait-for` on its leading signal (or a bare +;; `settle` tick when it asserts only absence). (defn- with-persistence - [f] + "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. + + By default the transport responds through the `:response` subject. Pass a + `respond` function (`(fn [cmd params] observable)`) to drive the transport + response directly instead. Delivery through the subject is asynchronous + (`observe-on :async`): await each effect — via `wait-for` — before + asserting it." + [f & [respond]] (let [file-id (uuid/next) 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 %))})] - (with-redefs [rp/cmd! (mock/stub (fn [cmd params] - (swap! requests conj [cmd params]) - (rx/take 1 response))) - errors/flash (fn [& {:keys [cause]}] - (swap! failures conj cause))] + (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)) + st/ongoing-tasks tasks} (try (ptk/emit! store (dps/initialize-persistence)) - (f {:file-id file-id :response response :failures failures - :requests requests :store store}) + (await (f {:file-id file-id :response response :failures failures + :requests requests :store store :tasks tasks})) (finally (rx/dispose! store) (rx/end! response)))))) -(t/deftest permission-loss-fails-without-discarding-queued-edits - (with-persistence - (fn [{:keys [file-id requests failures store]}] - (ptk/emit! store (local-commit file-id) - #(assoc-in % [:permissions :can-edit] false) - ::dps/force-persist) - (t/is (= :error (get-in @store [:persistence :status]))) - (t/is (= 1 (count (get-in @store [:persistence :queue])))) - (t/is (empty? @requests)) - (t/is (= 1 (count @failures))) - (ptk/emit! store (local-commit file-id) ::dps/force-persist - (#'dps/update-status :pending)) - (t/is (= :error (get-in @store [:persistence :status]))) - (t/is (= 2 (count (get-in @store [:persistence :queue]))))))) +;; Scenario: edit permission is revoked with an edit queued. The save fails +;; without sending anything, the queue keeps the edit and the user is +;; notified once, so `wait-persisted-or-error` still rejects and nothing is +;; snapshotted from unsaved state. Proves: permission loss fails safe. +(t/deftest ^:async permission-loss-retains-the-queue-and-notifies-once + (await + (with-persistence + (^:async fn [{:keys [file-id requests failures store]}] + (ptk/emit! store (local-commit file-id) + #(assoc-in % [:permissions :can-edit] false) + ::dps/force-persist) + (await (async/wait-for #(and (= :error (get-in @store [:persistence :status])) + (= 1 (count (get-in @store [:persistence :queue])))) + "permission loss fails the save")) + (t/is (= :error (get-in @store [:persistence :status]))) + (t/is (= 1 (count (get-in @store [:persistence :queue]))) + "the undeliverable edit is retained, so waiters keep rejecting") + (t/is (empty? @requests)) + (t/is (= 1 (count @failures))))))) -(t/deftest failed-request-retains-the-queue-and-is-not-retried-on-initialization +;; Scenario: the same terminal failure, then the user opens a file again. +;; Opening a file releases the edit that can never be saved and settles the +;; editor, instead of leaving it halted until a reload. Proves: the halt does +;; not outlive the visit that caused it. +(t/deftest ^:async opening-a-file-again-releases-a-terminal-failure + (await + (with-persistence + (^:async fn [{:keys [file-id requests failures store]}] + (ptk/emit! store (local-commit file-id) + #(assoc-in % [:permissions :can-edit] false) + ::dps/force-persist) + (await (async/wait-for #(and (= :error (get-in @store [:persistence :status])) + (= 1 (count (get-in @store [:persistence :queue])))) + "the save fails terminally")) + ;; The user acts again: a team-role change is one of the two real + ;; recovery triggers (the other is opening a file, whose event does + ;; real work and is not usable as a bare signal here). + (ptk/emit! store (ptk/data-event :app.main.data.common/change-team-role)) + (await (async/wait-for #(and (= :saved (get-in @store [:persistence :status])) + (empty? (get-in @store [:persistence :queue]))) + "re-entering the file settles the queue")) + (t/is (nil? (get-in @store [:persistence :error])) + "the halt is cleared once the user comes back") + (t/is (empty? @requests) + "the edit that cannot be saved is not replayed on re-entry") + (t/is (= 1 (count @failures)) "the user is still notified exactly once"))))) + +;; Scenario: two files have pending edits and the first send fails +;; terminally. Opening a file again releases the failed file, the other file +;; still saves, and the editor settles saved instead of staying halted. +;; Proves: one file that cannot be saved does not block every other file. +(t/deftest ^:async terminal-failure-does-not-block-other-files + (let [files (into [] (repeatedly 2 uuid/next)) + sends (atom 0)] + (await + (with-persistence + (^:async fn [{:keys [requests store]}] + (ptk/emit! store + #(assoc % :files (into (:files %) + (map (fn [id] [id {:id id :revn 0}])) + files)) + (local-commit (nth files 0)) + (local-commit (nth files 1)) + ::dps/force-persist) + (await (async/wait-for #(seq @requests) "the first file is sent")) + (let [failed-file (get-in (second (first @requests)) [:id])] + (await (async/wait-for #(and (= :error (get-in @store [:persistence :status])) + (not (empty? (get-in @store [:persistence :queue])))) + "the terminal failure retains the queue")) + ;; The user acts again: recovery releases the failed file and drains + ;; the rest. + (ptk/emit! store (ptk/data-event :app.main.data.common/change-team-role)) + (await (async/wait-for #(and (= :saved (get-in @store [:persistence :status])) + (empty? (get-in @store [:persistence :queue]))) + "the released file frees the rest of the queue")) + (t/is (= 2 (count @requests)) + "the other file was saved after the failed one was released") + (t/is (= 1 (count (filter #(= failed-file (get-in (second %) [:id])) @requests))) + "the failed file is sent once, never replayed"))) + (fn [_ _] + ;; Fail the first send terminally and answer the rest inline, so no + ;; hot-subject race can swallow the answer. + (if (= 1 (swap! sends inc)) + (rx/throw (ex-info "rejected" {:type :validation :code :invalid-data})) + (rx/of {:revn 1}))))))) + +(defn- check-save-failure-warning + "Fails a queued save with `cause-type` and asserts the hint shown to the + user; authentication failures have their own UI and must stay silent." + [cause-type] (with-persistence - (fn [{:keys [file-id response requests store]}] - (ptk/emit! store (local-commit file-id) ::dps/force-persist - (local-commit file-id) ::dps/force-persist) - (.error response (ex-info "Connection lost" {:type :network})) + (^:async fn [{:keys [file-id response store]}] + (let [notifications (atom [])] + (await + (mock/with-mocks* + {errors/flash (fn [& params] + (swap! notifications conj (apply hash-map params))) + i18n/tr (mock/stub #(str "translated:" %))} + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (.error response (ex-info "Raw transport details" {:type cause-type})) + (await (async/wait-for #(= :error (get-in @store [:persistence :status])) + "failed request errors the save")) + (t/is (= :error (get-in @store [:persistence :status]))) + (let [data (get-in @store [:persistence :error])] + (ptk/handle-error (assoc data ::errors/instance (ex-info "Save failed" data)))) + (if (= cause-type :authentication) + (do (await (async/settle)) + (t/is (empty? @notifications))) + (do (await (async/wait-for #(seq @notifications) "save-failure toast")) + (t/is (= ["translated:errors.save-failed"] + (mapv :hint @notifications))))))))))) + +;; Variant: an authentication failure stays silent (own UI flow). +(t/deftest ^:async authentication-save-failure-shows-no-warning + (await (check-save-failure-warning :authentication))) + +;; NOTE: the `:network` and `:offline` warning variants lived here while +;; transport failures went straight to `:error`. Transient failures now +;; retry instead, so their coverage moved to the retry tests below (and to +;; the exhaustion test for the terminal toast). + +;; The transient/terminal classification is pure: transport failures and +;; unusable save responses retry with backoff, everything else stays +;; terminal. Note the wrapped shape: `persistence-failed` records the +;; original cause under `:cause-type` with `:type :persistence`. +(t/deftest transient-error-classification + (t/is (dps/transient-error? {:type :network})) + (t/is (dps/transient-error? {:type :offline})) + (t/is (dps/transient-error? {:type :bad-gateway})) + (t/is (dps/transient-error? {:type :service-unavailable})) + (t/is (dps/transient-error? {:type :persistence :cause-type :network})) + (t/is (dps/transient-error? {:type :persistence :cause-type :offline})) + (t/is (dps/transient-error? {:type :internal :cause-type :bad-gateway})) + (t/is (dps/transient-error? {:type :persistence :cause-type :service-unavailable})) + ;; The wrapped shape stays transient with an explicit non-retry code too: + ;; the cause-type carries the transport verdict, not the wrapper's code. + (t/is (dps/transient-error? {:type :persistence :cause-type :service-unavailable :code :save-failed})) + (t/is (dps/transient-error? {:type :persistence :cause-type :bad-gateway :code :save-failed})) + (t/is (dps/transient-error? {:type :persistence :code :invalid-save-response})) + (t/is (not (dps/transient-error? {:type :authentication}))) + (t/is (not (dps/transient-error? {:type :validation}))) + (t/is (not (dps/transient-error? {:type :internal}))) + (t/is (not (dps/transient-error? {:type :persistence :cause-type :authentication}))) + (t/is (not (dps/transient-error? {:type :persistence :code :missing-commit}))) + (t/is (not (dps/transient-error? {:type :persistence :code :save-permission-denied}))) + (t/is (not (dps/transient-error? {})))) + +;; The transient set is owned by `repo/retryable-types`: every transport +;; type retryable at the HTTP layer must also be transient for the save +;; pipeline, in both the direct and the wrapped (`persistence-failed`) +;; positions. Proves: the two classifications cannot drift apart. +(t/deftest transient-classification-follows-repo-retryable-types + (doseq [transport-type rp/retryable-types] + (t/testing (str "transport type " transport-type " is transient in both positions") + (t/is (dps/transient-error? {:type transport-type})) + (t/is (dps/transient-error? {:type :persistence :cause-type transport-type}))))) + +;; Scenario: a save fails transiently and the episode parks on its backoff +;; timer. A waiter started mid-episode must not resolve on the `:retrying` +;; transition — only the terminal save releases it. Proves: `:retrying` is +;; non-terminal for waiters. +(t/deftest waiter-release-rule + ;; The waiter release rule is pure: only a failed save or a settled + ;; (`nil` / `:saved`) empty queue releases waiters. In particular, the + ;; `:retrying` episode — queue non-empty, status non-terminal — never + ;; does. Proves: `:retrying` is non-terminal for waiters, a document of + ;; intent over the `wait-persisted-or-error` filter. + ;; + ;; Note: this intentionally avoids scripting the global store atom — it + ;; is shared with the whole suite, so any test reading it observes + ;; other namespaces' leftovers depending on run order. + (t/is (dps/terminal-status? {:status :error :queue [1]})) + (t/is (dps/terminal-status? {:status :saved :queue []})) + (t/is (dps/terminal-status? {:status nil :queue []})) + (t/is (dps/terminal-status? {:status nil :queue nil})) + (t/is (not (dps/terminal-status? {:status :retrying :queue [1]}))) + (t/is (not (dps/terminal-status? {:status :saving :queue [1]}))) + (t/is (not (dps/terminal-status? {:status :pending :queue [1]}))) + (t/is (not (dps/terminal-status? {:status :saved :queue [1]})))) + +;; Scenario: the queue references a commit id with no matching commit +;; (plus a dangling run id) when persistence initializes. It must error +;; instead of silently skipping the unknown entry, keeping it queued and +;; sending nothing. Proves: dangling queue entries fail loudly, never skip. +(t/deftest ^:async missing-commit-is-an-error-instead-of-skipping-changes + (await + (with-persistence + (^:async fn [{:keys [requests store]}] + (let [id (uuid/next)] + (ptk/emit! store + #(assoc % :persistence {:queue (conj #queue [] id) + :index {} :run-id (uuid/next) + :status :saving}) + (dps/initialize-persistence)) + (await (async/wait-for #(= :error (get-in @store [:persistence :status])) + "dangling commit errors instead of skipping")) + (t/is (= :error (get-in @store [:persistence :status]))) + (t/is (= [id] (vec (get-in @store [:persistence :queue])))) + (t/is (empty? @requests))))))) + +;; Scenario: a valid but unsent commit sits queued with a dangling run id +;; when persistence initializes. It is sent exactly once and, once answered, +;; the file saves with an empty queue. Proves: unsent commits survive a +;; stale runner — neither stuck nor duplicated. +(t/deftest ^:async initialization-recovers-an-unsent-commit-with-a-dangling-run-id + (await + (with-persistence + (^:async fn [{:keys [file-id response requests store]}] + (let [commit (assoc @(local-commit file-id) :changes []) + id (:id commit)] + (ptk/emit! store + #(assoc % :persistence {:queue (conj #queue [] id) + :index {id commit} :run-id (uuid/next) + :status :saving}) + (dps/initialize-persistence)) + (await (async/wait-for #(= 1 (count @requests)) "dangling commit is sent")) + (t/is (= 1 (count @requests))) + (rx/push! response {:revn 1}) + (await (async/wait-for #(and (= :saved (get-in @store [:persistence :status])) + (empty? (get-in @store [:persistence :queue]))) + "recovered save lands")) + (t/is (= :saved (get-in @store [:persistence :status]))) + (t/is (empty? (get-in @store [:persistence :queue])))))))) + +(defn- check-active-request-not-resent + "Sends a commit, interrupts the active request with `interrupt` and + reinitializes persistence: the pending request must not be sent again." + [interrupt] + (with-persistence + (^:async fn [{:keys [file-id response requests store]}] + (apply ptk/emit! store (local-commit file-id) ::dps/force-persist interrupt) (ptk/emit! store (dps/initialize-persistence)) - (t/is (= :error (get-in @store [:persistence :status]))) - (t/is (= 2 (count (get-in @store [:persistence :queue])))) - (t/is (= 1 (count @requests)))))) - -(t/deftest save-failures-use-a-translated-warning-except-for-authentication - (doseq [cause-type [:network :offline :authentication]] - (with-persistence - (fn [{:keys [file-id response store]}] - (let [notifications (atom [])] - (with-redefs [errors/flash (fn [& params] - (swap! notifications conj (apply hash-map params))) - i18n/tr (mock/stub #(str "translated:" %))] - (ptk/emit! store (local-commit file-id) ::dps/force-persist) - (.error response (ex-info "Raw transport details" {:type cause-type})) - (t/is (= :error (get-in @store [:persistence :status]))) - (let [data (get-in @store [:persistence :error])] - (ptk/handle-error (assoc data ::errors/instance (ex-info "Save failed" data)))) - (if (= cause-type :authentication) - (t/is (empty? @notifications)) - (t/is (= ["translated:errors.save-failed"] - (mapv :hint @notifications)))))))))) - -(t/deftest missing-commit-is-an-error-instead-of-skipping-changes - (with-persistence - (fn [{:keys [requests store]}] - (let [id (uuid/next)] - (ptk/emit! store - #(assoc % :persistence {:queue (conj #queue [] id) - :index {} :run-id (uuid/next) - :status :saving}) - (dps/initialize-persistence)) - (t/is (= :error (get-in @store [:persistence :status]))) - (t/is (= [id] (vec (get-in @store [:persistence :queue])))) - (t/is (empty? @requests)))))) - -(t/deftest initialization-recovers-an-unsent-commit-with-a-dangling-run-id - (with-persistence - (fn [{:keys [file-id response requests store]}] - (let [commit (assoc @(local-commit file-id) :changes []) - id (:id commit)] - (ptk/emit! store - #(assoc % :persistence {:queue (conj #queue [] id) - :index {id commit} :run-id (uuid/next) - :status :saving}) - (dps/initialize-persistence)) - (t/is (= 1 (count @requests))) - (rx/push! response {:revn 1}) - (t/is (= :saved (get-in @store [:persistence :status]))) - (t/is (empty? (get-in @store [:persistence :queue]))))))) - -(t/deftest an-active-request-is-never-sent-twice - (doseq [interrupt [[(dps/initialize-persistence)] - [(ptk/data-event ::dps/error)]]] - (with-persistence - (fn [{:keys [file-id response requests store]}] - (apply ptk/emit! store (local-commit file-id) ::dps/force-persist interrupt) - (ptk/emit! store (dps/initialize-persistence)) - (t/is (= 1 (count @requests))) - (rx/push! response {:revn 1}) - (t/is (= :saved (get-in @store [:persistence :status]))) - (t/is (empty? (get-in @store [:persistence :queue]))))))) - -(t/deftest permission-restoration-resumes-only-unsent-edits - (with-persistence - (fn [{:keys [file-id response requests store]}] - (ptk/emit! store (local-commit file-id) ::dps/force-persist - (local-commit file-id) ::dps/force-persist - #(assoc-in % [:permissions :can-edit] false)) - (rx/push! response {:revn 1}) - (t/is (= :error (get-in @store [:persistence :status]))) - (t/is (= 1 (count (get-in @store [:persistence :queue])))) - (ptk/emit! store - #(assoc-in % [:permissions :can-edit] true) - (ptk/data-event :app.main.data.common/change-team-role)) - (t/is (= 2 (count @requests))) - (rx/push! response {:revn 2}) - (t/is (= :saved (get-in @store [:persistence :status]))) - (t/is (empty? (get-in @store [:persistence :queue])))))) - -(t/deftest recovery-keeps-an-acknowledgment-received-without-a-runner - (with-persistence - (fn [{:keys [file-id response requests store]}] - (ptk/emit! store (local-commit file-id) ::dps/force-persist - (ptk/data-event ::dps/error)) - (rx/push! response {:revn 1}) - (t/is (= 1 (count (get-in @store [:persistence :queue])))) - (ptk/emit! store (dps/initialize-persistence)) - (t/is (= 1 (count @requests)) "The acknowledged changes must not be sent again") - (t/is (= :saved (get-in @store [:persistence :status]))) - (t/is (empty? (get-in @store [:persistence :queue])))))) - -(t/deftest recovery-reports-an-unknown-request-outcome-without-replaying-it - (with-persistence - (fn [{:keys [file-id requests store]}] - (let [commit (assoc @(local-commit file-id) ::dps/request-id (uuid/next)) - id (:id commit)] - (ptk/emit! store - #(assoc % :persistence {:queue (conj #queue [] id) - :index {id commit} :status :saving}) - (dps/initialize-persistence)) - (t/is (= :error (get-in @store [:persistence :status]))) - (t/is (= :save-outcome-unknown (get-in @store [:persistence :error :code]))) - (t/is (= [id] (vec (get-in @store [:persistence :queue])))) - (t/is (empty? @requests)))))) - -(t/deftest initialization-flushes-buffered-edits-without-duplicating-them - (with-persistence - (fn [{:keys [file-id response requests store]}] - (ptk/emit! store (local-commit file-id) - (dps/initialize-persistence) - ::dps/force-persist) + (await (async/wait-for #(= 1 (count @requests)) "only the active request is sent")) (t/is (= 1 (count @requests))) - (t/is (= 1 (count (get-in @store [:persistence :queue])))) (rx/push! response {:revn 1}) - (t/is (= :saved (get-in @store [:persistence :status])))))) + (await (async/wait-for #(and (= :saved (get-in @store [:persistence :status])) + (empty? (get-in @store [:persistence :queue]))) + "active request completes")) + (t/is (= :saved (get-in @store [:persistence :status]))) + (t/is (empty? (get-in @store [:persistence :queue])))))) -(t/deftest synchronous-save-results-do-not-leave-a-dangling-runner - (with-persistence - (fn [{:keys [file-id store]}] - (with-redefs [rp/cmd! (mock/stub (fn [_ _] (rx/of {:revn 1})))] - (ptk/emit! store (local-commit file-id) ::dps/force-persist) - (t/is (= :saved (get-in @store [:persistence :status]))) - (t/is (empty? (get-in @store [:persistence :queue]))))))) +;; Variant: the interrupt is a reinitialization. +(t/deftest ^:async reinitializing-does-not-resend-an-active-request + (await (check-active-request-not-resent [(dps/initialize-persistence)]))) -(t/deftest empty-or-invalid-save-responses-preserve-the-queue-as-failed - (doseq [result [(rx/empty) (rx/of nil) (rx/of {:revn -1})]] - (with-persistence - (fn [{:keys [file-id store]}] - (with-redefs [rp/cmd! (mock/stub (fn [_ _] result))] - (ptk/emit! store (local-commit file-id) ::dps/force-persist) - (t/is (= :error (get-in @store [:persistence :status]))) - (t/is (= :invalid-save-response (get-in @store [:persistence :error :code]))) - (t/is (= 1 (count (get-in @store [:persistence :queue]))))))))) +;; Variant: the interrupt is a save error event. +(t/deftest ^:async save-error-does-not-resend-an-active-request + (await (check-active-request-not-resent [(ptk/data-event ::dps/error)]))) + +;; Scenario: permission is lost mid-flight, so the save fails terminally. +;; Even if the permission comes back, recovery releases the undeliverable +;; edits instead of replaying them. The backend raises `:not-found` for a +;; lost edit permission, so a resend would only route the user to the +;; exception page. Proves: permission loss is treated as permanent, like +;; every other terminal failure. +(t/deftest ^:async permission-loss-is-released-not-resumed + (await + (with-persistence + (^:async fn [{:keys [file-id requests store]}] + (ptk/emit! store (local-commit file-id) + #(assoc-in % [:permissions :can-edit] false) + ::dps/force-persist) + (await (async/wait-for #(and (= :error (get-in @store [:persistence :status])) + (= 1 (count (get-in @store [:persistence :queue])))) + "permission loss fails the save")) + ;; Permission comes back and a file is opened again. + (ptk/emit! store #(assoc-in % [:permissions :can-edit] true) + (ptk/data-event :app.main.data.common/change-team-role)) + (await (async/wait-for #(and (= :saved (get-in @store [:persistence :status])) + (empty? (get-in @store [:persistence :queue]))) + "recovery releases the undeliverable edit")) + (t/is (empty? @requests) + "the undeliverable edit is never replayed, not even once the + permission is back") + (t/is (not= :error (get-in @store [:persistence :status])) + "the editor is not left halted"))))) + +;; Scenario: a terminal failure is waiting, and persistence is re-initialized. +;; Initialization must not lift the halt: only opening a file does. Otherwise +;; the edits would be released the moment the workspace view mounts, instead +;; of when the user acts on them. Proves: the init/recovery split holds. +(t/deftest ^:async initialization-does-not-lift-a-halt + (await + (with-persistence + (^:async fn [{:keys [file-id response store]}] + (ptk/emit! store (local-commit file-id) ::dps/force-persist) + (.error response (ex-info "Validation failed" {:type :validation})) + (await (async/wait-for #(and (= :error (get-in @store [:persistence :status])) + (= 1 (count (get-in @store [:persistence :queue])))) + "the save fails terminally")) + (ptk/emit! store (dps/initialize-persistence)) + (await (async/settle)) + (t/is (= :error (get-in @store [:persistence :status])) + "initialization leaves the halt alone") + (t/is (= 1 (count (get-in @store [:persistence :queue]))) + "and keeps the undeliverable edits queued until the user acts"))))) + +;; Scenario: the answer arrives but no runner is tracking the request +;; anymore. The acknowledged commit stays queued instead of being dropped; +;; on initialization it is settled as saved without resending. Proves: late +;; acknowledgments are neither lost nor replayed. +(t/deftest ^:async recovery-keeps-an-acknowledgment-received-without-a-runner + (await + (with-persistence + (^:async fn [{:keys [file-id response requests store]}] + (ptk/emit! store (local-commit file-id) ::dps/force-persist + (ptk/data-event ::dps/error)) + (rx/push! response {:revn 1}) + (await (async/wait-for #(= 1 (count (get-in @store [:persistence :queue]))) + "acknowledged commit stays queued")) + (t/is (= 1 (count (get-in @store [:persistence :queue])))) + (ptk/emit! store (dps/initialize-persistence)) + (await (async/wait-for #(and (= :saved (get-in @store [:persistence :status])) + (empty? (get-in @store [:persistence :queue]))) + "recovery completes without resending")) + (t/is (= 1 (count @requests)) "The acknowledged changes must not be sent again") + (t/is (= :saved (get-in @store [:persistence :status]))) + (t/is (empty? (get-in @store [:persistence :queue]))))))) + +;; Scenario: a queued commit carries a request id but persistence has no +;; run id for it when initializing, so its outcome is unknown. It is sent +;; again under the same commit id and saves. Proves: an unknown outcome is +;; resent, since changes are idempotent. +(t/deftest ^:async recovery-sends-again-a-save-with-an-unknown-outcome + (await + (with-persistence + (^:async fn [{:keys [file-id response requests store]}] + (let [commit (assoc @(local-commit file-id) ::dps/request-id (uuid/next)) + id (:id commit)] + (ptk/emit! store + #(assoc % :persistence {:queue (conj #queue [] id) + :index {id commit} :status :saving}) + (dps/initialize-persistence)) + (await (async/wait-for #(= 1 (count @requests)) "the commit is sent again")) + (t/is (= id (:commit-id (second (first @requests))))) + (rx/push! response {:revn 1}) + (await (async/wait-for #(and (= :saved (get-in @store [:persistence :status])) + (empty? (get-in @store [:persistence :queue]))) + "the resent commit saves")) + (t/is (= 1 (count @requests)))))))) + +;; Scenario: an edit is queued before persistence even initializes. On +;; initialization plus force-persist it is sent exactly once (still queued +;; until answered); once answered, the file saves. Proves: pre-init buffered +;; edits flush exactly once, without duplicating. +(t/deftest ^:async initialization-flushes-buffered-edits-without-duplicating-them + (await + (with-persistence + (^:async fn [{:keys [file-id response requests store]}] + (ptk/emit! store (local-commit file-id) + (dps/initialize-persistence) + ::dps/force-persist) + (await (async/wait-for #(and (= 1 (count @requests)) + (= 1 (count (get-in @store [:persistence :queue])))) + "buffered edit is sent once")) + (t/is (= 1 (count @requests))) + (t/is (= 1 (count (get-in @store [:persistence :queue])))) + (rx/push! response {:revn 1}) + (await (async/wait-for #(= :saved (get-in @store [:persistence :status])) + "buffered edit saves")) + (t/is (= :saved (get-in @store [:persistence :status]))))))) + +;; Scenario: the transport answers synchronously (immediate observable). +;; The save completes, the queue empties, and no runner is left dangling. +;; Proves: synchronous transport responses settle cleanly. +(t/deftest ^:async synchronous-save-results-do-not-leave-a-dangling-runner + (await + (with-persistence + (^:async fn [{:keys [file-id store]}] + (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]))) + "synchronous save completes")) + (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: a save fails terminally, then recovery releases the edit. The +;; guard stays on while the failed edit is retained, and turns off once it +;; is released. Proves: a release that empties the queue also turns the +;; leave-page warning off. +(t/deftest ^:async releasing-a-failed-edit-turns-the-leave-page-guard-off + (await + (with-persistence + (^:async fn [{:keys [file-id store tasks]}] + (ptk/emit! store (local-commit file-id) + #(assoc-in % [:permissions :can-edit] false) + ::dps/force-persist) + (await (async/wait-for #(= :error (get-in @store [:persistence :status])) + "the save fails terminally")) + (await (async/settle)) + (t/is (contains? @tasks :persistence) "the retained edit keeps the guard on") + (ptk/emit! store (ptk/data-event :app.main.data.common/change-team-role)) + (await (async/wait-for #(empty? (get-in @store [:persistence :queue])) + "recovery releases the edit")) + (await (async/wait-for #(not (contains? @tasks :persistence)) + "the release turns the guard off")) + (t/is (= :saved (get-in @store [:persistence :status]))))))) diff --git a/frontend/test/frontend_tests/data/repo_test.cljs b/frontend/test/frontend_tests/data/repo_test.cljs index 6b0f99e742..9c9c6a7355 100644 --- a/frontend/test/frontend_tests/data/repo_test.cljs +++ b/frontend/test/frontend_tests/data/repo_test.cljs @@ -8,7 +8,8 @@ (:require [app.main.repo :as repo] [beicon.v2.core :as rx] - [cljs.test :as t :include-macros true])) + [cljs.test :as t :include-macros true] + [cuerdas.core :as str])) ;; --------------------------------------------------------------------------- ;; retryable-error? tests (synchronous) @@ -29,6 +30,11 @@ (let [err (ex-info "service unavailable" {:type :service-unavailable})] (t/is (true? (repo/retryable-error? err)))))) +(t/deftest retryable-error-gateway-error + (t/testing "504 and the Cloudflare 52x family are retryable" + (let [err (ex-info "http error" {:type :gateway-error})] + (t/is (true? (repo/retryable-error? err)))))) + (t/deftest retryable-error-offline (t/testing "offline (status 0) is retryable" (let [err (ex-info "offline" {:type :offline})] @@ -215,3 +221,123 @@ (t/is (= 2 @call-count)) (t/is (= :authentication (:type (ex-data err)))) (done)))))))) + +;; --------------------------------------------------------------------------- +;; handle-response classification tests +;; --------------------------------------------------------------------------- + +(defn- capture-error + "Subscribes to `handle-response` for `response` and calls `k` with the + `ex-data` of the raised error." + [response k] + (->> (repo/handle-response response) + (rx/subs! + (fn [_] (t/is false "expected an error response") (k nil)) + (fn [cause] (k (ex-data cause)))))) + +(def ^:private html-error-page + "Web Page Blockedblocked") + +(t/deftest handle-response-gateway-statuses + (t/testing "every edge status that never reached the backend is a gateway error" + (t/async done + (let [statuses [504 520 521 522 523 524] + pending (atom (count statuses))] + (doseq [status statuses] + (capture-error {:status status + :body html-error-page + :headers {"content-type" "text/html"} + :uri "https://design.penpot.app/api/main/methods/get-teams"} + (fn [data] + (t/is (= :gateway-error (:type data)) + (str "status " status " should be a gateway error")) + (t/is (= status (:status data)) + (str "status " status " should be carried through")) + (when (zero? (swap! pending dec)) + (done))))))))) + +(t/deftest handle-response-rate-limit + (t/testing "a 429 with no interpretable body is a rate-limit error" + (t/async done + (capture-error {:status 429 + :body "" + :headers {} + :uri "https://design.penpot.app/api/main/methods/get-teams"} + (fn [data] + (t/is (= :rate-limit (:type data))) + (t/is (= 429 (:status data))) + (done)))))) + +(t/deftest handle-response-intercepted-by-proxy + (t/testing "an error page from a filtering proxy is not an internal error" + (t/async done + (capture-error {:status 403 + :body html-error-page + :headers {"content-type" "text/html" + "server" "Zscaler/6.2"} + :uri "https://design.penpot.app/api/main/methods/update-file"} + (fn [data] + (t/is (= :unexpected-response (:type data))) + (t/is (= 403 (:status data))) + (done)))))) + +(t/deftest handle-response-keeps-body-excerpt + (t/testing "a body too long to keep is cut short and marked as cut" + (t/async done + (capture-error {:status 403 + :body (apply str (repeat 5000 "x")) + :headers {"content-type" "text/html"} + :uri "https://design.penpot.app/api/main/methods/update-file"} + (fn [data] + (t/is (= 503 (count (:data data))) "500 characters and an ellipsis") + (t/is (str/ends-with? (:data data) "...")) + (done)))))) + +(t/deftest handle-response-keeps-a-short-body-whole + (t/testing "a body short enough to read is passed through untouched" + (t/async done + (capture-error {:status 403 + :body html-error-page + :headers {"content-type" "text/html"} + :uri "https://design.penpot.app/api/main/methods/update-file"} + (fn [data] + (t/is (= html-error-page (:data data))) + (done)))))) + +(t/deftest handle-response-challenge-still-authorization + (t/testing "a Cloudflare challenge keeps its own type" + (t/async done + (capture-error {:status 403 + :body html-error-page + :headers {"server" "cloudflare" + "cf-mitigated" "challenge"} + :uri "https://design.penpot.app/api/main/methods/get-teams"} + (fn [data] + (t/is (= :authorization (:type data))) + (t/is (= :challenge-required (:code data))) + (done)))))) + +(t/deftest handle-response-keeps-backend-error + (t/testing "an error the backend itself reported is passed through untouched" + (t/async done + (capture-error {:status 400 + :body {:type :validation :code :missing-param} + :headers {"content-type" "application/transit+json"} + :uri "https://design.penpot.app/api/main/methods/update-file"} + (fn [data] + (t/is (= :validation (:type data))) + (t/is (= :missing-param (:code data))) + (t/is (= 400 (:status data))) + (done)))))) + +(t/deftest handle-response-undecodable-non-error-is-internal + (t/testing "a non-error response we cannot interpret is still an internal error" + (t/async done + (capture-error {:status 301 + :body html-error-page + :headers {"content-type" "text/html"} + :uri "https://design.penpot.app/api/main/methods/get-teams"} + (fn [data] + (t/is (= :internal (:type data))) + (t/is (= :unable-to-process-repository-response (:code data))) + (done)))))) diff --git a/frontend/test/frontend_tests/errors_governor_test.cljs b/frontend/test/frontend_tests/errors_governor_test.cljs new file mode 100644 index 0000000000..a51f775a43 --- /dev/null +++ b/frontend/test/frontend_tests/errors_governor_test.cljs @@ -0,0 +1,403 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS INC Sucursal en España SL + +(ns frontend-tests.errors-governor-test + "Unit tests for the error report governor (`app.main.errors`). + + Tests cover: + - error fingerprinting – stable identity incl. wrapper stacks + - reserve-report* – pure window/count/eviction decisions + - submit-report – governed emission, thunk reports + - flash report pipeline – reserve-before-generate, totality" + (:require + [app.main.data.event :as ev] + [app.main.errors :as errors] + [app.main.router :as rt] + [app.main.store :as st] + [app.util.timers :as tm] + [cljs.test :as t :include-macros true] + [cuerdas.core :as str] + [frontend-tests.helpers.mock :as mock] + [potok.v2.core :as ptk])) + +;; --------------------------------------------------------------------------- +;; Error report governor +;; +;; The governor deduplicates report by fingerprint: the first occurrence is +;; always emitted, repeats inside a 2 minute window are counted, and the +;; fingerprint cache is bounded (the oldest entry is evicted when full). +;; --------------------------------------------------------------------------- + +(t/use-fixtures :each {:before #(errors/reset-report-governor!)}) + +(defn- error-cause + [& {:keys [type code hint]}] + (ex-info (or hint "boom") + (cond-> {} + (some? type) (assoc :type type) + (some? code) (assoc :code code) + (some? hint) (assoc :hint hint)))) + +(defn- capture-reports! + "Run `f` capturing the events emitted through `st/emit!`." + [f] + (let [events (atom [])] + (with-redefs [st/emit! (mock/stub (fn [& emitted] (swap! events into emitted))) + rt/get-current-href (constantly "https://penpot.example.com/#/workspace")] + (f) + @events))) + +(t/deftest fingerprint-is-stable-for-equivalent-errors + (let [cause-a (error-cause :type :network :code :fetch-failed :hint "unable to perform fetch operation") + cause-b (error-cause :type :network :code :fetch-failed :hint "unable to perform fetch operation")] + (t/is (= (errors/error-fingerprint "handled-exception" cause-a) + (errors/error-fingerprint "handled-exception" cause-b))))) + +(t/deftest fingerprint-changes-with-error-identity + (let [base (error-cause :type :network :code :fetch-failed :hint "boom")] + (t/is (not= (errors/error-fingerprint "handled-exception" base) + (errors/error-fingerprint "handled-exception" + (error-cause :type :network :code :fetch-failed :hint "other")))) + (t/is (not= (errors/error-fingerprint "handled-exception" base) + (errors/error-fingerprint "handled-exception" + (error-cause :type :validation :code :fetch-failed :hint "boom")))) + (t/is (not= (errors/error-fingerprint "handled-exception" base) + (errors/error-fingerprint "handled-exception" + (error-cause :type :network :code :other :hint "boom")))))) + +(t/deftest fingerprint-includes-the-report-name + (let [cause (error-cause :type :network :hint "boom")] + (t/is (not= (errors/error-fingerprint "handled-exception" cause) + (errors/error-fingerprint "unhandled-exception" cause))) + (t/is (not= (errors/error-fingerprint "handled-exception" cause) + (errors/error-fingerprint "exception-page" cause))))) + +(t/deftest fingerprint-handles-missing-type-and-code + (let [fingerprint (errors/error-fingerprint "handled-exception" (js/Error. "plain failure"))] + (t/is (string? fingerprint)) + (t/is (str/starts-with? fingerprint "handled-exception|unknown|unknown|")))) + +(t/deftest fingerprint-skips-non-frame-preamble-lines + ;; Scenario: a bundler/polyfill wrapper prepends extra non-frame lines + ;; before the real frames. Positional indexing would take the preamble + ;; as the frame and fragment the grouping; matching the first frame + ;; line keeps the identity equal to the plain equivalent. Proves: + ;; grouping survives wrapper-prepended stacks. + (let [plain (doto (ex-info "boom" {:type :internal :hint "boom"}) + (unchecked-set "stack" "Error: boom\n at call-site-a (app.js:1)")) + wrapped (doto (ex-info "boom" {:type :internal :hint "boom"}) + (unchecked-set "stack" "Error: boom\nWrapped by polyfill\n at call-site-a (app.js:1)"))] + (t/is (= (errors/error-fingerprint "handled-exception" plain) + (errors/error-fingerprint "handled-exception" wrapped))))) + +(t/deftest environment-fingerprints-ignore-the-stack-frame + (let [cause-a (doto (ex-info "http error" {:type :offline :hint "http error"}) + (unchecked-set "stack" "Error: http error\n at call-site-a (app.js:1)")) + cause-b (doto (ex-info "http error" {:type :offline :hint "http error"}) + (unchecked-set "stack" "Error: http error\n at call-site-b (app.js:2)")) + defect-a (doto (ex-info "boom" {:type :internal :hint "boom"}) + (unchecked-set "stack" "Error: boom\n at call-site-a (app.js:1)")) + defect-b (doto (ex-info "boom" {:type :internal :hint "boom"}) + (unchecked-set "stack" "Error: boom\n at call-site-b (app.js:2)"))] + (t/testing "environment failures group across internal call sites" + (t/is (= (errors/error-fingerprint "handled-exception" cause-a) + (errors/error-fingerprint "handled-exception" cause-b)))) + (t/testing "application defects keep the stack frame in their identity" + (t/is (not= (errors/error-fingerprint "handled-exception" defect-a) + (errors/error-fingerprint "handled-exception" defect-b)))))) + +(t/deftest governor-emits-first-occurrence-and-suppresses-repeats + (let [d1 (errors/reserve-report* (errors/initial-report-state) "fp" 1000) + d2 (errors/reserve-report* d1 "fp" 2000) + d3 (errors/reserve-report* d2 "fp" 3000) + d4 (errors/reserve-report* d3 "fp" (+ 1000 errors/report-window-ms))] + (t/is (true? (::errors/emit d1))) + (t/is (= 1 (::errors/occurrences d1))) + (t/is (false? (::errors/emit d2))) + (t/is (nil? (::errors/occurrences d2))) + (t/is (false? (::errors/emit d3))) + (t/is (nil? (::errors/occurrences d3))) + (t/is (true? (::errors/emit d4))) + (t/is (= 3 (::errors/occurrences d4))))) + +(t/deftest governor-evicts-oldest-entry-when-cache-is-full + (let [base (reduce (fn [state i] + (errors/reserve-report* state (str "fp-" i) (* 1000 i))) + (errors/initial-report-state) + (range errors/max-tracked-fingerprints)) + state (errors/reserve-report* base + "fp-new" + (* 1000 errors/max-tracked-fingerprints))] + (t/is (= errors/max-tracked-fingerprints (count (:entries state)))) + (t/is (= errors/max-tracked-fingerprints (count (:order state)))) + (t/is (true? (::errors/emit state))) + (t/is (nil? (get-in state [:entries "fp-0"]))) + (t/is (= "fp-1" (peek (:order state)))) + (t/is (some? (get-in state [:entries "fp-new"]))))) + +(t/deftest governor-evicts-by-insertion-order-not-by-last-emission + (let [base (reduce (fn [state i] + (errors/reserve-report* state (str "fp-" i) (* 1000 i))) + (errors/initial-report-state) + (range errors/max-tracked-fingerprints)) + ;; fp-0 re-emits after the window, so its :emitted-at becomes the + ;; most recent one, but it keeps its insertion position. + re-emitted (errors/reserve-report* base + "fp-0" + (+ (* 1000 errors/max-tracked-fingerprints) + errors/report-window-ms)) + state (errors/reserve-report* re-emitted + "fp-new" + (+ (* 1000 errors/max-tracked-fingerprints) + errors/report-window-ms + 1000))] + (t/is (true? (::errors/emit state))) + ;; FIFO: the first inserted one goes, even though it was the last + ;; emitted and fp-1 is the oldest by :emitted-at. + (t/is (nil? (get-in state [:entries "fp-0"]))) + (t/is (some? (get-in state [:entries "fp-1"]))) + (t/is (= errors/max-tracked-fingerprints (count (:entries state)))) + (t/is (= errors/max-tracked-fingerprints (count (:order state)))))) + +(t/deftest submit-report-is-governed-and-reports-occurrences + (let [cause (error-cause :type :network :code :fetch-failed :hint "boom") + events (capture-reports! + (fn [] + (dotimes [_ 5] + (errors/submit-report :event-name "handled-exception" + :report "report" + :hint "boom" + :cause cause))))] + (t/is (= 1 (count events))) + (t/is (= 1 (:occurrences (deref (first events))))))) + +(t/deftest invalid-report-does-not-consume-a-reservation + (let [cause (error-cause :type :network :hint "boom") + events (capture-reports! + (fn [] + (errors/submit-report :event-name "handled-exception" + :report nil :hint "boom" :cause cause) + (errors/submit-report :event-name "handled-exception" + :report "report" :hint "boom" :cause cause)))] + (t/is (= 1 (count events))) + (t/is (= 1 (:occurrences (deref (first events))))))) + +(t/deftest submit-report-evaluates-thunk-reports-lazily + ;; Scenario: the same failure is submitted twice with the report as a + ;; thunk. The first occurrence is granted and builds the report; the + ;; second is suppressed and must never run the thunk. Proves: suppressed + ;; occurrences skip the report-building cost entirely. + (let [calls (atom 0) + report (fn [] (swap! calls inc) "report") + cause (error-cause :type :network :hint "boom") + events (capture-reports! + (fn [] + (errors/submit-report :event-name "handled-exception" + :report report + :hint "boom" + :cause cause) + (errors/submit-report :event-name "handled-exception" + :report report + :hint "boom" + :cause cause)))] + (t/is (= 1 (count events))) + (t/is (= 1 @calls) "only the granted occurrence builds the report") + (t/is (= "report" (:report (deref (first events))))))) + +(t/deftest governor-applies-to-every-report-name + (let [events (capture-reports! + (fn [] + (doseq [event-name ["handled-exception" "unhandled-exception" "exception-page"]] + (let [cause (error-cause :type :internal :hint event-name)] + (errors/submit-report :event-name event-name + :report "report" + :hint event-name + :cause cause) + (errors/submit-report :event-name event-name + :report "report" + :hint event-name + :cause cause)))))] + (t/is (= 3 (count events))))) + +(t/deftest submit-report-without-cause-is-ignored + (let [events (capture-reports! + (fn [] + (errors/submit-report :event-name "exception-page" :report "report" :hint "boom") + (errors/submit-report :event-name "exception-page" + :report "report" + :hint "boom" + :cause (error-cause :type :internal :hint "boom"))))] + ;; The cause-less call is ignored and must not consume the reservation + ;; of the cause-based report. + (t/is (= 1 (count events))) + (t/is (= 1 (:occurrences (deref (first events))))))) + +(t/deftest governor-bounds-an-incident-like-loop + (let [cause (error-cause :type :network :hint "unable to perform fetch operation") + events (capture-reports! + (fn [] + (dotimes [_ 10000] + (errors/submit-report :event-name "handled-exception" + :report "report" + :hint "unable to perform fetch operation" + :cause cause))))] + (t/is (= 1 (count events))))) + +(defn- report-events + "The audit events (report emissions) out of everything collected through + the `st/emit!` double. Toasts are ungoverned by design — one per `flash` + call — so only the events typed as audit events count for emission + bounds. Discriminates by `ptk/type`, which is total (never throws), + because toasts are not derefable." + [events] + (filter #(= ::ev/event (ptk/type %)) events)) + +(t/deftest ^:async flash-suppressed-occurrence-does-not-build-a-report + ;; Scenario: the same failure flashes 3 times inside the governor window. + ;; Only the first occurrence reserves emission; the suppressed ones skip + ;; generation entirely. Proves: one audit event and a single report build + ;; for the whole burst; each `flash` is awaited to completion, so no + ;; timer reasoning is involved. + (let [generated (atom 0) + cause (error-cause :type :internal :hint "unable to perform fetch operation") + events (atom [])] + (await + (mock/with-mocks* + {st/format-last-events (mock/stub (fn [& _] (swap! generated inc) "report")) + st/emit! (mock/stub (fn [& emitted] (swap! events into emitted))) + rt/get-current-href (constantly "https://penpot.example.com/#/workspace") + tm/schedule (mock/stub (fn [f] (mock/asap f)))} + (dotimes [_ 3] + (await (errors/flash :cause cause :type :handled))) + (t/is (= 1 (count (report-events @events)))) + (t/is (= 1 @generated)))))) + +(t/deftest ^:async flash-bounds-an-incident-like-loop + ;; Scenario: 10 000 identical flashes, replaying the incident loop. Every + ;; flash is awaited (all 10 000 scheduled at once, one wait for all of + ;; them), but the governor emits only the first occurrence. Proves: the + ;; burst produces exactly one audit event and one report build. + (let [generated (atom 0) + cause (error-cause :type :internal :hint "unable to perform fetch operation") + events (atom [])] + (await + (mock/with-mocks* + {st/format-last-events (mock/stub (fn [& _] (swap! generated inc) "report")) + st/emit! (mock/stub (fn [& emitted] (swap! events into emitted))) + rt/get-current-href (constantly "https://penpot.example.com/#/workspace") + tm/schedule (mock/stub (fn [f] (mock/asap f)))} + (await (js/Promise.all + (into-array + (map (fn [_] (errors/flash :cause cause :type :handled)) + (range 10000))))) + (t/is (= 1 (count (report-events @events)))) + (t/is (= 1 @generated)))))) + +(t/deftest generate-report-is-total-when-formatting-fails + (with-redefs [st/format-last-events (mock/stub (fn [& _] (throw (ex-info "formatting failed" {}))))] + (let [report (errors/generate-report (error-cause :type :network :hint "boom"))] + (t/is (string? report))))) + +(t/deftest ^:async flash-emits-a-fallback-report-when-generation-fails + ;; Scenario: the full-report formatter throws. `generate-report` stays + ;; total and the fallback string is what gets emitted. Proves: a + ;; formatting failure still produces exactly one audit event carrying a + ;; string report, with the `flash` awaited to completion. + (let [events (atom [])] + (await + (mock/with-mocks* + {st/format-last-events (mock/stub (fn [& _] (throw (ex-info "formatting failed" {})))) + st/emit! (mock/stub (fn [& emitted] (swap! events into emitted))) + rt/get-current-href (constantly "https://penpot.example.com/#/workspace") + tm/schedule (mock/stub (fn [f] (mock/asap f)))} + (await (errors/flash :cause (error-cause :type :internal :hint "boom") :type :handled)) + (let [reports (report-events @events)] + (t/is (= 1 (count reports))) + (t/is (string? (:report (deref (first reports)))))))))) + +(t/deftest ^:async flash-emits-nothing-synchronously + ;; Scenario: a single handled failure. Nothing report- or toast-related + ;; may run on the error handler's stack: the whole `flash` body executes + ;; inside one scheduled callback. Proves: zero events right after the + ;; call returns; report + toast once the returned promise completes. + (errors/reset-report-governor!) + (let [events (atom []) + cause (error-cause :type :internal :hint "async flash probe")] + (await + (mock/with-mocks* + {st/emit! (mock/stub (fn [& emitted] (swap! events into emitted))) + rt/get-current-href (constantly "https://penpot.example.com/#/workspace") + tm/schedule (mock/stub (fn [f] (mock/asap f)))} + (let [completed (errors/flash :cause cause :type :handled)] + (t/is (empty? @events) "nothing emitted synchronously") + (await completed) + (t/is (= 2 (count @events)) "report + toast once completed")))))) + +(t/deftest ^:async flash-report-failure-neither-propagates-nor-kills-the-toast + ;; Scenario: the report emission itself throws (audit sink down). The + ;; failure is logged and swallowed at the schedule boundary while the + ;; toast is still attempted, so the user keeps the banner. Proves: + ;; `flash` never throws, its promise still completes, and a reporting + ;; failure still leaves the toast emitted. + (errors/reset-report-governor!) + (let [events (atom []) + calls (atom 0) + cause (error-cause :type :internal :hint "emit failure probe")] + (await + (mock/with-mocks* + {st/emit! (mock/stub (fn [& emitted] + (if (zero? @calls) + (do (swap! calls inc) + (throw (ex-info "sink down" {}))) + (swap! events into emitted)))) + rt/get-current-href (constantly "https://penpot.example.com/#/workspace") + tm/schedule (mock/stub (fn [f] (mock/asap f)))} + (await (errors/flash :cause cause :type :handled)) + (t/is (= 1 (count @events)) "only the toast survives a reporting failure"))))) + +(defn- toast-links + "The download links of every toast collected through the `st/emit!` + double, one entry per toast." + [events] + (->> events + (remove #(= ::ev/event (ptk/type %))) + (map #(get-in (ptk/update % {}) [:notification :links])))) + +(t/deftest ^:async repeated-flash-keeps-the-report-download-link + ;; Scenario: the same save failure flashes twice inside the governor + ;; window with a report link. The repeat is not emitted, but its toast + ;; still offers the report. Proves: the governor bounds emission, never + ;; the user's download. + (let [generated (atom 0) + cause (error-cause :type :validation :hint "save failed") + events (atom [])] + (await + (mock/with-mocks* + {st/format-last-events (mock/stub (fn [& _] (swap! generated inc) "report")) + st/emit! (mock/stub (fn [& emitted] (swap! events into emitted))) + rt/get-current-href (constantly "https://penpot.example.com/#/workspace") + tm/schedule (mock/stub (fn [f] (mock/asap f)))} + (dotimes [_ 2] + (await (errors/flash :cause cause :type :handled :report-link? true))) + (t/is (= 1 (count (report-events @events))) "the repeat is not emitted") + (t/is (= [1 1] (map count (toast-links @events))) "both toasts carry the link") + (t/is (= 2 @generated) "the repeat builds its report for the link only"))))) + +(t/deftest ^:async unreportable-flash-keeps-the-report-download-link + ;; Scenario: a failure with an empty hint flashes with a report link. It + ;; cannot be emitted, but its toast still offers the report. Proves: the + ;; link does not depend on emission. + (let [cause (ex-info "" {:type :validation}) + events (atom [])] + (await + (mock/with-mocks* + {st/format-last-events (mock/stub (fn [& _] "report")) + st/emit! (mock/stub (fn [& emitted] (swap! events into emitted))) + rt/get-current-href (constantly "https://penpot.example.com/#/workspace") + tm/schedule (mock/stub (fn [f] (mock/asap f)))} + (await (errors/flash :cause cause :type :handled :report-link? true)) + (t/is (empty? (report-events @events)) "nothing is emitted") + (t/is (= [1] (map count (toast-links @events))) "the toast carries the link"))))) diff --git a/frontend/test/frontend_tests/helpers/async.cljs b/frontend/test/frontend_tests/helpers/async.cljs new file mode 100644 index 0000000000..1e52a49c25 --- /dev/null +++ b/frontend/test/frontend_tests/helpers/async.cljs @@ -0,0 +1,92 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS INC Sucursal en España SL + +(ns frontend-tests.helpers.async + "Async-first plumbing for ClojureScript tests. + + Lets a test read sequentially while presupposing asynchronous APIs: + triggers run, effects are awaited as promises, and `done` always runs + at the end. Relies on two platform properties: + + - `cljs.test` keeps its env in a `set!` var, so assertions inside + deferred ticks are still counted. + - RxJS delivers `observe-on :async` notifications in scheduling (FIFO) + order, so awaiting the last scheduled delivery observes every effect + scheduled before it." + (:require + [beicon.v2.core :as rx] + [cljs.test :as t :include-macros true])) + +(defn ->promise + "Coerces a single-value observable into a js/Promise that resolves + with its first value (or rejects on error)." + [ob] + (js/Promise. (fn [resolve reject] (rx/subs! resolve reject ob)))) + +(defn ^:async await-response + "Pushes `value` into the `response` subject and resolves once the last + recorded request completes, delivery included. + + The promise subscribes BEFORE pushing: subscribing after the push + would never resolve. Request entries are maps holding the request + observable under `:req`." + [requests response value] + (let [p (->promise (:req (last @requests)))] + (rx/push! response value) + (await p))) + +(defn settle + "Resolves on the next macrotask, letting scheduled deliveries land. + Await it before asserting absence: silence is only meaningful once the + queue had a chance to deliver." + [] + (js/Promise. (fn [resolve] (js/setTimeout resolve 0)))) + +(defn observe + "Subscribes to `ob` forcing asynchronous delivery through `observe-on + :async` — even when the source is synchronous — and returns a promise + resolving once the stream terminates. + + Keyword args: `:on-next` per value, `:on-error` (handled errors resolve; + unhandled reject), `:on-complete` on clean termination, `:timeout-ms` + (default 2000). Asserts the stream is provided: resolving nil would let + a test pass without observing anything. Rejects on timeout instead of + hanging." + [ob & {:keys [on-next on-error on-complete timeout-ms] + :or {timeout-ms 2000}}] + (assert (some? ob) "observe requires an observable stream") + (js/Promise. + (fn [resolve reject] + (let [timer (js/setTimeout + #(reject (ex-info "Stream did not terminate in time" {})) + timeout-ms) + settle (fn [f v] + (js/clearTimeout timer) + (f v))] + (->> ob + (rx/observe-on :async) + (rx/subs! + (fn [v] (when on-next (on-next v))) + (fn [e] + (if on-error + (do (on-error e) (settle resolve nil)) + (settle reject e))) + (fn [] + (when on-complete (on-complete)) + (settle resolve nil)))))))) + +(defn ^:async wait-for + "Resolves once `pred` holds, checking immediately and then once per + macrotask (bounded: records a failure instead of hanging). Await it + before asserting effects of triggers — it holds whether the effect + lands synchronously or not." + [pred msg & [{:keys [max-ticks] :or {max-ticks 50}}]] + (if (pred) + nil + (if (<= max-ticks 0) + (t/is false (str "Timed out waiting for: " msg)) + (do (await (settle)) + (await (wait-for pred msg {:max-ticks (dec max-ticks)})))))) diff --git a/frontend/test/frontend_tests/helpers/mock.cljc b/frontend/test/frontend_tests/helpers/mock.cljc index 50f4d49d29..35e73f17c6 100644 --- a/frontend/test/frontend_tests/helpers/mock.cljc +++ b/frontend/test/frontend_tests/helpers/mock.cljc @@ -23,9 +23,14 @@ 4. `inner-done` restores originals and calls `outer-done` (typically `cljs.test/async`'s done). - Usage: `(with-mocks {ns/sym mock-fn, ...} test-fn done)`" + Usage: `(with-mocks {ns/sym mock-fn, ...} test-fn done)`. + + `with-mocks*` is the preferred form for new tests: it wraps the body in a + generated `^:async` fn and evaluates to a promise, so there is no `done` to + thread. See [[run-mocked]] for the restore-on-settle machinery." #?(:cljs (:require - [beicon.v2.core :as rx])) + [beicon.v2.core :as rx] + [cljs.test :as t])) #?(:cljs (:require-macros [frontend-tests.helpers.mock]))) ;; ═══════════════════════════════════════════════════════════════ @@ -84,6 +89,50 @@ ~@restore-exprs (~outer-done)))))))) +#?(:clj + (defmacro with-mocks* + "Installs `mocks` via `set!`, then evaluates `body` inside a generated + `^:async` fn awaited via `run-mocked`: when the body settles, the + originals are restored — always. A rejection is reported as an `:error`. + + Evaluates to a promise resolving once the body settles and the mocks + are restored. `await` it, either directly or by returning it from an + `^:async` fn; nested scopes must be awaited too. + + Example: + + (t/deftest ^:async my-async-test + (await (mock/with-mocks* + {app.main.repo/cmd! mock/rpc-cmd-mock} + (await (some-async-flow)) + ...)))" + [mocks & body] + (let [entries (map identity mocks) + gen-pairs (mapv (fn [[qsym _mock]] + {:qsym qsym + :osym (gensym "orig-")}) + entries) + let-bindings (vec (mapcat + (fn [{:keys [qsym osym]}] + [osym qsym]) + gen-pairs)) + install-exprs (mapv + (fn [[_qsym mock-fn] {:keys [qsym]}] + `(set! ~qsym ~mock-fn)) + entries + gen-pairs) + restore-exprs (mapv + (fn [{:keys [qsym osym]}] + `(set! ~qsym ~osym)) + gen-pairs)] + `(do + (frontend-tests.helpers.mock/reset-state!) + (let ~let-bindings + ~@install-exprs + (frontend-tests.helpers.mock/run-mocked + (^:async fn [] ~@body) + (fn [] ~@restore-exprs))))))) + ;; ═══════════════════════════════════════════════════════════════ ;; Runtime (ClojureScript only) ;; ═══════════════════════════════════════════════════════════════ @@ -164,6 +213,39 @@ ([a b c d e] (f a b c d e)) ([a b c d e g] (f a b c d e g)))) + ;; Scheduling + ;; ═══════════════════════════════════════════════════════════════ + + (defn asap + "Runs `f` on the next macrotask (`js/setTimeout` 0) and returns + the timer id." + [f] + (js/setTimeout f 0)) + + (defn ^:async run-mocked + "Awaits the async zero-arg `thunk`, then runs `restore` — always, in + that order — and resolves. A rejection is reported as an `:error` + (uncaught-exception semantics, like `test-var-block*`); a non-promise + return is reported as an `:error` too." + [thunk restore] + (let [p (thunk)] + (if (and (some? p) (fn? (.-then p))) + (try + (await p) + (catch :default e + (t/report {:type :error + :message "Uncaught exception, not in assertion." + :expected nil + :actual e})) + (finally + (restore))) + (do + (restore) + (t/report {:type :error + :message "with-mocks* body did not return a promise." + :expected nil + :actual p}))))) + ;; Lifecycle ;; ═══════════════════════════════════════════════════════════════ diff --git a/frontend/test/frontend_tests/main_errors_test.cljs b/frontend/test/frontend_tests/main_errors_test.cljs index 0e60f75393..41fa032aa3 100644 --- a/frontend/test/frontend_tests/main_errors_test.cljs +++ b/frontend/test/frontend_tests/main_errors_test.cljs @@ -11,13 +11,15 @@ - stale-asset-error? – pure predicate - exception->error-data – pure transformer - on-error re-entrancy guard – prevents recursive invocations - - flash schedules async emit – ntf/show is not emitted synchronously + - flash schedules async report and toast – neither the report nor + ntf/show is emitted synchronously - organization SSO recovery – expired SSO sessions go back to the provider - invalid-sso-config handler – requires :organization-id to promote to :sso-error - save failure notification – sticky toast carrying the error report - delegated save failures – causes handled by the handler for their type" (:require [app.common.uuid :as uuid] + [app.main.data.event :as ev] [app.main.data.persistence :as dps] [app.main.data.workspace :as-alias dw] [app.main.errors :as errors] @@ -31,6 +33,8 @@ [app.util.webapi :as wapi] [beicon.v2.core :as rx] [cljs.test :as t :include-macros true] + [cuerdas.core :as str] + [frontend-tests.helpers.async :as async] [frontend-tests.helpers.mock :as mock] [potok.v2.core :as ptk])) @@ -97,6 +101,245 @@ data (errors/exception->error-data err)] (t/is (= "fallback message" (:hint data)))))) +;; Shared report-test helpers (copied from the governor suite so each +;; namespace stays self-contained). +(t/use-fixtures :each {:before #(errors/reset-report-governor!)}) + +(defn- error-cause + [& {:keys [type code hint]}] + (ex-info (or hint "boom") + (cond-> {} + (some? type) (assoc :type type) + (some? code) (assoc :code code) + (some? hint) (assoc :hint hint)))) + +(defn- capture-reports! + "Run `f` capturing the events emitted through `st/emit!`." + [f] + (let [events (atom [])] + (with-redefs [st/emit! (mock/stub (fn [& emitted] (swap! events into emitted))) + rt/get-current-href (constantly "https://penpot.example.com/#/workspace")] + (f) + @events))) + +(defn- report-events + "The audit events (report emissions) out of everything collected through + the `st/emit!` double. Toasts are ungoverned by design — one per `flash` + call — so only the events typed as audit events count for emission + bounds. Discriminates by `ptk/type`, which is total (never throws), + because toasts are not derefable." + [events] + (filter #(= ::ev/event (ptk/type %)) events)) + +(defn- ^:async report-names + "Drives `flash-persistence` with an `ex-data` map of `cause-data` and + returns the audit event names it emitted, in order. + + The report generator is stubbed and the scheduler runs its callback + inline, so the whole flash body completes before returning. The emitter + is the only observable." + [cause-data] + (let [events (atom []) + cause (ex-info "Save failed" (assoc cause-data :hint "Save failed"))] + ;; The governor is global and remembers fingerprints for two minutes, so + ;; a second identical report would be suppressed. Clear it per case. + (errors/reset-report-governor!) + (await + (mock/with-mocks* + {errors/generate-report (fn [_ & _] "generated error report") + st/emit! (mock/stub (fn [& emitted] + (swap! events into emitted))) + ;; `schedule` is multi-arity, so the mock needs every arity the + ;; flash body may call it with. + tm/schedule (mock/stub (fn + ([] nil) + ([callback] (callback)) + ([_ms callback] (callback))))} + (errors/flash-persistence cause))) + (mapv #(-> % deref ::ev/name) (report-events @events)))) + +;; --------------------------------------------------------------------------- +;; Environment failures +;; +;; Connectivity and service failures are not application defects: they are +;; audit-only telemetry with a compact report and a dedicated toast. +;; --------------------------------------------------------------------------- + +(t/deftest environment-error-classification + (t/testing "environment failures are recognised" + (doseq [type [:network :offline :bad-gateway :service-unavailable + :gateway-error :nitrate-unavailable :nitrate-not-configured]] + (t/is (true? (errors/environment-error? (error-cause :type type))) + (str "expected environment error: " type)))) + (t/testing "application defects are not environment failures" + (doseq [type [:internal :assertion :persistence :validation :authentication]] + (t/is (false? (errors/environment-error? (error-cause :type type))) + (str "did not expect environment error: " type)))) + (t/testing "causes without ex-data are not environment failures" + (t/is (false? (errors/environment-error? (js/Error. "plain failure")))) + (t/is (false? (errors/environment-error? nil))))) + +(t/deftest ^:async generate-report-compact-omits-stack-data-and-last-events + (await + (mock/with-mocks* + {st/format-last-events (mock/stub (fn [& _] (throw (ex-info "must not be called" {})))) + rt/get-current-href (constantly "https://penpot.example.com/#/workspace")} + (let [cause (ex-info "http error" {:type :offline + :hint "http error" + :uri "/api/rpc/command/update-file" + :headers {"x-session-id" "secret"}}) + report (errors/generate-report cause {:format :compact})] + (t/is (string? report)) + (t/is (str/includes? report "Hint:")) + (t/is (str/includes? report "http error")) + (t/is (str/includes? report ":offline")) + (t/is (str/includes? report "/api/rpc/command/update-file")) + (t/is (not (str/includes? report "Last events:"))) + (t/is (not (str/includes? report "Data:"))) + (t/is (not (str/includes? report "===="))) + (t/is (not (str/includes? report "secret"))) + ;; Trailing settle: the body is synchronous, but `with-mocks*` + ;; evaluates to a promise, so the body must settle one. + (await (async/settle)))))) + +(t/deftest ^:async generate-report-defaults-to-the-full-format + (await + (mock/with-mocks* + {st/format-last-events (mock/stub (fn [& _] "(stub last events)")) + rt/get-current-href (constantly "https://penpot.example.com/#/workspace")} + (let [report (errors/generate-report (error-cause :type :internal :hint "boom"))] + (t/is (str/includes? report "Last events:")) + (t/is (str/includes? report "(stub last events)")) + ;; Trailing settle: the body is synchronous, but `with-mocks*` + ;; evaluates to a promise, so the body must settle one. + (await (async/settle)))))) + +(t/deftest ^:async connectivity-handlers-report-governed-compact-audit-events + ;; Scenario: a network failure and an offline status through the global + ;; handler. Each is reported as a governed compact audit event plus its + ;; connection toast. Proves: per type, report first and toast right after, + ;; with no stack in the report and the dedicated toast message. + (doseq [type [:network :offline :gateway-error]] + (errors/reset-report-governor!) + (let [events (atom []) + cause (ex-info "http error" {:type type :hint "http error"})] + (await + (mock/with-mocks* + {st/emit! (mock/stub (fn [& emitted] (swap! events into emitted))) + rt/get-current-href (constantly "https://penpot.example.com/#/workspace") + tm/schedule (mock/stub (fn [f] (f))) + st/format-last-events (mock/stub (fn [& _] (throw (ex-info "must not be called" {}))))} + (errors/on-error cause) + (await (async/settle)) + ;; `flash` emits the report first and schedules the toast right after. + (t/is (= 2 (count @events)) (str "unexpected event count for " type)) + (let [report-event (first @events) + toast-event (second @events) + props (deref report-event)] + (t/is (= "handled-exception" (::ev/name props))) + (t/is (not (str/includes? (:report props) "Last events:"))) + (t/is (= (i18n/tr "errors.connection-error") + (get-in (ptk/update toast-event {}) [:notification :content]))))))))) + +(t/deftest ^:async flash-keeps-the-canonical-event-name-and-derives-the-format + ;; Scenario: an environment failure flashed as `:handled` and as + ;; `:unhandled`. The audit event name is the canonical one requested by + ;; the caller while only the payload format derives from the cause + ;; (compact, with no stack and no header dump). Proves: per type, one + ;; compact audit event under the requested name, with the `flash` + ;; awaited to completion. + (let [cause (ex-info "http error" {:type :network + :hint "http error" + :headers {"x-session-id" "secret"}})] + (doseq [[type event-name] [[:handled "handled-exception"] + [:unhandled "unhandled-exception"]]] + (errors/reset-report-governor!) + (let [events (atom [])] + (await + (mock/with-mocks* + {st/emit! (mock/stub (fn [& emitted] (swap! events into emitted))) + rt/get-current-href (constantly "https://penpot.example.com/#/workspace") + tm/schedule (mock/stub (fn [f] (mock/asap f))) + st/format-last-events (mock/stub (fn [& _] (throw (ex-info "must not be called" {}))))} + ;; The event name is the canonical one requested by the caller; + ;; only the payload format is derived from the cause. + (await (errors/flash :cause cause :type type)) + (let [reports (report-events @events)] + (t/is (= 1 (count reports)) (str "unexpected event count for " type)) + (let [props (deref (first reports)) + report (:report props)] + (t/is (= event-name (::ev/name props)) (str "event name for " type)) + (t/is (not (str/includes? report "Last events:"))) + (t/is (not (str/includes? report "secret"))))))))))) + +(t/deftest ^:async offline-loop-is-governed-and-never-unhandled + ;; Scenario: 10 000 offline errors through the global handler, replaying + ;; a connectivity outage. Every occurrence is handled (never unhandled) + ;; and the governor emits only the first. Proves: one `handled-exception` + ;; audit event for the whole loop, observed after timers drain. + (let [events (atom []) + cause (ex-info "http error" {:type :offline :hint "http error"})] + (await + (mock/with-mocks* + {st/emit! (mock/stub (fn [& emitted] (swap! events into emitted))) + rt/get-current-href (constantly "https://penpot.example.com/#/workspace") + tm/schedule (mock/stub (fn [f] (mock/asap f))) + st/format-last-events (mock/stub (fn [& _] (throw (ex-info "must not be called" {}))))} + (dotimes [_ 10000] + (errors/on-error cause)) + (await (async/settle)) + (t/is (= 1 (count (report-events @events)))) + (t/is (= "handled-exception" (::ev/name (deref (first (report-events @events)))))))))) + +(t/deftest ^:async flash-persistence-uses-compact-reports-for-environment-failures + ;; Scenario: a save failure caused by the environment. `flash-persistence` + ;; delegates to `flash`, so the audit event carries a compact report + ;; (context only: no stack, no header dump). Proves: one + ;; `handled-exception` with a compact payload, observed after timers + ;; drain. + (let [events (atom [])] + (await + (mock/with-mocks* + {st/emit! (mock/stub (fn [& emitted] (swap! events into emitted))) + rt/get-current-href (constantly "https://penpot.example.com/#/workspace") + tm/schedule (mock/stub (fn [f] (mock/asap f))) + st/format-last-events (mock/stub (fn [& _] (throw (ex-info "must not be called" {}))))} + (errors/flash-persistence (ex-info "http error" {:type :offline + :hint "http error" + :headers {"x-session-id" "secret"}})) + (await (async/settle)) + (let [reports (report-events @events)] + (t/is (= 1 (count reports))) + (let [props (deref (first reports))] + (t/is (= "handled-exception" (::ev/name props))) + (t/is (not (str/includes? (:report props) "Last events:"))) + (t/is (not (str/includes? (:report props) "secret"))))))))) + +(t/deftest exception-page-reports-dedup-by-cause + (let [cause-a (error-cause :type :internal :code :unable-to-process-repository-response :hint "boom") + cause-b (error-cause :type :internal :code :other :hint "other") + events (capture-reports! + (fn [] + (errors/submit-report :event-name "exception-page" + :report "report" :hint "boom" :cause cause-a) + (errors/submit-report :event-name "exception-page" + :report "report" :hint "different hint" :cause cause-a) + (errors/submit-report :event-name "exception-page" + :report "report" :hint "other" :cause cause-b)))] + (t/is (= 2 (count events))))) + +(t/deftest reports-of-the-same-cause-under-different-names-do-not-coalesce + (let [cause (error-cause :type :internal :hint "boom") + events (capture-reports! + (fn [] + (errors/submit-report :event-name "handled-exception" + :report "report" :hint "boom" :cause cause) + (errors/submit-report :event-name "unhandled-exception" + :report "report" :hint "boom" :cause cause) + (errors/submit-report :event-name "exception-page" + :report "report" :hint "boom" :cause cause)))] + (t/is (= 3 (count events))))) + ;; --------------------------------------------------------------------------- ;; on-error dispatches to ptk/handle-error ;; @@ -173,152 +416,136 @@ :organization-id organization-id :team-id "b8f8bb52-8b70-8144-8004-4a5085f0bdc9"}) -(t/deftest expired-organization-sso-navigates-to-identity-provider - (t/async done - (t/testing "the browser is sent to the identity provider instead of an error page" - (let [events (atom [])] - (mock/with-mocks - {rp/cmd! (mock/stub - (fn [_command _params] - (rx/of {:authorized false - :redirect-uri "https://idp.example.com/authorize"}))) - rt/get-current-href (constantly workspace-href) - st/emit! (mock/stub (fn [& emitted] (swap! events into emitted)))} - (fn [done'] - (errors/on-error (sso-required-error)) - (t/is (= [::rt/nav-raw] (mapv ptk/type @events))) - (done')) - done))))) +(t/deftest ^:async expired-organization-sso-navigates-to-identity-provider + (t/testing "the browser is sent to the identity provider instead of an error page" + (let [events (atom [])] + (await + (mock/with-mocks* + {rp/cmd! (mock/stub + (fn [_command _params] + (rx/of {:authorized false + :redirect-uri "https://idp.example.com/authorize"}))) + rt/get-current-href (constantly workspace-href) + st/emit! (mock/stub (fn [& emitted] (swap! events into emitted)))} + (errors/on-error (sso-required-error)) + (await (async/settle)) + (t/is (= [::rt/nav-raw] (mapv ptk/type @events)))))))) -(t/deftest expired-organization-sso-comes-back-to-the-current-location - (t/async done - (t/testing "the SSO check asks the provider to return the user where they were" - (let [rpc-calls (atom [])] - (mock/with-mocks - {rp/cmd! (mock/stub - (fn [command params] - (swap! rpc-calls conj {:command command :params params}) - (rx/of {:authorized false - :redirect-uri "https://idp.example.com/authorize"}))) - rt/get-current-href (constantly workspace-href) - st/emit! mock/noop} - (fn [done'] - (errors/on-error (sso-required-error)) - (t/is (= [{:command :check-nitrate-sso - :params {:team-id "b8f8bb52-8b70-8144-8004-4a5085f0bdc9" - :organization-id organization-id - :url workspace-href}}] - @rpc-calls)) - (done')) - done))))) +(t/deftest ^:async expired-organization-sso-comes-back-to-the-current-location + (t/testing "the SSO check asks the provider to return the user where they were" + (let [rpc-calls (atom [])] + (await + (mock/with-mocks* + {rp/cmd! (mock/stub + (fn [command params] + (swap! rpc-calls conj {:command command :params params}) + (rx/of {:authorized false + :redirect-uri "https://idp.example.com/authorize"}))) + rt/get-current-href (constantly workspace-href) + st/emit! mock/noop} + (errors/on-error (sso-required-error)) + (await (async/settle)) + (t/is (= [{:command :check-nitrate-sso + :params {:team-id "b8f8bb52-8b70-8144-8004-4a5085f0bdc9" + :organization-id organization-id + :url workspace-href}}] + @rpc-calls))))))) -(t/deftest already-satisfied-organization-sso-retries-the-location - (t/async done - (t/testing "a session renewed meanwhile (e.g. in another tab) reloads instead of erroring" - (let [events (atom [])] - (mock/with-mocks - {rp/cmd! (mock/stub - (fn [_command _params] - (rx/of {:authorized true :reason :sso-satisfied}))) - rt/get-current-href (constantly workspace-href) - st/emit! (mock/stub (fn [& emitted] (swap! events into emitted)))} - (fn [done'] - (errors/on-error (sso-required-error)) - (t/is (= [::rt/reload] (mapv ptk/type @events))) - (done')) - done))))) +(t/deftest ^:async already-satisfied-organization-sso-retries-the-location + (t/testing "a session renewed meanwhile (e.g. in another tab) reloads instead of erroring" + (let [events (atom [])] + (await + (mock/with-mocks* + {rp/cmd! (mock/stub + (fn [_command _params] + (rx/of {:authorized true :reason :sso-satisfied}))) + rt/get-current-href (constantly workspace-href) + st/emit! (mock/stub (fn [& emitted] (swap! events into emitted)))} + (errors/on-error (sso-required-error)) + (await (async/settle)) + (t/is (= [::rt/reload] (mapv ptk/type @events)))))))) -(t/deftest organization-sso-without-usable-provider-shows-the-sso-error-dialog - (t/async done - (t/testing "SSO is required but there is nowhere to go: offer a retry, not a permission error" - (let [assigned* (atom nil)] - (mock/with-mocks - {rp/cmd! (mock/stub - (fn [_command _params] - (rx/of {:authorized false :redirect-uri nil}))) - rt/get-current-href (constantly workspace-href) - rt/assign-exception (fn [error] - (reset! assigned* error) - (ptk/data-event ::assigned error))} - (fn [done'] - (errors/on-error (sso-required-error)) - (t/is (= :sso-error (:type @assigned*))) - (t/is (= organization-id (:organization-id @assigned*))) - (t/is (true? (:is-workspace @assigned*))) - (done')) - done))))) +(t/deftest ^:async organization-sso-without-usable-provider-shows-the-sso-error-dialog + (t/testing "SSO is required but there is nowhere to go: offer a retry, not a permission error" + (let [assigned* (atom nil)] + (await + (mock/with-mocks* + {rp/cmd! (mock/stub + (fn [_command _params] + (rx/of {:authorized false :redirect-uri nil}))) + rt/get-current-href (constantly workspace-href) + rt/assign-exception (fn [error] + (reset! assigned* error) + (ptk/data-event ::assigned error))} + (errors/on-error (sso-required-error)) + (await (async/settle)) + (t/is (= :sso-error (:type @assigned*))) + (t/is (= organization-id (:organization-id @assigned*))) + (t/is (true? (:is-workspace @assigned*)))))))) -(t/deftest organization-sso-without-team-access-reports-a-permission-failure - (t/async done - (t/testing "a user who cannot reach the team keeps getting the authentication error" - (let [assigned* (atom nil)] - (mock/with-mocks - {rp/cmd! (mock/stub - (fn [_command _params] - (rx/of {:authorized true :reason :no-team-access}))) - rt/get-current-href (constantly workspace-href) - rt/assign-exception (fn [error] - (reset! assigned* error) - (ptk/data-event ::assigned error))} - (fn [done'] - (errors/on-error (sso-required-error)) - (t/is (= :authentication (:type @assigned*))) - (t/is (= :nitrate-sso-required (:code @assigned*))) - (done')) - done))))) +(t/deftest ^:async organization-sso-without-team-access-reports-a-permission-failure + (t/testing "a user who cannot reach the team keeps getting the authentication error" + (let [assigned* (atom nil)] + (await + (mock/with-mocks* + {rp/cmd! (mock/stub + (fn [_command _params] + (rx/of {:authorized true :reason :no-team-access}))) + rt/get-current-href (constantly workspace-href) + rt/assign-exception (fn [error] + (reset! assigned* error) + (ptk/data-event ::assigned error))} + (errors/on-error (sso-required-error)) + (await (async/settle)) + (t/is (= :authentication (:type @assigned*))) + (t/is (= :nitrate-sso-required (:code @assigned*)))))))) -(t/deftest organization-sso-does-not-retry-on-an-unexplained-authorization - (t/async done - (t/testing "reloading on an answer we don't understand would spin on the same rejection" - (let [events (atom [])] - (mock/with-mocks - {rp/cmd! (mock/stub (fn [_command _params] (rx/of {:authorized true}))) - rt/get-current-href (constantly workspace-href) - rt/assign-exception (fn [error] (ptk/data-event ::assigned error)) - st/async-emit! (fn [& emitted] (swap! events into emitted))} - (fn [done'] - (errors/on-error (sso-required-error)) - (t/is (= [::assigned] (mapv ptk/type @events))) - (done')) - done))))) +(t/deftest ^:async organization-sso-does-not-retry-on-an-unexplained-authorization + (t/testing "reloading on an answer we don't understand would spin on the same rejection" + (let [events (atom [])] + (await + (mock/with-mocks* + {rp/cmd! (mock/stub (fn [_command _params] (rx/of {:authorized true}))) + rt/get-current-href (constantly workspace-href) + rt/assign-exception (fn [error] (ptk/data-event ::assigned error)) + st/async-emit! (fn [& emitted] (swap! events into emitted))} + (errors/on-error (sso-required-error)) + (await (async/settle)) + (t/is (= [::assigned] (mapv ptk/type @events)))))))) -(t/deftest organization-sso-error-without-context-is-reported-as-it-arrives - (t/async done - (t/testing "with no organization and no team there is nothing to check" - (let [rpc-calls (atom 0) - assigned* (atom nil)] - (mock/with-mocks - {rp/cmd! (mock/stub (fn [_command _params] - (swap! rpc-calls inc) - (rx/empty))) - rt/get-current-href (constantly workspace-href) - rt/assign-exception (fn [error] - (reset! assigned* error) - (ptk/data-event ::assigned error))} - (fn [done'] - (errors/on-error {:type :authentication - :code :nitrate-sso-required}) - (t/is (zero? @rpc-calls)) - (t/is (= :nitrate-sso-required (:code @assigned*))) - (done')) - done))))) +(t/deftest ^:async organization-sso-error-without-context-is-reported-as-it-arrives + (t/testing "with no organization and no team there is nothing to check" + (let [rpc-calls (atom 0) + assigned* (atom nil)] + (await + (mock/with-mocks* + {rp/cmd! (mock/stub (fn [_command _params] + (swap! rpc-calls inc) + (rx/empty))) + rt/get-current-href (constantly workspace-href) + rt/assign-exception (fn [error] + (reset! assigned* error) + (ptk/data-event ::assigned error))} + (errors/on-error {:type :authentication + :code :nitrate-sso-required}) + (await (async/settle)) + (t/is (zero? @rpc-calls)) + (t/is (= :nitrate-sso-required (:code @assigned*)))))))) -(t/deftest a-resultless-organization-sso-check-does-not-wedge-later-rejections - (t/async done - (t/testing "the one-in-flight guard is released even when no answer arrives" - (let [rpc-calls (atom 0)] - (mock/with-mocks - {rp/cmd! (mock/stub (fn [_command _params] - (swap! rpc-calls inc) - (rx/empty))) - rt/get-current-href (constantly workspace-href) - st/emit! mock/noop} - (fn [done'] - (errors/on-error (sso-required-error)) - (errors/on-error (sso-required-error)) - (t/is (= 2 @rpc-calls)) - (done')) - done))))) +(t/deftest ^:async a-resultless-organization-sso-check-does-not-wedge-later-rejections + (t/testing "the one-in-flight guard is released even when no answer arrives" + (let [rpc-calls (atom 0)] + (await + (mock/with-mocks* + {rp/cmd! (mock/stub (fn [_command _params] + (swap! rpc-calls inc) + (rx/empty))) + rt/get-current-href (constantly workspace-href) + st/emit! mock/noop} + (errors/on-error (sso-required-error)) + (errors/on-error (sso-required-error)) + (await (async/settle)) + (t/is (= 2 @rpc-calls))))))) ;; A failing check must stay a failing check: the generic handling turns it ;; into a toast, whereas swallowing it would show a permission error for @@ -332,35 +559,31 @@ [error] (swap! check-failures conj error)) -(t/deftest failing-organization-sso-check-is-not-reported-as-missing-access - (t/async done +(t/deftest ^:async failing-organization-sso-check-is-not-reported-as-missing-access + (t/testing "the SSO check fails like a real request (later tick) and the failure stays a failure" (reset! check-failures []) (let [assigned* (atom nil)] - (mock/with-mocks - {rp/cmd! - (mock/stub - (fn [_command _params] - (->> (rx/timer 0) - (rx/mapcat (fn [_] - (rx/throw (ex-info "boom" {:type ::test-check-failure}))))))) + (await + (mock/with-mocks* + {rp/cmd! + (mock/stub + (fn [_command _params] + (->> (rx/timer 0) + (rx/mapcat (fn [_] + (rx/throw (ex-info "boom" {:type ::test-check-failure}))))))) - rt/get-current-href - (constantly workspace-href) + rt/get-current-href + (constantly workspace-href) - rt/assign-exception - (fn [error] - (reset! assigned* error) - (ptk/data-event ::assigned error))} - - (fn [done'] - (errors/on-error (sso-required-error)) - (tm/schedule - 50 - (fn [] - (t/is (= [::test-check-failure] (mapv :type @check-failures))) - (t/is (nil? @assigned*)) - (done')))) - done)))) + rt/assign-exception + (fn [error] + (reset! assigned* error) + (ptk/data-event ::assigned error))} + (errors/on-error (sso-required-error)) + (await (async/wait-for #(= 1 (count @check-failures)) + "sso check failure observed")) + (t/is (= [::test-check-failure] (mapv :type @check-failures))) + (t/is (nil? @assigned*))))))) ;; --------------------------------------------------------------------------- ;; :validation / :invalid-sso-config @@ -422,7 +645,7 @@ (t/is (= timeout (get-in state [:notification :timeout]))) (t/is (= :visible (get-in state [:notification :status])))))))) -(t/deftest persistence-notifications-include-an-error-report-download +(t/deftest ^:async persistence-notifications-include-an-error-report-download (let [scheduled (atom []) idle-callbacks (atom []) events (atom []) @@ -430,66 +653,142 @@ revoked (atom []) report "generated error report" cause (ex-info "Save failed" {:type :validation})] - (with-redefs [dom/prevent-default (fn [_]) - dom/trigger-download-uri (fn [& params] - (swap! downloads conj params)) - errors/generate-report (fn [_] report) - errors/submit-report (fn [& _]) - ;; `tr` is called with one and with two arguments, and its - ;; two-argument arity is variadic: the stub exposes both - ;; shapes so the compiled static calls resolve. - i18n/tr (fn ([key] (str key ":")) - ([key & args] - (str key ":" (first args)))) - st/emit! (mock/stub (fn [& emitted] - (swap! events into emitted))) - tm/schedule (mock/stub (fn [callback] - (swap! scheduled conj callback))) - tm/schedule-on-idle (mock/stub (fn [callback] - (swap! idle-callbacks conj callback))) - wapi/create-blob (mock/stub (fn [content media-type] - {:content content :media-type media-type})) - wapi/create-uri (fn [_] "blob:report") - wapi/revoke-uri (fn [uri] - (swap! revoked conj uri))] - (errors/flash-persistence cause) - (doseq [callback @scheduled] (callback)) - (let [state (ptk/update (first @events) {}) - download (get-in state [:notification :links 0])] - (t/is (= "labels.download:report.txt" (:label download))) - ((:callback download) nil) - (t/is (= [["report" "text/plain" "blob:report"]] @downloads)) - (doseq [callback @idle-callbacks] (callback)) - (t/is (= ["blob:report"] @revoked)))))) + (await + (mock/with-mocks* + {dom/prevent-default (fn [_]) + dom/trigger-download-uri (fn [& params] + (swap! downloads conj params)) + errors/generate-report (fn [_ & _] report) + errors/submit-report (fn [& _]) + ;; `tr` is called with one and with two arguments, and its + ;; two-argument arity is variadic: the stub exposes both + ;; shapes so the compiled static calls resolve. + i18n/tr (fn ([key] (str key ":")) + ([key & args] + (str key ":" (first args)))) + st/emit! (mock/stub (fn [& emitted] + (swap! events into emitted))) + tm/schedule (mock/stub (fn [callback] + (swap! scheduled conj callback))) + tm/schedule-on-idle (mock/stub (fn [callback] + (swap! idle-callbacks conj callback))) + wapi/create-blob (mock/stub (fn [content media-type] + {:content content :media-type media-type})) + wapi/create-uri (fn [_] "blob:report") + wapi/revoke-uri (fn [uri] + (swap! revoked conj uri))} + (errors/flash-persistence cause) + (doseq [callback @scheduled] (callback)) + (await (async/settle)) + ;; The report is emitted first and the toast right after, so the + ;; toast carrying the download link is the last event collected. + (let [state (ptk/update (last @events) {}) + download (get-in state [:notification :links 0])] + (t/is (= "labels.download:report.txt" (:label download))) + ((:callback download) nil) + (t/is (= [["report" "text/plain" "blob:report"]] @downloads)) + (doseq [callback @idle-callbacks] (callback)) + (t/is (= ["blob:report"] @revoked)) + ;; Autosave is stopped for the whole session, so the toast also + ;; offers the only action that restarts it without the user having + ;; to know they could leave the file and come back. + (let [reload (get-in state [:notification :links 1])] + (t/is (= "labels.reload-page:" (:label reload)) + "the `tr` stub renders a one-argument key with a trailing colon") + (t/is (fn? (:callback reload)) "the reload link has a callback"))))))) -(t/deftest persistence-waiters-do-not-report-an-already-handled-failure +;; Scenario: a save fails terminally. The toast offers the report download +;; and a reload. Proves: the recovery action reaches the user. +;; +;; The reload callback itself is not invoked here: `js/location` does not +;; exist under the test runner, so the link is verified by its label and by +;; being a callable, not by calling it. +(t/deftest ^:async save-failure-toast-offers-a-reload-action + (let [events (atom [])] + (await + (mock/with-mocks* + {errors/generate-report (fn [_ & _] "generated error report") + st/emit! (mock/stub (fn [& emitted] + (swap! events into emitted))) + tm/schedule (mock/stub (fn [callback] (callback)))} + (errors/flash-persistence (ex-info "Save failed" + {:type :validation :hint "Save failed"})) + (await (async/settle)) + ;; The report is emitted first and the toast right after, so the toast + ;; is the last event collected. + (let [state (ptk/update (last @events) {}) + links (get-in state [:notification :links])] + ;; `tr` is not stubbed here, and the test runner does not load the + ;; catalogue, so a key comes back verbatim without its arguments. + (t/is (= ["labels.download" "labels.reload-page"] (mapv :label links)) + "the toast carries the report and a reload, download first") + (t/is (every? #(fn? (:callback %)) links) + "both actions are callable") + (t/is (nil? (get-in state [:notification :timeout])) + "the toast stays until the user acts on it")))))) + +;; Scenario: a save fails on the transport and the queue keeps trying on +;; the slow cycle. The toast says the changes are kept and offers no reload, +;; which would lose them. Proves: the retrying variant tells the truth. +(t/deftest ^:async retrying-save-failure-toast-offers-no-reload + (let [events (atom [])] + (await + (mock/with-mocks* + {errors/generate-report (fn [_ & _] "generated error report") + st/emit! (mock/stub (fn [& emitted] + (swap! events into emitted))) + tm/schedule (mock/stub (fn [callback] (callback)))} + (errors/flash-persistence (ex-info "Save failed" + {:type :gateway-error :hint "Save failed"}) + :retrying true) + (await (async/settle)) + (let [state (ptk/update (last @events) {})] + (t/is (= "errors.save-still-retrying" (get-in state [:notification :content]))) + (t/is (= ["labels.download"] (mapv :label (get-in state [:notification :links]))) + "the toast carries the report and no reload") + (t/is (= errors/persistence-failed-tag (get-in state [:notification :tag])) + "a save that lands can hide it") + (t/is (nil? (get-in state [:notification :timeout])))))))) + +(t/deftest ^:async persistence-waiters-do-not-report-an-already-handled-failure (let [reports (atom []) rejected (atom []) pstate (atom {:status :saving}) store (ptk/store {:state {} :on-error errors/on-error}) cause (ex-info "Save failed" {:type :network})] - (with-redefs [refs/persistence pstate - errors/submit-report (fn [& params] - (swap! reports conj (apply hash-map params))) - tm/schedule (mock/stub (fn [_]))] - (try - (ptk/emit! store (#'dps/persistence-failed (uuid/next) cause)) - (reset! pstate (:persistence @store)) - (dotimes [_ 2] - (->> (dps/wait-persisted-or-error) - (rx/subs! (fn [_] (t/is false "A failed save must still reject")) - (fn [error] - (swap! rejected conj error) - (errors/on-error error))))) - (t/is (= 2 (count @rejected))) - (t/is (= 1 (count @reports))) - ;; A standalone timeout and a later save failure are new incidents. - (errors/on-error (ex-info "Save timed out" {:type :persistence :code :save-timeout})) - (t/is (= 2 (count @reports))) - (ptk/emit! store (#'dps/persistence-failed (uuid/next) cause)) - (t/is (= 3 (count @reports))) - (finally - (rx/dispose! store)))))) + (await + (mock/with-mocks* + {refs/persistence pstate + st/emit! (mock/stub (fn [& emitted] + (swap! reports into + (report-events emitted)))) + ;; Run the scheduled `flash` body synchronously: the whole flow + ;; under test is synchronous except for the deferral. + tm/schedule (mock/stub (fn [f] (f)))} + (try + (ptk/emit! store (#'dps/persistence-failed (uuid/next) cause)) + (reset! pstate (:persistence @store)) + (dotimes [_ 2] + (->> (dps/wait-persisted-or-error) + (rx/subs! (fn [_] (t/is false "A failed save must still reject")) + (fn [error] + (swap! rejected conj error) + (errors/on-error error))))) + (await (async/settle)) + (t/is (= 2 (count @rejected))) + (t/is (= 1 (count @reports))) + ;; A standalone timeout and a later save failure are new incidents. + ;; The later failure carries a distinct signature: repeating the same + ;; one inside the governor window is coalesced by design. + (errors/on-error (ex-info "Save timed out" {:type :persistence :code :save-timeout})) + (await (async/settle)) + (t/is (= 2 (count @reports))) + (ptk/emit! store (#'dps/persistence-failed (uuid/next) + (ex-info "Save failed again" {:type :network}))) + (await (async/settle)) + (t/is (= 3 (count @reports))) + (finally + (rx/dispose! store))))))) ;; --------------------------------------------------------------------------- ;; Save failures that belong to their own handler @@ -512,22 +811,20 @@ (t/is (= :authentication (:type @assigned))) (t/is (empty? @scheduled) "An expired session shows no save notification"))))) -(t/deftest expired-organization-sso-during-save-renews-the-session - (t/async done - (t/testing "an SSO-guarded save failure goes back through the identity provider" - (let [events (atom [])] - (mock/with-mocks - {rp/cmd! (mock/stub - (fn [_command _params] - (rx/of {:authorized false - :redirect-uri "https://idp.example.com/authorize"}))) - rt/get-current-href (constantly workspace-href) - st/emit! (mock/stub (fn [& emitted] (swap! events into emitted)))} - (fn [done'] - (errors/flash-persistence (ex-info "SSO required" (sso-required-error))) - (t/is (= [::rt/nav-raw] (mapv ptk/type @events))) - (done')) - done))))) +(t/deftest ^:async expired-organization-sso-during-save-renews-the-session + (t/testing "an SSO-guarded save failure goes back through the identity provider" + (let [events (atom [])] + (await + (mock/with-mocks* + {rp/cmd! (mock/stub + (fn [_command _params] + (rx/of {:authorized false + :redirect-uri "https://idp.example.com/authorize"}))) + rt/get-current-href (constantly workspace-href) + st/emit! (mock/stub (fn [& emitted] (swap! events into emitted)))} + (errors/flash-persistence (ex-info "SSO required" (sso-required-error))) + (await (async/settle)) + (t/is (= [::rt/nav-raw] (mapv ptk/type @events)))))))) (t/deftest a-deleted-file-during-save-shows-the-exception-page (t/testing "a file that no longer exists shows its page, not the save notification" @@ -554,20 +851,86 @@ (t/is (= [::dw/reload-current-file] (mapv ptk/type @events))) (t/is (empty? @scheduled) "A restored version shows no save notification"))))) -(t/deftest other-validation-failures-during-save-keep-the-notification - (t/testing "a validation failure without a recovery of its own is still notified" - (let [events (atom []) - scheduled (atom [])] - (with-redefs [errors/generate-report (fn [_] "generated error report") - errors/submit-report (fn [& _]) - st/emit! (mock/stub (fn [& emitted] - (swap! events into emitted))) - tm/schedule (mock/stub (fn [callback] - (swap! scheduled conj callback)))] - (errors/flash-persistence (ex-info "Invalid data" {:type :validation - :code :invalid-data})) - (doseq [callback @scheduled] (callback)) - (t/is (= 1 (count @events))) - (let [state (ptk/update (first @events) {})] - (t/is (nil? (get-in state [:notification :timeout]))) - (t/is (some? (get-in state [:notification :links 0])))))))) +(t/deftest ^:async save-failure-report-type-follows-the-cause + ;; The user still gets the same sticky toast and report link; only the audit + ;; event name changes, and that is what decides whether the incident reaches + ;; the internal reports and the alerts. + (t/testing "a validation failure is a defect, so it reports unhandled" + (t/is (= ["unhandled-exception"] + (await (report-names {:type :validation :code :invalid-data}))))) + + (t/testing "the wrapped shape reads the cause, not the wrapper" + ;; This is the shape that actually reaches flash-persistence: + ;; persistence-failed sets :type :persistence and keeps the real type + ;; under :cause-type. Reading :type alone would match the wrapper and + ;; leave the cause as handled. + (t/is (= ["unhandled-exception"] + (await (report-names {:type :persistence + :cause-type :validation + :code :invalid-data}))))) + + (t/testing "environment failures stay handled after the retry budget" + ;; They land here once the backoff is spent, and the user's connection is + ;; not our bug, so they must not alert. + (doseq [cause-type [:network :offline :bad-gateway :service-unavailable + :gateway-error]] + (t/is (= ["handled-exception"] + (await (report-names {:type :persistence + :cause-type cause-type}))) + (str cause-type " is an environment failure, not a defect")))) + + (t/testing "responses the backend never wrote stay handled" + (doseq [cause-type [:rate-limit :unexpected-response]] + (t/is (= ["handled-exception"] + (await (report-names {:type :persistence + :cause-type cause-type}))) + (str cause-type " comes from a proxy, not from our code")))) + + (t/testing "an unclassified failure keeps the handled path" + (t/is (= ["handled-exception"] + (await (report-names {:type :persistence + :cause-type :unknown-thing}))))) + + (t/testing "a bare :type still classifies, without a wrapper" + (t/is (= ["unhandled-exception"] + (await (report-names {:type :validation}))))) + + (t/testing "a server-side or internal defect reports unhandled" + (doseq [cause-type [:server-error :internal]] + (t/is (= ["unhandled-exception"] + (await (report-names {:type :persistence + :cause-type cause-type}))) + (str cause-type " is our bug"))))) + +;; --------------------------------------------------------------------------- +;; transport errors +;; --------------------------------------------------------------------------- + +(t/deftest ^:async transport-errors-are-handled-without-replacing-the-page + ;; Scenario: a rate limit and an error page the backend did not write, + ;; through the global handler. Proves: neither replaces the page, each is + ;; a handled report followed by one toast. + (doseq [type [:rate-limit :unexpected-response]] + (errors/reset-report-governor!) + (let [events (atom []) + assigned (atom []) + cause (ex-info "http error" + {:type type + :hint "http error" + :status 429 + :uri "https://design.penpot.app/api/main/methods/get-teams"})] + (await + (mock/with-mocks* + {st/emit! (mock/stub (fn [& emitted] (swap! events into emitted))) + rt/get-current-href (constantly "https://penpot.example.com/#/workspace") + rt/assign-exception (fn [error] (swap! assigned conj error) error) + tm/schedule (mock/stub (fn [f] (f))) + st/format-last-events (mock/stub (fn [& _] "(stub last events)"))} + (errors/on-error cause) + (await (async/settle)) + (t/is (empty? @assigned) + (str type " must not replace the page with an error screen")) + (t/is (= ["handled-exception"] + (map (comp ::ev/name deref) (report-events @events))) + (str type " is reported as handled, not unhandled")) + (t/is (= 2 (count @events)) (str type " must show one notification"))))))) diff --git a/frontend/test/frontend_tests/runner.cljs b/frontend/test/frontend_tests/runner.cljs index 96b79f0419..8423e94fbd 100644 --- a/frontend/test/frontend_tests/runner.cljs +++ b/frontend/test/frontend_tests/runner.cljs @@ -10,7 +10,9 @@ [frontend-tests.copy-as-svg-test] [frontend-tests.data.dashboard-test] [frontend-tests.data.exports-assets-test] + [frontend-tests.data.fix-deleted-fonts-test] [frontend-tests.data.nitrate-test] + [frontend-tests.data.persistence-retry-test] [frontend-tests.data.persistence-test] [frontend-tests.data.profile-test] [frontend-tests.data.repo-test] @@ -29,6 +31,7 @@ [frontend-tests.data.workspace-texts-test] [frontend-tests.data.workspace-thumbnails-test] [frontend-tests.data.workspace-versions-test] + [frontend-tests.errors-governor-test] [frontend-tests.errors-test] [frontend-tests.fonts-test] [frontend-tests.helpers-shapes-test] @@ -113,7 +116,9 @@ 'frontend-tests.composable-tests.comp.sync-test 'frontend-tests.copy-as-svg-test 'frontend-tests.data.dashboard-test + 'frontend-tests.data.fix-deleted-fonts-test 'frontend-tests.data.nitrate-test + 'frontend-tests.data.persistence-retry-test 'frontend-tests.data.persistence-test 'frontend-tests.data.profile-test 'frontend-tests.data.repo-test @@ -133,6 +138,7 @@ 'frontend-tests.data.workspace-texts-test 'frontend-tests.data.workspace-thumbnails-test 'frontend-tests.data.workspace-versions-test + 'frontend-tests.errors-governor-test 'frontend-tests.errors-test 'frontend-tests.fonts-test 'frontend-tests.helpers-shapes-test diff --git a/frontend/translations/en.po b/frontend/translations/en.po index 8135c2f712..e08161f63b 100644 --- a/frontend/translations/en.po +++ b/frontend/translations/en.po @@ -1535,6 +1535,10 @@ msgstr "" msgid "errors.comment-error" msgstr "There was an error with the comment" +#: src/app/main/errors.cljs:499 +msgid "errors.connection-error" +msgstr "Cannot reach the server. Check your connection and try again." + #: src/app/main/errors.cljs:414 msgid "errors.deprecated" msgstr "" @@ -1799,7 +1803,16 @@ msgstr "The registration is currently disabled." #: src/app/main/errors.cljs:216 msgid "errors.save-failed" msgstr "" -"Autosave is not working due to an error. Contact support to report the error and reload to continue from your last saved version." +"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:310 +msgid "errors.save-retrying" +msgstr "Connection lost. Retrying to save your changes." + +#: src/app/main/errors.cljs +msgid "errors.save-still-retrying" +msgstr "" +"Your changes are not saved yet because Penpot cannot reach the server. They are kept, and Penpot will keep trying to save them. Keep this tab open until they are saved." #: src/app/main/errors.cljs:337 msgid "errors.svg-parser.invalid-svg" @@ -7133,6 +7146,10 @@ msgstr "Unlock guides" msgid "workspace.header.reset-zoom" msgstr "Reset" +#: src/app/main/ui/workspace/left_header.cljs:125 +msgid "workspace.header.retrying" +msgstr "Retrying to save" + #: src/app/main/ui/workspace/left_header.cljs:123 msgid "workspace.header.save-error" msgstr "Error on saving" diff --git a/frontend/translations/es.po b/frontend/translations/es.po index aa583263ea..3807fd81d0 100644 --- a/frontend/translations/es.po +++ b/frontend/translations/es.po @@ -1766,7 +1766,12 @@ msgstr "El registro está actualmente desactivado." #: src/app/main/errors.cljs:216 msgid "errors.save-failed" msgstr "" -"El autoguardado se ha detenido debido a un error. Contacta soporte para informar del error y recarga para continuar desde los últimos cambios guardados." +"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/errors.cljs +msgid "errors.save-still-retrying" +msgstr "" +"Tus cambios aún no se han guardado porque Penpot no puede conectar con el servidor. Se conservan y Penpot seguirá intentando guardarlos. Mantén esta pestaña abierta hasta que se guarden." #: src/app/main/errors.cljs:337 msgid "errors.svg-parser.invalid-svg" From 334f727e870599538b07f758c145520f9aa875e7 Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Thu, 15 Oct 2026 08:40:39 +0000 Subject: [PATCH 09/16] :bug: Stop oversized audit events from wedging the queue Port staging c74d415 (#12252) to main, adapted to this branch. The :export-shapes modal event carried the full :exports vector, each export embedding its shape, which could reach megabytes and wedge the audit archive queue past the proxy body limit. Build a compact body instead: totals, distinct shapes and per-type counts, plus the page name. Other modals keep their props. Move the modal :origin prop to ::ev/origin so make-proto-event records it as :event-origin; the UI still reads the plain prop. Bound exception messages at the source: get-hint clamps to max-message-length (1000 chars) and the CLJS format-throwable clamps the trace message line and honors :trace-length. The Context Hint header in generate-report prints get-hint instead of the raw hint. Also fix first-line on the JVM, where cuerdas/index-of returns nil and (pos? nil) throws. Adaptations to main: skip audit-log.md (absent here), skip the generate-report huge-message test (staging async helpers are absent), and fit the errors.cljs hunk to main's generate-report. AI-assisted-by: muse-spark-1.3-contributor --- .serena/memories/clojure/idioms.md | 1 + .../frontend/routing-app-shell-subtleties.md | 3 +- common/src/app/common/exceptions.cljc | 39 ++++++++++--- common/test/common_tests/exceptions_test.cljc | 57 +++++++++++++++++++ common/test/common_tests/runner.cljc | 4 +- frontend/src/app/main/data/modal.cljs | 27 ++++++++- frontend/src/app/main/errors.cljs | 2 +- .../test/frontend_tests/data/modal_test.cljs | 55 ++++++++++++++++++ frontend/test/frontend_tests/runner.cljs | 2 + 9 files changed, 176 insertions(+), 14 deletions(-) create mode 100644 common/test/common_tests/exceptions_test.cljc create mode 100644 frontend/test/frontend_tests/data/modal_test.cljs diff --git a/.serena/memories/clojure/idioms.md b/.serena/memories/clojure/idioms.md index 26db315487..1345fd50a6 100644 --- a/.serena/memories/clojure/idioms.md +++ b/.serena/memories/clojure/idioms.md @@ -18,3 +18,4 @@ assumption; a wrong assumption here already cost a review round. - `^:async` fns never throw synchronously (rejected promises instead); `try/catch/finally` supported; continuations are microtasks, timers and RxJS schedulers are macrotasks (FIFO). +- `cuerdas.core/index-of` returns `nil` (not `-1`) when the substring is absent, like `clojure.string/index-of`. `(pos? nil)` **throws on the JVM** but evaluates to `false` in CLJS (JS coercion), so `(if (pos? (str/index-of s "\n")) …)` works in the browser and crashes the backend. Guard with `some?` before `pos?` (this was `app.common.exceptions/first-line`). diff --git a/.serena/memories/frontend/routing-app-shell-subtleties.md b/.serena/memories/frontend/routing-app-shell-subtleties.md index d62690ec72..7181144a9f 100644 --- a/.serena/memories/frontend/routing-app-shell-subtleties.md +++ b/.serena/memories/frontend/routing-app-shell-subtleties.md @@ -16,10 +16,11 @@ - `flash` accepts a `:links` vector of `{:label :callback}` actions, appended after the download link that `:report-link?` produces. `flash-persistence` passes a reload link, so a terminal save failure hands the user both the report and the only action that restarts persistence for the session. `labels.reload-page` plus `js/location.reload` is the established full-restart pattern; the link cannot be invoked under the test runner because `js/location` does not exist there, so it is covered by its label and by being callable. - `flash-persistence` only delegates to another handler for `:authentication`, `:not-found` and `:code :vern-conflict`. Everything else it reports itself, and the report type is derived from the cause: `#{:validation :server-error :internal}` are application defects and report as `unhandled-exception` so they reach the internal reports and the alerts; the rest stay `handled-exception`. `:cause-type` wins over `:type` when classifying, because `persistence-failed` wraps the original cause under `:type :persistence`. Environment failures are deliberately kept handled: they land here after the retry budget is spent and the user's connection is not our bug. `:assertion` is also kept handled, matching its own handler. - The report governor is global and stateful across tests: two reports with the same fingerprint inside `report-window-ms` collapse. Call `errors/reset-report-governor!` between assertions that expect an emission. +- Error messages are bounded at the source: `app.common.exceptions/get-hint` clamps to `max-message-length` (1000 chars) and the CLJS `format-throwable` clamps the message line of the stack trace and honors `:trace-length`. A message can embed a whole payload (a serialized file, for example) and reach megabytes; the bound keeps the audit `:hint` prop and the `:report` string small. The `Context: Hint:` header in `generate-report` prints `get-hint` (not the raw `:hint` from `ex-data`) for the same reason. ## Store and websocket For general store mechanics such as `emit!`, `last-events`, persistence, and undo, read `mem:frontend/workspace-state-persistence-subtleties`. - Websocket initialization uses `cf/public-uri` joined with `ws/notifications`, converting `http/https` to `ws/wss`, and includes the current `session-id` as query param. -- Reinitializing or finalizing websocket stops the previous receive stream. Incoming websocket payloads become Potok data events under `app.main.data.websocket/message`. \ No newline at end of file +- Reinitializing or finalizing websocket stops the previous receive stream. Incoming websocket payloads become Potok data events under `app.main.data.websocket/message`. diff --git a/common/src/app/common/exceptions.cljc b/common/src/app/common/exceptions.cljc index 588391601a..7bb36f2253 100644 --- a/common/src/app/common/exceptions.cljc +++ b/common/src/app/common/exceptions.cljc @@ -29,6 +29,22 @@ (def ^:dynamic *data-length* 8) (def ^:dynamic *data-level* 8) +(def max-message-length + "Upper bound, in characters, for an exception message surfaced as a hint or + embedded in a formatted stack trace. A message can carry a whole payload (a + serialized file, for instance) and grow to megabytes; only the head helps to + identify the failure, and the rest is noise that bloats reports and the audit + events built from them." + 1000) + +(defn- truncate + "Truncates a string to at most `n` characters, appending an ellipsis when it + had to cut. Values that are not strings pass through unchanged." + [s n] + (if (and (string? s) (> (count s) n)) + (str (subs s 0 n) "...") + s)) + (defmacro error [& {:keys [type hint] :as params}] `(ex-info ~(or hint (name type)) @@ -243,7 +259,7 @@ :cljs (defn format-throwable - [cause & {:as opts}] + [cause & {:keys [trace-length]}] (with-out-str (when-let [exdata (ex-data cause)] (when-let [hint (or (get exdata :hint) @@ -251,7 +267,7 @@ (when (str/index-of hint "\n") (println "Hint:") (println "--------------------") - (println hint) + (println (truncate hint max-message-length)) (println))) (when-let [explain (get exdata ::sm/explain)] @@ -272,14 +288,20 @@ (println)) (when-let [trace (.-stack cause)] - (println "Trace:") - (println "--------------------") - (println (.-stack cause)))))) + (let [lines (str/lines trace) + head (truncate (first lines) max-message-length) + tail (rest lines)] + (println "Trace:") + (println "--------------------") + (when head + (println head)) + (doseq [line (if trace-length (take trace-length tail) tail)] + (println line))))))) (defn first-line [s] (let [break-index (str/index-of s "\n")] - (if (pos? break-index) + (if (and (some? break-index) (pos? break-index)) (subs s 0 break-index) s))) @@ -308,5 +330,6 @@ (defn get-hint [cause] - (or (some-> (ex-data cause) (get :hint) first-line) - (some-> (ex-message cause) first-line))) + (truncate (or (some-> (ex-data cause) (get :hint) first-line) + (some-> (ex-message cause) first-line)) + max-message-length)) diff --git a/common/test/common_tests/exceptions_test.cljc b/common/test/common_tests/exceptions_test.cljc new file mode 100644 index 0000000000..6f9df8da60 --- /dev/null +++ b/common/test/common_tests/exceptions_test.cljc @@ -0,0 +1,57 @@ +;; 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 common-tests.exceptions-test + "Exception message bounding in `app.common.exceptions`. + + A message can carry a whole payload (a serialized file, for instance) and + grow to megabytes. `get-hint` and the CLJS `format-throwable` keep a bounded + head so neither the audit `:hint` prop nor the report can explode." + (:require + #?(:cljs [cuerdas.core :as str]) + [app.common.exceptions :as ex] + [clojure.test :as t])) + +(defn- huge-string + [n] + (apply str (repeat n "x"))) + +(t/deftest first-line-keeps-a-single-line-message-intact-test + (t/is (= "boom" (ex/first-line "boom"))) + (t/is (= "boom" (ex/first-line "boom\nrest of the message")))) + +(t/deftest get-hint-returns-the-first-line-test + (t/is (= "boom" (ex/get-hint (ex-info "boom\nsecond line" {}))))) + +(t/deftest get-hint-prefers-the-ex-data-hint-test + (t/is (= "from-data" (ex/get-hint (ex-info "from-message" {:hint "from-data"}))))) + +(t/deftest get-hint-bounds-a-huge-message-test + (let [huge (huge-string (* 4 ex/max-message-length)) + hint (ex/get-hint (ex-info huge {}))] + (t/is (string? hint)) + (t/is (<= (count hint) (+ ex/max-message-length 3))) + (t/is (= (subs hint 0 32) (subs huge 0 32))))) + +(t/deftest get-hint-bounds-a-huge-ex-data-hint-test + (let [huge (huge-string (* 4 ex/max-message-length)) + hint (ex/get-hint (ex-info "short" {:hint huge}))] + (t/is (<= (count hint) (+ ex/max-message-length 3))) + (t/is (= (subs hint 0 32) (subs huge 0 32))))) + +#?(:cljs + (t/deftest format-throwable-bounds-a-huge-trace-message-test + (let [huge (huge-string (* 4 ex/max-message-length)) + out (ex/format-throwable (ex-info huge {})) + msg (some #(when (str/includes? % (subs huge 0 16)) %) (str/lines out))] + (t/is (some? msg)) + (t/is (<= (count msg) (+ ex/max-message-length 16)))))) + +#?(:cljs + (t/deftest format-throwable-honors-trace-length-test + (let [full (ex/format-throwable (ex-info "boom" {})) + short (ex/format-throwable (ex-info "boom" {}) {:trace-length 1})] + (t/is (< (count (str/lines short)) (count (str/lines full))))))) diff --git a/common/test/common_tests/runner.cljc b/common/test/common_tests/runner.cljc index 1b55f1d1e4..1a0ba1217d 100644 --- a/common/test/common_tests/runner.cljc +++ b/common/test/common_tests/runner.cljc @@ -16,6 +16,7 @@ [common-tests.buffer-test] [common-tests.colors-test] [common-tests.data-test] + [common-tests.exceptions-test] [common-tests.files-builder-test] [common-tests.files-changes-test] [common-tests.files-migrations-0025-test] @@ -96,8 +97,9 @@ 'common-tests.buffer-test 'common-tests.colors-test 'common-tests.data-test - 'common-tests.files-changes-test + 'common-tests.exceptions-test 'common-tests.files-builder-test + 'common-tests.files-changes-test 'common-tests.files-migrations-0025-test 'common-tests.files-migrations-0026-test 'common-tests.files-migrations-test diff --git a/frontend/src/app/main/data/modal.cljs b/frontend/src/app/main/data/modal.cljs index 052080f3fb..c6351e1a8d 100644 --- a/frontend/src/app/main/data/modal.cljs +++ b/frontend/src/app/main/data/modal.cljs @@ -17,6 +17,19 @@ ;; TODO: rename `:type` to `:name` +(defn- summarize-export-shapes + "Builds a compact body for the `:export-shapes` modal event. We know the + shape of these props here, so instead of dumping every export (each one + carrying its full shape, which can be megabytes) we emit counters: total + exports, distinct shapes and one count per export type." + [props] + (let [exports (:exports props)] + (merge + {:page (:name props) + :num-shapes (count (distinct (map :object-id exports))) + :num-exports (count exports)} + (frequencies (map :type exports))))) + (defn show ([props] (show (uuid/next) (:type props) props)) @@ -26,9 +39,17 @@ (ptk/reify ::show-modal ev/Event (-data [_] - (-> props - (dissoc :type) - (assoc :name type))) + (let [origin (:origin props) + data (if (= type :export-shapes) + (assoc (summarize-export-shapes props) :name type) + (-> props + (dissoc :type) + (assoc :name type)))] + ;; The origin is event metadata, not a prop: sending it as + ;; ::ev/origin makes `make-proto-event` put it on the event context + ;; (`:event-origin`); as a plain `:origin` it only stayed as a prop. + (cond-> (dissoc data :origin) + (some? origin) (assoc ::ev/origin origin)))) ptk/UpdateEvent (update [_ state] diff --git a/frontend/src/app/main/errors.cljs b/frontend/src/app/main/errors.cljs index 28e6e54a9b..5be508739a 100644 --- a/frontend/src/app/main/errors.cljs +++ b/frontend/src/app/main/errors.cljs @@ -157,7 +157,7 @@ (println "Context:") (println "--------------------") (println "Timestamp:" (ct/format-inst (ct/now) :rfc1123)) - (println "Hint: " (or (:hint data) (ex-message cause) "--")) + (println "Hint: " (or (ex/get-hint cause) "--")) (println "Prof ID: " (str (or profile-id "--"))) (println "Team ID: " (str (or team-id "--"))) (when-let [file-id (or (:file-id data) file-id)] diff --git a/frontend/test/frontend_tests/data/modal_test.cljs b/frontend/test/frontend_tests/data/modal_test.cljs new file mode 100644 index 0000000000..e3b0fd4325 --- /dev/null +++ b/frontend/test/frontend_tests/data/modal_test.cljs @@ -0,0 +1,55 @@ +;; 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.modal-test + (:require + [app.common.uuid :as uuid] + [app.main.data.event :as ev] + [app.main.data.modal :as modal] + [cljs.test :as t :include-macros true])) + +(t/deftest export-shapes-modal-event-carries-a-summary + (let [shape-a (uuid/next) + shape-b (uuid/next) + exports [{:object-id shape-a :type :png} + {:object-id shape-a :type :svg} + {:object-id shape-b :type :png}] + event (modal/show :export-shapes + {:exports exports + :origin "workspace:sidebar" + :name "Page 1"}) + data (ev/-data event)] + + (t/testing "the raw exports never leak into the event" + (t/is (not (contains? data :exports)))) + + (t/testing "the event carries counters instead" + (t/is (= 3 (:num-exports data))) + (t/is (= 2 (:num-shapes data))) + (t/is (= 2 (:png data))) + (t/is (= 1 (:svg data)))) + + (t/testing "the modal context is preserved" + (t/is (= "Page 1" (:page data))) + (t/is (= :export-shapes (:name data)))) + + (t/testing "origin is emitted as event metadata, not as a prop" + (t/is (= "workspace:sidebar" (::ev/origin data))) + (t/is (not (contains? data :origin)))))) + +(t/deftest other-modals-keep-their-props + (let [event (modal/show :some-modal {:foo "bar" :items [1 2 3]}) + data (ev/-data event)] + (t/is (= "bar" (:foo data))) + (t/is (= [1 2 3] (:items data))) + (t/is (= :some-modal (:name data))))) + +(t/deftest modal-origin-becomes-event-metadata + (let [event (modal/show :some-modal {:foo "bar" :origin "dashboard"}) + data (ev/-data event)] + (t/is (= "dashboard" (::ev/origin data))) + (t/is (not (contains? data :origin))) + (t/is (= "bar" (:foo data))))) diff --git a/frontend/test/frontend_tests/runner.cljs b/frontend/test/frontend_tests/runner.cljs index 8423e94fbd..e7a5859879 100644 --- a/frontend/test/frontend_tests/runner.cljs +++ b/frontend/test/frontend_tests/runner.cljs @@ -11,6 +11,7 @@ [frontend-tests.data.dashboard-test] [frontend-tests.data.exports-assets-test] [frontend-tests.data.fix-deleted-fonts-test] + [frontend-tests.data.modal-test] [frontend-tests.data.nitrate-test] [frontend-tests.data.persistence-retry-test] [frontend-tests.data.persistence-test] @@ -117,6 +118,7 @@ 'frontend-tests.copy-as-svg-test 'frontend-tests.data.dashboard-test 'frontend-tests.data.fix-deleted-fonts-test + 'frontend-tests.data.modal-test 'frontend-tests.data.nitrate-test 'frontend-tests.data.persistence-retry-test 'frontend-tests.data.persistence-test From 98f8b7e62548280a8dea45d484c4603925477f02 Mon Sep 17 00:00:00 2001 From: Eva Marco Date: Thu, 15 Oct 2026 16:23:32 +0200 Subject: [PATCH 10/16] :bug: Keep the picture in place when a crop crosses the opposite edge (#12361) With the mod key, resizing a shape with an image fill crops it: the shape is a window over a picture that keeps its size and position. When the dragged edge crossed the opposite one, the crop mode turned off and a normal resize with a negative scale flipped the shape. The image transform is relative to the shape, so the picture was mirrored and shrank a bit more on every crossing until it disappeared. Keep the crop mode when the edge crosses: the window moves to the other side of the fixed edge without flipping, the part outside the picture shows empty, and moving the window back shows the picture again. The crop math lives in app.common.geom.image-crop and replaces the image transform code that was duplicated for fills and fill-image. Closes #12349 AI-assisted-by: claude-opus-5-5 --- common/src/app/common/geom/image_crop.cljc | 38 +++++++++ .../common_tests/geom_image_crop_test.cljc | 67 +++++++++++++++ common/test/common_tests/runner.cljc | 2 + .../app/main/data/workspace/transforms.cljs | 83 ++++++++----------- 4 files changed, 143 insertions(+), 47 deletions(-) create mode 100644 common/src/app/common/geom/image_crop.cljc create mode 100644 common/test/common_tests/geom_image_crop_test.cljc diff --git a/common/src/app/common/geom/image_crop.cljc b/common/src/app/common/geom/image_crop.cljc new file mode 100644 index 0000000000..fdd9f89527 --- /dev/null +++ b/common/src/app/common/geom/image_crop.cljc @@ -0,0 +1,38 @@ +;; 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.common.geom.image-crop + "Geometry of the image crop (resize with the mod key on a shape with an + image fill). The shape is a window over a picture that keeps its size + and position; the window never flips." + (:require + [app.common.math :as mth])) + +(defn crop-axis + "Resize one axis of the crop window. `size` is the current window size, + `origin` the fixed point relative to the window start and `scale` the + resize factor, negative when the dragged edge crosses the fixed point. + Returns `[offset size]`: the new window start relative to the old one, + and the new size, always positive." + [size origin scale] + (let [start (* origin (- 1 scale)) + end (+ origin (* (- size origin) scale))] + [(mth/min start end) (mth/abs (- end start))])) + +(defn update-image-transform + "Return the image fill transform that keeps the picture in place when + the window of `width` x `height` moves by `dx`, `dy` and gets a size of + `width'` x `height'`. The transform values are relative to the window + size, and a nil transform means the picture fills the window." + [transform width height dx dy width' height'] + (let [x (get transform :x 0.0) + y (get transform :y 0.0) + w (get transform :width 1.0) + h (get transform :height 1.0)] + {:x (/ (- (* x width) dx) width') + :y (/ (- (* y height) dy) height') + :width (/ (* w width) width') + :height (/ (* h height) height')})) diff --git a/common/test/common_tests/geom_image_crop_test.cljc b/common/test/common_tests/geom_image_crop_test.cljc new file mode 100644 index 0000000000..cdd30e444f --- /dev/null +++ b/common/test/common_tests/geom_image_crop_test.cljc @@ -0,0 +1,67 @@ +;; 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 common-tests.geom-image-crop-test + (:require + [app.common.geom.image-crop :as gic] + [app.common.math :as mth] + [clojure.test :as t])) + +(defn- close-vals? + [a b] + (every? true? (map mth/close? a b))) + +(defn- picture-box + "Picture position and size relative to the original window start, for a + window at `offset` with `size` and the given image transform." + [{:keys [x y width height]} [dx dy] [w h]] + [(+ dx (* x w)) (+ dy (* y h)) (* width w) (* height h)]) + +(t/deftest crop-axis-test + (t/testing "shrinks the window towards the fixed edge" + ;; Top handler: the bottom edge (300) stays fixed. + (t/is (close-vals? [60 240] (gic/crop-axis 300 300 0.8)))) + + (t/testing "grows the window away from the fixed edge" + (t/is (close-vals? [-60 360] (gic/crop-axis 300 300 1.2)))) + + (t/testing "crossing the fixed edge moves the window to the other side" + ;; Top handler dragged 100px below the bottom edge. + (t/is (close-vals? [300 100] (gic/crop-axis 300 300 (/ -1 3)))) + ;; Bottom handler dragged 150px above the top edge. + (t/is (close-vals? [-150 150] (gic/crop-axis 300 0 -0.5)))) + + (t/testing "resize from the center keeps the center when crossing" + (t/is (close-vals? [75 150] (gic/crop-axis 300 150 -0.5))))) + +(t/deftest update-image-transform-test + (let [width 400 + height 300 + tf {:x 0 :y -0.2 :width 1 :height 1.4}] + + (t/testing "the picture keeps its position and size" + (doseq [[dx dy w' h'] [[0 60 400 240] + [0 300 400 100] + [0 -150 400 150] + [-50 75 500 150]]] + (let [tf' (gic/update-image-transform tf width height dx dy w' h')] + (t/is (close-vals? (picture-box tf [0 0] [width height]) + (picture-box tf' [dx dy] [w' h'])) + (str "window " [dx dy w' h']))))) + + (t/testing "a missing transform means the picture fills the window" + (t/is (close-vals? [0 -0.25 1 1.25] + ((juxt :x :y :width :height) + (gic/update-image-transform nil 400 300 0 60 400 240))))) + + (t/testing "moving the window back restores the original transform" + (let [[dy h'] (gic/crop-axis height height (/ -1 3)) + crossed (gic/update-image-transform tf width height 0 dy width h') + [dy2 h2] (gic/crop-axis h' 0 (/ height h' -1)) + back (gic/update-image-transform crossed width h' 0 dy2 width h2)] + (t/is (close-vals? [(- dy) height] [dy2 h2]) "window back at its original place") + (t/is (close-vals? ((juxt :x :y :width :height) tf) + ((juxt :x :y :width :height) back))))))) diff --git a/common/test/common_tests/runner.cljc b/common/test/common_tests/runner.cljc index e4cec9b442..88e10df432 100644 --- a/common/test/common_tests/runner.cljc +++ b/common/test/common_tests/runner.cljc @@ -35,6 +35,7 @@ [common-tests.geom-grid-layout-test] [common-tests.geom-grid-test] [common-tests.geom-image-bounds-resize-test] + [common-tests.geom-image-crop-test] [common-tests.geom-line-test] [common-tests.geom-modif-tree-test] [common-tests.geom-modifiers-test] @@ -138,6 +139,7 @@ 'common-tests.geom-grid-layout-test 'common-tests.geom-grid-test 'common-tests.geom-image-bounds-resize-test + 'common-tests.geom-image-crop-test 'common-tests.geom-line-test 'common-tests.geom-modif-tree-test 'common-tests.geom-modifiers-test diff --git a/frontend/src/app/main/data/workspace/transforms.cljs b/frontend/src/app/main/data/workspace/transforms.cljs index 15990f2de3..640a9fc11f 100644 --- a/frontend/src/app/main/data/workspace/transforms.cljs +++ b/frontend/src/app/main/data/workspace/transforms.cljs @@ -11,6 +11,7 @@ [app.common.data.macros :as dm] [app.common.files.changes-builder :as pcb] [app.common.files.helpers :as cfh] + [app.common.geom.image-crop :as gic] [app.common.geom.matrix :as gmt] [app.common.geom.modifiers :as gm] [app.common.geom.point :as gpt] @@ -212,10 +213,29 @@ ;; Resize origin point given the selected handler selrect (dm/get-prop shape :selrect) handler-origin (get-handler-resize-origin selrect handler) + selrect-start (gpt/point (dm/get-prop selrect :x) (dm/get-prop selrect :y)) + + ;; Image crop (mod key): the shape is a window over a + ;; picture that keeps its size and position. Dragging an + ;; edge past the fixed one moves the window to the other + ;; side instead of flipping it. + crop-origin (if ^boolean center? + (gpt/point (/ width 2) (/ height 2)) + (gpt/subtract handler-origin selrect-start)) + [crop-dx crop-w] (gic/crop-axis width (dm/get-prop crop-origin :x) (dm/get-prop scalev :x)) + [crop-dy crop-h] (gic/crop-axis height (dm/get-prop crop-origin :y) (dm/get-prop scalev :y)) + + scalev (if ^boolean bounds-resize? + (gpt/point (/ crop-w width) (/ crop-h height)) + scalev) ;; If we want resize from center, displace the shape ;; so it is still centered after resize. - displacement (when ^boolean center? + displacement (cond + ^boolean bounds-resize? + (gpt/transform (gpt/point crop-dx crop-dy) shape-transform) + + ^boolean center? (-> shape-center (gpt/subtract handler-origin) (gpt/multiply scalev) @@ -224,7 +244,10 @@ (gpt/multiply (gpt/point -1 -1)) (gpt/transform shape-transform))) - resize-origin (gmt/transform-point-center handler-origin shape-center shape-transform) + resize-origin (gmt/transform-point-center + (if ^boolean bounds-resize? selrect-start handler-origin) + shape-center + shape-transform) resize-origin (if (some? displacement) (gpt/add resize-origin displacement) resize-origin) @@ -242,57 +265,23 @@ change-height? (not (mth/close? (dm/get-prop scalev :y) 1)) - ;; Calculate independent image bounds resize transform - sx (dm/get-prop scalev :x) - sy (dm/get-prop scalev :y) - w-new (* width sx) - h-new (* height sy) - - bounds-resize? (and ^boolean bounds-resize? - (pos? w-new) - (pos? h-new)) - - [dx dy] (if ^boolean center? - [(/ (* width (- 1.0 sx)) 2.0) - (/ (* height (- 1.0 sy)) 2.0)] - [(case handler - (:left :bottom-left :top-left) (* width (- 1.0 sx)) - 0.0) - (case handler - (:top :top-left :top-right) (* height (- 1.0 sy)) - 0.0)]) + ;; Keep the picture in place inside the new crop window + update-image + (fn [img-fill] + (update img-fill :transform gic/update-image-transform + width height crop-dx crop-dy crop-w crop-h)) new-fills - (when (and bounds-resize? (seq (:fills shape))) + (when (and ^boolean bounds-resize? (seq (:fills shape))) (mapv (fn [fill] - (if-let [img-fill (:fill-image fill)] - (let [tf (get img-fill :transform) - nx0 (get tf :x 0.0) - ny0 (get tf :y 0.0) - nw0 (get tf :width 1.0) - nh0 (get tf :height 1.0) - nx' (/ (- (* nx0 width) dx) w-new) - ny' (/ (- (* ny0 height) dy) h-new) - nw' (/ nw0 sx) - nh' (/ nh0 sy)] - (assoc-in fill [:fill-image :transform] - {:x nx' :y ny' :width nw' :height nh'})) - fill)) + (cond-> fill + (some? (:fill-image fill)) + (update :fill-image update-image))) (:fills shape))) new-fill-image - (when (and bounds-resize? (some? (:fill-image shape))) - (let [img-fill (:fill-image shape) - tf (get img-fill :transform) - nx0 (get tf :x 0.0) - ny0 (get tf :y 0.0) - nw0 (get tf :width 1.0) - nh0 (get tf :height 1.0) - nx' (/ (- (* nx0 width) dx) w-new) - ny' (/ (- (* ny0 height) dy) h-new) - nw' (/ nw0 sx) - nh' (/ nh0 sy)] - (assoc img-fill :transform {:x nx' :y ny' :width nw' :height nh'})))] + (when (and ^boolean bounds-resize? (some? (:fill-image shape))) + (update-image (:fill-image shape)))] (cond-> (ctm/empty) (some? displacement) From feb73f0fd82538a5f977a3e8b6a19378c010534d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Moya?= Date: Thu, 15 Oct 2026 16:53:30 +0200 Subject: [PATCH 11/16] :sparkles: Handle tokens libraries when exporting .penpot files (#12077) * :sparkles: Handle tokens libraries when exporting .penpot files Exporting a file that takes its tokens from an external library left the :tokens-source of the file pointing at a library that is not in the export, and the tokens lib of that library was not exported. With :detach-libraries, unset the :tokens-source and the tokens status in detach-external-references. The file is exported without any link to the library, and the shapes keep their applied tokens. With :merge-libraries, add cfo/absorb-tokens-lib, which copies the tokens lib of a library into a file and unsets its :tokens-source, so the file becomes its own tokens source. The tokens status of the file is kept; if it has none, the one of the library is copied. If the library has no tokens lib, only the source is unset. embed-assets calls it for the library that is the tokens source of the file, and ignores the other linked libraries. Add unit tests for absorb-tokens-lib, and binfile tests that export a file with tokens from an external library with both modes, checking the exported files, the tokens lib, the tokens source and the applied tokens. Also reformat the export-type docstring in binfile v3 and remove a leftover debug prn in the export dialog. AI-assisted-by: claude-sonnet-5-5 * :bug: Preserve active token sets when importing linked libraries Cache each decoded tokens library for the duration of an import so files and their tokens source resolve active sets against the same generated IDs. Add a round-trip regression test for exports that include linked libraries. * :bug: Preserve tokens when deleting or unpublishing libraries Absorb the tokens library into files that use it as their tokens source. Keep referencing file IDs in the deletion task before removing relations. Embed tokens from deleted, unlinked sources during export, and clear stale source and status data when the library no longer exists. Add regression tests for deletion, unpublishing, and exports with unavailable libraries. --------- Co-authored-by: alonso.torres --- backend/src/app/binfile/common.clj | 34 +- backend/src/app/binfile/v3.clj | 22 +- backend/src/app/rpc/commands/files.clj | 50 ++- backend/src/app/tasks/delete_object.clj | 4 +- backend/test/backend_tests/binfile_test.clj | 412 +++++++++++++++++- backend/test/backend_tests/rpc_file_test.clj | 92 ++++ common/src/app/common/files/tokens.cljc | 26 ++ common/src/app/common/types/file.cljc | 5 +- .../test/common_tests/files/tokens_test.cljc | 215 +++++++++ frontend/src/app/main/ui/exports/files.cljs | 1 - 10 files changed, 827 insertions(+), 34 deletions(-) diff --git a/backend/src/app/binfile/common.clj b/backend/src/app/binfile/common.clj index 2275a2cc6d..fe85844dc2 100644 --- a/backend/src/app/binfile/common.clj +++ b/backend/src/app/binfile/common.clj @@ -13,6 +13,7 @@ [app.common.features :as cfeat] [app.common.files.helpers :as cfh] [app.common.files.migrations :as fmg] + [app.common.files.tokens :as cfo] [app.common.files.validate :as fval] [app.common.logging :as l] [app.common.media :as cm] @@ -678,15 +679,34 @@ colors colors)) +(defn absorb-unlinked-tokens-source + "Make the file its own tokens source when its tokens source is not one + of the given library-ids, as happens when the library was deleted. The + tokens lib of the source is copied while the library still exists, even + if deleted; otherwise the tokens source and status are removed." + [cfg data library-ids] + (let [source-id (cfo/get-tokens-source data)] + (if (and (some? source-id) + (not (contains? library-ids source-id))) + (if-let [library (get-file cfg source-id + :include-deleted? true + :throw-if-not-exists? false)] + (cfo/absorb-tokens-lib data (:data library)) + (dissoc data :tokens-source :tokens-status)) + data))) + (defn embed-assets [cfg data file-id] - (let [library-ids (get-libraries cfg [file-id])] - (reduce (fn [data library-id] - (if-let [library (get-file cfg library-id :include-deleted? true)] - (ctf/absorb-assets data (:data library)) - data)) - data - library-ids))) + (let [library-ids (get-libraries cfg [file-id]) + data (reduce (fn [data library-id] + (if-let [library (get-file cfg library-id :include-deleted? true)] + (cond-> (ctf/absorb-assets data (:data library)) + (= library-id (cfo/get-tokens-source data)) + (cfo/absorb-tokens-lib (:data library))) + data)) + data + library-ids)] + (absorb-unlinked-tokens-source cfg data library-ids))) (def ^:const import-transaction-timeout-ms "Ceiling for binfile import transactions (20 minutes). Interpolated diff --git a/backend/src/app/binfile/v3.clj b/backend/src/app/binfile/v3.clj index 1d411336f7..c2fa61b686 100644 --- a/backend/src/app/binfile/v3.clj +++ b/backend/src/app/binfile/v3.clj @@ -259,6 +259,10 @@ embed? (update :data #(bfc/embed-assets cfg % file-id)) + (not (or detach? embed?)) + (update :data #(bfc/absorb-unlinked-tokens-source + cfg % (bfc/get-libraries cfg [file-id]))) + :always (bfc/clean-file-features)))))) @@ -800,7 +804,7 @@ {}) (not-empty))) -(defn- read-file-tokens-lib +(defn- read-file-tokens-lib* [{:keys [::bfc/input ::entries-index] :as cfg} file-id] (when-let [{:keys [entry]} (first (get-in entries-index [:tokens (str file-id)]))] (events/tap :progress {:section :tokens-lib :file-id file-id}) @@ -808,6 +812,19 @@ (decode-tokens-lib) (validate-tokens-lib)))) +(defn- read-file-tokens-lib + "Read the tokens lib of a file once per import. Decoding generates new + set ids, so the tokens lib of a library must be the same instance when + it is imported and when it resolves the tokens status of a file that + uses it as tokens source." + [cfg file-id] + (let [cache (:tokens-libs @bfc/*state*)] + (if (contains? cache file-id) + (get cache file-id) + (let [tokens-lib (read-file-tokens-lib* cfg file-id)] + (vswap! bfc/*state* assoc-in [:tokens-libs file-id] tokens-lib) + tokens-lib)))) + (defn- read-file-tokens-status [{:keys [::bfc/input ::entries-index] :as cfg} file-id tokens-lib] (when-let [{:keys [entry]} (first (get-in entries-index [:tokens-status (str file-id)]))] @@ -1313,7 +1330,8 @@ format. There are some options available for customize the output: `::bfc/export-type`: determines how linked libraries are handled. - Valid values: `:include-libraries` (include linked libraries), + Valid values: + `:include-libraries` (include linked libraries), `:merge-libraries` (embed library assets in the file), `:detach-libraries` (treat assets as basic objects), `:link-later` (preserve component metadata for relinking on import)." diff --git a/backend/src/app/rpc/commands/files.clj b/backend/src/app/rpc/commands/files.clj index 1679e76204..b71d425040 100644 --- a/backend/src/app/rpc/commands/files.clj +++ b/backend/src/app/rpc/commands/files.clj @@ -940,7 +940,11 @@ (let [file (-> (bfc/get-file cfg file-id :include-deleted? true :lock-for-update? true) - (update :data ctf/absorb-assets ldata))] + (update :data ctf/absorb-assets ldata) + (update :data (fn [data] + (cond-> data + (cfo/effective-tokens-source? data (:id ldata)) + (cfo/absorb-tokens-lib ldata)))))] (l/trc :hint "library absorbed" :library-id (str (:id ldata)) @@ -953,16 +957,21 @@ :modified-at (ct/now) :has-media-trimmed false})))) +(defn- get-referenced-files + [cfg library-id] + (->> (db/exec! cfg [sql:get-referenced-files library-id]) + (into [] bfc/xf-map-id))) + (defn- absorb-library* - "Find all files using a shared library, and absorb all library assets - into the file local libraries" - [cfg {:keys [id data] :as library}] + "Absorb all library assets, and its tokens lib if it is their tokens + source, into the local libraries of the files that use it. The files + are the given file-ids, or the ones linked to the library if nil." + [cfg {:keys [id data] :as library} file-ids] (assert (db/connection-map? cfg) "expected cfg with valid connection") - (let [ids (->> (db/exec! cfg [sql:get-referenced-files id]) - (sequence bfc/xf-map-id))] + (let [ids (or file-ids (get-referenced-files cfg id))] (l/trc :hint "absorbing library" :library-id (str id) @@ -972,7 +981,9 @@ library)) (defn absorb-library - [{:keys [::db/conn] :as cfg} id] + "Absorb the library into the files that use it. The files are the given + file-ids, or the ones linked to the library if omitted." + [{:keys [::db/conn] :as cfg} id & {:keys [file-ids]}] (let [file (-> (bfc/get-file cfg id :realize? true :lock-for-update? true @@ -988,7 +999,7 @@ (-> (cfeat/get-team-enabled-features cf/flags team) (cfeat/check-file-features! (:features file))) - (absorb-library* cfg file))) + (absorb-library* cfg file file-ids))) (defn- set-file-shared [{:keys [::db/conn] :as cfg} {:keys [profile-id id] :as params}] @@ -1056,12 +1067,15 @@ (defn- mark-file-deleted [conn team file-id] - (let [delay (ldel/get-deletion-delay team) - file (db/update! conn :file - {:deleted-at (ct/in-future delay)} - {:id file-id} - {::db/return-keys [:id :name :is-shared :deleted-at - :project-id :created-at :modified-at]})] + (let [delay (ldel/get-deletion-delay team) + file (db/update! conn :file + {:deleted-at (ct/in-future delay)} + {:id file-id} + {::db/return-keys [:id :name :is-shared :deleted-at + :project-id :created-at :modified-at]}) + ;; Files using the library, captured before their relations are removed + file-ids (when (:is-shared file) + (get-referenced-files conn file-id))] ;; Remove all possible relations for that file (db/delete! conn :file-library-rel @@ -1069,9 +1083,11 @@ (wrk/submit! {::db/conn conn ::wrk/task :delete-object - ::wrk/params {:object :file - :deleted-at (:deleted-at file) - :id file-id}}) + ::wrk/params (cond-> {:object :file + :deleted-at (:deleted-at file) + :id file-id} + (some? file-ids) + (assoc :file-ids file-ids))}) file)) (def ^:private diff --git a/backend/src/app/tasks/delete_object.clj b/backend/src/app/tasks/delete_object.clj index abdc4bc5f3..aa64f2e8c1 100644 --- a/backend/src/app/tasks/delete_object.clj +++ b/backend/src/app/tasks/delete_object.clj @@ -61,7 +61,7 @@ {::db/return-keys false})) (defmethod delete-object :file - [{:keys [::db/conn] :as cfg} {:keys [id deleted-at]}] + [{:keys [::db/conn] :as cfg} {:keys [id deleted-at file-ids]}] (when-let [file (db/get* conn :file {:id id} {::db/remove-deleted false ::sql/columns [:id :is-shared]})] @@ -79,7 +79,7 @@ (not *team-deletion*)) ;; NOTE: we don't prevent file deletion on absorb operation failure (try - (db/tx-run! cfg files/absorb-library id) + (db/tx-run! cfg files/absorb-library id :file-ids file-ids) (catch Throwable cause (l/warn :hint "error on absorbing library" :file-id id diff --git a/backend/test/backend_tests/binfile_test.clj b/backend/test/backend_tests/binfile_test.clj index b29b2fcf29..1b75b3a6cd 100644 --- a/backend/test/backend_tests/binfile_test.clj +++ b/backend/test/backend_tests/binfile_test.clj @@ -12,17 +12,18 @@ [app.binfile.v3 :as v3] [app.common.data :as d] [app.common.features :as cfeat] + [app.common.files.changes-builder :as pcb] + [app.common.files.tokens :as cfo] [app.common.files.validate :as cfv] - [app.common.pprint :as pp] [app.common.thumbnails :as thc] [app.common.time :as ct] [app.common.types.shape :as cts] + [app.common.types.token :as cto] [app.common.types.tokens-lib :as ctob] + [app.common.types.tokens-status :as ctos] [app.common.uuid :as uuid] [app.config :as cf] [app.db :as db] - [app.db.sql :as sql] - [app.http :as http] [app.rpc :as-alias rpc] [app.rpc.commands.binfile :as binfile] [app.storage :as sto] @@ -36,7 +37,6 @@ [datoteka.io :as io]) (:import java.io.ByteArrayInputStream - java.io.DataInputStream java.io.OutputStreamWriter java.io.Writer java.util.zip.Deflater @@ -105,6 +105,117 @@ (dissoc file :data)))) +(defn- prepare-file-with-tokens-lib + "A shared library and a linked file with different active token sets. + The file has a rect with two applied tokens. Returns the created files, + and the ids and tokens needed to check them." + [profile] + (let [lib-page-id (uuid/custom 5 1) + file-page-id (uuid/custom 5 2) + shape-id (uuid/custom 5 3) + set-id (uuid/custom 5 4) + theme-id (uuid/custom 5 5) + other-set-id (uuid/custom 5 8) + other-theme-id (uuid/custom 5 9) + + token-radius (ctob/make-token :id (uuid/custom 5 6) + :name "token-radius" + :type :border-radius + :value 10) + + token-opacity (ctob/make-token :id (uuid/custom 5 7) + :name "token-opacity" + :type :opacity + :value 0.7) + + tokens-lib (-> (ctob/make-tokens-lib) + (ctob/add-set (ctob/make-token-set :id set-id + :name "test-token-set")) + (ctob/add-theme (ctob/make-token-theme :id theme-id + :name "test-theme" + :sets #{"test-token-set"})) + (ctob/add-set (ctob/make-token-set :id other-set-id + :name "other-token-set")) + (ctob/add-theme (ctob/make-token-theme :id other-theme-id + :name "other-theme" + :sets #{"other-token-set"})) + (ctob/add-token other-set-id (ctob/make-token :id (uuid/custom 5 10) + :name "other-token" + :type :opacity + :value 0.4)) + (ctob/add-token set-id token-radius) + (ctob/add-token set-id token-opacity)) + + library (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared true + :name "Tokens Library"}) + + file (th/create-file* 2 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared false})] + + (th/link-file-to-library* {:file-id (:id file) + :library-id (:id library)}) + + (update-file! + :file-id (:id library) + :profile-id (:id profile) + :revn 0 + :changes + (-> (pcb/empty-changes nil) + (pcb/with-library-data (:data library)) + (pcb/add-empty-page lib-page-id "library page") + (pcb/set-tokens-lib tokens-lib) + (pcb/set-tokens-status (ctos/make-tokens-status :active-theme-ids #{other-theme-id} + :active-set-ids #{other-set-id})) + (:redo-changes))) + + (update-file! + :file-id (:id file) + :profile-id (:id profile) + :revn 0 + :changes + (-> (pcb/empty-changes nil) + (pcb/with-library-data (:data file)) + (pcb/add-empty-page file-page-id "file page") + (pcb/set-tokens-source (:id library)) + (pcb/set-tokens-status (ctos/make-tokens-status :active-theme-ids #{theme-id} + :active-set-ids #{set-id})) + (:redo-changes))) + + (let [page (-> (bfc/get-file th/*system* (:id file) {:realize? true}) + (get-in [:data :pages-index file-page-id])) + shape (as-> (cts/setup-shape + {:id shape-id + :name "rect" + :frame-id uuid/zero + :parent-id uuid/zero + :type :rect}) $ + (cto/apply-token-to-shape {:shape $ + :token token-radius + :attributes [:r1 :r2 :r3 :r4]}) + (cto/apply-token-to-shape {:shape $ + :token token-opacity + :attributes [:opacity]}))] + (update-file! + :file-id (:id file) + :profile-id (:id profile) + :revn 0 + :changes + (-> (pcb/empty-changes nil) + (pcb/with-page page) + (pcb/with-objects (:objects page)) + (pcb/add-object shape) + (:redo-changes)))) + + {:library library + :file file + :page-id file-page-id + :shape-id shape-id + :token-radius token-radius + :token-opacity token-opacity})) + (def ^:private svg-raw-page-id (uuid/custom 1 1)) (def ^:private svg-raw-root-id (uuid/custom 3 1)) (def ^:private svg-raw-child-id (uuid/custom 3 2)) @@ -376,6 +487,299 @@ (t/is (= "icons-library" (:slug ext-lib))) (t/is (= [(:id file)] (:used-by ext-lib)))))))) +(defn- zip-entry-names + [path] + (with-open [zin (ZipFile. (fs/file path))] + (into #{} (map #(.getName ^ZipEntry %)) (iterator-seq (.entries zin))))) + +(t/deftest export-detach-libraries-removes-tokens-library-although-keeps-applied-tokens + (let [profile (th/create-profile* 1) + {:keys [library file page-id shape-id token-radius token-opacity]} + (prepare-file-with-tokens-lib profile)] + + ;; Precondition: before the export, the file really depends on the + ;; tokens of the library + (let [file-data (:data (bfc/get-file th/*system* (:id file)))] + (t/is (= (:id library) (cfo/get-tokens-source file-data))) + (t/is (some? (cfo/get-tokens-status file-data))) + (t/is (nil? (cfo/get-tokens-lib file-data)))) + + ;; Do the export, with type :detach-libraries + (let [output (tmp/tempfile :suffix ".zip")] + (v3/export-files! + (-> th/*system* + (assoc ::bfc/ids #{(:id file)}) + (assoc ::bfc/export-type :detach-libraries)) + (io/output-stream output)) + + ;; Only the file is exported, not the library + (let [manifest (v3/get-manifest th/*system* output) + names (zip-entry-names output)] + (t/is (= [(:id file)] (mapv :id (:files manifest)))) + (t/is (empty? (:relations manifest))) + (t/is (empty? (:external-libraries manifest))) + (t/is (contains? names (str "files/" (:id file) ".json"))) + (t/is (not-any? #(str/includes? % (str (:id library))) names))) + + ;; The exported file has neither tokens library nor tokens status + (let [names (zip-entry-names output)] + (t/is (not (contains? names (str "files/" (:id file) "/tokens.json")))) + (t/is (not (contains? names (str "files/" (:id file) "/tokens-status.json"))))) + + ;; Import the file again + (let [result (-> th/*system* + (assoc ::bfc/project-id (:default-project-id profile)) + (assoc ::bfc/team-id (:default-team-id profile)) + (assoc ::bfc/profile-id (:id profile)) + (assoc ::bfc/input output) + (v3/import-files!)) + imported (bfc/get-file th/*system* (first (:file-ids result))) + file-data (:data imported) + shape (get-in file-data [:pages-index page-id :objects shape-id])] + + (t/is (= 1 (count (:file-ids result)))) + + ;; ...so the imported file has no tokens source, status or library + (t/is (nil? (cfo/get-tokens-source file-data))) + (t/is (nil? (cfo/get-tokens-status file-data))) + (t/is (nil? (cfo/get-tokens-lib file-data))) + + ;; The shape keeps the applied tokens + (t/is (some? shape)) + (t/is (cfo/token-applied? token-radius shape [:r1 :r2 :r3 :r4])) + (t/is (cfo/token-applied? token-opacity shape [:opacity])))))) + +(t/deftest export-merge-libraries-embeds-tokens-library-and-keeps-applied-tokens + (let [profile (th/create-profile* 1) + {:keys [library file page-id shape-id token-radius token-opacity]} + (prepare-file-with-tokens-lib profile)] + + ;; Precondition: before the export, the file depends on the tokens + ;; of the library and has no tokens library of its own + (let [file-data (:data (bfc/get-file th/*system* (:id file)))] + (t/is (= (:id library) (cfo/get-tokens-source file-data))) + (t/is (nil? (cfo/get-tokens-lib file-data)))) + + (let [library-tokens-lib (-> (bfc/get-file th/*system* (:id library)) + (:data) + (cfo/get-tokens-lib)) + output (tmp/tempfile :suffix ".zip")] + + (t/is (some? library-tokens-lib)) + + (v3/export-files! + (-> th/*system* + (assoc ::bfc/ids #{(:id file)}) + (assoc ::bfc/export-type :merge-libraries)) + (io/output-stream output)) + + ;; Only the file is exported, not the library + (let [manifest (v3/get-manifest th/*system* output) + names (zip-entry-names output)] + (t/is (= [(:id file)] (mapv :id (:files manifest)))) + (t/is (empty? (:relations manifest))) + (t/is (empty? (:external-libraries manifest))) + (t/is (contains? names (str "files/" (:id file) ".json"))) + (t/is (not-any? #(str/includes? % (str (:id library))) names))) + + ;; The exported file carries its own tokens library + (t/is (contains? (zip-entry-names output) + (str "files/" (:id file) "/tokens.json"))) + + (let [result (-> th/*system* + (assoc ::bfc/project-id (:default-project-id profile)) + (assoc ::bfc/team-id (:default-team-id profile)) + (assoc ::bfc/profile-id (:id profile)) + (assoc ::bfc/input output) + (v3/import-files!)) + imported (bfc/get-file th/*system* (first (:file-ids result))) + file-data (:data imported) + shape (get-in file-data [:pages-index page-id :objects shape-id])] + + (t/is (= 1 (count (:file-ids result)))) + + ;; The tokens library of the library file is now in the file... + ;; (the import gives new ids to the sets and tokens, so compare + ;; their content) + (t/is (some? (cfo/get-tokens-lib file-data))) + (t/is (= (ctob/export-dtcg-json library-tokens-lib) + (ctob/export-dtcg-json (cfo/get-tokens-lib file-data)))) + + ;; ...so the file is its own tokens source + (t/is (nil? (cfo/get-tokens-source file-data))) + + ;; Activation follows the consuming file, using the imported ids. + (t/is (= {:active-themes #{"/test-theme"} + :active-sets #{"test-token-set"}} + (cfo/ids->names (cfo/get-tokens-status file-data) + (cfo/get-tokens-lib file-data)))) + (t/is (= #{"token-radius" "token-opacity"} + (set (keys (cfo/get-tokens-in-active-sets + (cfo/get-tokens-status file-data) + (cfo/get-tokens-lib file-data)))))) + + ;; The shape keeps the applied tokens + (t/is (some? shape)) + (t/is (cfo/token-applied? token-radius shape [:r1 :r2 :r3 :r4])) + (t/is (cfo/token-applied? token-opacity shape [:opacity])))))) + +(t/deftest export-detach-libraries-preserves-own-tokens-and-status + (let [profile (th/create-profile* 1) + {:keys [library file page-id shape-id token-radius token-opacity]} + (prepare-file-with-tokens-lib profile) + file-data (:data (bfc/get-file th/*system* (:id file))) + library-data (:data (bfc/get-file th/*system* (:id library))) + tokens-lib (cfo/get-tokens-lib library-data) + output (tmp/tempfile :suffix ".zip")] + + ;; Keep the linked library, but use the file's own tokens. + (update-file! + :file-id (:id file) + :profile-id (:id profile) + :changes + (-> (pcb/empty-changes nil) + (pcb/with-library-data file-data) + (pcb/set-tokens-source nil) + (pcb/set-tokens-lib tokens-lib) + (:redo-changes))) + + (v3/export-files! + (assoc th/*system* + ::bfc/ids #{(:id file)} + ::bfc/export-type :detach-libraries) + (io/output-stream output)) + + (let [names (zip-entry-names output)] + (t/is (contains? names (str "files/" (:id file) "/tokens.json"))) + (t/is (contains? names (str "files/" (:id file) "/tokens-status.json")))) + + (let [result (v3/import-files! + (assoc th/*system* + ::bfc/project-id (:default-project-id profile) + ::bfc/team-id (:default-team-id profile) + ::bfc/profile-id (:id profile) + ::bfc/input output)) + imported (bfc/get-file th/*system* (first (:file-ids result))) + file-data (:data imported) + shape (get-in file-data [:pages-index page-id :objects shape-id])] + (t/is (nil? (cfo/get-tokens-source file-data))) + (t/is (= (ctob/export-dtcg-json tokens-lib) + (ctob/export-dtcg-json (cfo/get-tokens-lib file-data)))) + (t/is (some? (cfo/get-tokens-status file-data))) + (when-let [status (cfo/get-tokens-status file-data)] + (t/is (= {:active-themes #{"/test-theme"} + :active-sets #{"test-token-set"}} + (cfo/ids->names status (cfo/get-tokens-lib file-data))))) + (t/is (cfo/token-applied? token-radius shape [:r1 :r2 :r3 :r4])) + (t/is (cfo/token-applied? token-opacity shape [:opacity]))))) + +(defn- import-output + "Import the exported output in the default project of the profile and + return the imported files, indexed by name." + [profile output] + (let [result (v3/import-files! + (assoc th/*system* + ::bfc/project-id (:default-project-id profile) + ::bfc/team-id (:default-team-id profile) + ::bfc/profile-id (:id profile) + ::bfc/input output))] + (into {} + (map (fn [id] + (let [file (bfc/get-file th/*system* id)] + [(:name file) file]))) + (:file-ids result)))) + +(t/deftest export-include-libraries-keeps-tokens-status-of-the-file + (let [profile (th/create-profile* 1) + {:keys [library file]} (prepare-file-with-tokens-lib profile) + output (tmp/tempfile :suffix ".zip")] + + (v3/export-files! + (assoc th/*system* + ::bfc/ids #{(:id file)} + ::bfc/export-type :include-libraries) + (io/output-stream output)) + + (let [files (import-output profile output) + library' (get files (:name library)) + file' (get files (:name file)) + file-data (:data file') + library-lib (cfo/get-tokens-lib (:data library')) + file-status (cfo/get-tokens-status file-data)] + + (t/is (= 2 (count files))) + (t/is (= (:id library') (cfo/get-tokens-source file-data))) + + ;; The active sets of the file are resolved against the sets of the + ;; imported library, so they are not lost. + (t/is (= {:active-themes #{"/test-theme"} + :active-sets #{"test-token-set"}} + (cfo/ids->names file-status library-lib))) + (t/is (= #{"token-radius" "token-opacity"} + (set (keys (cfo/get-tokens-in-active-sets file-status library-lib)))))))) + +(t/deftest export-file-with-deleted-tokens-library-embeds-its-tokens + (let [profile (th/create-profile* 1) + {:keys [library file]} (prepare-file-with-tokens-lib profile) + tokens-lib (-> (bfc/get-file th/*system* (:id library)) + (:data) + (cfo/get-tokens-lib)) + output (tmp/tempfile :suffix ".zip")] + + ;; The state left by deleting the library: in the trash and unlinked, + ;; but still the tokens source of the file. + (th/db-update! :file {:deleted-at (ct/in-future {:days 7})} {:id (:id library)}) + (th/db-delete! :file-library-rel {:library-file-id (:id library)}) + + (v3/export-files! + (assoc th/*system* + ::bfc/ids #{(:id file)} + ::bfc/export-type :include-libraries) + (io/output-stream output)) + + (t/is (contains? (zip-entry-names output) + (str "files/" (:id file) "/tokens.json"))) + + (let [files (import-output profile output) + file-data (:data (get files (:name file)))] + (t/is (= 1 (count files))) + (t/is (nil? (cfo/get-tokens-source file-data))) + (t/is (= (ctob/export-dtcg-json tokens-lib) + (ctob/export-dtcg-json (cfo/get-tokens-lib file-data)))) + (t/is (= {:active-themes #{"/test-theme"} + :active-sets #{"test-token-set"}} + (cfo/ids->names (cfo/get-tokens-status file-data) + (cfo/get-tokens-lib file-data))))))) + +(t/deftest export-file-with-missing-tokens-library-removes-tokens-source + (let [profile (th/create-profile* 1) + {:keys [library file]} (prepare-file-with-tokens-lib profile) + output (tmp/tempfile :suffix ".zip")] + + ;; The tokens source points to a library that does not exist anymore + (th/db-delete! :file-library-rel {:library-file-id (:id library)}) + (update-file! + :file-id (:id file) + :profile-id (:id profile) + :changes + (-> (pcb/empty-changes nil) + (pcb/with-library-data (:data (bfc/get-file th/*system* (:id file)))) + (pcb/set-tokens-source (uuid/next)) + (:redo-changes))) + + (v3/export-files! + (assoc th/*system* + ::bfc/ids #{(:id file)} + ::bfc/export-type :include-libraries) + (io/output-stream output)) + + (let [files (import-output profile output) + file-data (:data (get files (:name file)))] + (t/is (= 1 (count files))) + (t/is (nil? (cfo/get-tokens-source file-data))) + (t/is (nil? (cfo/get-tokens-status file-data))) + (t/is (nil? (cfo/get-tokens-lib file-data)))))) + (t/deftest import-auto-links-single-candidate (let [profile (th/create-profile* 1) ;; Create a shared library file diff --git a/backend/test/backend_tests/rpc_file_test.clj b/backend/test/backend_tests/rpc_file_test.clj index aadd976c2d..1bb3a0a09e 100644 --- a/backend/test/backend_tests/rpc_file_test.clj +++ b/backend/test/backend_tests/rpc_file_test.clj @@ -6,11 +6,16 @@ (ns backend-tests.rpc-file-test (:require + [app.binfile.common :as bfc] [app.common.features :as cfeat] + [app.common.files.changes-builder :as pcb] + [app.common.files.tokens :as cfo] [app.common.pprint :as pp] [app.common.thumbnails :as thc] [app.common.time :as ct] [app.common.types.shape :as cts] + [app.common.types.tokens-lib :as ctob] + [app.common.types.tokens-status :as ctos] [app.common.uuid :as uuid] [app.config :as cf] [app.db :as db] @@ -2169,6 +2174,93 @@ (get-in out [:result :data :pages-index f-page :objects inst-id :component-file]))))))))) +(defn- prepare-tokens-library + "A shared library with a tokens lib, a file linked to it that uses it + as its tokens source, and another linked file that does not." + [profile] + (let [set-id (uuid/next) + theme-id (uuid/next) + tokens-lib (-> (ctob/make-tokens-lib) + (ctob/add-set (ctob/make-token-set :id set-id :name "test-set")) + (ctob/add-theme (ctob/make-token-theme :id theme-id + :name "test-theme" + :sets #{"test-set"})) + (ctob/add-token set-id (ctob/make-token :name "token-radius" + :type :border-radius + :value 10))) + params {:profile-id (:id profile) + :project-id (:default-project-id profile)} + library (th/create-file* 1 (assoc params :is-shared true)) + file (th/create-file* 2 params) + other (th/create-file* 3 params)] + + (th/link-file-to-library* {:file-id (:id file) :library-id (:id library)}) + (th/link-file-to-library* {:file-id (:id other) :library-id (:id library)}) + + (update-file! + :file-id (:id library) + :profile-id (:id profile) + :changes + (-> (pcb/empty-changes nil) + (pcb/with-library-data (:data library)) + (pcb/set-tokens-lib tokens-lib) + (:redo-changes))) + + (update-file! + :file-id (:id file) + :profile-id (:id profile) + :changes + (-> (pcb/empty-changes nil) + (pcb/with-library-data (:data file)) + (pcb/set-tokens-source (:id library)) + (pcb/set-tokens-status (ctos/make-tokens-status :active-theme-ids #{theme-id} + :active-set-ids #{set-id})) + (:redo-changes))) + + {:library library :file file :other other :tokens-lib tokens-lib})) + +(defn- check-tokens-absorbed + "The file is its own tokens source, with a copy of the tokens lib, and + keeps its tokens status; the other file is not changed." + [{:keys [file other tokens-lib]}] + (let [file-data (:data (bfc/get-file th/*system* (:id file))) + other-data (:data (bfc/get-file th/*system* (:id other)))] + (t/is (nil? (cfo/get-tokens-source file-data))) + (t/is (= (ctob/export-dtcg-json tokens-lib) + (ctob/export-dtcg-json (cfo/get-tokens-lib file-data)))) + (t/is (= {:active-themes #{"/test-theme"} + :active-sets #{"test-set"}} + (cfo/ids->names (cfo/get-tokens-status file-data) + (cfo/get-tokens-lib file-data)))) + (t/is (nil? (cfo/get-tokens-lib other-data))))) + +(t/deftest delete-shared-library-absorbs-its-tokens-lib + (let [profile (th/create-profile* 1) + {:keys [library file] :as prepared} (prepare-tokens-library profile) + out (th/command! {::th/type :delete-file + ::rpc/profile-id (:id profile) + :id (:id library)})] + (t/is (nil? (:error out))) + + ;; The relations are removed at once, the absorption is done by the + ;; deletion task. + (t/is (empty? (th/db-query :file-library-rel {:library-file-id (:id library)}))) + (t/is (= (:id library) + (cfo/get-tokens-source (:data (bfc/get-file th/*system* (:id file)))))) + + (th/run-pending-tasks!) + (check-tokens-absorbed prepared))) + +(t/deftest unpublish-shared-library-absorbs-its-tokens-lib + (let [profile (th/create-profile* 1) + {:keys [library] :as prepared} (prepare-tokens-library profile) + out (th/command! {::th/type :set-file-shared + ::rpc/profile-id (:id profile) + :id (:id library) + :is-shared false})] + (t/is (nil? (:error out))) + (check-tokens-absorbed prepared))) + (t/deftest deleted-files-permanently-delete (let [prof (th/create-profile* 1 {:is-active true}) team-id (:default-team-id prof) diff --git a/common/src/app/common/files/tokens.cljc b/common/src/app/common/files/tokens.cljc index 34c5b760d6..e78adf2c47 100644 --- a/common/src/app/common/files/tokens.cljc +++ b/common/src/app/common/files/tokens.cljc @@ -547,6 +547,32 @@ [file-data f & args] (d/update-when file-data :tokens-status #(apply f % args))) +(defn absorb-tokens-lib + "Copy the tokens-lib of the library into the file, replacing the + previous one if any, and unset the tokens-source, so the file becomes + its own tokens source. + + The tokens-status of the file is preserved. If the file has none, the + one of the library is copied along with the tokens-lib. + + If the library has no tokens-lib, only the tokens-source is unset, and + the file keeps its own tokens-lib and tokens-status. If there is no + library-data, there is nothing to absorb and the file is returned + unchanged." + [file-data library-data] + (if (nil? library-data) + file-data + (let [tokens-lib (get-tokens-lib library-data)] + (if (nil? tokens-lib) + (set-tokens-source file-data nil) + (let [tokens-status (or (get-tokens-status file-data) + (get-tokens-status library-data))] + (cond-> (-> file-data + (set-tokens-source nil) + (assoc :tokens-lib tokens-lib)) + (some? tokens-status) + (assoc :tokens-status tokens-status))))))) + ;; Tokens status with tokens lib (defn- calculate-active-sets diff --git a/common/src/app/common/types/file.cljc b/common/src/app/common/types/file.cljc index c4ab29e3da..3a52dd79ca 100644 --- a/common/src/app/common/types/file.cljc +++ b/common/src/app/common/types/file.cljc @@ -11,6 +11,7 @@ [app.common.features :as cfeat] [app.common.files.defaults :refer [version]] [app.common.files.helpers :as cfh] + [app.common.files.tokens :as cfo] [app.common.geom.point :as gpt] [app.common.geom.shapes :as gsh] [app.common.geom.shapes.tree-seq :as gsts] @@ -1238,7 +1239,9 @@ (fn [pages-index] (d/update-vals pages-index #(update % :objects detach-objects)))] - (update-in file [:data :pages-index] detach-pages))) + (cond-> (update-in file [:data :pages-index] detach-pages) + (not (cfo/effective-tokens-source? (:data file) file-id)) + (update :data dissoc :tokens-source :tokens-status)))) ;; Base font size diff --git a/common/test/common_tests/files/tokens_test.cljc b/common/test/common_tests/files/tokens_test.cljc index 76da45bd4e..8d6a28b393 100644 --- a/common/test/common_tests/files/tokens_test.cljc +++ b/common/test/common_tests/files/tokens_test.cljc @@ -1494,3 +1494,218 @@ ;; set-theme-active false removes non-existent id (let [status' (cfo/set-theme-active all-invalid tokens-lib invalid-theme-id false)] (t/is (not (ctos/theme-active? status' invalid-theme-id)))))))) + +;; absorb-tokens-lib + +(defn- make-sample-tokens-lib + "A tokens-lib with a set (and a token in it) for each label. Each set + is named as its label, and its id is registered in thi under it." + [& set-labels] + (reduce (fn [tokens-lib set-label] + (let [set-id (thi/new-id! set-label)] + (-> tokens-lib + (ctob/add-set (ctob/make-token-set :id set-id + :name (name set-label))) + (ctob/add-token set-id (ctob/make-token :name (str (name set-label) "-token") + :type :border-radius + :value 10))))) + (ctob/make-tokens-lib) + set-labels)) + +(defn- make-sample-tokens-status + "A tokens-status with the sets of the given labels active. The sets + must have been created before by make-sample-tokens-lib." + [& set-labels] + (ctos/make-tokens-status :active-set-ids (into #{} (map thi/id) set-labels))) + +(defn- make-sample-data + "File data with the given tokens-lib, tokens-status and tokens-source. + Those not given are left unset." + [label & {:keys [tokens-lib tokens-status tokens-source]}] + (-> (ctf/file-data (thf/sample-file label)) + (cfo/ensure-tokens-lib) + (cfo/update-tokens-lib (constantly tokens-lib)) + (cfo/update-tokens-status (constantly tokens-status)) + (cfo/set-tokens-source tokens-source))) + +(t/deftest test-absorb-tokens-lib + (t/testing "copies the tokens-lib of the library and unsets the tokens-source" + (let [library-data (make-sample-data :library + :tokens-lib (make-sample-tokens-lib :lib-set)) + file-data (make-sample-data :file1 + :tokens-source (:id library-data)) + file-data' (cfo/absorb-tokens-lib file-data library-data)] + (t/is (= (cfo/get-tokens-lib library-data) (cfo/get-tokens-lib file-data'))) + (t/is (nil? (cfo/get-tokens-source file-data'))) + (t/is (true? (cfo/effective-tokens-source? file-data' (:id file-data')))) + (t/is (true? (cfo/editable-tokens? file-data'))))) + + (t/testing "replaces the own tokens-lib of the file" + (let [library-data (make-sample-data :library + :tokens-lib (make-sample-tokens-lib :lib-set)) + file-data (make-sample-data :file1 + :tokens-lib (make-sample-tokens-lib :own-set) + :tokens-source (:id library-data)) + file-data' (cfo/absorb-tokens-lib file-data library-data)] + (t/is (= (cfo/get-tokens-lib library-data) (cfo/get-tokens-lib file-data'))) + (t/is (nil? (cfo/get-tokens-source file-data'))))) + + (t/testing "copies an empty tokens-lib of the library" + (let [empty-lib (ctob/make-tokens-lib) + library-data (make-sample-data :library :tokens-lib empty-lib) + file-data (make-sample-data :file1 + :tokens-lib (make-sample-tokens-lib :own-set) + :tokens-source (:id library-data)) + file-data' (cfo/absorb-tokens-lib file-data library-data)] + (t/is (= empty-lib (cfo/get-tokens-lib file-data'))) + (t/is (nil? (cfo/get-tokens-source file-data'))))) + + (t/testing "unsets the tokens-source even if the file had no tokens-source" + (let [library-data (make-sample-data :library + :tokens-lib (make-sample-tokens-lib :lib-set)) + file-data (make-sample-data :file1) + file-data' (cfo/absorb-tokens-lib file-data library-data)] + (t/is (= (cfo/get-tokens-lib library-data) (cfo/get-tokens-lib file-data'))) + (t/is (nil? (cfo/get-tokens-source file-data'))))) + + (t/testing "does not change anything else in the file" + (let [library-data (make-sample-data :library + :tokens-lib (make-sample-tokens-lib :lib-set)) + file-data (make-sample-data :file1 + :tokens-source (:id library-data)) + file-data' (cfo/absorb-tokens-lib file-data library-data)] + (t/is (= (dissoc file-data :tokens-lib :tokens-status :tokens-source) + (dissoc file-data' :tokens-lib :tokens-status :tokens-source)))))) + +(t/deftest test-absorb-tokens-lib-status + (t/testing "preserves the tokens-status of the file" + (let [library-lib (make-sample-tokens-lib :lib-set :other-set) + file-status (make-sample-tokens-status :lib-set) + library-status (make-sample-tokens-status :other-set) + library-data (make-sample-data :library + :tokens-lib library-lib + :tokens-status library-status) + file-data (make-sample-data :file1 + :tokens-status file-status + :tokens-source (:id library-data)) + file-data' (cfo/absorb-tokens-lib file-data library-data)] + (t/is (= file-status (cfo/get-tokens-status file-data'))) + (t/is (not= library-status (cfo/get-tokens-status file-data'))))) + + (t/testing "preserves an empty tokens-status of the file" + (let [library-lib (make-sample-tokens-lib :lib-set) + file-status (ctos/make-tokens-status) + library-status (make-sample-tokens-status :lib-set) + library-data (make-sample-data :library + :tokens-lib library-lib + :tokens-status library-status) + file-data (make-sample-data :file1 + :tokens-status file-status + :tokens-source (:id library-data)) + file-data' (cfo/absorb-tokens-lib file-data library-data)] + (t/is (= file-status (cfo/get-tokens-status file-data'))))) + + (t/testing "copies the tokens-status of the library if the file has none" + (let [library-lib (make-sample-tokens-lib :lib-set) + library-status (make-sample-tokens-status :lib-set) + library-data (make-sample-data :library + :tokens-lib library-lib + :tokens-status library-status) + file-data (make-sample-data :file1 + :tokens-source (:id library-data)) + file-data' (cfo/absorb-tokens-lib file-data library-data)] + (t/is (= library-status (cfo/get-tokens-status file-data'))) + (t/is (= #{(thi/id :lib-set)} + (ctos/get-active-set-ids (cfo/get-tokens-status file-data')))) + (t/is (some? (ctob/get-set (cfo/get-tokens-lib file-data') (thi/id :lib-set)))))) + + (t/testing "leaves the tokens-status unset if neither the file nor the library have one" + (let [library-data (make-sample-data :library + :tokens-lib (make-sample-tokens-lib :lib-set)) + file-data (make-sample-data :file1 + :tokens-source (:id library-data)) + file-data' (cfo/absorb-tokens-lib file-data library-data)] + (t/is (nil? (cfo/get-tokens-status file-data')))))) + +(t/deftest test-absorb-tokens-lib-library-without-tokens + (t/testing "library without tokens-lib: keeps the tokens-lib and tokens-status of the file, and unsets the tokens-source" + (let [file-lib (make-sample-tokens-lib :own-set) + file-status (make-sample-tokens-status :own-set) + library-status (ctos/make-tokens-status :active-set-ids #{(uuid/next)}) + library-data (make-sample-data :library + :tokens-status library-status) + file-data (make-sample-data :file1 + :tokens-lib file-lib + :tokens-status file-status + :tokens-source (:id library-data)) + file-data' (cfo/absorb-tokens-lib file-data library-data)] + (t/is (= file-lib (cfo/get-tokens-lib file-data'))) + (t/is (= file-status (cfo/get-tokens-status file-data'))) + (t/is (nil? (cfo/get-tokens-source file-data'))))) + + (t/testing "library without tokens-lib: does not copy the tokens-status of the library" + (let [library-status (ctos/make-tokens-status :active-set-ids #{(uuid/next)}) + library-data (make-sample-data :library + :tokens-status library-status) + file-data (make-sample-data :file1 + :tokens-source (:id library-data)) + file-data' (cfo/absorb-tokens-lib file-data library-data)] + (t/is (nil? (cfo/get-tokens-lib file-data'))) + (t/is (nil? (cfo/get-tokens-status file-data'))) + (t/is (nil? (cfo/get-tokens-source file-data'))))) + + (t/testing "library without any tokens attribute" + (let [library-data (ctf/file-data (thf/sample-file :library)) + file-lib (make-sample-tokens-lib :own-set) + file-data (make-sample-data :file1 + :tokens-lib file-lib + :tokens-source (:id library-data)) + file-data' (cfo/absorb-tokens-lib file-data library-data)] + (t/is (= file-lib (cfo/get-tokens-lib file-data'))) + (t/is (nil? (cfo/get-tokens-source file-data'))))) + + (t/testing "neither the file nor the library have tokens" + (let [library-data (ctf/file-data (thf/sample-file :library)) + file-data (ctf/file-data (thf/sample-file :file1)) + file-data' (cfo/absorb-tokens-lib file-data library-data)] + (t/is (nil? (cfo/get-tokens-lib file-data'))) + (t/is (nil? (cfo/get-tokens-status file-data'))) + (t/is (nil? (cfo/get-tokens-source file-data')))))) + +(t/deftest test-absorb-tokens-lib-no-library-data + (t/testing "nil library-data: the file is returned unchanged" + (let [file-lib (make-sample-tokens-lib :own-set) + file-data (make-sample-data :file1 + :tokens-lib file-lib + :tokens-status (make-sample-tokens-status :own-set) + :tokens-source (uuid/next))] + (t/is (identical? file-data (cfo/absorb-tokens-lib file-data nil))))) + + (t/testing "nil library-data and a file without tokens" + (let [file-data (ctf/file-data (thf/sample-file :file1))] + (t/is (identical? file-data (cfo/absorb-tokens-lib file-data nil)))))) + +(t/deftest test-detach-external-references-preserves-own-tokens + (let [file (thf/sample-file :file1) + lib (make-sample-tokens-lib :own-set) + status (make-sample-tokens-status :own-set) + file (-> file + (assoc-in [:data :tokens-lib] lib) + (assoc-in [:data :tokens-status] status))] + (doseq [source [nil (:id file)]] + (t/testing (str "local tokens source " source) + (let [file (cond-> file + source (assoc-in [:data :tokens-source] source)) + detached (ctf/detach-external-references file (:id file))] + (t/is (= source (cfo/get-tokens-source (:data detached)))) + (t/is (identical? lib (cfo/get-tokens-lib (:data detached)))) + (t/is (= status (cfo/get-tokens-status (:data detached))))))))) + +(t/deftest test-detach-external-references-removes-external-tokens-status + (let [file (-> (thf/sample-file :file1) + (assoc-in [:data :tokens-source] (uuid/next)) + (assoc-in [:data :tokens-status] (ctos/make-tokens-status))) + detached (ctf/detach-external-references file (:id file))] + (t/is (not (contains? (:data detached) :tokens-source))) + (t/is (not (contains? (:data detached) :tokens-status))) + (t/is (= detached (ctf/check-file detached))))) diff --git a/frontend/src/app/main/ui/exports/files.cljs b/frontend/src/app/main/ui/exports/files.cljs index 92a458e772..27d91275c0 100644 --- a/frontend/src/app/main/ui/exports/files.cljs +++ b/frontend/src/app/main/ui/exports/files.cljs @@ -123,7 +123,6 @@ (let [type (-> (dom/get-target event) (dom/get-data "type") (keyword))] - (prn "AAA" selected type) (swap! state* assoc :selected type))))] (mf/with-effect [has-libs?] From 556d604e67b85b753740a066a63a8601d2d968de Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Elena=20Torr=C3=B3?= Date: Thu, 15 Oct 2026 17:09:01 +0200 Subject: [PATCH 12/16] :bug: Refresh clip content button state after toggling it (#12353) --- .../main/ui/workspace/sidebar/options/menus/measures.cljs | 2 ++ .../test/frontend_tests/ui/measures_menu_props_test.cljs | 7 ++++++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/frontend/src/app/main/ui/workspace/sidebar/options/menus/measures.cljs b/frontend/src/app/main/ui/workspace/sidebar/options/menus/measures.cljs index b398f099fc..3f56fbbc23 100644 --- a/frontend/src/app/main/ui/workspace/sidebar/options/menus/measures.cljs +++ b/frontend/src/app/main/ui/workspace/sidebar/options/menus/measures.cljs @@ -154,6 +154,8 @@ (get n-values :rotation)) (identical? (get o-values :hide-in-viewer) (get n-values :hide-in-viewer)) + (identical? (get o-values :show-content) + (get n-values :show-content)) (identical? (get o-values :width) (get n-values :width)) (identical? (get o-values :height) diff --git a/frontend/test/frontend_tests/ui/measures_menu_props_test.cljs b/frontend/test/frontend_tests/ui/measures_menu_props_test.cljs index 0f509d3a08..790b749aef 100644 --- a/frontend/test/frontend_tests/ui/measures_menu_props_test.cljs +++ b/frontend/test/frontend_tests/ui/measures_menu_props_test.cljs @@ -55,4 +55,9 @@ ;; force a re-render so the X/Y inputs enabled/disabled state updates. (t/is (false? (check-measures-menu-props (props (assoc base-values :layout-item-absolute false)) - (props (assoc base-values :layout-item-absolute true))))))) + (props (assoc base-values :layout-item-absolute true)))))) + + (t/testing "re-renders when clip content changes but nothing else does" + (t/is (false? (check-measures-menu-props + (props (assoc base-values :show-content false)) + (props (assoc base-values :show-content true))))))) From 414553278ae36b4e213cbd56a56e4e09a5f441eb Mon Sep 17 00:00:00 2001 From: Andrey Antukh Date: Thu, 15 Oct 2026 19:50:06 +0200 Subject: [PATCH 13/16] :sparkles: Count the application logs as a metric, by logger and level (#12313) * :sparkles: Count the application logs as a metric, by logger and level The error panels had no metric to read: they counted log lines in Loki, because the backend published nothing about the errors of the application (the only thing alive in Prometheus was the http listener error count, which measures another thing). Now there is `penpot_log_events_total{logger, level}`. The counter comes from a new component, `app.loggers.metrics/reporter`, which hooks a watch on the log record like the database and mattermost reporters do, but without a thread or a channel: the increment is in memory, so it runs in the watcher itself. Only `warn`, `error` and `fatal` are counted, and only the records that go through `app.common.logging`: the lines a library writes straight to log4j2 are not counted (one in a thousand today). The body of the watcher is wrapped in a `try/catch` that swallows the error on purpose: the watcher fires from the `swap!` of the log record, inside the logging path, so an exception there would reach whoever was logging and would take the logging executor down with it. A test pins that a failing publication does not propagate. The suite removes the reporter (it would count the logs of the tests and the recording of their `mtx/run!`), so a test of its own pins the wiring. The memories carry the counter, its two limits and why the `try/catch` is not noise; the grafana one also brings the notes of this afternoon about the service account, the dashboard search and Cloudflare, which were waiting for a commit. AI-assisted-by: deepseek-v4.1-flash * :books: Address the review findings on the log-events metric The review of the counter found that the reason written for the `try/catch` was not the real one, so the memory and the comments say now what happens if it is removed: with `::l/sync?` the exception reaches whoever was logging, and on the async path it dies in the uncaught handler of the logging executor -- outside the application's logging -- where the pool replaces the worker, so logging continues and that line is lost. They also say that a publication failing every time is silent: the counter stays flat and nothing is written about it. The rest are small things the review asked for: the test of the `fatal` level (it was in the counted set and nothing verified it), the HELP of the metric naming the three levels, the require of the test without the unused alias that clj-kondo flagged, and the note that the `level` is lowercase here and uppercase in Loki. The grafana memory loses what was said twice: the two pairs of bullets about reading the API (the service account 403s and the search that lies) are merged, the CLIMIT notes are one bullet instead of two, and the four bullets about editing dashboards are grouped in their own section. Its host name is gone as well, which the first line of that file forbids. AI-assisted-by: deepseek-v4.1-flash --- .serena/memories/backend/subtleties.md | 4 + .serena/memories/prod-infra/grafana.md | 24 +++- backend/src/app/loggers/metrics.clj | 46 ++++++ backend/src/app/main.clj | 11 +- backend/test/backend_tests/helpers.clj | 1 + .../backend_tests/loggers_metrics_test.clj | 135 ++++++++++++++++++ 6 files changed, 213 insertions(+), 8 deletions(-) create mode 100644 backend/src/app/loggers/metrics.clj create mode 100644 backend/test/backend_tests/loggers_metrics_test.clj diff --git a/.serena/memories/backend/subtleties.md b/.serena/memories/backend/subtleties.md index 241d1e1567..ed7f390af6 100644 --- a/.serena/memories/backend/subtleties.md +++ b/.serena/memories/backend/subtleties.md @@ -57,6 +57,10 @@ - The xnio worker MXBean can return transient `-1` (e.g. on the queue or the pool size); negative samples are discarded (gauge keeps its previous value). Undertow exposes absolute request/error totals, so the sampler keeps a watermark atom and publishes deltas; a counter reset (decreasing totals) skips the negative delta and moves the watermark forward. - The `process_*` families (`process_open_fds`, `process_max_fds`, `process_cpu_seconds_total`, …) come from the prometheus client `StandardExports`, registered by `app.metrics/create-registry`. They read the OS MXBean reflectively and need the `jdk.management` module: on a pruned `jlink` JRE the MXBean is `sun.management.BaseOperatingSystemImpl`, the getters throw `NoSuchMethodException` and `StandardExports#collect` swallows it, so those families silently vanish from `/metrics`. `docker/images/Dockerfile.backend` keeps `jdk.management` in the `--add-modules` list, and `backend-tests.metrics-test` pins the contract. +## Log-derived metrics + +- `app.loggers.metrics/reporter` counts the log records the application emits and publishes them as `penpot_log_events_total{logger, level}` (counter), so the error panels do not have to count text in Loki. It is a component that hooks `add-watch` on `app.common.logging/log-record`, like `app.loggers.database`, but with no thread and no channel: the increment is in memory, so it goes straight in the watcher. Only `warn`, `error` and `fatal` are counted, and only the records that go through `app.common.logging` (the application's own logs; a library writing straight to log4j2 is not counted, and today that is one line in a thousand). The body of the watcher is wrapped in a `try/catch` that swallows the error on purpose: the watcher fires from the `swap!` of the log record, inside the logging path. With `::l/sync?` (`app.binfile.v1`, `app.msgbus`) an exception there would reach whoever was logging; on the async path it escapes to the logging executor worker, whose trace goes to the thread's uncaught handler -- outside the application's logging -- and the pool replaces the dead worker, so logging continues and that line is lost. The catch also makes a publication that fails every time invisible: `penpot_log_events_total` stays flat and nothing is written about it. The published `level` values are lowercase (`warn`), unlike the `level` label of the Loki logs (`ERROR`), so a panel that moves from one source to the other has to change it. Cardinality is `logger` (fixed names taken from the code) times `level`; a logger built from a dynamic value would break that. + ## Storage and media - Storage abstraction, backend configuration, logical buckets, object lifecycle, deduplication, access rules, and garbage collection: `mem:backend/storage`. diff --git a/.serena/memories/prod-infra/grafana.md b/.serena/memories/prod-infra/grafana.md index fbc40ec6e5..10af277db2 100644 --- a/.serena/memories/prod-infra/grafana.md +++ b/.serena/memories/prod-infra/grafana.md @@ -6,15 +6,15 @@ Keep this memory free of internal names: no host names, no deployed versions, no ## Datasources -- Metrics — **Prometheus**, uid `xkRmyFBGk`. PromQL. Metric families: `penpot_*` (RPC, task timings, CLIMIT, HTTP, websocket, storage), `hikaricp_*`, `jvm_*` and `process_*` on the backend (`job="app"`); `pg_*` from the Postgres exporter (`job="postgres"`); `redis_*` from the Redis exporter (`job="redis"`); `node_*` and `container_*` from node-exporter and cAdvisor. Backend histograms are in **milliseconds**. -- Logs — **Loki**, uid `h3CGKhEMk`. LogQL, and filter by the structured metadata `logger`/`level` (`{job="penpot"} | logger="..." | level="ERROR"`). Signals that only exist as logs: the profile behind a CLIMIT queue (`logger="app.rpc.climit"`, whose `id` carries the key). CLIMIT rejections have their own counters (`penpot_rpc_climit_rejected_total`, by `name` and `reason`), and their `hint="rejected"` line goes out at WARN only when something stays queued, so counting the lines is not counting the rejections. +- Metrics — **Prometheus**, uid `xkRmyFBGk`. PromQL. Metric families: `penpot_*` (RPC, task timings, CLIMIT, HTTP, websocket, storage, and the application log events of the backend), `hikaricp_*`, `jvm_*` and `process_*` on the backend (`job="app"`); `pg_*` from the Postgres exporter (`job="postgres"`); `redis_*` from the Redis exporter (`job="redis"`); `node_*` and `container_*` from node-exporter and cAdvisor. Backend histograms are in **milliseconds**. +- Logs — **Loki**, uid `h3CGKhEMk`. LogQL, and filter by the structured metadata `logger`/`level` (`{job="penpot"} | logger="..." | level="ERROR"`). Two things to remember when counting from it: the CLIMIT rejections have their own counters (`penpot_rpc_climit_rejected_total`, by `name` and `reason`) and their `hint="rejected"` line goes out at WARN only when something is left queued behind the call (a lone caller that times out is written at TRACE), so counting lines is not counting rejections -- the same goes for `hint="enqueued"` and `hint="acquired"`; and the only signal that exists nowhere else is the profile behind a queue (`logger="app.rpc.climit"`, whose `id` carries the key), chased there on demand. - SQL — **Postgres**, uid `y8ea9tfMk`. Panels need `rawQuery: true`, `editorMode: "code"` and `format: "table"`. The `task` table is the only truth about the queue depth. It is a **read-only replica**: it rejects any write, `CREATE TEMP TABLE` included, so queries through it must be plain `SELECT`s. It also cuts long-running queries (the MCP path has a short timeout), so bound them (e.g. a list of ids); an empty answer there is not proof that there is no data. - **Postgres (telemetry)**, uid `9YAUuM_Gz`. - `$__rate_interval` and `$__interval` are substituted by Grafana; use them instead of fixed windows in graphs. ## Main dashboard -- `Production status`, uid `penpot-production-status`. Sections: general state and deploy, RPC and CLIMIT, PostgreSQL and pool, Redis/msgbus, tasks, JVM/process. Variables `$env` and `$host` (custom), no auto refresh. +- `Production status`, uid `penpot-production-status`. Sections: general state and deploy, `RPC y CLIMIT`, PostgreSQL and pool, Redis/msgbus, tasks, JVM/process. Variables `$env` and `$host` (custom), no auto refresh. Every section opens collapsed except `RPC y CLIMIT`, which is the one read on a normal day. - Per-host investigation dashboards are separate, and the alert rules deeplink into them. ## Conventions @@ -26,6 +26,20 @@ Keep this memory free of internal names: no host names, no deployed versions, no - Cron "did it run" comes from the task metrics, not from the cron registry table (it keeps rows from old versions). - Dashboard thresholds must match the alert rule thresholds. +## Editing dashboards through the API + +- Saving through the API normalizes the dashboard: submit the native form, rows with `panels: []` and their panels top-level with contiguous `y`. A row that has to start collapsed (or open) is sent holding its children in `panels` with `collapsed` set, and the top-level `y` are recomputed by hand: one unit per collapsed row, with the expanded block kept contiguous. Grafana accepts it and returns the same shape. +- A `remove` operation on a panel leaves its `gridPos` hole behind: Grafana does not refill the layout (the UI behaves the same), so a neighbouring panel has to be moved by hand when the gap matters. +- Check `list_dashboard_versions` before writing and prefer `operations` patches: the user edits dashboards by hand and a full-JSON overwrite silently reverts that work. + +## Reading the API by hand + +- The MCP authenticates with a service account token (`GRAFANA_SERVICE_ACCOUNT_TOKEN`, set in the environment of the MCP server), and a service account has no user behind it: a 403 is never the token being bad. On `/api/user` and `/api/user/orgs` it is normal; on a single dashboard (`Access denied to this dashboard`, which is not a 404) it means that identity cannot see it, a permission on that dashboard or its folder. Restarting the MCP or rotating the token changes nothing, and `X-Grafana-Org-Id` does not help when the identity belongs to another organization. +- Listing is reliable, filtering is not: a dashboard search with a text query answers empty in this instance (through the tool and through `/api/search?query=...` alike), and `list_prometheus_metric_names` also lists names that survive only in the retained series of a metric that stopped being published. Use the listing without a query, and `count()` to tell whether a metric is alive today. +- The MCP Prometheus tool can answer empty for every query, `up` included, while the datasource itself is fine: run PromQL by hand with `grafana_api_request` against `/api/datasources/uid//resources/api/v1/query?query=...`. +- `curl` and `python` from the shell cannot reach the Grafana host of the deployment: Cloudflare blocks them (`error code: 1010`, which looks like a 403 and has nothing to do with Grafana). Probe the API through the MCP (`grafana_api_request`), which is what the deployment lets through. +- A Loki query by hand goes through `GET /api/datasources/proxy/uid//loki/api/v1/query_range?query=&start=&end=&step=` (the range comes back as `resultType: matrix`, one series per group). For Loki the `/api/datasources/uid//resources/...` route answers 500, and `/api/ds/query` is not reachable from `grafana_api_request` at all (404), even though that is the path the dashboards use. + ## Gotchas - PromQL literal dots need `\\.`; simpler to use `[.]` or a plain dot. @@ -34,9 +48,5 @@ Keep this memory free of internal names: no host names, no deployed versions, no - Prometheus: `label_replace(, "host", "$1", "instance", "([^.]+)[.][^.]+.*")` plus `legendFormat: "... {{host}}"`. - Loki metric query: `| label_format host="{{ regexReplaceAll "[.][^.]*[.][^.]*[.][^.]*$" .instance "" }}"` plus `legendFormat: "{{host}}"`. Quotes inside the template must be escaped as `\"`, or LogQL closes the string early (`not a valid duration string`). - Tables from a Prometheus raw selector carry a `__name__` column; hide it with `organize`. -- Saving through the API normalizes the dashboard (rows may be flattened, `y` recomputed): submit the native form (rows with `panels: []`, panels top-level, contiguous `y`). - Panel images cannot be rendered (no image renderer installed) and there is no browser here: verify a dashboard by running its queries with the variables substituted. - Signals that exist only as logs are counted with Loki, and the count is then cross-checked against the nginx access log for the same window and the same status code (`job="frontend"`, e.g. a `429`): two independent sources must agree before a number is trusted. -- The app writes its own logs at WARN only when something is left queued behind the call and at TRACE otherwise, so production Loki holds just the under-pressure lines: a count of `hint="enqueued"` or `hint="acquired"` is not the number of calls, and neither is a count of `hint="rejected"` lines, because a rejection that leaves the queue empty (a lone caller that times out) is written at TRACE. The rejection counters are the real number. -- The MCP Prometheus tool can answer empty for every query, `up` included, while the datasource itself is fine: an empty result from it is not proof that a panel has no data, and blaming the datasource for it is wrong. Run PromQL by hand with `grafana_api_request` against `/api/datasources/uid//resources/api/v1/query?query=...` (or `POST /api/ds/query`, the path dashboards use), and check when a series is expected but the tool says nothing. -- **Check `list_dashboard_versions` before writing.** The user edits dashboards by hand and a full-JSON overwrite silently reverts that work; prefer `operations` patches per panel. diff --git a/backend/src/app/loggers/metrics.clj b/backend/src/app/loggers/metrics.clj new file mode 100644 index 0000000000..07c97debd1 --- /dev/null +++ b/backend/src/app/loggers/metrics.clj @@ -0,0 +1,46 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS INC Sucursal en España SL + +(ns app.loggers.metrics + "A reporter that counts the log records of this application, by logger and + level, and publishes them as a counter." + (:require + [app.common.logging :as l] + [app.metrics :as mtx] + [integrant.core :as ig])) + +(def ^:private counted-levels + "The levels worth counting: `info` is emitted often and says nothing about + the health of the application." + #{:warn :error :fatal}) + +(defmethod ig/assert-key ::reporter + [_ params] + (assert (mtx/metrics? (::mtx/metrics params)) "expect valid metrics instance")) + +(defmethod ig/init-key ::reporter + [_ {::mtx/keys [metrics]}] + (add-watch l/log-record ::reporter + (fn [_ _ _ record] + ;; This runs inside the logging path: the watcher fires from + ;; the `swap!` of the log record, so an exception here would + ;; reach whoever was logging on the synchronous path, and on + ;; the async one it would die in the executor's uncaught + ;; handler, taking that log line out of Loki. Swallowed on + ;; purpose either way. + (try + (let [level (::l/level record)] + (when (contains? counted-levels level) + (mtx/run! metrics + :id :log-events + :inc 1 + :labels (into-array String [(::l/logger record) (name level)])))) + (catch Throwable _ nil)))) + {::mtx/metrics metrics}) + +(defmethod ig/halt-key! ::reporter + [_ _] + (remove-watch l/log-record ::reporter)) diff --git a/backend/src/app/main.clj b/backend/src/app/main.clj index 86ce7883be..221c20af3a 100644 --- a/backend/src/app/main.clj +++ b/backend/src/app/main.clj @@ -50,7 +50,13 @@ (:gen-class)) (def default-metrics - {:update-file-changes + {:log-events + {::mdef/name "penpot_log_events_total" + ::mdef/help "Log records at WARN, ERROR and FATAL emitted by the application, by logger and level." + ::mdef/labels ["logger" "level"] + ::mdef/type :counter} + + :update-file-changes {::mdef/name "penpot_rpc_update_file_changes_total" ::mdef/help "A total number of changes submitted to update-file." ::mdef/type :counter} @@ -534,6 +540,9 @@ :app.loggers.database/reporter {::db/pool (ig/ref ::db/pool)} + :app.loggers.metrics/reporter + {::mtx/metrics (ig/ref ::mtx/metrics)} + ::sto/storage {::db/pool (ig/ref ::db/pool) ::sto/backends diff --git a/backend/test/backend_tests/helpers.clj b/backend/test/backend_tests/helpers.clj index 89c0d33084..2771470506 100644 --- a/backend/test/backend_tests/helpers.clj +++ b/backend/test/backend_tests/helpers.clj @@ -126,6 +126,7 @@ :app.notifications/handler :app.loggers.mattermost/reporter :app.loggers.database/reporter + :app.loggers.metrics/reporter :app.worker/cron :app.worker/dispatcher [:app.main/default :app.worker/runner] diff --git a/backend/test/backend_tests/loggers_metrics_test.clj b/backend/test/backend_tests/loggers_metrics_test.clj new file mode 100644 index 0000000000..984ad3b0f8 --- /dev/null +++ b/backend/test/backend_tests/loggers_metrics_test.clj @@ -0,0 +1,135 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS INC Sucursal en España SL + +(ns backend-tests.loggers-metrics-test + "The reporter that turns log records into a counter." + (:require + [app.common.logging :as l] + [app.loggers.metrics] ;; registers the integrant methods of the reporter key + [app.main :as main] + [app.metrics :as mtx] + [clojure.test :as t] + [integrant.core :as ig]) + (:import + io.prometheus.client.CollectorRegistry)) + +(def ^:private logger + "The logger of a record is the namespace of the code that logs, and that is + this namespace." + (str *ns*)) + +(defn- init-metrics + [] + (ig/init-key :app.metrics/metrics {:default main/default-metrics})) + +(defn- init-reporter + [metrics] + (ig/init-key :app.loggers.metrics/reporter {::mtx/metrics metrics})) + +(defn- halt-reporter! + [reporter] + (ig/halt-key! :app.loggers.metrics/reporter reporter)) + +(defn- sample + "Value of the counter for one logger and level, read from the registry. Nil + when that combination has never been published." + [metrics logger level] + (.getSampleValue ^CollectorRegistry (mtx/get-registry metrics) + "penpot_log_events_total" + (into-array String ["logger" "level"]) + (into-array String [logger level]))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; COUNTING +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(t/deftest warn-and-error-are-counted-by-logger-and-level + (let [metrics (init-metrics) + reporter (init-reporter metrics)] + (try + ;; `:sync?` so the record is emitted on this thread and the assertion + ;; does not depend on the logging executor. + (l/warn :hint "una prueba" ::l/sync? true) + (l/error :hint "otra prueba" ::l/sync? true) + + (t/is (= 1.0 (sample metrics logger "warn"))) + (t/is (= 1.0 (sample metrics logger "error"))) + + (l/error :hint "y otra mas" ::l/sync? true) + (t/is (= 2.0 (sample metrics logger "error"))) + + (finally + (halt-reporter! reporter))))) + +(t/deftest info-is-not-counted + (let [metrics (init-metrics) + reporter (init-reporter metrics)] + (try + (l/info :hint "un mensaje normal" ::l/sync? true) + (t/is (nil? (sample metrics logger "info"))) + + (finally + (halt-reporter! reporter))))) + +(t/deftest fatal-is-counted + (let [metrics (init-metrics) + reporter (init-reporter metrics)] + (try + ;; No macro of the logging emits `:fatal`; this is the only way a record + ;; gets that level. + (l/log :fatal :hint "algo muy malo" ::l/sync? true) + (t/is (= 1.0 (sample metrics logger "fatal"))) + + (finally + (halt-reporter! reporter))))) + +(t/deftest halting-the-reporter-stops-counting + (let [metrics (init-metrics) + reporter (init-reporter metrics)] + + (halt-reporter! reporter) + + (l/error :hint "despues de parar" ::l/sync? true) + (t/is (nil? (sample metrics logger "error"))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; SAFETY +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(t/deftest a-failing-publication-does-not-break-the-logging + ;; The watcher fires from the `swap!` of the log record, inside the logging + ;; path. With `::l/sync?` an exception here would reach whoever was logging; + ;; on the async path it would end in the executor's uncaught handler, which + ;; is outside the application's logging, taking that log line out of Loki and + ;; out of this counter. + (let [metrics (init-metrics) + reporter (init-reporter metrics)] + (try + (with-redefs [mtx/run! (fn [& _] (throw (ex-info "publicando mal" {})))] + (t/is (nil? (l/error :hint "no debe propagar" ::l/sync? true)))) + + (finally + (halt-reporter! reporter))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; DEFINITION +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(t/deftest the-log-events-metric-is-defined + (let [metrics (init-metrics)] + (t/is (= ["logger" "level"] + (:app.metrics.definition/labels (mtx/get-collector metrics :log-events)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; WIRING +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(t/deftest the-system-declares-the-reporter + ;; The reporter hooks itself to the logging, so declaring it in the system is + ;; all the wiring there is. The tests of the suite remove it, so this is the + ;; only place that pins it. + (t/is (= {::mtx/metrics (ig/ref ::mtx/metrics)} + (:app.loggers.metrics/reporter main/system-config)))) From 296ad9704f911727dbb80eed8d134320b1175fe4 Mon Sep 17 00:00:00 2001 From: Pablo Alba Date: Thu, 15 Oct 2026 21:41:36 +0200 Subject: [PATCH 14/16] :bug: Fix bad message changing team to another organization (#12354) --- frontend/src/app/main/data/common.cljs | 8 ++-- .../frontend_tests/data/dashboard_test.cljs | 44 ++++++++++++++++++- frontend/translations/ca.po | 4 +- frontend/translations/en.po | 4 +- frontend/translations/es.po | 4 +- frontend/translations/fa.po | 4 +- frontend/translations/fr.po | 4 +- frontend/translations/fr_CA.po | 4 +- frontend/translations/he.po | 4 +- frontend/translations/it.po | 4 +- frontend/translations/jpn_JP.po | 4 +- frontend/translations/nl.po | 4 +- frontend/translations/sv.po | 4 +- frontend/translations/tr.po | 4 +- frontend/translations/zh_Hant.po | 4 +- 15 files changed, 74 insertions(+), 30 deletions(-) diff --git a/frontend/src/app/main/data/common.cljs b/frontend/src/app/main/data/common.cljs index 6c948eef09..b04228694c 100644 --- a/frontend/src/app/main/data/common.cljs +++ b/frontend/src/app/main/data/common.cljs @@ -257,6 +257,8 @@ (watch [_ state _] (let [current-team-id (:current-team-id state) organization (:organization team) + team-name (or (:name team) + (dm/get-in state [:teams (:id team) :name])) current-team? (= (:id team) current-team-id)] (when (and (contains? cf/flags :admin-console) current-team?) @@ -266,14 +268,14 @@ ;; (tr "dashboard.team-belong-organization") ;; (tr "dashboard.team-no-longer-belong-organization") ;; notification is a server-provided key, dynamic by design + ;; args: team name, organization name #_{:clj-kondo/ignore [:penpot/tr-dynamic]} - (rx/of (ntf/show {:content (tr notification (:name organization)) + (rx/of (ntf/show {:content (tr notification team-name (:name organization)) :type :toast :level :info :timeout nil}))) (when (:id organization) - (check-team-sso current-team-id)))))) - ptk/UpdateEvent + (check-team-sso current-team-id)))))) ptk/UpdateEvent (update [_ state] (if (contains? cf/flags :admin-console) (let [team-id (:id team) diff --git a/frontend/test/frontend_tests/data/dashboard_test.cljs b/frontend/test/frontend_tests/data/dashboard_test.cljs index 12fefdb476..f59b5f83e7 100644 --- a/frontend/test/frontend_tests/data/dashboard_test.cljs +++ b/frontend/test/frontend_tests/data/dashboard_test.cljs @@ -10,14 +10,57 @@ [app.config :as cf] [app.main.data.common :as dcm] [app.main.data.dashboard :as dd] + [app.main.data.notifications :as ntf] [app.main.data.websocket :as dws] [app.main.repo :as rp] [app.main.router :as rt] + [app.util.i18n :as i18n] [beicon.v2.core :as rx] [cljs.test :as t :include-macros true] [frontend-tests.helpers.async :as async] [frontend-tests.helpers.mock :as mock] [potok.v2.core :as ptk])) +(defn- tr-args-for-team-org-toast + "Runs handle-change-team-organization and returns recorded i18n/tr calls." + [notification organization] + (let [team-id (uuid/next) + current-url (str "https://penpot.example.com/#/dashboard/recent?team-id=" team-id) + state {:current-team-id team-id + :teams {team-id {:id team-id :name "Team-Apple"}}} + event (dcm/handle-change-team-organization + {:team {:id team-id :organization organization} + :notification notification}) + tr-calls (atom [])] + (-> (mock/with-mocks* + {cf/flags (conj cf/flags :admin-console) + ;; plain variadic fn: mock/stub does not cover IFn variadic dispatch + i18n/tr (fn [key & args] + (swap! tr-calls conj [key (vec args)]) + (str key ":" (pr-str args))) + rp/cmd! (mock/stub + (fn [cmd params] + (if (= [:check-nitrate-sso + {:team-id team-id :url current-url}] + [cmd params]) + (rx/of {:authorized true}) + (rx/throw (ex-info "unexpected RPC" {:cmd cmd :params params}))))) + rt/get-current-href (mock/stub (constantly current-url))} + (await (async/observe (ptk/watch event state nil) + :on-next (fn [ev] + (t/is (= ::ntf/show (ptk/type ev))))))) + (.then (fn [_] @tr-calls))))) (t/deftest ^:async team-org-change-toast-names-team-when-joining-org + (let [tr-calls (await (tr-args-for-team-org-toast + "dashboard.team-belong-organization" + {:id (uuid/next) :name "OrgB"}))] + (t/is (= [["dashboard.team-belong-organization" ["Team-Apple" "OrgB"]]] + tr-calls)))) + +(t/deftest ^:async team-org-change-toast-names-team-when-leaving-org + (let [tr-calls (await (tr-args-for-team-org-toast + "dashboard.team-no-longer-belong-organization" + {:name "OrgA"}))] + (t/is (= [["dashboard.team-no-longer-belong-organization" ["Team-Apple" "OrgA"]]] + tr-calls)))) (t/deftest moving-current-team-into-sso-organization-redirects (t/async done @@ -51,7 +94,6 @@ (fn [] (done'))))) done)))) - (t/deftest organization-sso-activation-redirects-current-team (t/async done (let [team-id (uuid/next) diff --git a/frontend/translations/ca.po b/frontend/translations/ca.po index 2c3702dc0c..900e2048d1 100644 --- a/frontend/translations/ca.po +++ b/frontend/translations/ca.po @@ -1238,7 +1238,7 @@ msgstr "S'ha mogut el projecte" #: src/app/main/data/common.cljs:266 #, backend msgid "dashboard.team-belong-organization" -msgstr "Aquest equip ara forma part de l'organització %s" +msgstr "%s ara forma part de %s" #: src/app/main/ui/dashboard/team.cljs:1669 msgid "dashboard.team-info" @@ -1251,7 +1251,7 @@ msgstr "Membres de l'equip" #: src/app/main/data/common.cljs:267 #, backend msgid "dashboard.team-no-longer-belong-organization" -msgstr "Aquest equip ja no forma part de l'organització %s" +msgstr "%s ja no forma part de %s" #: src/app/main/ui/dashboard/team.cljs:1676 msgid "dashboard.team-organization" diff --git a/frontend/translations/en.po b/frontend/translations/en.po index 68f7eb7cbf..5c10b8d23b 100644 --- a/frontend/translations/en.po +++ b/frontend/translations/en.po @@ -1250,7 +1250,7 @@ msgstr "Your project has been moved successfully" #: src/app/main/data/common.cljs:266 #, backend msgid "dashboard.team-belong-organization" -msgstr "This team is now part of the organization %s" +msgstr "%s now belongs to %s" #: src/app/main/ui/dashboard/team.cljs:1669 msgid "dashboard.team-info" @@ -1263,7 +1263,7 @@ msgstr "Team members" #: src/app/main/data/common.cljs:267 #, backend msgid "dashboard.team-no-longer-belong-organization" -msgstr "This team is no longer part of the organization %s" +msgstr "%s is no longer part of %s" #: src/app/main/ui/dashboard/team.cljs:1676 msgid "dashboard.team-organization" diff --git a/frontend/translations/es.po b/frontend/translations/es.po index 794f34f57f..4207845025 100644 --- a/frontend/translations/es.po +++ b/frontend/translations/es.po @@ -1264,7 +1264,7 @@ msgstr "Tu proyecto ha sido movido con éxito" #: src/app/main/data/common.cljs:266 #, backend msgid "dashboard.team-belong-organization" -msgstr "Este equipo ahora es parte de la organización %s" +msgstr "%s ahora pertenece a %s" #: src/app/main/ui/dashboard/team.cljs:1669 msgid "dashboard.team-info" @@ -1277,7 +1277,7 @@ msgstr "Integrantes del equipo" #: src/app/main/data/common.cljs:267 #, backend msgid "dashboard.team-no-longer-belong-organization" -msgstr "Este equipo ya no es parte de la organización %s" +msgstr "%s ya no forma parte de %s" #: src/app/main/ui/dashboard/team.cljs:1676 msgid "dashboard.team-organization" diff --git a/frontend/translations/fa.po b/frontend/translations/fa.po index 2acda65b41..bf01868ef6 100644 --- a/frontend/translations/fa.po +++ b/frontend/translations/fa.po @@ -1220,7 +1220,7 @@ msgstr "پروژه شما با موفقیت منتقل شد" #: src/app/main/data/common.cljs:266 #, backend msgid "dashboard.team-belong-organization" -msgstr "این تیم اکنون به %s تعلق دارد" +msgstr "%s اکنون به %s تعلق دارد" #: src/app/main/ui/dashboard/team.cljs:1669 msgid "dashboard.team-info" @@ -1233,7 +1233,7 @@ msgstr "اعضای تیم" #: src/app/main/data/common.cljs:267 #, backend msgid "dashboard.team-no-longer-belong-organization" -msgstr "این تیم دیگر به سازمان %s تعلق ندارد" +msgstr "%s دیگر به %s تعلق ندارد" #: src/app/main/ui/dashboard/team.cljs:1676 msgid "dashboard.team-organization" diff --git a/frontend/translations/fr.po b/frontend/translations/fr.po index 507dfc85bb..5686f05331 100644 --- a/frontend/translations/fr.po +++ b/frontend/translations/fr.po @@ -1248,7 +1248,7 @@ msgstr "Votre projet a bien été déplacé" #: src/app/main/data/common.cljs:266 #, backend msgid "dashboard.team-belong-organization" -msgstr "Cette équipe appartient désormais à %s" +msgstr "%s appartient désormais à %s" #: src/app/main/ui/dashboard/team.cljs:1669 msgid "dashboard.team-info" @@ -1261,7 +1261,7 @@ msgstr "Membres de l’équipe" #: src/app/main/data/common.cljs:267 #, backend msgid "dashboard.team-no-longer-belong-organization" -msgstr "Cette équipe n'appartient plus à l'organisation %s" +msgstr "%s n'appartient plus à %s" #: src/app/main/ui/dashboard/team.cljs:1676 msgid "dashboard.team-organization" diff --git a/frontend/translations/fr_CA.po b/frontend/translations/fr_CA.po index 65470f996a..79fb1a0323 100644 --- a/frontend/translations/fr_CA.po +++ b/frontend/translations/fr_CA.po @@ -1122,7 +1122,7 @@ msgstr "Le projet a été déplacé avec succès" #: src/app/main/data/common.cljs:266 #, backend msgid "dashboard.team-belong-organization" -msgstr "Cette équipe appartient maintenant à l'organisation %s" +msgstr "%s appartient maintenant à %s" #: src/app/main/ui/dashboard/team.cljs:1669 msgid "dashboard.team-info" @@ -1135,7 +1135,7 @@ msgstr "Membres de l'équipe" #: src/app/main/data/common.cljs:267 #, backend msgid "dashboard.team-no-longer-belong-organization" -msgstr "Cette équipe n'appartient plus à l'organisation %s" +msgstr "%s n'appartient plus à %s" #: src/app/main/ui/dashboard/team.cljs:1676 msgid "dashboard.team-organization" diff --git a/frontend/translations/he.po b/frontend/translations/he.po index 468980a6f6..0e9eabca97 100644 --- a/frontend/translations/he.po +++ b/frontend/translations/he.po @@ -1093,7 +1093,7 @@ msgstr "המיזם שלך הועבר בהצלחה" #: src/app/main/data/common.cljs:266 #, backend msgid "dashboard.team-belong-organization" -msgstr "הצוות הזה שייך מעתה ל־%s" +msgstr "%s שייך מעתה ל־%s" #: src/app/main/ui/dashboard/team.cljs:1669 msgid "dashboard.team-info" @@ -1106,7 +1106,7 @@ msgstr "חברי הצוות" #: src/app/main/data/common.cljs:267 #, backend msgid "dashboard.team-no-longer-belong-organization" -msgstr "הצוות הזה לא שייך יותר לארגון %s" +msgstr "%s לא שייך יותר ל־%s" #: src/app/main/ui/dashboard/team.cljs:1676 msgid "dashboard.team-organization" diff --git a/frontend/translations/it.po b/frontend/translations/it.po index 992dc61a58..3512c5d007 100644 --- a/frontend/translations/it.po +++ b/frontend/translations/it.po @@ -1103,7 +1103,7 @@ msgstr "Il tuo progetto è stato spostato con successo" #: src/app/main/data/common.cljs:266 #, backend msgid "dashboard.team-belong-organization" -msgstr "Questo team ora appartiene a %s" +msgstr "%s ora appartiene a %s" #: src/app/main/ui/dashboard/team.cljs:1669 msgid "dashboard.team-info" @@ -1116,7 +1116,7 @@ msgstr "Membri del team" #: src/app/main/data/common.cljs:267 #, backend msgid "dashboard.team-no-longer-belong-organization" -msgstr "Questo team non appartiene più all'organizzazione %s" +msgstr "%s non appartiene più a %s" #: src/app/main/ui/dashboard/team.cljs:1676 msgid "dashboard.team-organization" diff --git a/frontend/translations/jpn_JP.po b/frontend/translations/jpn_JP.po index 1d633bb75d..7b0a3d78b9 100644 --- a/frontend/translations/jpn_JP.po +++ b/frontend/translations/jpn_JP.po @@ -1202,7 +1202,7 @@ msgstr "プロジェクトを移動しました" #: src/app/main/data/common.cljs:266 #, backend msgid "dashboard.team-belong-organization" -msgstr "このチームは組織「%s」に所属しました" +msgstr "%s は組織「%s」に所属しました" #: src/app/main/ui/dashboard/team.cljs:1669 msgid "dashboard.team-info" @@ -1215,7 +1215,7 @@ msgstr "チームのメンバー" #: src/app/main/data/common.cljs:267 #, backend msgid "dashboard.team-no-longer-belong-organization" -msgstr "このチームは組織「%s」に所属しなくなりました" +msgstr "%s は組織「%s」に所属しなくなりました" #: src/app/main/ui/dashboard/team.cljs:1676 msgid "dashboard.team-organization" diff --git a/frontend/translations/nl.po b/frontend/translations/nl.po index 1de2d611ec..3d55474017 100644 --- a/frontend/translations/nl.po +++ b/frontend/translations/nl.po @@ -1230,7 +1230,7 @@ msgstr "Je project is succesvol verplaatst" #: src/app/main/data/common.cljs:266 #, backend msgid "dashboard.team-belong-organization" -msgstr "Dit team behoort nu tot %s" +msgstr "%s behoort nu tot %s" #: src/app/main/ui/dashboard/team.cljs:1669 msgid "dashboard.team-info" @@ -1243,7 +1243,7 @@ msgstr "Teamleden" #: src/app/main/data/common.cljs:267 #, backend msgid "dashboard.team-no-longer-belong-organization" -msgstr "Dit team behoort niet langer tot de organisatie %s" +msgstr "%s behoort niet langer tot %s" #: src/app/main/ui/dashboard/team.cljs:1676 msgid "dashboard.team-organization" diff --git a/frontend/translations/sv.po b/frontend/translations/sv.po index b74e6d85a0..293b654895 100644 --- a/frontend/translations/sv.po +++ b/frontend/translations/sv.po @@ -1221,7 +1221,7 @@ msgstr "Ditt projekt har flyttats" #: src/app/main/data/common.cljs:266 #, backend msgid "dashboard.team-belong-organization" -msgstr "Detta team tillhör nu %s" +msgstr "%s tillhör nu %s" #: src/app/main/ui/dashboard/team.cljs:1669 msgid "dashboard.team-info" @@ -1234,7 +1234,7 @@ msgstr "Teammedlemmar" #: src/app/main/data/common.cljs:267 #, backend msgid "dashboard.team-no-longer-belong-organization" -msgstr "Detta team tillhör inte längre organisation %s" +msgstr "%s tillhör inte längre %s" #: src/app/main/ui/dashboard/team.cljs:1676 msgid "dashboard.team-organization" diff --git a/frontend/translations/tr.po b/frontend/translations/tr.po index 82cd5fe9a6..adbc51754c 100644 --- a/frontend/translations/tr.po +++ b/frontend/translations/tr.po @@ -1226,7 +1226,7 @@ msgstr "Projen başarıyla taşındı" #: src/app/main/data/common.cljs:266 #, backend msgid "dashboard.team-belong-organization" -msgstr "Bu takım artık %s organizasyonuna ait" +msgstr "%s artık %s organizasyonuna ait" #: src/app/main/ui/dashboard/team.cljs:1669 msgid "dashboard.team-info" @@ -1239,7 +1239,7 @@ msgstr "Takım üyeleri" #: src/app/main/data/common.cljs:267 #, backend msgid "dashboard.team-no-longer-belong-organization" -msgstr "Bu takım artık %s organizasyonuna ait değil" +msgstr "%s artık %s organizasyonuna ait değil" #: src/app/main/ui/dashboard/team.cljs:1676 msgid "dashboard.team-organization" diff --git a/frontend/translations/zh_Hant.po b/frontend/translations/zh_Hant.po index 94bb9de6fa..ebb8577137 100644 --- a/frontend/translations/zh_Hant.po +++ b/frontend/translations/zh_Hant.po @@ -1163,7 +1163,7 @@ msgstr "已成功移動您的專案" #: src/app/main/data/common.cljs:266 #, backend msgid "dashboard.team-belong-organization" -msgstr "此團隊現已隸屬於組織 %s" +msgstr "%s 現已隸屬於 %s" #: src/app/main/ui/dashboard/team.cljs:1669 msgid "dashboard.team-info" @@ -1176,7 +1176,7 @@ msgstr "團隊成員" #: src/app/main/data/common.cljs:267 #, backend msgid "dashboard.team-no-longer-belong-organization" -msgstr "此團隊已不再隸屬於組織 %s" +msgstr "%s 已不再隸屬於 %s" #: src/app/main/ui/dashboard/team.cljs:1676 msgid "dashboard.team-organization" From 0afe1e193d7c6579752ecd886bd294e7fd4a91d0 Mon Sep 17 00:00:00 2001 From: Pablo Alba Date: Fri, 16 Oct 2026 09:13:03 +0200 Subject: [PATCH 15/16] :bug: Fix team switcher height (#12371) --- .../app/main/ui/dashboard/organization_team_switch.scss | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/frontend/src/app/main/ui/dashboard/organization_team_switch.scss b/frontend/src/app/main/ui/dashboard/organization_team_switch.scss index c2aef5e875..3fee83b7a4 100644 --- a/frontend/src/app/main/ui/dashboard/organization_team_switch.scss +++ b/frontend/src/app/main/ui/dashboard/organization_team_switch.scss @@ -208,7 +208,12 @@ gap: var(--sp-s); top: calc(var(--sp-s) + #{$sz-64} + var(--sp-xs)); left: var(--sp-s); - height: px2rem(416); + + // Floor matches the previous fixed height; grow for ~6 org rows + left + // footer; scroll + fade kick in above the cap. + block-size: fit-content; + min-block-size: px2rem(416); + max-block-size: $sz-520; overflow: hidden; } From a5f75c73940c1a0257315a88d8c137984a5d0ded Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Moya?= Date: Fri, 16 Oct 2026 10:59:57 +0200 Subject: [PATCH 16/16] :bug: Fix repair bad variants (#11983) * :bug: Ensure normalized names in components and variants We have a rule of that shape names that include / separator should have it normalized, with one space before and one after. But this rule is being enforced only in the UI and the plugins API. There may be other ways of creating shapes that does not follow it. For normal shapes this is not really a problem. But for main instances it may cause that the name of the shape does not match the joined path+name of the component, and this may generate some problems. We have decided to add a migration to fix this in all main instances and variant containers and enforce it in the future with integrity validations (normal shapes may be left as is). * :bug: Fix bad variant-id in the component and the main instance * :wrench: Fix some issues detected in PR review * :bug: Add nil guard --- common/src/app/common/files/builder.cljc | 4 +- common/src/app/common/files/migrations.cljc | 70 +++++++++- common/src/app/common/files/repair.cljc | 67 ++++++++- common/src/app/common/files/validate.cljc | 67 ++++++--- .../src/app/common/test_helpers/variants.cljc | 3 - .../test/common_tests/files/repair_test.cljc | 127 ++++++++++++++++-- .../test/common_tests/files_builder_test.cljc | 17 +++ .../common_tests/files_migrations_test.cljc | 103 ++++++++++++++ .../logic/comp_creation_test.cljc | 20 ++- 9 files changed, 429 insertions(+), 49 deletions(-) diff --git a/common/src/app/common/files/builder.cljc b/common/src/app/common/files/builder.cljc index 49d93407a0..2e02166a93 100644 --- a/common/src/app/common/files/builder.cljc +++ b/common/src/app/common/files/builder.cljc @@ -16,6 +16,7 @@ [app.common.files.helpers :as cph] [app.common.files.migrations :as fmig] [app.common.geom.shapes :as gsh] + [app.common.path-names :as cpn] [app.common.schema :as sm] [app.common.svg :as csvg] [app.common.time :as dt] @@ -102,7 +103,8 @@ (str/capital (d/name type))))) :always - (update :name unique-name state))) + (-> (update :name cpn/clean-path) + (update :name unique-name state)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; SCHEMAS diff --git a/common/src/app/common/files/migrations.cljc b/common/src/app/common/files/migrations.cljc index adc25e6cf6..d0312f5a56 100644 --- a/common/src/app/common/files/migrations.cljc +++ b/common/src/app/common/files/migrations.cljc @@ -21,21 +21,24 @@ [app.common.geom.shapes.text :as gsht] [app.common.logging :as l] [app.common.math :as mth] + [app.common.path-names :as cpn] [app.common.schema :as sm] [app.common.svg :as csvg] [app.common.types.color :as types.color] [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.types.fills :as types.fills] [app.common.types.path :as path] [app.common.types.path.segment :as path.segment] [app.common.types.shape :as cts] + [app.common.types.shape-tree :as ctt] [app.common.types.shape.interactions :as ctsi] [app.common.types.shape.shadow :as ctss] [app.common.types.shape.text :as ctst] [app.common.types.text :as types.text] - [app.common.types.token :as ctt] + [app.common.types.token :as cto] [app.common.types.tokens-lib :as ctob] [app.common.types.variant :as ctv] [app.common.uuid :as uuid] @@ -2169,7 +2172,7 @@ (if (some? token) (update shape :applied-tokens (fn [applied] - (-> (zipmap ctt/per-side-stroke-width-keys (repeat token)) + (-> (zipmap cto/per-side-stroke-width-keys (repeat token)) (merge applied) (dissoc :stroke-width)))) shape))) @@ -2219,6 +2222,66 @@ (update :pages-index d/update-vals update-container) (d/update-when :components d/update-vals update-container)))) +(defmethod migrate-data "0033-normalize-main-instance-names" + [data _] + ;; In penpot shape names always have "/" characters normalized with one space between and after, + ;; to form paths. But this is not enforced and may be places that still admit names like + ;; "Group/Name" or "Group / Name". With normal shapes this is not a problem. But for main + ;; instances, the name of the root shape must match exactly the path+name of the component. + ;; Here we normalize the names of all main instances, and a new file integrity validation has + ;; been added to enforce this from now on. + ;; Main instances in variants are a special case because they need to match the variant name. + (letfn [(update-shape [container shape-id] + (let [shape (ctn/get-shape container shape-id) + + shape (cond + ;; Variant container must have a normalized name + (ctk/is-variant-container? shape) + (let [name (:name shape) + clean-name (cpn/clean-path name) + clean-name (if (str/blank? clean-name) + "(empty)" ;; this may occur if the name contains only separators + clean-name)] + (if (= name clean-name) + shape + (assoc shape :name clean-name))) + + ;; Main instance inside a variant must have the same name as the container + (ctk/main-instance? shape) + (if (ctk/is-variant? shape) + (let [variant-container (ctn/get-shape container (:parent-id shape))] + (if (or (= (:name shape) (:name variant-container)) + (nil? variant-container)) + shape + (assoc shape :name (:name variant-container)))) + + ;; Other main instances must have the same name as the path+name of the component + (let [component (ctkl/get-component data (:component-id shape) true) + expected-name (when component + (cpn/merge-path-item (:path component) (:name component)))] + (if (or (= expected-name (:name shape)) + (nil? expected-name)) + shape + (assoc shape :name expected-name)))) + + ;; Any other shape does not need processing + :else shape)] + + (reduce update-shape + (ctt/set-shape container shape) + (:shapes shape)))) + + (update-container + [container] + (let [root (ctn/get-container-root container)] + (if root + (update-shape container (:id root)) + container)))] + + (-> data + (update :pages-index d/update-vals update-container) + (d/update-when :components d/update-vals update-container)))) + (def available-migrations (into (d/ordered-set) ["legacy-2" @@ -2308,4 +2371,5 @@ "0029-move-background-blur-out-of-blur" "0030-remove-stroke-per-side-attr" "0031-migrate-stroke-width-token-attr" - "0032-fix-children-not-in-parent"])) + "0032-fix-children-not-in-parent" + "0033-normalize-main-instance-names"])) diff --git a/common/src/app/common/files/repair.cljc b/common/src/app/common/files/repair.cljc index a8d98a2d87..4756f8a758 100644 --- a/common/src/app/common/files/repair.cljc +++ b/common/src/app/common/files/repair.cljc @@ -7,6 +7,7 @@ (ns app.common.files.repair (:require [app.common.data :as d] + [app.common.data.macros :as dm] [app.common.files.changes-builder :as pcb] [app.common.files.helpers :as cfh] [app.common.files.tokens :as cfo] @@ -215,6 +216,20 @@ (pcb/with-library-data file-data) (pcb/update-component (:component-id shape) repair-component)))) +(defmethod repair-error :invalid-main-instance-name + [_ {:keys [shape page-id args] :as error} file-data _] + (let [repair-shape + (fn [shape] + ;; Change the name to match the component + (let [component-name (:component-name args)] + (log/debug :hint (str " -> rename shape " (:id shape) " to " component-name)) + (assoc shape :name component-name)))] + + (log/debug :hint "repairing shape :invalid-main-instance-name" :id (:id shape) :name (:name shape) :page-id page-id) + (-> (pcb/empty-changes nil page-id) + (pcb/with-file-data file-data) + (pcb/update-shapes [(:id shape)] repair-shape)))) + (defmethod repair-error :invalid-main-instance [_ {:keys [shape page-id] :as error} file-data _] (let [repair-shape @@ -729,6 +744,42 @@ (pcb/with-file-data file-data) (pcb/update-shapes [parent-id] repair-fn)))) +(defmethod repair-error :variant-container-bad-name + [_ {:keys [shape page-id args]} file-data _] + (let [clean-name (:clean-name args) + + repair-shape + (fn [shape] + (log/debug :hint " -> set :name of shape" :id (:id shape) :name clean-name) + (assoc shape :name clean-name)) + + repair-component + (fn [component] + (let [[path name] (cpn/split-group-name clean-name)] + (log/debug :hint " -> set :path and :name of component" :id (:id component) :path path :name name) + (assoc component :path path :name name))) + + all-shape-ids + (cons (:id shape) (:shapes shape)) + + objects + (dm/get-in file-data [:pages-index page-id :objects]) + + all-main-instances + (map (d/getf objects) (:shapes shape)) + + all-component-ids + (map :component-id all-main-instances)] + + (log/debug :hint "repairing shape :variant-container-bad-name" :id (:id shape) :name (:name shape) :page-id page-id) + (as-> (pcb/empty-changes nil page-id) $ + (pcb/with-file-data $ file-data) + (pcb/with-library-data $ file-data) + (pcb/update-shapes $ all-shape-ids repair-shape) + (reduce #(pcb/update-component %1 %2 repair-component) + $ + all-component-ids)))) + (defmethod repair-error :variant-main-bad-name [_ {:keys [shape page-id args]} file-data _] (let [repair-fn @@ -771,14 +822,22 @@ (fn [shape] (let [variant-id (:variant-id args)] ;; Set the desired variant-id - (log/debug :hint (str " -> set variant-id to " variant-id)) - (assoc shape - :variant-id variant-id)))] + (log/debug :hint (str " -> set variant-id in shape to " variant-id)) + (assoc shape :variant-id variant-id))) + + repair-component + (fn [component] + (let [variant-id (:variant-id args)] + ;; Set the desired variant-id + (log/debug :hint (str " -> set variant-id in component to " variant-id)) + (assoc component :variant-id variant-id)))] (log/debug :hint "repairing shape :variant-component-bad-id" :id (:id shape) :name (:name shape) :page-id page-id) (-> (pcb/empty-changes nil page-id) (pcb/with-file-data file-data) - (pcb/update-shapes [(:id shape)] repair-shape)))) + (pcb/with-library-data file-data) + (pcb/update-shapes [(:id shape)] repair-shape) + (pcb/update-component (:component-id shape) repair-component)))) (defmethod repair-error :missing-tokens-status [_ _ file-data _] diff --git a/common/src/app/common/files/validate.cljc b/common/src/app/common/files/validate.cljc index 72a1e112ff..6654e28508 100644 --- a/common/src/app/common/files/validate.cljc +++ b/common/src/app/common/files/validate.cljc @@ -41,6 +41,7 @@ :duplicate-slot :invalid-main-instance-id :invalid-main-instance-page + :invalid-main-instance-name :invalid-main-instance :invalid-parent :component-main @@ -70,6 +71,7 @@ :invalid-variant-properties :variant-not-main :parent-not-variant + :variant-container-bad-name :variant-main-bad-name :variant-main-bad-variant-name :variant-component-bad-name @@ -302,7 +304,14 @@ shape file page) (report-error :invalid-main-instance-page (str/ffmt "Main instance page of component % is not valid" (:component-id shape)) - shape file page)))))))) + shape file page)))) + (when-not (ctk/is-variant? component) ;; Variants are checked elsewhere + (let [component-name (cpn/merge-path-item (:path component) (:name component))] + (when-not (= (:name shape) component-name) + (report-error :invalid-main-instance-name + (str/ffmt "Main instance % has an invalid name" (:id shape)) + shape file page + :component-name component-name)))))))) (defn- check-component-not-main-head "Validate shape is a not-main instance head, component @@ -570,14 +579,25 @@ (defn- check-variant-container "Shape is a variant container, so: -all its children should be variants with variant-id equals to the shape-id - -all the components should have the same properties" + -all the components should have the same properties + -the name of the container should be normalized for paths (separator / with one space at each side)." [shape file page] - (let [shape-id (:id shape) - shapes (:shapes shape) - objects (:objects page) - file-data (:data file) - first-child (get objects (first shapes)) - prop-names (cfv/extract-properties-names first-child file-data)] + (let [shape-id (:id shape) + container-name (:name shape) + shapes (:shapes shape) + objects (:objects page) + file-data (:data file) + first-child (get objects (first shapes)) + prop-names (cfv/extract-properties-names first-child file-data) + clean-path (cpn/clean-path container-name) + clean-path (if (str/blank? clean-path) + "(empty)" ;; this may occur if the name contains only separators + clean-path)] + (when-not (= container-name clean-path) + (report-error :variant-container-bad-name + (str/ffmt "Variant container % has a bad name %" shape-id container-name) + shape file page + :clean-name clean-path)) (run! (fn [child-id] (when-let [child (get objects child-id)] (if (not (ctk/is-variant? child)) @@ -598,6 +618,11 @@ :prop-names prop-names)))))) shapes))) +(defn- renamed-container? + [container] + (and (some? container) + (not= (:name container) (cpn/clean-path (:name container))))) + (defn- check-variant "Shape is a variant, so -it should be a main component @@ -622,21 +647,23 @@ (str/ffmt "Variant % has an invalid variant-name" (:id shape)) shape file page :variant-name variant-name)) - (when-not (= (:name parent) (:name shape)) - (report-error :variant-main-bad-name - (str/ffmt "Main instance inside variant % has an invalid name" (:id shape)) - shape file page - :variant-name (:name parent))) - (when-not (= (:name parent) (cpn/merge-path-item (:path component) (:name component))) - (report-error :variant-component-bad-name - (str/ffmt "Component % has an invalid name" (:id shape)) - shape file page - :variant-container-name (:name parent))) + ;; If the container is going to be renamed all main and components will be renamed, too + (when-not (renamed-container? parent) + (when-not (= (:name parent) (:name shape)) + (report-error :variant-main-bad-name + (str/ffmt "Main instance inside variant % has an invalid name" (:id shape)) + shape file page + :variant-name (:name parent))) + (when-not (= (:name parent) (cpn/merge-path-item (:path component) (:name component))) + (report-error :variant-component-bad-name + (str/ffmt "Component % has an invalid name" (:id shape)) + shape file page + :variant-container-name (:name parent)))) (when-not (= (:variant-id component) (:variant-id shape)) (report-error :variant-component-bad-id - (str/ffmt "Variant % has adifferent variant-id than its component" (:id shape)) + (str/ffmt "Variant % has a :variant-id that does not point to the container" (:id shape)) shape file page - :variant-id (:variant-id component))))) + :variant-id (:parent-id shape))))) (defn- check-shape "Validate referential integrity and semantic coherence of diff --git a/common/src/app/common/test_helpers/variants.cljc b/common/src/app/common/test_helpers/variants.cljc index 8bbadf4c40..34f0cc8467 100644 --- a/common/src/app/common/test_helpers/variants.cljc +++ b/common/src/app/common/test_helpers/variants.cljc @@ -62,7 +62,6 @@ (thc/make-component component2-label root2-label) (thc/update-component component2-label {:variant-id variant-id :variant-properties [{:name "Property 1" :value "Value2"}]})))) - (defn add-variant-with-copy [file variant-label component1-label root1-label component2-label root2-label child1-label child2-label component-copy-label] (let [file (ths/add-sample-shape file variant-label :type :frame :is-variant-container true) @@ -77,8 +76,6 @@ (thc/make-component component2-label root2-label) (thc/update-component component2-label {:variant-id variant-id :variant-properties [{:name "Property 1" :value "Value2"}]})))) - - (defn add-variant-with-text [file variant-label component1-label root1-label component2-label root2-label child1-label child2-label text1 text2 & {:keys [text1-params text2-params]}] diff --git a/common/test/common_tests/files/repair_test.cljc b/common/test/common_tests/files/repair_test.cljc index d5aba47c98..27f6964de2 100644 --- a/common/test/common_tests/files/repair_test.cljc +++ b/common/test/common_tests/files/repair_test.cljc @@ -15,6 +15,7 @@ [app.common.files.repair :as cfr] [app.common.files.validate :as cfv] [app.common.test-helpers.components :as thc] + [app.common.test-helpers.compositions :as tho] [app.common.test-helpers.files :as thf] [app.common.test-helpers.ids-map :as thi] [app.common.test-helpers.shapes :as ths] @@ -24,6 +25,48 @@ (t/use-fixtures :each thi/test-fixture) +(t/deftest repair-invalid-main-instance-name + (t/testing "detect and repair a main instance whose name doesn't match the component's name" + (let [file (-> (thf/sample-file :file1 :page-label :page1) + (tho/add-simple-component-with-copy :component1 :root1 :child1 :copy1) + (tho/add-simple-component-with-copy :component2 :root2 :child2 :copy2) + + ;; Update component paths and names + (thc/update-component :component1 {:path "Group / Subgroup" :name "Component1"}) + (thc/update-component :component2 {:path "Group / Subgroup" :name "Component2"}) + + ;; Update component1 shapes name to have path structure + (ths/update-shape :root1 :name "Group / Subgroup / Component1") + (ths/update-shape :copy1 :name "Group / Subgroup / Component1") + + ;; Update component2's name to have unnormalized path + ;; Note that the copy name is allowed to be different + (ths/update-shape :root2 :name "Group/Subgroup / Component2") + (ths/update-shape :copy2 :name "Group/Subgroup / Component2")) + + errors (cfv/validate-file file {}) + changes (cfr/repair-file file {} errors) + file' (thf/apply-changes file {:redo-changes changes} :validate? false) + errors' (cfv/validate-file file' {}) + root1' (ths/get-shape file' :root1) + child1' (ths/get-shape file' :child1) + copy1' (ths/get-shape file' :copy1) + root2' (ths/get-shape file' :root2) + child2' (ths/get-shape file' :child2) + copy2' (ths/get-shape file' :copy2)] + + (t/is (= 1 (count errors))) + (t/is (= :invalid-main-instance-name (:code (first errors)))) + (t/is (nil? errors')) + + (t/is (= "Group / Subgroup / Component1" (:name root1'))) + (t/is (= "Rect1" (:name child1'))) + (t/is (= "Group / Subgroup / Component1" (:name copy1'))) + + (t/is (= "Group / Subgroup / Component2" (:name root2'))) + (t/is (= "Rect1" (:name child2'))) + (t/is (= "Group/Subgroup / Component2" (:name copy2')))))) + (t/deftest repair-main-instance-not-a-variant (t/testing "detect and repair a variant component whose root shape is not a variant" (let [file (-> (thf/sample-file :file1 :page-label :page1) @@ -44,7 +87,7 @@ (t/is (= (thi/id :variant1) (:variant-id root1')))))) (t/deftest repair-invalid-variant-id-variant-component-bad-id - (t/testing "detect and repair a variant component whose variant id does not match the container's id" + (t/testing "detect and repair a variant main whose variant id does not match the container's id" (let [file (-> (thf/sample-file :file1 :page-label :page1) (thv/add-variant :variant1 :component1 :root1 :component2 :root2) (ths/update-shape :root1 :variant-id (uuid/next))) @@ -61,7 +104,25 @@ (t/is (= :variant-component-bad-id (:code (second errors)))) (t/is (nil? errors')) - (t/is (= (thi/id :variant1) (:variant-id root1')))))) + (t/is (= (thi/id :variant1) (:variant-id root1'))))) + + (t/testing "detect and repair a variant component whose variant id does not match the container's id" + (let [file (-> (thf/sample-file :file1 :page-label :page1) + (thv/add-variant :variant1 :component1 :root1 :component2 :root2) + (thc/update-component :component1 {:variant-id (uuid/next)})) + + errors (cfv/validate-file file {}) + changes (cfr/repair-file file {} errors) + file' (thf/apply-changes file {:redo-changes changes} :validate? false) + errors' (cfv/validate-file file' {}) + + component1' (thc/get-component file' :component1)] + + (t/is (= 1 (count errors))) + (t/is (= :variant-component-bad-id (:code (first errors)))) + + (t/is (nil? errors')) + (t/is (= (thi/id :variant1) (:variant-id component1')))))) (t/deftest repair-invalid-variant-properties (t/testing "detect and repair a second variant component whose properties do not match the first variant component's properties" @@ -161,23 +222,60 @@ (t/is (true? (:is-variant-container container')))))) +(t/deftest repair-variant-container-bad-name + (t/testing "detect and repair a variant container who has an unnormalized name" + (let [file (-> (thf/sample-file :file1 :page-label :page1) + (thv/add-variant :variant1 :component1 :root1 :component2 :root2) + ;; Variant container has a name that is not normalized and thus it cannot + ;; match the component names, that are separated in path and group. + (ths/update-shape :variant1 :name "Group / Subgroup/Component") + (ths/update-shape :root1 :name "Group / Subgroup/Component") + (ths/update-shape :root2 :name "Group / Subgroup/Component") + (thc/update-component :component1 {:path "Group / Subgroup" :name "Component"}) + (thc/update-component :component2 {:path "Group/Subgroup" :name "Component"})) + + errors (cfv/validate-file file {}) + changes (cfr/repair-file file {} errors) + file' (thf/apply-changes file {:redo-changes changes} :validate? false) + errors' (cfv/validate-file file' {}) + var1' (ths/get-shape file' :variant1) + root1' (ths/get-shape file' :root1) + comp1' (thc/get-component file' :component1) + root2' (ths/get-shape file' :root2) + comp2' (thc/get-component file' :component2)] + + (t/is (= 1 (count errors))) + (t/is (= :variant-container-bad-name (:code (first errors)))) + (t/is (nil? errors')) + (t/is (= "Group / Subgroup / Component" (:name var1'))) + (t/is (= "Group / Subgroup / Component" (:name root1'))) + (t/is (= "Group / Subgroup" (:path comp1'))) + (t/is (= "Component" (:name comp1'))) + (t/is (= "Group / Subgroup / Component" (:name root2'))) + (t/is (= "Group / Subgroup" (:path comp2'))) + (t/is (= "Component" (:name comp2')))))) + (t/deftest repair-variant-main-bad-name (t/testing "detect and repair a main instance whose name doesn't match the variant container's name" (let [file (-> (thf/sample-file :file1 :page-label :page1) (thv/add-variant :variant1 :component1 :root1 :component2 :root2) - ;; Change root1's name so it doesn't match the container + ;; Change component's name so it doesn't match the container + (thc/update-component :component1 :name "WrongName") (ths/update-shape :root1 :name "WrongName")) errors (cfv/validate-file file {}) changes (cfr/repair-file file {} errors) file' (thf/apply-changes file {:redo-changes changes} :validate? false) errors' (cfv/validate-file file' {}) - root1' (ths/get-shape file' :root1)] + root1' (ths/get-shape file' :root1) + comp1' (thc/get-component file' :component1)] - (t/is (= 1 (count errors))) + (t/is (= 2 (count errors))) (t/is (= :variant-main-bad-name (:code (first errors)))) + (t/is (= :variant-component-bad-name (:code (second errors)))) (t/is (nil? errors')) - (t/is (= "Board" (:name root1')))))) + (t/is (= "Board" (:name root1'))) + (t/is (= "Board" (:name comp1')))))) (t/deftest repair-variant-main-bad-variant-name (t/testing "detect and repair a variant shape whose :variant-name doesn't match the component's properties" @@ -211,23 +309,28 @@ (ths/update-shape :variant1 :name "Group / Subgroup / Component") (ths/update-shape :root1 :name "Group / Subgroup / Component") (ths/update-shape :root2 :name "Group / Subgroup / Component") - ;; Update component paths and names (thc/update-component :component1 {:path "Group / Subgroup" :name "Component"}) - (thc/update-component :component2 {:path "Group / Subgroup" :name "Component"}) - ;; Break component1's name - (thc/update-component :component1 {:name "WrongName"})) + ;; Break component2's name + (thc/update-component :component2 {:name "WrongName"})) errors (cfv/validate-file file {}) changes (cfr/repair-file file {} errors) file' (thf/apply-changes file {:redo-changes changes} :validate? false) errors' (cfv/validate-file file' {}) - comp1' (thc/get-component file' :component1)] + root1' (ths/get-shape file' :root1) + comp1' (thc/get-component file' :component1) + root2' (ths/get-shape file' :root2) + comp2' (thc/get-component file' :component2)] (t/is (= 1 (count errors))) (t/is (= :variant-component-bad-name (:code (first errors)))) (t/is (nil? errors')) + (t/is (= "Group / Subgroup / Component" (:name root1'))) (t/is (= "Group / Subgroup" (:path comp1'))) - (t/is (= "Component" (:name comp1')))))) + (t/is (= "Component" (:name comp1'))) + (t/is (= "Group / Subgroup / Component" (:name root2'))) + (t/is (= "Group / Subgroup" (:path comp2'))) + (t/is (= "Component" (:name comp2')))))) (t/deftest repair-child-not-in-parent (t/testing "detect and repair shapes whose parent exists but does not list them" diff --git a/common/test/common_tests/files_builder_test.cljc b/common/test/common_tests/files_builder_test.cljc index 707d56d3f0..23891a583b 100644 --- a/common/test/common_tests/files_builder_test.cljc +++ b/common/test/common_tests/files_builder_test.cljc @@ -70,3 +70,20 @@ (t/is (= "Image" (:name media))) (t/is (= 128 (:width media))) (t/is (= 64 (:height media))))) + +(t/deftest add-shape-normalizes-path-name + (let [file-id (uuid/next) + page-id (uuid/next) + shape-id (uuid/next) + state (-> (fb/create-state) + (fb/add-file {:id file-id :name "Test file"}) + (fb/add-page {:id page-id :name "Page 1"}) + (fb/add-shape {:id shape-id + :type :frame + :name "Group/Subgroup / Name" + :x 0 + :y 0 + :width 10 + :height 10})) + shape (fb/get-shape state shape-id)] + (t/is (= "Group / Subgroup / Name" (:name shape))))) diff --git a/common/test/common_tests/files_migrations_test.cljc b/common/test/common_tests/files_migrations_test.cljc index b76f4f369c..61ba0e7486 100644 --- a/common/test/common_tests/files_migrations_test.cljc +++ b/common/test/common_tests/files_migrations_test.cljc @@ -9,12 +9,20 @@ [app.common.data :as d] [app.common.files.migrations :as cfm] [app.common.files.tokens :as cfo] + [app.common.test-helpers.components :as thk] + [app.common.test-helpers.compositions :as tho] + [app.common.test-helpers.files :as thf] + [app.common.test-helpers.ids-map :as thi] + [app.common.test-helpers.shapes :as ths] + [app.common.test-helpers.variants :as thv] [app.common.types.file :as ctf] [app.common.types.shape :as cts] [app.common.types.token :as ctt] [app.common.uuid :as uuid] [clojure.test :as t])) +(t/use-fixtures :each thi/test-fixture) + (defmethod cfm/migrate-data "test/1" [data _] (update data :sum inc)) (defmethod cfm/migrate-data "test/2" [data _] (update data :sum inc)) (defmethod cfm/migrate-data "test/3" [data _] (update data :sum inc)) @@ -647,3 +655,98 @@ (t/is (contains? (:migrations file') migration-id) "migration id persisted") (t/is (= 4 (count (get-in file' [:data :pages-index page-id :objects shape-id :points]))) "path points repaired before schema validation"))) + +(t/deftest migration-0033-normalize-main-instance-diff-from-component + (let [migration-id "0033-normalize-main-instance-names" + file (-> (thf/sample-file :file1) + (tho/add-simple-component :component1 :root1 :child1 + :component-params {:path "Group / Subgroup" + :name "Name"} + :root-params {:name "Group/Subgroup / Name"}) + (tho/add-simple-component :component2 :root2 :child2 + :component-params {:path "Group / Subgroup" + :name "Other Name"} + :root-params {:name "Group / Subgroup / Other Name"}) + (ths/add-sample-shape :shape1 :name "Other Group/Other Subgroup / Other Name")) + + data (ctf/file-data file) + data' (cfm/migrate-data data migration-id) + file' (assoc file :data data') + + root1' (ths/get-shape file' :root1) + component1' (thk/get-component file' :component1) + root2' (ths/get-shape file' :root2) + component2' (thk/get-component file' :component2) + shape1' (ths/get-shape file' :shape1)] + + (t/is (= "Group / Subgroup" (:path component1'))) + (t/is (= "Name" (:name component1'))) + (t/is (= "Group / Subgroup / Name" (:name root1'))) + (t/is (= "Group / Subgroup" (:path component2'))) + (t/is (= "Other Name" (:name component2'))) + (t/is (= "Group / Subgroup / Other Name" (:name root2'))) + (t/is (= "Other Group/Other Subgroup / Other Name" (:name shape1'))))) + +(t/deftest migration-0033-normalize-variant-instance-diff-from-container + (let [migration-id "0033-normalize-main-instance-names" + file (-> (thf/sample-file :file1) + (thv/add-variant :variant1 :component1 :root1 :component2 :root2) + (ths/update-shape :variant1 :name "Group / Subgroup / Component") + (ths/update-shape :root1 :name "Group / Subgroup / Component") + (ths/update-shape :root2 :name "Group / Subgroup/Component") ;; Bad path + (thk/update-component :component1 {:path "Group / Subgroup" :name "Component"}) + (thk/update-component :component2 {:path "Group / Subgroup" :name "Component"}) + (thk/instantiate-component :component2 :copy2) + (ths/update-shape :copy2 :name "Group / Subgroup/Component")) ;; Allowed name in copies + + data (ctf/file-data file) + data' (cfm/migrate-data data migration-id) + file' (assoc file :data data') + + variant1' (ths/get-shape file' :variant1) + root1' (ths/get-shape file' :root1) + component1' (thk/get-component file' :component1) + root2' (ths/get-shape file' :root2) + component2' (thk/get-component file' :component2) + copy2' (ths/get-shape file' :copy2)] + + (t/is (= "Group / Subgroup / Component" (:name variant1'))) + (t/is (= "Group / Subgroup / Component" (:name root1'))) + (t/is (= "Group / Subgroup / Component" (:name root2'))) + (t/is (= "Group / Subgroup" (:path component1'))) + (t/is (= "Group / Subgroup" (:path component2'))) + (t/is (= "Component" (:name component1'))) + (t/is (= "Component" (:name component2'))) + (t/is (= "Group / Subgroup/Component" (:name copy2'))))) + +(t/deftest migration-0033-normalize-variant-name-not-normalized + (let [migration-id "0033-normalize-main-instance-names" + file (-> (thf/sample-file :file1) + (thv/add-variant :variant1 :component1 :root1 :component2 :root2) + (ths/update-shape :variant1 :name "Group/Subgroup / Component") + (ths/update-shape :root1 :name "Group/Subgroup / Component") + (ths/update-shape :root2 :name "Group/Subgroup / Component") ;; Bad path + (thk/update-component :component1 {:path "Group / Subgroup" :name "Component"}) + (thk/update-component :component2 {:path "Group / Subgroup" :name "Component"}) + (thk/instantiate-component :component2 :copy2) + (ths/update-shape :copy2 :name "Group / Subgroup/Component")) ;; Allowed name in copies + + data (ctf/file-data file) + data' (cfm/migrate-data data migration-id) + file' (assoc file :data data') + + variant1' (ths/get-shape file' :variant1) + root1' (ths/get-shape file' :root1) + component1' (thk/get-component file' :component1) + root2' (ths/get-shape file' :root2) + component2' (thk/get-component file' :component2) + copy2' (ths/get-shape file' :copy2)] + + (t/is (= "Group / Subgroup / Component" (:name variant1'))) + (t/is (= "Group / Subgroup / Component" (:name root1'))) + (t/is (= "Group / Subgroup / Component" (:name root2'))) + (t/is (= "Group / Subgroup" (:path component1'))) + (t/is (= "Group / Subgroup" (:path component2'))) + (t/is (= "Component" (:name component1'))) + (t/is (= "Component" (:name component2'))) + (t/is (= "Group / Subgroup/Component" (:name copy2'))))) diff --git a/common/test/common_tests/logic/comp_creation_test.cljc b/common/test/common_tests/logic/comp_creation_test.cljc index d28e5f3b31..95f158e2a3 100644 --- a/common/test/common_tests/logic/comp_creation_test.cljc +++ b/common/test/common_tests/logic/comp_creation_test.cljc @@ -19,6 +19,7 @@ [app.common.test-helpers.shapes :as ths] [app.common.types.component :as ctk] [app.common.types.components-list :as ctkl] + [app.common.types.file :as ctf] [app.common.types.shape-tree :as ctst] [app.common.uuid :as uuid] [clojure.test :as t])) @@ -250,18 +251,25 @@ component (thc/get-component file :component1) ;; ==== Action - changes (cll/generate-rename-component (pcb/empty-changes) - (:id component) - "Test component after" - (:data file)) + changes (-> (pcb/empty-changes nil (thf/current-page-id file)) + (pcb/with-file-data (ctf/file-data file)) + (cll/generate-rename-component + (:id component) + "Test component after" + (:data file)) + (pcb/update-shapes + [(thi/id :main1-root)] + #(assoc % :name "Test component after"))) file' (thf/apply-changes file changes) ;; ==== Get - component' (thc/get-component file' :component1)] + component' (thc/get-component file' :component1) + main1-root' (ths/get-shape file' :main1-root)] ;; ==== Check - (t/is (= (:name component') "Test component after")))) + (t/is (= (:name component') "Test component after")) + (t/is (= (:name main1-root') "Test component after")))) (t/deftest test-duplicate-component (let [;; ==== Setup