✨ Add tail buckets and update-file validation timings (#12409)

* ✨ Extend backend histogram buckets beyond 7.5s

Give every backend timing histogram a tail past the shared 7500ms cap
so slow RPC calls, CLIMIT waits and background tasks report real
quantiles instead of clipping at the top bucket.

Request and wait metrics grow to 60s, background tasks to 300s and
Redis eval to 10s; the sub-7.5s buckets stay untouched to keep the
history comparable.

Closes #12408

AI-assisted-by: muse-spark-1.3-contributor

* 🐛 Fix flaky assertion in climit republish test

Read the last published waiting value instead of the exact
publication list. The sampler thread started with the component
runs its first tick asynchronously, and when it lands inside the
recording window it publishes the same count twice, which made
the full-suite CI run fail while focused runs stayed green.

AI-assisted-by: muse-spark-1.3-contributor

* ✨ Add file_data blob to JSON decode helper

Allow decoding file_data blobs (app.util.blob) to JSON
for investigations with jq, offline from a blob file or
from nREPL with the backend running.

AI-assisted-by: muse-spark-1.3-contributor

* ✨ Add validation step timings to update-file logs and metrics

Measure the six phases inside process-changes-and-validate
(resolve-libs, process-changes, soft and hard affected and
schema validations) with tpoint and try/finally, so timings
are recorded even when a hard validation throws.

Publish each phase to a new histogram
penpot_rpc_update_file_validation_timing with a fixed step
label using the request buckets (up to 60000 ms), and extend
the update-file debug log with the same *-ms fields plus
file, project and team ids. The deferred log only runs on
success, so failures get an inline error log with partial
timings.

AI-assisted-by: muse-spark-1.3-contributor

* 💄 Translate decode-file-data comments to English

Translate the Spanish docstrings, section headers and test
messages of the file_data decode helper to English, keeping
code untouched. The repo convention is English in code and
comments; the helper was first written in Spanish.

AI-assisted-by: muse-spark-1.3-contributor

.serena/memories/clojure/design-rules.md

@@ -2,10 +2,11 @@
 
 How to shape a function in this codebase. Each rule came from a review round; do not re-derive from taste.
 
-- **Preconditions belong to the boundary, not to the core.** A function documents what it needs (hints, docstring) and assumes it. Absence checks live where the value enters the system: the caller that resolves optional objects, `ig/init-key`, the request handler. A `(when (and (some? a) (some? b)) ...)` inside a leaf function means the guard is in the wrong place — if you cannot get `a` or `b`, you should not be calling it.
-- **Optional-by-design data is guarded where the optionality is born.** Example: `ConnectorStatistics` is nil when the server option is off, so the guard is `when-let [cs (some-> server ...)]` at the entry point and the consumer assumes `cs`.
+- **Preconditions belong to the boundary, not to the core.** A function documents what it needs (hints, docstring) and assumes it. Absence checks live where the value enters the system: the caller that resolves optional objects, `ig/init-key`, the request handler — including `nil` that is optional-by-design (`when-let [cs (some-> server ...)]` at the entry point, as with `ConnectorStatistics` when the server option is off). A `(when (and (some? a) (some? b)) ...)` inside a leaf function means the guard is in the wrong place — if you cannot get `a` or `b`, you should not be calling it.
 - **A static set of operations is written statically.** With a fixed, small set (four metrics) write the four calls. Do not build a collection and iterate it (`doseq` over a literal vector): it allocates, adds indirection and hides each operation. Use a collection when the set is dynamic (config, registry, input).
-- **The name says what the function is; `!` says it mutates.** `!` marks functions whose contract is to change state or run a command (`run!`, `submit!`, `swap!`, `shutdown-now`). Reporting helpers (log, sample-and-publish) do not take it: the mutation happens in the `!` API they call. Keep a family consistent.
+- **Default to no `!`; existing `!` is legacy being removed gradually.** Do not introduce new `!` names except the allowed cases documented in `mem:clojure/idioms` (add and justify the special case there first). Allowed: mutating public fns in `app.db` (`insert!`, `update!`, `delete!`, `run!`, `tx-run!`, ...) and fns whose contract is to work over transients (stdlib `conj!`/`assoc!`/`dissoc!`/`persistent!` and custom helpers over them). Existing `!` elsewhere (e.g. `emit!`, `send!`, `submit!`, `validate-file!`) stays until its refactor; keep a family consistent in the meantime. Reporting helpers (log, sample-and-publish) never take `!`: the mutation happens in the `!` API they call.
+- **Functions that obtain data start with `get-` or `fetch-`.** A reader must see at a glance that the function reads (`get-file`, `get-snapshot`, `get-file-json`); a bare noun hides it (`file-json` says nothing about reading). New helpers that fetch by id follow this, never a `current-` prefix: the id parameter already says which one it is.
+- **`?` marks a predicate, not a data prop.** A var or function that answers a question takes `?` (`export-error?`, `(defn editable? …)`); a map key that names a property does not (`:export-error`, never `:export-error?`), even when its value is a boolean. Existing `?` keys are legacy to remove gradually; do not add a new one.
 - **Do not shape production code for tests.** No return values added just to assert them; assert on the observable effect. When preconditions move, move the tests with them.
 
 Reference implementation: the http metrics samplers in `app.http` (`sample-worker-metrics` / `sample-connector-metrics` are guard-free; `sample-http-metrics` guards at the boundary).

.serena/memories/critical-info.md

@@ -7,7 +7,7 @@ You are working on the GitHub project `penpot/penpot`, a monorepo.
 - Edits/stale refs/duplication cleanup: `mem:memory-maintenance`.
 - Cross-cutting testing principles, TDD workflow, and anti-patterns: `mem:testing`.
 - Verified Clojure language behaviors that contradict common assumptions (e.g. `int?` covers `Long`; `integer?` is the general predicate): `mem:clojure/idioms` — read before assuming stdlib predicate semantics.
-- When designing a solution or an API, read `mem:clojure/design-rules` (function shape, boundary checks, naming).
+- Read `mem:clojure/design-rules` (function shape, boundary checks, naming) before writing or modifying Clojure/ClojureScript code — not only when designing a solution or an API.
 
 # Development workflow
 

.serena/memories/prod-infra/grafana.md

@@ -6,7 +6,7 @@ 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, 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**.
+- 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**. Tails (ms): requests and waits to 60000, background tasks to 300000, Redis eval to 10000; the sub-7500 buckets are identical everywhere, so old quantiles stay comparable.
 - 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`.

backend/scripts/decode-file-data

@@ -0,0 +1,19 @@
+#!/usr/bin/env bash
+# Decode a file_data blob (app.util.blob) to JSON for inspection with jq.
+#
+# Offline use (no DB):
+#   backend/scripts/decode-file-data --input /tmp/blob.bin --format summary | jq .
+#
+# DB use (backend running, via nREPL):
+#   ./scripts/nrepl-eval.mjs "(require '[app.scripts.decode-file-data :as dfd] :reload)"
+#   ./scripts/nrepl-eval.mjs '(dfd/get-file-json sys/system #uuid "..." :format :summary)'
+
+SCRIPT_DIR=$(dirname "$0")
+
+source "$SCRIPT_DIR/_env"
+
+if [ -f "$SCRIPT_DIR/_env.local" ]; then
+    source "$SCRIPT_DIR/_env.local"
+fi
+
+exec clojure -M:dev -m app.scripts.decode-file-data "$@"

backend/src/app/main.clj

@@ -25,7 +25,7 @@
    [app.http.session.tasks :as-alias session.tasks]
    [app.http.websocket :as http.ws]
    [app.loggers.webhooks :as-alias webhooks]
-   [app.metrics :as-alias mtx]
+   [app.metrics :as mtx]
    [app.metrics.definition :as-alias mdef]
    [app.msgbus :as-alias mbus]
    [app.redis :as-alias rds]
@@ -66,16 +66,25 @@
     ::mdef/help "A total number of bytes processed by update-file."
     ::mdef/type :counter}
 
+   :update-file-validation-timing
+   {::mdef/name "penpot_rpc_update_file_validation_timing"
+    ::mdef/help "update-file validation step timings (milliseconds)."
+    ::mdef/labels ["step"]
+    ::mdef/buckets mtx/default-request-histogram-buckets
+    ::mdef/type :histogram}
+
    :rpc-main-timing
    {::mdef/name "penpot_rpc_main_timing"
     ::mdef/help "RPC command method call timing for main"
     ::mdef/labels ["name"]
+    ::mdef/buckets mtx/default-request-histogram-buckets
     ::mdef/type :histogram}
 
    :rpc-management-timing
    {::mdef/name "penpot_rpc_management_timing"
     ::mdef/help "RPC command method call timing for management."
     ::mdef/labels ["name"]
+    ::mdef/buckets mtx/default-request-histogram-buckets
     ::mdef/type :histogram}
 
    :websocket-active-connections
@@ -103,6 +112,7 @@
    {::mdef/name "penpot_tasks_timing"
     ::mdef/help "Background tasks timing (milliseconds)."
     ::mdef/labels ["name"]
+    ::mdef/buckets mtx/default-tasks-histogram-buckets
     ::mdef/type :histogram}
 
    :storage-gc-deleted-objects
@@ -115,6 +125,7 @@
    {::mdef/name "penpot_redis_eval_timing"
     ::mdef/help "Redis EVAL commands execution timings (ms)"
     ::mdef/labels ["name"]
+    ::mdef/buckets mtx/default-redis-histogram-buckets
     ::mdef/type :histogram}
 
    :rpc-climit-waiting
@@ -133,6 +144,7 @@
    {::mdef/name "penpot_rpc_climit_timing"
     ::mdef/help "Summary of the time between queuing and executing on the CLIMIT"
     ::mdef/labels ["name"]
+    ::mdef/buckets mtx/default-request-histogram-buckets
     ::mdef/type :histogram}
 
    :audit-http-handler-queue-size
@@ -151,12 +163,14 @@
    {::mdef/name "penpot_audit_http_handler_timing"
     ::mdef/help "Summary of the time between queuing and executing on the audit log http handler"
     ::mdef/labels []
+    ::mdef/buckets mtx/default-request-histogram-buckets
     ::mdef/type :histogram}
 
    :http-server-dispatch-timing
    {::mdef/name "penpot_http_server_dispatch_timing"
     ::mdef/help "Histogram of dispatch handler"
     ::mdef/labels []
+    ::mdef/buckets mtx/default-request-histogram-buckets
     ::mdef/type :histogram}
 
    :http-worker-queue-size

backend/src/app/metrics.clj

@@ -132,6 +132,25 @@
 (def default-histogram-buckets
   [1 5 10 25 50 75 100 250 500 750 1000 2500 5000 7500])
 
+;; Tail for request and wait timings (RPC, CLIMIT waits, audit handler,
+;; HTTP dispatch): covers the 30s/60s CLIMIT timeouts while keeping the
+;; sub-7.5s resolution of the default buckets untouched.
+(def default-request-histogram-buckets
+  [1 5 10 25 50 75 100 250 500 750 1000 2500 5000 7500
+   10000 15000 30000 60000])
+
+;; Tail for background tasks (GC sweeps, file workers): they run until
+;; done with no CLIMIT timeout, bounded in practice by the 300s postgres
+;; statement timeout.
+(def default-tasks-histogram-buckets
+  [1 5 10 25 50 75 100 250 500 750 1000 2500 5000 7500
+   10000 15000 30000 60000 120000 300000])
+
+;; Tail for Redis eval: sub-second in practice, one extra bucket covers
+;; the pathological (timeout) case without adding idle series.
+(def default-redis-histogram-buckets
+  [1 5 10 25 50 75 100 250 500 750 1000 2500 5000 7500 10000])
+
 (defmulti run-collector! (fn [mdef _] (::mdef/type mdef)))
 (defmulti create-collector ::mdef/type)
 

backend/src/app/rpc/commands/files_update.clj

@@ -169,7 +169,8 @@
                      (assoc :file file)
                      (assoc :changes changes))
 
-        cfg      (assoc cfg ::timestamp (ct/now))
+        cfg      (assoc cfg ::timestamp (ct/now)
+                        ::validation-timings (atom {}))
 
         tpoint   (ct/tpoint)]
 
@@ -210,9 +211,39 @@
     (binding [l/*context* (some-> (meta params)
                                   (get :app.http/request)
                                   (errors/request->context))]
-      (-> (update-file* cfg params)
-          (rph/with-defer #(let [elapsed (tpoint)]
-                             (l/trace :hint "update-file" :time (ct/format-duration elapsed))))))))
+      (try
+        (-> (update-file* cfg params)
+            (rph/with-defer #(let [elapsed (tpoint)
+                                   timings @(::validation-timings cfg)]
+                               (l/dbg :hint "update-file"
+                                      :file-id (str (:id file))
+                                      :project-id (str (:project-id file))
+                                      :team-id (str (:team-id file))
+                                      :status "success"
+                                      :time (ct/format-duration elapsed)
+                                      :resolve-libs-ms (get timings :resolve-libs-ms)
+                                      :process-changes-ms (get timings :process-changes-ms)
+                                      :soft-validate-affected-ms (get timings :soft-validate-affected-ms)
+                                      :soft-validate-schema-ms (get timings :soft-validate-schema-ms)
+                                      :validate-affected-ms (get timings :validate-affected-ms)
+                                      :validate-schema-ms (get timings :validate-schema-ms)))))
+        (catch Throwable cause
+          ;; NOTE: `with-defer` hooks only run on the success path
+          ;; (`handle-response`), so timings collected before a hard
+          ;; validation failure would be lost without this inline log.
+          (let [timings @(::validation-timings cfg)]
+            (l/dbg :hint "update-file"
+                   :file-id (str (:id file))
+                   :project-id (str (:project-id file))
+                   :team-id (str (:team-id file))
+                   :status "error"
+                   :resolve-libs-ms (get timings :resolve-libs-ms)
+                   :process-changes-ms (get timings :process-changes-ms)
+                   :soft-validate-affected-ms (get timings :soft-validate-affected-ms)
+                   :soft-validate-schema-ms (get timings :soft-validate-schema-ms)
+                   :validate-affected-ms (get timings :validate-affected-ms)
+                   :validate-schema-ms (get timings :validate-schema-ms)))
+          (throw cause))))))
 
 (defn- update-file*
   "Internal function, part of the update-file process, that encapsulates
@@ -379,6 +410,16 @@
     (catch Throwable cause
       (l/error :hint "file schema validation error" :cause cause))))
 
+(defn- record-validation-timing
+  [cfg step-key step-label elapsed-ms]
+  (when-let [metrics (::mtx/metrics cfg)]
+    (when (mtx/metrics? metrics)
+      (mtx/run! metrics {:id :update-file-validation-timing
+                         :labels [step-label]
+                         :val (double elapsed-ms)})))
+  (when-let [timings (::validation-timings cfg)]
+    (swap! timings assoc step-key elapsed-ms)))
+
 (defn- soft-validate-file!
   [file libs changes]
   (try
@@ -389,11 +430,21 @@
 
 (defn- process-changes-and-validate
   [cfg file changes skip-validate]
-  (let [libs
-        (when (and (or (contains? cf/flags :file-validation)
-                       (contains? cf/flags :soft-file-validation))
-                   (not skip-validate))
-          (bfc/get-resolved-file-libraries cfg file))
+  (let [should-resolve-libs?
+        (and (or (contains? cf/flags :file-validation)
+                 (contains? cf/flags :soft-file-validation))
+             (not skip-validate))
+
+        tlibs
+        (ct/tpoint)
+
+        libs
+        (try
+          (when should-resolve-libs?
+            (bfc/get-resolved-file-libraries cfg file))
+          (finally
+            (when should-resolve-libs?
+              (record-validation-timing cfg :resolve-libs-ms "resolve-libs" (inst-ms (tlibs))))))
 
         ;; The main purpose of this atom is provide a contextual state
         ;; for the changes subsystem where optionally some hints can
@@ -403,32 +454,56 @@
         state
         (atom {})
 
-        file
-        (binding [cpc/*state* state]
-          (-> (files/check-version! file)
-              (update :revn inc)
-              (update :data cpc/process-changes changes)
-              (update :data d/without-nils)))
+        tproc
+        (ct/tpoint)
 
         file
-        (if-let [media-refs (-> @state :media-refs not-empty)]
-          (bfc/update-media-references! cfg file media-refs)
-          file)]
+        (try
+          (let [file
+                (binding [cpc/*state* state]
+                  (-> (files/check-version! file)
+                      (update :revn inc)
+                      (update :data cpc/process-changes changes)
+                      (update :data d/without-nils)))
+
+                file
+                (if-let [media-refs (-> @state :media-refs not-empty)]
+                  (bfc/update-media-references! cfg file media-refs)
+                  file)]
+            file)
+          (finally
+            (record-validation-timing cfg :process-changes-ms "process-changes" (inst-ms (tproc)))))]
 
     (binding [pmap/*tracked* nil]
       (when (contains? cf/flags :soft-file-validation)
-        (soft-validate-file! file libs changes))
+        (let [t (ct/tpoint)]
+          (try
+            (soft-validate-file! file libs changes)
+            (finally
+              (record-validation-timing cfg :soft-validate-affected-ms "soft-validate-affected" (inst-ms (t)))))))
 
       (when (contains? cf/flags :soft-file-schema-validation)
-        (soft-validate-file-schema! file))
+        (let [t (ct/tpoint)]
+          (try
+            (soft-validate-file-schema! file)
+            (finally
+              (record-validation-timing cfg :soft-validate-schema-ms "soft-validate-schema" (inst-ms (t)))))))
 
       (when (and (contains? cf/flags :file-validation)
                  (not skip-validate))
-        (val/validate-file-affected! file libs changes))
+        (let [t (ct/tpoint)]
+          (try
+            (val/validate-file-affected! file libs changes)
+            (finally
+              (record-validation-timing cfg :validate-affected-ms "validate-affected" (inst-ms (t)))))))
 
       (when (and (contains? cf/flags :file-schema-validation)
                  (not skip-validate))
-        (val/validate-file-schema! file)))
+        (let [t (ct/tpoint)]
+          (try
+            (val/validate-file-schema! file)
+            (finally
+              (record-validation-timing cfg :validate-schema-ms "validate-schema" (inst-ms (t))))))))
 
     file))
 

backend/src/app/scripts/decode_file_data.clj

@@ -0,0 +1,300 @@
+;; 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
+
+(ns app.scripts.decode-file-data
+  "Decode a file's `file_data` binary blob to `jq`-readable JSON.
+
+  The content of `file_data.data` (and `file.data` on the `legacy-db`
+  backend, or the `file-data` object on storage) is not text: it is a blob
+  encoded with `app.util.blob` (versions 1, 3, 4 and 5; transit+json or
+  fressian plus lz4/zstd). That is why it cannot be inspected with SQL
+  directly.
+
+  Two uses:
+
+  1. Offline (no DB, just the blob): dump the `bytea` to a file with
+     `psql` (`\\copy ...` or `encode(data, 'base64')`) and pass it with `--input`.
+     Needs no system and no `file_data` read permissions.
+
+     backend/scripts/decode-file-data --input /tmp/blob.bin --format summary | jq .
+     backend/scripts/decode-file-data --input /tmp/blob.b64 --from-base64 --format pages | jq .
+
+  2. Inside the penpot context (nREPL with the backend running, where
+     `sys/system` already exists): call `get-file-json` or `get-snapshot-json`.
+     They resolve the backend (`legacy-db`, `db`, `storage`), realize the
+     pointer-maps and objects-maps and return JSON.
+
+     (require '[app.scripts.decode-file-data :as dfd] :reload)
+     (spit \"/tmp/maquette.json\"
+       (dfd/get-file-json sys/system #uuid \"9e056cfe-f83f-81f8-8008-cc885732f00d\"
+                      :format :full))
+     (spit \"/tmp/snap-518.json\"
+       (dfd/get-snapshot-json sys/system #uuid \"9e056cfe-f83f-81f8-8008-cc885732f00d\"
+                          #uuid \"<snapshot-id>\" :format :summary))
+
+  Then filter with `jq`: `.pages`, `.data[\"pages-index\"] | keys`,
+  `[.data[\"pages-index\"][] | {id, name}]`, etc."
+  (:require
+   [app.binfile.common :as bfc]
+   [app.common.json :as json]
+   [app.db :as db]
+   [app.features.file-snapshots :as fsnap]
+   [app.util.blob :as blob]
+   [app.util.objects-map :as omap-legacy]
+   [app.util.pointer-map :as pmap]
+   [clojure.java.io :as io]
+   [clojure.string :as str])
+  (:import
+   java.util.Base64))
+
+(set! *warn-on-reflection* true)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; JSON sanitization
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- sanitize-key
+  [k]
+  (cond
+    (keyword? k) (subs (str k) 1)
+    (symbol? k)  (str k)
+    (uuid? k)    (str k)
+    :else        (str k)))
+
+(declare sanitize)
+
+(defn- sanitize-map
+  [m]
+  (persistent!
+   (reduce-kv (fn [acc k v]
+                (assoc! acc (sanitize-key k) (sanitize v)))
+              (transient {})
+              m)))
+
+(defn sanitize
+  "Convert a blob-decoded value to plain JSON-ready data.
+
+  - Unrealized pointers become `{\"$pointer\": \"<uuid>\"}`.
+  - `objects-map` instances are materialized to a plain map.
+  - Bytes become `{\"$bytes\": \"<base64>\"}`.
+  - UUIDs, instants, keywords and symbols become strings."
+  [x]
+  (cond
+    (nil? x)     nil
+    (string? x)  x
+    (boolean? x) x
+
+    (number? x)
+    (if (ratio? x) (double x) x)
+
+    (keyword? x) (subs (str x) 1)
+    (symbol? x)  (str x)
+    (uuid? x)    (str x)
+    (inst? x)    (str x)
+
+    (bytes? x)
+    {"$bytes" (.encodeToString (Base64/getEncoder) ^bytes x)}
+
+    (pmap/pointer-map? x)
+    {"$pointer" (str (pmap/get-id x))}
+
+    (omap-legacy/objects-map? x)
+    (sanitize (into {} x))
+
+    (map? x)
+    (sanitize-map x)
+
+    (set? x)
+    (mapv sanitize x)
+
+    (coll? x)
+    (mapv sanitize x)
+
+    :else
+    (str x)))
+
+(defn data->json
+  "Encode sanitizable data to a JSON string."
+  [data]
+  (json/encode (sanitize data)))
+
+(defn blob->json
+  "Decode a `file_data` blob (`app.util.blob`) and return it as JSON."
+  [^bytes blob-bytes]
+  (data->json (blob/decode blob-bytes)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; jq-oriented investigation summary
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn summarize-data
+  "Small, stable summary for `jq`: pages (in `:pages` order) with object
+  counts, plus component, color and typography counters. Takes the already
+  decoded `:data` (not the JSON)."
+  [data]
+  (let [pages       (:pages data)
+        pages-index (:pages-index data)
+        page-entry  (fn [pid]
+                      {:id      (str pid)
+                       :name    (get-in pages-index [pid :name])
+                       :objects (count (get-in pages-index [pid :objects]))})]
+    {:pages (mapv page-entry (or pages []))
+     :stats {:pages        (count (or pages []))
+             :components   (count (:components data))
+             :colors       (count (:colors data))
+             :typographies (count (:typographies data))}}))
+
+(defn file-data-summary-json
+  [data]
+  (data->json (summarize-data data)))
+
+(defn file-data-pages-json
+  [data]
+  (data->json (:pages (summarize-data data))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; DB access (for use from nREPL with the backend running)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- write-output
+  [^String payload output]
+  (if output
+    (do (spit output payload) output)
+    (print payload))
+  payload)
+
+(defn get-file-json
+  "Return a file as JSON (realized). For nREPL.
+
+  `format` can be `:full` (whole file), `:data` (`:data` only),
+  `:summary` or `:pages`. With `:output` it also writes it to a file."
+  [system file-id & {:keys [format output] :or {format :full}}]
+  (let [file (db/run! system bfc/get-file file-id :realize? true)
+        data (case format
+               :full    file
+               :data    (:data file)
+               :summary (summarize-data (:data file))
+               :pages   (:pages (summarize-data (:data file))))]
+    (write-output (data->json data) output)))
+
+(defn get-snapshot-json
+  "Return a snapshot as JSON (realized). For nREPL.
+
+  Takes the same `format` and `output` as `get-file-json`."
+  [system file-id snapshot-id & {:keys [format output] :or {format :full}}]
+  (let [snapshot (db/run! system
+                          (fn [cfg]
+                            (fsnap/get-snapshot cfg file-id snapshot-id)))
+        data   (case format
+                 :full    snapshot
+                 :data    (:data snapshot)
+                 :summary (summarize-data (:data snapshot))
+                 :pages   (:pages (summarize-data (:data snapshot))))]
+    (write-output (data->json data) output)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Offline CLI: decode a file holding the blob
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def ^:private cli-usage
+  (str "Usage: decode-file-data --input PATH [--output PATH] [--format full|data|summary|pages]\n"
+       "                       [--from-base64|--from-hex]\n"
+       "\n"
+       "Decode a file_data blob (app.util.blob) to JSON for inspection with jq.\n"
+       "\n"
+       "Examples:\n"
+       "  psql -c \"\\\\copy (select data from file_data where file_id='...' and id='...') to '/tmp/blob.bin' with binary\"\n"
+       "  decode-file-data --input /tmp/blob.bin --format summary | jq .\n"
+       "  decode-file-data --input /tmp/blob.b64 --from-base64 --format pages | jq .\n"))
+
+(defn- parse-args
+  [args]
+  (loop [args args
+         opts {:format "full"}]
+    (if (empty? args)
+      opts
+      (let [[a b & rest-args] args]
+        (cond
+          (contains? #{"-h" "--help"} a)
+          (assoc opts :help true)
+
+          (= a "--input")
+          (recur rest-args (assoc opts :input b))
+
+          (= a "--output")
+          (recur rest-args (assoc opts :output b))
+
+          (= a "--format")
+          (recur rest-args (assoc opts :format b))
+
+          (= a "--from-base64")
+          (recur (cons b rest-args) (assoc opts :from :base64))
+
+          (= a "--from-hex")
+          (recur (cons b rest-args) (assoc opts :from :hex))
+
+          :else
+          (assoc opts :error (str "unknown argument: " a)))))))
+
+(defn- hex->bytes
+  [^String s]
+  (let [s   (str/trim s)
+        s   (cond
+              (str/starts-with? s "\\x") (subs s 2)
+              (str/starts-with? s "0x") (subs s 2)
+              :else s)
+        s   (str/replace s #"\s+" "")
+        n   (/ (count s) 2)
+        out (byte-array n)]
+    (dotimes [i n]
+      (aset-byte out i (unchecked-byte (Integer/parseInt (subs s (* i 2) (+ (* i 2) 2)) 16))))
+    out))
+
+(defn- read-input-bytes
+  [{:keys [input from]}]
+  (cond
+    (nil? input)
+    (throw (ex-info "missing --input" {}))
+
+    (= from :base64)
+    (.decode (Base64/getDecoder) ^String (str/trim (slurp (io/file input))))
+
+    (= from :hex)
+    (hex->bytes (slurp (io/file input)))
+
+    :else
+    (java.nio.file.Files/readAllBytes (.toPath (io/file input)))))
+
+(defn -main
+  [& args]
+  (let [{:keys [help error input format output] :as opts} (parse-args (vec args))]
+    (cond
+      help
+      (do (print cli-usage) nil)
+
+      error
+      (do (binding [*out* *err*] (println error) (println cli-usage)) (System/exit 2))
+
+      (nil? input)
+      (do (binding [*out* *err*] (println "missing --input") (println cli-usage)) (System/exit 2))
+
+      (not (contains? #{"full" "data" "summary" "pages"} (or format "full")))
+      (do (binding [*out* *err*] (println (str "unknown format: " format))) (System/exit 2))
+
+      :else
+      (let [blob-bytes (read-input-bytes opts)
+            decoded    (blob/decode blob-bytes)
+            payload    (case format
+                         "full"    decoded
+                         "data"    (:data decoded (:data decoded decoded))
+                         "summary" (summarize-data (:data decoded decoded))
+                         "pages"   (:pages (summarize-data (:data decoded decoded))))
+            ;; NOTE: the file_data blob already IS the file's :data; but if
+            ;; someone dumps the whole serialized row, tolerate both.
+            out        (data->json payload)]
+        (if output
+          (spit output out)
+          (println out))))))

backend/test/backend_tests/climit_test.clj

@@ -661,7 +661,11 @@
       (record-metrics
        (fn []
          (#'climit/republish-waiting (th/metrics-stub) (:counters climit))
-         (t/is (= [3] (waiting-value-of name))))))))
+         ;; The value is the contract, not the publication count: the
+         ;; sampler thread started with the component runs its first
+         ;; tick asynchronously, and when it lands inside this window
+         ;; it publishes the same count a second time.
+         (t/is (= 3 (waiting-last name))))))))
 
 (t/deftest halting-the-component-stops-the-republisher
   ;; The republisher is a daemon thread started with the component: halting it

backend/test/backend_tests/files_update_validation_timing_test.clj

@@ -0,0 +1,128 @@
+;; 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.files-update-validation-timing-test
+  (:require
+   [app.binfile.common :as bfc]
+   [app.common.files.validate :as val]
+   [app.common.uuid :as uuid]
+   [app.config :as cf]
+   [app.main :as main]
+   [app.metrics :as mtx]
+   [app.metrics.definition :as-alias mdef]
+   [app.rpc.commands.files-update :as files-update]
+   [clojure.test :as t]
+   [integrant.core :as ig])
+  (:import
+   io.prometheus.client.CollectorRegistry))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Helpers
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- bucket-value
+  [metrics mname label-names label-values le]
+  (.getSampleValue ^CollectorRegistry (mtx/get-registry metrics)
+                   (str mname "_bucket")
+                   (into-array String (conj (vec label-names) "le"))
+                   (into-array String (conj (vec label-values) le))))
+
+(defn- test-file
+  []
+  {:id (uuid/next)
+   :revn 0
+   :version 0
+   :data {}})
+
+(defn- test-cfg
+  [metrics]
+  {::mtx/metrics metrics
+   ::files-update/validation-timings (atom {})})
+
+(def ^:private all-flags
+  #{:file-validation
+    :file-schema-validation
+    :soft-file-validation
+    :soft-file-schema-validation})
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Tests
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(t/deftest validation-timing-metric-uses-request-buckets
+  (t/is (= mtx/default-request-histogram-buckets
+           (get-in main/default-metrics [:update-file-validation-timing ::mdef/buckets])))
+  (t/is (= "penpot_rpc_update_file_validation_timing"
+           (get-in main/default-metrics [:update-file-validation-timing ::mdef/name]))))
+
+(t/deftest process-changes-and-validate-records-all-steps
+  (let [metrics (ig/init-key :app.metrics/metrics {:default main/default-metrics})
+        cfg (test-cfg metrics)]
+    (binding [cf/flags all-flags]
+      (with-redefs [bfc/get-resolved-file-libraries (fn [_ _] {})
+                    val/validate-file-affected! (fn [_ _ _] nil)
+                    val/validate-file-schema! (fn [_] nil)]
+        (let [file (@#'files-update/process-changes-and-validate cfg (test-file) [] nil)
+              timings @(::files-update/validation-timings cfg)]
+          (t/is (map? file))
+          (t/is (number? (:resolve-libs-ms timings)))
+          (t/is (number? (:process-changes-ms timings)))
+          (t/is (number? (:soft-validate-affected-ms timings)))
+          (t/is (number? (:soft-validate-schema-ms timings)))
+          (t/is (number? (:validate-affected-ms timings)))
+          (t/is (number? (:validate-schema-ms timings)))
+          (doseq [step ["resolve-libs" "process-changes"
+                        "soft-validate-affected" "soft-validate-schema"
+                        "validate-affected" "validate-schema"]]
+            (t/is (= 1.0 (bucket-value metrics "penpot_rpc_update_file_validation_timing"
+                                       ["step"] [step] "60000.0"))
+                  (str "expected one sample for step " step))))))))
+
+(t/deftest process-changes-and-validate-skips-when-skip-validate
+  (let [metrics (ig/init-key :app.metrics/metrics {:default main/default-metrics})
+        cfg (test-cfg metrics)]
+    (binding [cf/flags all-flags]
+      (with-redefs [bfc/get-resolved-file-libraries (fn [_ _]
+                                                      (throw (ex-info "must not resolve libs" {})))
+                    val/validate-file-affected! (fn [_ _ _]
+                                                  (throw (ex-info "must not validate" {})))
+                    val/validate-file-schema! (fn [_]
+                                                (throw (ex-info "must not validate schema" {})))]
+        ;; soft validations still run: they only check flags, not skip-validate
+        (let [file (@#'files-update/process-changes-and-validate cfg (test-file) [] true)
+              timings @(::files-update/validation-timings cfg)]
+          (t/is (map? file))
+          (t/is (nil? (:resolve-libs-ms timings)))
+          (t/is (number? (:process-changes-ms timings)))
+          (t/is (number? (:soft-validate-affected-ms timings)))
+          (t/is (number? (:soft-validate-schema-ms timings)))
+          (t/is (nil? (:validate-affected-ms timings)))
+          (t/is (nil? (:validate-schema-ms timings)))
+          (t/is (= 1.0 (bucket-value metrics "penpot_rpc_update_file_validation_timing"
+                                     ["step"] ["process-changes"] "60000.0"))))))))
+
+(t/deftest process-changes-and-validate-records-timing-on-error
+  (let [metrics (ig/init-key :app.metrics/metrics {:default main/default-metrics})
+        cfg (test-cfg metrics)]
+    (binding [cf/flags all-flags]
+      (with-redefs [bfc/get-resolved-file-libraries (fn [_ _] {})
+                    val/validate-file-affected! (fn [_ _ _]
+                                                  (throw (ex-info "bad file" {:code :referential-integrity})))
+                    val/validate-file-schema! (fn [_] nil)]
+        (let [timings-atom (::files-update/validation-timings cfg)]
+          (t/is (thrown? clojure.lang.ExceptionInfo
+                         (@#'files-update/process-changes-and-validate cfg (test-file) [] nil)))
+          ;; the failing step still recorded its timing via finally
+          (t/is (number? (:validate-affected-ms @timings-atom)))
+          (t/is (number? (:resolve-libs-ms @timings-atom)))
+          (t/is (number? (:process-changes-ms @timings-atom))))))))
+
+(t/deftest record-validation-timing-tolerates-missing-collaborators
+  ;; production code must not blow up when called without metrics
+  ;; (e.g. scripts) or without the timings collector.
+  (let [record @#'files-update/record-validation-timing]
+    (t/is (nil? (record {} :resolve-libs-ms "resolve-libs" 12)))
+    (t/is (nil? (record {::mtx/metrics nil} :resolve-libs-ms "resolve-libs" 12)))))

backend/test/backend_tests/metrics_test.clj

@@ -6,13 +6,16 @@
 
 (ns backend-tests.metrics-test
   (:require
+   [app.main :as main]
    [app.metrics :as mtx]
+   [app.metrics.definition :as-alias mdef]
    [clojure.test :as t]
    [integrant.core :as ig]
    [promesa.exec :as px])
   (:import
    io.prometheus.client.Collector$MetricFamilySamples
    io.prometheus.client.Collector$MetricFamilySamples$Sample
+   io.prometheus.client.CollectorRegistry
    java.util.concurrent.ScheduledThreadPoolExecutor))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -74,3 +77,72 @@
 
       (finally
         (px/shutdown-now sampler)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; HISTOGRAM BUCKETS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(t/deftest histogram-bucket-tails-extend-past-7-5s
+  ;; The sub-7.5s prefix stays identical, so p50/p90 resolution and the
+  ;; history remain comparable; only the tail grows, per latency profile.
+  (t/is (= mtx/default-histogram-buckets
+           (subvec mtx/default-request-histogram-buckets 0 14)))
+  (t/is (= mtx/default-histogram-buckets
+           (subvec mtx/default-tasks-histogram-buckets 0 14)))
+  (t/is (= mtx/default-histogram-buckets
+           (subvec mtx/default-redis-histogram-buckets 0 14)))
+
+  (t/is (= [10000 15000 30000 60000]
+           (subvec mtx/default-request-histogram-buckets 14)))
+  (t/is (= [10000 15000 30000 60000 120000 300000]
+           (subvec mtx/default-tasks-histogram-buckets 14)))
+  (t/is (= [10000]
+           (subvec mtx/default-redis-histogram-buckets 14))))
+
+(t/deftest default-metrics-wire-bucket-tails-per-profile
+  ;; Requests and waits cover the 30s/60s CLIMIT timeouts, tasks run
+  ;; until done (300s postgres statement timeout), Redis only needs the
+  ;; pathological case covered.
+  (doseq [id [:rpc-main-timing :rpc-management-timing :rpc-climit-timing
+              :audit-http-handler-timing :http-server-dispatch-timing
+              :update-file-validation-timing]]
+    (t/is (= mtx/default-request-histogram-buckets
+             (get-in main/default-metrics [id ::mdef/buckets]))
+          (str "request buckets on " id)))
+  (t/is (= mtx/default-tasks-histogram-buckets
+           (get-in main/default-metrics [:tasks-timing ::mdef/buckets])))
+  (t/is (= mtx/default-redis-histogram-buckets
+           (get-in main/default-metrics [:redis-eval-timing ::mdef/buckets]))))
+
+(defn- bucket-value
+  "Cumulative count of the `le` bucket of a histogram, read from the
+  registry. Nil when that boundary does not exist."
+  [metrics mname label-names label-values le]
+  (.getSampleValue ^CollectorRegistry (mtx/get-registry metrics)
+                   (str mname "_bucket")
+                   (into-array String (conj (vec label-names) "le"))
+                   (into-array String (conj (vec label-values) le))))
+
+(t/deftest histogram-tails-are-registered
+  ;; A 9s observation must land in the new tail instead of piling up in
+  ;; +Inf: every histogram used to stop at 7500.
+  (let [metrics (ig/init-key :app.metrics/metrics {:default main/default-metrics})]
+    (mtx/run! metrics :id :rpc-main-timing :val 9000 :labels (into-array String ["update-file"]))
+    (t/is (= 0.0 (bucket-value metrics "penpot_rpc_main_timing" ["name"] ["update-file"] "7500.0")))
+    (t/is (= 1.0 (bucket-value metrics "penpot_rpc_main_timing" ["name"] ["update-file"] "10000.0")))
+    (t/is (nil? (bucket-value metrics "penpot_rpc_main_timing" ["name"] ["update-file"] "120000.0")))
+
+    (mtx/run! metrics :id :tasks-timing :val 200000 :labels (into-array String ["file-gc"]))
+    (t/is (= 0.0 (bucket-value metrics "penpot_tasks_timing" ["name"] ["file-gc"] "60000.0")))
+    (t/is (= 1.0 (bucket-value metrics "penpot_tasks_timing" ["name"] ["file-gc"] "300000.0")))
+
+    (mtx/run! metrics :id :redis-eval-timing :val 9000 :labels (into-array String ["claim"]))
+    (t/is (= 1.0 (bucket-value metrics "penpot_redis_eval_timing" ["name"] ["claim"] "10000.0")))
+    (t/is (nil? (bucket-value metrics "penpot_redis_eval_timing" ["name"] ["claim"] "15000.0")))
+
+    (mtx/run! metrics :id :http-server-dispatch-timing :val 45000)
+    (t/is (= 1.0 (bucket-value metrics "penpot_http_server_dispatch_timing" [] [] "60000.0")))
+
+    (mtx/run! metrics :id :update-file-validation-timing :val 9000 :labels (into-array String ["validate-affected"]))
+    (t/is (= 0.0 (bucket-value metrics "penpot_rpc_update_file_validation_timing" ["step"] ["validate-affected"] "7500.0")))
+    (t/is (= 1.0 (bucket-value metrics "penpot_rpc_update_file_validation_timing" ["step"] ["validate-affected"] "10000.0")))))

backend/test/backend_tests/scripts_decode_file_data_test.clj

@@ -0,0 +1,82 @@
+;; 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
+
+(ns backend-tests.scripts-decode-file-data-test
+  (:require
+   [app.common.json :as json]
+   [app.common.uuid :as uuid]
+   [app.scripts.decode-file-data :as dfd]
+   [app.util.blob :as blob]
+   [clojure.java.io :as io]
+   [clojure.test :as t])
+  (:import
+   java.util.Base64))
+
+(defn- sample-file-data
+  []
+  (let [p1 (uuid/next)
+        p2 (uuid/next)]
+    {:pages [p1 p2]
+     :pages-index
+     {p1 {:id p1 :name "Accueil1" :objects {:a 1 :b 2}}
+      p2 {:id p2 :name "Contact" :objects {:c 3}}}
+     :components {(uuid/next) {:name "comp"}}
+     :colors {(uuid/next) {:name "red"}}
+     :typographies {}}))
+
+(t/deftest sanitize-converts-special-types
+  (let [id (uuid/next)
+        out (dfd/sanitize {:id id
+                           :kw :pages-index
+                           :when (java.util.Date. 0)
+                           :tags #{:a :b}
+                           :raw (.getBytes "hi" "UTF-8")})]
+    (t/is (= (str id) (get out "id")))
+    (t/is (= "pages-index" (get out "kw")))
+    (t/is (string? (get out "when")))
+    (t/is (= ["a" "b"] (sort (get out "tags"))))
+    (t/is (= {"$bytes" (.encodeToString (Base64/getEncoder) (.getBytes "hi" "UTF-8"))}
+             (get out "raw")))))
+
+(t/deftest sanitize-keeps-integers-as-integers
+  (t/is (= 2 (dfd/sanitize 2)))
+  (t/is (= 2.5 (dfd/sanitize 2.5))))
+
+(t/deftest blob-roundtrip-all-versions-to-json
+  (doseq [version [1 3 4 5]]
+    (let [data    (sample-file-data)
+          encoded (blob/encode data {:version version})
+          payload (dfd/blob->json encoded)
+          parsed  (json/decode payload)]
+      (t/is (map? parsed) (str "version " version " produces a JSON map"))
+      (t/is (= 2 (count (get parsed "pages"))) (str "version " version " keeps pages")))))
+
+(t/deftest summary-lists-pages-in-order-with-object-counts
+  (let [data    (sample-file-data)
+        summary (dfd/summarize-data data)
+        pages   (:pages summary)]
+    (t/is (= 2 (count pages)))
+    (t/is (= ["Accueil1" "Contact"] (mapv :name pages)))
+    (t/is (= [2 1] (mapv :objects pages)))
+    (t/is (= {:pages 2 :components 1 :colors 1 :typographies 0}
+             (:stats summary)))
+    (let [pages-json (json/decode (dfd/file-data-pages-json data))]
+      (t/is (= ["Accueil1" "Contact"] (mapv #(get % "name") pages-json))))))
+
+(t/deftest cli-decodes-blob-file-to-json
+  (let [data     (sample-file-data)
+        tmp-in   (java.io.File/createTempFile "blob" ".bin")
+        tmp-out  (java.io.File/createTempFile "out" ".json")
+        _        (.deleteOnExit tmp-in)
+        _        (.deleteOnExit tmp-out)
+        _        (with-open [os (io/output-stream tmp-in)]
+                   (.write os ^bytes (blob/encode data {:version 5})))
+        _        (dfd/-main "--input" (.getAbsolutePath tmp-in)
+                            "--output" (.getAbsolutePath tmp-out)
+                            "--format" "summary")
+        parsed   (json/decode (slurp tmp-out))]
+    (t/is (== 2 (get-in parsed ["stats" "pages"])))
+    (t/is (= ["Accueil1" "Contact"] (mapv #(get % "name") (get parsed "pages"))))))