penpot/backend/test/backend_tests/rpc_file_update_test.clj
alonso.torres 61bf66342b ✨ Tell repairs, damaged data and other files apart in save notices
The notice of a rejected save always said the same thing. It did not
name the file when the user had moved to another one, gave no hint when
the page held data that was already invalid, and replaced the notice of
a backend repair still on screen, since the store holds one toast.

The backend flags a rejection whose first commit touches pages or
components that failed validation before it (:preexisting-damage). The
rejection notice names a file other than the open one, says when the
data was damaged before, and folds into a repair notice still on
screen; a later repair notice folds a rejection notice in the same way.
The notice says that the latest changes were undone, no longer that the
rest of the work is saved.
2026-11-05 23:59:32 +01:00

515 lines
22 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.rpc-file-update-test
(:require
[app.common.exceptions :as ex]
[app.common.features :as cfeat]
[app.common.files.changes :as cpc]
[app.common.files.validate :as val]
[app.common.logging :as l]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.msgbus :as mbus]
[app.rpc :as-alias rpc]
[app.util.blob :as blob]
[backend-tests.helpers :as th]
[clojure.test :as t]))
(defn- with-validation
[next]
(with-redefs [cf/flags (conj cf/flags :file-validation :file-schema-validation)]
(next)))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset with-validation)
(defn- create-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})]
{:profile-id (:id profile)
:file-id (:id file)
:page-id (-> file :data :pages first)}))
(defn- break-parent
"A change that leaves the shape pointing to a parent that does not exist."
[page-id id]
{:type :mod-obj
:page-id page-id
:id id
:operations [{:type :set :attr :parent-id :val (uuid/next)}]})
(defn- conflicting-page-change
"A change that fails while applied: `:add-page` refuses an id and name
together with a page."
[]
{:type :add-page
:id (uuid/next)
:name "page"
:page {:id (uuid/next) :name "page" :objects {}}})
(defn- update-file
[{:keys [profile-id file-id]} params]
(th/command! (merge {::th/type :update-file
::rpc/profile-id profile-id
:id file-id
:session-id (uuid/next)
:revn 0
:vern 0
:features cfeat/supported-features}
params)))
(defn- commit
[& changes]
{:commit-id (uuid/next) :changes (vec changes)})
(defn- get-file-data
[{:keys [profile-id file-id]}]
(-> (th/command! {::th/type :get-file
::rpc/profile-id profile-id
:id file-id})
:result
:data))
(defn- get-file-changes
[{:keys [file-id]}]
(->> (th/db-query :file-change {:file-id file-id} {:order-by [:revn]})
(filter :changes)
(mapv #(update % :changes blob/decode))))
(defn- capture-messages
[next]
(let [messages (atom [])]
(with-redefs [mbus/pub! (fn [_ & {:keys [message]}]
(swap! messages conj message))]
(let [out (next)]
{:out out :messages @messages}))))
(t/deftest saves-the-commits-before-the-first-invalid-one
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
shape-c (uuid/next)
commit1 (commit (th/add-rect-change page-id shape-a))
commit2 (commit (break-parent page-id shape-a))
commit3 (commit (th/add-rect-change page-id shape-c))
{:keys [out messages]}
(capture-messages
#(update-file ctx {:changes-with-metadata [commit1 commit2 commit3]}))]
(t/is (nil? (:error out)))
(t/testing "the response names the rejected commits and the failure"
(let [rejected (-> out :result :rejected)]
(t/is (= [(:commit-id commit2) (:commit-id commit3)] (:commit-ids rejected)))
(t/is (= (:commit-id commit2) (:failed-commit-id rejected)))
(t/is (= :validation (-> rejected :error :type)))
(t/is (= :referential-integrity (-> rejected :error :code)))
(t/is (nil? (:preexisting-damage rejected)))))
(t/testing "the file holds the accepted commit only"
(let [objects (-> (get-file-data ctx) :pages-index (get page-id) :objects)]
(t/is (= uuid/zero (get-in objects [shape-a :parent-id])))
(t/is (not (contains? objects shape-c)))))
(t/testing "the change log holds the accepted commit only"
(let [rows (get-file-changes ctx)]
(t/is (= 1 (count rows)))
(t/is (= 1 (:revn (first rows))))
(t/is (= (:changes commit1) (:changes (first rows))))))
(t/testing "peers get the accepted commit only"
(let [file-changes (filter #(= :file-change (:type %)) messages)]
(t/is (= 1 (count file-changes)))
(t/is (= (:changes commit1) (:changes (first file-changes))))))))
(t/deftest saves-nothing-when-the-first-commit-is-invalid
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
_ (update-file ctx {:changes [(th/add-rect-change page-id shape-a)]})
commit1 (commit (break-parent page-id shape-a))
commit2 (commit (th/add-rect-change page-id (uuid/next)))
{:keys [out messages]}
(capture-messages
#(update-file ctx {:revn 1 :changes-with-metadata [commit1 commit2]}))]
(t/is (nil? (:error out)))
(t/is (= [(:commit-id commit1) (:commit-id commit2)]
(-> out :result :rejected :commit-ids)))
(t/is (= 1 (:revn (th/db-get :file {:id (:file-id ctx)}))))
(t/is (= 1 (count (get-file-changes ctx))))
(t/is (empty? messages))))
(t/deftest rejects-a-commit-that-throws-while-applied
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
commit1 (commit (th/add-rect-change page-id shape-a))
commit2 (commit (conflicting-page-change))
out (update-file ctx {:changes-with-metadata [commit1 commit2]})]
(t/is (nil? (:error out)))
(t/is (= [(:commit-id commit2)] (-> out :result :rejected :commit-ids)))
(t/is (= :conflict (-> out :result :rejected :error :type)))
(t/is (= 1 (:revn (th/db-get :file {:id (:file-id ctx)}))))))
(t/deftest rejects-a-commit-that-only-fails-the-schema
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
shape-c (uuid/next)
commit1 (commit (th/add-rect-change page-id shape-a))
commit2 (commit {:type :mod-obj
:page-id page-id
:id shape-a
:operations [{:type :set :attr :name :val "schema-breaker"}]})
commit3 (commit (th/add-rect-change page-id shape-c))
validate val/validate-file-schema-affected!
;; Changes and shapes are schema checked while applied, so no real
;; change reaches the file schema check invalid: one is simulated
out (with-redefs [val/validate-file-schema-affected!
(fn [file changes]
(when (= "schema-breaker"
(get-in file [:data :pages-index page-id :objects shape-a :name]))
(ex/raise :type :validation :code :schema-validation :hint "schema"))
(validate file changes))]
(update-file ctx {:changes-with-metadata [commit1 commit2 commit3]}))
objects (-> (get-file-data ctx) :pages-index (get page-id) :objects)]
(t/is (nil? (:error out)))
(t/is (= [(:commit-id commit2) (:commit-id commit3)]
(-> out :result :rejected :commit-ids)))
(t/is (= :schema-validation (-> out :result :rejected :error :code)))
(t/is (nil? (-> out :result :rejected :preexisting-damage))
"the data was valid before the rejected commit")
(t/is (= "rect" (get-in objects [shape-a :name])))
(t/is (not (contains? objects shape-c)))))
(t/deftest flags-a-rejection-on-data-damaged-before-the-commit
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
_ (update-file ctx {:changes [(th/add-rect-change page-id shape-a)
{:type :mod-obj
:page-id page-id
:id shape-a
:operations [{:type :set :attr :name :val "damaged"}]}]})
commit1 (commit (th/add-rect-change page-id (uuid/next)))
validate val/validate-file-schema-affected!
;; The page fails the schema check whenever it holds the "damaged"
;; shape, as stored data that an older version saved invalid would
out (with-redefs [val/validate-file-schema-affected!
(fn [file changes]
(when (= "damaged"
(get-in file [:data :pages-index page-id :objects shape-a :name]))
(ex/raise :type :validation :code :schema-validation :hint "schema"))
(validate file changes))]
(update-file ctx {:revn 1 :changes-with-metadata [commit1]}))
rejected (-> out :result :rejected)]
(t/is (nil? (:error out)))
(t/is (= [(:commit-id commit1)] (:commit-ids rejected)))
(t/is (true? (:preexisting-damage rejected)))
(t/is (= 1 (:revn (th/db-get :file {:id (:file-id ctx)}))))))
(t/deftest saves-every-commit-when-all-are-valid
(let [{:keys [page-id] :as ctx} (create-file)
out (update-file ctx {:changes-with-metadata [(commit (th/add-rect-change page-id (uuid/next)))
(commit (th/add-rect-change page-id (uuid/next)))]})]
(t/is (nil? (:error out)))
(t/is (nil? (-> out :result :rejected)))
(t/is (= 1 (:revn (th/db-get :file {:id (:file-id ctx)}))))))
(t/deftest flat-changes-stay-all-or-nothing
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
out (update-file ctx {:changes [(th/add-rect-change page-id shape-a)
(break-parent page-id shape-a)]})]
(t/is (= :validation (th/ex-type (:error out))))
(t/is (= 0 (:revn (th/db-get :file {:id (:file-id ctx)}))))))
(t/deftest groups-without-commit-ids-stay-all-or-nothing
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
out (update-file ctx {:changes-with-metadata
[{:changes [(th/add-rect-change page-id shape-a)]}
{:changes [(break-parent page-id shape-a)]}]})]
(t/is (= :validation (th/ex-type (:error out))))
(t/is (= 0 (:revn (th/db-get :file {:id (:file-id ctx)}))))))
(t/deftest database-failures-fail-the-whole-request
(let [{:keys [page-id] :as ctx} (create-file)
conflict (conflicting-page-change)
process cpc/process-changes
out (with-redefs [cpc/process-changes
(fn [data changes & args]
;; The database fails on every attempt that
;; leaves the conflicting commit out: the
;; retries, never the pass over every commit
(when (and (seq changes)
(not-any? #{conflict} changes))
(throw (java.sql.SQLException. "connection lost")))
(apply process data changes args))]
(update-file ctx {:changes-with-metadata
[(commit (th/add-rect-change page-id (uuid/next)))
(commit conflict)]}))]
(t/is (instance? java.sql.SQLException (:error out)))
(t/is (= 0 (:revn (th/db-get :file {:id (:file-id ctx)}))))))
(defn- move-rect
[page-id id x]
{:type :mod-obj
:page-id page-id
:id id
:operations [{:type :set :attr :x :val x}]})
(defn- wait-for-record
"The first log record whose message hint is `hint`, waiting up to two
seconds for the asynchronous logger to write it."
[records hint]
(loop [tries 0]
(if-let [record (->> @records
(filter #(= hint (get-in % [::l/props :hint])))
(first))]
record
(when (< tries 200)
(Thread/sleep 10)
(recur (inc tries))))))
(defn- update-file-logged
"Updates the file and returns the response in `:out` and, in `:rejected`,
the props of the log record of the rejection, if any."
[ctx params]
(let [records (atom [])
out (try
(add-watch l/log-record ::capture
(fn [_ _ _ record] (swap! records conj record)))
(update-file ctx params)
(finally
(remove-watch l/log-record ::capture)))]
{:out out
:rejected (some-> (wait-for-record records "update-file commit rejected")
::l/props)}))
(t/deftest bisects-the-commits-to-find-the-invalid-one
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
_ (update-file ctx {:changes [(th/add-rect-change page-id shape-a)]})
commits (mapv (fn [i]
(if (= i 5)
(commit (break-parent page-id shape-a))
(commit (move-rect page-id shape-a i))))
(range 16))
{:keys [out rejected]}
(update-file-logged ctx {:revn 1 :changes-with-metadata commits})]
(t/is (nil? (:error out)))
(t/is (= (mapv :commit-id (subvec commits 5))
(-> out :result :rejected :commit-ids)))
(t/is (= (:commit-id (nth commits 5))
(-> out :result :rejected :failed-commit-id)))
(t/is (= :referential-integrity (-> out :result :rejected :error :code)))
(t/testing "the search takes log2 of the commits attempts"
(t/is (= 4 (:attempts rejected))))
(t/testing "the file holds the commits before the invalid one"
(let [objects (-> (get-file-data ctx) :pages-index (get page-id) :objects)]
(t/is (= uuid/zero (get-in objects [shape-a :parent-id])))
(t/is (= 4 (get-in objects [shape-a :x])))))))
(t/deftest rejects-a-single-commit-without-a-retry
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
_ (update-file ctx {:changes [(th/add-rect-change page-id shape-a)]})
commit1 (commit (break-parent page-id shape-a))
{:keys [out rejected]}
(update-file-logged ctx {:revn 1 :changes-with-metadata [commit1]})]
(t/is (nil? (:error out)))
(t/is (= [(:commit-id commit1)] (-> out :result :rejected :commit-ids)))
(t/is (= :referential-integrity (-> out :result :rejected :error :code)))
(t/is (= 0 (:attempts rejected)) "no retry")
(t/is (= 1 (:revn (th/db-get :file {:id (:file-id ctx)}))))))
(defn- rename-rect
[page-id id name]
{:type :mod-obj
:page-id page-id
:id id
:operations [{:type :set :attr :name :val name}]})
(t/deftest keeps-fifty-commits-before-the-invalid-one
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
_ (update-file ctx {:changes [(th/add-rect-change page-id shape-a)]})
renames (mapv #(commit (rename-rect page-id shape-a (str "name " %))) (range 50))
invalid (commit (break-parent page-id shape-a))
{:keys [out rejected]}
(update-file-logged ctx {:revn 1 :changes-with-metadata (conj renames invalid)})]
(t/is (nil? (:error out)))
(t/is (= [(:commit-id invalid)] (-> out :result :rejected :commit-ids)))
(t/testing "the file holds the fifty renames"
(let [objects (-> (get-file-data ctx) :pages-index (get page-id) :objects)]
(t/is (= "name 49" (get-in objects [shape-a :name])))
(t/is (= uuid/zero (get-in objects [shape-a :parent-id])))))
(t/testing "the change log holds the renames in one revision"
(let [rows (get-file-changes ctx)]
(t/is (= 2 (count rows)))
(t/is (= (into [] (mapcat :changes) renames)
(:changes (last rows))))))
(t/testing "the search takes log2 of the commits attempts"
(t/is (= 51 (:commits rejected)))
(t/is (= 6 (:attempts rejected))))))
(t/deftest keeps-a-commit-that-repairs-an-earlier-one
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
shape-c (uuid/next)
_ (update-file ctx {:changes [(th/add-rect-change page-id shape-a)]})
commit1 (commit (break-parent page-id shape-a))
commit2 (commit {:type :mod-obj
:page-id page-id
:id shape-a
:operations [{:type :set :attr :parent-id :val uuid/zero}]})
commit3 (commit (th/add-rect-change page-id shape-c))
commit4 (commit (break-parent page-id shape-c))
out (update-file ctx {:revn 1 :changes-with-metadata [commit1 commit2 commit3 commit4]})
objects (-> (get-file-data ctx) :pages-index (get page-id) :objects)]
(t/is (nil? (:error out)))
(t/is (= [(:commit-id commit4)] (-> out :result :rejected :commit-ids)))
(t/is (= uuid/zero (get-in objects [shape-a :parent-id])))
(t/is (= uuid/zero (get-in objects [shape-c :parent-id])))))
(defn- debug-fault
"A change that asks the backend to fail with `fault` while applied."
[fault]
{:type :set-plugin-data
:object-type :file
:namespace :penpot-debug
:key (str "save-fault:" fault)
:value nil})
(defn- with-debug-faults
[f]
(with-redefs [cf/flags (conj cf/flags :debug-save-faults)]
(f)))
(t/deftest a-debug-fault-rejects-its-commit
(let [{:keys [page-id] :as ctx} (create-file)
shape-a (uuid/next)
commit1 (commit (th/add-rect-change page-id shape-a))
commit2 (commit (debug-fault "runtime"))
commit3 (commit (th/add-rect-change page-id (uuid/next)))
out (with-debug-faults
#(update-file ctx {:changes-with-metadata [commit1 commit2 commit3]}))
objects (-> (get-file-data ctx) :pages-index (get page-id) :objects)]
(t/is (nil? (:error out)))
(t/is (= [(:commit-id commit2) (:commit-id commit3)]
(-> out :result :rejected :commit-ids)))
(t/is (= :internal (-> out :result :rejected :error :type)))
(t/is (contains? objects shape-a))))
(t/deftest a-debug-validation-fault-rejects-like-a-validation-error
(let [{:keys [page-id] :as ctx} (create-file)
out (with-debug-faults
#(update-file ctx {:changes-with-metadata
[(commit (th/add-rect-change page-id (uuid/next)))
(commit (debug-fault "validation"))]}))]
(t/is (= :validation (-> out :result :rejected :error :type)))))
(t/deftest a-debug-infrastructure-fault-fails-the-whole-request
(let [{:keys [page-id] :as ctx} (create-file)
out (with-debug-faults
#(update-file ctx {:changes-with-metadata
[(commit (th/add-rect-change page-id (uuid/next)))
(commit (debug-fault "sql"))]}))]
(t/is (instance? java.sql.SQLException (:error out)))
(t/is (= 0 (:revn (th/db-get :file {:id (:file-id ctx)}))))))
(t/deftest debug-faults-need-the-flag
(let [{:keys [page-id] :as ctx} (create-file)
out (update-file ctx {:changes-with-metadata
[(commit (th/add-rect-change page-id (uuid/next)))
(commit (debug-fault "runtime"))]})]
(t/is (nil? (:error out)))
(t/is (nil? (-> out :result :rejected)))
(t/is (= 1 (:revn (th/db-get :file {:id (:file-id ctx)}))))
(t/is (nil? (:plugin-data (get-file-data ctx))))))
(t/deftest a-rejection-without-an-error-type-reports-an-internal-error
(let [{:keys [page-id] :as ctx} (create-file)
out (with-debug-faults
#(update-file ctx {:changes-with-metadata
[(commit (th/add-rect-change page-id (uuid/next)))
(commit (debug-fault "ex-info"))]}))
error (-> out :result :rejected :error)]
(t/is (= :internal (:type error)))
(t/is (= :unexpected-error (:code error)))
(t/is (= "debug save fault" (:hint error)))))
(defn- upload-image
"Uploads an image to the file `file-id` and returns its media object."
[profile-id file-id]
(let [out (th/multipart-command!
{::th/type :upload-file-media-object
::rpc/profile-id profile-id
:file-id file-id
:is-local true
:name "image"
:content {:filename "sample.jpg"
:path (th/tempfile "backend_tests/test_files/sample.jpg")
:mtype "image/jpeg"
:size 312043}})]
(t/is (nil? (:error out)))
(:result out)))
(defn- add-image-rect
"A rect filled with the image of `mobj`."
[page-id id mobj]
(assoc-in (th/add-rect-change page-id id)
[:obj :fills]
[{:fill-opacity 1
:fill-image {:id (:id mobj) :width 100 :height 100 :mtype "image/jpeg"}}]))
(t/deftest a-rejected-commit-adds-no-media-references
(let [{:keys [profile-id page-id file-id] :as ctx} (create-file)
other (th/create-file* 2 {:profile-id profile-id
:project-id (:default-project-id (th/db-get :profile {:id profile-id}))
:is-shared false})
;; An image of another file: referencing it copies the media
;; object into this file
mobj (upload-image profile-id (:id other))
shape-a (uuid/next)
shape-b (uuid/next)
commit1 (commit (th/add-rect-change page-id shape-a))
commit2 (commit (add-image-rect page-id shape-b mobj)
(break-parent page-id shape-a))
out (update-file ctx {:changes-with-metadata [commit1 commit2]})]
(t/is (nil? (:error out)))
(t/is (= [(:commit-id commit2)] (-> out :result :rejected :commit-ids)))
(t/testing "the rejected image adds no media object to the file"
(t/is (empty? (th/db-query :file-media-object {:file-id file-id}))))
(t/testing "the same image in an accepted commit does"
(let [out (update-file ctx {:revn 1
:changes-with-metadata [(commit (add-image-rect page-id shape-b mobj))]})]
(t/is (nil? (:error out)))
(t/is (nil? (-> out :result :rejected)))
(t/is (= 1 (count (th/db-query :file-media-object {:file-id file-id}))))))))