penpot/backend/test/backend_tests/storage_metadata_test.clj
Andrey Antukh d67a00c1d5
✨ Normalize storage metadata with a closed schema (#11987)
* ✨ Add Malli schema for storage metadata with dual decode

Phase 1 of the storage_object.metadata migration: reads accept both
Transit and plain JSON (sniffed by the marker) and always return the
normalized shape; writes validate against a closed per-bucket Malli
schema and still serialize as Transit unless the new
:storage-metadata-as-json config flag is set.

The 0155 migration normalizes existing rows inside Transit (reference
to bucket, default bucket, drop of chunk leftovers) and is
idempotent; large instances should fake it and run the batched
script instead.

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

* ♻️ Address review findings on storage metadata Phase 1

Collapse the dead :reference leg of the gc-touched bucket fallback
(the decode always sets :bucket on non-nil metadata, so it is only
reachable with a NULL column) and fix its comment.

Pin the write flag off in the transit-assuming metadata tests so the
suite proves the same with the flag set, and add coverage for the
flag rollback contract, JSON hash survival, NULL metadata in
gc-touched, and the 0155 normalization statements.

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

* ♻️ Backfill NULLs, canonical buckets, comment fix

Backfill NULL metadata columns in 0155 via coalesce (the key-missing
rule already matches them), derive valid-buckets from the Malli schema
dispatch entries so the list lives in one place, and correct the
lookup-bucket fallback comment to NULL columns.

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

* ♻️ Defer corrupt metadata rows in storage gc-touched

Decode touched rows individually so one non-map metadata value no
longer aborts the whole chunk: corrupt rows are logged and deferred
exactly one day in the same transaction, keeping their metadata
intact for a later repair, while healthy rows process normally.

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

* ♻️ Address storage metadata phase 1 review findings

Address the review findings on the storage metadata phase 1 branch:

- Fix put-and-delete-object: it stored the object with
  ::sto/expired-at, so the row was already deleted and del-object!
  returned false. Add delete-expired-object-returns-false to keep
  the expired-delete case covered.
- Cache the Malli decoder and encoder per process. Building them
  compiles the closed multi-dispatch schema, and decode-metadata
  runs on every read path (get-object, dedup probes, GC batches).
- Catch Exception instead of Throwable in try-decode-row so JVM
  Errors are not deferred as corrupt metadata.
- Add penpot_storage_gc_poison_total, emitted from
  storage-gc-touched; wire ::mtx/metrics into its handler.
- Anchor the encoding sniff to the start of the document so a
  plain JSON value that begins with a Transit-looking prefix is
  not read as Transit.
- Cover every bucket on both encodings, a JSON roundtrip through
  the jsonb column, nil metadata, the canonical bucket set and a
  poison-only GC chunk.
- Rename private check-metadata! to check-metadata.

AI-assisted-by: deepseek-v4.1-flash

* ♻️ Simplify the storage metadata schema to a single map

Replace the per-bucket :multi dispatch with a single closed map: the
bucket is validated with ::sm/one-of over metadata-buckets (now a plain
set) and the remaining keys are typed optional fields. Per-bucket
enforcement shrinks to a one-line :fn guard requiring :file-id and :id
for file-data, whose ids the GC reads to resolve references.

- Drop the dead (sm/register! ::metadata ...): nothing references the
  schema by keyword.
- Define tempfile-bucket and upload-session-bucket in the schema and
  alias them from app.storage, removing duplicated literals.
- Keep content-type required and the map closed, so an unknown bucket
  or key still fails fast on write.

AI-assisted-by: deepseek-v4.1-flash

* ♻️ Drop input coercion from encode-metadata

encode-metadata no longer runs the json-transformer decoder before
validation. On the write path its only effect was coercing string
UUIDs to UUID, and every producer already passes native UUIDs (the
RPC profile-id, uuid/random, or binfile ids decoded as ::sm/uuid).
Reads keep decoding, so stored Transit or JSON values still come
back as native types.

- Replace encode-accepts-string-uuids with
  encode-rejects-string-uuids, pinning the stricter contract.
- Pass native UUIDs in encode-writes-plain-json-with-flag.

AI-assisted-by: deepseek-v4.1-flash

* 📚 Document each statement in the storage metadata migration

Move the per-statement rules out of the header and add a comment to each
UPDATE explaining what it does: drop chunk leftovers, promote the legacy
"~:reference" to "~:bucket", drop residual "~:reference", and backfill the
default bucket. The header keeps the scope, the encoding note, the `->`
vs `?` note and the large-instance warning.

AI-assisted-by: deepseek-v4.1-flash

* 📚 Unwrap wrapped lines in the backend storage memory

One line per bullet or paragraph, as mem:memory-maintenance requires.
Only formatting; no content change.

AI-assisted-by: deepseek-v4.1-flash

* ♻️ Defer storage GC poison rows in their own transaction

process-chunk! no longer takes poison-ids; it only processes the healthy
chunk. The deferral moves to defer-poison! and process-touched! runs it in
its own transaction, separate from the freeze/delete work. The loop still
drains while there is chunk or poison, so a batch made only of poison rows
does not leave healthy rows behind the LIMIT 10 waiting for the next run.

Add a regression test: ten poison rows plus one healthy row with a later
touched_at are all handled in the same run.

AI-assisted-by: deepseek-v4.1-flash

* ♻️ Declare per-bucket metadata requirements in one map

Replace the file-data-specific predicate with bucket-requirements, a map
from bucket to the extra keys it must carry. metadata-buckets is derived
from its keys and a single generic :fn enforces presence, so a new bucket
and its contract are one entry. organization now requires
:organization-id; file-data keeps requiring :file-id and :id.

Update the http-assets test helper to set organization-id for its
organization objects.

AI-assisted-by: deepseek-v4.1-flash

* ♻️ Drop the ! suffix from storage GC helpers

Rename the internal helpers in app.storage.gc-touched (process-chunk,
defer-poison, mark-freeze-in-bulk, ...) to drop the trailing !.

AI-assisted-by: deepseek-v4.1-flash

* ♻️ Drop the ! suffix from storage GC deleted helpers

Rename the internal helpers in app.storage.gc-deleted (clean-deleted,
delete-sobjects, delete-give-up, ...) to drop the trailing !.

AI-assisted-by: deepseek-v4.1-flash

* 🐛 Fix dedup lookup for JSON-encoded storage metadata

get-database-object-by-hash only matched the Transit keys, so once the
:storage-metadata-as-json flag wrote plain JSON rows the dedup stopped
finding them and duplicated blobs. Match both encodings with a UNION ALL
of two indexable branches.

- Add migration 0156 with the plain-key dedup index; the legacy 0068
  index stays until Transit support is removed.
- Cover it with a JSON dedup test and a Transit -> JSON cross test.

AI-assisted-by: deepseek-v4.1-flash
2026-10-01 07:19:21 +02:00

277 lines
13 KiB
Clojure

;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS SUBSIDIARY SL
(ns backend-tests.storage-metadata-test
(:require
[app.config :as cf]
[app.db :as db]
[app.storage.schema :as stsch]
[clojure.string :as str]
[clojure.test :as t])
(:import
org.postgresql.util.PGobject))
(defn- pgobject
[^String value]
(doto (PGobject.)
(.setType "jsonb")
(.setValue value)))
;; Raw Transit payloads shaped like the production rows sampled on
;; 2026-09-11 (verbose transit: "~:key" keys, "~u<uuid>" uuid values,
;; "~:xxx" keyword values).
(def ^:private transit-media
"{\"~:hash\":\"blake2b:9f1c2e\",\"~:bucket\":\"file-media-object\",\"~:content-type\":\"image/png\"}")
(def ^:private transit-tempfile
"{\"~:hash\":\"blake2b:9f1c2e\",\"~:bucket\":\"tempfile\",\"~:content-type\":\"application/zip\",\"~:profile-id\":\"~u86907e95-1cb8-8122-8008-4eb7ba07d89d\"}")
(def ^:private transit-legacy-reference
"{\"~:reference\":\"~:file-media-object\",\"~:content-type\":\"image/png\",\"~:hash\":\"blake2b:9f1c2e\"}")
(def ^:private transit-no-bucket
"{\"~:content-type\":\"image/svg+xml\"}")
(def ^:private transit-chunk-leftovers
"{\"~:bucket\":\"tempfile\",\"~:content-type\":\"application/zip\",\"~:upload-id\":\"~u86907e95-1cb8-8122-8008-4eb7ba07d89d\",\"~:chunk-index\":3}")
(def ^:private json-file-data
"{\"bucket\":\"file-data\",\"content-type\":\"application/octet-stream\",\"file-id\":\"86907e95-1cb8-8122-8008-4eb7ba07d89d\",\"id\":\"83df2f92-6bd4-4e6d-9c9a-3f6d2b1a4c55\"}")
(t/deftest decode-transit-returns-native-types
(let [mdata (stsch/decode-metadata (pgobject transit-tempfile))]
(t/is (= "tempfile" (:bucket mdata)))
(t/is (= "application/zip" (:content-type mdata)))
(t/is (= "blake2b:9f1c2e" (:hash mdata)))
(t/is (uuid? (:profile-id mdata)))
(t/is (= (parse-uuid "86907e95-1cb8-8122-8008-4eb7ba07d89d")
(:profile-id mdata)))))
(t/deftest decode-transit-maps-reference-to-bucket
(let [mdata (stsch/decode-metadata (pgobject transit-legacy-reference))]
(t/is (= "file-media-object" (:bucket mdata)))
(t/is (= "image/png" (:content-type mdata)))
(t/is (not (contains? mdata :reference)))))
(t/deftest decode-transit-defaults-missing-bucket
(let [mdata (stsch/decode-metadata (pgobject transit-no-bucket))]
(t/is (= "file-media-object" (:bucket mdata)))
(t/is (= "image/svg+xml" (:content-type mdata)))))
(t/deftest decode-transit-drops-chunk-leftovers
(let [mdata (stsch/decode-metadata (pgobject transit-chunk-leftovers))]
(t/is (= "tempfile" (:bucket mdata)))
(t/is (not (contains? mdata :upload-id)))
(t/is (not (contains? mdata :chunk-index)))))
(t/deftest decode-json-coerces-uuids
(let [mdata (stsch/decode-metadata (pgobject json-file-data))]
(t/is (= "file-data" (:bucket mdata)))
(t/is (uuid? (:file-id mdata)))
(t/is (uuid? (:id mdata)))
(t/is (= (parse-uuid "86907e95-1cb8-8122-8008-4eb7ba07d89d")
(:file-id mdata)))))
(t/deftest sniff-has-no-false-positives-on-values
;; "~:" inside a value (not anchored to a quote) must not trigger
;; the transit branch.
(let [mdata (stsch/decode-metadata
(pgobject "{\"bucket\":\"tempfile\",\"content-type\":\"text/plain;~:x\"}"))]
(t/is (= "tempfile" (:bucket mdata)))
(t/is (= "text/plain;~:x" (:content-type mdata)))))
(t/deftest encode-writes-transit-by-default
;; Pinned off: without the binding this test inherits the ambient
;; config and proves nothing where the flag is set.
(binding [cf/config (assoc cf/config :storage-metadata-as-json nil)]
(let [encoded (stsch/encode-metadata {:bucket "file-media-object"
:content-type "image/png"
:hash "blake2b:9f1c2e"})
value (.getValue ^PGobject encoded)]
(t/is (string? value))
(t/is (str/includes? value "\"~:bucket\""))
(t/is (not (str/includes? value "\"~:reference\""))))))
(t/deftest encode-normalizes-legacy-input
(binding [cf/config (assoc cf/config :storage-metadata-as-json nil)]
(let [encoded (stsch/encode-metadata {:reference :file-media-object
:content-type "image/png"})
value (.getValue ^PGobject encoded)
decoded (stsch/decode-metadata encoded)]
(t/is (= "file-media-object" (:bucket decoded)))
(t/is (not (str/includes? value "\"~:reference\""))))))
(t/deftest encode-writes-plain-json-with-flag
(binding [cf/config (assoc cf/config :storage-metadata-as-json true)]
(let [file-id (parse-uuid "86907e95-1cb8-8122-8008-4eb7ba07d89d")
encoded (stsch/encode-metadata {:bucket "file-data"
:content-type "application/octet-stream"
:file-id file-id
:id (parse-uuid "83df2f92-6bd4-4e6d-9c9a-3f6d2b1a4c55")})
value (.getValue ^PGobject encoded)]
(t/is (str/includes? value "\"bucket\""))
(t/is (not (str/includes? value "\"~:")))
;; uuids travel as plain strings on the JSON encoding
(t/is (str/includes? value (str file-id)))
(let [decoded (stsch/decode-metadata encoded)]
(t/is (uuid? (:file-id decoded)))
(t/is (= file-id (:file-id decoded)))))))
(t/deftest encode-rejects-string-uuids
;; Encoding does not coerce input types: callers must pass native UUIDs
;; (every producer does; reads still coerce on the way back).
(t/is (thrown-with-msg? clojure.lang.ExceptionInfo
#"invalid storage object metadata"
(stsch/encode-metadata {:bucket "tempfile"
:content-type "application/zip"
:profile-id "86907e95-1cb8-8122-8008-4eb7ba07d89d"}))))
(t/deftest encode-rejects-unknown-bucket
(t/is (thrown-with-msg? clojure.lang.ExceptionInfo
#"invalid storage object metadata"
(stsch/encode-metadata {:bucket "no-such-bucket"
:content-type "image/png"}))))
(t/deftest encode-rejects-extra-key
(t/is (thrown-with-msg? clojure.lang.ExceptionInfo
#"invalid storage object metadata"
(stsch/encode-metadata {:bucket "file-media-object"
:content-type "image/png"
:other "data"}))))
(t/deftest encode-rejects-malformed-uuid
(t/is (thrown-with-msg? clojure.lang.ExceptionInfo
#"invalid storage object metadata"
(stsch/encode-metadata {:bucket "file-data"
:content-type "application/octet-stream"
:file-id "not-a-uuid"
:id "83df2f92-6bd4-4e6d-9c9a-3f6d2b1a4c55"}))))
(t/deftest encode-rejects-missing-content-type
(t/is (thrown-with-msg? clojure.lang.ExceptionInfo
#"invalid storage object metadata"
(stsch/encode-metadata {:bucket "file-media-object"}))))
(t/deftest encode-rejects-missing-file-data-ids
;; Both ids are required for file-data; omitting one fails the bucket
;; requirement check (the file-id here is a native UUID, so the map
;; itself is valid).
(t/is (thrown-with-msg? clojure.lang.ExceptionInfo
#"invalid storage object metadata"
(stsch/encode-metadata {:bucket "file-data"
:content-type "application/octet-stream"
:file-id (parse-uuid "86907e95-1cb8-8122-8008-4eb7ba07d89d")}))))
(t/deftest encode-rejects-missing-organization-id
(t/is (thrown-with-msg? clojure.lang.ExceptionInfo
#"invalid storage object metadata"
(stsch/encode-metadata {:bucket "organization"
:content-type "image/svg+xml"}))))
(t/deftest decode-real-transit-payload
;; Same legacy shape as above but produced by the real transit
;; encoder, so the test breaks if the encoding ever drifts.
(let [mdata (stsch/decode-metadata
(db/tjson {:reference :team-font-variant
:content-type "font/woff2"}))]
(t/is (= "team-font-variant" (:bucket mdata)))
(t/is (not (contains? mdata :reference)))))
(t/deftest transit-and-json-encodings-decode-to-same-shape
(let [mdata {:bucket "tempfile"
:content-type "application/zip"
:profile-id (parse-uuid "86907e95-1cb8-8122-8008-4eb7ba07d89d")}
transit (binding [cf/config (assoc cf/config :storage-metadata-as-json nil)]
(stsch/decode-metadata (stsch/encode-metadata mdata)))
json (binding [cf/config (assoc cf/config :storage-metadata-as-json true)]
(stsch/decode-metadata (stsch/encode-metadata mdata)))]
(t/is (= transit json))
(t/is (= mdata json))))
(t/deftest flag-on-and-off-differ-only-in-encoding-family
;; The Phase 2 rollback contract: flipping the flag changes how the
;; same logical metadata hits the disk, never what it means.
(let [mdata {:bucket "file-media-object"
:content-type "image/png"
:hash "blake2b:9f1c2e"}
transit (binding [cf/config (assoc cf/config :storage-metadata-as-json nil)]
(.getValue ^PGobject (stsch/encode-metadata mdata)))
json (binding [cf/config (assoc cf/config :storage-metadata-as-json true)]
(.getValue ^PGobject (stsch/encode-metadata mdata)))]
(t/is (str/includes? transit "\"~:bucket\""))
(t/is (str/includes? json "\"bucket\""))
(t/is (not (str/includes? json "\"~:")))
(t/is (= (stsch/decode-metadata (pgobject transit))
(stsch/decode-metadata (pgobject json))))))
(t/deftest decode-json-keeps-hash-byte-exact
;; Dedup matches on the hash string; it must survive the JSON
;; roundtrip untouched.
(let [mdata (stsch/decode-metadata
(pgobject "{\"bucket\":\"file-media-object\",\"content-type\":\"image/png\",\"hash\":\"blake2b:9f1c2e\"}"))]
(t/is (= "blake2b:9f1c2e" (:hash mdata)))))
(def ^:private bucket-samples
;; One representative payload per bucket, with every required key and
;; one optional key where the bucket declares any.
[["file-media-object"
{:bucket "file-media-object" :content-type "image/png" :hash "blake2b:9f1c2e"}]
["team-font-variant"
{:bucket "team-font-variant" :content-type "font/woff2"}]
["file-object-thumbnail"
{:bucket "file-object-thumbnail" :content-type "image/png"}]
["file-thumbnail"
{:bucket "file-thumbnail" :content-type "image/png"}]
["profile"
{:bucket "profile" :content-type "image/png"}]
["organization"
{:bucket "organization" :content-type "image/svg+xml"
:organization-id #uuid "11111111-2222-3333-4444-555555555555"}]
["tempfile"
{:bucket "tempfile" :content-type "application/zip"
:profile-id #uuid "86907e95-1cb8-8122-8008-4eb7ba07d89d"}]
["upload-session"
{:bucket "upload-session" :content-type "application/octet-stream"}]
["file-data"
{:bucket "file-data" :content-type "application/octet-stream"
:file-id #uuid "86907e95-1cb8-8122-8008-4eb7ba07d89d"
:id #uuid "83df2f92-6bd4-4e6d-9c9a-3f6d2b1a4c55"}]
["file-data-fragment"
{:bucket "file-data-fragment" :content-type "application/octet-stream"}]
["file-change"
{:bucket "file-change" :content-type "application/octet-stream"}]])
(t/deftest encode-decode-roundtrips-every-bucket
(binding [cf/config (assoc cf/config :storage-metadata-as-json nil)]
(doseq [[bucket mdata] bucket-samples]
(t/testing bucket
(t/is (= mdata (stsch/decode-metadata (stsch/encode-metadata mdata))))))))
(t/deftest json-encoding-roundtrips-every-bucket
(binding [cf/config (assoc cf/config :storage-metadata-as-json true)]
(doseq [[bucket mdata] bucket-samples]
(t/testing bucket
(t/is (= mdata (stsch/decode-metadata (stsch/encode-metadata mdata))))))))
(t/deftest metadata-buckets-is-the-canonical-set
(t/is (= #{"file-media-object" "team-font-variant" "file-object-thumbnail"
"file-thumbnail" "profile" "organization" "tempfile"
"upload-session" "file-data" "file-data-fragment" "file-change"}
stsch/metadata-buckets)))
(t/deftest decode-metadata-returns-nil-for-nil
(t/is (nil? (stsch/decode-metadata nil))))
(t/deftest sniff-treats-leading-tilde-value-as-json
;; A plain-JSON value starting with `~:` must not switch the reader to
;; the Transit branch: the sniff is anchored to the first key.
(let [encoded (binding [cf/config (assoc cf/config :storage-metadata-as-json true)]
(stsch/encode-metadata {:bucket "tempfile"
:content-type "~:not-transit"}))
decoded (stsch/decode-metadata encoded)]
(t/is (= "~:not-transit" (:content-type decoded)))
(t/is (= "tempfile" (:bucket decoded)))))