Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-03-17 18:21:23 -05:00
Code Issues Activity

Merge pull request #3924 from penpot/niwinz-staging-bugfixes-1

Browse source 
🐛 Features bugfixes
This commit is contained in:
Alejandro 2023-12-14 12:17:35 +01:00 • committed by GitHub
commit 6b042be65c
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
11 changed files with 634 additions and 575 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

81
backend/src/app/features/components_v2.clj
View file

@ -769,58 +769,65 @@
fdata (migrate-graphics fdata)]
(update fdata :options assoc :components-v2 true)))))
(defn- process-fdata
(defn- prepare-fdata
[fdata id]
(-> fdata
(assoc :id id)
(fdata/process-pointers deref)
(fmg/migrate-data)))
(defn- validate-file!
[file libs throw-on-validate?]
(try
(cfv/validate-file! file libs)
(cfv/validate-file-schema! file)
(catch Throwable cause
(if throw-on-validate?
(throw cause)
(l/wrn :hint "migrate:file:validation-error" :cause cause)))))
(defn- process-file
[{:keys [::db/conn] :as system} id & {:keys [validate? throw-on-validate?]}]
(binding [pmap/*tracked* (pmap/create-tracked)
pmap/*load-fn* (partial fdata/load-pointer *system* id)]
(let [file (binding [cfeat/*new* (atom #{})
pmap/*load-fn* (partial fdata/load-pointer system id)]
(-> (files/get-file system id :migrate? false)
(update :data prepare-fdata id)
(update :features into (deref cfeat/*new*))
(update :features cfeat/migrate-legacy-features)))
(let [file (binding [cfeat/*new* (atom #{})]
(-> (files/get-file system id :migrate? false)
(update :data process-fdata id)
(update :features into (deref cfeat/*new*))
(update :features cfeat/migrate-legacy-features)))
libs (->> (files/get-file-libraries conn id)
(into [file] (map (fn [{:keys [id]}]
(binding [pmap/*load-fn* (partial fdata/load-pointer system id)]
(-> (files/get-file system id :migrate? false)
(update :data prepare-fdata id))))))
(d/index-by :id))
libs (->> (files/get-file-libraries conn id)
(into [file] (map (fn [{:keys [id]}]
(binding [pmap/*load-fn* (partial fdata/load-pointer system id)]
(-> (files/get-file system id :migrate? false)
(update :data process-fdata id))))))
(d/index-by :id))
file (-> file
(update :data migrate-fdata libs)
(update :features conj "components/v2"))
pmap? (contains? (:features file) "fdata/pointer-map")
_ (when validate?
(validate-file! file libs throw-on-validate?))
file (-> file
(update :data migrate-fdata libs)
(update :features conj "components/v2")
(cond-> pmap? (fdata/enable-pointer-map)))
]
file (if (contains? (:features file) "fdata/objects-map")
(fdata/enable-objects-map file)
file)
(when validate?
(if throw-on-validate?
(cfv/validate-file! file libs)
(doseq [error (cfv/validate-file file libs)]
(l/wrn :hint "migrate:file:validation-error"
:file-id (str (:id file))
:file-name (:name file)
:error error))))
file (if (contains? (:features file) "fdata/pointer-map")
(binding [pmap/*tracked* (pmap/create-tracked)]
(let [file (fdata/enable-pointer-map file)]
(fdata/persist-pointers! system id)
file))
file)]
(db/update! conn :file
{:data (blob/encode (:data file))
:features (db/create-array conn "text" (:features file))
:revn (:revn file)}
{:id (:id file)})
(db/update! conn :file
{:data (blob/encode (:data file))
:features (db/create-array conn "text" (:features file))
:revn (:revn file)}
{:id (:id file)}
{::db/return-keys? false})
(when pmap?
(fdata/persist-pointers! system id))
(dissoc file :data))))
(dissoc file :data)))
(defn migrate-file!
[system file-id & {:keys [validate? throw-on-validate?]}]

106
backend/src/app/rpc/commands/binfile.clj
View file

@ -693,17 +693,6 @@
(vswap! *state* update :index update-index files)
(vswap! *state* assoc :version version :files files)))
(defn- postprocess-file
[file]
(cond-> file
(and (contains? cfeat/*current* "fdata/objects-map")
(not (contains? cfeat/*previous* "fdata/objects-map")))
(feat.fdata/enable-objects-map)
(and (contains? cfeat/*current* "fdata/pointer-map")
(not (contains? cfeat/*previous* "fdata/pointer-map")))
(feat.fdata/enable-pointer-map)))
(defn- get-remaped-thumbnails
[thumbnails file-id]
(mapv (fn [thumbnail]
@ -712,6 +701,25 @@
(update :object-id #(str/replace-first % #"^(.*?)/" (str file-id "/")))))
thumbnails))
(defn- process-fdata
[fdata id]
(-> fdata
(dissoc :recent-colors)
(assoc :id id)
(cond-> (> (:version fdata) cfd/version)
(assoc :version cfd/version))
;; FIXME: We're temporarily activating all
;; migrations because a problem in the
;; environments messed up with the version
;; numbers When this problem is fixed delete
;; the following line
(assoc :version 22)
(pmg/migrate-data)
(update :pages-index relink-shapes)
(update :components relink-shapes)
(update :media relink-media)))
(defmethod read-section :v1/files
[{:keys [::db/conn ::input ::project-id ::enabled-features ::timestamp ::overwrite?] :as system}]
@ -765,63 +773,51 @@
(l/dbg :hint "update media references" ::l/sync? true)
(vswap! *state* update :media into (map #(update % :id lookup-index)) media))
(binding [cfeat/*current* features
cfeat/*previous* (:features file)
pmap/*tracked* (atom {})]
(let [file (binding [cfeat/*new* (atom #{})]
(-> file
(assoc :id file-id')
(assoc :features features)
(assoc :project-id project-id)
(assoc :created-at timestamp)
(assoc :modified-at timestamp)
(dissoc :thumbnails)
(update :data process-fdata file-id')
(update :features into (deref cfeat/*new*))))
(let [params (-> file
(assoc :id file-id')
(assoc :features features)
(assoc :project-id project-id)
(assoc :created-at timestamp)
(assoc :modified-at timestamp)
(dissoc :thumbnails)
(update :data (fn [data]
(-> data
(dissoc :recent-colors)
(assoc :id file-id')
(cond-> (> (:version data) cfd/version)
(assoc :version cfd/version))
_ (when (contains? cf/flags :file-schema-validation)
(fval/validate-file-schema! file))
;; FIXME: We're temporarily activating all
;; migrations because a problem in the
;; environments messed up with the version
;; numbers When this problem is fixed delete
;; the following line
(assoc :version 22)
(update :pages-index relink-shapes)
(update :components relink-shapes)
(update :media relink-media)
(pmg/migrate-data)
(d/without-nils)))))
_ (when (contains? cf/flags :soft-file-schema-validation)
(let [result (ex/try! (fval/validate-file-schema! file))]
(when (ex/exception? result)
(l/error :hint "file schema validation error" :cause result))))
params (if (contains? cf/flags :file-schema-validation)
(fval/validate-file-schema! params)
params)
file (if (contains? (:features file) "fdata/objects-map")
(feat.fdata/enable-objects-map file)
file)
_ (when (contains? cf/flags :soft-file-schema-validation)
(try
(fval/validate-file-schema! params)
(catch Throwable cause
(l/error :hint "file schema validation error" :cause cause))))
file (if (contains? (:features file) "fdata/pointer-map")
(binding [pmap/*tracked* (pmap/create-tracked)]
(let [file (feat.fdata/enable-pointer-map file)]
(feat.fdata/persist-pointers! system file-id')
file))
file)
params (-> params
(postprocess-file)
(update :features #(db/create-array conn "text" %))
(update :data blob/encode))]
file (-> file
(update :features #(db/create-array conn "text" %))
(update :data blob/encode))]
(l/dbg :hint "create file" :id (str file-id') ::l/sync? true)
(if overwrite?
(create-or-update-file! conn params)
(db/insert! conn :file params))
(feat.fdata/persist-pointers! system file-id')
(create-or-update-file! conn file)
(db/insert! conn :file file))
(when overwrite?
(db/delete! conn :file-thumbnail {:file-id file-id'}))
file-id')))))
file-id'))))
(defmethod read-section :v1/rels
[{:keys [::db/conn ::input ::timestamp]}]

44
backend/src/app/rpc/commands/files.clj
View file

@ -34,7 +34,6 @@
[app.util.pointer-map :as pmap]
[app.util.services :as sv]
[app.util.time :as dt]
[clojure.set :as set]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]))
@ -227,7 +226,10 @@
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)
pmap/*tracked* (pmap/create-tracked)
cfeat/*new* (atom #{})]
(let [file (fmg/migrate-file file)]
(let [file (-> (fmg/migrate-file file)
(update :features into (deref cfeat/*new*))
(update :features cfeat/migrate-legacy-features))]
;; NOTE: when file is migrated, we break the rule of no perform
;; mutations on get operations and update the file with all
;; migrations applied
@ -235,16 +237,17 @@
;; NOTE: the following code will not work on read-only mode, it
;; is a known issue; we keep is not implemented until we really
;; need this
(if (fmg/migrated? file)
(let [file (update file :features cfeat/migrate-legacy-features)
features (set/union (deref cfeat/*new*) (:features file))]
(db/update! conn :file
{:data (blob/encode (:data file))
:features (db/create-array conn "text" features)}
{:id id})
(feat.fdata/persist-pointers! cfg id)
(assoc file :features features))
file))))
(when (fmg/migrated? file)
(db/update! conn :file
{:data (blob/encode (:data file))
:features (db/create-array conn "text" (:features file))}
{:id id}
{::db/return-keys? false})
(when (contains? (:features file) "fdata/pointer-map")
(feat.fdata/persist-pointers! cfg id)))
file)))
(defn get-file
[{:keys [::db/conn] :as cfg} id & {:keys [project-id migrate?
@ -706,11 +709,12 @@
(cfeat/check-client-features! (:features params))
(cfeat/check-file-features! (:features file) (:features params)))
{:name (:name file)
:components-count (count (ctkl/components-seq (:data file)))
:graphics-count (count (get-in file [:data :media] []))
:colors-count (count (get-in file [:data :colors] []))
:typography-count (count (get-in file [:data :typographies] []))}))
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)]
{:name (:name file)
:components-count (count (ctkl/components-seq (:data file)))
:graphics-count (count (get-in file [:data :media] []))
:colors-count (count (get-in file [:data :colors] []))
:typography-count (count (get-in file [:data :typographies] []))})))
(sv/defmethod ::get-file-summary
"Retrieve a file summary by its ID. Only authenticated users."
@ -856,8 +860,10 @@
(true? (:is-shared params)))
(let [file (assoc file :is-shared true)]
(db/update! conn :file
{:is-shared false}
{:id id})
{:is-shared true}
{:id id}
::db/return-keys? false)
file)
:else

108
backend/src/app/rpc/commands/files_update.clj
View file

@ -182,39 +182,39 @@
(defn update-file
[{:keys [::db/conn ::mtx/metrics] :as cfg}
{:keys [id file features changes changes-with-metadata] :as params}]
(binding [cfeat/*current* features
cfeat/*previous* (:features file)]
(let [update-fn (cond-> update-file*
(contains? features "fdata/pointer-map")
(wrap-with-pointer-map-context)
(let [features (-> features
(set/difference cfeat/frontend-only-features)
(set/union (:features file)))
(contains? features "fdata/objects-map")
(wrap-with-objects-map-context))
update-fn (cond-> update-file*
(contains? features "fdata/pointer-map")
(wrap-with-pointer-map-context)
changes (if changes-with-metadata
(->> changes-with-metadata (mapcat :changes) vec)
(vec changes))
(contains? features "fdata/objects-map")
(wrap-with-objects-map-context))
features (-> features
(set/difference cfeat/frontend-only-features)
(set/union (:features file)))]
changes (if changes-with-metadata
(->> changes-with-metadata (mapcat :changes) vec)
(vec changes))]
(when (> (:revn params)
(:revn file))
(ex/raise :type :validation
:code :revn-conflict
:hint "The incoming revision number is greater that stored version."
:context {:incoming-revn (:revn params)
:stored-revn (:revn file)}))
(when (> (:revn params)
(:revn file))
(ex/raise :type :validation
:code :revn-conflict
:hint "The incoming revision number is greater that stored version."
:context {:incoming-revn (:revn params)
:stored-revn (:revn file)}))
(mtx/run! metrics {:id :update-file-changes :inc (count changes)})
(mtx/run! metrics {:id :update-file-changes :inc (count changes)})
(when (not= features (:features file))
(let [features (db/create-array conn "text" features)]
(db/update! conn :file
{:features features}
{:id id})))
(when (not= features (:features file))
(let [features (db/create-array conn "text" features)]
(db/update! conn :file
{:features features}
{:id id})))
(binding [cfeat/*current* features
cfeat/*previous* (:features file)]
(let [file (assoc file :features features)
params (-> params
(assoc :file file)
@ -276,9 +276,7 @@
(try
(val/validate-file-schema! file)
(catch Throwable cause
(l/error :hint "file schema validation error" :cause cause)))
file)
(l/error :hint "file schema validation error" :cause cause))))
(defn- soft-validate-file!
[file libs]
@ -286,8 +284,7 @@
(val/validate-file! file libs)
(catch Throwable cause
(l/error :hint "file validation error"
:cause cause)))
file)
:cause cause))))
(defn- update-file-data
[{:keys [::db/conn] :as cfg} file changes skip-validate]
@ -300,7 +297,8 @@
;; WARNING: this ruins performance; maybe we need to find
;; some other way to do general validation
libs (when (and (contains? cf/flags :file-validation)
libs (when (and (or (contains? cf/flags :file-validation)
(contains? cf/flags :soft-file-validation))
(not skip-validate))
(->> (files/get-file-libraries conn (:id file))
(into [file] (map (fn [{:keys [id]}]
@ -309,37 +307,37 @@
(-> (files/get-file cfg id :migrate? false)
(feat.fdata/process-pointers deref) ; ensure all pointers resolved
(fmg/migrate-file))))))
(d/index-by :id)))]
(d/index-by :id)))
(-> (files/check-version! file)
(update :revn inc)
(update :data cpc/process-changes changes)
file (-> (files/check-version! file)
(update :revn inc)
(update :data cpc/process-changes changes))]
;; If `libs` is defined, then full validation is performed
(cond-> (contains? cf/flags :soft-file-validation)
(soft-validate-file! libs))
(when (contains? cf/flags :soft-file-validation)
(soft-validate-file! file libs))
(cond-> (contains? cf/flags :soft-file-schema-validation)
(soft-validate-file-schema!))
(when (contains? cf/flags :soft-file-schema-validation)
(soft-validate-file-schema! file))
(cond-> (and (contains? cf/flags :file-validation)
(not skip-validate))
(val/validate-file! libs))
(when (and (contains? cf/flags :file-validation)
(not skip-validate))
(val/validate-file! file libs))
(cond-> (and (contains? cf/flags :file-schema-validation)
(not skip-validate))
(val/validate-file-schema!))
(when (and (contains? cf/flags :file-schema-validation)
(not skip-validate))
(val/validate-file-schema! file))
(cond-> (and (contains? cfeat/*current* "fdata/objects-map")
(not (contains? cfeat/*previous* "fdata/objects-map")))
(feat.fdata/enable-objects-map))
(cond-> file
(and (contains? cfeat/*current* "fdata/objects-map")
(not (contains? cfeat/*previous* "fdata/objects-map")))
(feat.fdata/enable-objects-map)
(cond-> (and (contains? cfeat/*current* "fdata/pointer-map")
(not (contains? cfeat/*previous* "fdata/pointer-map")))
(feat.fdata/enable-pointer-map))
(update :data blob/encode))))
(and (contains? cfeat/*current* "fdata/pointer-map")
(not (contains? cfeat/*previous* "fdata/pointer-map")))
(feat.fdata/enable-pointer-map)
:always
(update :data blob/encode))))
(defn- take-snapshot?
"Defines the rule when file `data` snapshot should be saved."

63
backend/src/app/rpc/commands/management.clj
View file

@ -13,6 +13,7 @@
[app.common.files.migrations :as pmg]
[app.common.schema :as sm]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
[app.features.fdata :as feat.fdata]
[app.http.sse :as sse]
@ -108,23 +109,37 @@
(update-fdata [fdata new-id]
(-> fdata
(assoc :id new-id)
(feat.fdata/process-pointers deref)
(pmg/migrate-data)
(update :pages-index relink-shapes)
(update :components relink-shapes)
(update :media relink-media)
(d/without-nils)
(feat.fdata/process-pointers pmap/clone)))]
(d/without-nils)))]
(binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)
pmap/*tracked* (pmap/create-tracked)
cfeat/*new* (atom #{})]
(let [new-id (get index id)
file (-> file
(assoc :id new-id)
(update :data update-fdata new-id)
(update :features into (deref cfeat/*new*))
(update :features cfeat/migrate-legacy-features))]
(feat.fdata/persist-pointers! cfg new-id)
file (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)
cfeat/*new* (atom #{})]
(-> file
(assoc :id new-id)
(update :data update-fdata new-id)
(update :features into (deref cfeat/*new*))
(update :features cfeat/migrate-legacy-features)))
file (if (contains? (:features file) "fdata/objects-map")
(feat.fdata/enable-objects-map file)
file)
file (if (contains? (:features file) "fdata/pointer-map")
(binding [pmap/*tracked* (pmap/create-tracked)]
(let [file (feat.fdata/enable-pointer-map file)]
(feat.fdata/persist-pointers! cfg (:id file))
file))
file)]
file))))
(def sql:get-used-libraries
@ -190,20 +205,22 @@
(db/insert! conn :file
(-> file
(update :features #(db/create-array conn "text" %))
(update :data blob/encode)))
(update :data blob/encode))
{::db/return-keys? false})
(db/insert! conn :file-profile-rel
{:file-id (:id file)
:profile-id profile-id
:is-owner true
:is-admin true
:can-edit true})
:can-edit true}
{::db/return-keys? false})
(doseq [params flibs]
(db/insert! conn :file-library-rel params))
(db/insert! conn :file-library-rel params ::db/return-keys? false))
(doseq [params fmeds]
(db/insert! conn :file-media-object params))
(db/insert! conn :file-media-object params ::db/return-keys? false))
file))
@ -283,7 +300,7 @@
;; --- COMMAND: Move file
(def sql:get-files
"select id, project_id from file where id = ANY(?)")
"select id, features, project_id from file where id = ANY(?)")
(def sql:move-files
"update file set project_id = ? where id = ANY(?)")
@ -307,7 +324,8 @@
[{:keys [::db/conn] :as cfg} {:keys [profile-id ids project-id] :as params}]
(let [fids (db/create-array conn "uuid" ids)
files (db/exec! conn [sql:get-files fids])
files (->> (db/exec! conn [sql:get-files fids])
(map files/decode-row))
source (into #{} (map :project-id) files)
pids (->> (conj source project-id)
(db/create-array conn "uuid"))]
@ -327,7 +345,12 @@
;; Check the team compatibility
(let [orig-team (teams/get-team conn :profile-id profile-id :project-id (first source))
dest-team (teams/get-team conn :profile-id profile-id :project-id project-id)]
(cfeat/check-teams-compatibility! orig-team dest-team))
(cfeat/check-teams-compatibility! orig-team dest-team)
;; Check if all pending to move files are compaib
(let [features (cfeat/get-team-enabled-features cf/flags dest-team)]
(doseq [file files]
(cfeat/check-file-features! features (:features file)))))
;; move all files to the project
(db/exec-one! conn [sql:move-files project-id fids])
@ -384,7 +407,15 @@
;; Check the teams compatibility
(let [orig-team (teams/get-team conn :profile-id profile-id :team-id (:team-id project))
dest-team (teams/get-team conn :profile-id profile-id :team-id team-id)]
(cfeat/check-teams-compatibility! orig-team dest-team))
(cfeat/check-teams-compatibility! orig-team dest-team)
;; Check if all pending to move files are compaib
(let [features (cfeat/get-team-enabled-features cf/flags dest-team)]
(doseq [file (->> (db/query conn :file
{:project-id project-id}
{:columns [:features]})
(map files/decode-row))]
(cfeat/check-file-features! features (:features file)))))
;; move project to the destination team
(db/update! conn :project

2
backend/src/app/srepl/helpers.clj
View file

@ -105,7 +105,7 @@
(pmg/migrate-file))))))
(d/index-by :id))
errors (validate/validate-file file libs)
changes (-> (repair/repair-file (:data file) libs errors) :redo-changes)
changes (repair/repair-file file libs errors)
file (-> file
(update :revn inc)

118
backend/test/backend_tests/rpc_management_test.clj
View file

@ -69,12 +69,12 @@
(t/is (not= (:id file1) (:id result)))
;; Check that the new file has a correct file library relation
(let [[item :as rows] (db/query th/*pool* :file-library-rel {:file-id (:id result)})]
(let [[item :as rows] (th/db-query :file-library-rel {:file-id (:id result)})]
(t/is (= 1 (count rows)))
(t/is (= (:id file2) (:library-file-id item))))
;; Check that the new file has a correct file media objects
(let [[item :as rows] (db/query th/*pool* :file-media-object {:file-id (:id result)})]
(let [[item :as rows] (th/db-query :file-media-object {:file-id (:id result)})]
(t/is (= 1 (count rows)))
;; Check that both items have different ids
@ -91,7 +91,7 @@
(t/is (not (contains? (get-in result [:data :media]) (:id mobj)))))
;; Check the total number of files
(let [rows (db/query th/*pool* :file {:project-id (:id project)})]
(let [rows (th/db-query :file {:project-id (:id project)})]
(t/is (= 3 (count rows))))))))
(t/deftest duplicate-file-with-deleted-relations
@ -139,15 +139,15 @@
(t/is (not= (:id file1) (:id result)))
;; Check that there are no relation to a deleted library
(let [[item :as rows] (db/query th/*pool* :file-library-rel {:file-id (:id result)})]
(let [[item :as rows] (th/db-query :file-library-rel {:file-id (:id result)})]
(t/is (= 0 (count rows))))
;; Check that the new file has no media objects
(let [[item :as rows] (db/query th/*pool* :file-media-object {:file-id (:id result)})]
(let [[item :as rows] (th/db-query :file-media-object {:file-id (:id result)})]
(t/is (= 0 (count rows))))
;; Check the total number of files
(let [rows (db/query th/*pool* :file {:project-id (:id project)})]
(let [rows (th/db-query :file {:project-id (:id project)})]
(t/is (= 3 (count rows))))))))
(t/deftest duplicate-project
@ -196,16 +196,16 @@
(t/is (not= (:id project) (:id result)))
;; Check the total number of projects (previously is 2, now is 3)
(let [rows (db/query th/*pool* :project {:team-id (:default-team-id profile)})]
(let [rows (th/db-query :project {:team-id (:default-team-id profile)})]
(t/is (= 3 (count rows))))
;; Check that the new project has the same files
(let [p1-files (db/query th/*pool* :file
{:project-id (:id project)}
{:order-by [:name]})
p2-files (db/query th/*pool* :file
{:project-id (:id result)}
{:order-by [:name]})]
(let [p1-files (th/db-query :file
{:project-id (:id project)}
{:order-by [:name]})
p2-files (th/db-query :file
{:project-id (:id result)}
{:order-by [:name]})]
(t/is (= (count p1-files)
(count p2-files)))
@ -260,16 +260,16 @@
(t/is (not= (:id project) (:id result)))
;; Check the total number of projects (previously is 2, now is 3)
(let [rows (db/query th/*pool* :project {:team-id (:default-team-id profile)})]
(let [rows (th/db-query :project {:team-id (:default-team-id profile)})]
(t/is (= 3 (count rows))))
;; Check that the new project has only the second file
(let [p1-files (db/query th/*pool* :file
{:project-id (:id project)}
{:order-by [:name]})
p2-files (db/query th/*pool* :file
{:project-id (:id result)}
{:order-by [:name]})]
(let [p1-files (th/db-query :file
{:project-id (:id project)}
{:order-by [:name]})
p2-files (th/db-query :file
{:project-id (:id result)}
{:order-by [:name]})]
(t/is (= (count (rest p1-files))
(count p2-files)))
@ -318,11 +318,11 @@
(t/is (th/ex-of-code? error :cant-move-to-same-project)))
;; initially project1 should have 2 files
(let [rows (db/query th/*pool* :file {:project-id (:id project1)})]
(let [rows (th/db-query :file {:project-id (:id project1)})]
(t/is (= 2 (count rows))))
;; initially project2 should be empty
(let [rows (db/query th/*pool* :file {:project-id (:id project2)})]
(let [rows (th/db-query :file {:project-id (:id project2)})]
(t/is (= 0 (count rows))))
;; move a file1 to project2 (in the same team)
@ -337,21 +337,21 @@
(t/is (nil? (:result out)))
;; project1 now should contain 1 file
(let [rows (db/query th/*pool* :file {:project-id (:id project1)})]
(let [rows (th/db-query :file {:project-id (:id project1)})]
(t/is (= 1 (count rows))))
;; project2 now should contain 1 file
(let [rows (db/query th/*pool* :file {:project-id (:id project2)})]
(let [rows (th/db-query :file {:project-id (:id project2)})]
(t/is (= 1 (count rows))))
;; file1 should be still linked to file2
(let [[item :as rows] (db/query th/*pool* :file-library-rel {:file-id (:id file1)})]
(let [[item :as rows] (th/db-query :file-library-rel {:file-id (:id file1)})]
(t/is (= 1 (count rows)))
(t/is (= (:file-id item) (:id file1)))
(t/is (= (:library-file-id item) (:id file2))))
;; should be no libraries on file2
(let [rows (db/query th/*pool* :file-library-rel {:file-id (:id file2)})]
(let [rows (th/db-query :file-library-rel {:file-id (:id file2)})]
(t/is (= 0 (count rows)))))))
@ -384,27 +384,27 @@
;; --- initial data checks
;; the project1 should have 3 files
(let [rows (db/query th/*pool* :file {:project-id (:id project1)})]
(let [rows (th/db-query :file {:project-id (:id project1)})]
(t/is (= 3 (count rows))))
;; should be no files on project2
(let [rows (db/query th/*pool* :file {:project-id (:id project2)})]
(let [rows (th/db-query :file {:project-id (:id project2)})]
(t/is (= 0 (count rows))))
;; the file1 should be linked to file2
(let [[item :as rows] (db/query th/*pool* :file-library-rel {:file-id (:id file1)})]
(let [[item :as rows] (th/db-query :file-library-rel {:file-id (:id file1)})]
(t/is (= 1 (count rows)))
(t/is (= (:file-id item) (:id file1)))
(t/is (= (:library-file-id item) (:id file2))))
;; the file2 should be linked to file3
(let [[item :as rows] (db/query th/*pool* :file-library-rel {:file-id (:id file2)})]
(let [[item :as rows] (th/db-query :file-library-rel {:file-id (:id file2)})]
(t/is (= 1 (count rows)))
(t/is (= (:file-id item) (:id file2)))
(t/is (= (:library-file-id item) (:id file3))))
;; should be no libraries on file3
(let [rows (db/query th/*pool* :file-library-rel {:file-id (:id file3)})]
(let [rows (th/db-query :file-library-rel {:file-id (:id file3)})]
(t/is (= 0 (count rows))))
;; move to other project in other team
@ -418,23 +418,23 @@
(t/is (nil? (:result out)))
;; project1 now should have 2 file
(let [[item1 item2 :as rows] (db/query th/*pool* :file {:project-id (:id project1)}
{:order-by [:created-at]})]
(let [[item1 item2 :as rows] (th/db-query :file {:project-id (:id project1)}
{:order-by [:created-at]})]
;; (clojure.pprint/pprint rows)
(t/is (= 2 (count rows)))
(t/is (= (:id item1) (:id file2))))
;; project2 now should have 1 file
(let [[item :as rows] (db/query th/*pool* :file {:project-id (:id project2)})]
(let [[item :as rows] (th/db-query :file {:project-id (:id project2)})]
(t/is (= 1 (count rows)))
(t/is (= (:id item) (:id file1))))
;; the moved file1 should not have any link to libraries
(let [rows (db/query th/*pool* :file-library-rel {:file-id (:id file1)})]
(let [rows (th/db-query :file-library-rel {:file-id (:id file1)})]
(t/is (zero? (count rows))))
;; the file2 should still be linked to file3
(let [[item :as rows] (db/query th/*pool* :file-library-rel {:file-id (:id file2)})]
(let [[item :as rows] (th/db-query :file-library-rel {:file-id (:id file2)})]
(t/is (= 1 (count rows)))
(t/is (= (:file-id item) (:id file2)))
(t/is (= (:library-file-id item) (:id file3)))))))
@ -462,21 +462,21 @@
;; --- initial data checks
;; the project1 should have 2 files
(let [rows (db/query th/*pool* :file {:project-id (:id project1)})]
(let [rows (th/db-query :file {:project-id (:id project1)})]
(t/is (= 2 (count rows))))
;; should be no files on project2
(let [rows (db/query th/*pool* :file {:project-id (:id project2)})]
(let [rows (th/db-query :file {:project-id (:id project2)})]
(t/is (= 0 (count rows))))
;; the file1 should be linked to file2
(let [[item :as rows] (db/query th/*pool* :file-library-rel {:file-id (:id file1)})]
(let [[item :as rows] (th/db-query :file-library-rel {:file-id (:id file1)})]
(t/is (= 1 (count rows)))
(t/is (= (:file-id item) (:id file1)))
(t/is (= (:library-file-id item) (:id file2))))
;; should be no libraries on file2
(let [rows (db/query th/*pool* :file-library-rel {:file-id (:id file2)})]
(let [rows (th/db-query :file-library-rel {:file-id (:id file2)})]
(t/is (= 0 (count rows))))
;; move the library to other project
@ -490,22 +490,22 @@
(t/is (nil? (:result out)))
;; project1 now should have 1 file
(let [[item :as rows] (db/query th/*pool* :file {:project-id (:id project1)}
{:order-by [:created-at]})]
(let [[item :as rows] (th/db-query :file {:project-id (:id project1)}
{:order-by [:created-at]})]
(t/is (= 1 (count rows)))
(t/is (= (:id item) (:id file1))))
;; project2 now should have 1 file
(let [[item :as rows] (db/query th/*pool* :file {:project-id (:id project2)})]
(let [[item :as rows] (th/db-query :file {:project-id (:id project2)})]
(t/is (= 1 (count rows)))
(t/is (= (:id item) (:id file2))))
;; the file1 should not have any link to libraries
(let [rows (db/query th/*pool* :file-library-rel {:file-id (:id file1)})]
(let [rows (th/db-query :file-library-rel {:file-id (:id file1)})]
(t/is (zero? (count rows))))
;; the file2 should not have any link to libraries
(let [rows (db/query th/*pool* :file-library-rel {:file-id (:id file2)})]
(let [rows (th/db-query :file-library-rel {:file-id (:id file2)})]
(t/is (zero? (count rows)))))))
(t/deftest move-project
@ -538,16 +538,17 @@
;; --- initial data checks
;; the project1 should have 2 files
(let [rows (db/query th/*pool* :file {:project-id (:id project1)})]
(let [rows (th/db-query :file {:project-id (:id project1)})]
(t/is (= 2 (count rows))))
;; the project2 should have 1 file
(let [rows (db/query th/*pool* :file {:project-id (:id project2)})]
(let [rows (th/db-query :file {:project-id (:id project2)})]
(t/is (= 1 (count rows))))
;; the file1 should be linked to file2 and file3
(let [[item1 item2 :as rows] (db/query th/*pool* :file-library-rel {:file-id (:id file1)}
{:order-by [:created-at]})]
(let [[item1 item2 :as rows] (th/db-query :file-library-rel
{:file-id (:id file1)}
{:order-by [:created-at]})]
(t/is (= 2 (count rows)))
(t/is (= (:file-id item1) (:id file1)))
(t/is (= (:library-file-id item1) (:id file2)))
@ -555,15 +556,14 @@
(t/is (= (:library-file-id item2) (:id file3))))
;; the file2 should not be linked to any file
(let [[rows] (db/query th/*pool* :file-library-rel {:file-id (:id file2)})]
(let [[rows] (th/db-query :file-library-rel {:file-id (:id file2)})]
(t/is (= 0 (count rows))))
;; the file3 should not be linked to any file
(let [[rows] (db/query th/*pool* :file-library-rel {:file-id (:id file3)})]
(let [[rows] (th/db-query :file-library-rel {:file-id (:id file3)})]
(t/is (= 0 (count rows))))
;; move project1 to other team
;; TODO: correct team change of project
(let [data {::th/type :move-project
::rpc/profile-id (:id profile)
:project-id (:id project1)
@ -574,21 +574,25 @@
(t/is (nil? (:result out)))
;; project1 now should still have 2 files
(let [[item1 item2 :as rows] (db/query th/*pool* :file {:project-id (:id project1)}
{:order-by [:created-at]})]
(let [[item1 item2 :as rows] (th/db-query :file
{:project-id (:id project1)}
{:order-by [:created-at]})]
;; (clojure.pprint/pprint rows)
(t/is (= 2 (count rows)))
(t/is (= (:id item1) (:id file1)))
(t/is (= (:id item2) (:id file2))))
;; project2 now should still have 1 file
(let [[item :as rows] (db/query th/*pool* :file {:project-id (:id project2)})]
(let [[item :as rows] (th/db-query :file {:project-id (:id project2)})]
;; (pp/pprint rows)
(t/is (= 1 (count rows)))
(t/is (= (:id item) (:id file3))))
;; the file1 should be linked to file2 but not file3
(let [[item1 :as rows] (db/query th/*pool* :file-library-rel {:file-id (:id file1)}
{:order-by [:created-at]})]
(let [[item1 :as rows] (th/db-query :file-library-rel
{:file-id (:id file1)}
{:order-by [:created-at]})]
(t/is (= 1 (count rows)))
(t/is (= (:file-id item1) (:id file1)))
(t/is (= (:library-file-id item1) (:id file2)))))))

25
common/src/app/common/features.cljc
View file

@ -51,7 +51,10 @@
"layout/grid"})
;; A set of features enabled by default for each file, they are
;; implicit and are enabled by default and can't be disabled
;; implicit and are enabled by default and can't be disabled. The
;; features listed in this set are mainly freatures addedby file
;; migrations process, so all features referenced in migrations should
;; be here.
(def default-enabled-features
#{"fdata/shape-data-type"})
@ -190,7 +193,11 @@
([enabled-features file-features]
(check-file-features! enabled-features file-features #{}))
([enabled-features file-features client-features]
(let [file-features (into #{} xf-remove-ephimeral file-features)]
(let [file-features (into #{} xf-remove-ephimeral file-features)
;; We should ignore all features that does not match with the
;; `no-migration-features` set because we can't enable them
;; as-is, because they probably need migrations
client-features (set/intersection client-features no-migration-features)]
(let [not-supported (-> enabled-features
(set/union client-features)
(set/difference file-features)
@ -208,15 +215,11 @@
(check-supported-features! file-features)
(let [;; We should ignore all features that does not match with
;; the `no-migration-features` set because we can't enable
;; them as-is, because they probably need migrations
client-features (set/intersection client-features no-migration-features)
not-supported (-> file-features
(set/difference enabled-features)
(set/difference client-features)
(set/difference backend-only-features)
(set/difference frontend-only-features))]
(let [not-supported (-> file-features
(set/difference enabled-features)
(set/difference client-features)
(set/difference backend-only-features)
(set/difference frontend-only-features))]
(when (seq not-supported)
(ex/raise :type :restriction

130
common/src/app/common/files/repair.cljc
View file

@ -28,14 +28,14 @@
(let [repair-shape
(fn [shape]
; Reset geometry to minimal
(log/debug :hint " -> Reset geometry")
(log/debug :hint " -> reset geometry")
(-> shape
(assoc :x 0)
(assoc :y 0)
(assoc :width 0.01)
(assoc :height 0.01)
(cts/setup-rect)))]
(log/info :hint "Repairing shape :invalid-geometry" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :invalid-geometry" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
@ -45,10 +45,10 @@
(let [repair-shape
(fn [shape]
; Set parent to root frame.
(log/debug :hint " -> Set to " :parent-id uuid/zero)
(log/debug :hint " -> set to " :parent-id uuid/zero)
(assoc shape :parent-id uuid/zero))]
(log/info :hint "Repairing shape :parent-not-found" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :parent-not-found" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
@ -58,10 +58,10 @@
(let [repair-shape
(fn [parent-shape]
; Add shape to parent's children list
(log/debug :hint " -> Add children to" :parent-id (:id parent-shape))
(log/debug :hint " -> add children to" :parent-id (:id parent-shape))
(update parent-shape :shapes conj (:id shape)))]
(log/info :hint "Repairing shape :child-not-in-parent" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :child-not-in-parent" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:parent-id shape)] repair-shape))))
@ -70,17 +70,17 @@
[_ {:keys [shape page-id args] :as error} file-data _]
(let [repair-shape
(fn [parent-shape]
(log/debug :hint " -> Remove child" :child-id (:child-id args))
(log/debug :hint " -> remove child" :child-id (:child-id args))
(update parent-shape :shapes (fn [shapes]
(d/removev #(= (:child-id args) %) shapes))))]
(log/info :hint "Repairing shape :child-not-found" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :child-not-found" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
(defmethod repair-error :invalid-parent
[_ {:keys [shape page-id args] :as error} file-data _]
(log/info :hint "Repairing shape :invalid-parent" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :invalid-parent" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/change-parent (:parent-id args) [shape] nil {:component-swap true})))
@ -93,10 +93,10 @@
(let [page (ctpl/get-page file-data page-id)
frame (cfh/get-frame (:objects page) (:parent-id shape))
frame-id (or (:id frame) uuid/zero)]
(log/debug :hint " -> Set to " :frame-id frame-id)
(log/debug :hint " -> set to " :frame-id frame-id)
(assoc shape :frame-id frame-id)))]
(log/info :hint "Repairing shape :frame-not-found" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :frame-not-found" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
@ -109,10 +109,10 @@
(let [page (ctpl/get-page file-data page-id)
frame (cfh/get-frame (:objects page) (:parent-id shape))
frame-id (or (:id frame) uuid/zero)]
(log/debug :hint " -> Set to " :frame-id frame-id)
(log/debug :hint " -> set to " :frame-id frame-id)
(assoc shape :frame-id frame-id)))]
(log/info :hint "Repairing shape :invalid-frame" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :invalid-frame" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
@ -122,10 +122,10 @@
(let [repair-shape
(fn [shape]
; Set the :shape as main instance root
(log/debug :hint " -> Set :main-instance")
(log/debug :hint " -> set :main-instance")
(assoc shape :main-instance true))]
(log/info :hint "Repairing shape :component-not-main" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :component-not-main" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
@ -135,13 +135,13 @@
(let [repair-shape
(fn [shape]
; Set :component-file to local file
(log/debug :hint " -> Set :component-file to local file")
(log/debug :hint " -> set :component-file to local file")
(assoc shape :component-file (:id file-data)))]
; There is no solution that may recover it with confidence
;; (log/warn :hint " -> CANNOT REPAIR THIS AUTOMATICALLY.")
;; shape)]
(log/info :hint "Repairing shape :component-main-external" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :component-main-external" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
@ -154,13 +154,13 @@
repair-shape
(fn [shape]
; Detach the shape and convert it to non instance.
(log/debug :hint " -> Detach shape" :shape-id (:id shape))
(log/debug :hint " -> detach shape" :shape-id (:id shape))
(ctk/detach-shape shape))]
; There is no solution that may recover it with confidence
;; (log/warn :hint " -> CANNOT REPAIR THIS AUTOMATICALLY.")
;; shape)]
(log/info :hint "Repairing shape :component-not-found" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :component-not-found" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes shape-ids repair-shape))))
@ -172,15 +172,15 @@
repair-component
(fn [component]
; Assign main instance in the component to current shape
(log/debug :hint " -> Assign main-instance-id" :component-id (:id component))
(log/debug :hint " -> assign main-instance-id" :component-id (:id component))
(assoc component :main-instance-id (:id shape)))
detach-shape
(fn [shape]
(log/debug :hint " -> Detach shape" :shape-id (:id shape))
(log/debug :hint " -> detach shape" :shape-id (:id shape))
(ctk/detach-shape shape))]
(log/info :hint "Repairing shape :invalid-main-instance-id" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :invalid-main-instance-id" :id (:id shape) :name (:name shape) :page-id page-id)
(if (and (some? component) (not (:deleted component)))
(-> (pcb/empty-changes nil page-id)
(pcb/with-library-data file-data)
@ -195,9 +195,9 @@
(let [repair-component
(fn [component]
; Assign main instance in the component to current shape
(log/debug :hint " -> Assign main-instance-page" :component-id (:id component))
(log/debug :hint " -> assign main-instance-page" :component-id (:id component))
(assoc component :main-instance-page page-id))]
(log/info :hint "Repairing shape :invalid-main-instance-page" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :invalid-main-instance-page" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-library-data file-data)
(pcb/update-component (:component-id shape) repair-component))))
@ -210,7 +210,7 @@
(log/warn :hint " -> CANNOT REPAIR THIS AUTOMATICALLY.")
shape)]
(log/info :hint "Repairing shape :invalid-main-instance" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :invalid-main-instance" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
@ -220,10 +220,10 @@
(let [repair-shape
(fn [shape]
; Unset the :shape as main instance root
(log/debug :hint " -> Unset :main-instance")
(log/debug :hint " -> unset :main-instance")
(dissoc shape :main-instance))]
(log/info :hint "Repairing shape :component-main" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :component-main" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
@ -233,10 +233,10 @@
(let [repair-shape
(fn [shape]
; Convert the shape in a top copy root.
(log/debug :hint " -> Set :component-root")
(log/debug :hint " -> set :component-root")
(assoc shape :component-root true))]
(log/info :hint "Repairing shape :should-be-component-root" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :should-be-component-root" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
@ -246,10 +246,10 @@
(let [repair-shape
(fn [shape]
; Convert the shape in a nested copy root.
(log/debug :hint " -> Unset :component-root")
(log/debug :hint " -> unset :component-root")
(dissoc shape :component-root))]
(log/info :hint "Repairing shape :should-not-be-component-root" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :should-not-be-component-root" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
@ -268,17 +268,17 @@
reassign-shape
(fn [shape]
(log/debug :hint " -> Reassign shape-ref to" :shape-ref (:id matching-shape))
(log/debug :hint " -> reassign shape-ref to" :shape-ref (:id matching-shape))
(assoc shape :shape-ref (:id matching-shape)))
detach-shape
(fn [shape]
(log/debug :hint " -> Detach shape" :shape-id (:id shape))
(log/debug :hint " -> detach shape" :shape-id (:id shape))
(ctk/detach-shape shape))]
; If the shape still refers to the remote component, try to find the corresponding near one
; and link to it. If not, detach the shape.
(log/info :hint "Repairing shape :ref-shape-not-found" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :ref-shape-not-found" :id (:id shape) :name (:name shape) :page-id page-id)
(if (some? matching-shape)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
@ -294,10 +294,10 @@
(let [repair-shape
(fn [shape]
; Remove shape-ref
(log/debug :hint " -> Unset :shape-ref")
(log/debug :hint " -> unset :shape-ref")
(dissoc shape :shape-ref))]
(log/info :hint "Repairing shape :shape-ref-in-main" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :shape-ref-in-main" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
@ -307,10 +307,10 @@
(let [repair-shape
(fn [shape]
; Convert the shape in a nested main head.
(log/debug :hint " -> Unset :component-root")
(log/debug :hint " -> unset :component-root")
(dissoc shape :component-root))]
(log/info :hint "Repairing shape :root-main-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :root-main-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
@ -320,10 +320,10 @@
(let [repair-shape
(fn [shape]
; Convert the shape in a top main head.
(log/debug :hint " -> Set :component-root")
(log/debug :hint " -> set :component-root")
(assoc shape :component-root true))]
(log/info :hint "Repairing shape :nested-main-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :nested-main-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
@ -333,10 +333,10 @@
(let [repair-shape
(fn [shape]
; Convert the shape in a nested copy head.
(log/debug :hint " -> Unset :component-root")
(log/debug :hint " -> unset :component-root")
(dissoc shape :component-root))]
(log/info :hint "Repairing shape :root-copy-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :root-copy-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
@ -346,10 +346,10 @@
(let [repair-shape
(fn [shape]
; Convert the shape in a top copy root.
(log/debug :hint " -> Set :component-root")
(log/debug :hint " -> set :component-root")
(assoc shape :component-root true))]
(log/info :hint "Repairing shape :nested-copy-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :nested-copy-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
@ -359,10 +359,10 @@
(let [repair-shape
(fn [shape]
; Detach the shape and convert it to non instance.
(log/debug :hint " -> Detach shape" :shape-id (:id shape))
(log/debug :hint " -> detach shape" :shape-id (:id shape))
(ctk/detach-shape shape))]
(log/info :hint "Repairing shape :not-head-main-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :not-head-main-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
@ -372,10 +372,10 @@
(let [repair-shape
(fn [shape]
; Detach the shape and convert it to non instance.
(log/debug :hint " -> Detach shape" :shape-id (:id shape))
(log/debug :hint " -> detach shape" :shape-id (:id shape))
(ctk/detach-shape shape))]
(log/info :hint "Repairing shape :not-head-copy-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :not-head-copy-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
@ -388,7 +388,7 @@
(log/warn :hint " -> CANNOT REPAIR THIS AUTOMATICALLY.")
shape)]
(log/info :hint "Repairing shape :not-component-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :not-component-not-allowed" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
@ -398,14 +398,14 @@
(let [repair-shape
(fn [shape]
; Convert the shape in a frame.
(log/debug :hint " -> Set :type :frame")
(log/debug :hint " -> set :type :frame")
(assoc shape :type :frame
:fills []
:hide-in-viewer true
:rx 0
:ry 0))]
(log/info :hint "Repairing shape :instance-head-not-frame" :id (:id shape) :name (:name shape) :page-id page-id)
(log/dbg :hint "repairing shape :instance-head-not-frame" :id (:id shape) :name (:name shape) :page-id page-id)
(-> (pcb/empty-changes nil page-id)
(pcb/with-file-data file-data)
(pcb/update-shapes [(:id shape)] repair-shape))))
@ -417,13 +417,13 @@
; Remove the objects key, or set it to {} if the component is deleted
(if (:deleted component)
(do
(log/debug :hint " -> Set :objects {}")
(log/debug :hint " -> set :objects {}")
(assoc component :objects {}))
(do
(log/debug :hint " -> Remove :objects")
(log/debug :hint " -> remove :objects")
(dissoc component :objects))))]
(log/info :hint "Repairing component :component-nil-objects-not-allowed" :id (:id shape) :name (:name shape))
(log/dbg :hint "repairing component :component-nil-objects-not-allowed" :id (:id shape) :name (:name shape))
(-> (pcb/empty-changes nil)
(pcb/with-library-data file-data)
(pcb/update-component (:id shape) repair-component))))
@ -434,13 +434,15 @@
file)
(defn repair-file
[file-data libraries errors]
(log/info :hint "Repairing file" :id (:id file-data) :error-count (count errors))
(reduce (fn [changes error]
(pcb/concat-changes changes
(repair-error (:code error)
error
file-data
libraries)))
(pcb/empty-changes nil)
errors))
[{:keys [data id] :as file} libraries errors]
(log/dbg :hint "repairing file" :id (str id) :errors (count errors))
(let [{:keys [redo-changes]}
(reduce (fn [changes error]
(pcb/concat-changes changes
(repair-error (:code error)
error
data
libraries)))
(pcb/empty-changes nil)
errors)]
redo-changes))

477
common/src/app/common/files/validate.cljc
View file

@ -6,6 +6,7 @@
(ns app.common.files.validate
(:require
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.files.helpers :as cfh]
[app.common.schema :as sm]
@ -49,50 +50,50 @@
:not-component-not-allowed
:component-nil-objects-not-allowed})
(def validation-error
[:map {:title "ValidationError"}
[:code {:optional false} [::sm/one-of error-codes]]
[:hint {:optional false} :string]
[:shape {:optional true} :map] ; Cannot validate a shape because here it may be broken
[:file-id ::sm/uuid]
[:page-id ::sm/uuid]])
(def ^:private
schema:error
(sm/define
[:map {:title "ValidationError"}
[:code {:optional false} [::sm/one-of error-codes]]
[:hint {:optional false} :string]
[:shape {:optional true} :map] ; Cannot validate a shape because here it may be broken
[:shape-id {:optional true} ::sm/uuid]
[:file-id ::sm/uuid]
[:page-id ::sm/uuid]]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ERROR HANDLING
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:dynamic *errors* nil)
(def ^:dynamic ^:private *errors* nil)
(defn report-error!
(defn- report-error
[code hint shape file page & {:as args}]
(if (some? *errors*)
(vswap! *errors* conj {:code code
:hint hint
:shape shape
:file-id (:id file)
:page-id (:id page)
:args args})
(let [error {:code code
:hint hint
:shape shape
:file-id (:id file)
:page-id (:id page)
:shape-id (:id shape)
:args args}]
(let [explain (str/ffmt "file %, page %, shape %"
(:id file)
(:id page)
(:id shape))]
(ex/raise :type :validation
:code code
:hint hint
:args args
:file-id (:id file)
:page-id (:id page)
:shape-id (:id shape)
::explain explain))))
(dm/assert!
"expected a valid `*errors*` dynamic binding"
(some? *errors*))
(dm/assert!
"expected valid error"
(sm/check! schema:error error))
(vswap! *errors* conj error)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; VALIDATION FUNCTIONS
;; PRIVATE API: VALIDATION FUNCTIONS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare validate-shape!)
(declare check-shape)
(defn validate-geometry!
(defn- check-geometry
"Validate that the shape has valid coordinates, selrect and points."
[shape file page]
(when (and (not (#{:path :bool} (:type shape)))
@ -102,175 +103,175 @@
(nil? (:height shape))
(nil? (:selrect shape))
(nil? (:points shape))))
(report-error! :invalid-geometry
"Shape greometry is invalid"
shape file page)))
(report-error :invalid-geometry
"Shape greometry is invalid"
shape file page)))
(defn validate-parent-children!
(defn- check-parent-children
"Validate parent and children exists, and the link is bidirectional."
[shape file page]
(let [parent (ctst/get-shape page (:parent-id shape))]
(if (nil? parent)
(report-error! :parent-not-found
(str/ffmt "Parent % not found" (:parent-id shape))
shape file page)
(report-error :parent-not-found
(str/ffmt "Parent % not found" (:parent-id shape))
shape file page)
(do
(when-not (cfh/root? shape)
(when-not (some #{(:id shape)} (:shapes parent))
(report-error! :child-not-in-parent
(str/ffmt "Shape % not in parent's children list" (:id shape))
shape file page)))
(report-error :child-not-in-parent
(str/ffmt "Shape % not in parent's children list" (:id shape))
shape file page)))
(doseq [child-id (:shapes shape)]
(let [child (ctst/get-shape page child-id)]
(if (nil? child)
(report-error! :child-not-found
(str/ffmt "Child % not found in parent %" child-id (:id shape))
shape file page
:parent-id (:id shape)
:child-id child-id)
(report-error :child-not-found
(str/ffmt "Child % not found in parent %" child-id (:id shape))
shape file page
:parent-id (:id shape)
:child-id child-id)
(when (not= (:parent-id child) (:id shape))
(report-error! :invalid-parent
(str/ffmt "Child % has invalid parent %" child-id (:id shape))
child file page
:parent-id (:id shape))))))))))
(report-error :invalid-parent
(str/ffmt "Child % has invalid parent %" child-id (:id shape))
child file page
:parent-id (:id shape))))))))))
(defn validate-frame!
(defn- check-frame
"Validate that the frame-id shape exists and is indeed a frame. Also
it must point to the parent shape (if this is a frame) or to the
frame-id of the parent (if not)."
[shape file page]
(let [frame (ctst/get-shape page (:frame-id shape))]
(if (nil? frame)
(report-error! :frame-not-found
(str/ffmt "Frame % not found" (:frame-id shape))
shape file page)
(report-error :frame-not-found
(str/ffmt "Frame % not found" (:frame-id shape))
shape file page)
(if (not= (:type frame) :frame)
(report-error! :invalid-frame
(str/ffmt "Frame % is not actually a frame" (:frame-id shape))
shape file page)
(report-error :invalid-frame
(str/ffmt "Frame % is not actually a frame" (:frame-id shape))
shape file page)
(let [parent (ctst/get-shape page (:parent-id shape))]
(when (some? parent)
(if (= (:type parent) :frame)
(when-not (= (:frame-id shape) (:id parent))
(report-error! :invalid-frame
(str/ffmt "Frame-id should point to parent %" (:id parent))
shape file page))
(report-error :invalid-frame
(str/ffmt "Frame-id should point to parent %" (:id parent))
shape file page))
(when-not (= (:frame-id shape) (:frame-id parent))
(report-error! :invalid-frame
(str/ffmt "Frame-id should point to parent frame %" (:frame-id parent))
shape file page)))))))))
(report-error :invalid-frame
(str/ffmt "Frame-id should point to parent frame %" (:frame-id parent))
shape file page)))))))))
(defn validate-component-main-head!
(defn- check-component-main-head
"Validate shape is a main instance head, component exists
and its main-instance points to this shape."
[shape file page libraries]
(when (nil? (:main-instance shape))
(report-error! :component-not-main
"Shape expected to be main instance"
shape file page))
(report-error :component-not-main
"Shape expected to be main instance"
shape file page))
(when-not (= (:component-file shape) (:id file))
(report-error! :component-main-external
"Main instance should refer to a component in the same file"
shape file page))
(report-error :component-main-external
"Main instance should refer to a component in the same file"
shape file page))
(let [component (ctf/resolve-component shape file libraries :include-deleted? true)]
(if (nil? component)
(report-error! :component-not-found
(str/ffmt "Component % not found in file %" (:component-id shape) (:component-file shape))
shape file page)
(report-error :component-not-found
(str/ffmt "Component % not found in file %" (:component-id shape) (:component-file shape))
shape file page)
(do
(when-not (= (:main-instance-id component) (:id shape))
(report-error! :invalid-main-instance-id
(str/ffmt "Main instance id of component % is not valid" (:component-id shape))
shape file page))
(report-error :invalid-main-instance-id
(str/ffmt "Main instance id of component % is not valid" (:component-id shape))
shape file page))
(when-not (= (:main-instance-page component) (:id page))
(let [component-page (ctf/get-component-page (:data file) component)
main-component (ctst/get-shape component-page (:main-instance-id component))]
;; We must check if the same component has main instances in different pages.
;; In that case one of those instances shouldn't be main
(if (:main-instance main-component)
(report-error! :component-main
"Shape not expected to be main instance"
shape file page)
(report-error! :invalid-main-instance-page
(str/ffmt "Main instance page of component % is not valid" (:component-id shape))
shape file page))))))))
(report-error :component-main
"Shape not expected to be main instance"
shape file page)
(report-error :invalid-main-instance-page
(str/ffmt "Main instance page of component % is not valid" (:component-id shape))
shape file page))))))))
(defn validate-component-not-main-head!
(defn- check-component-not-main-head
"Validate shape is a not-main instance head, component
exists and its main-instance does not point to this
shape."
[shape file page libraries]
(when (true? (:main-instance shape))
(report-error! :component-not-main
"Shape not expected to be main instance"
shape file page))
(report-error :component-not-main
"Shape not expected to be main instance"
shape file page))
(let [library-exists? (or (= (:component-file shape) (:id file))
(contains? libraries (:component-file shape)))
(contains? libraries (:component-file shape)))
component (when library-exists?
(ctf/resolve-component shape file libraries {:include-deleted? true}))]
(if (nil? component)
(when library-exists?
(report-error! :component-not-found
(str/ffmt "Component % not found in file %" (:component-id shape) (:component-file shape))
shape file page))
(report-error :component-not-found
(str/ffmt "Component % not found in file %" (:component-id shape) (:component-file shape))
shape file page))
(when (and (= (:main-instance-id component) (:id shape))
(= (:main-instance-page component) (:id page)))
(report-error! :invalid-main-instance
(str/ffmt "Main instance of component % should not be this shape" (:id component))
shape file page)))))
(report-error :invalid-main-instance
(str/ffmt "Main instance of component % should not be this shape" (:id component))
shape file page)))))
(defn validate-component-not-main-not-head!
(defn- check-component-not-main-not-head
"Validate that this shape is not main instance and not head."
[shape file page]
(when (true? (:main-instance shape))
(report-error! :component-main
"Shape not expected to be main instance"
shape file page))
(report-error :component-main
"Shape not expected to be main instance"
shape file page))
(when (or (some? (:component-id shape))
(some? (:component-file shape)))
(report-error! :component-main
"Shape not expected to be component head"
shape file page)))
(report-error :component-main
"Shape not expected to be component head"
shape file page)))
(defn validate-component-root!
(defn- check-component-root
"Validate that this shape is an instance root."
[shape file page]
(when (nil? (:component-root shape))
(report-error! :should-be-component-root
"Shape should be component root"
shape file page)))
(report-error :should-be-component-root
"Shape should be component root"
shape file page)))
(defn validate-component-not-root!
(defn- check-component-not-root
"Validate that this shape is not an instance root."
[shape file page]
(when (true? (:component-root shape))
(report-error! :should-not-be-component-root
"Shape should not be component root"
shape file page)))
(report-error :should-not-be-component-root
"Shape should not be component root"
shape file page)))
(defn validate-component-ref!
(defn- check-component-ref
"Validate that the referenced shape exists in the near component."
[shape file page libraries]
(let [library-exists? (or (= (:component-file shape) (:id file))
(contains? libraries (:component-file shape)))
(contains? libraries (:component-file shape)))
ref-shape (when library-exists?
(ctf/find-ref-shape file page libraries shape :include-deleted? true))]
(when (and library-exists? (nil? ref-shape))
(report-error! :ref-shape-not-found
(str/ffmt "Referenced shape % not found in near component" (:shape-ref shape))
shape file page))))
(report-error :ref-shape-not-found
(str/ffmt "Referenced shape % not found in near component" (:shape-ref shape))
shape file page))))
(defn validate-component-not-ref!
(defn- check-component-not-ref
"Validate that this shape does not reference other one."
[shape file page]
(when (some? (:shape-ref shape))
(report-error! :shape-ref-in-main
"Shape inside main instance should not have shape-ref"
shape file page)))
(report-error :shape-ref-in-main
"Shape inside main instance should not have shape-ref"
shape file page)))
(defn validate-shape-main-root-top!
(defn- check-shape-main-root-top
"Root shape of a top main instance:
- :main-instance
@ -278,78 +279,78 @@
- :component-file
- :component-root"
[shape file page libraries]
(validate-component-main-head! shape file page libraries)
(validate-component-root! shape file page)
(validate-component-not-ref! shape file page)
(check-component-main-head shape file page libraries)
(check-component-root shape file page)
(check-component-not-ref shape file page)
(doseq [child-id (:shapes shape)]
(validate-shape! child-id file page libraries :context :main-top)))
(check-shape child-id file page libraries :context :main-top)))
(defn validate-shape-main-root-nested!
(defn- check-shape-main-root-nested
"Root shape of a nested main instance
- :main-instance
- :component-id
- :component-file"
[shape file page libraries]
(validate-component-main-head! shape file page libraries)
(validate-component-not-root! shape file page)
(validate-component-not-ref! shape file page)
(check-component-main-head shape file page libraries)
(check-component-not-root shape file page)
(check-component-not-ref shape file page)
(doseq [child-id (:shapes shape)]
(validate-shape! child-id file page libraries :context :main-nested)))
(check-shape child-id file page libraries :context :main-nested)))
(defn validate-shape-copy-root-top!
(defn- check-shape-copy-root-top
"Root shape of a top copy instance
- :component-id
- :component-file
- :component-root
- :shape-ref"
[shape file page libraries]
(validate-component-not-main-head! shape file page libraries)
(validate-component-root! shape file page)
(validate-component-ref! shape file page libraries)
(check-component-not-main-head shape file page libraries)
(check-component-root shape file page)
(check-component-ref shape file page libraries)
(doseq [child-id (:shapes shape)]
(validate-shape! child-id file page libraries :context :copy-top)))
(check-shape child-id file page libraries :context :copy-top)))
(defn validate-shape-copy-root-nested!
(defn- check-shape-copy-root-nested
"Root shape of a nested copy instance
- :component-id
- :component-file
- :shape-ref"
[shape file page libraries]
(validate-component-not-main-head! shape file page libraries)
(validate-component-not-root! shape file page)
(validate-component-ref! shape file page libraries)
(check-component-not-main-head shape file page libraries)
(check-component-not-root shape file page)
(check-component-ref shape file page libraries)
(doseq [child-id (:shapes shape)]
(validate-shape! child-id file page libraries :context :copy-nested)))
(check-shape child-id file page libraries :context :copy-nested)))
(defn validate-shape-main-not-root!
(defn- check-shape-main-not-root
"Not-root shape of a main instance (not any attribute)"
[shape file page libraries]
(validate-component-not-main-not-head! shape file page)
(validate-component-not-root! shape file page)
(validate-component-not-ref! shape file page)
(check-component-not-main-not-head shape file page)
(check-component-not-root shape file page)
(check-component-not-ref shape file page)
(doseq [child-id (:shapes shape)]
(validate-shape! child-id file page libraries :context :main-any)))
(check-shape child-id file page libraries :context :main-any)))
(defn validate-shape-copy-not-root!
(defn- check-shape-copy-not-root
"Not-root shape of a copy instance :shape-ref"
[shape file page libraries]
(validate-component-not-main-not-head! shape file page)
(validate-component-not-root! shape file page)
(validate-component-ref! shape file page libraries)
(check-component-not-main-not-head shape file page)
(check-component-not-root shape file page)
(check-component-ref shape file page libraries)
(doseq [child-id (:shapes shape)]
(validate-shape! child-id file page libraries :context :copy-any)))
(check-shape child-id file page libraries :context :copy-any)))
(defn validate-shape-not-component!
(defn- check-shape-not-component
"Shape is not in a component or is a fostered children (not any
attribute)"
[shape file page libraries]
(validate-component-not-main-not-head! shape file page)
(validate-component-not-root! shape file page)
(validate-component-not-ref! shape file page)
(check-component-not-main-not-head shape file page)
(check-component-not-root shape file page)
(check-component-not-ref shape file page)
(doseq [child-id (:shapes shape)]
(validate-shape! child-id file page libraries :context :not-component)))
(check-shape child-id file page libraries :context :not-component)))
(defn validate-shape!
(defn- check-shape
"Validate referential integrity and semantic coherence of
a shape and all its children. Report all errors found.
@ -366,132 +367,140 @@
(let [shape (ctst/get-shape page shape-id)]
(when (some? shape)
(do
(validate-geometry! shape file page)
(validate-parent-children! shape file page)
(validate-frame! shape file page)
(check-geometry shape file page)
(check-parent-children shape file page)
(check-frame shape file page)
(if (ctk/instance-head? shape)
(if (not= :frame (:type shape))
(report-error! :instance-head-not-frame
"Instance head should be a frame"
shape file page)
(report-error :instance-head-not-frame
"Instance head should be a frame"
shape file page)
(if (ctk/instance-root? shape)
(if (ctk/main-instance? shape)
(if (not= context :not-component)
(report-error! :root-main-not-allowed
"Root main component not allowed inside other component"
shape file page)
(validate-shape-main-root-top! shape file page libraries))
(report-error :root-main-not-allowed
"Root main component not allowed inside other component"
shape file page)
(check-shape-main-root-top shape file page libraries))
(if (not= context :not-component)
(report-error! :root-copy-not-allowed
"Root copy component not allowed inside other component"
shape file page)
(validate-shape-copy-root-top! shape file page libraries)))
(report-error :root-copy-not-allowed
"Root copy component not allowed inside other component"
shape file page)
(check-shape-copy-root-top shape file page libraries)))
(if (ctk/main-instance? shape)
(if (= context :not-component)
(report-error! :nested-main-not-allowed
"Nested main component only allowed inside other component"
shape file page)
(validate-shape-main-root-nested! shape file page libraries))
(report-error :nested-main-not-allowed
"Nested main component only allowed inside other component"
shape file page)
(check-shape-main-root-nested shape file page libraries))
(if (= context :not-component)
(report-error! :nested-copy-not-allowed
"Nested copy component only allowed inside other component"
shape file page)
(validate-shape-copy-root-nested! shape file page libraries)))))
(report-error :nested-copy-not-allowed
"Nested copy component only allowed inside other component"
shape file page)
(check-shape-copy-root-nested shape file page libraries)))))
(if (ctk/in-component-copy? shape)
(if-not (#{:copy-top :copy-nested :copy-any} context)
(report-error! :not-head-copy-not-allowed
"Non-root copy only allowed inside a copy"
shape file page)
(validate-shape-copy-not-root! shape file page libraries))
(report-error :not-head-copy-not-allowed
"Non-root copy only allowed inside a copy"
shape file page)
(check-shape-copy-not-root shape file page libraries))
(if (ctn/inside-component-main? (:objects page) shape)
(if-not (#{:main-top :main-nested :main-any} context)
(report-error! :not-head-main-not-allowed
"Non-root main only allowed inside a main component"
shape file page)
(validate-shape-main-not-root! shape file page libraries))
(report-error :not-head-main-not-allowed
"Non-root main only allowed inside a main component"
shape file page)
(check-shape-main-not-root shape file page libraries))
(if (#{:main-top :main-nested :main-any} context)
(report-error! :not-component-not-allowed
"Not compoments are not allowed inside a main"
shape file page)
(validate-shape-not-component! shape file page libraries)))))))))
(report-error :not-component-not-allowed
"Not compoments are not allowed inside a main"
shape file page)
(check-shape-not-component shape file page libraries)))))))))
(defn- check-component
"Validate semantic coherence of a component. Report all errors found."
[component file]
(when (and (contains? component :objects) (nil? (:objects component)))
(report-error :component-nil-objects-not-allowed
"Objects list cannot be nil"
component file nil)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PUBLIC API: VALIDATION FUNCTIONS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn validate-file
"Validate full referential integrity and semantic coherence on file data.
Return a list of errors or `nil`"
[{:keys [data features] :as file} libraries]
(when (contains? features "components/v2")
(binding [*errors* (volatile! [])]
(doseq [page (filter :id (ctpl/pages-seq data))]
(let [orphans (->> page
:objects
vals
(filter #(not (contains? (:objects page) (:parent-id %))))
(map :id))]
(check-shape uuid/zero file page libraries)
(doseq [shape-id orphans]
(check-shape shape-id file page libraries))))
(doseq [component (vals (:components data))]
(check-component component file))
(-> *errors* deref not-empty))))
(defn validate-shape
"Validate a shape and all its children. Returns a list of errors."
[shape-id file page libraries]
(binding [*errors* (volatile! [])]
(validate-shape! shape-id file page libraries)
(check-shape shape-id file page libraries)
(deref *errors*)))
(defn validate-component!
"Validate semantic coherence of a component. Report all errors found."
[component file]
(when (and (contains? component :objects) (nil? (:objects component)))
(report-error! :component-nil-objects-not-allowed
"Objects list cannot be nil"
component file nil)))
(defn validate-component
"Validate a component. Returns a list of errors."
[component file]
(binding [*errors* (volatile! [])]
(validate-component! component file)
(check-component component file)
(deref *errors*)))
(def valid-fdata?
(def ^:private valid-fdata?
"Structural validation of file data using defined schema"
(sm/lazy-validator ::ctf/data))
(def get-fdata-explain
(def ^:private get-fdata-explain
"Get schema explain data for file data"
(sm/lazy-explainer ::ctf/data))
(defn validate-file-schema!
[{:keys [id data] :as file}]
(when-not (valid-fdata? data)
(if (some? *errors*)
(vswap! *errors* conj
{:code :invalid-file-data-structure
:hint (str/ffmt "invalid file data structure found on file '%'" id)
:file-id id})
(ex/raise :type :validation
:code :data-validation
:hint (str/ffmt "invalid file data structure found on file '%'" id)
:file-id id
::sm/explain (get-fdata-explain data))))
file)
(ex/raise :type :validation
:code :schema-validation
:hint (str/ffmt "invalid file data structure found on file '%'" id)
:file-id id
::sm/explain (get-fdata-explain data))))
(defn validate-file!
"Validate full referential integrity and semantic coherence on file data.
Raises a validation exception on first error found."
[{:keys [data features] :as file} libraries]
(when (contains? features "components/v2")
(doseq [page (filter :id (ctpl/pages-seq data))]
(let [orphans (->> page
:objects
vals
(filter #(not (contains? (:objects page) (:parent-id %))))
(map :id))]
(validate-shape! uuid/zero file page libraries)
(doseq [shape-id orphans]
(validate-shape! shape-id file page libraries))))
(doseq [component (vals (:components data))]
(validate-component! component file)))
file)
(defn validate-file
"Validate structure, referencial integrity and semantic coherence of
all contents of a file. Returns a list of errors."
Raises an exception"
[file libraries]
(binding [*errors* (volatile! [])]
(validate-file! file libraries)
(deref *errors*)))
(when-let [errors (validate-file file libraries)]
(ex/raise :type :validation
:code :referential-integrity
:hint "error on validating file referential integrity"
:file-id (:id file)
:details errors)))

55
frontend/src/debug.cljs
View file

@ -385,7 +385,7 @@
libraries (get @st/state :workspace-libraries)]
(try
(->> (if shape-id
(->> (if-let [shape-id (some-> shape-id parse-uuid)]
(let [page (dm/get-in file [:data :pages-index (get @st/state :current-page-id)])]
(cfv/validate-shape (uuid shape-id) file page libraries))
(cfv/validate-file file libraries))
@ -404,36 +404,39 @@
(errors/print-error! cause))))
(defn ^:export repair
[]
(let [file (assoc (get @st/state :workspace-file)
:data (get @st/state :workspace-data))
libraries (get @st/state :workspace-libraries)
errors (cfv/validate-file file libraries)]
[reload?]
(st/emit!
(ptk/reify ::repair-current-file
ptk/EffectEvent
(effect [_ state _]
(let [features (features/get-team-enabled-features state)
sid (:session-id state)
(l/dbg :hint "repair current file" :errors (count errors))
file (get state :workspace-file)
fdata (get state :workspace-data)
(st/emit!
(ptk/reify ::repair-current-file
ptk/WatchEvent
(watch [_ state _]
(let [features (features/get-team-enabled-features state)
sid (:session-id state)
file (get state :workspace-file)
file-data (get state :workspace-data)
libraries (get state :workspace-libraries)
file (assoc file :data fdata)
libs (get state :workspace-libraries)
changes (-> (cfr/repair-file file-data libraries errors)
(get :redo-changes))
errors (cfv/validate-file file libs)
_ (l/dbg :hint "repair current file" :errors (count errors))
params {:id (:id file)
:revn (:revn file)
:session-id sid
:changes changes
:features features
:skip-validate true}]
changes (cfr/repair-file file libs errors)
(->> (rp/cmd! :update-file params)
(rx/tap #(dom/reload-current-window)))))))))
params {:id (:id file)
:revn (:revn file)
:session-id sid
:changes changes
:features features
:skip-validate true}]
(->> (rp/cmd! :update-file params)
(rx/subs (fn [_]
(when reload?
(dom/reload-current-window)))
(fn [cause]
(errors/print-error! cause)))))))))
(defn ^:export fix-orphan-shapes
[]