diff --git a/.serena/memories/backend/storage.md b/.serena/memories/backend/storage.md index 529fcd1cc8..88ff09e6c4 100644 --- a/.serena/memories/backend/storage.md +++ b/.serena/memories/backend/storage.md @@ -30,6 +30,7 @@ - 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. +- Background bulk writers (e.g. file-gc) intentionally resolve storage without `::db/reuse-conn`: `put-object!` commits in its own transaction and a rolled-back run leaves at most an unreferenced row, which deduplication reuses and storage GC reaps. Joining the main transaction would risk the opposite leak (backend content with no row). ## GC Cost Model diff --git a/.serena/memories/backend/subtleties.md b/.serena/memories/backend/subtleties.md index 1099b99374..e59e7de48c 100644 --- a/.serena/memories/backend/subtleties.md +++ b/.serena/memories/backend/subtleties.md @@ -44,6 +44,8 @@ - `job_event` is append-only and deleted by cascade with the job. `progress` is a row there, not a column: no Redis and no mutable column to keep in sync. - `job` is deletion-protected at the SQL level (`deletion_protection__tgr`): a stray `DELETE FROM job` raises instead of dropping the row and its `job_event` cascade without touching the referenced `storage_object`. The only intended deleters, the jobs GC and the submit dedupe, disable the guard with `SET LOCAL rules.deletion_protection TO off` inside their transaction; tests use `th/db-force-delete`. - A missing job-def raises (`:no-job-definition`) instead of completing. Throwing with `ex-data :type ::retry` still controls retry behavior; `:strategy ::noop` retries without incrementing retry count. +- The file-gc handler reports a result map `{:cleaned :file-id :reason}` with `:cleaned`, `:gone`, `:stale-revn` (changed or locked since the read), `:unfixable` (data failures: `:validation`/`:data-validation` ex-data; anything raising `:repair-did-not-converge` — a file that is still invalid after repair: the repair loop returns the input unchanged when it cannot converge, and a partial cleanup must never be stored as clean) or `:error` (anything else). A run that changes bytes touches `modified-at` (invalidating the file ETag) without bumping `revn`, and always marks `has-media-trimmed`; neither failure marks the file, so the scheduler retries it. +- The file-gc run has three phases and only the last one writes: the read, the repair and the library-user scan run outside any write transaction (the scan loads every user file and used to trip the idle-in-transaction timeout), and the write phase takes the row lock (`FOR UPDATE SKIP LOCKED`) and checks the revision under it. The read keeps the pages unrealized so they keep their fragment ids, and realizes them right away because the schema decode and the repair loop cannot walk unresolved pointers; the pointer layout is captured before the realization and `reattach-unchanged` puts the original fragments back wherever nothing changed, so an untouched page is not written again. - Cron entries claim their `scheduled_task` row with `FOR UPDATE SKIP LOCKED`, disable statement/idle-in-transaction timeouts locally, submit one `job` row per entry when no active instance exists (no-overlap), and reschedule themselves in `finally` unless interrupted. Worker, dispatcher, and cron components do not start when the DB pool is read-only. - Integrant params schemas name injected components as bare `::ns/key` entries (pool, metrics, msgbus, job defs), and a bare entry is a malli registry lookup, not `any?`: the owning namespace must `sm/register!` it at load, or the backend crashes at boot with `:malli.core/invalid-schema` instead of asserting. Unit tests never build those keys, so `backend-tests.worker-test` compiles the three worker schemas to catch it. @@ -100,6 +102,9 @@ - `fdata/load-pointer` reads rows that a previous `file-gc` pass marked on purpose (explicit `::db/remove-deleted false`): the fragment is only gone once `objects-gc` purges it. The `get-file-fragment` RPC keeps rejecting marked rows. - Bind the fragment loader through `fdata/with-pointers` (reads), `fdata/with-tracked-pointers` (writes with a loader) or `fdata/with-tracked` (writes with nothing to load yet, e.g. file creation), and `fdata/with-untracked` (validation passes that must track nothing) instead of hand-rolled `binding` forms; `file-snapshots/reduce-snapshots` already binds its loader while walking snapshot content. - `fdata/realize` combines pointer realization and object-map realization. Use it before operations that need complete in-memory file data instead of pointer placeholders. +- Realize pointers BEFORE sanitizing/decoding: a schema decode over data holding unresolved PointerMap values throws `UnsupportedOperationException` on first touch (`valAt` without a bound `*load-fn*`). `app.features.fdata/realize-pointers` takes `[cfg file]` (cfg first): it cannot be threaded with `->` from call sites that already hold the file map — the reverse threading returned the Integrant system map as the "loaded library" in `get-resolved-file-libraries`. +- The libraries weak map (`app.common.weak/loadable-weak-value-map`, used by `binfile.common/get-resolved-file-libraries`) pre-registers every key at construction; `valAt` calls `load-fn` only for a registered key whose soft reference is gone, so a missing key returns nil silently with no load attempt. `contains?` checks membership without loading; anything that reads a value loads lazily and caches it in a soft reference. +- `ctf/sanitize-file-data` walks and decodes the whole data on every call — that walk is the unavoidable cost. When the nil-entry drop and the schema decode change nothing, it returns the input instance as is: lazy containers (objects-map) keep their identity, and callers detect a real fix by comparing with the input (file-gc keeps the pre-sanitize `:data` around as `:orig-data` for exactly that). - A `file_data` row is one of three classes, told apart by `type`: `main` is the file's current state and carries `id = file_id`; `snapshot` is a point-in-time copy whose `id` is the one its `file_change` row shares; `fragment` is a piece of the pointer-map, referenced from the file's data. - Their lifecycles differ: `main` and `snapshot` live with the file (dated when it is deleted, undated when it is restored), while a `fragment` carries no date and is collected by `file_gc` once the file stops referencing it. Neither is a session buffer, so do not read a `fragment` as an ephemeral revision. - File snapshots (versions) keep their metadata row in `file_change` and their payload in `file_data` (`type = 'snapshot'`). With the `db` backend `file_change.data` stays NULL: that column is only written by the `legacy-db` backend, plus the rows written before the 2025-07 file storage refactor. diff --git a/.serena/memories/common/component-data-model.md b/.serena/memories/common/component-data-model.md index ef3343797c..092545b3a1 100644 --- a/.serena/memories/common/component-data-model.md +++ b/.serena/memories/common/component-data-model.md @@ -5,7 +5,7 @@ A shape can occupy multiple roles at once: 1. Master/main instance: defines a component and has `:main-instance true` plus `:component-id`. -2. Copy/non-main instance: produced by instantiating a component and carries `:shape-ref` pointing at the master shape. `(ctk/in-component-copy? shape)` is essentially `(some? (:shape-ref shape))`. +2. Copy/non-main instance: produced by instantiating a component and carries `:shape-ref` pointing at the master shape. `(ctk/in-component-copy? shape)` is essentially `(some? (:shape-ref shape))`. A copy that lost its `:shape-ref` is corruption, but `check-component-ref` deliberately ignores ref-less shapes (otherwise repair crashes on the `get-shape` precondition); the dedicated repair is tracked in penpot/penpot#12509. 3. Component root: topmost shape of an instance, marked `:component-root true` and carrying surface attrs such as `:component-id` and `:component-file`. Variant masters are main instances and component roots. Their descendants may themselves be component copies, so master/copy logic must handle nested instances rather than assuming those roles are exclusive. diff --git a/.serena/memories/common/file-change-validation-migration-subtleties.md b/.serena/memories/common/file-change-validation-migration-subtleties.md index d013415730..267c930177 100644 --- a/.serena/memories/common/file-change-validation-migration-subtleties.md +++ b/.serena/memories/common/file-change-validation-migration-subtleties.md @@ -21,7 +21,11 @@ - Full referential/semantic validation currently runs only when file features contain `"components/v2"`. - Validation starts at root plus orphan shapes, then validates component records. `validate-file!` raises `:validation :referential-integrity` with collected details. - `repair-file` does not mutate data directly; it reduces validation errors into redo changes using `changes-builder`. Callers must apply or persist those changes. +- `cfr/repair-loop` is the shared best-effort loop (file-gc, debug endpoint, srepl): validate, apply computed repair changes and repeat up to 10 times (`nil` counts as default). It never touches `revn`; when it throws (including `AssertionError` on JVM) or does not converge, it returns the input file untouched and the caller decides via a schema check. +- `check-component-ref` deliberately ignores shapes without `:shape-ref` (otherwise repair crashes on the `get-shape` precondition instead of converging). A copy root that genuinely lost its ref is therefore neither reported nor repaired; the dedicated `repair-error` is tracked in penpot/penpot#12509. - `:missing-slot` fires only for a REAL swap: a copy sub-head whose `shape-ref` is no longer a child of the near main parent. A pure positional mismatch (ref still a sibling elsewhere) is a reorder — valid, realigned by the async component sync; do not "repair" it by assigning swap slots (a slot freezes the child out of normal sync). `fix-missing-swap-slots` (migration 0019) follows the same membership rule. +- `ctf/sanitize-file-data` decodes file data with the schema plus the legacy-57 nil-page cleanup; it is total and idempotent (unknown values pass through so real corruption still fails loudly). It runs on GC/debug/srepl/library reads, never as a substitute for `repair-loop`. +- file-gc never bumps `revn`: when the persisted snapshot differs from the decoded pre-sanitize data it touches `modified-at` (invalidating the file ETag) and always marks `has-media-trimmed`, so thumbnails keep matching the stored revision. ## Migrations @@ -29,4 +33,5 @@ - Migrations are an ordered set mixing legacy version-derived ids and newer named ids. Keep append order stable; `migrate` applies the set difference between available migrations and file migrations. - `migrate-file` synthesizes legacy migration ids from old numeric versions when `:migrations` is absent, migrates legacy features, and records feature flags created through `cfeat/*new*`. - When a file had no previous `:migrations`, `migrate-file` marks all migrations as migrated in metadata so callers persist the complete migration set, not only transformations that changed data. -- Closed schemas (`schema:stroke-attrs` and others) reject a key that was dropped from the declaration, so removing a declared attr needs a migration in the same change, for data already written with it. \ No newline at end of file +- Closed schemas (`schema:stroke-attrs` and others) reject a key that was dropped from the declaration, so removing a declared attr needs a migration in the same change, for data already written with it. +- `"0027-repair-unconverted-types-and-nil-pages"` re-applies the legacy-57 nil-page cleanup plus a schema decode, healing unconverted types durably. File-gc calls `fmg/migrate-file` only when `fmg/need-migration?` (same predicate as `bfc/get-file*`); in-memory `sanitize-file-data` always runs first. diff --git a/backend/src/app/binfile/cleaner.clj b/backend/src/app/binfile/cleaner.clj index a7fcd456db..4d68d39c07 100644 --- a/backend/src/app/binfile/cleaner.clj +++ b/backend/src/app/binfile/cleaner.clj @@ -133,6 +133,9 @@ (d/update-when :objects d/update-vals clean-shape-post-decode))) (defn clean-file + "Post-decode shape fixes plus nil cleanup. Does not sanitize: the + single canonical sanitize pass lives in file-gc/get-file, before + migration; this function's only caller is file-gc/repair-file." [file & {:as _opts}] (update file :data (fn [data] diff --git a/backend/src/app/binfile/common.clj b/backend/src/app/binfile/common.clj index 111db69183..9cd2814787 100644 --- a/backend/src/app/binfile/common.clj +++ b/backend/src/app/binfile/common.clj @@ -945,11 +945,27 @@ This still requires at least one library at time to be loaded while access to it is performed, but it improves considerable not having the need of loading all the libraries at the same time." - [{:keys [::db/conn] :as cfg} {:keys [id] :as file}] - (let [library-ids (->> (get-file-libraries conn (:id file)) + [cfg {:keys [id] :as file}] + (let [library-ids (->> (get-file-libraries cfg (:id file)) (map :id) (cons (:id file))) - load-fn #(get-file cfg % :migrate? false)] + ;; Realize pointers on load with each library's own loader + ;; (pointers are file-local): values need no ambient *load-fn* + ;; binding to be dereferenced. The realize pass walks and + ;; materializes pointer content in memory — the accepted + ;; cost, since this load is always in-memory. + ;; Realize BEFORE sanitizing: an unresolved PointerMap throws + ;; on first touch (valAt during the schema decode) because + ;; no *load-fn* is bound around the loader itself, and the + ;; sanitizer needs to walk the decoded data we hand it. + ;; Note: realize-pointers takes [cfg file], so it cannot be + ;; threaded with `->` from here. + ;; Sanitize like the GC read path does: unconverted types + ;; would break ref resolution (and detach copies) downstream, + ;; and this load is always in-memory. + load-fn (fn [id] + (let [file (fdata/realize-pointers cfg (get-file cfg id :migrate? false))] + (update file :data ctf/sanitize-file-data)))] (weak/loadable-weak-value-map library-ids load-fn {id file}))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/backend/src/app/http/debug.clj b/backend/src/app/http/debug.clj index 6995464290..5eb41def71 100644 --- a/backend/src/app/http/debug.clj +++ b/backend/src/app/http/debug.clj @@ -21,6 +21,7 @@ [app.common.pprint :as pp] [app.common.time :as ct] [app.common.transit :as t] + [app.common.types.file :as ctf] [app.common.uuid :as uuid] [app.config :as cf] [app.db :as db] @@ -784,8 +785,13 @@ (db/tx-run! (assoc cfg ::db/rollback true) (fn [cfg] - (let [file (bfc/get-file cfg file-id) - libs (bfc/get-resolved-file-libraries cfg file-id)] + ;; Realize before sanitizing, like the libraries + ;; loader does: an unresolved PointerMap throws on + ;; first touch without a bound *load-fn*. + (let [file (some-> (bfc/get-file cfg file-id :realize? true) + (update :data ctf/sanitize-file-data)) + libs (when file + (bfc/get-resolved-file-libraries cfg file))] (if file (let [errors (cfv/validate-file file libs)] {::yres/status 200 @@ -811,7 +817,14 @@ repair-file (fn [file libs _] - (let [errors (cfv/validate-file file libs)] + ;; Sanitize like the validate endpoint does: the single + ;; pass fixes the production corruption families + ;; (unconverted types, nil page entries) before the + ;; cfr pass decides and heals. The data is already + ;; realized by h/process-file!, so there is no + ;; PointerMap risk here. + (let [file (update file :data ctf/sanitize-file-data) + errors (cfv/validate-file file libs)] (.append output (if (empty? errors) "NO VALIDATION ERRORS FOUND\n" (str "VALIDATION ERRORS FOUND:\n" diff --git a/backend/src/app/srepl/procs/file_repair.clj b/backend/src/app/srepl/procs/file_repair.clj index f863f250cf..4c8dbbc3ce 100644 --- a/backend/src/app/srepl/procs/file_repair.clj +++ b/backend/src/app/srepl/procs/file_repair.clj @@ -6,55 +6,22 @@ (ns app.srepl.procs.file-repair (:require - [app.common.files.changes :as cfc] [app.common.files.repair :as cfr] - [app.common.files.validate :as cfv] - [app.common.logging :as l])) + [app.common.types.file :as ctf])) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; GENERAL PURPOSE REPAIR ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn repair-file - "Internal helper for validate and repair the file. The operation is - applied multiple times untile file is fixed or max iteration counter - is reached (default 10). + "Internal helper for validate and repair the file. Sanitizes first + (the shared loop does not) so unconverted types do not choke + validation, then delegates to the shared `cfr/repair-loop` (the + same loop the file-gc task uses), so convergence rules stay in one + place. This function should not be used directly, it is used throught the app.srepl.main/repair-file! helper. In practical terms this function is private and implementation detail." - [file libs & {:keys [max-iterations] :or {max-iterations 10}}] - - (let [validate-and-repair - (fn [file libs iteration] - (when-let [errors (not-empty (cfv/validate-file file libs))] - (l/trc :hint "repairing file" - :file-id (str (:id file)) - :iteration iteration - :errors (count errors)) - (let [changes (cfr/repair-file file libs errors)] - (-> file - (update :revn inc) - (update :data cfc/process-changes changes))))) - - process-file - (fn [file libs] - (loop [file file - iteration 0] - (if (< iteration max-iterations) - (if-let [file (validate-and-repair file libs iteration)] - (recur file (inc iteration)) - file) - (do - (l/wrn :hint "max retry num reached on repairing file" - :file-id (str (:id file)) - :iteration iteration) - file)))) - - file' - (process-file file libs)] - - (when (not= (:revn file) (:revn file')) - (l/trc :hint "file repaired" :file-id (str (:id file)))) - - file')) + [file libs & {:keys [max-iterations]}] + (cfr/repair-loop (update file :data ctf/sanitize-file-data) libs :max-iterations max-iterations)) diff --git a/backend/src/app/tasks/file_gc.clj b/backend/src/app/tasks/file_gc.clj index f23f47b69f..101af6df06 100644 --- a/backend/src/app/tasks/file_gc.clj +++ b/backend/src/app/tasks/file_gc.clj @@ -12,7 +12,10 @@ (:require [app.binfile.cleaner :as bfl] [app.binfile.common :as bfc] + [app.common.exceptions :as ex] [app.common.files.helpers :as cfh] + [app.common.files.migrations :as fmg] + [app.common.files.repair :as cfr] [app.common.files.validate :as cfv] [app.common.logging :as l] [app.common.schema :as sm] @@ -23,15 +26,13 @@ [app.common.types.shape-tree :as ctt] [app.config :as cf] [app.db :as db] + [app.db.sql :as-alias sql] [app.features.fdata :as feat.fdata] [app.features.file-snapshots :as fsnap] [app.jobs :as jobs] [app.loggers.audit :as audit] - [app.storage :as sto] [integrant.core :as ig])) -(declare get-file) - (def ^:private sql:mark-file-media-object-deleted "UPDATE file_media_object SET deleted_at = ? @@ -75,7 +76,7 @@ (jobs/heartbeat cfg) (doseq [id unused-media] (l/trc :obj "media-object" - :file-id (str id) + :file-id (str (:id file)) :id (str id))) ;; The storage-usage consumer learns about this shrink path only @@ -155,27 +156,46 @@ [components library-id {:keys [data]}] (filter #(ctf/used-in? data library-id % :component) components)) -(defn- clean-deleted-components! - "Performs the garbage collection of unreferenced deleted components." - [{:keys [::db/conn] :as cfg} {:keys [data] :as file}] - (let [file-id (:id file) +(defn- get-library-user-ids + "Materialize the rows of the files using this one as a library with + a plain query (no cursor), so no write transaction needs to stay + open while their file data is loaded." + [cfg library-id] + (db/exec! cfg [sql:get-files-for-library library-id])) - deleted-components - (ctkl/deleted-components-seq data) +(defn- find-used-components + "Compute the set of deleted component ids still in use by library + users. Every user file is loaded on its own connection, outside any + write transaction. Skips the scan entirely when there is nothing + deleted to collect." + [cfg file-id deleted-components] + (if (seq deleted-components) + (let [file-xform (mapcat (partial get-used-components deleted-components file-id)) + library-xform (comp + (map :id) + ;; Sanitize on load like the read path does: + ;; instance-of? compares with =, so text ids + ;; would miss real uses and delete live data. + (map #(-> (bfc/get-file cfg % :realize? true :read-only? true) + (update :data ctf/sanitize-file-data))) + file-xform)] + (->> (get-library-user-ids cfg file-id) + (transduce library-xform conj #{}))) + #{})) +(defn- process-deleted-components + "Performs the garbage collection of unreferenced deleted components. + Takes the set of component ids still used by library users and the + deleted components, both computed beforehand outside any write + transaction. The revn guard protects against changes to this file, + but not against a library user starting to use a deleted component + between the scan and the write: that race pre-dates this refactor + and is accepted here." + [used-remote deleted-components {:keys [id] :as file}] + (let [file-id id file-xform (mapcat (partial get-used-components deleted-components file-id)) - library-xform - (comp - (map :id) - (map #(bfc/get-file cfg % :realize? true :read-only? true)) - file-xform) - - used-remote - (->> (db/plan conn [sql:get-files-for-library file-id] {:fetch-size 1}) - (transduce library-xform conj #{})) - used-local (into #{} file-xform [file]) @@ -212,10 +232,10 @@ (defn- clean-fragments! "Mark fragment rows referenced neither by the current main file data - nor by any unpurged snapshot. The file arrives unrealized (see - `get-file`), so `main-used` holds its stored fragment ids; combined - with `reattach-unchanged`, unchanged pages keep their ids and are - never marked. Runs inside the caller transaction, which already + nor by any unpurged snapshot. The file arrives with the original + fragment pointers put back (see `reattach-unchanged`), so `main-used` + holds its stored fragment ids; unchanged pages keep their ids and + are never marked. Runs inside the caller transaction, which already holds FOR UPDATE on the file row." [{:keys [::db/conn ::timestamp] :as cfg} snap-pointers {:keys [id] :as file}] (let [main-used (into #{} xf:collect-pointers [file]) @@ -227,99 +247,246 @@ (jobs/heartbeat cfg) (doseq [id unused] (l/trc :obj "fragment" - :file-id (str id) + :file-id (str (:id file)) :id (str id))) file)) (defn- clean-media! - [cfg {:keys [media]} file] + "Collect the media, the thumbnails and the unreferenced deleted + components of the file. The components still used by library users + and the deleted components are computed beforehand, outside the write + transaction, so the scan does not keep it open." + [cfg {:keys [media]} used-remote deleted-components file] (let [file (->> file - (clean-deleted-components! cfg) + (process-deleted-components used-remote deleted-components) (clean-file-media! cfg media) (clean-file-thumbnails! cfg) (clean-file-object-thumbnails! cfg))] + ;; Write guard: the snapshot about to be persisted must be + ;; schema-valid, no matter what the repair produced. (cfv/validate-file-schema! file) file)) -(defn get-file - [cfg {:keys [file-id revn]}] - ;; NOTE: deliberately NOT realized: `process-file!` binds the fragment - ;; loader and works on PointerMaps directly, so unchanged pages keep - ;; their fragment ids (see `reattach-unchanged`). Realizing here would - ;; force every page to be re-persisted under a new id on every pass. - (let [file (bfc/get-file cfg file-id - :realize? false - :skip-locked? true - :lock-for-update? true)] - - ;; We should ensure that the scheduled file and the procesing file - ;; has not changed since schedule, for this reason we check the - ;; revn from props with the revn from retrieved file from database - (when (or (nil? revn) (= revn (:revn file))) - file))) - -;; FIXME: we should skip files that does not match the revn on the -;; props and add proper schema for this task props - -(defn- process-file! +(defn- get-file + "Plain read of the file: no row lock, no writes. The pages are read + unrealized, so they keep their fragment ids, and realized right away + because the schema decode and the repair loop cannot walk unresolved + pointers. The pointer layout is kept aside so the write phase can put + the original fragments back wherever nothing changed. + Sanitizes first so legacy migrations do not choke on unconverted + types, then migrates in memory and checks the scheduled revn against + the stored one. The check runs before sanitizing and migrating, so a + stale scheduled revn skips that work instead of discarding it. + Returns a map with the migrated file, the (delayed, lazily resolved) + libraries, the original pointer layout and the decoded pre-sanitize + data; nil when the file is gone or the revn does not match." [cfg {:keys [file-id] :as props}] - (if-let [file (get-file cfg props)] - ;; Every fragment load goes through `with-pointers`. Each pointer - ;; instance loads its content once (`loaded?`), and the replacement - ;; instances `clean-file` creates already carry their content, so - ;; the pass reads each fragment once without a separate cache. - (feat.fdata/with-pointers cfg file-id - (let [liveness (collect-snapshot-liveness cfg file-id) - original (feat.fdata/original-pointers (:data file)) - file (->> file - (bfl/clean-file) - (clean-media! cfg liveness) - (feat.fdata/reattach-unchanged original) - (clean-fragments! cfg (:pointers liveness))) - file (assoc file :has-media-trimmed true)] - (bfc/update-file! cfg file) - true)) + (when-let [file (bfc/get-file cfg file-id + :realize? false + :migrate? false + :throw-if-not-exists? false)] + (when (or (nil? (:revn props)) (= (:revn props) (:revn file))) + (let [original (feat.fdata/original-pointers (:data file)) + ;; One connection for the whole realization: the fragment + ;; loader needs one and every page of the file is read + ;; here. No transaction: this phase must not hold a write + ;; open. + data (db/run! cfg (fn [cfg] + (feat.fdata/realize-pointers cfg file-id (:data file)))) + file (assoc file :data data) + libs (delay (bfc/get-resolved-file-libraries cfg file)) + orig-data data + ;; Migrate only when pending: without diff, migrate ends + ;; in a full schema walk plus legacy feature migration. + ;; Sanitize above stays unconditional: validation and + ;; repair need it in memory. + file (cond-> (update file :data ctf/sanitize-file-data) + (fmg/need-migration? file) + (fmg/migrate-file libs))] + {:file file + :original original + :libs libs + :orig-data orig-data})))) +(defn- repair-file + "In-memory repair of a file snapshot: run the semantic repair loop + when validation reports errors and check the schema of the result. + Takes no lock and writes nothing; the write transaction persists + the snapshot later. A file that is still invalid after the repair + (by schema or by semantics) never reaches the write phase: the + schema gate and the no-convergence gate below raise instead, so it + is never marked as cleaned and a human can fix the file by hand. + Returns the repaired file." + [file libs] + ;; Libraries resolve lazily through the weak map; + ;; each one realizes on load with its own loader, + ;; so validation needs no ambient *load-fn*. + (let [file (cfr/repair-loop (bfl/clean-file file) libs)] + ;; Fast-fail gate (kept alongside the write guard in + ;; clean-media!): a file that is still schema-invalid after the + ;; repair never pays the expensive library-user scan. + (cfv/validate-file-schema! file) + ;; No-convergence gate: the repair loop returns the input + ;; unchanged when it cannot make the file clean (see + ;; cfr/repair-loop), so semantic errors may still remain. A file + ;; like that must not be stored as clean: raise with the codes + ;; so the handler classifies the run as :unfixable, the file + ;; stays unmarked and the scheduler retries it later. + ;; Semantic re-validation costs one extra validation pass per + ;; run: accepted in exchange for never persisting a partial + ;; cleanup as clean. + (let [errors (not-empty (cfv/validate-file file libs))] + (when errors + (l/warn :hint "file still invalid after repair" + :file-id (str (:id file)) + :codes (frequencies (mapv :code errors))) + (ex/raise :type :validation + :code :repair-did-not-converge + :hint "file did not converge after repair" + :file-id (:id file) + :details (mapv #(select-keys % [:code :hint]) errors)))) + file)) + +(def ^:private sql:lock-file-revn + "SELECT f.revn FROM file AS f WHERE f.id = ? AND f.deleted_at IS NULL FOR UPDATE OF f SKIP LOCKED") + +(defn- lock-file-revn + "Take the row lock and return the current revn, or nil when the row + is locked elsewhere or gone." + [conn id] + (:revn (db/exec-one! conn [sql:lock-file-revn id]))) + +(defn- process-file + "The write transaction: take the row lock, check nobody modified + the file since it was read, and run the garbage collection on its + snapshot instead of re-reading it. The snapshot arrives already + cleaned from the repair step, so this only collects, marks and + persists. Takes the components still in use by library users and + the deleted components (both as component maps; ids are extracted + inside), both computed beforehand outside any write transaction, + then the repaired file and its data as decoded before sanitize + (:orig-data) to detect a real change: modified-at is only touched + when the persisted snapshot differs, but the trim flag is always + persisted so the scheduler does not retry the file. Never bumps + revn: a new revision here would orphan the current thumbnail row, + which the file list joins on." + [{:keys [::db/conn ::timestamp] :as cfg} + used-remote deleted-components {:keys [id revn] :as file} orig-data original] + (if (= revn (lock-file-revn conn id)) + (let [liveness (collect-snapshot-liveness cfg id) + processed (->> file + (clean-media! cfg liveness used-remote deleted-components)) + ;; Touch modified-at only on real change: a no-op run still + ;; marks the file as trimmed (that is the point of the run) + ;; but must not look like a new version to clients holding + ;; an ETag. + changed? (not (= orig-data (:data processed))) + file (-> processed + (cond-> changed? (assoc :modified-at timestamp)) + (assoc :has-media-trimmed true)) + ;; Put the original fragment pointers back wherever nothing + ;; changed: an untouched page keeps its fragment id and no + ;; new fragment row is written for it. + file (feat.fdata/reattach-unchanged original file) + file (clean-fragments! cfg (:pointers liveness) file)] + (bfc/update-file! cfg file) + true) (do - (l/dbg :hint "skip cleaning, criteria does not match" :file-id (str file-id)) + ;; :stale-revn covers both causes: the file changed since the + ;; read, or the row is locked elsewhere and SKIP LOCKED skipped + ;; it. Either way the scheduler retries the file later. + (l/dbg :hint "skip cleaning, file changed or locked since repair" :file-id (str id)) false))) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; HANDLER -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defn execute-file-gc - "Plain job handler: clean the media/thumbnails/fdata of one file." + "Job handler: heal the file when its stored data does not validate, + then clean the media, the thumbnails and the file data of one file. + The read, the repair and the library-user scan run outside the write + transaction, so a long scan never trips the idle-in-transaction + timeout; only the write itself is transactional. + Returns a result map `{:cleaned :file-id :reason}` (see + `schema:file-gc-result`)." [cfg params] - (try - (-> cfg - (assoc ::db/rollback (:rollback? params)) - (db/tx-run! (fn [{:keys [::db/conn] :as cfg}] - (let [cfg (-> cfg - (update ::sto/storage sto/configure conn) - (assoc ::timestamp (ct/now))) - processed? (process-file! cfg params)] - - (when (and processed? (contains? cf/flags :tiered-file-data-storage)) - ;; Pass only the file id: the offload job ignores - ;; any other file-gc param, and forwarding the whole - ;; map would silently couple the two jobs. - (jobs/submit cfg - {::jobs/name :offload-file-data - ::jobs/params {:file-id (:file-id params)} - ::jobs/priority 10 - ::jobs/delay 1000})) - processed?)))) - (catch Throwable cause - (l/err :hint "error on cleaning file" - :file-id (str (:file-id params)) - :cause cause)))) + (let [cfg (-> cfg + (assoc ::db/rollback (:rollback? params)) + (assoc ::timestamp (ct/now))) + result (try + ;; No write transaction here on purpose: the read, + ;; the repair and the library-user scan must not hold + ;; a transaction open (the scan loads every user file + ;; and used to trip the idle-in-transaction timeout). + (let [{:keys [file libs orig-data original]} (get-file cfg params) + repaired (some-> file (repair-file @libs))] + (if repaired + (let [deleted-components (ctkl/deleted-components-seq (:data repaired)) + used-remote (find-used-components cfg (:id repaired) deleted-components) + cleaned? (db/tx-run! cfg process-file used-remote deleted-components repaired orig-data original)] + {:cleaned cleaned? :file-id (:id file) + :reason (if cleaned? :cleaned :stale-revn)}) + {:cleaned false :file-id (:file-id params) + ;; Existence check only: fetch the identity columns + ;; so a big legacy blob is never read for this + ;; answer (:deleted-at stays so soft-deleted + ;; rows keep filtering out to :gone). + :reason (if (db/get* cfg :file {:id (:file-id params)} + ::sql/columns [:id :deleted-at]) + :stale-revn + :gone)})) + (catch Throwable cause + ;; Data failures (:validation from validate!/report-error, + ;; :data-validation from schema checks like the one in + ;; repair-file) are unfixable; anything else (DB, + ;; storage, asserts) is transient. Neither marks the + ;; file, so the scheduler retries the run later. + (let [edata (ex-data cause) + reason (if (or (= :validation (:type edata)) + (= :data-validation (:code edata))) + :unfixable + :error)] + (l/err :hint "error on cleaning file" + :file-id (str (:file-id params)) + :cause cause) + {:cleaned false :reason reason :file-id (:file-id params)})))] + ;; The offload submit runs outside the result try/catch: a queue + ;; failure after a successful write must not falsify the + ;; cleaning outcome (the file is already marked trimmed, so no + ;; retry would recover the dropped offload either way). + (when (and (:cleaned result) (contains? cf/flags :tiered-file-data-storage)) + (try + (jobs/submit cfg + {::jobs/name :offload-file-data + ;; Pass only the file id: the offload job ignores + ;; any other file-gc param, and forwarding the whole + ;; map would silently couple the two jobs. + ::jobs/params {:file-id (:file-id params)} + ::jobs/priority 10 + ::jobs/delay 1000}) + (catch Throwable cause + (l/err :hint "error submitting file-gc offload" + :file-id (str (:file-id params)) + :cause cause)))) + result)) (def schema:file-gc-params + ;; `:revn` is optional: the write phase re-checks the revision under + ;; the row lock, so a run without it still cleans (and the file is + ;; never marked with a revision the read did not see). [:map [:file-id ::sm/uuid] - [:revn ::sm/int]]) + [:revn {:optional true} ::sm/int]]) + +(def schema:file-gc-result + "The outcome of one file-gc run: whether the file was cleaned, which + file it was and why it was not (when it was not)." + [:map + [:cleaned ::sm/boolean] + [:file-id ::sm/uuid] + [:reason ::sm/keyword]]) (defmethod ig/init-key ::job-def [_ cfg] @@ -329,4 +496,5 @@ (fn [_context params] (execute-file-gc cfg params)) ::jobs/decoder (sm/decoder schema:file-gc-params sm/json-transformer) - ::jobs/validator (sm/validator schema:file-gc-params)}) + ::jobs/validator (sm/validator schema:file-gc-params) + ::jobs/result-schema schema:file-gc-result}) diff --git a/backend/test/backend_tests/file_pointer_snapshot_test.clj b/backend/test/backend_tests/file_pointer_snapshot_test.clj index 5ca42b5d4d..682550dcea 100644 --- a/backend/test/backend_tests/file_pointer_snapshot_test.clj +++ b/backend/test/backend_tests/file_pointer_snapshot_test.clj @@ -132,7 +132,7 @@ orphan (first (remove #(contains? new-ids %) old-ids))] (t/is (some? orphan)) - (t/is (true? (th/run-task! :file-gc {:file-id file-id}))) + (t/is (true? (:cleaned (th/run-task! :file-gc {:file-id file-id})))) ;; The old fragment is still alive because the snapshot needs it. (let [rows (fragment-rows file-id) @@ -180,7 +180,7 @@ orphan (first (remove #(contains? new-ids %) old-ids))] (t/is (some? orphan)) - (t/is (true? (th/run-task! :file-gc {:file-id file-id}))) + (t/is (true? (:cleaned (th/run-task! :file-gc {:file-id file-id})))) (t/is (nil? (:deleted-at (first (filter #(= orphan (:id %)) (fragment-rows file-id)))))) @@ -196,7 +196,7 @@ (th/run-pending-jobs) (t/is (pos? (:processed (th/run-task! :objects-gc {})))) - (t/is (true? (th/run-task! :file-gc {:file-id file-id}))) + (t/is (true? (:cleaned (th/run-task! :file-gc {:file-id file-id})))) (let [row (first (filter #(= orphan (:id %)) (fragment-rows file-id)))] (t/is (some? row)) (t/is (some? (:deleted-at row)))))))) @@ -211,10 +211,10 @@ file-id (:id file) before (live-fragment-ids file-id)] (t/is (pos? (count before))) - (t/is (true? (th/run-task! :file-gc {:file-id file-id}))) + (t/is (true? (:cleaned (th/run-task! :file-gc {:file-id file-id})))) (let [after-first (live-fragment-ids file-id)] (t/is (= before after-first)) - (t/is (true? (th/run-task! :file-gc {:file-id file-id}))) + (t/is (true? (:cleaned (th/run-task! :file-gc {:file-id file-id})))) (t/is (= after-first (live-fragment-ids file-id))) (t/is (every? #(nil? (:deleted-at %)) (fragment-rows file-id)))))) @@ -243,7 +243,7 @@ ;; test performs before asserting GC marking). (th/db-delete! :file-change {:file-id file-id}) (th/db-delete! :file-data {:file-id file-id :type "snapshot"}) - (t/is (true? (th/run-task! :file-gc {:file-id file-id}))) + (t/is (true? (:cleaned (th/run-task! :file-gc {:file-id file-id})))) (let [row (first (filter #(= orphan (:id %)) (fragment-rows file-id)))] (t/is (some? row)) (t/is (some? (:deleted-at row))))))) @@ -319,7 +319,7 @@ ;; Force a pending migration on the next save: drop one applied ;; migration row so `need-migration?` is true again. (th/db-delete! :file-migration {:file-id file-id - :name "0031-migrate-stroke-width-token-attr"}) + :name "0032-migrate-stroke-width-token-attr"}) (update-file! :profile-id (:id profile) :file-id file-id @@ -453,7 +453,7 @@ ;; gc-marks test performs before asserting marking). (th/db-delete! :file-change {:file-id file-id}) (th/db-delete! :file-data {:file-id file-id :type "snapshot"}) - (t/is (true? (th/run-task! :file-gc {:file-id file-id}))) + (t/is (true? (:cleaned (th/run-task! :file-gc {:file-id file-id})))) ;; Unchanged page kept its id through the pass. (let [f3 (bfc/get-file th/*system* file-id) pages-3 (:pages-index (:data f3))] @@ -550,7 +550,7 @@ (t/is (nil? (seq (th/db-query :file-data {:file-id file-id :type "snapshot"})))) (t/is (some? (:data (th/db-get :file-change {:id snap-id} {::db/remove-deleted false}))))) ;; file-gc scans the legacy snapshot without failing... - (t/is (true? (th/run-task! :file-gc {:file-id file-id}))) + (t/is (true? (:cleaned (th/run-task! :file-gc {:file-id file-id})))) ;; ...the live file still resolves fully... (let [live (:data (bfc/get-file th/*system* file-id :realize? true))] (t/is (empty? (fdata/get-used-pointer-ids live)))) @@ -591,7 +591,7 @@ (th/db-query :file-data {:file-id file-id}))))) (th/db-delete! :file-change {:file-id file-id}) (th/db-delete! :file-data {:file-id file-id :type "snapshot"}) - (t/is (true? (th/run-task! :file-gc {:file-id file-id}))) + (t/is (true? (:cleaned (th/run-task! :file-gc {:file-id file-id})))) (let [live (:data (bfc/get-file th/*system* file-id :realize? true))] (t/is (empty? (fdata/get-used-pointer-ids live)))) ;; Every referenced fragment is live. @@ -854,10 +854,10 @@ {:stroke-width "token"}))]) (let [ids-before (page-pointer-ids file-id)] - ;; Force the 0031 migration on the next read. + ;; Force the 0032 migration on the next read. (th/db-delete! :file-migration {:file-id file-id - :name "0031-migrate-stroke-width-token-attr"}) + :name "0032-migrate-stroke-width-token-attr"}) (let [returned (db/tx-run! th/*system* (fn [cfg] (bfc/get-file cfg file-id)))] @@ -898,7 +898,7 @@ (th/db-delete! :file-migration {:file-id file-id - :name "0031-migrate-stroke-width-token-attr"}) + :name "0032-migrate-stroke-width-token-attr"}) (let [ids-before (page-pointer-ids file-id {:migrate? false}) returned (db/tx-run! th/*system* @@ -907,7 +907,7 @@ (t/is (not (pmap/pointer-map? (get-in returned [:data :pages-index page-1])))) (t/is (empty? (th/db-query :file-migration {:file-id file-id - :name "0031-migrate-stroke-width-token-attr"}))) + :name "0032-migrate-stroke-width-token-attr"}))) (t/is (= ids-before (page-pointer-ids file-id {:migrate? false})))) ;; A normal read migrates, and the unchanged page keeps its id. @@ -916,4 +916,4 @@ (t/is (= ids-before (page-pointer-ids file-id))) (t/is (seq (th/db-query :file-migration {:file-id file-id - :name "0031-migrate-stroke-width-token-attr"})))))) + :name "0032-migrate-stroke-width-token-attr"})))))) diff --git a/backend/test/backend_tests/helpers.clj b/backend/test/backend_tests/helpers.clj index ab1bce7a85..f1ec81c5a1 100644 --- a/backend/test/backend_tests/helpers.clj +++ b/backend/test/backend_tests/helpers.clj @@ -779,6 +779,13 @@ [& params] (apply db/get* *pool* params)) +(defn run-file-gc! + "Run the file-gc task the way the scheduler does: props always carry + the current revn, so the read-time freshness check has a baseline." + [file-id] + (run-task! :file-gc {:file-id file-id + :revn (:revn (db-get :file {:id file-id}))})) + (defn sleep [ms-or-duration] (Thread/sleep (inst-ms (ct/duration ms-or-duration)))) diff --git a/backend/test/backend_tests/offload_file_data_test.clj b/backend/test/backend_tests/offload_file_data_test.clj index f4c99c3310..4adc6b1dbe 100644 --- a/backend/test/backend_tests/offload_file_data_test.clj +++ b/backend/test/backend_tests/offload_file_data_test.clj @@ -290,7 +290,7 @@ (t/is (not (contains? cf/flags :tiered-file-data-storage))) (let [profile (th/create-profile* 1) file (create-file 1 profile)] - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))) + (t/is (true? (:cleaned (th/run-task! :file-gc {:file-id (:id file)})))) (th/run-pending-jobs) (t/testing "no offload job was enqueued" (t/is (empty? (th/db-query :job {:name "offload-file-data"})))) @@ -519,7 +519,7 @@ file (create-file 1 profile) before (db-rows (:id file)) stale (inc (or (:revn file) 0))] - (t/is (not (th/run-task! :file-gc {:file-id (:id file) :revn stale}))) + (t/is (false? (:cleaned (th/run-task! :file-gc {:file-id (:id file) :revn stale})))) (th/run-pending-jobs) (t/testing "no offload job was enqueued" (t/is (empty? (th/db-query :job {:name "offload-file-data"})))) diff --git a/backend/test/backend_tests/rpc_file_gc_repair_test.clj b/backend/test/backend_tests/rpc_file_gc_repair_test.clj new file mode 100644 index 0000000000..e4e79a65f6 --- /dev/null +++ b/backend/test/backend_tests/rpc_file_gc_repair_test.clj @@ -0,0 +1,917 @@ +;; This Source Code Form is subject to the terms of the Mozilla Public +;; License, v. 2.0. If a copy of the MPL was not distributed with this +;; file, You can obtain one at http://mozilla.org/MPL/2.0/. +;; +;; Copyright (c) KALEIDOS SUBSIDIARY SL + +(ns backend-tests.rpc-file-gc-repair-test + "Regression tests for file-gc on files whose stored data fails schema + validation (see https://github.com/penpot/penpot/issues/12433)." + (:require + [app.binfile.common :as bfc] + [app.common.features :as cfeat] + [app.common.files.repair :as cfr] + [app.common.files.validate :as cfv] + [app.common.logging :as l] + [app.common.test-helpers.files :as thf] + [app.common.time :as ct] + [app.common.types.components-list :as ctkl] + [app.common.types.shape :as cts] + [app.common.uuid :as uuid] + [app.config :as cf] + [app.db :as db] + [app.jobs :as jobs] + [app.rpc :as-alias rpc] + [app.srepl.procs.file-repair :as procs-repair] + [app.tasks.file-gc :as file-gc] + [backend-tests.helpers :as th] + [clojure.test :as t])) + +(t/use-fixtures :once th/state-init) +(t/use-fixtures :each th/database-reset) + +(defn- wait-for-log + "First captured log record matching pred, waiting up to the + deadline because logging is asynchronous." + [records pred] + (let [deadline (+ (System/currentTimeMillis) 5000)] + (loop [] + (if-let [record (first (filter pred @records))] + record + (when (< (System/currentTimeMillis) deadline) + (Thread/sleep 10) + (recur)))))) + +(defn- error-with-hint + "Log record predicate: an error log with the given hint." + [hint] + (fn [record] + (let [props (:app.common.logging/props record)] + (and (= :error (:app.common.logging/level record)) + (= hint (get props :hint)))))) + +(defn- apply-file-changes + [& {:keys [profile-id file-id changes revn] :or {revn 0}}] + (let [params {::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} + out (th/command! params)] + (t/is (nil? (:error out))) + (:result out))) + +(defn- read-file + [file-id] + (db/run! th/*system* + (fn [cfg] + (bfc/get-file cfg file-id :realize? true)))) + +(defn- persist-file + [file] + (db/tx-run! th/*system* + (fn [cfg] + (bfc/update-file! cfg file)))) + +(defn- repair-file! + "Run the read and repair phases the way the task does: plain read + with the current revn as baseline, then in-memory repair on the + once-resolved libraries." + [file-id] + (let [props {:file-id file-id + :revn (:revn (th/db-get :file {:id file-id}))} + {:keys [file libs]} (#'file-gc/get-file th/*system* props)] + (some-> file + (#'file-gc/repair-file @libs)))) + +(defn- run-process-file! + "Run the write phase alone on a repaired snapshot, mirroring + the handler: timestamp set once, expensive scan outside the write + transaction. Takes the snapshot's pre-sanitize data to decide the + modified-at touch, like the handler does. The default only fits + abort paths (no write happens there): anyone testing the write + passes the pre-change data explicitly. The fragment layout is left + out on purpose: these calls work on an already realized snapshot, + so there is no pointer layout to put back." + [file & [orig-data]] + (let [cfg (assoc th/*system* :app.tasks.file-gc/timestamp (ct/now)) + deleted-components (ctkl/deleted-components-seq (:data file)) + used-remote (#'file-gc/find-used-components cfg (:id file) deleted-components) + orig-data (or orig-data (:data file))] + (db/tx-run! cfg #'file-gc/process-file used-remote deleted-components file orig-data nil))) + +(defn- backdate-modified-at! + "Push a file's modified-at far into the past so a later touch is + deterministic: same-millisecond comparisons would be flaky." + [file-id] + (th/db-update! :file {:modified-at (ct/minus (ct/now) {:days 30})} {:id file-id})) + +(defn- corrupt-with-nil-page + "Mirrors production files where the `:pages` vector holds nil and + `:pages-index` holds a nil key (see legacy-57, already applied on + those files, so the nils came back through a write path)." + [data] + (-> data + (update :pages conj nil) + (assoc-in [:pages-index nil] {:id nil :name "ghost" :objects {}}))) + +(defn- setup-file-with-rect + [profile file] + (let [page-id (first (:pages (:data file))) + shape-id (uuid/next)] + (apply-file-changes + :profile-id (:id profile) + :file-id (:id file) + :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})}]) + (:id file))) + +(defn- instantiate-component + "Adds a copy of the library component to the given file." + [profile file library-id component-id] + (let [page-id (first (:pages (:data file))) + shape-id (uuid/next)] + (apply-file-changes + :profile-id (:id profile) + :file-id (:id file) + :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 "Board" + :frame-id uuid/zero + :parent-id uuid/zero + :type :frame + :main-instance false + :component-root true + :component-file library-id + :component-id component-id})}]) + shape-id)) + +(defn- add-library-component + "Adds a component (with its main instance) to the library file. + Returns the map with the main shape id and the component id." + [profile library component-name] + (let [lib-page-id (first (get-in library [:data :pages])) + shape-id (uuid/next) + component-id (uuid/next)] + (apply-file-changes + :profile-id (:id profile) + :file-id (:id library) + :changes [{:type :add-obj + :page-id lib-page-id + :id shape-id + :parent-id uuid/zero + :frame-id uuid/zero + :components-v2 true + :obj (cts/setup-shape + {:id shape-id + :name "Board" + :frame-id uuid/zero + :parent-id uuid/zero + :type :frame + :main-instance true + :component-root true + :component-file (:id library) + :component-id component-id})} + {:type :add-component + :path "" + :name component-name + :main-instance-id shape-id + :main-instance-page lib-page-id + :id component-id + :anotation nil}]) + {:shape-id shape-id :component-id component-id :page-id lib-page-id})) + +(t/deftest file-gc-cleans-library-used-by-several-files + (let [profile (th/create-profile* 1) + library (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared true}) + users (mapv (fn [i] + (th/create-file* i {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared false})) + [2 3 4]) + _ (doseq [user users] + (th/link-file-to-library* + {:file-id (:id user) + :library-id (:id library)})) + used (add-library-component profile library "Used") + unused (add-library-component profile library "Unused")] + + ;; Only the used component is instantiated in the user files. + (doseq [user users] + (instantiate-component profile user (:id library) (:component-id used))) + + ;; Delete both components (and their mains) from the library. + (doseq [{:keys [component-id page-id shape-id]} [used unused]] + (apply-file-changes + :profile-id (:id profile) + :file-id (:id library) + :changes [{:type :del-component :id component-id} + {:type :del-obj :page-id page-id :id shape-id + :ignore-touched true}])) + + ;; The scan over library users must not hold a write transaction + ;; open (it used to hold a db/plan cursor while loading every + ;; user file, tripping idle-in-transaction timeouts in prod). + (t/testing "file-gc cleans a library used by several files" + (t/is (true? (:cleaned (th/run-file-gc! (:id library))))) + (let [components (get-in (read-file (:id library)) [:data :components])] + (t/is (contains? components (:component-id used)) + "component still used by library users is preserved") + (t/is (not (contains? components (:component-id unused))) + "component used nowhere is deleted")) + (t/is (true? (:has-media-trimmed (th/db-get :file {:id (:id library)}))))))) + +(t/deftest file-gc-repairs-unconverted-schema-types-before-cleaning + (let [profile (th/create-profile* 1) + file (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared false}) + file-id (setup-file-with-rect profile file)] + + ;; Corrupt the stored data the way production files look today and + ;; persist it through the real (non-validating) write path. + (-> (read-file file-id) + (update :data thf/corrupt-shape-types) + (persist-file)) + + ;; Pin the failure cause: the persisted file is schema-invalid. + (t/is (thrown-with-msg? clojure.lang.ExceptionInfo #"invalid file data" + (cfv/validate-file-schema! (read-file file-id)))) + + ;; The file reads fine (no migration pending) but must fail at + ;; clean-media validation until the repair is implemented. + (backdate-modified-at! file-id) + (t/testing "file-gc repairs schema-invalid types and completes" + (let [revn-before (:revn (th/db-get :file {:id file-id})) + modified-before (:modified-at (th/db-get :file {:id file-id}))] + (t/is (true? (:cleaned (th/run-file-gc! file-id)))) + (t/is (= revn-before (:revn (th/db-get :file {:id file-id}))) + "curing data does not mint a new version") + (t/is (ct/is-after? (:modified-at (th/db-get :file {:id file-id})) modified-before) + "the cure touches modified-at so the ETag invalidates") + (t/is (some? (cfv/validate-file-schema! (read-file file-id))) + "the healed data was still persisted") + (t/is (true? (:has-media-trimmed (th/db-get :file {:id file-id})))))))) + +(t/deftest file-gc-repairs-nil-pages-that-fail-at-migration + (let [profile (th/create-profile* 1) + file (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared false}) + file-id (setup-file-with-rect profile file)] + + (-> (read-file file-id) + (update :data corrupt-with-nil-page) + (persist-file)) + + ;; Force the read-time migration check by dropping the applied + ;; migrations, mirroring production files that fail inside + ;; get-file/migrate-file before cleaning ever starts. + (th/db-delete! :file-migration {:file-id file-id}) + + ;; Since the 0027 migration heals nil pages, the read now + ;; succeeds where it used to throw invalid file data. + + (backdate-modified-at! file-id) + (t/testing "file-gc repairs nil pages and completes" + (let [revn-before (:revn (th/db-get :file {:id file-id})) + modified-before (:modified-at (th/db-get :file {:id file-id}))] + (t/is (true? (:cleaned (th/run-file-gc! file-id)))) + (t/is (= revn-before (:revn (th/db-get :file {:id file-id}))) + "curing data does not mint a new version") + (t/is (ct/is-after? (:modified-at (th/db-get :file {:id file-id})) modified-before) + "the cure touches modified-at so the ETag invalidates") + (t/is (some? (cfv/validate-file-schema! (read-file file-id))) + "the healed data was still persisted") + (t/is (true? (:has-media-trimmed (th/db-get :file {:id file-id})))))))) + +(t/deftest file-gc-leaves-pristine-file-at-same-revn + ;; A pristine file has nothing to repair or collect: the run marks + ;; it trimmed without minting a new version. + (let [profile (th/create-profile* 1) + file (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared false}) + file-id (setup-file-with-rect profile file)] + (let [revn-before (:revn (th/db-get :file {:id file-id})) + modified-before (:modified-at (th/db-get :file {:id file-id})) + result (th/run-file-gc! file-id)] + (t/is (true? (:cleaned result))) + (t/is (= :cleaned (:reason result))) + (t/is (= revn-before (:revn (th/db-get :file {:id file-id}))) + "a no-op GC run does not mint a new version") + (t/is (= modified-before (:modified-at (th/db-get :file {:id file-id}))) + "a no-op GC run touches nothing") + (t/is (true? (:has-media-trimmed (th/db-get :file {:id file-id}))) + "the file is marked as trimmed")))) + +(defn- corrupt-with-unknown-type + "Corruption no migration can heal: an unknown shape type. The file + must keep failing loudly instead of being silently rewritten." + [data page-id shape-id] + (assoc-in data [:pages-index page-id :objects shape-id :type] "triangle")) + +(t/deftest file-gc-read-does-not-persist-without-repair + ;; White-box: read and repair return the sanitized snapshot but + ;; write nothing when the repair loop finds no errors; only the + ;; write phase persists. + (let [profile (th/create-profile* 1) + file (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared false}) + file-id (setup-file-with-rect profile file) + file (read-file file-id) + page-id (first (:pages (:data file))) + shape-id (first (remove #{uuid/zero} + (filter uuid? (keys (get-in file [:data :pages-index page-id :objects])))))] + (t/is (some? shape-id) "a non-root shape exists") + + (-> (read-file file-id) + (update :data thf/corrupt-shape-types) + (persist-file)) + + (let [revn-before (:revn (th/db-get :file {:id file-id})) + repaired (repair-file! file-id)] + (t/is (some? repaired) "read and repair return the snapshot") + (t/testing "read and repair persist nothing" + (t/is (= revn-before (:revn (th/db-get :file {:id file-id}))) + "the stored revn is untouched") + ;; Stored keys keep the corrupted forms (strings in + ;; pages-index, keywords in objects): decode does not + ;; normalize them, sanitize does the value coercion. + (t/is (= "rect" (get-in (read-file file-id) + [:data :pages-index (str page-id) :objects (keyword (str shape-id)) :type])) + "the stored data keeps the unconverted type") + (let [shapes (vals (get-in repaired [:data :pages-index page-id :objects])) + rect (first (filter #(= "rect" (:name %)) shapes))] + (t/is (some? rect) "the snapshot keeps the shape") + (t/is (= :rect (:type rect)) + "the returned snapshot is sanitized")))))) + +(t/deftest file-gc-gives-up-cleanly-on-unfixable-file + (let [profile (th/create-profile* 1) + file (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared false}) + file-id (setup-file-with-rect profile file) + file (read-file file-id) + page-id (first (:pages (:data file))) + shape-id (first (remove #{uuid/zero} + (filter uuid? (keys (get-in file [:data :pages-index page-id :objects])))))] + (t/is (some? shape-id) "a non-root shape exists") + + (-> (read-file file-id) + (update :data #(corrupt-with-unknown-type % page-id shape-id)) + (persist-file)) + + ;; Force the read-time migration check: the single read path + ;; cannot fix an unknown type. + (th/db-delete! :file-migration {:file-id file-id}) + + (let [revn-before (:revn (th/db-get :file {:id file-id})) + records (atom []) + _ (add-watch l/log-record ::capture + (fn [_ _ _ record] (swap! records conj record)))] + (try + (let [result (th/run-file-gc! file-id) + ;; Keep the watch installed while waiting: log emission + ;; is asynchronous, removing it right after run-task! + ;; would drop the record before it arrives. + cleaning (wait-for-log records (error-with-hint "error on cleaning file"))] + ;; The repair failure propagates to the outer handler catch: + ;; loud in Loki, never half-persisted. No phased wrapper + ;; anymore: the raw cause reaches the log with its stack + ;; trace. The handler reports the outcome instead of nil so + ;; the cause travels with the result. + (t/testing "file-gc gives up cleanly on unfixable files" + (t/is (false? (:cleaned result))) + (t/is (= :unfixable (:reason result)) + "the cause travels with the result") + (t/is (= file-id (:file-id result))) + (t/is (false? (:has-media-trimmed (th/db-get :file {:id file-id}))) + "file is not marked as trimmed") + (t/is (= revn-before (:revn (th/db-get :file {:id file-id}))) + "no half transaction was persisted") + (t/is (some? cleaning) + "the failure is reported"))) + (finally + (remove-watch l/log-record ::capture)))))) + +(defn- corrupt-with-broken-child + "Semantic breakage that repair-file heals: a dangling child id on the + root shape. Validation reports :child-not-found and the repair drops + the id, so the file is clean afterwards." + [data page-id] + (update-in data [:pages-index page-id :objects uuid/zero :shapes] conj (uuid/next))) + +(t/deftest file-gc-write-aborts-when-file-changed + ;; White-box: the handler always reads and writes back to back, so + ;; the revn-abort is only isolable by calling run-process-file! + ;; directly. + (let [profile (th/create-profile* 1) + file (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared false}) + file-id (setup-file-with-rect profile file) + page-id (first (:pages (:data (read-file file-id))))] + + (-> (read-file file-id) + (update :data #(corrupt-with-broken-child % page-id)) + (persist-file)) + + (let [repaired (repair-file! file-id)] + (t/is (some? repaired) "read and repair return the file") + ;; Concurrent write after the read, based on the stored revn: + ;; the snapshot still carries it untouched. + (let [stored-revn (:revn (th/db-get :file {:id file-id}))] + ;; Concurrent write after the read: bump revn through the real RPC path. + (apply-file-changes + :profile-id (:id profile) + :file-id file-id + :revn stored-revn + :changes [{:type :mod-page :id page-id :name "bumped"}]) + (let [revn-after-bump (:revn (th/db-get :file {:id file-id})) + result (run-process-file! repaired)] + (t/testing "the write aborts on stale revn without writing" + (t/is (false? result)) + (t/is (false? (:has-media-trimmed (th/db-get :file {:id file-id}))) + "the file is not marked as trimmed") + (t/is (= revn-after-bump (:revn (th/db-get :file {:id file-id}))) + "the write persisted nothing") + (t/is (> revn-after-bump stored-revn) + "the concurrent bump is still there"))))))) + +(t/deftest file-gc-write-skips-when-file-deleted + ;; White-box like the stale-revn test: delete the file after the + ;; read and call run-process-file! directly with its snapshot. The + ;; light row lock sees the deleted row and the write skips without + ;; writing. + (let [profile (th/create-profile* 1) + file (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared false}) + file-id (setup-file-with-rect profile file)] + (let [repaired (repair-file! file-id)] + (t/is (some? repaired) "read and repair return the file") + (th/db-update! :file {:deleted-at (ct/now)} {:id file-id}) + (let [result (run-process-file! repaired) + row (th/db-get :file {:id file-id} {::db/remove-deleted false})] + (t/testing "the write skips a file deleted after the read without writing" + (t/is (false? result)) + (t/is (some? (:deleted-at row)) "still deleted") + (t/is (false? (:has-media-trimmed row)) + "the file is not marked as trimmed")))))) + +(t/deftest file-gc-write-persists-the-repair + ;; White-box: read and repair work in memory and write nothing; + ;; only the write phase persists. Direct phase calls isolate each + ;; side, the handler always runs them together. + (let [profile (th/create-profile* 1) + file (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared false}) + file-id (setup-file-with-rect profile file) + file (read-file file-id) + page-id (first (:pages (:data file)))] + + (let [corrupted (-> (read-file file-id) + (update :data #(corrupt-with-broken-child % page-id)))] + (persist-file corrupted) + + (let [stored-before (th/db-get :file {:id file-id}) + repaired (repair-file! file-id)] + (t/is (some? repaired) "read and repair return the snapshot") + (t/testing "read and repair persist nothing" + (t/is (= (:revn stored-before) (:revn (th/db-get :file {:id file-id}))) + "the stored revn is untouched") + (t/is (nil? (cfv/validate-file repaired {})) + "the snapshot validates clean")) + (backdate-modified-at! file-id) + (t/testing "the write persists the repair" + (t/is (true? (run-process-file! repaired (:data corrupted)))) + (let [row-after-write (th/db-get :file {:id file-id})] + (t/is (= (:revn stored-before) (:revn row-after-write)) + "a GC write never mints a new version") + (t/is (ct/is-after? (:modified-at row-after-write) (:modified-at stored-before)) + "persisting changed data touches modified-at") + (t/is (nil? (cfv/validate-file (read-file file-id) {})) + "the persisted file validates clean") + (t/is (true? (:has-media-trimmed row-after-write)) + "the file is marked as trimmed"))))))) + +(t/deftest file-gc-cleans-without-revn-in-props + ;; Pins the nil-revn tolerance in get-file (TODO(2.20)): props without + ;; revn still clean. No bump at all anymore: the run only touches + ;; modified-at when the persisted snapshot differs (change-on-clean). + ;; If the tolerance is ever dropped, this test fails and must change + ;; together with the behavior. + (let [profile (th/create-profile* 1) + file (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared false}) + file-id (setup-file-with-rect profile file) + page-id (first (:pages (:data (read-file file-id))))] + + (-> (read-file file-id) + (update :data #(corrupt-with-broken-child % page-id)) + (persist-file)) + + (backdate-modified-at! file-id) + (let [revn-before (:revn (th/db-get :file {:id file-id})) + modified-before (:modified-at (th/db-get :file {:id file-id})) + result (th/run-task! :file-gc {:file-id file-id})] + (t/is (true? (:cleaned result)) + "the file is cleaned without revn in props") + (t/is (= revn-before (:revn (th/db-get :file {:id file-id}))) + "a GC write never mints a new version") + (t/is (ct/is-after? (:modified-at (th/db-get :file {:id file-id})) modified-before) + "persisting changed data touches modified-at") + (t/is (true? (:has-media-trimmed (th/db-get :file {:id file-id}))) + "the file is marked as trimmed")))) + +(t/deftest file-gc-skips-soft-deleted-file-without-error + ;; A file soft-deleted between scheduling and running is a normal + ;; race: the read returns nil through the plain path and the handler + ;; reports {:cleaned false :reason :gone}, without logging an ERROR. + (let [profile (th/create-profile* 1) + file (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared false}) + file-id (setup-file-with-rect profile file) + revn (:revn (th/db-get :file {:id file-id}))] + + (th/db-update! :file {:deleted-at (ct/now)} {:id file-id}) + + (let [records (atom []) + _ (add-watch l/log-record ::capture + (fn [_ _ _ record] (swap! records conj record)))] + (try + (let [result (th/run-task! :file-gc {:file-id file-id :revn revn})] + ;; Log emission is asynchronous: give a late ERROR the + ;; chance to arrive before asserting its absence. + (th/sleep 1000) + (let [cleaning-errors (filter (error-with-hint "error on cleaning file") @records)] + (t/testing "a file deleted after scheduling is skipped quietly" + (t/is (false? (:cleaned result)) + "the file is reported as not cleaned, not nil") + (t/is (= :gone (:reason result)) + "the cause travels with the result") + (t/is (= file-id (:file-id result)) + "the file id is echoed back") + (t/is (empty? cleaning-errors) + "no ERROR is logged for this normal race")))) + (finally + (remove-watch l/log-record ::capture)))))) + +(t/deftest file-gc-skips-when-props-revn-is-stale + ;; A file modified between scheduling and running is a normal + ;; race: the read-time revn check returns nil and the handler + ;; reports {:cleaned false :reason :stale-revn} quietly, leaving + ;; the file pending so the scheduler retries it later. + (let [profile (th/create-profile* 1) + file (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared false}) + file-id (setup-file-with-rect profile file) + stale-revn (:revn (th/db-get :file {:id file-id})) + page-id (first (:pages (:data (read-file file-id))))] + + ;; Concurrent write through the real RPC path. + (apply-file-changes + :profile-id (:id profile) + :file-id file-id + :revn stale-revn + :changes [{:type :mod-page :id page-id :name "bumped"}]) + + (let [result (th/run-task! :file-gc {:file-id file-id :revn stale-revn})] + (t/testing "a file changed after scheduling is skipped quietly" + (t/is (false? (:cleaned result)) + "the file is reported as not cleaned") + (t/is (= :stale-revn (:reason result)) + "the cause travels with the result") + (t/is (= file-id (:file-id result)) + "the file id is echoed back") + (t/is (false? (:has-media-trimmed (th/db-get :file {:id file-id}))) + "the file is not marked as trimmed"))))) + +(t/deftest srepl-repair-delegate-repairs-like-the-shared-loop + ;; Regression: procs/repair-file is called by h/process-file! with + ;; a positional opts map lacking :max-iterations. It must repair + ;; like the shared loop instead of silently returning the input. + (let [profile (th/create-profile* 1) + file (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared false}) + file-id (setup-file-with-rect profile file) + page-id (first (:pages (:data (read-file file-id)))) + broken (-> (read-file file-id) + (update :data #(corrupt-with-broken-child % page-id)))] + (t/is (some? (seq (cfv/validate-file broken {}))) + "the file is broken") + (let [fixed (procs-repair/repair-file broken {} {:rollback? true})] + (t/is (nil? (cfv/validate-file fixed {})) + "the delegate converges like the shared loop")) + (t/testing "the delegate also heals unconverted types once sanitized" + (let [unconverted (-> (read-file file-id) + (update :data thf/corrupt-shape-types)) + fixed (procs-repair/repair-file unconverted {})] + (t/is (false? (identical? unconverted fixed)) + "sanitize lets the loop converge instead of returning the input") + (t/is (nil? (cfv/validate-file fixed {})) + "the healed snapshot validates clean"))))) + +(t/deftest file-gc-offload-failure-keeps-truthful-result + ;; A submit! failure after a successful write must not falsify the + ;; outcome: the file is clean, so the handler reports cleaned and + ;; logs the offload error instead of claiming unfixable. + (let [profile (th/create-profile* 1) + file (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared false}) + file-id (setup-file-with-rect profile file)] + (let [records (atom []) + _ (add-watch l/log-record ::capture + (fn [_ _ _ record] (swap! records conj record)))] + (try + (let [result (with-redefs [cf/flags (conj cf/flags :tiered-file-data-storage) + jobs/submit (fn [& _] (throw (ex-info "redis down" {})))] + (th/run-file-gc! file-id)) + ;; Keep the watch installed while waiting: log emission + ;; is asynchronous, removing it right after run-file-gc! + ;; would drop the record before it arrives. + offload (wait-for-log records (error-with-hint "error submitting file-gc offload"))] + (t/testing "a failed offload keeps the truthful cleaning result" + (t/is (true? (:cleaned result))) + (t/is (= :cleaned (:reason result)) + "the result describes the file, not the queue") + (t/is (= file-id (:file-id result))) + (t/is (true? (:has-media-trimmed (th/db-get :file {:id file-id}))) + "the cleaning was persisted") + (t/is (some? offload) + "the offload failure is logged"))) + (finally + (remove-watch l/log-record ::capture)))))) + +(t/deftest file-gc-survives-unsanitized-libraries + ;; A library with decoder leftovers (text ids, string types) breaks + ;; ref resolution; the GC must sanitize libraries on load instead of + ;; detaching the copies that point at them. + (let [profile (th/create-profile* 1) + library (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared true}) + user (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 user) + :library-id (:id library)}) + used (add-library-component profile library "Used") + shape-id (instantiate-component profile user (:id library) (:component-id used))] + + ;; The raw add-obj above bypasses component sync, so point the + ;; copy at the main root like a real instantiation would. + (let [page-id (first (:pages (:data (read-file (:id user)))))] + (-> (read-file (:id user)) + (assoc-in [:data :pages-index page-id :objects shape-id :shape-ref] + (:shape-id used)) + (persist-file))) + + ;; Corrupt the library the way production data looks, then run GC + ;; on the user before the library itself is ever cleaned. + (-> (read-file (:id library)) + (update :data thf/corrupt-shape-types) + (persist-file)) + + (let [result (th/run-file-gc! (:id user))] + (t/testing "a copy on a corrupt library survives the GC" + (t/is (true? (:cleaned result))) + (let [page-id (first (:pages (:data (read-file (:id user))))) + copy (get-in (read-file (:id user)) + [:data :pages-index page-id :objects shape-id])] + (t/is (some? (:component-id copy)) + "the copy keeps its component") + (t/is (some? (:component-file copy)) + "the copy keeps its library") + (t/is (some? (:shape-ref copy)) + "the copy keeps its master ref")))))) + +(t/deftest file-gc-repairs-through-loaded-library + ;; The library loads lazily through the weak-map loader when the + ;; user file references it. If that load throws, the repair loop + ;; swallows the error and keeps the original file: nothing is + ;; repaired and the run still looks clean. A linked library with a + ;; remote copy must load without errors while a dangling child is + ;; repaired, proving validation really ran through the loaded + ;; library. + (let [profile (th/create-profile* 1) + library (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared true}) + user (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 user) + :library-id (:id library)}) + used (add-library-component profile library "Used") + shape-id (instantiate-component profile user (:id library) (:component-id used)) + page-id (first (:pages (:data (read-file (:id user))))) + bogus (uuid/next)] + ;; The test env enables every feature it supports on every file; + ;; production never enables fdata/pointer-map. Re-persist both + ;; files without it so this regression covers the data shape + ;; production actually has: plain data, objects-map lazy only. + (doseq [f [library user]] + (-> (read-file (:id f)) + (assoc :features (disj (set (:features f)) "fdata/pointer-map")) + (persist-file))) + ;; The raw add-obj above bypasses component sync, so point the + ;; copy at the main root like a real instantiation would, and + ;; add a dangling child id that only validation can heal. + (-> (read-file (:id user)) + (assoc-in [:data :pages-index page-id :objects shape-id :shape-ref] + (:shape-id used)) + (update-in [:data :pages-index page-id :objects uuid/zero :shapes] + conj bogus) + (persist-file)) + + (let [result (th/run-file-gc! (:id user))] + (t/testing "validation loads the remote library and repairs locally" + (t/is (true? (:cleaned result))) + (let [data (:data (read-file (:id user))) + copy (get-in data [:pages-index page-id :objects shape-id]) + root (get-in data [:pages-index page-id :objects uuid/zero])] + (t/is (some? (:component-id copy)) + "the copy keeps its component") + (t/is (some? (:shape-ref copy)) + "the copy keeps its master ref") + (t/is (not (contains? (set (:shapes root)) bogus)) + "the dangling child was repaired, so validation ran")))))) + +(t/deftest file-gc-gives-up-when-repair-does-not-converge + ;; A file the repair loop cannot make clean must never be + ;; persisted as a clean snapshot. The non-convergence raises, the + ;; handler classifies it as :unfixable, nothing is marked and the + ;; revn stays put so any manual fix has the original revision to + ;; work on. + (let [profile (th/create-profile* 1) + file (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared false}) + file-id (setup-file-with-rect profile file) + page-id (first (:pages (:data (read-file file-id))))] + (-> (read-file file-id) + (update :data #(corrupt-with-broken-child % page-id)) + (persist-file)) + + (backdate-modified-at! file-id) + + (let [{:keys [revn modified-at]} (th/db-get :file {:id file-id}) + result (with-redefs [cfr/repair-file (fn [& _] [])] + (th/run-file-gc! file-id))] + (t/testing "the run reports the file as unfixable" + (t/is (false? (:cleaned result))) + (t/is (= :unfixable (:reason result)) + "the cause travels with the result") + (t/is (= file-id (:file-id result)))) + (t/testing "nothing is persisted" + (t/is (false? (:has-media-trimmed (th/db-get :file {:id file-id}))) + "file is not marked as trimmed") + (t/is (= revn (:revn (th/db-get :file {:id file-id}))) + "no revision was persisted") + (t/is (= modified-at (:modified-at (th/db-get :file {:id file-id}))) + "no modification touch was persisted"))))) + +(t/deftest file-gc-scan-counts-unsanitized-copies-as-used + ;; Same corruption family on the consuming side: a user file with + ;; text ids makes instance-of? miss, so the scan must sanitize + ;; before asking who uses a deleted component. + (let [profile (th/create-profile* 1) + library (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared true}) + user (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 user) + :library-id (:id library)}) + used (add-library-component profile library "Used") + shape-id (instantiate-component profile user (:id library) (:component-id used))] + + ;; Delete the component (and its main) from the library. + (apply-file-changes + :profile-id (:id profile) + :file-id (:id library) + :changes [{:type :del-component :id (:component-id used)} + {:type :del-obj :page-id (:page-id used) :id (:shape-id used) + :ignore-touched true}]) + + ;; Corrupt the user the way production data looks, including the + ;; component refs as text: instance-of? compares with = so the + ;; copy would not count as a use without sanitizing first. + (let [page-id (first (:pages (:data (read-file (:id user))))) + obj-key (keyword (str shape-id))] + (-> (read-file (:id user)) + (update :data thf/corrupt-shape-types) + (update-in [:data :pages-index (str page-id) :objects obj-key :component-id] str) + (update-in [:data :pages-index (str page-id) :objects obj-key :component-file] str) + (persist-file))) + + (let [result (th/run-file-gc! (:id library))] + (t/testing "a deleted component still used counts as used" + (t/is (true? (:cleaned result))) + (t/is (contains? (get-in (read-file (:id library)) [:data :components]) + (:component-id used)) + "the component used by the unsanitized copy is preserved"))))) + +(t/deftest file-gc-scan-loads-users-outside-write-transaction + ;; Pins the design rule behind the idle-in-transaction timeouts: + ;; every library-user file loads on its own connection, never with + ;; the write transaction held open. If the scan moves back inside, + ;; the captured cfgs carry ::db/conn and this fails. + (let [profile (th/create-profile* 1) + library (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared true}) + users (mapv (fn [i] + (th/create-file* i {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared false})) + [2 3]) + _ (doseq [user users] + (th/link-file-to-library* + {:file-id (:id user) + :library-id (:id library)})) + used (add-library-component profile library "Used")] + (doseq [user users] + (instantiate-component profile user (:id library) (:component-id used))) + (doseq [{:keys [component-id page-id shape-id]} [used]] + (apply-file-changes + :profile-id (:id profile) + :file-id (:id library) + :changes [{:type :del-component :id component-id} + {:type :del-obj :page-id page-id :id shape-id + :ignore-touched true}])) + + (let [seen (atom []) + orig bfc/get-file] + (with-redefs [bfc/get-file (fn [cfg & args] + (swap! seen conj cfg) + (apply orig cfg args))] + (t/is (true? (:cleaned (th/run-file-gc! (:id library)))))) + (t/testing "user files load without a write connection" + (t/is (seq @seen) "the scan loaded files through bfc/get-file") + (t/is (every? #(nil? (::db/conn %)) @seen) + "no load happens inside the write transaction"))))) + +(t/deftest file-gc-reports-error-on-transient-failure + ;; Unexpected failures (DB down, storage hiccup) are not data + ;; corruption: they report :error so operators stop reading every + ;; unfixable as a broken file. The file stays unmarked either way, + ;; so the scheduler retries the run later. + (let [profile (th/create-profile* 1) + file (th/create-file* 1 {:profile-id (:id profile) + :project-id (:default-project-id profile) + :is-shared false}) + file-id (setup-file-with-rect profile file)] + (let [records (atom []) + _ (add-watch l/log-record ::capture + (fn [_ _ _ record] (swap! records conj record)))] + (try + (let [result (with-redefs [db/tx-run! (fn [& _] (throw (RuntimeException. "db down")))] + (th/run-file-gc! file-id)) + logged (wait-for-log records (error-with-hint "error on cleaning file"))] + (t/testing "transient failures report :error" + (t/is (false? (:cleaned result))) + (t/is (= :error (:reason result)) + "the cause is not mistaken for corrupt data") + (t/is (= file-id (:file-id result))) + (t/is (false? (:has-media-trimmed (th/db-get :file {:id file-id}))) + "the file is not marked as cleaned") + (t/is (some? logged) + "the failure is still loud"))) + (finally + (remove-watch l/log-record ::capture)))))) diff --git a/backend/test/backend_tests/rpc_file_snapshot_test.clj b/backend/test/backend_tests/rpc_file_snapshot_test.clj index 025c1dc290..50964865a9 100644 --- a/backend/test/backend_tests/rpc_file_snapshot_test.clj +++ b/backend/test/backend_tests/rpc_file_snapshot_test.clj @@ -393,7 +393,7 @@ (bfc/get-file cfg file-id :lock-for-share? true) ;; The GC uses SKIP LOCKED on a different connection, so it ;; must skip instead of blocking or marking. - (t/is (not (th/run-task! :file-gc {:file-id file-id})))))) + (t/is (false? (:cleaned (th/run-task! :file-gc {:file-id file-id}))))))) (t/testing "creation cannot slip between gc scan and mark" ;; Deterministic interleaving: pause the GC right after its @@ -420,7 +420,7 @@ (fn [& args] (deliver reached-insert true) (apply orig-create args))] - (let [gc-done (future (th/run-task! :file-gc {:file-id file-id}))] + (let [gc-done (future (:cleaned (th/run-task! :file-gc {:file-id file-id})))] (t/is (= true (deref scan-started 10000 ::timeout))) (let [created (future (do-create))] ;; The creation must not reach the insert while the GC @@ -439,7 +439,7 @@ ;; reattach keeps every id), therefore there is nothing to purge; ;; the snapshot keeps resolving afterwards. (t/is (zero? (:processed (th/run-task! :objects-gc {})))) - (t/is (true? (th/run-task! :file-gc {:file-id file-id}))) + (t/is (true? (:cleaned (th/run-task! :file-gc {:file-id file-id})))) ;; The pinned snapshot (not an arbitrary autosnapshot: those may ;; reference fragments an earlier pass already marked) must keep ;; resolving after another GC cycle. @@ -510,7 +510,7 @@ (fn [& args] (deliver reached-insert true) (apply orig-create args))] - (let [gc-done (future (th/run-task! :file-gc {:file-id file-id}))] + (let [gc-done (future (:cleaned (th/run-task! :file-gc {:file-id file-id})))] (t/is (= true (deref scan-started 10000 ::timeout))) (let [restored (future (do-restore))] (t/is (= ::timeout (deref reached-insert 10000 ::timeout))) diff --git a/backend/test/backend_tests/rpc_file_test.clj b/backend/test/backend_tests/rpc_file_test.clj index c833fb2ad5..68f7850486 100644 --- a/backend/test/backend_tests/rpc_file_test.clj +++ b/backend/test/backend_tests/rpc_file_test.clj @@ -156,7 +156,7 @@ shape-id (uuid/random)] ;; Preventive file-gc - (t/is (true? (th/run-task! :file-gc {:file-id (:id file) :revn (:revn file)}))) + (t/is (true? (:cleaned (th/run-task! :file-gc {:file-id (:id file) :revn (:revn file)})))) ;; Check the number of fragments before adding the page ;; (no churn: the preventive GC above reuses the single id). @@ -187,7 +187,7 @@ (th/db-delete! :file-data {:file-id (:id file) :type "snapshot"}) ;; The file-gc should mark for remove unused fragments - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file))))) ;; Check the number of fragments (no churn: unchanged pages keep ;; their ids, so nothing is marked and nothing new is persisted). @@ -233,7 +233,7 @@ (th/db-delete! :file-data {:file-id (:id file) :type "snapshot"}) ;; The file-gc should mark for remove unused fragments - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file))))) ;; Only the replaced page fragment is marked; the live pages keep ;; their ids instead of being re-persisted. @@ -256,7 +256,7 @@ ;; The file-gc should remove fragments related to changes ;; snapshots previously deleted. - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file))))) ;; Check the number of fragments; without churn the two live ;; pages simply stay where they are (was 4 with 2 re-persisted). @@ -340,7 +340,7 @@ (t/is (= 0 (:delete res)))) ;; run the task again - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file))))) ;; retrieve file and check trimmed attribute (let [row (th/db-get :file {:id (:id file)})] @@ -384,7 +384,7 @@ ;; Now, we have deleted the usage of pointers to the ;; file-media-objects, if we paste file-gc, they should be marked ;; as deleted. - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file))))) ;; The deleted shape's fragment is pinned by the automatic ;; snapshot taken before the deletion, and its media is still @@ -402,7 +402,7 @@ (t/is (= 4 (:processed res)))) ;; Rerun the file-gc and objects-gc - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file))))) (let [res (th/run-task! :objects-gc {})] ;; 3 (was 4): the two orphaned page fragments plus the media @@ -530,7 +530,7 @@ ;; run the task again - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file))))) (let [res (th/run-task! :objects-gc {})] ;; 0 (was 2, then 1): no churn orphans and every replaced page @@ -577,7 +577,7 @@ ;; Now, we have deleted the usage of pointers to the ;; file-media-objects, if we paste file-gc, they should be marked ;; as deleted. - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file))))) ;; The deleted shapes' fragments stay pinned by the automatic ;; snapshots taken before the deletion, and the media is still @@ -592,7 +592,7 @@ ;; Rerun file-gc and objects-gc task for the same file once all snapshots are ;; "expired/deleted" - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file))))) (let [res (th/run-task! :objects-gc {})] ;; 7 (was 6, then 8): the two orphaned page fragments plus the ;; five media rows, all unreferenced once the snapshot file_data @@ -706,7 +706,7 @@ (t/is (= 1 (:freeze res))) (t/is (= 0 (:delete res)))) - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file))))) ;; retrieve file and check trimmed attribute (let [row (th/db-get :file {:id (:id file)})] @@ -736,7 +736,7 @@ :page-id page-id :id frame-id-2}]) - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file))))) (let [rows (th/db-query :file-tagged-object-thumbnail {:file-id file-id})] (t/is (= 2 (count rows))) @@ -773,7 +773,7 @@ :page-id page-id :id frame-id-1}]) - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file))))) (let [rows (th/db-query :file-tagged-object-thumbnail {:file-id file-id})] (t/is (= 1 (count rows))) @@ -1378,7 +1378,7 @@ (th/sleep 300) ;; run the task - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file))))) ;; check that object thumbnails are still here (let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})] @@ -1407,7 +1407,7 @@ (t/is (= 2 (count rows)))) ;; run the task again - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file))))) ;; check that we have all object thumbnails (let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})] @@ -1540,7 +1540,7 @@ (t/is (= 2 (count rows))))) (t/testing "gc task" - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file))))) (let [rows (th/db-query :file-thumbnail {:file-id (:id file)})] (t/is (= 2 (count rows))) @@ -1565,7 +1565,7 @@ sobject (volatile! nil)] ;; Preventive file-gc - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file))))) ;; Preventive objects-gc (let [result (th/run-task! :objects-gc {})] @@ -1585,7 +1585,7 @@ ;; Run FileGC again, with tiered storage activated (with-redefs [app.config/flags (conj app.config/flags :tiered-file-data-storage)] - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)})))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file)))))) ;; The FileGC task will schedule an inner taskq (th/run-pending-jobs) @@ -1646,7 +1646,7 @@ ;; The file-gc should mark for remove unused fragments - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file))))) ;; The file-gc only marks fragments nothing references: the live ;; pages keep their ids (no churn re-persist), row1 stays alive on @@ -1764,7 +1764,7 @@ :anotation nil}]) ;; Run the task again - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file))))) ;; Retrieve file and check trimmed attribute (let [row (th/db-get :file {:id (:id file)})] @@ -1810,7 +1810,7 @@ (t/is (some? (not-empty (:objects component)))))) ;; Re-run the file-gc task - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file))))) (let [row (th/db-get :file {:id (:id file)})] (t/is (true? (:has-media-trimmed row)))) @@ -1840,7 +1840,7 @@ ;; Now, we have deleted the usage of component if we pass file-gc, ;; that component should be deleted - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file))))) ;; Check that component is properly removed (let [data {::th/type :get-file @@ -1931,8 +1931,8 @@ :component-id c-id})}]) ;; Run the file-gc on file and library - (t/is (true? (th/run-task! :file-gc {:file-id (:id file-1)}))) - (t/is (true? (th/run-task! :file-gc {:file-id (:id file-2)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file-1))))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file-2))))) ;; Check that component exists (let [data {::th/type :get-file @@ -1974,7 +1974,7 @@ (t/is (some? (not-empty (:objects component)))))) ;; Re-run the file-gc task - (t/is (true? (th/run-task! :file-gc {:file-id (:id file-1)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file-1))))) ;; Check that component is still there after file-gc task (let [data {::th/type :get-file @@ -2005,7 +2005,7 @@ ;; Now, we have deleted the usage of component if we pass file-gc, ;; that component should be deleted - (t/is (true? (th/run-task! :file-gc {:file-id (:id file-1)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file-1))))) ;; Check that component is properly removed (let [data {::th/type :get-file @@ -2154,8 +2154,8 @@ (t/is (not= (:id fill) (:id fmedia))))) ;; Run the file-gc on file and library - (t/is (true? (th/run-task! :file-gc {:file-id (:id file-1)}))) - (t/is (true? (th/run-task! :file-gc {:file-id (:id file-2)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file-1))))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file-2))))) ;; Now proceed to delete file and absorb it (let [data {::th/type :delete-file diff --git a/backend/test/backend_tests/rpc_file_thumbnails_test.clj b/backend/test/backend_tests/rpc_file_thumbnails_test.clj index 6025849773..dab681ec4d 100644 --- a/backend/test/backend_tests/rpc_file_thumbnails_test.clj +++ b/backend/test/backend_tests/rpc_file_thumbnails_test.clj @@ -117,7 +117,7 @@ ;; Run the File GC task that should remove unused file object ;; thumbnails - (th/run-task! :file-gc {:file-id (:id file)}) + (th/run-file-gc! (:id file)) ;; Only the unused object-thumbnail row is purged: the replaced ;; page fragment stays pinned by the automatic snapshot that shares @@ -224,7 +224,7 @@ ;; Run the File GC task that should remove unused file object ;; thumbnails - (t/is (true? (th/run-task! :file-gc {:file-id (:id file)}))) + (t/is (true? (:cleaned (th/run-file-gc! (:id file))))) ;; Only the superseded revn thumbnail row is purged: the file ;; itself is unchanged, so it keeps its fragment ids (no-churn) diff --git a/common/src/app/common/files/changes.cljc b/common/src/app/common/files/changes.cljc index ce45edd485..246e1d995f 100644 --- a/common/src/app/common/files/changes.cljc +++ b/common/src/app/common/files/changes.cljc @@ -868,9 +868,24 @@ (when (and id name page) (ex/raise :type :conflict :hint "id+name or page should be provided, never both")) + ;; The undo of :add-page is :del-page with :id, so a change carrying + ;; both with different ids persists one page and undoes another. + (when (and id (:id page) (not= id (:id page))) + (ex/raise :type :conflict + :hint "id and page should agree" + :id id + :page-id (:id page))) (let [page (if (and (string? name) (uuid? id)) (ctp/make-empty-page {:id id :name name}) page)] + ;; A page without a valid id would leave a nil entry in :pages + ;; and a nil key in :pages-index (see legacy-57). Fail fast with + ;; a structured error instead of assert: asserts are elided in + ;; release CLJS builds, and this must hold there too. + (when-not (uuid? (:id page)) + (ex/raise :type :validation + :hint "add-page requires a page with a valid :id" + :page-id (:id page))) (ctpl/add-page data page))) (defmethod process-change :mod-page diff --git a/common/src/app/common/files/migrations.cljc b/common/src/app/common/files/migrations.cljc index de82f16f9e..838095560e 100644 --- a/common/src/app/common/files/migrations.cljc +++ b/common/src/app/common/files/migrations.cljc @@ -2020,14 +2020,22 @@ (update :pages-index d/update-vals update-container) (d/update-when :components d/update-vals update-container)))) -(defmethod migrate-data "0027-separate-tokens-status" +(defmethod migrate-data "0027-repair-unconverted-types-and-nil-pages" + ;; Re-apply the legacy-57 nil page cleanup (nils came back through a + ;; write path after it ran) and decode the data with the schema, which + ;; converts the unconverted types left by decoders. See + ;; ctf/sanitize-file-data. + [data _] + (ctf/sanitize-file-data data)) + +(defmethod migrate-data "0028-separate-tokens-status" [data _] (if-let [tokens-lib (:tokens-lib data)] (assoc data :tokens-status (cfo/make-tokens-status-from-lib tokens-lib)) data)) -(defmethod migrate-data "0028-normalize-constrained-values" +(defmethod migrate-data "0029-normalize-constrained-values" ;; Existing files can contain values outside the limits now shared by the UI ;; and file schemas. Normalize them before checking the migrated file. [data _] @@ -2129,7 +2137,7 @@ (update :pages-index d/update-vals repair-page) (d/update-when :components d/update-vals repair-container)))) -(defmethod migrate-data "0029-move-background-blur-out-of-blur" +(defmethod migrate-data "0030-move-background-blur-out-of-blur" ;; Before background blur got its own attribute, `:blur` accepted a ;; `:background-blur` type, so the editor and the plugin API saved those maps ;; under `:blur`. Once the shape schema was tightened, such files fail @@ -2152,7 +2160,7 @@ (update :pages-index d/update-vals repair-container) (d/update-when :components d/update-vals repair-container)))) -(defmethod migrate-data "0030-remove-stroke-per-side-attr" +(defmethod migrate-data "0031-remove-stroke-per-side-attr" ;; Individual stroke widths shipped with a `:stroke-per-side` boolean on every ;; stroke, telling the renderer and the CSS generator whether the four side ;; widths were meaningful. Comparing the sides answers that on its own, so @@ -2171,7 +2179,7 @@ (update :pages-index d/update-vals repair-container) (d/update-when :components d/update-vals repair-container)))) -(defmethod migrate-data "0031-migrate-stroke-width-token-attr" +(defmethod migrate-data "0032-migrate-stroke-width-token-attr" ;; Stroke width tokens used to be applied to the single `:stroke-width` token ;; attribute, replaced by the four per-side attributes. The editor reads only ;; the new keys, so a file written before the change keeps the token on @@ -2203,7 +2211,7 @@ ;; that walk the tree through `:shapes` miss them; e.g. deleting a variant ;; also deleted its container, which looked empty, and left the other ;; variants pointing to a deleted parent. Add them back to their parent. -(defmethod migrate-data "0032-fix-children-not-in-parent" +(defmethod migrate-data "0033-fix-children-not-in-parent" [data _] (letfn [(get-unlisted-children [objects] ;; Returns a {parent-id -> [child-id]} map @@ -2236,7 +2244,7 @@ (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" +(defmethod migrate-data "0034-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 @@ -2380,10 +2388,11 @@ "0024b-fix-stroke-cap-placement" "0025-repair-empty-text-content" "0026-fix-svg-raw-shapes-uuids" - "0027-separate-tokens-status" - "0028-normalize-constrained-values" - "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" - "0033-normalize-main-instance-names"])) + "0027-repair-unconverted-types-and-nil-pages" + "0028-separate-tokens-status" + "0029-normalize-constrained-values" + "0030-move-background-blur-out-of-blur" + "0031-remove-stroke-per-side-attr" + "0032-migrate-stroke-width-token-attr" + "0033-fix-children-not-in-parent" + "0034-normalize-main-instance-names"])) diff --git a/common/src/app/common/files/repair.cljc b/common/src/app/common/files/repair.cljc index 4756f8a758..f3af814897 100644 --- a/common/src/app/common/files/repair.cljc +++ b/common/src/app/common/files/repair.cljc @@ -8,9 +8,11 @@ (:require [app.common.data :as d] [app.common.data.macros :as dm] + [app.common.files.changes :as cfc] [app.common.files.changes-builder :as pcb] [app.common.files.helpers :as cfh] [app.common.files.tokens :as cfo] + [app.common.files.validate :as cfv] [app.common.logging :as log] [app.common.path-names :as cpn] [app.common.types.component :as ctk] @@ -867,3 +869,58 @@ (pcb/empty-changes nil) errors)] redo-changes)) + +(defn repair-loop + "Best-effort semantic repair loop over an in-memory file: validate, + apply the computed repair changes and repeat until the file + validates clean or `max-iterations` (default 10) is reached. When + it throws or does not converge, the input file is returned + untouched and the caller owns the decision (file-gc raises with + :repair-did-not-converge so nothing is persisted as clean; the + debug endpoints keep running their own single pass). Never touches + `revn`: the caller decides whether to bump it. file-gc does not: + it only touches :modified-at on real change." + [{:keys [id] :as file} libraries & {:keys [max-iterations]}] + ;; NOTE: no `:or` default here on purpose: an explicit nil must + ;; behave like a missing key (both come from valid call shapes), + ;; and `:or` only covers the missing one. Normalize explicitly. + (let [max-iterations (or max-iterations 10)] + (try + (loop [current file + iteration 0] + (let [errors (not-empty (cfv/validate-file current libraries))] + (cond + (empty? errors) + (do + (when (pos? iteration) + (log/debug :hint "file repaired" + :file-id (str id) + :iterations iteration)) + current) + + (>= iteration max-iterations) + (do + (log/warn :hint "file still invalid after repair" + :file-id (str id) + :codes (frequencies (map :code errors))) + file) + + :else + (let [changes (repair-file current libraries errors)] + (recur (update current :data cfc/process-changes changes) + (inc iteration)))))) + (catch #?(:clj Exception :cljs js/Error) cause + (log/warn :hint "error on repairing file, keeping original" + :file-id (str (:id file)) + :cause cause) + file) + ;; AssertionError is not an Exception: asserts on the repair + ;; path (e.g. get-shape with a non-uuid id) must also return + ;; the input instead of escaping. CLJS needs no extra clause: + ;; js/Error already covers everything thrown there. + #?(:clj + (catch AssertionError cause + (log/warn :hint "error on repairing file, keeping original" + :file-id (str (:id file)) + :cause cause) + file))))) diff --git a/common/src/app/common/files/validate.cljc b/common/src/app/common/files/validate.cljc index 6654e28508..641562cdc4 100644 --- a/common/src/app/common/files/validate.cljc +++ b/common/src/app/common/files/validate.cljc @@ -367,12 +367,22 @@ shape file page))) (defn- check-component-ref - "Validate that the referenced shape exists in the near component." + "Validate that the referenced shape exists in the near component. + A shape without :shape-ref is deliberately ignored here (instance + heads carry none, see get-ref-shape), so there is nothing to check + for it: without this guard the matching repair crashes on the + get-shape precondition instead of converging. Accepted consequence: + a copy root that genuinely lost its :shape-ref is neither reported + nor repaired through validate-file (debug endpoint, srepl, GC); a + dedicated repair-error for that case is tracked in + https://github.com/penpot/penpot/issues/12509." [shape file page libraries] (let [library-exists (library-exists? file libraries shape) ref-shape (when library-exists (find-ref-shape* file page libraries shape))] - (when (and library-exists (nil? ref-shape)) + (when (and library-exists + (some? (:shape-ref shape)) + (nil? ref-shape)) (report-error :ref-shape-not-found (str/ffmt "Referenced shape % not found in near component" (:shape-ref shape)) shape file page)))) diff --git a/common/src/app/common/test_helpers/files.cljc b/common/src/app/common/test_helpers/files.cljc index 448e0d2562..d406420702 100644 --- a/common/src/app/common/test_helpers/files.cljc +++ b/common/src/app/common/test_helpers/files.cljc @@ -206,3 +206,37 @@ Example: (thf/dump-file file :keys [:name :swap-slot-label] :show-refs? false)" [file & {:keys [] :as params}] (dump-page (current-page file) params)) + +;; ----- Corruption builders (mirror production data) + +(defn corrupt-shape-types + "Corrupt file data the way production files look when the decoder + left unconverted types: shape `:type` as text, ids as text and + object/page-map keys as text/keyword instead of uuid. Defensive: + only converts values that are still unconverted, so it is safe to + run on already-corrupted data." + [data] + (letfn [(corrupt-shape [shape] + (cond-> shape + (keyword? (:type shape)) + (assoc :type (name (:type shape))) + + (uuid? (:id shape)) + (assoc :id (str (:id shape))) + + (uuid? (:parent-id shape)) + (update :parent-id str) + + (uuid? (:frame-id shape)) + (update :frame-id str))) + (corrupt-objects [objects] + (into {} + (map (fn [[id shape]] + [(keyword (str id)) (corrupt-shape shape)])) + objects)) + (corrupt-page [[page-id page]] + [(str page-id) (update page :objects corrupt-objects)])] + (-> data + (update :pages (fn [pages] (mapv str pages))) + (update :pages-index (fn [pages-index] + (into {} (map corrupt-page) pages-index)))))) diff --git a/common/src/app/common/types/file.cljc b/common/src/app/common/types/file.cljc index df4733c25a..b06493f720 100644 --- a/common/src/app/common/types/file.cljc +++ b/common/src/app/common/types/file.cljc @@ -131,6 +131,66 @@ (def check-file-data (sm/check-fn schema:data :hint "invalid file data")) +(def decode-file-data + "Precompiled json decoder for file data. Compiling the decoder on + every call (via `sm/decode`) costs a schema walk per file; this one + is built once at load time. See `decode-file-metadata` below for + the same pattern." + (sm/decoder schema:data sm/json-transformer)) + +(def decode-page-objects + "Precompiled json decoder for page `:objects` maps, used for the + explicit component-objects pass in `sanitize-file-data` (the + container schema keeps them opaque, so the top-level decode does + not descend into them)." + (sm/decoder ctp/schema:objects sm/json-transformer)) + +(defn sanitize-file-data + "Decode file data with the file schema and drop nil page entries, + repairing the two corruption families seen in production: types + left unconverted by decoders (strings or keywords where the schema + expects keywords or uuids) and nil page entries that reappeared + after legacy-57. The schema itself drives the coercions + (`:decode/json` on shape types, json-transformer uuid decoders), so + there is no hand-rolled type table to keep in sync. Component + objects need an explicit pass because the container schema declares + them opaque (`:map`), so the top-level decode does not descend into + them. Total and idempotent: values the schema can coerce are + coerced, even when the result is still invalid (an unknown + shape type still gets keywordized), while genuinely + unknown values are left untouched — so files with real corruption + keep failing loudly instead of being silently rewritten. When + nothing is repaired (neither nil entries nor coercions), the input + itself is returned as is, same instance: lazy containers + (objects-map) keep their identity and callers can tell a real fix + from a no-op by comparing against the input, without re-diffing. + The walk still happens on every call — the decode runs over the + whole data — because that is the only way to name the corruption + families; the no-op case saves the callers the repair bookkeeping, + not the walk. Migration 0027 applies the same recipe when pending + (idempotent, one extra pass per file, then never again)." + [data] + (let [dropped (-> data + (d/update-when :pages #(if (some nil? %) + (into (empty %) (remove nil?) %) + %)) + (d/update-when :pages-index #(cond-> % (contains? % nil) (dissoc nil)))) + decoded (-> (decode-file-data dropped) + ;; The container schema declares :objects opaque (:map), so + ;; the top-level decode does not descend into component + ;; shapes. Decode them explicitly with the page objects + ;; schema, which carries the same shape decoders. + (d/update-when :components (fn [components] + (d/update-vals components + (fn [component] + (d/update-when component :objects + decode-page-objects))))))] + ;; Nothing repaired and no nil entries: return the input as is. + ;; Same instance keeps lazy containers (objects-map) untouched, + ;; avoids fake change-detection stamps, and lets callers find a + ;; real fix just by comparing against the input. + (if (= decoded dropped) dropped decoded))) + (def check-file-media (sm/check-fn schema:media)) diff --git a/common/test/common_tests/files/repair_test.cljc b/common/test/common_tests/files/repair_test.cljc index 27f6964de2..95205b8cfd 100644 --- a/common/test/common_tests/files/repair_test.cljc +++ b/common/test/common_tests/files/repair_test.cljc @@ -67,6 +67,52 @@ (t/is (= "Rect1" (:name child2'))) (t/is (= "Group/Subgroup / Component2" (:name copy2')))))) +(t/deftest repair-loop-explicit-nil-max-iterations + (t/testing "explicit nil :max-iterations behaves like the default" + (let [file (-> (thf/sample-file :file1 :page-label :page1) + (thv/add-variant :variant1 :component1 :root1 :component2 :root2) + (ths/update-shape :root1 :variant-id nil)) + errors (cfv/validate-file file {})] + (t/is (some? (seq errors)) "the file is broken") + (let [fixed (cfr/repair-loop file {} :max-iterations nil)] + (t/is (nil? (cfv/validate-file fixed {})) "it converges"))))) + +(t/deftest repair-loop-gives-up-after-max-iterations + (t/testing "errors that never clear return the input untouched" + (let [file (-> (thf/sample-file :file1 :page-label :page1) + (thv/add-variant :variant1 :component1 :root1 :component2 :root2) + (ths/update-shape :root1 :variant-id nil))] + (with-redefs [cfv/validate-file + (fn [_ _] [{:code :definitely-not-a-real-error}])] + (let [result (cfr/repair-loop file {} :max-iterations 2)] + (t/is (identical? file result) + "no convergence, no partial persist")))))) + +(t/deftest repair-loop-keeps-original-on-error + (t/testing "a throwing repair returns the input untouched" + (let [file (-> (thf/sample-file :file1 :page-label :page1) + (thv/add-variant :variant1 :component1 :root1 :component2 :root2) + (ths/update-shape :root1 :variant-id nil))] + (with-redefs [cfr/repair-file + (fn [& _] (throw (ex-info "boom" {})))] + (let [result (cfr/repair-loop file {})] + (t/is (identical? file result) + "the handler decides, the loop never half-persists")))))) + +;; AssertionError is a JVM Error, not an Exception, and does not +;; exist in CLJS (where js/Error catches everything): JVM-only. +#?(:clj + (t/deftest repair-loop-keeps-original-on-assertion-error + (t/testing "an assert on the repair path returns the input untouched" + (let [file (-> (thf/sample-file :file1 :page-label :page1) + (thv/add-variant :variant1 :component1 :root1 :component2 :root2) + (ths/update-shape :root1 :variant-id nil))] + (with-redefs [cfr/repair-file + (fn [& _] (throw (AssertionError. "non-uuid id")))] + (let [result (cfr/repair-loop file {})] + (t/is (identical? file result) + "asserts do not escape the loop"))))))) + (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) diff --git a/common/test/common_tests/files/validate_test.cljc b/common/test/common_tests/files/validate_test.cljc index 48fd3e3f07..62352d9652 100644 --- a/common/test/common_tests/files/validate_test.cljc +++ b/common/test/common_tests/files/validate_test.cljc @@ -17,8 +17,10 @@ validated." (:require [app.common.files.validate :as cfv] + [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.types.file :as ctf] [app.common.types.pages-list :as ctpl] [app.common.types.shape-tree :as ctst] @@ -447,3 +449,40 @@ (t/is (= :validation (:type data))) (t/is (= :referential-integrity (:code data))) (t/is (seq (:details data))))))))) + +;; ---------------------------------------------------------------- +;; 11. check-component-ref – copy roots without :shape-ref +;; ---------------------------------------------------------------- + +(defn- dissoc-copy-shape-ref + "Remove :shape-ref from the copy root shape. Instance heads + legitimately carry none (see get-ref-shape), so this mirrors the + stored shape instead of crafting corruption." + [file copy-label] + (let [page (thf/current-page file) + copy-id (thi/id copy-label)] + (ctf/update-file-data + file + (fn [file-data] + (ctpl/update-page file-data (:id page) + (fn [p] + (ctst/set-shape p (dissoc (ctst/get-shape p copy-id) + :shape-ref)))))))) + +(t/deftest validate-copy-without-shape-ref + (t/testing "a copy root without :shape-ref reports no :ref-shape-not-found" + (let [file (-> (thf/sample-file :file1 :page-label :page1) + (tho/add-simple-component-with-copy :component1 :main-root :main-child :copy-root)) + file (dissoc-copy-shape-ref file :copy-root) + errors (cfv/validate-file file {})] + (t/is (empty? (filter #(= :ref-shape-not-found (:code %)) errors)) + "nothing referenced, nothing to report")))) + +(t/deftest validate-copy-with-unknown-shape-ref + (t/testing "a copy root with a dangling :shape-ref still reports :ref-shape-not-found" + (let [file (-> (thf/sample-file :file1 :page-label :page1) + (tho/add-simple-component-with-copy :component1 :main-root :main-child :copy-root)) + file (ths/update-shape file :copy-root :shape-ref (uuid/next)) + errors (cfv/validate-file file {})] + (t/is (some #(= :ref-shape-not-found (:code %)) errors) + "the guard did not swallow dangling references")))) diff --git a/common/test/common_tests/files_migrations_0027_test.cljc b/common/test/common_tests/files_migrations_0027_test.cljc new file mode 100644 index 0000000000..10b211659e --- /dev/null +++ b/common/test/common_tests/files_migrations_0027_test.cljc @@ -0,0 +1,239 @@ +;; 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.files-migrations-0027-test + "Tests for the 0027 migration + (see https://github.com/penpot/penpot/issues/12433). + + Production files fail schema validation with unconverted types + (`:type \"circle\"` instead of `:circle`, ids as text, map keys as + text/keyword instead of uuid) and with nil pages. The file holds + two groups: `decode-coverage-*` are characterization tests pinning + down what the schema `decode` (json-transformer) already fixes on + its own and what still needs targeted repair clauses; + `migration-0027-*` pin the migration behavior itself (converting + unconverted types, dropping nil pages, leaving valid data + untouched, idempotence and running through `migrate`). The first + group asserts observed behavior, the second fixed behavior." + (:require + [app.common.files.migrations :as cfm] + [app.common.schema :as sm] + [app.common.test-helpers.files :as thf] + [app.common.types.file :as ctf] + [app.common.types.shape :as cts] + [app.common.uuid :as uuid] + [clojure.test :as t])) + +(defn- make-rect-shape + [shape-id] + (cts/setup-shape {:id shape-id + :name "rect" + :type :rect + :x 0 :y 0 :width 10 :height 10 + :parent-id uuid/zero + :frame-id uuid/zero})) + +(defn- make-root-shape + [shape-id] + (cts/setup-shape {:id uuid/zero + :name "root" + :type :frame + :parent-id uuid/zero + :frame-id uuid/zero + :shapes [shape-id]})) + +(defn- make-data + "Minimal file data with a single page holding a single rect shape." + [page-id shape] + (let [shape-id (:id shape)] + {:pages [page-id] + :pages-index + {page-id {:id page-id + :name "Page 1" + :objects {uuid/zero (make-root-shape shape-id) + shape-id shape}}}})) + +(defn- decode-data + [data] + (sm/decode ctf/schema:data data (sm/json-transformer))) + +(t/deftest decode-coverage-string-shape-type + (let [page-id (uuid/next) + shape-id (uuid/next) + data (make-data page-id (assoc (make-rect-shape shape-id) :type "rect")) + decoded (decode-data data)] + (t/is (= :rect (get-in decoded [:pages-index page-id :objects shape-id :type])) + "decode converts string shape type to keyword"))) + +(t/deftest decode-coverage-string-uuid-fields + (let [page-id (uuid/next) + shape-id (uuid/next) + shape (-> (make-rect-shape shape-id) + (assoc :id (str shape-id)) + (assoc :parent-id (str uuid/zero)) + (assoc :frame-id (str uuid/zero))) + data (make-data page-id shape) + decoded (decode-data data) + shape' (get-in decoded [:pages-index page-id :objects shape-id])] + (t/is (uuid? (:id shape')) "decode converts string shape id to uuid") + (t/is (uuid? (:parent-id shape')) "decode converts string parent id to uuid") + (t/is (uuid? (:frame-id shape')) "decode converts string frame id to uuid"))) + +(t/deftest decode-coverage-string-page-and-map-keys + (let [page-id (uuid/next) + shape-id (uuid/next) + data (make-data page-id (make-rect-shape shape-id)) + data (-> data + (update :pages (fn [pages] (mapv str pages))) + (update :pages-index + (fn [pages-index] + (into {} + (map (fn [[pid page]] + [(str pid) + (update page :objects + (fn [objects] + (into {} + (map (fn [[id shape]] + [(keyword (str id)) shape])) + objects)))])) + pages-index)))) + decoded (decode-data data)] + (t/is (= [page-id] (:pages decoded)) "decode converts string page refs to uuid") + (t/is (contains? (:pages-index decoded) page-id) "decode converts string page keys to uuid") + (t/is (contains? (get-in decoded [:pages-index page-id :objects]) shape-id) + "decode converts keyword object keys to uuid"))) + +(t/deftest decode-coverage-nil-pages + (let [page-id (uuid/next) + shape-id (uuid/next) + data (-> (make-data page-id (make-rect-shape shape-id)) + (update :pages conj nil) + (assoc-in [:pages-index nil] + {:id nil :name "ghost" :objects {}})) + decoded (decode-data data)] + (t/is (some nil? (:pages decoded)) "decode leaves nil page entries alone") + (t/is (contains? (:pages-index decoded) nil) "decode leaves nil page keys alone"))) + +(t/deftest decode-coverage-healthy-file-untouched + (let [page-id (uuid/next) + shape-id (uuid/next) + data (make-data page-id (make-rect-shape shape-id)) + _ (ctf/check-file-data (assoc data :id (uuid/next))) + decoded (decode-data data) + shape' (get-in decoded [:pages-index page-id :objects shape-id])] + ;; NOTE: no whole-map equality here: decode materializes domain + ;; records (Shape, Point, ...), which is the normal in-memory + ;; representation (setup-shape builds the same records). + (t/is (= (:type (get-in data [:pages-index page-id :objects shape-id])) + (:type shape')) + "decode preserves shape type") + (t/is (= #{page-id} (set (:pages decoded))) "decode preserves page refs") + (t/is (contains? (:pages-index decoded) page-id) "decode preserves page keys") + (t/is (some? (ctf/check-file-data (assoc decoded :id (uuid/next)))) + "decoded healthy data stays valid"))) + +(defn- valid-shape? + [data page-id shape-id] + (let [shape (get-in data [:pages-index page-id :objects shape-id])] + (and (= :rect (:type shape)) + (uuid? (:id shape)) + (uuid? (:parent-id shape)) + (uuid? (:frame-id shape))))) + +(t/deftest migration-0027-converts-unconverted-types-in-pages + (let [page-id (uuid/next) + shape-id (uuid/next) + data (-> (make-data page-id (make-rect-shape shape-id)) + (thf/corrupt-shape-types) + (assoc :custom-attr "kept")) + data' (cfm/migrate-data data "0027-repair-unconverted-types-and-nil-pages") + shape (get-in data' [:pages-index page-id :objects shape-id])] + (t/is (valid-shape? data' page-id shape-id) "types and ids converted back") + (t/is (contains? (:pages-index data') page-id) "page key converted back") + (t/is (= [page-id] (:pages data')) "page refs converted back") + (t/is (= "kept" (:custom-attr data')) "unknown keys preserved") + (t/is (some? (ctf/check-file-data (assoc data' :id (uuid/next)))) + "migrated data validates"))) + +(t/deftest migration-0027-converts-unconverted-types-in-components + (let [page-id (uuid/next) + shape-id (uuid/next) + component-id (uuid/next) + data {:pages-index + {page-id {:id page-id + :name "Page 1" + :objects {uuid/zero (make-root-shape page-id)}}} + :components + {(str component-id) {:id (str component-id) + :name "Component" + :objects {shape-id (make-rect-shape shape-id)}}}} + data (-> data + (update-in [:components (str component-id) :objects] + (fn [objects] + (into {} + (map (fn [[id shape]] + [(keyword (str id)) + (-> shape + (assoc :type (name (:type shape))) + (assoc :id (str (:id shape))))])) + objects)))) + data' (cfm/migrate-data data "0027-repair-unconverted-types-and-nil-pages") + shape (get-in data' [:components component-id :objects shape-id])] + (t/is (= :rect (:type shape)) "component shape type converted") + (t/is (uuid? (:id shape)) "component shape id converted") + (t/is (contains? (:components data') component-id) "component key converted") + (t/is (= component-id (get-in data' [:components component-id :id])) + "component id converted") + (t/is (contains? (get-in data' [:components component-id :objects]) shape-id) + "component object key converted"))) + +(t/deftest migration-0027-drops-nil-pages + (let [page-id (uuid/next) + shape-id (uuid/next) + data (-> (make-data page-id (make-rect-shape shape-id)) + (update :pages conj nil) + (assoc-in [:pages-index nil] + {:id nil :name "ghost" :objects {}})) + data' (cfm/migrate-data data "0027-repair-unconverted-types-and-nil-pages")] + (t/is (not-any? nil? (:pages data')) "nil page refs removed") + (t/is (not (contains? (:pages-index data') nil)) "nil page key removed") + (t/is (some? (ctf/check-file-data (assoc data' :id (uuid/next)))) + "migrated data validates"))) + +(t/deftest migration-0027-leaves-valid-data-untouched + (let [page-id (uuid/next) + shape-id (uuid/next) + data (assoc (make-data page-id (make-rect-shape shape-id)) + :id (uuid/next)) + data' (cfm/migrate-data data "0027-repair-unconverted-types-and-nil-pages")] + (t/is (some? (ctf/check-file-data data')) "healthy data stays valid"))) + +(t/deftest migration-0027-is-idempotent + (let [page-id (uuid/next) + shape-id (uuid/next) + data (-> (make-data page-id (make-rect-shape shape-id)) + (thf/corrupt-shape-types)) + data' (cfm/migrate-data data "0027-repair-unconverted-types-and-nil-pages") + data'' (cfm/migrate-data data' "0027-repair-unconverted-types-and-nil-pages")] + (t/is (= data' data'') "second run is a no-op"))) + +(t/deftest migration-0027-runs-through-migrate + (let [file-id (uuid/next) + page-id (uuid/next) + shape-id (uuid/next) + data (-> (make-data page-id (make-rect-shape shape-id)) + (thf/corrupt-shape-types)) + file {:id file-id + :features #{} + :migrations (disj cfm/available-migrations + "0027-repair-unconverted-types-and-nil-pages") + :data data} + file' (cfm/migrate file nil)] + ;; migrate itself validates at the end, so returning is passing. + (t/is (contains? (:migrations file') "0027-repair-unconverted-types-and-nil-pages") + "migration marked as applied") + (t/is (valid-shape? (:data file') page-id shape-id) + "migrated file data has converted types"))) diff --git a/common/test/common_tests/files_migrations_test.cljc b/common/test/common_tests/files_migrations_test.cljc index cb27492b6a..f0b8dbc570 100644 --- a/common/test/common_tests/files_migrations_test.cljc +++ b/common/test/common_tests/files_migrations_test.cljc @@ -87,7 +87,7 @@ (t/is (nil? (:stroke-cap-start shape)) "top-level cap removed even with no strokes") (t/is (nil? (:stroke-cap-end shape)) "top-level cap removed even with no strokes")))) -(t/deftest migration-0028-normalizes-constrained-shape-values +(t/deftest migration-0029-normalizes-constrained-shape-values (let [file-id (uuid/next) page-id (uuid/next) shape-id (uuid/next) @@ -142,7 +142,7 @@ (ctf/check-file-data data)) "new schemas reject legacy negative values") - (let [data' (cfm/migrate-data data "0028-normalize-constrained-values") + (let [data' (cfm/migrate-data data "0029-normalize-constrained-values") shape' (get-in data' [:pages-index page-id :objects shape-id])] (t/is (= data' (ctf/check-file-data data')) "migrated file data passes the schema") (t/is (every? zero? (map #(get shape' %) [:r1 :r2 :r3 :r4])) "corner radii clamped") @@ -167,7 +167,7 @@ (t/is (= 0.01 (get-in shape' [:grids 0 :params :size])) "square grid size clamped") (t/is (= 1 (get-in shape' [:grids 1 :params :size])) "column grid count clamped")))) -(t/deftest migration-0028-normalizes-page-grids-and-variant-properties +(t/deftest migration-0029-normalizes-page-grids-and-variant-properties (let [file-id (uuid/next) page-id (uuid/next) component-id (uuid/next) @@ -186,7 +186,7 @@ :name "Variant" :variant-properties [{:name long-name :value long-value}]})) - data' (cfm/migrate-data data "0028-normalize-constrained-values")] + data' (cfm/migrate-data data "0029-normalize-constrained-values")] (t/is (= 0.01 (get-in data' [:pages-index page-id :default-grids :square :size])) "default square grid size clamped") @@ -198,11 +198,11 @@ "variant property name truncated") (t/is (= 60 (count (get-in data' [:components component-id :variant-properties 0 :value]))) "variant property value truncated") - (t/is (= data' (cfm/migrate-data data' "0028-normalize-constrained-values")) + (t/is (= data' (cfm/migrate-data data' "0029-normalize-constrained-values")) "migration is idempotent"))) -(t/deftest migration-0028-runs-through-file-migration - (let [migration-id "0028-normalize-constrained-values" +(t/deftest migration-0029-runs-through-file-migration + (let [migration-id "0029-normalize-constrained-values" shape-id (uuid/next) file (ctf/make-file {:name "Legacy constrained values"}) page-id (first (get-in file [:data :pages])) @@ -219,8 +219,8 @@ (t/is (zero? (get-in file' [:data :pages-index page-id :objects shape-id :r1])) "migration repaired file data before schema validation"))) -(t/deftest migration-0029-moves-background-blur-out-of-blur - (let [migration-id "0029-move-background-blur-out-of-blur" +(t/deftest migration-0030-moves-background-blur-out-of-blur + (let [migration-id "0030-move-background-blur-out-of-blur" file-id (uuid/next) page-id (uuid/next) shape-id (uuid/next) @@ -248,8 +248,8 @@ (t/is (= data' (cfm/migrate-data data' migration-id)) "migration is idempotent")))) -(t/deftest migration-0029-keeps-existing-background-blur - (let [migration-id "0029-move-background-blur-out-of-blur" +(t/deftest migration-0030-keeps-existing-background-blur + (let [migration-id "0030-move-background-blur-out-of-blur" page-id (uuid/next) shape-id (uuid/next) existing-bg {:id (uuid/next) @@ -270,8 +270,8 @@ (t/is (= existing-bg (:background-blur shape')) "existing background blur preserved"))) -(t/deftest migration-0029-leaves-layer-blur-untouched - (let [migration-id "0029-move-background-blur-out-of-blur" +(t/deftest migration-0030-leaves-layer-blur-untouched + (let [migration-id "0030-move-background-blur-out-of-blur" page-id (uuid/next) shape-id (uuid/next) blur {:id (uuid/next) @@ -287,8 +287,8 @@ (t/is (= blur (:blur shape')) "layer blur untouched") (t/is (nil? (:background-blur shape')) "no background blur created"))) -(t/deftest migration-0029-migrates-component-blurs - (let [migration-id "0029-move-background-blur-out-of-blur" +(t/deftest migration-0030-migrates-component-blurs + (let [migration-id "0030-move-background-blur-out-of-blur" component-id (uuid/next) shape-id (uuid/next) blur {:id (uuid/next) @@ -305,8 +305,8 @@ (t/is (= blur (:background-blur shape')) "component background blur moved to its own attribute"))) -(t/deftest migration-0029-runs-through-file-migration - (let [migration-id "0029-move-background-blur-out-of-blur" +(t/deftest migration-0030-runs-through-file-migration + (let [migration-id "0030-move-background-blur-out-of-blur" shape-id (uuid/next) blur-id (uuid/next) blur {:id blur-id @@ -330,8 +330,8 @@ (t/is (nil? (get-in file' [:data :pages-index page-id :objects shape-id :blur])) "mis-typed :blur removed"))) -(t/deftest migration-0030-removes-stroke-per-side-attr - (let [migration-id "0030-remove-stroke-per-side-attr" +(t/deftest migration-0031-removes-stroke-per-side-attr + (let [migration-id "0031-remove-stroke-per-side-attr" page-id (uuid/next) shape-id (uuid/next) stroke {:stroke-width 2 @@ -359,8 +359,8 @@ (t/is (= data' (cfm/migrate-data data' migration-id)) "migration is idempotent"))) -(t/deftest migration-0030-repairs-strokes-rejected-by-schema - (let [migration-id "0030-remove-stroke-per-side-attr" +(t/deftest migration-0031-repairs-strokes-rejected-by-schema + (let [migration-id "0031-remove-stroke-per-side-attr" file-id (uuid/next) page-id (uuid/next) shape-id (uuid/next) @@ -384,8 +384,8 @@ (t/is (= data' (ctf/check-file-data data')) "migrated data passes the schema")))) -(t/deftest migration-0030-repairs-component-strokes - (let [migration-id "0030-remove-stroke-per-side-attr" +(t/deftest migration-0031-repairs-component-strokes + (let [migration-id "0031-remove-stroke-per-side-attr" component-id (uuid/next) shape-id (uuid/next) stroke {:stroke-width 3 @@ -406,8 +406,8 @@ (t/is (= 5 (:stroke-width-right stroke')) "component per-side width preserved"))) -(t/deftest migration-0030-keeps-strokes-without-the-obsolete-attr - (let [migration-id "0030-remove-stroke-per-side-attr" +(t/deftest migration-0031-keeps-strokes-without-the-obsolete-attr + (let [migration-id "0031-remove-stroke-per-side-attr" page-id (uuid/next) shape-id (uuid/next) stroke {:stroke-width 2 @@ -422,8 +422,8 @@ (t/is (= data (cfm/migrate-data data migration-id)) "a stroke without the obsolete attr is left untouched"))) -(t/deftest migration-0030-keeps-distinct-sides-when-the-attr-was-false - (let [migration-id "0030-remove-stroke-per-side-attr" +(t/deftest migration-0031-keeps-distinct-sides-when-the-attr-was-false + (let [migration-id "0031-remove-stroke-per-side-attr" page-id (uuid/next) shape-id (uuid/next) ;; The old toggle set the flag to false without equalizing the sides, @@ -445,8 +445,8 @@ (t/is (= 8 (:stroke-width-right stroke')) "distinct side width kept instead of being equalized"))) -(t/deftest migration-0030-runs-through-file-migration - (let [migration-id "0030-remove-stroke-per-side-attr" +(t/deftest migration-0031-runs-through-file-migration + (let [migration-id "0031-remove-stroke-per-side-attr" shape-id (uuid/next) stroke {:stroke-width 5 :stroke-width-top 5 @@ -472,7 +472,7 @@ "obsolete attr removed before schema validation") (t/is (= 5 (:stroke-width stroke')) "stroke width preserved"))) -(t/deftest migration-0031-legacy-applied-token-is-not-recognized-before-migration +(t/deftest migration-0032-legacy-applied-token-is-not-recognized-before-migration ;; Reproduces #12016: the editor reads only the per-side token attributes, so ;; a shape carrying the old global `:stroke-width` reference looks unapplied. (let [shape (-> (cts/setup-shape {:id (uuid/next) :type :rect}) @@ -481,8 +481,8 @@ ctt/stroke-width-keys)) "a legacy applied token is invisible to the token lookup"))) -(t/deftest migration-0031-recycles-global-stroke-width-token - (let [migration-id "0031-migrate-stroke-width-token-attr" +(t/deftest migration-0032-recycles-global-stroke-width-token + (let [migration-id "0032-migrate-stroke-width-token-attr" page-id (uuid/next) shape-id (uuid/next) shape (-> (cts/setup-shape {:id shape-id :type :rect}) @@ -503,8 +503,8 @@ ctt/stroke-width-keys) "the token is recognized after migration"))) -(t/deftest migration-0031-keeps-side-token-that-was-already-set - (let [migration-id "0031-migrate-stroke-width-token-attr" +(t/deftest migration-0032-keeps-side-token-that-was-already-set + (let [migration-id "0032-migrate-stroke-width-token-attr" page-id (uuid/next) shape-id (uuid/next) shape (-> (cts/setup-shape {:id shape-id :type :rect}) @@ -518,8 +518,8 @@ "an explicit side reference is not overwritten") (t/is (= "30" (:stroke-width-right applied'))))) -(t/deftest migration-0031-repairs-component-shapes - (let [migration-id "0031-migrate-stroke-width-token-attr" +(t/deftest migration-0032-repairs-component-shapes + (let [migration-id "0032-migrate-stroke-width-token-attr" component-id (uuid/next) shape-id (uuid/next) shape (-> (cts/setup-shape {:id shape-id :type :rect}) @@ -532,8 +532,8 @@ (t/is (= "30" (:stroke-width-left applied')) "component side reference created"))) -(t/deftest migration-0031-leaves-shapes-without-the-legacy-token - (let [migration-id "0031-migrate-stroke-width-token-attr" +(t/deftest migration-0032-leaves-shapes-without-the-legacy-token + (let [migration-id "0032-migrate-stroke-width-token-attr" page-id (uuid/next) shape-id (uuid/next) shape (-> (cts/setup-shape {:id shape-id :type :rect}) @@ -546,8 +546,8 @@ (t/is (= data (cfm/migrate-data data migration-id)) "a shape without the legacy token is left untouched"))) -(t/deftest migration-0031-runs-through-file-migration - (let [migration-id "0031-migrate-stroke-width-token-attr" +(t/deftest migration-0032-runs-through-file-migration + (let [migration-id "0032-migrate-stroke-width-token-attr" shape-id (uuid/next) file (ctf/make-file {:name "Legacy stroke width token"}) page-id (first (get-in file [:data :pages])) @@ -565,8 +565,8 @@ (t/is (= "30" (:stroke-width-top applied')) "legacy token applied to the sides"))) -(t/deftest migration-0032-adds-unlisted-children-to-their-parent - (let [migration-id "0032-fix-children-not-in-parent" +(t/deftest migration-0033-adds-unlisted-children-to-their-parent + (let [migration-id "0033-fix-children-not-in-parent" page-id (uuid/next) parent-id (uuid/next) listed-id (uuid/next) @@ -602,8 +602,8 @@ (t/is (= data' (cfm/migrate-data data' migration-id)) "migration is idempotent"))) -(t/deftest migration-0032-adds-unlisted-children-in-components - (let [migration-id "0032-fix-children-not-in-parent" +(t/deftest migration-0033-adds-unlisted-children-in-components + (let [migration-id "0033-fix-children-not-in-parent" component-id (uuid/next) main-id (uuid/next) child-id (uuid/next) @@ -714,8 +714,8 @@ (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" +(t/deftest migration-0034-normalize-main-instance-diff-from-component + (let [migration-id "0034-normalize-main-instance-names" file (-> (thf/sample-file :file1) (tho/add-simple-component :component1 :root1 :child1 :component-params {:path "Group / Subgroup" @@ -745,8 +745,8 @@ (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" +(t/deftest migration-0034-normalize-variant-instance-diff-from-container + (let [migration-id "0034-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") @@ -777,8 +777,8 @@ (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" +(t/deftest migration-0034-normalize-variant-name-not-normalized + (let [migration-id "0034-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") diff --git a/common/test/common_tests/files_pages_test.cljc b/common/test/common_tests/files_pages_test.cljc new file mode 100644 index 0000000000..01752a31ee --- /dev/null +++ b/common/test/common_tests/files_pages_test.cljc @@ -0,0 +1,98 @@ +;; 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.files-pages-test + "Regression tests for the nil-page writer + (see https://github.com/penpot/penpot/issues/12433). + + Production files turned up with a nil entry in `:pages` and a nil + key in `:pages-index` (the shape legacy-57 cleans). The writer was + `:add-page` with a page missing a valid `:id`: the change schema + leaves `:page` unchecked (`:any`) and nothing else stopped it, so a + nil page was persisted whenever validation was skipped or soft. + `process-change :add-page` now asserts a valid page id up front, + like `:del-page` already did." + (:require + [app.common.files.validate :as cfv] + [app.common.test-helpers.files :as thf] + [app.common.test-helpers.ids-map :as thi] + [app.common.uuid :as uuid] + [clojure.test :as t])) + +(t/use-fixtures :each thi/test-fixture) + +(defn- schema-status + [file] + (try + (cfv/validate-file-schema! file) + :valid + (catch #?(:clj Exception :cljs js/Error) e + [:invalid (ex-message e)]))) + +(t/deftest add-page-without-id-is-rejected + (let [file (thf/sample-file :file)] + (try + (thf/apply-changes file + {:redo-changes [{:type :add-page :page {:name "Ghost"}}]} + :validate? false) + (t/is false "expected exception to be thrown") + (catch #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core.ExceptionInfo) e + (let [data (ex-data e)] + (t/is (= :validation (:type data))) + (t/is (= "add-page requires a page with a valid :id" (ex-message e)))))))) + +(t/deftest mov-page-with-nil-id-is-rejected-at-change-level + (let [file (thf/sample-file :file)] + (t/is (thrown? #?(:clj Exception :cljs js/Error) + (thf/apply-changes file + {:redo-changes [{:type :mov-page :id nil :index 0}]} + :validate? false)) + "mov-page with nil id never reaches the file"))) + +(t/deftest del-missing-page-is-a-no-op + (let [file (thf/sample-file :file) + file' (thf/apply-changes file + {:redo-changes [{:type :del-page :id (uuid/next)}]} + :validate? false) + data (:data file')] + (t/is (not-any? nil? (:pages data)) "no nil page refs") + (t/is (not (contains? (:pages-index data) nil)) "no nil page keys") + (t/is (= :valid (schema-status file')) "stays schema-valid"))) + +(t/deftest mov-page-out-of-range-keeps-valid + (let [file (thf/sample-file :file) + page (thf/current-page file) + file' (thf/apply-changes file + {:redo-changes [{:type :mov-page :id (:id page) :index 99}]} + :validate? false) + data (:data file')] + (t/is (not-any? nil? (:pages data)) "no nil page refs") + (t/is (= :valid (schema-status file')) "stays schema-valid"))) + +(t/deftest add-page-roundtrip-stays-valid + (let [file (thf/sample-file :file) + page-id (uuid/next) + file' (thf/apply-changes file + {:redo-changes [{:type :add-page + :id page-id + :name "Second"}]})] + (t/is (some #(= page-id %) (:pages (:data file'))) "page ref stored") + (t/is (some? (get-in file' [:data :pages-index page-id])) "page stored") + (t/is (= :valid (schema-status file')) "stays schema-valid"))) + +(t/deftest add-page-with-mismatched-id-is-rejected + (let [file (thf/sample-file :file)] + (try + (thf/apply-changes file + {:redo-changes [{:type :add-page + :id (uuid/next) + :page {:id (uuid/next) :name "Ghost"}}]} + :validate? false) + (t/is false "expected exception to be thrown") + (catch #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core.ExceptionInfo) e + (let [data (ex-data e)] + (t/is (= :conflict (:type data))) + (t/is (= "id and page should agree" (ex-message e)))))))) diff --git a/common/test/common_tests/runner.cljc b/common/test/common_tests/runner.cljc index e78fbf3da9..fde035281f 100644 --- a/common/test/common_tests/runner.cljc +++ b/common/test/common_tests/runner.cljc @@ -22,7 +22,9 @@ [common-tests.files-changes-test] [common-tests.files-migrations-0025-test] [common-tests.files-migrations-0026-test] + [common-tests.files-migrations-0027-test] [common-tests.files-migrations-test] + [common-tests.files-pages-test] [common-tests.files.comp-processors-test] [common-tests.files.helpers-test] [common-tests.files.repair-test] @@ -95,6 +97,7 @@ [common-tests.types.color-test] [common-tests.types.components-test] [common-tests.types.container-test] + [common-tests.types.file-sanitize-test] [common-tests.types.fill-test] [common-tests.types.font-test] [common-tests.types.modifiers-test] @@ -128,9 +131,11 @@ 'common-tests.files-changes-test 'common-tests.files-migrations-0025-test 'common-tests.files-migrations-0026-test + 'common-tests.files-migrations-0027-test 'common-tests.files-migrations-test 'common-tests.files.comp-processors-test 'common-tests.files.helpers-test + 'common-tests.files-pages-test 'common-tests.files.repair-test 'common-tests.files.shapes-builder-test 'common-tests.files.tokens-test @@ -201,6 +206,7 @@ 'common-tests.types.color-test 'common-tests.types.components-test 'common-tests.types.container-test + 'common-tests.types.file-sanitize-test 'common-tests.types.fill-test 'common-tests.types.font-test 'common-tests.types.modifiers-test diff --git a/common/test/common_tests/types/file_sanitize_test.cljc b/common/test/common_tests/types/file_sanitize_test.cljc new file mode 100644 index 0000000000..316dac815f --- /dev/null +++ b/common/test/common_tests/types/file_sanitize_test.cljc @@ -0,0 +1,118 @@ +;; 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.types.file-sanitize-test + "Pins the behavior of `ctf/sanitize-file-data`: it coerces the + unconverted types seen in production (strings where the schema + expects keywords or uuids) and drops nil page entries, while + leaving genuinely unknown values untouched so downstream + validation still fails loudly." + (:require + [app.common.test-helpers.files :as thf] + [app.common.types.file :as ctf] + [app.common.types.objects-map :as omap] + [app.common.types.shape :as cts] + [app.common.uuid :as uuid] + [clojure.test :as t])) + +(defn- make-rect-shape + [shape-id] + (cts/setup-shape {:id shape-id + :name "rect" + :type :rect + :x 0 :y 0 :width 10 :height 10 + :parent-id uuid/zero + :frame-id uuid/zero})) + +(defn- make-root-shape + [shape-id] + (cts/setup-shape {:id uuid/zero + :name "root" + :type :frame + :parent-id uuid/zero + :frame-id uuid/zero + :shapes [shape-id]})) + +(defn- make-data + "Minimal file data with a single page holding a single rect shape." + [page-id shape] + (let [shape-id (:id shape)] + {:pages [page-id] + :pages-index + {page-id {:id page-id + :name "Page 1" + :objects {uuid/zero (make-root-shape shape-id) + shape-id shape}}}})) + +(t/deftest sanitize-coerces-unconverted-types + (let [page-id (uuid/next) + shape-id (uuid/next) + data (thf/corrupt-shape-types + (make-data page-id (make-rect-shape shape-id))) + data' (ctf/sanitize-file-data data) + shape' (get-in data' [:pages-index page-id :objects shape-id])] + (t/is (= [page-id] (:pages data')) "string page refs become uuids") + (t/is (contains? (:pages-index data') page-id) "string page keys become uuids") + (t/is (= :rect (:type shape')) "string shape type becomes a keyword") + (t/is (uuid? (:id shape')) "string shape id becomes a uuid"))) + +(t/deftest sanitize-drops-nil-pages + (let [page-id (uuid/next) + shape-id (uuid/next) + data (-> (make-data page-id (make-rect-shape shape-id)) + (update :pages conj nil) + (assoc-in [:pages-index nil] {:id nil :name "ghost" :objects {}})) + data' (ctf/sanitize-file-data data)] + (t/is (= [page-id] (:pages data')) "nil page entries are dropped") + (t/is (not (contains? (:pages-index data') nil)) "nil page keys are dropped"))) + +(t/deftest sanitize-leaves-unknown-values-untouched + (let [page-id (uuid/next) + shape-id (uuid/next) + data (make-data page-id + (assoc (make-rect-shape shape-id) :type "triangle")) + data' (ctf/sanitize-file-data data) + shape' (get-in data' [:pages-index page-id :objects shape-id])] + (t/is (= :triangle (:type shape')) + "decode keywordizes the string, but the value stays out of schema") + (t/is (thrown? #?(:clj clojure.lang.ExceptionInfo :cljs cljs.core.ExceptionInfo) + (ctf/check-file-data data')) + "downstream validation still fails loudly") + (t/is (= data' (ctf/sanitize-file-data data')) + "sanitize is idempotent"))) + +(t/deftest sanitize-returns-same-instance-when-clean + ;; Clean data needs no repair: sanitize must return the input as + ;; is (same instance) so nothing gets re-materialized nor needs + ;; re-diffing downstream to tell change apart from no-op. + (let [page-id (uuid/next) + shape-id (uuid/next) + data (make-data page-id (make-rect-shape shape-id))] + (t/is (identical? data (ctf/sanitize-file-data data))))) + +(t/deftest sanitize-keeps-objects-map-when-clean + ;; Same contract for a lazy objects-map container: the untouched + ;; input comes back with the same instance, so the container stays + ;; lazy and objectless entries are never decoded for nothing. + (let [page-id (uuid/next) + shape-id (uuid/next) + objects (omap/wrap {uuid/zero (make-root-shape shape-id) + shape-id (make-rect-shape shape-id)}) + data (assoc-in (make-data page-id (make-rect-shape shape-id)) + [:pages-index page-id :objects] objects)] + (t/is (identical? objects + (get-in (ctf/sanitize-file-data data) + [:pages-index page-id :objects])) + "the objects-map container survives unchanged"))) + +(t/deftest sanitize-returns-new-instance-when-repairing + ;; Positive control for the identity contract: real corruption + ;; yields coerced values and therefore a genuinely new instance. + (let [page-id (uuid/next) + shape-id (uuid/next) + data (thf/corrupt-shape-types + (make-data page-id (make-rect-shape shape-id)))] + (t/is (not (identical? data (ctf/sanitize-file-data data))))))