diff --git a/backend/src/app/rpc/commands/files_update.clj b/backend/src/app/rpc/commands/files_update.clj index 92d14d96a..f827257cf 100644 --- a/backend/src/app/rpc/commands/files_update.clj +++ b/backend/src/app/rpc/commands/files_update.clj @@ -315,6 +315,12 @@ (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)) + + (cond-> (contains? cf/flags :soft-file-schema-validation) + (soft-validate-file-schema!)) + (cond-> (and (contains? cf/flags :file-validation) (not skip-validate)) (val/validate-file! libs)) @@ -323,12 +329,6 @@ (not skip-validate)) (val/validate-file-schema!)) - (cond-> (contains? cf/flags :soft-file-validation) - (soft-validate-file! libs)) - - (cond-> (contains? cf/flags :soft-file-schema-validation) - (soft-validate-file-schema!)) - (cond-> (and (contains? cfeat/*current* "fdata/objects-map") (not (contains? cfeat/*previous* "fdata/objects-map"))) (enable-objects-map)) diff --git a/backend/src/app/rpc/commands/profile.clj b/backend/src/app/rpc/commands/profile.clj index a5735d694..60d181009 100644 --- a/backend/src/app/rpc/commands/profile.clj +++ b/backend/src/app/rpc/commands/profile.clj @@ -8,7 +8,6 @@ (:require [app.auth :as auth] [app.common.data :as d] - [app.common.data.macros :as dm] [app.common.exceptions :as ex] [app.common.schema :as sm] [app.common.uuid :as uuid] @@ -37,7 +36,7 @@ (declare strip-private-attrs) (declare verify-password) -(def schema:profile +(def ^:private schema:profile [:map {:title "Profile"} [:id ::sm/uuid] [:fullname [::sm/word-string {:max 250}]] @@ -53,14 +52,12 @@ [:props {:optional true} [:map-of {:title "ProfileProps"} :keyword :any]]]) -(def valid-profile? - (sm/pred-fn schema:profile)) - ;; --- QUERY: Get profile (own) (sv/defmethod ::get-profile {::rpc/auth false ::doc/added "1.18" + ::sm/params [:map] ::sm/result schema:profile} [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id]}] ;; We need to return the anonymous profile object in two cases, when @@ -93,10 +90,6 @@ ::sm/result schema:profile} [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id fullname lang theme] :as params}] - (dm/assert! - "expected valid profile data" - (valid-profile? params)) - (db/with-atomic [conn pool] ;; NOTE: we need to retrieve the profile independently if we use ;; it or not for explicit locking and avoid concurrent updates of diff --git a/backend/src/app/setup/templates.clj b/backend/src/app/setup/templates.clj index c51bc98c8..3122a7668 100644 --- a/backend/src/app/setup/templates.clj +++ b/backend/src/app/setup/templates.clj @@ -28,6 +28,9 @@ (def ^:private schema:templates [:vector schema:template]) +(def check-templates! + (sm/check-fn schema:templates)) + (defmethod ig/init-key ::setup/templates [_ _] (let [templates (-> "app/onboarding.edn" io/resource slurp edn/read-string) @@ -35,7 +38,7 @@ (dm/verify! "expected a valid templates file" - (sm/valid? schema:templates templates)) + (check-templates! templates)) (doseq [{:keys [id path] :as template} templates] (let [path (or path (fs/join dest id))] diff --git a/common/src/app/common/data/macros.cljc b/common/src/app/common/data/macros.cljc index 3d3c1d1b1..4c8ff9a6c 100644 --- a/common/src/app/common/data/macros.cljc +++ b/common/src/app/common/data/macros.cljc @@ -140,7 +140,7 @@ :else (str "expr assert: " (pr-str expr)))] (when *assert* - `(binding [*assert-context* true] + `(binding [*assert-context* ~hint] (when-not ~expr (let [hint# ~hint params# {:type :assertion @@ -161,7 +161,7 @@ :else (str "expr assert: " (pr-str expr)))] - `(binding [*assert-context* true] + `(binding [*assert-context* ~hint] (when-not ~expr (let [hint# ~hint params# {:type :assertion diff --git a/common/src/app/common/files/builder.cljc b/common/src/app/common/files/builder.cljc index 520846df1..d999a05fd 100644 --- a/common/src/app/common/files/builder.cljc +++ b/common/src/app/common/files/builder.cljc @@ -46,7 +46,7 @@ (and add-container? (nil? component-id)) (assoc :page-id (:current-page-id file) :frame-id (:current-frame-id file))) - valid? (ch/valid-change? change)] + valid? (ch/check-change! change)] (when-not valid? (let [explain (sm/explain ::ch/change change)] diff --git a/common/src/app/common/files/changes.cljc b/common/src/app/common/files/changes.cljc index 9df8792ac..f6ed60623 100644 --- a/common/src/app/common/files/changes.cljc +++ b/common/src/app/common/files/changes.cljc @@ -31,25 +31,27 @@ ;; SCHEMAS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(sm/def! ::operation - [:multi {:dispatch :type :title "Operation" ::smd/simplified true} - [:set - [:map {:title "SetOperation"} - [:type [:= :set]] - [:attr :keyword] - [:val :any] - [:ignore-touched {:optional true} :boolean] - [:ignore-geometry {:optional true} :boolean]]] - [:set-touched - [:map {:title "SetTouchedOperation"} - [:type [:= :set-touched]] - [:touched [:maybe [:set :keyword]]]]] - [:set-remote-synced - [:map {:title "SetRemoteSyncedOperation"} - [:type [:= :set-remote-synced]] - [:remote-synced {:optional true} [:maybe :boolean]]]]]) +(def ^:private + schema:operation + (sm/define + [:multi {:dispatch :type :title "Operation" ::smd/simplified true} + [:set + [:map {:title "SetOperation"} + [:type [:= :set]] + [:attr :keyword] + [:val :any] + [:ignore-touched {:optional true} :boolean] + [:ignore-geometry {:optional true} :boolean]]] + [:set-touched + [:map {:title "SetTouchedOperation"} + [:type [:= :set-touched]] + [:touched [:maybe [:set :keyword]]]]] + [:set-remote-synced + [:map {:title "SetRemoteSyncedOperation"} + [:type [:= :set-remote-synced]] + [:remote-synced {:optional true} [:maybe :boolean]]]]])) -(sm/def! ::change +(sm/define! ::change [:schema [:multi {:dispatch :type :title "Change" ::smd/simplified true} [:set-option @@ -79,7 +81,7 @@ [:id ::sm/uuid] [:page-id {:optional true} ::sm/uuid] [:component-id {:optional true} ::sm/uuid] - [:operations [:vector {:gen/max 5} ::operation]]]] + [:operations [:vector {:gen/max 5} schema:operation]]]] [:del-obj [:map {:title "DelObjChange"} @@ -230,14 +232,14 @@ [:type [:= :del-typography]] [:id ::sm/uuid]]]]]) -(sm/def! ::changes +(sm/define! ::changes [:sequential {:gen/max 2} ::change]) -(def valid-change? - (sm/pred-fn ::change)) +(def check-change! + (sm/check-fn ::change)) -(def valid-changes? - (sm/pred-fn [:sequential ::change])) +(def check-changes! + (sm/check-fn ::changes)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Specific helpers @@ -263,8 +265,10 @@ ;; If object has changed or is new verify is correct (when (and (some? shape-new) (not= shape-old shape-new)) - (dm/verify! (and (cts/shape? shape-new) - (cts/valid-shape? shape-new))))))] + (dm/verify! + "expected valid shape" + (and (cts/check-shape! shape-new) + (cts/shape? shape-new))))))] (->> (into #{} (map :page-id) items) (mapcat (fn [page-id] @@ -289,7 +293,9 @@ ;; When verify? false we spec the schema validation. Currently used to make just ;; 1 validation even if the changes are applied twice (when verify? - (dm/verify! (valid-changes? items))) + (dm/verify! + "expected valid changes" + (check-changes! items))) (let [result (reduce #(or (process-change %1 %2) %1) data items)] ;; Validate result shapes (only on the backend) diff --git a/common/src/app/common/files/changes_builder.cljc b/common/src/app/common/files/changes_builder.cljc index be371314a..aa6918440 100644 --- a/common/src/app/common/files/changes_builder.cljc +++ b/common/src/app/common/files/changes_builder.cljc @@ -24,8 +24,8 @@ ;; Auxiliary functions to help create a set of changes (undo + redo) -(def schema:changes - [:map +(sm/define! ::changes + [:map {:title "changes"} [:redo-changes vector?] [:undo-changes seq?] [:origin {:optional true} any?] @@ -33,8 +33,8 @@ [:stack-undo? {:optional true} boolean?] [:undo-group {:optional true} any?]]) -(def valid-changes? - (sm/pred-fn schema:changes)) +(def check-changes! + (sm/check-fn ::changes)) (defn empty-changes ([origin page-id] @@ -158,7 +158,7 @@ [changes] (dm/assert! "expected valid changes" - (valid-changes? changes)) + (check-changes! changes)) (if-let [file-data (::file-data (meta changes))] (let [index (::applied-changes-count (meta changes)) diff --git a/common/src/app/common/files/helpers.cljc b/common/src/app/common/files/helpers.cljc index 7a17b4678..6142b728d 100644 --- a/common/src/app/common/files/helpers.cljc +++ b/common/src/app/common/files/helpers.cljc @@ -417,7 +417,7 @@ [used basename] (dm/assert! "expected a set of strings" - (sm/set-of-strings? used)) + (sm/check-set-of-strings! used)) (dm/assert! "expected a string for `basename`." diff --git a/common/src/app/common/files/shapes_helpers.cljc b/common/src/app/common/files/shapes_helpers.cljc index 450668b9e..a36fadf91 100644 --- a/common/src/app/common/files/shapes_helpers.cljc +++ b/common/src/app/common/files/shapes_helpers.cljc @@ -11,14 +11,10 @@ [app.common.files.changes-builder :as pcb] [app.common.files.helpers :as cfh] [app.common.geom.shapes :as gsh] - [app.common.schema :as sm] [app.common.types.shape :as cts] [app.common.types.shape.layout :as ctl] [app.common.uuid :as uuid])) -(def valid-shape-map? - (sm/pred-fn ::cts/shape)) - (defn prepare-add-shape [changes shape objects _selected] (let [index (:index (meta shape)) diff --git a/common/src/app/common/schema.cljc b/common/src/app/common/schema.cljc index f61c58083..1f939f15e 100644 --- a/common/src/app/common/schema.cljc +++ b/common/src/app/common/schema.cljc @@ -26,17 +26,17 @@ [malli.transform :as mt] [malli.util :as mu])) -(defn validate - [s value] - (m/validate s value {:registry sr/default-registry})) +(defprotocol ISchemaOps + (-validate [_ o]) + (-explain [_ o]) + (-decode [_ o])) + +(def default-options + {:registry sr/default-registry}) (defn explain [s value] - (m/explain s value {:registry sr/default-registry})) - -(defn explain-data - [s value] - (mu/explain-data s value {:registry sr/default-registry})) + (m/explain s value default-options)) (defn schema? [o] @@ -44,7 +44,11 @@ (defn schema [s] - (m/schema s {:registry sr/default-registry})) + (m/schema s default-options)) + +(defn validate + [s value] + (m/validate s value default-options)) (defn humanize [exp] @@ -58,7 +62,7 @@ (defn form [s] - (m/form s {:registry sr/default-registry})) + (m/form s default-options)) (defn merge [& items] @@ -115,37 +119,37 @@ [s] (-> s schema m/explainer)) -(defn lazy-validator - [s] - (let [vfn (delay (validator s))] - (fn [v] (@vfn v)))) - -(defn lazy-explainer - [s] - (let [vfn (delay (explainer s))] - (fn [v] (@vfn v)))) - (defn encode ([s val transformer] - (m/encode s val {:registry sr/default-registry} transformer)) + (m/encode s val default-options transformer)) ([s val options transformer] (m/encode s val options transformer))) (defn decode ([s val transformer] - (m/decode s val {:registry sr/default-registry} transformer)) + (m/decode s val default-options transformer)) ([s val options transformer] (m/decode s val options transformer))) (defn decoder ([s transformer] - (m/decoder s {:registry sr/default-registry} transformer)) + (m/decoder s default-options transformer)) ([s options transformer] (m/decoder s options transformer))) +(defn lazy-validator + [s] + (let [vfn (delay (validator (if (delay? s) (deref s) s)))] + (fn [v] (@vfn v)))) + +(defn lazy-explainer + [s] + (let [vfn (delay (explainer (if (delay? s) (deref s) s)))] + (fn [v] (@vfn v)))) + (defn lazy-decoder [s transformer] - (let [vfn (delay (decoder s transformer))] + (let [vfn (delay (decoder (if (delay? s) (deref s) s) transformer))] (fn [v] (@vfn v)))) (defn humanize-data @@ -198,46 +202,86 @@ ([s] (lookup sr/default-registry s)) ([registry s] (schema (mr/schema registry s)))) -(defn pred-fn +(declare define) + +(defn fast-check! + "A fast path for checking process, assumes the ISchemaOps protocol + implemented on the provided `s` schema. Sould not be used directly." + [s value] + (when-not ^boolean (-validate s value) + (let [hint (d/nilv dm/*assert-context* "check error") + explain (-explain s value)] + (throw (ex-info hint {:type :assertion + :code :data-validation + :hint hint + ::explain explain})))) + true) + +(defn check-fn + "Create a predefined check function" [s] - (let [s (schema s) - v-fn (lazy-validator s) - e-fn (lazy-explainer s)] - (fn [v] - (let [result (v-fn v)] - (when (and (not result) (true? dm/*assert-context*)) - (let [hint "schema validation" - exp (e-fn v)] - (throw (ex-info hint {:type :assertion - :code :data-validation - :hint hint - ::explain exp})))) - result)))) + (let [schema (if (satisfies? ISchemaOps s) s (define s))] + (partial fast-check! schema))) + +(defn check! + "A helper intended to be used on assertions for validate/check the + schema over provided data. Raises an assertion exception, should be + used together with `dm/assert!` or `dm/verify!`." + [s value] + (if (satisfies? ISchemaOps s) + (fast-check! s value) + (do + (when-not ^boolean (m/validate s value default-options) + (let [hint (d/nilv dm/*assert-context* "check error") + explain (explain s value)] + (throw (ex-info hint {:type :assertion + :code :data-validation + :hint hint + ::explain explain})))) + true))) -(defn valid? - [s v] - (let [result (validate s v)] - (when (and (not result) (true? dm/*assert-context*)) - (let [hint "schema validation" - exp (explain s v)] - (throw (ex-info hint {:type :assertion - :code :data-validation - :hint hint - ::explain exp})))) - result)) +(defn fast-validate! + "A fast path for validation process, assumes the ISchemaOps protocol + implemented on the provided `s` schema. Sould not be used directly." + ([s value] (fast-validate! s value nil)) + ([s value options] + (when-not ^boolean (-validate s value) + (let [explain (-explain s value) + options (into {:type :validation + :code :data-validation + ::explain explain} + options) + hint (get options :hint "schema validation error")] + (throw (ex-info hint options)))))) -(defn assert-fn +(defn validate-fn + "Create a predefined validate function" [s] - (let [f (pred-fn s)] - (fn [v] - (dm/assert! (f v))))) + (let [schema (if (satisfies? ISchemaOps s) s (define s))] + (partial fast-validate! schema))) -(defmacro verify-fn - [s] - (let [f (pred-fn s)] - (fn [v] - (dm/verify! (f v))))) +(defn validate! + "A generic validation function for predefined schemas." + ([s value] (validate! s value nil)) + ([s value options] + (if (satisfies? ISchemaOps s) + (fast-validate! s value options) + (when-not ^boolean (m/validate s value default-options) + (let [explain (explain s value) + options (into {:type :validation + :code :data-validation + ::explain explain} + options) + hint (get options :hint "schema validation error")] + (throw (ex-info hint options))))))) + +(defn conform! + [schema value] + (assert (satisfies? ISchemaOps schema) "expected `schema` to satisfy ISchemaOps protocol") + (let [params (-decode schema value)] + (fast-validate! schema params nil) + params)) (defn register! [type s] (let [s (if (map? s) (simple-schema s) s)] @@ -247,6 +291,65 @@ (register! type s) nil) +(defn define! [id s] + (register! id s) + nil) + +(defn define + [s] + (let [schema (delay (schema s)) + validator (delay (validator @schema)) + explainer (delay (explainer @schema)) + decoder (delay (decoder @schema default-transformer))] + + (reify + m/AST + (-to-ast [_ options] (m/-to-ast @schema options)) + + m/EntrySchema + (-entries [_] (m/-entries @schema)) + (-entry-parser [_] (m/-entry-parser @schema)) + + m/Cached + (-cache [_] (m/-cache @schema)) + + m/LensSchema + (-keep [_] (m/-keep @schema)) + (-get [_ key default] (m/-get @schema key default)) + (-set [_ key value] (m/-set @schema key value)) + + m/Schema + (-validator [_] + (m/-validator @schema)) + (-explainer [_ path] + (m/-explainer @schema path)) + (-parser [_] + (m/-parser @schema)) + (-unparser [_] + (m/-unparser @schema)) + (-transformer [_ transformer method options] + (m/-transformer @schema transformer method options)) + (-walk [_ walker path options] + (m/-walk @schema walker path options)) + (-properties [_] + (m/-properties @schema)) + (-options [_] + (m/-options @schema)) + (-children [_] + (m/-children @schema)) + (-parent [_] + (m/-parent @schema)) + (-form [_] + (m/-form @schema)) + + ISchemaOps + (-validate [_ o] + (@validator o)) + (-explain [_ o] + (@explainer o)) + (-decode [_ o] + (@decoder o))))) + ;; --- GENERATORS ;; FIXME: replace with sg/subseq @@ -261,8 +364,8 @@ ;; --- BUILTIN SCHEMAS -(def! :merge (mu/-merge)) -(def! :union (mu/-union)) +(define! :merge (mu/-merge)) +(define! :union (mu/-union)) (def uuid-rx #"^[0-9a-f]{8}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{4}-[0-9a-f]{12}$") @@ -273,7 +376,7 @@ (some->> (re-matches uuid-rx s) uuid/uuid) s)) -(def! ::uuid +(define! ::uuid {:type ::uuid :pred uuid? :type-properties @@ -294,7 +397,7 @@ s)) ;; FIXME: add proper email generator -(def! ::email +(define! ::email {:type ::email :pred (fn [s] (and (string? s) @@ -315,7 +418,7 @@ (remove str/empty?) (remove str/blank?))) -(def! ::set-of-strings +(define! ::set-of-strings {:type ::set-of-strings :pred #(and (set? %) (every? string? %)) :type-properties @@ -331,7 +434,7 @@ (let [v (if (string? v) (str/split v #"[\s,]+") v)] (into #{} non-empty-strings-xf v)))}}) -(def! ::set-of-keywords +(define! ::set-of-keywords {:type ::set-of-keywords :pred #(and (set? %) (every? keyword? %)) :type-properties @@ -347,7 +450,7 @@ (let [v (if (string? v) (str/split v #"[\s,]+") v)] (into #{} (comp non-empty-strings-xf (map keyword)) v)))}}) -(def! ::set-of-emails +(define! ::set-of-emails {:type ::set-of-emails :pred #(and (set? %) (every? string? %)) :type-properties @@ -363,7 +466,7 @@ (let [v (if (string? v) (str/split v #"[\s,]+") v)] (into #{} (keep parse-email) v)))}}) -(def! ::set-of-uuid +(define! ::set-of-uuid {:type ::set-of-uuid :pred #(and (set? %) (every? uuid? %)) :type-properties @@ -379,7 +482,7 @@ (let [v (if (string? v) (str/split v #"[\s,]+") v)] (into #{} (keep parse-uuid) v)))}}) -(def! ::coll-of-uuid +(define! ::coll-of-uuid {:type ::set-of-uuid :pred (partial every? uuid?) :type-properties @@ -395,7 +498,7 @@ (let [v (if (string? v) (str/split v #"[\s,]+") v)] (into [] (keep parse-uuid) v)))}}) -(def! ::one-of +(define! ::one-of {:type ::one-of :min 1 :max 1 @@ -418,7 +521,7 @@ ;; Integer/MIN_VALUE (def min-safe-int -2147483648) -(def! ::safe-int +(define! ::safe-int {:type ::safe-int :pred #(and (int? %) (>= max-safe-int %) (>= % min-safe-int)) :type-properties @@ -433,7 +536,7 @@ (parse-long s) s))}}) -(def! ::safe-number +(define! ::safe-number {:type ::safe-number :pred #(and (number? %) (>= max-safe-int %) (>= % min-safe-int)) :type-properties @@ -449,7 +552,7 @@ (parse-double s) s))}}) -(def! ::safe-double +(define! ::safe-double {:type ::safe-double :pred #(and (double? %) (>= max-safe-int %) (>= % min-safe-int)) :type-properties @@ -464,7 +567,7 @@ (parse-double s) s))}}) -(def! ::contains-any +(define! ::contains-any {:type ::contains-any :min 1 :max 1 @@ -482,7 +585,7 @@ {:title "contains" :description "contains predicate"}}))}) -(def! ::inst +(define! ::inst {:type ::inst :pred inst? :type-properties @@ -493,10 +596,10 @@ ::oapi/type "number" ::oapi/format "int64"}}) -(def! ::fn +(define! ::fn [:schema fn?]) -(def! ::word-string +(define! ::word-string {:type ::word-string :pred #(and (string? %) (not (str/blank? %))) :property-pred (m/-min-max-pred count) @@ -508,7 +611,7 @@ ::oapi/type "string" ::oapi/format "string"}}) -(def! ::uri +(define! ::uri {:type ::uri :pred u/uri? :type-properties @@ -522,20 +625,20 @@ ;; ---- PREDICATES -(def safe-int? - (pred-fn ::safe-int)) +(def check-safe-int! + (check-fn ::safe-int)) -(def set-of-strings? - (pred-fn ::set-of-strings)) +(def check-set-of-strings! + (check-fn ::set-of-strings)) -(def set-of-emails? - (pred-fn ::set-of-emails)) +(def check-email! + (check-fn ::email)) -(def set-of-uuid? - (pred-fn ::set-of-uuid)) +(def check-coll-of-uuid! + (check-fn ::coll-of-uuid)) -(def coll-of-uuid? - (pred-fn ::coll-of-uuid)) +(def check-set-of-uuid! + (check-fn ::set-of-uuid)) -(def email? - (pred-fn ::email)) +(def check-set-of-emails! + (check-fn ::set-of-emails)) diff --git a/common/src/app/common/text.cljc b/common/src/app/common/text.cljc index 554a7d7c0..d95500f7d 100644 --- a/common/src/app/common/text.cljc +++ b/common/src/app/common/text.cljc @@ -59,6 +59,19 @@ item)) root))) +(defn xform-nodes + "The same as transform but instead of receiving a funcion, receives + a transducer." + [xf root] + (let [rf (fn [_ v] v)] + (walk/postwalk + (fn [item] + (let [rf (xf rf)] + (if (map? item) + (d/nilv (rf nil item) item) + item))) + root))) + (defn node-seq ([root] (node-seq identity root)) ([match? root] diff --git a/common/src/app/common/types/color.cljc b/common/src/app/common/types/color.cljc index 309d51b77..035f0dfae 100644 --- a/common/src/app/common/types/color.cljc +++ b/common/src/app/common/types/color.cljc @@ -34,7 +34,7 @@ (.. g (toString 16) (padStart 2 "0")) (.. b (toString 16) (padStart 2 "0")))))) -(sm/def! ::rgb-color +(sm/define! ::rgb-color {:type ::rgb-color :pred #(and (string? %) (some? (re-matches rgb-color-re %))) :type-properties @@ -46,7 +46,7 @@ ::oapi/type "integer" ::oapi/format "int64"}}) -(sm/def! ::image-color +(sm/define! ::image-color [:map {:title "ImageColor"} [:name {:optional true} :string] [:width :int] @@ -54,7 +54,7 @@ [:mtype {:optional true} [:maybe :string]] [:id ::sm/uuid]]) -(sm/def! ::gradient +(sm/define! ::gradient [:map {:title "Gradient"} [:type [::sm/one-of #{:linear :radial "linear" "radial"}]] [:start-x ::sm/safe-number] @@ -69,7 +69,7 @@ [:opacity {:optional true} [:maybe ::sm/safe-number]] [:offset ::sm/safe-number]]]]]) -(sm/def! ::color +(sm/define! ::color [:map {:title "Color"} [:id {:optional true} ::sm/uuid] [:name {:optional true} :string] @@ -83,7 +83,7 @@ [:gradient {:optional true} [:maybe ::gradient]] [:image {:optional true} [:maybe ::image-color]]]) -(sm/def! ::recent-color +(sm/define! ::recent-color [:and [:map {:title "RecentColor"} [:opacity {:optional true} [:maybe ::sm/safe-number]] @@ -92,11 +92,11 @@ [:image {:optional true} [:maybe ::image-color]]] [::sm/contains-any {:strict true} [:color :gradient :image]]]) -(def valid-color? - (sm/pred-fn ::color)) +(def check-color! + (sm/check-fn ::color)) -(def valid-recent-color? - (sm/pred-fn ::recent-color)) +(def check-recent-color! + (sm/check-fn ::recent-color)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; HELPERS diff --git a/common/src/app/common/types/container.cljc b/common/src/app/common/types/container.cljc index 6e08073cc..5e0bb1579 100644 --- a/common/src/app/common/types/container.cljc +++ b/common/src/app/common/types/container.cljc @@ -25,7 +25,7 @@ (def valid-container-types #{:page :component}) -(sm/def! ::container +(sm/define! ::container [:map [:id ::sm/uuid] [:type {:optional true} @@ -36,8 +36,8 @@ [:objects {:optional true} [:map-of {:gen/max 10} ::sm/uuid :map]]]) -(def container? - (sm/pred-fn ::container)) +(def check-container! + (sm/check-fn ::container)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; HELPERS @@ -71,7 +71,7 @@ (dm/assert! "expected valid container" - (container? container)) + (check-container! container)) (dm/assert! "expected valid uuid for `shape-id`" diff --git a/common/src/app/common/types/file.cljc b/common/src/app/common/types/file.cljc index 2ad7b395f..369cff4ce 100644 --- a/common/src/app/common/types/file.cljc +++ b/common/src/app/common/types/file.cljc @@ -33,7 +33,7 @@ ;; SCHEMA ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(sm/def! ::media-object +(sm/define! ::media-object [:map {:title "FileMediaObject"} [:id ::sm/uuid] [:name :string] @@ -42,7 +42,7 @@ [:mtype :string] [:path {:optional true} [:maybe :string]]]) -(sm/def! ::data +(sm/define! ::data [:map {:title "FileData"} [:pages [:vector ::sm/uuid]] [:pages-index @@ -58,11 +58,11 @@ [:media {:optional true} [:map-of {:gen/max 5} ::sm/uuid ::media-object]]]) -(def valid-file-data? - (sm/pred-fn ::data)) +(def check-file-data! + (sm/check-fn ::data)) -(def valid-media-object? - (sm/pred-fn ::media-object)) +(def check-media-object! + (sm/check-fn ::media-object)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; INITIALIZATION diff --git a/common/src/app/common/types/page.cljc b/common/src/app/common/types/page.cljc index 177198c7b..ec24c52a2 100644 --- a/common/src/app/common/types/page.cljc +++ b/common/src/app/common/types/page.cljc @@ -18,26 +18,20 @@ ;; SCHEMAS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(sm/def! ::flow +(sm/define! ::flow [:map {:title "PageFlow"} [:id ::sm/uuid] [:name :string] [:starting-frame ::sm/uuid]]) -(def flow? - (sm/pred-fn ::flow)) - -(sm/def! ::guide +(sm/define! ::guide [:map {:title "PageGuide"} [:id ::sm/uuid] [:axis [::sm/one-of #{:x :y}]] [:position ::sm/safe-number] [:frame-id {:optional true} [:maybe ::sm/uuid]]]) -(def guide? - (sm/pred-fn ::guide)) - -(sm/def! ::page +(sm/define! ::page [:map {:title "FilePage"} [:id ::sm/uuid] [:name :string] @@ -52,8 +46,11 @@ [:guides {:optional true} [:map-of {:gen/max 2} ::sm/uuid ::guide]]]]]) -(def page? - (sm/pred-fn ::page)) +(def check-page-guide! + (sm/check-fn ::guide)) + +(def check-page! + (sm/check-fn ::page)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; INIT & HELPERS diff --git a/common/src/app/common/types/shape.cljc b/common/src/app/common/types/shape.cljc index 3944f2af9..ea39f91f0 100644 --- a/common/src/app/common/types/shape.cljc +++ b/common/src/app/common/types/shape.cljc @@ -77,7 +77,7 @@ (def text-align-types #{"left" "right" "center" "justify"}) -(sm/def! ::selrect +(sm/define! ::selrect [:and {:title "Selrect" :gen/gen (->> (sg/tuple (sg/small-double) @@ -96,10 +96,10 @@ [:width ::sm/safe-number] [:height ::sm/safe-number]]]) -(sm/def! ::points +(sm/define! ::points [:vector {:gen/max 4 :gen/min 4} ::gpt/point]) -(sm/def! ::fill +(sm/define! ::fill [:map {:title "Fill"} [:fill-color {:optional true} ::ctc/rgb-color] [:fill-opacity {:optional true} ::sm/safe-number] @@ -108,7 +108,7 @@ [:fill-color-ref-id {:optional true} [:maybe ::sm/uuid]] [:fill-image {:optional true} ::ctc/image-color]]) -(sm/def! ::stroke +(sm/define! ::stroke [:map {:title "Stroke"} [:stroke-color {:optional true} :string] [:stroke-color-ref-file {:optional true} ::sm/uuid] @@ -126,7 +126,7 @@ [:stroke-color-gradient {:optional true} ::ctc/gradient] [:stroke-image {:optional true} ::ctc/image-color]]) -(sm/def! ::minimal-shape-attrs +(sm/define! ::minimal-shape-attrs [:map {:title "ShapeMinimalRecord"} [:id {:optional false} ::sm/uuid] [:name {:optional false} :string] @@ -142,7 +142,7 @@ [:parent-id {:optional false} ::sm/uuid] [:frame-id {:optional false} ::sm/uuid]]) -(sm/def! ::shape-attrs +(sm/define! ::shape-attrs [:map {:title "ShapeAttrs"} [:name {:optional true} :string] [:component-id {:optional true} ::sm/uuid] @@ -197,15 +197,12 @@ [::sm/one-of #{:auto-width :auto-height :fixed}]] ]) -(def valid-shape-attrs? - (sm/pred-fn ::shape-attrs)) - -(sm/def! ::group-attrs +(sm/define! ::group-attrs [:map {:title "GroupAttrs"} [:type [:= :group]] [:shapes {:optional true} [:maybe [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]]]) -(sm/def! ::frame-attrs +(sm/define! ::frame-attrs [:map {:title "FrameAttrs"} [:type [:= :frame]] [:shapes [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]] @@ -213,7 +210,7 @@ [:show-content {:optional true} :boolean] [:hide-in-viewer {:optional true} :boolean]]) -(sm/def! ::bool-attrs +(sm/define! ::bool-attrs [:map {:title "BoolAttrs"} [:type [:= :bool]] [:shapes {:optional true} [:maybe [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]] @@ -231,19 +228,19 @@ [:maybe [:map-of {:gen/max 5} :keyword ::sm/safe-number]]]]]]]) -(sm/def! ::rect-attrs +(sm/define! ::rect-attrs [:map {:title "RectAttrs"} [:type [:= :rect]]]) -(sm/def! ::circle-attrs +(sm/define! ::circle-attrs [:map {:title "CircleAttrs"} [:type [:= :circle]]]) -(sm/def! ::svg-raw-attrs +(sm/define! ::svg-raw-attrs [:map {:title "SvgRawAttrs"} [:type [:= :svg-raw]]]) -(sm/def! ::image-attrs +(sm/define! ::image-attrs [:map {:title "ImageAttrs"} [:type [:= :image]] [:metadata @@ -253,7 +250,7 @@ [:mtype {:optional true} [:maybe :string]] [:id ::sm/uuid]]]]) -(sm/def! ::path-attrs +(sm/define! ::path-attrs [:map {:title "PathAttrs"} [:type [:= :path]] [:x {:optional true} [:maybe ::sm/safe-number]] @@ -267,12 +264,12 @@ [:command :keyword] [:params {:optional true} [:maybe :map]]]]]]) -(sm/def! ::text-attrs +(sm/define! ::text-attrs [:map {:title "TextAttrs"} [:type [:= :text]] [:content {:optional true} [:maybe ::ctsx/content]]]) -(sm/def! ::shape-map +(sm/define! ::shape-map [:multi {:dispatch :type :title "Shape"} [:group [:merge {:title "GroupShape"} @@ -337,7 +334,7 @@ ::text-attrs ::ctsl/layout-child-attrs]]]) -(sm/def! ::shape +(sm/define! ::shape [:and {:title "Shape" :gen/gen (->> (sg/generator ::shape-map) @@ -345,13 +342,15 @@ ::shape-map [:fn shape?]]) -(def valid-shape? - (sm/pred-fn ::shape)) +(def check-shape-attrs! + (sm/check-fn ::shape-attrs)) +(def check-shape! + (sm/check-fn ::shape)) (defn has-images? [{:keys [fills strokes]}] - (or + (or (some :fill-image fills) (some :stroke-image strokes))) diff --git a/common/src/app/common/types/shape/interactions.cljc b/common/src/app/common/types/shape/interactions.cljc index 18004ddc8..99290303d 100644 --- a/common/src/app/common/types/shape/interactions.cljc +++ b/common/src/app/common/types/shape/interactions.cljc @@ -71,7 +71,7 @@ (def animation-types #{:dissolve :slide :push}) -(sm/def! ::animation +(sm/define! ::animation [:multi {:dispatch :animation-type :title "Animation"} [:dissolve [:map {:title "AnimationDisolve"} @@ -93,10 +93,10 @@ [:easing [::sm/one-of easing-types]] [:direction [::sm/one-of direction-types]]]]]) -(def animation? - (sm/pred-fn ::animation)) +(def check-animation! + (sm/check-fn ::animation)) -(sm/def! ::interaction +(sm/define! ::interaction [:multi {:dispatch :action-type} [:navigate [:map @@ -144,6 +144,9 @@ [:event-type [::sm/one-of event-types]] [:url :string]]]]) +(def check-interaction! + (sm/check-fn ::interaction)) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; HELPERS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -157,15 +160,8 @@ (def default-delay 600) - ;; -- Helpers for interaction -(def interaction? - (sm/pred-fn ::interaction)) - -;; (def destination? -;; (sm/pred-fn [:maybe ::sm/uuid])) - (declare calc-overlay-pos-initial) (declare allowed-animation?) @@ -173,7 +169,7 @@ [interaction event-type shape] (dm/assert! "Should be an interraction map" - ^boolean (interaction? interaction)) + (check-interaction! interaction)) (dm/assert! "Should be a valid event type" @@ -201,7 +197,7 @@ (dm/assert! "Should be an interraction map" - (interaction? interaction)) + (check-interaction! interaction)) (dm/assert! "Should be a valid event type" @@ -255,11 +251,11 @@ (dm/assert! "expected valid interaction map" - (interaction? interaction)) + (check-interaction! interaction)) (dm/assert! "expected valid delay" - (sm/safe-int? delay)) + (sm/check-safe-int! delay)) (dm/assert! "expected compatible interaction event type" @@ -286,7 +282,7 @@ (dm/assert! "expected valid interaction map" - (interaction? interaction)) + (check-interaction! interaction)) (dm/assert! "expected compatible interaction event type" @@ -310,7 +306,7 @@ (dm/assert! "expected valid interaction map" - (interaction? interaction)) + (check-interaction! interaction)) (dm/assert! "expected boolean for `preserve-scroll`" @@ -331,7 +327,7 @@ (dm/assert! "expected valid interaction map" - (interaction? interaction)) + (check-interaction! interaction)) (dm/assert! "expected a string for `url`" @@ -352,7 +348,7 @@ (dm/assert! "expected valid interaction map" - (interaction? interaction)) + (check-interaction! interaction)) (dm/assert! "expected valid overlay positioning type" @@ -373,7 +369,7 @@ (dm/assert! "expected valid interaction map" - (interaction? interaction)) + (check-interaction! interaction)) (dm/assert! "expected valid overlay positioning type" @@ -397,7 +393,7 @@ (dm/assert! "expected valid interaction map" - (interaction? interaction)) + (check-interaction! interaction)) (dm/assert! "expected valid overlay position" @@ -416,7 +412,7 @@ (dm/assert! "expected valid interaction map" - (interaction? interaction)) + (check-interaction! interaction)) (dm/assert! "expected boolean value for `close-click-outside`" @@ -433,7 +429,7 @@ (dm/assert! "expected valid interaction map" - (interaction? interaction)) + (check-interaction! interaction)) (dm/assert! "expected boolean value for `background-overlay`" @@ -450,7 +446,7 @@ (dm/assert! "expected valid interaction map" - (interaction? interaction)) + (check-interaction! interaction)) (dm/assert! "expected valid uuid for `position-relative-to`" @@ -489,7 +485,7 @@ ;; of that frame (dm/assert! "expected valid interaction map" - (interaction? interaction)) + (check-interaction! interaction)) (dm/assert! "expected compatible interaction map" @@ -587,7 +583,7 @@ [interaction animation-type] (dm/assert! "expected valid interaction map" - (interaction? interaction)) + (check-interaction! interaction)) (dm/assert! "expected valid value for `animation-type`" @@ -638,11 +634,11 @@ (dm/assert! "expected valid interaction map" - (interaction? interaction)) + (check-interaction! interaction)) (dm/assert! "expected valid duration" - (sm/safe-int? duration)) + (sm/check-safe-int! duration)) (dm/assert! "expected compatible interaction map" @@ -659,7 +655,7 @@ (dm/assert! "expected valid interaction map" - (interaction? interaction)) + (check-interaction! interaction)) (dm/assert! "expected valid easing" @@ -682,7 +678,7 @@ (dm/assert! "expected valid interaction map" - (interaction? interaction)) + (check-interaction! interaction)) (dm/assert! "expected valid way" @@ -703,7 +699,7 @@ (dm/assert! "expected valid interaction map" - (interaction? interaction)) + (check-interaction! interaction)) (dm/assert! "expected valid direction" @@ -720,7 +716,7 @@ (dm/assert! "expected valid animation map" (or (nil? animation) - (animation? animation))) + (check-animation! animation))) (case (:direction animation) :right @@ -745,7 +741,7 @@ (dm/assert! "expected valid interaction map" - (interaction? interaction)) + (check-interaction! interaction)) (dm/assert! "expected valid boolean for `offset-effect`" diff --git a/common/src/app/common/types/shape/layout.cljc b/common/src/app/common/types/shape/layout.cljc index 45e041a80..97d5fbd0a 100644 --- a/common/src/app/common/types/shape/layout.cljc +++ b/common/src/app/common/types/shape/layout.cljc @@ -116,7 +116,7 @@ (def grid-cell-justify-self-types #{:auto :start :center :end :stretch}) -(sm/def! ::grid-cell +(sm/define! ::grid-cell [:map {:title "GridCell"} [:id ::sm/uuid] [:area-name {:optional true} :string] @@ -130,11 +130,14 @@ [:shapes [:vector {:gen/max 1} ::sm/uuid]]]) -(sm/def! ::grid-track +(sm/define! ::grid-track [:map {:title "GridTrack"} [:type [::sm/one-of grid-track-types]] [:value {:optional true} [:maybe ::sm/safe-number]]]) +(def check-grid-track! + (sm/check-fn ::grid-track)) + ;; LAYOUT CHILDREN (def item-margin-types @@ -168,8 +171,6 @@ [:layout-item-absolute {:optional true} :boolean] [:layout-item-z-index {:optional true} ::sm/safe-number]]) -(def grid-track? (sm/pred-fn ::grid-track)) - ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; SCHEMAS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -597,7 +598,7 @@ [parent value] (dm/assert! "expected a valid grid definition for `value`" - (grid-track? value)) + (check-grid-track! value)) (let [rows (:layout-grid-rows parent) new-col-num (inc (count (:layout-grid-columns parent))) @@ -620,7 +621,7 @@ [parent value] (dm/assert! "expected a valid grid definition for `value`" - (grid-track? value)) + (check-grid-track! value)) (let [cols (:layout-grid-columns parent) new-row-num (inc (count (:layout-grid-rows parent))) diff --git a/common/src/app/common/types/typography.cljc b/common/src/app/common/types/typography.cljc index db3368173..8602f3573 100644 --- a/common/src/app/common/types/typography.cljc +++ b/common/src/app/common/types/typography.cljc @@ -29,8 +29,8 @@ [:modified-at {:optional true} ::sm/inst] [:path {:optional true} [:maybe :string]]]) -(def typography? - (sm/pred-fn ::typography)) +(def check-typography! + (sm/check-fn ::typography)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; HELPERS diff --git a/common/test/common_tests/types_test.cljc b/common/test/common_tests/types_test.cljc index c3c5508c6..d0c217c4c 100644 --- a/common/test/common_tests/types_test.cljc +++ b/common/test/common_tests/types_test.cljc @@ -25,7 +25,7 @@ (sg/check! (sg/for [fdata (sg/generator ::cts/shape)] (binding [app.common.data.macros/*assert-context* true] - (t/is (sm/valid? ::cts/shape fdata)))))) + (t/is (sm/validate ::cts/shape fdata)))))) (t/deftest types-page-spec (-> (sg/for [fdata (sg/generator ::ctp/page)] diff --git a/frontend/src/app/main/data/comments.cljs b/frontend/src/app/main/data/comments.cljs index 6c119803e..d49126157 100644 --- a/frontend/src/app/main/data/comments.cljs +++ b/frontend/src/app/main/data/comments.cljs @@ -17,38 +17,40 @@ [beicon.core :as rx] [potok.core :as ptk])) -(def schema:comment-thread - [:map {:title "CommentThread"} - [:id ::sm/uuid] - [:page-id ::sm/uuid] - [:file-id ::sm/uuid] - [:project-id ::sm/uuid] - [:owner-id ::sm/uuid] - [:page-name :string] - [:file-name :string] - [:seqn :int] - [:content :string] - [:participants ::sm/set-of-uuid] - [:created-at ::sm/inst] - [:modified-at ::sm/inst] - [:position ::gpt/point] - [:count-unread-comments {:optional true} :int] - [:count-comments {:optional true} :int]]) +(def ^:private schema:comment-thread + (sm/define + [:map {:title "CommentThread"} + [:id ::sm/uuid] + [:page-id ::sm/uuid] + [:file-id ::sm/uuid] + [:project-id ::sm/uuid] + [:owner-id ::sm/uuid] + [:page-name :string] + [:file-name :string] + [:seqn :int] + [:content :string] + [:participants ::sm/set-of-uuid] + [:created-at ::sm/inst] + [:modified-at ::sm/inst] + [:position ::gpt/point] + [:count-unread-comments {:optional true} :int] + [:count-comments {:optional true} :int]])) -(def schema:comment - [:map {:title "CommentThread"} - [:id ::sm/uuid] - [:thread-id ::sm/uuid] - [:owner-id ::sm/uuid] - [:created-at ::sm/inst] - [:modified-at ::sm/inst] - [:content :string]]) +(def ^:private schema:comment + (sm/define + [:map {:title "Comment"} + [:id ::sm/uuid] + [:thread-id ::sm/uuid] + [:owner-id ::sm/uuid] + [:created-at ::sm/inst] + [:modified-at ::sm/inst] + [:content :string]])) -(def comment-thread? - (sm/pred-fn schema:comment-thread)) +(def check-comment-thread! + (sm/check-fn schema:comment-thread)) -(def comment? - (sm/pred-fn schema:comment)) +(def check-comment! + (sm/check-fn schema:comment)) (declare create-draft-thread) (declare retrieve-comment-threads) @@ -68,16 +70,20 @@ (update-in [:comments id] assoc (:id comment) comment))))) -(def schema:create-thread-on-workspace - [:map - [:page-id ::sm/uuid] - [:file-id ::sm/uuid] - [:position ::gpt/point] - [:content :string]]) +(def ^:private + schema:create-thread-on-workspace + (sm/define + [:map {:title "created-thread-on-workspace"} + [:page-id ::sm/uuid] + [:file-id ::sm/uuid] + [:position ::gpt/point] + [:content :string]])) (defn create-thread-on-workspace [params] - (dm/assert! (sm/valid? schema:create-thread-on-workspace params)) + (dm/assert! + (sm/check! schema:create-thread-on-workspace params)) + (ptk/reify ::create-thread-on-workspace ptk/WatchEvent (watch [_ state _] @@ -107,17 +113,21 @@ (update :workspace-drawing dissoc :comment) (update-in [:comments id] assoc (:id comment) comment))))) -(def schema:create-thread-on-viewer - [:map - [:page-id ::sm/uuid] - [:file-id ::sm/uuid] - [:frame-id ::sm/uuid] - [:position ::gpt/point] - [:content :string]]) +(def ^:private + schema:create-thread-on-viewer + (sm/define + [:map {:title "created-thread-on-viewer"} + [:page-id ::sm/uuid] + [:file-id ::sm/uuid] + [:frame-id ::sm/uuid] + [:position ::gpt/point] + [:content :string]])) (defn create-thread-on-viewer [params] - (dm/assert! (sm/valid? schema:create-thread-on-viewer params)) + (dm/assert! + (sm/check! schema:create-thread-on-viewer params)) + (ptk/reify ::create-thread-on-viewer ptk/WatchEvent (watch [_ state _] @@ -146,7 +156,11 @@ (defn update-comment-thread [{:keys [id is-resolved] :as thread}] - (dm/assert! (comment-thread? thread)) + + (dm/assert! + "expected valid comment thread" + (check-comment-thread! thread)) + (ptk/reify ::update-comment-thread IDeref (-deref [_] {:is-resolved is-resolved}) @@ -168,8 +182,14 @@ (defn add-comment [thread content] - (dm/assert! (comment-thread? thread)) - (dm/assert! (string? content)) + + (dm/assert! + "expected valid comment thread" + (check-comment-thread! thread)) + + (dm/assert! + "expected valid content" + (string? content)) (letfn [(created [comment state] (update-in state [:comments (:id thread)] assoc (:id comment) comment))] @@ -189,7 +209,10 @@ (defn update-comment [{:keys [id content thread-id] :as comment}] - (dm/assert! (comment? comment)) + (dm/assert! + "expected valid comment" + (check-comment! comment)) + (ptk/reify ::update-comment ptk/UpdateEvent (update [_ state] @@ -204,7 +227,9 @@ (defn delete-comment-thread-on-workspace [{:keys [id] :as thread}] - (dm/assert! (comment-thread? thread)) + (dm/assert! + "expected valid comment thread" + (check-comment-thread! thread)) (ptk/reify ::delete-comment-thread-on-workspace ptk/UpdateEvent (update [_ state] @@ -222,7 +247,9 @@ (defn delete-comment-thread-on-viewer [{:keys [id] :as thread}] - (dm/assert! (comment-thread? thread)) + (dm/assert! + "expected valid comment thread" + (check-comment-thread! thread)) (ptk/reify ::delete-comment-thread-on-viewer ptk/UpdateEvent (update [_ state] @@ -241,7 +268,9 @@ (defn delete-comment [{:keys [id thread-id] :as comment}] - (dm/assert! (comment? comment)) + (dm/assert! + "expected valid comment" + (check-comment! comment)) (ptk/reify ::delete-comment ptk/UpdateEvent (update [_ state] @@ -256,7 +285,9 @@ (defn refresh-comment-thread [{:keys [id file-id] :as thread}] - (dm/assert! (comment-thread? thread)) + (dm/assert! + "expected valid comment thread" + (check-comment-thread! thread)) (letfn [(fetched [thread state] (assoc-in state [:comment-threads id] thread))] (ptk/reify ::refresh-comment-thread @@ -338,7 +369,9 @@ (defn open-thread [{:keys [id] :as thread}] - (dm/assert! (comment-thread? thread)) + (dm/assert! + "expected valid comment thread" + (check-comment-thread! thread)) (ptk/reify ::open-comment-thread ptk/UpdateEvent (update [_ state] @@ -379,15 +412,18 @@ (update [_ state] (update state :comments-local merge params)))) -(def schema:create-draft - [:map - [:page-id ::sm/uuid] - [:file-id ::sm/uuid] - [:position ::gpt/point]]) +(def ^:private + schema:create-draft + (sm/define + [:map {:title "create-draft"} + [:page-id ::sm/uuid] + [:file-id ::sm/uuid] + [:position ::gpt/point]])) (defn create-draft [params] - (dm/assert! (sm/valid? schema:create-draft params)) + (dm/assert! + (sm/check! schema:create-draft params)) (ptk/reify ::create-draft ptk/UpdateEvent (update [_ state] @@ -452,11 +488,14 @@ (filter #(contains? (:participants %) (:id profile)))))) (defn update-comment-thread-frame - ([thread ] + ([thread] (update-comment-thread-frame thread uuid/zero)) ([thread frame-id] - (dm/assert! (comment-thread? thread)) + (dm/assert! + "expected valid comment thread" + (check-comment-thread! thread)) + (ptk/reify ::update-comment-thread-frame ptk/UpdateEvent (update [_ state] @@ -473,7 +512,10 @@ (defn detach-comment-thread "Detach comment threads that are inside a frame when that frame is deleted" [ids] - (dm/assert! (sm/coll-of-uuid? ids)) + (dm/assert! + "expected a valid coll of uuid's" + (sm/check-coll-of-uuid! ids)) + (ptk/reify ::detach-comment-thread ptk/WatchEvent (watch [_ state _] diff --git a/frontend/src/app/main/data/dashboard.cljs b/frontend/src/app/main/data/dashboard.cljs index 2fcb68524..0e39ddff9 100644 --- a/frontend/src/app/main/data/dashboard.cljs +++ b/frontend/src/app/main/data/dashboard.cljs @@ -468,7 +468,10 @@ [{:keys [emails role team-id resend?] :as params}] (dm/assert! (keyword? role)) (dm/assert! (uuid? team-id)) - (dm/assert! (sm/set-of-emails? emails)) + + (dm/assert! + "expected a valid set of emails" + (sm/check-set-of-emails! emails)) (ptk/reify ::invite-team-members IDeref @@ -487,7 +490,10 @@ (defn copy-invitation-link [{:keys [email team-id] :as params}] - (dm/assert! (sm/email? email)) + (dm/assert! + "expected a valid email" + (sm/check-email! email)) + (dm/assert! (uuid? team-id)) (ptk/reify ::copy-invitation-link @@ -515,7 +521,10 @@ (defn update-team-invitation-role [{:keys [email team-id role] :as params}] - (dm/assert! (sm/email? email)) + (dm/assert! + "expected a valid email" + (sm/check-email! email)) + (dm/assert! (uuid? team-id)) (dm/assert! (keyword? role)) ;; FIXME validate role @@ -534,7 +543,7 @@ (defn delete-team-invitation [{:keys [email team-id] :as params}] - (dm/assert! (sm/email? email)) + (dm/assert! (sm/check-email! email)) (dm/assert! (uuid? team-id)) (ptk/reify ::delete-team-invitation ptk/WatchEvent @@ -891,9 +900,12 @@ (defn move-files [{:keys [ids project-id] :as params}] - (dm/assert! (sm/set-of-uuid? ids)) (dm/assert! (uuid? project-id)) + (dm/assert! + "expected a valid set of uuids" + (sm/check-set-of-uuid! ids)) + (ptk/reify ::move-files IDeref (-deref [_] diff --git a/frontend/src/app/main/data/messages.cljs b/frontend/src/app/main/data/messages.cljs index 5730d5502..d792b7b17 100644 --- a/frontend/src/app/main/data/messages.cljs +++ b/frontend/src/app/main/data/messages.cljs @@ -18,38 +18,37 @@ (def default-animation-timeout 600) (def default-timeout 5000) -(def schema:message - [:map {:title "Message"} - [:type [::sm/one-of #{:success :error :info :warning}]] - [:status {:optional true} - [::sm/one-of #{:visible :hide}]] - [:position {:optional true} - [::sm/one-of #{:fixed :floating :inline}]] - [:controls {:optional true} - [::sm/one-of #{:none :close :inline-actions :bottom-actions}]] - [:tag {:optional true} - [:or :string :keyword]] - [:timeout {:optional true} - [:maybe :int]] - [:actions {:optional true} - [:vector - [:map - [:label :string] - [:callback ::sm/fn]]]] - [:links {:optional true} - [:vector - [:map - [:label :string] - [:callback ::sm/fn]]]]]) - -(def message? - (sm/pred-fn schema:message)) +(def ^:private + schema:message + (sm/define + [:map {:title "Message"} + [:type [::sm/one-of #{:success :error :info :warning}]] + [:status {:optional true} + [::sm/one-of #{:visible :hide}]] + [:position {:optional true} + [::sm/one-of #{:fixed :floating :inline}]] + [:controls {:optional true} + [::sm/one-of #{:none :close :inline-actions :bottom-actions}]] + [:tag {:optional true} + [:or :string :keyword]] + [:timeout {:optional true} + [:maybe :int]] + [:actions {:optional true} + [:vector + [:map + [:label :string] + [:callback ::sm/fn]]]] + [:links {:optional true} + [:vector + [:map + [:label :string] + [:callback ::sm/fn]]]]])) (defn show [data] (dm/assert! "expected valid message map" - (message? data)) + (sm/check! schema:message data)) (ptk/reify ::show ptk/UpdateEvent diff --git a/frontend/src/app/main/data/shortcuts.cljs b/frontend/src/app/main/data/shortcuts.cljs index f5cef666b..4e679c37b 100644 --- a/frontend/src/app/main/data/shortcuts.cljs +++ b/frontend/src/app/main/data/shortcuts.cljs @@ -127,16 +127,17 @@ ;; --- EVENT: push -(def schema:shortcuts - [:map-of - :keyword - [:map - [:command [:or :string [:vector :any]]] - [:fn {:optional true} fn?] - [:tooltip {:optional true} :string]]]) +(def ^:private + schema:shortcuts + (sm/define + [:map-of :keyword + [:map + [:command [:or :string [:vector :any]]] + [:fn {:optional true} fn?] + [:tooltip {:optional true} :string]]])) -(def shortcuts? - (sm/pred-fn schema:shortcuts)) +(def check-shortcuts! + (sm/check-fn schema:shortcuts)) (defn- wrap-cb [key cb] @@ -169,8 +170,11 @@ (defn push-shortcuts [key shortcuts] - (dm/assert! (keyword? key)) - (dm/assert! (shortcuts? shortcuts)) + + (dm/assert! + "expected valid parameters" + (and (keyword? key) + (check-shortcuts! shortcuts))) (ptk/reify ::push-shortcuts ptk/UpdateEvent diff --git a/frontend/src/app/main/data/users.cljs b/frontend/src/app/main/data/users.cljs index f0b7b337a..2d085c8ed 100644 --- a/frontend/src/app/main/data/users.cljs +++ b/frontend/src/app/main/data/users.cljs @@ -26,17 +26,19 @@ ;; --- SCHEMAS -(def schema:profile - [:map {:title "Profile"} - [:id ::sm/uuid] - [:created-at {:optional true} :any] - [:fullname {:optional true} :string] - [:email {:optional true} :string] - [:lang {:optional true} :string] - [:theme {:optional true} :string]]) +(def ^:private + schema:profile + (sm/define + [:map {:title "Profile"} + [:id ::sm/uuid] + [:created-at {:optional true} :any] + [:fullname {:optional true} :string] + [:email {:optional true} :string] + [:lang {:optional true} :string] + [:theme {:optional true} :string]])) -(def profile? - (sm/pred-fn schema:profile)) +(def check-profile! + (sm/check-fn schema:profile)) ;; --- HELPERS @@ -289,7 +291,10 @@ (defn update-profile [data] - (dm/assert! (profile? data)) + (dm/assert! + "expected valid profile data" + (check-profile! data)) + (ptk/reify ::update-profile ptk/WatchEvent (watch [_ _ stream] @@ -343,9 +348,13 @@ ;; Social registered users don't have old-password [:password-old {:optional true} [:maybe :string]]]) + (defn update-password [data] - (dm/assert! (sm/valid? schema:update-password data)) + (dm/assert! + "expected valid parameters" + (sm/check! schema:update-password data)) + (ptk/reify ::update-password ptk/WatchEvent (watch [_ _ _] @@ -475,14 +484,19 @@ ;; --- EVENT: request-profile-recovery -(def schema:request-profile-recovery - [:map {:closed true} - [:email ::sm/email]]) +(def ^:private + schema:request-profile-recovery + (sm/define + [:map {:title "request-profile-recovery" :closed true} + [:email ::sm/email]])) -;; FIXME: check if we can use schema for proper filter (defn request-profile-recovery [data] - (dm/assert! (sm/valid? schema:request-profile-recovery data)) + + (dm/assert! + "expected valid parameters" + (sm/check! schema:request-profile-recovery data)) + (ptk/reify ::request-profile-recovery ptk/WatchEvent (watch [_ _ _] @@ -496,14 +510,19 @@ ;; --- EVENT: recover-profile (Password) -(def schema:recover-profile - [:map {:closed true} - [:password :string] - [:token :string]]) +(def ^:private + schema:recover-profile + (sm/define + [:map {:title "recover-profile" :closed true} + [:password :string] + [:token :string]])) (defn recover-profile [data] - (dm/assert! (sm/valid? schema:recover-profile data)) + (dm/assert! + "expected valid arguments" + (sm/check! schema:recover-profile data)) + (ptk/reify ::recover-profile ptk/WatchEvent (watch [_ _ _] diff --git a/frontend/src/app/main/data/viewer.cljs b/frontend/src/app/main/data/viewer.cljs index 07fe52cc0..997ee9607 100644 --- a/frontend/src/app/main/data/viewer.cljs +++ b/frontend/src/app/main/data/viewer.cljs @@ -46,15 +46,20 @@ (declare zoom-to-fill) (declare zoom-to-fit) -(def schema:initialize - [:map - [:file-id ::sm/uuid] - [:share-id {:optional true} [:maybe ::sm/uuid]] - [:page-id {:optional true} ::sm/uuid]]) +(def ^:private + schema:initialize + (sm/define + [:map {:title "initialize"} + [:file-id ::sm/uuid] + [:share-id {:optional true} [:maybe ::sm/uuid]] + [:page-id {:optional true} ::sm/uuid]])) (defn initialize [{:keys [file-id share-id interactions-show?] :as params}] - (dm/assert! (sm/valid? schema:initialize params)) + (dm/assert! + "expected valid params" + (sm/check! schema:initialize params)) + (ptk/reify ::initialize ptk/UpdateEvent (update [_ state] @@ -92,18 +97,20 @@ ;; --- Data Fetching -(def schema:fetch-bundle - [:map - [:page-id ::sm/uuid] - [:file-id ::sm/uuid] - [:share-id {:optional true} ::sm/uuid]]) - -(def ^:private valid-fetch-bundle-params? - (sm/pred-fn schema:fetch-bundle)) +(def ^:private + schema:fetch-bundle + (sm/define + [:map {:title "fetch-bundle"} + [:page-id ::sm/uuid] + [:file-id ::sm/uuid] + [:share-id {:optional true} ::sm/uuid]])) (defn- fetch-bundle [{:keys [file-id share-id] :as params}] - (dm/assert! (valid-fetch-bundle-params? params)) + + (dm/assert! + "expected valid params" + (sm/check! schema:fetch-bundle params)) (ptk/reify ::fetch-bundle ptk/WatchEvent @@ -486,9 +493,11 @@ (go-to-frame frame-id nil)) ([frame-id animation] - (dm/assert! (uuid? frame-id)) - (dm/assert! (or (nil? animation) - (ctsi/animation? animation))) + (dm/assert! + "expected valid parameters" + (and (uuid? frame-id) + (or (nil? animation) + (ctsi/check-animation! animation)))) (ptk/reify ::go-to-frame ptk/UpdateEvent @@ -587,7 +596,7 @@ (dm/assert! (or (nil? background-overlay) (boolean? background-overlay))) (dm/assert! (or (nil? animation) - (ctsi/animation? animation))) + (ctsi/check-animation! animation))) (ptk/reify ::open-overlay ptk/UpdateEvent (update [_ state] @@ -617,7 +626,7 @@ (dm/assert! (or (nil? background-overlay) (boolean? background-overlay))) (dm/assert! (or (nil? animation) - (ctsi/animation? animation))) + (ctsi/check-animation! animation))) (ptk/reify ::toggle-overlay ptk/UpdateEvent @@ -645,7 +654,7 @@ ([frame-id animation] (dm/assert! (uuid? frame-id)) (dm/assert! (or (nil? animation) - (ctsi/animation? animation))) + (ctsi/check-animation! animation))) (ptk/reify ::close-overlay ptk/UpdateEvent diff --git a/frontend/src/app/main/data/workspace.cljs b/frontend/src/app/main/data/workspace.cljs index dada4f7a7..1d3eb97f1 100644 --- a/frontend/src/app/main/data/workspace.cljs +++ b/frontend/src/app/main/data/workspace.cljs @@ -9,6 +9,8 @@ [app.common.attrs :as attrs] [app.common.data :as d] [app.common.data.macros :as dm] + [app.common.exceptions :as ex] + [app.common.features :as cfeat] [app.common.files.changes-builder :as pcb] [app.common.files.helpers :as cfh] [app.common.geom.align :as gal] @@ -17,6 +19,7 @@ [app.common.geom.rect :as grc] [app.common.geom.shapes :as gsh] [app.common.geom.shapes.grid-layout :as gslg] + [app.common.schema :as sm] [app.common.text :as txt] [app.common.transit :as t] [app.common.types.component :as ctk] @@ -77,6 +80,7 @@ [app.util.webapi :as wapi] [beicon.core :as rx] [cljs.spec.alpha :as s] + [clojure.set :as set] [cuerdas.core :as str] [potok.core :as ptk])) @@ -669,8 +673,11 @@ (defn update-shape [id attrs] - (dm/assert! (uuid? id)) - (dm/assert! (cts/valid-shape-attrs? attrs)) + (dm/assert! + "expected valid parameters" + (and (cts/check-shape-attrs! attrs) + (uuid? id))) + (ptk/reify ::update-shape ptk/WatchEvent (watch [_ _ _] @@ -712,7 +719,10 @@ (defn update-selected-shapes [attrs] - (dm/assert! (cts/valid-shape-attrs? attrs)) + (dm/assert! + "expected valid shape attrs" + (cts/check-shape-attrs! attrs)) + (ptk/reify ::update-selected-shapes ptk/WatchEvent (watch [_ state _] @@ -1525,60 +1535,47 @@ (assoc data :selected selected))) - ;; Retrieve all ids of selected shapes with corresponding - ;; children; this is needed because each shape should be - ;; processed one by one because of async events (data url - ;; fetching). - (collect-object-ids [objects res id] - (let [obj (get objects id)] - (reduce (partial collect-object-ids objects) - (assoc res id obj) - (:shapes obj)))) + (fetch-image [entry] + (let [url (cf/resolve-file-media entry)] + (->> (http/send! {:method :get + :uri url + :response-type :blob}) + (rx/map :body) + (rx/mapcat wapi/read-file-as-data-url) + (rx/map #(assoc entry :data %))))) ;; Prepare the shape object. Mainly needed for image shapes ;; for retrieve the image data and convert it to the ;; data-url. - (prepare-object [objects parent-frame-id {:keys [type] :as obj}] - (let [obj (maybe-translate obj objects parent-frame-id) + (prepare-object [objects parent-frame-id obj] + (let [obj (maybe-translate obj objects parent-frame-id) ;; Texts can have different fills for pieces of the text - fill-images-data (->> (or (:position-data obj) [obj]) - (map :fills) - (reduce into []) - (filter :fill-image) - (map :fill-image)) + imgdata (concat + (->> (or (:position-data obj) [obj]) + (mapcat :fills) + (keep :fill-image)) + (->> (:strokes obj) + (keep :stroke-image)) + (when (cfh/image-shape? obj) + [(:metadata obj)]))] - stroke-images-data (->> (:strokes obj) - (filter :stroke-image) - (map :stroke-image)) - images-data (concat - fill-images-data - stroke-images-data - (when (= type :image) - [(:metadata obj)]))] - - (if (> (count images-data) 0) - (->> (rx/from images-data) - (rx/mapcat (fn [image-data] - (let [url (cf/resolve-file-media image-data)] - (->> (http/send! {:method :get - :uri url - :response-type :blob}) - (rx/map :body) - (rx/mapcat wapi/read-file-as-data-url) - (rx/map #(assoc image-data :data %)))))) + (if (seq imgdata) + (->> (rx/from imgdata) + (rx/mapcat fetch-image) (rx/reduce conj []) - (rx/map - (fn [images] - (assoc obj ::data images)))) + (rx/map (fn [images] + (assoc obj ::images images)))) (rx/of obj)))) ;; Collects all the items together and split images into a ;; separated data structure for a more easy paste process. - (collect-data [res {:keys [id] :as item}] - (let [res (update res :objects assoc id (dissoc item ::data))] - (if (::data item) - (update res :images into (::data item)) - res))) + (collect-data [result {:keys [id ::images] :as item}] + (cond-> result + :always + (update :objects assoc id (dissoc item ::images)) + + (some? images) + (update :images into images))) (maybe-translate [shape objects parent-frame-id] (if (= parent-frame-id uuid/zero) @@ -1587,122 +1584,128 @@ (gsh/translate-to-frame shape frame)))) (on-copy-error [error] - (js/console.error "Clipboard blocked:" error) + (js/console.error "clipboard blocked:" error) (rx/empty))] (ptk/reify ::copy-selected ptk/WatchEvent (watch [_ state _] - (let [objects (wsh/lookup-page-objects state) - selected (->> (wsh/lookup-selected state) - (cfh/clean-loops objects)) - - parent-frame-id (cfh/common-parent-frame objects selected) - pdata (reduce (partial collect-object-ids objects) {} selected) - initial {:type :copied-shapes - :file-id (:current-file-id state) - :selected selected - :objects {} - :images #{}} - selected_text (.. js/window getSelection toString)] - - (if (not-empty selected_text) + (let [text (wapi/get-current-selected-text)] + (if-not (str/empty? text) (try - (wapi/write-to-clipboard selected_text) + (wapi/write-to-clipboard text) (catch :default e (on-copy-error e))) - (->> (rx/from (seq (vals pdata))) - (rx/merge-map (partial prepare-object objects parent-frame-id)) - (rx/reduce collect-data initial) - (rx/map (partial sort-selected state)) - (rx/map t/encode-str) - (rx/map wapi/write-to-clipboard) - (rx/catch on-copy-error) - (rx/ignore)))))))) -(declare paste-shape) -(declare paste-text) -(declare paste-image) -(declare paste-svg) + (let [objects (wsh/lookup-page-objects state) + selected (->> (wsh/lookup-selected state) + (cfh/clean-loops objects)) + features (features/get-team-enabled-features state) -(def paste - (ptk/reify ::paste - ptk/WatchEvent - (watch [_ _ _] - (try - (let [clipboard-str (wapi/read-from-clipboard) + file-id (:current-file-id state) + frame-id (cfh/common-parent-frame objects selected) + version (dm/get-in state [:workspace-data :version]) - paste-transit-str - (->> clipboard-str - (rx/filter t/transit?) - (rx/map t/decode-str) - (rx/filter #(= :copied-shapes (:type %))) - (rx/map #(select-keys % [:selected :objects])) - (rx/map paste-shape)) + initial {:type :copied-shapes + :features features + :version version + :file-id file-id + :selected selected + :objects {} + :images #{}} - paste-plain-text-str - (->> clipboard-str - (rx/filter (comp not empty?)) - (rx/map paste-text)) + shapes (->> (cfh/selected-with-children objects selected) + (keep (d/getf objects)))] - paste-image-str + (->> (rx/from shapes) + (rx/merge-map (partial prepare-object objects frame-id)) + (rx/reduce collect-data initial) + (rx/map (partial sort-selected state)) + (rx/map #(t/encode-str % {:type :json-verbose})) + (rx/map wapi/write-to-clipboard) + (rx/catch on-copy-error) + (rx/ignore))))))))) + +(declare ^:private paste-transit) +(declare ^:private paste-text) +(declare ^:private paste-image) +(declare ^:private paste-svg-text) +(declare ^:private paste-shapes) + +(defn paste-from-clipboard + "Perform a `paste` operation using the Clipboard API." + [] + (letfn [(decode-entry [entry] + (try + [:transit (t/decode-str entry)] + (catch :default _cause + [:text entry]))) + + (process-entry [[type data]] + (case type + :text + (if (str/empty? data) + (rx/empty) + (rx/of (paste-text data))) + + :transit + (rx/of (paste-transit data)))) + + (on-error [cause] + (let [data (ex-data cause)] + (if (:not-implemented data) + (rx/of (msg/warn (tr "errors.clipboard-not-implemented"))) + (js/console.error "Clipboard error:" cause)) + (rx/empty)))] + + (ptk/reify ::paste-from-clipboard + ptk/WatchEvent + (watch [_ _ _] + (->> (rx/concat + (->> (wapi/read-from-clipboard) + (rx/map decode-entry) + (rx/mapcat process-entry)) (->> (wapi/read-image-from-clipboard) - (rx/map paste-image))] + (rx/map paste-image))) + (rx/take 1) + (rx/catch on-error)))))) - (->> (rx/concat paste-transit-str - paste-plain-text-str - paste-image-str) - (rx/take 1) - (rx/catch - (fn [err] - (js/console.error "Clipboard error:" err) - (rx/empty))))) - (catch :default e - (let [data (ex-data e)] - (if (:not-implemented data) - (rx/of (msg/warn (tr "errors.clipboard-not-implemented"))) - (js/console.error "ERROR" e)))))))) (defn paste-from-event + "Perform a `paste` operation from user emmited event." [event in-viewport?] (ptk/reify ::paste-from-event ptk/WatchEvent (watch [_ state _] - (try - (let [objects (wsh/lookup-page-objects state) - paste-data (wapi/read-from-paste-event event) - image-data (wapi/extract-images paste-data) - text-data (wapi/extract-text paste-data) - decoded-data (and (t/transit? text-data) - (t/decode-str text-data)) + (let [objects (wsh/lookup-page-objects state) + edit-id (dm/get-in state [:workspace-local :edition]) + is-editing? (and edit-id (= :text (get-in objects [edit-id :type])))] - edit-id (get-in state [:workspace-local :edition]) - is-editing-text? (and edit-id (= :text (get-in objects [edit-id :type])))] - - ;; Some paste events can be fired while we're editing a text - ;; we forbid that scenario so the default behaviour is executed - (when-not is-editing-text? + ;; Some paste events can be fired while we're editing a text + ;; we forbid that scenario so the default behaviour is executed + (if is-editing? + (rx/empty) + (let [pdata (wapi/read-from-paste-event event) + image-data (some-> pdata wapi/extract-images) + text-data (some-> pdata wapi/extract-text) + transit-data (ex/ignoring (some-> text-data t/decode-str))] (cond (and (string? text-data) - (str/includes? text-data "> (rx/from image-data) + (rx/map paste-image)) - (coll? decoded-data) - (->> (rx/of decoded-data) - (rx/filter #(= :copied-shapes (:type %))) - (rx/map #(paste-shape % in-viewport?))) + (coll? transit-data) + (rx/of (paste-transit (assoc transit-data :in-viewport in-viewport?))) (string? text-data) (rx/of (paste-text text-data)) :else - (rx/empty)))) - - (catch :default err - (js/console.error "Clipboard error:" err)))))) + (rx/empty)))))))) (defn selected-frame? [state] (let [selected (wsh/lookup-selected state) @@ -1731,15 +1734,63 @@ (= (:width (:selrect (first (vals paste-obj)))) (:width (:selrect frame-obj))))) -(defn- paste-shape - [{selected :selected - paste-objects :objects ;; rename this because here comes only the clipboard shapes, - images :images ;; not the whole page tree of shapes. - :as data} - in-viewport?] - (letfn [;; Given a file-id and img (part generated by the - ;; copy-selected event), uploads the new media. - (upload-media [file-id imgpart] +(defn- check-paste-features! + "Function used for check feature compability between currently + enabled features set on the application with the provided featured + set by the paste data." + [enabled-features paste-features] + (let [not-supported (-> enabled-features + (set/difference paste-features) + ;; NOTE: we don't want to raise a feature-mismatch + ;; exception for features which don't require an + ;; explicit file migration process or has no real + ;; effect on file data structure + (set/difference cfeat/no-migration-features))] + + (when (seq not-supported) + (ex/raise :type :restriction + :code :missing-features-in-paste-content + :feature (first not-supported) + :hint (str/ffmt "expected features '%' not present in pasted content" + (str/join "," not-supported))))) + + (let [not-supported (set/difference enabled-features cfeat/supported-features)] + (when (seq not-supported) + (ex/raise :type :restriction + :code :paste-feature-not-supported + :feature (first not-supported) + :hint (str/ffmt "features '%' not supported in the application" + (str/join "," not-supported))))) + + (let [not-supported (-> paste-features + (set/difference enabled-features) + (set/difference cfeat/backend-only-features) + (set/difference cfeat/frontend-only-features))] + + (when (seq not-supported) + (ex/raise :type :restriction + :code :paste-feature-not-enabled + :feature (first not-supported) + :hint (str/ffmt "paste features '%' not enabled on the application" + (str/join "," not-supported)))))) + +(def ^:private schema:paste-data + (sm/define + [:map {:title "paste-data"} + [:type [:= :copied-shapes]] + [:features ::sm/set-of-strings] + [:version :int] + [:file-id ::sm/uuid] + [:selected ::sm/set-of-uuid] + [:objects + [:map-of ::sm/uuid :map]] + [:images [:set :map]] + [:position {:optional true} ::gpt/point]])) + +(defn- paste-transit + [{:keys [images] :as pdata}] + + (letfn [(upload-media [file-id imgpart] (->> (http/send! {:uri (:data imgpart) :response-type :blob :method :get}) @@ -1750,51 +1801,70 @@ :file-id file-id :content blob :is-local true})) - (rx/mapcat #(rp/cmd! :upload-file-media-object %)) - (rx/map (fn [media] - (assoc media :prev-id (:id imgpart)))))) + (rx/mapcat (partial rp/cmd! :upload-file-media-object)) + (rx/map #(assoc % :prev-id (:id imgpart)))))] - (translate-staled-media [mdata attribute media-idx] - (let [id (get-in mdata [attribute :id]) + (ptk/reify ::paste-transit + ptk/WatchEvent + (watch [_ state _] + (let [file-id (:current-file-id state) + features (features/get-team-enabled-features state)] + + (sm/validate! schema:paste-data pdata + {:hint "invalid paste data" + :code :invalid-paste-data}) + + (check-paste-features! features (:features pdata)) + (if (= file-id (:file-id pdata)) + (let [pdata (assoc pdata :images [])] + (rx/of (paste-shapes pdata))) + (->> (rx/from images) + (rx/merge-map (partial upload-media file-id)) + (rx/reduce conj []) + (rx/map #(assoc pdata :images %)) + (rx/map paste-shapes)))))))) + +(defn paste-shapes + [{in-viewport? :in-viewport :as pdata}] + (letfn [(translate-media [mdata media-idx attr-path] + (let [id (get-in mdata attr-path) mobj (get media-idx id)] (if mobj - (update mdata attribute #(assoc % - :id (:id mobj) - :path (:path mobj))) + (update-in mdata attr-path (fn [value] + (-> value + (assoc :id (:id mobj)) + (assoc :path (:path mobj))))) mdata))) + (add-obj? [chg] + (= (:type chg) :add-obj)) + ;; Analyze the rchange and replace staled media and ;; references to the new uploaded media-objects. - (process-rchange [media-idx item] + (process-rchange [media-idx change] (let [;; Texts can have different fills for pieces of the text - obj (:obj item) - fills (mapv #(translate-staled-media % :fill-image media-idx) (:fills obj)) - strokes (mapv #(translate-staled-media % :stroke-image media-idx) (:strokes obj)) - position-data (->> (:position-data obj) - (mapv (fn [p-data] - (let [fills (mapv #(translate-staled-media % :fill-image media-idx) (:fills p-data))] - (assoc p-data :fills fills))))) - content (txt/transform-nodes #(translate-staled-media % :fill-image media-idx) (:content obj))] + tr-fill-xf (map #(translate-media % media-idx [:fill-image :id])) + tr-stroke-xf (map #(translate-media % media-idx [:stroke-image :id]))] - (if (= (:type item) :add-obj) - (-> item - (update-in [:obj :metadata] - (fn [{:keys [id] :as mdata}] - (if-let [mobj (get media-idx id)] - (assoc mdata - :id (:id mobj) - :path (:path mobj)) - mdata))) - (assoc-in [:obj :fills] fills) - (assoc-in [:obj :strokes] strokes) - (assoc-in [:obj :content] content) - (cond-> - (> (count position-data) 0) (assoc-in [:obj :position-data] position-data))) - item))) + (if (add-obj? change) + (update change :obj (fn [obj] + (-> obj + (update :fills #(into [] tr-fill-xf %)) + (update :strokes #(into [] tr-stroke-xf %)) + (d/update-when :metadata translate-media media-idx [:id]) + (d/update-when :content + (fn [content] + (txt/xform-nodes tr-fill-xf content))) + (d/update-when :position-data + (fn [position-data] + (mapv (fn [pos-data] + (update pos-data :fills #(into [] tr-fill-xf %))) + position-data)))))) + change))) - (calculate-paste-position [state mouse-pos in-viewport?] + (calculate-paste-position [state pobjects selected position] (let [page-objects (wsh/lookup-page-objects state) - selected-objs (map #(get paste-objects %) selected) + selected-objs (map (d/getf pobjects) selected) first-selected-obj (first selected-objs) page-selected (wsh/lookup-selected state) wrapper (gsh/shapes->rect selected-objs) @@ -1803,12 +1873,12 @@ frame-object (get page-objects frame-id) base (cfh/get-base-shape page-objects page-selected) index (cfh/get-position-on-parent page-objects (:id base)) - tree-root (get-tree-root-shapes paste-objects) + tree-root (get-tree-root-shapes pobjects) only-one-root-shape? (and - (< 1 (count paste-objects)) + (< 1 (count pobjects)) (= 1 (count tree-root))) - all-objects (merge page-objects paste-objects) - comps-nesting-loop? (not (->> (keys paste-objects) + all-objects (merge page-objects pobjects) + comps-nesting-loop? (not (->> (keys pobjects) (map #(cfh/components-nesting-loop? all-objects % (:id base))) (every? nil?)))] @@ -1816,13 +1886,13 @@ comps-nesting-loop? ;; Avoid placing a shape as a direct or indirect child of itself, ;; or inside its main component if it's in a copy. - [uuid/zero uuid/zero (gpt/subtract mouse-pos orig-pos)] + [uuid/zero uuid/zero (gpt/subtract position orig-pos)] (selected-frame? state) - (if (or (any-same-frame-from-selected? state (keys paste-objects)) + (if (or (any-same-frame-from-selected? state (keys pobjects)) (and only-one-root-shape? - (frame-same-size? paste-objects (first tree-root)))) + (frame-same-size? pobjects (first tree-root)))) ;; Paste next to selected frame, if selected is itself or of the same size as the copied (let [selected-frame-obj (get page-objects (first page-selected)) parent-id (:parent-id base) @@ -1866,114 +1936,119 @@ [frame-id frame-id delta (dec (count (:shapes selected-frame-obj )))])) (empty? page-selected) - (let [frame-id (ctst/top-nested-frame page-objects mouse-pos) - delta (gpt/subtract mouse-pos orig-pos)] + (let [frame-id (ctst/top-nested-frame page-objects position) + delta (gpt/subtract position orig-pos)] [frame-id frame-id delta]) :else (let [frame-id (:frame-id base) parent-id (:parent-id base) delta (if in-viewport? - (gpt/subtract mouse-pos orig-pos) + (gpt/subtract position orig-pos) (gpt/subtract (gpt/point (:selrect base)) orig-pos))] [frame-id parent-id delta index])))) ;; Change the indexes of the pasted shapes - (change-add-obj-index [paste-objects selected index change] - (let [index (or index -1) ;; if there is no current element selected, we want the first (inc index) to be 0 + (change-add-obj-index [objects selected index change] + (let [;; if there is no current element selected, we want + ;; the first (inc index) to be 0 + index (d/nilv index -1) set-index (fn [[result index] id] [(assoc result id index) (inc index)]) + ;; FIXME: optimize ??? map-ids (->> selected - (map #(get-in paste-objects [% :id])) + (map #(get-in objects [% :id])) (reduce set-index [{} (inc index)]) first)] - (if (and (= :add-obj (:type change)) + + (if (and (add-obj? change) (contains? map-ids (:old-id change))) (assoc change :index (get map-ids (:old-id change))) change))) - ;; Proceed with the standard shape paste process. - (do-paste [it state mouse-pos media] - (let [libraries (wsh/get-libraries state) - file-id (:current-file-id state) - page (wsh/lookup-page state) - page-objects (:objects page) - media-idx (d/index-by :prev-id media) + (process-shape [file-id frame-id parent-id shape] + (cond-> shape + :always + (assoc :frame-id frame-id :parent-id parent-id) - ;; Calculate position for the pasted elements - [frame-id parent-id delta index] (calculate-paste-position state mouse-pos in-viewport?) + (and (or (cfh/group-shape? shape) + (cfh/bool-shape? shape)) + (nil? (:shapes shape))) + (assoc :shapes []) - ;; We don't want to change the structure of component copies - ;; If the parent-id or the frame-id are component-copies, we need to get the first not copy parent - parent-id (:id (ctn/get-first-not-copy-parent page-objects parent-id)) - frame-id (:id (ctn/get-first-not-copy-parent page-objects frame-id)) + (cfh/text-shape? shape) + (ctt/remove-external-typographies file-id)))] - process-shape - (fn [_ shape] - (let [assign-shapes? (and (or (cfh/group-shape? shape) - (cfh/bool-shape? shape)) - (nil? (:shapes shape)))] - (-> shape - (assoc :frame-id frame-id :parent-id parent-id) - (cond-> assign-shapes? - (assoc :shapes [])) - ;; if is a text, remove references to external typographies - (cond-> (= (:type shape) :text) - (ctt/remove-external-typographies file-id))))) - - paste-objects (->> paste-objects (d/mapm process-shape)) - - all-objects (merge (:objects page) paste-objects) - - library-data (wsh/get-file state file-id) - - changes (-> (dws/prepare-duplicate-changes all-objects page selected delta it libraries library-data file-id) - (pcb/amend-changes (partial process-rchange media-idx)) - (pcb/amend-changes (partial change-add-obj-index paste-objects selected index))) - - ;; Adds a resize-parents operation so the groups are updated. We add all the new objects - new-objects-ids (->> changes :redo-changes (filter #(= (:type %) :add-obj)) (mapv :id)) - - drop-cell - (when (ctl/grid-layout? all-objects parent-id) - (gslg/get-drop-cell frame-id all-objects mouse-pos)) - - changes (pcb/resize-parents changes new-objects-ids) - - selected (->> changes - :redo-changes - (filter #(= (:type %) :add-obj)) - (filter #(selected (:old-id %))) - (map #(get-in % [:obj :id])) - (into (d/ordered-set))) - - changes - (cond-> changes - (some? drop-cell) - (pcb/update-shapes [parent-id] - #(ctl/add-children-to-cell % selected all-objects drop-cell))) - - undo-id (js/Symbol)] - - (rx/of (dwu/start-undo-transaction undo-id) - (dch/commit-changes changes) - (dws/select-shapes selected) - (ptk/data-event :layout/update [frame-id]) - (dwu/commit-undo-transaction undo-id))))] - - (ptk/reify ::paste-shape + (ptk/reify ::paste-shapes ptk/WatchEvent (watch [it state _] - (let [file-id (:current-file-id state) - mouse-pos (deref ms/mouse-position)] - (if (= file-id (:file-id data)) - (do-paste it state mouse-pos []) - (->> (rx/from images) - (rx/merge-map (partial upload-media file-id)) - (rx/reduce conj []) - (rx/mapcat (partial do-paste it state mouse-pos))))))))) + (let [ + file-id (:current-file-id state) + page (wsh/lookup-page state) + + media-idx (->> (:media pdata) + (d/index-by :prev-id)) + + selected (:selected pdata) + objects (:objects pdata) + + position (deref ms/mouse-position) + + ;; Calculate position for the pasted elements + [frame-id + parent-id + delta + index] (calculate-paste-position state objects selected position) + + ;; We don't want to change the structure of component + ;; copies If the parent-id or the frame-id are + ;; component-copies, we need to get the first not copy + ;; parent + parent-id (:id (ctn/get-first-not-copy-parent (:objects page) parent-id)) + frame-id (:id (ctn/get-first-not-copy-parent (:objects page) frame-id)) + + objects (update-vals objects (partial process-shape file-id frame-id parent-id)) + all-objects (merge (:objects page) objects) + + libraries (wsh/get-libraries state) + ldata (wsh/get-file state file-id) + + drop-cell (when (ctl/grid-layout? all-objects parent-id) + (gslg/get-drop-cell frame-id all-objects position)) + + changes (-> (dws/prepare-duplicate-changes all-objects page selected delta it libraries ldata file-id) + (pcb/amend-changes (partial process-rchange media-idx)) + (pcb/amend-changes (partial change-add-obj-index objects selected index))) + + ;; Adds a resize-parents operation so the groups are + ;; updated. We add all the new objects + changes (->> (:redo-changes changes) + (filter add-obj?) + (map :id) + (pcb/resize-parents changes)) + + selected (into (d/ordered-set) + (comp + (filter add-obj?) + (filter #(contains? selected (:old-id %))) + (map :obj) + (map :id)) + (:redo-changes changes)) + + changes (cond-> changes + (some? drop-cell) + (pcb/update-shapes [parent-id] + #(ctl/add-children-to-cell % selected all-objects drop-cell))) + + undo-id (js/Symbol)] + + (rx/of (dwu/start-undo-transaction undo-id) + (dch/commit-changes changes) + (dws/select-shapes selected) + (ptk/data-event :layout/update [frame-id]) + (dwu/commit-undo-transaction undo-id))))))) (defn as-content [text] (let [paragraphs (->> (str/lines text) @@ -1998,7 +2073,7 @@ :else (deref ms/mouse-position))) -(defn paste-text +(defn- paste-text [text] (dm/assert! (string? text)) (ptk/reify ::paste-text @@ -2025,10 +2100,10 @@ (dwu/commit-undo-transaction undo-id)))))) ;; TODO: why not implement it in terms of upload-media-workspace? -(defn- paste-svg +(defn- paste-svg-text [text] (dm/assert! (string? text)) - (ptk/reify ::paste-svg + (ptk/reify ::paste-svg-text ptk/WatchEvent (watch [_ state _] (let [position (calculate-paste-position state) @@ -2038,14 +2113,14 @@ (defn- paste-image [image] - (ptk/reify ::paste-bin-impl + (ptk/reify ::paste-image ptk/WatchEvent (watch [_ state _] - (let [file-id (get-in state [:workspace-file :id]) + (let [file-id (dm/get-in state [:workspace-file :id]) position (calculate-paste-position state) - params {:file-id file-id - :blobs [image] - :position position}] + params {:file-id file-id + :blobs [image] + :position position}] (rx/of (dwm/upload-media-workspace params)))))) (defn toggle-distances-display [value] diff --git a/frontend/src/app/main/data/workspace/changes.cljs b/frontend/src/app/main/data/workspace/changes.cljs index ceb6e16ac..9968f9305 100644 --- a/frontend/src/app/main/data/workspace/changes.cljs +++ b/frontend/src/app/main/data/workspace/changes.cljs @@ -53,7 +53,11 @@ ([ids update-fn] (update-shapes ids update-fn nil)) ([ids update-fn {:keys [reg-objects? save-undo? stack-undo? attrs ignore-tree page-id ignore-remote? ignore-touched undo-group] :or {reg-objects? false save-undo? true stack-undo? false ignore-remote? false ignore-touched false}}] - (dm/assert! (sm/coll-of-uuid? ids)) + + (dm/assert! + "expected a valid coll of uuid's" + (sm/check-coll-of-uuid! ids)) + (dm/assert! (fn? update-fn)) (ptk/reify ::update-shapes @@ -212,8 +216,8 @@ (try (dm/assert! "expect valid vector of changes" - (and (cpc/valid-changes? redo-changes) - (cpc/valid-changes? undo-changes))) + (and (cpc/check-changes! redo-changes) + (cpc/check-changes! undo-changes))) (update-in state path (fn [file] (-> file diff --git a/frontend/src/app/main/data/workspace/colors.cljs b/frontend/src/app/main/data/workspace/colors.cljs index 82487f4a2..94f03694a 100644 --- a/frontend/src/app/main/data/workspace/colors.cljs +++ b/frontend/src/app/main/data/workspace/colors.cljs @@ -278,7 +278,10 @@ (defn add-shadow [ids shadow] - (dm/assert! (sm/coll-of-uuid? ids)) + (dm/assert! + "expected a valid coll of uuid's" + (sm/check-coll-of-uuid! ids)) + (ptk/reify ::add-shadow ptk/WatchEvent (watch [_ _ _] diff --git a/frontend/src/app/main/data/workspace/comments.cljs b/frontend/src/app/main/data/workspace/comments.cljs index 2dd9bd231..46919efa4 100644 --- a/frontend/src/app/main/data/workspace/comments.cljs +++ b/frontend/src/app/main/data/workspace/comments.cljs @@ -81,7 +81,10 @@ (defn center-to-comment-thread [{:keys [position] :as thread}] - (dm/assert! (dcm/comment-thread? thread)) + (dm/assert! + "expected valid comment thread" + (dcm/check-comment-thread! thread)) + (ptk/reify ::center-to-comment-thread ptk/UpdateEvent (update [_ state] @@ -97,7 +100,9 @@ (defn navigate [thread] - (dm/assert! (dcm/comment-thread? thread)) + (dm/assert! + "expected valid comment thread" + (dcm/check-comment-thread! thread)) (ptk/reify ::open-comment-thread ptk/WatchEvent (watch [_ _ stream] @@ -118,36 +123,41 @@ (update-comment-thread-position thread [new-x new-y] nil)) ([thread [new-x new-y] frame-id] - (dm/assert! (dcm/comment-thread? thread)) - (ptk/reify ::update-comment-thread-position - ptk/WatchEvent - (watch [it state _] - (let [thread-id (:id thread) - page (wsh/lookup-page state) - page-id (:id page) - objects (wsh/lookup-page-objects state page-id) - new-frame-id (if (nil? frame-id) - (ctst/get-frame-id-by-position objects (gpt/point new-x new-y)) - (:frame-id thread)) - thread (assoc thread - :position (gpt/point new-x new-y) - :frame-id new-frame-id) + (dm/assert! + "expected valid comment thread" + (dcm/check-comment-thread! thread)) + (ptk/reify ::update-comment-thread-position + ptk/WatchEvent + (watch [it state _] + (let [thread-id (:id thread) + page (wsh/lookup-page state) + page-id (:id page) + objects (wsh/lookup-page-objects state page-id) + new-frame-id (if (nil? frame-id) + (ctst/get-frame-id-by-position objects (gpt/point new-x new-y)) + (:frame-id thread)) + thread (assoc thread + :position (gpt/point new-x new-y) + :frame-id new-frame-id) - changes - (-> (pcb/empty-changes it) - (pcb/with-page page) - (pcb/update-page-option :comment-threads-position assoc thread-id (select-keys thread [:position :frame-id])))] + changes + (-> (pcb/empty-changes it) + (pcb/with-page page) + (pcb/update-page-option :comment-threads-position assoc thread-id (select-keys thread [:position :frame-id])))] - (rx/merge - (rx/of (dwc/commit-changes changes)) - (->> (rp/cmd! :update-comment-thread-position thread) - (rx/catch #(rx/throw {:type :update-comment-thread-position})) - (rx/ignore)))))))) + (rx/merge + (rx/of (dwc/commit-changes changes)) + (->> (rp/cmd! :update-comment-thread-position thread) + (rx/catch #(rx/throw {:type :update-comment-thread-position})) + (rx/ignore)))))))) ;; Move comment threads that are inside a frame when that frame is moved" (defmethod ptk/resolve ::move-frame-comment-threads [_ ids] - (dm/assert! (sm/coll-of-uuid? ids)) + (dm/assert! + "expected a valid coll of uuid's" + (sm/check-coll-of-uuid! ids)) + (ptk/reify ::move-frame-comment-threads ptk/WatchEvent (watch [_ state _] diff --git a/frontend/src/app/main/data/workspace/guides.cljs b/frontend/src/app/main/data/workspace/guides.cljs index af97d5787..9e4fc3e6f 100644 --- a/frontend/src/app/main/data/workspace/guides.cljs +++ b/frontend/src/app/main/data/workspace/guides.cljs @@ -25,7 +25,7 @@ (defn update-guides [guide] (dm/assert! "expected valid guide" - (ctp/guide? guide)) + (ctp/check-page-guide! guide)) (ptk/reify ::update-guides ptk/WatchEvent @@ -40,7 +40,7 @@ (defn remove-guide [guide] (dm/assert! "expected valid guide" - (ctp/guide? guide)) + (ctp/check-page-guide! guide)) (ptk/reify ::remove-guide ptk/UpdateEvent diff --git a/frontend/src/app/main/data/workspace/libraries.cljs b/frontend/src/app/main/data/workspace/libraries.cljs index e6770c448..fa23060a1 100644 --- a/frontend/src/app/main/data/workspace/libraries.cljs +++ b/frontend/src/app/main/data/workspace/libraries.cljs @@ -114,7 +114,10 @@ (defn add-recent-color [color] - (dm/assert! (ctc/valid-recent-color? color)) + (dm/assert! + "expected valid recent color map" + (ctc/check-recent-color! color)) + (ptk/reify ::add-recent-color ptk/WatchEvent (watch [it _ _] @@ -144,8 +147,11 @@ (defn update-color [color file-id] - (dm/assert! (ctc/valid-color? color)) - (dm/assert! (uuid? file-id)) + + (dm/assert! + "expected valid parameters" + (and (ctc/check-color! color) + (uuid? file-id))) (ptk/reify ::update-color ptk/WatchEvent @@ -183,7 +189,10 @@ (defn add-media [media] - (dm/assert! (ctf/valid-media-object? media)) + (dm/assert! + "expected valid media object" + (ctf/check-media-object! media)) + (ptk/reify ::add-media ptk/WatchEvent (watch [it _ _] @@ -227,7 +236,10 @@ ([typography] (add-typography typography true)) ([typography edit?] (let [typography (update typography :id #(or % (uuid/next)))] - (dm/assert! (ctt/typography? typography)) + (dm/assert! + "expected valid typography" + (ctt/check-typography! typography)) + (ptk/reify ::add-typography IDeref (-deref [_] typography) @@ -256,8 +268,11 @@ (defn update-typography [typography file-id] - (dm/assert! (ctt/typography? typography)) - (dm/assert! (uuid? file-id)) + + (dm/assert! + "expected valid typography and file-id" + (and (ctt/check-typography! typography) + (uuid? file-id))) (ptk/reify ::update-typography ptk/WatchEvent @@ -607,7 +622,7 @@ (defn ext-library-changed [library-id modified-at revn changes] (dm/assert! (uuid? library-id)) - (dm/assert! (ch/valid-changes? changes)) + (dm/assert! (ch/check-changes! changes)) (ptk/reify ::ext-library-changed ptk/UpdateEvent (update [_ state] diff --git a/frontend/src/app/main/data/workspace/media.cljs b/frontend/src/app/main/data/workspace/media.cljs index 5cc682dd4..984a073e5 100644 --- a/frontend/src/app/main/data/workspace/media.cljs +++ b/frontend/src/app/main/data/workspace/media.cljs @@ -163,15 +163,6 @@ (rx/merge-map svg->clj) (rx/do on-svg))))) -(def schema:process-media-objects - [:map - [:file-id ::sm/uuid] - [:local? :boolean] - [:name {:optional true} :string] - [:data {:optional true} :any] ; FIXME - [:uris {:optional true} [:sequential :string]] - [:mtype {:optional true} :string]]) - (defn handle-media-error [error on-error] (if (ex/ex-info? error) (handle-media-error (ex-data error) on-error) @@ -205,10 +196,22 @@ (.error js/console "ERROR" error) (rx/of (msg/error (tr "errors.cannot-upload"))))))) + +(def ^:private + schema:process-media-objects + (sm/define + [:map {:title "process-media-objects"} + [:file-id ::sm/uuid] + [:local? :boolean] + [:name {:optional true} :string] + [:data {:optional true} :any] ; FIXME + [:uris {:optional true} [:sequential :string]] + [:mtype {:optional true} :string]])) + (defn- process-media-objects [{:keys [uris on-error] :as params}] (dm/assert! - (and (sm/valid? schema:process-media-objects params) + (and (sm/check! schema:process-media-objects params) (or (contains? params :blobs) (contains? params :uris)))) @@ -392,14 +395,18 @@ :on-svg #(st/emit! (process-svg-component %)))] (process-media-objects params))) -(def schema:clone-media-object - [:map - [:file-id ::sm/uuid] - [:object-id ::sm/uuid]]) +(def ^:private + schema:clone-media-object + (sm/define + [:map {:title "clone-media-object"} + [:file-id ::sm/uuid] + [:object-id ::sm/uuid]])) (defn clone-media-object [{:keys [file-id object-id] :as params}] - (dm/assert! (sm/valid? schema:clone-media-object params)) + (dm/assert! + (sm/check! schema:clone-media-object params)) + (ptk/reify ::clone-media-objects ptk/WatchEvent (watch [_ _ _] diff --git a/frontend/src/app/main/data/workspace/notifications.cljs b/frontend/src/app/main/data/workspace/notifications.cljs index 798e228c3..4b5916055 100644 --- a/frontend/src/app/main/data/workspace/notifications.cljs +++ b/frontend/src/app/main/data/workspace/notifications.cljs @@ -184,18 +184,23 @@ :updated-at (dt/now) :page-id page-id)))))) -(def schema:handle-file-change - [:map - [:type :keyword] - [:profile-id ::sm/uuid] - [:file-id ::sm/uuid] - [:session-id ::sm/uuid] - [:revn :int] - [:changes ::cpc/changes]]) +(def ^:private + schema:handle-file-change + (sm/define + [:map {:title "handle-file-change"} + [:type :keyword] + [:profile-id ::sm/uuid] + [:file-id ::sm/uuid] + [:session-id ::sm/uuid] + [:revn :int] + [:changes ::cpc/changes]])) (defn handle-file-change [{:keys [file-id changes] :as msg}] - (dm/assert! (sm/valid? schema:handle-file-change msg)) + (dm/assert! + "expected valid arguments" + (sm/check! schema:handle-file-change msg)) + (ptk/reify ::handle-file-change IDeref (-deref [_] {:changes changes}) @@ -241,19 +246,24 @@ (when-not (empty? changes-by-pages) (rx/from (map process-page-changes changes-by-pages)))))))) -(def schema:handle-library-change - [:map - [:type :keyword] - [:profile-id ::sm/uuid] - [:file-id ::sm/uuid] - [:session-id ::sm/uuid] - [:revn :int] - [:modified-at ::sm/inst] - [:changes ::cpc/changes]]) +(def ^:private + schema:handle-library-change + (sm/define + [:map {:title "handle-library-change"} + [:type :keyword] + [:profile-id ::sm/uuid] + [:file-id ::sm/uuid] + [:session-id ::sm/uuid] + [:revn :int] + [:modified-at ::sm/inst] + [:changes ::cpc/changes]])) (defn handle-library-change [{:keys [file-id modified-at changes revn] :as msg}] - (dm/assert! (sm/valid? schema:handle-library-change msg)) + (dm/assert! + "expected valid arguments" + (sm/check! schema:handle-library-change msg)) + (ptk/reify ::handle-library-change ptk/WatchEvent (watch [_ state _] diff --git a/frontend/src/app/main/data/workspace/path/changes.cljs b/frontend/src/app/main/data/workspace/path/changes.cljs index 32f4efed1..21990a28b 100644 --- a/frontend/src/app/main/data/workspace/path/changes.cljs +++ b/frontend/src/app/main/data/workspace/path/changes.cljs @@ -9,7 +9,7 @@ [app.common.data.macros :as dm] [app.common.files.changes-builder :as pcb] [app.main.data.workspace.changes :as dch] - [app.main.data.workspace.path.common :refer [content?]] + [app.main.data.workspace.path.common :refer [check-path-content!]] [app.main.data.workspace.path.helpers :as helpers] [app.main.data.workspace.path.state :as st] [app.main.data.workspace.state-helpers :as wsh] @@ -19,8 +19,12 @@ (defn generate-path-changes "Generates changes to update the new content of the shape" [it objects page-id shape old-content new-content] - (dm/assert! (content? old-content)) - (dm/assert! (content? new-content)) + + (dm/assert! + "expected valid path content" + (and (check-path-content! old-content) + (check-path-content! new-content))) + (let [shape-id (:id shape) [old-points old-selrect] diff --git a/frontend/src/app/main/data/workspace/path/common.cljs b/frontend/src/app/main/data/workspace/path/common.cljs index ee526a940..6bfd0d000 100644 --- a/frontend/src/app/main/data/workspace/path/common.cljs +++ b/frontend/src/app/main/data/workspace/path/common.cljs @@ -22,23 +22,27 @@ :elliptical-arc :close-path}) -(def schema:content - [:vector {:title "PathContent"} - [:map {:title "PathContentEntry"} - [:command [::sm/one-of valid-commands]] - ;; FIXME: remove the `?` from prop name - [:relative? {:optional true} :boolean] - [:params {:optional true} - [:map {:title "PathContentEntryParams"} - [:x :double] - [:y :double] - [:c1x {:optional true} :double] - [:c1y {:optional true} :double] - [:c2x {:optional true} :double] - [:c2y {:optional true} :double]]]]]) +;; FIXME: should this schema be defined on common.types ? -(def content? - (sm/pred-fn schema:content)) +(def ^:private + schema:path-content + (sm/define + [:vector {:title "PathContent"} + [:map {:title "PathContentEntry"} + [:command [::sm/one-of valid-commands]] + ;; FIXME: remove the `?` from prop name + [:relative? {:optional true} :boolean] + [:params {:optional true} + [:map {:title "PathContentEntryParams"} + [:x :double] + [:y :double] + [:c1x {:optional true} :double] + [:c1y {:optional true} :double] + [:c2x {:optional true} :double] + [:c2y {:optional true} :double]]]]])) + +(def check-path-content! + (sm/check-fn schema:path-content)) (defn init-path [] (ptk/reify ::init-path)) diff --git a/frontend/src/app/main/data/workspace/path/drawing.cljs b/frontend/src/app/main/data/workspace/path/drawing.cljs index ac24a2fa3..a0dd03249 100644 --- a/frontend/src/app/main/data/workspace/path/drawing.cljs +++ b/frontend/src/app/main/data/workspace/path/drawing.cljs @@ -20,7 +20,7 @@ [app.main.data.workspace.drawing.common :as dwdc] [app.main.data.workspace.edition :as dwe] [app.main.data.workspace.path.changes :as changes] - [app.main.data.workspace.path.common :as common :refer [content?]] + [app.main.data.workspace.path.common :as common :refer [check-path-content!]] [app.main.data.workspace.path.helpers :as helpers] [app.main.data.workspace.path.state :as st] [app.main.data.workspace.path.streams :as streams] @@ -262,7 +262,11 @@ ptk/UpdateEvent (update [_ state] (let [content (get-in state [:workspace-drawing :object :content] [])] - (dm/assert! (content? content)) + + (dm/assert! + "expected valid path content" + (check-path-content! content)) + (if (> (count content) 1) (assoc-in state [:workspace-drawing :object :initialized?] true) state))) diff --git a/frontend/src/app/main/data/workspace/persistence.cljs b/frontend/src/app/main/data/workspace/persistence.cljs index 7bf24ed39..509defdeb 100644 --- a/frontend/src/app/main/data/workspace/persistence.cljs +++ b/frontend/src/app/main/data/workspace/persistence.cljs @@ -238,7 +238,7 @@ [file-id {:keys [revn changes]}] (dm/assert! (uuid? file-id)) (dm/assert! (int? revn)) - (dm/assert! (cpc/valid-changes? changes)) + (dm/assert! (cpc/check-changes! changes)) (ptk/reify ::shapes-changes-persisted ptk/UpdateEvent diff --git a/frontend/src/app/main/data/workspace/shapes.cljs b/frontend/src/app/main/data/workspace/shapes.cljs index 1d879d298..f83eab3a1 100644 --- a/frontend/src/app/main/data/workspace/shapes.cljs +++ b/frontend/src/app/main/data/workspace/shapes.cljs @@ -27,9 +27,6 @@ [beicon.core :as rx] [potok.core :as ptk])) -(def valid-shape-map? - (sm/pred-fn ::cts/shape)) - (defn add-shape ([shape] (add-shape shape {})) @@ -37,7 +34,7 @@ (dm/verify! "expected a valid shape" - (cts/valid-shape? shape)) + (cts/check-shape! shape)) (ptk/reify ::add-shape ptk/WatchEvent @@ -94,7 +91,10 @@ ([ids] (delete-shapes nil ids {})) ([page-id ids] (delete-shapes page-id ids {})) ([page-id ids options] - (dm/assert! (sm/set-of-uuid? ids)) + (dm/assert! + "expected a valid set of uuid's" + (sm/check-set-of-uuid! ids)) + (ptk/reify ::delete-shapes ptk/WatchEvent (watch [it state _] @@ -376,7 +376,7 @@ (dm/assert! "expected valid shape-attrs value for `flags`" - (cts/valid-shape-attrs? flags)) + (cts/check-shape-attrs! flags)) (ptk/reify ::update-shape-flags ptk/WatchEvent diff --git a/frontend/src/app/main/data/workspace/texts.cljs b/frontend/src/app/main/data/workspace/texts.cljs index 543160edb..9f9988e21 100644 --- a/frontend/src/app/main/data/workspace/texts.cljs +++ b/frontend/src/app/main/data/workspace/texts.cljs @@ -427,7 +427,7 @@ shape))] - (let [ids (->> (keys props) (filter changed-text?))] + (let [ids (into #{} (filter changed-text?) (keys props))] (rx/of (dwu/start-undo-transaction undo-id) (dch/update-shapes ids update-fn {:reg-objects? true :stack-undo? true diff --git a/frontend/src/app/main/data/workspace/undo.cljs b/frontend/src/app/main/data/workspace/undo.cljs index c494d2c27..7bc8b61fd 100644 --- a/frontend/src/app/main/data/workspace/undo.cljs +++ b/frontend/src/app/main/data/workspace/undo.cljs @@ -24,13 +24,15 @@ ;; Undo / Redo ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(def schema:undo-entry - [:map - [:undo-changes [:vector ::cpc/change]] - [:redo-changes [:vector ::cpc/change]]]) +(def ^:private + schema:undo-entry + (sm/define + [:map {:title "undo-entry"} + [:undo-changes [:vector ::cpc/change]] + [:redo-changes [:vector ::cpc/change]]])) -(def undo-entry? - (sm/pred-fn schema:undo-entry)) +(def check-undo-entry! + (sm/check-fn schema:undo-entry)) (def MAX-UNDO-SIZE 50) @@ -89,8 +91,12 @@ (defn append-undo [entry stack?] - (dm/assert! (boolean? stack?)) - (dm/assert! (undo-entry? entry)) + (dm/assert! + "expected valid undo entry" + (check-undo-entry! entry)) + + (dm/assert! + (boolean? stack?)) (ptk/reify ::append-undo ptk/UpdateEvent diff --git a/frontend/src/app/main/errors.cljs b/frontend/src/app/main/errors.cljs index f1a3b324b..c6a25644a 100644 --- a/frontend/src/app/main/errors.cljs +++ b/frontend/src/app/main/errors.cljs @@ -114,17 +114,29 @@ ;; the user perspective a error flash message should be visualized but ;; user can continue operate on the application. Can happen in backend ;; and frontend. + (defmethod ptk/handle-error :validation - [error] - (ts/schedule - #(st/emit! (msg/show {:content "Validation error" - :type :error - :timeout 3000}))) + [{:keys [code] :as error}] (print-group! "Validation Error" (fn [] (print-data! error) - (print-explain! error)))) + (print-explain! error))) + (cond + (= code :invalid-paste-data) + (let [message (tr "errors.paste-data-validation")] + (st/async-emit! + (msg/show {:content message + :type :error + :timeout 3000}))) + + :else + (let [message (tr "errors.generic-validation")] + (st/async-emit! + (msg/show {:content message + :type :error + :timeout 3000}))))) + ;; This is a pure frontend error that can be caused by an active @@ -232,6 +244,12 @@ (let [message (tr "errors.max-quote-reached" (:target error))] (st/emit! (modal/show {:type :alert :message message}))) + (or (= :paste-feature-not-enabled code) + (= :missing-features-in-paste-content code) + (= :paste-feature-not-supported code)) + (let [message (tr "errors.feature-not-supported" (:feature error))] + (st/emit! (modal/show {:type :alert :message message}))) + :else (ptk/handle-error {:type :server-error :data error}))) diff --git a/frontend/src/app/main/store.cljs b/frontend/src/app/main/store.cljs index 04f715300..906702b84 100644 --- a/frontend/src/app/main/store.cljs +++ b/frontend/src/app/main/store.cljs @@ -8,6 +8,7 @@ (:require [app.common.logging :as log] [app.util.object :as obj] + [app.util.timers :as tm] [beicon.core :as rx] [okulary.core :as l] [potok.core :as ptk])) @@ -86,6 +87,10 @@ (apply ptk/emit! state (cons event events)) nil)) +(defn async-emit! + [& params] + (tm/schedule #(apply emit! params))) + (defonce ongoing-tasks (l/atom #{})) (add-watch ongoing-tasks ::ongoing-tasks diff --git a/frontend/src/app/main/ui/dashboard/project_menu.cljs b/frontend/src/app/main/ui/dashboard/project_menu.cljs index c85cc543b..d5dc1d976 100644 --- a/frontend/src/app/main/ui/dashboard/project_menu.cljs +++ b/frontend/src/app/main/ui/dashboard/project_menu.cljs @@ -6,8 +6,6 @@ (ns app.main.ui.dashboard.project-menu (:require - [app.common.data.macros :as dm] - [app.common.schema :as sm] [app.main.data.dashboard :as dd] [app.main.data.messages :as msg] [app.main.data.modal :as modal] @@ -21,19 +19,8 @@ [app.util.router :as rt] [rumext.v2 :as mf])) -(def schema:project-menu - [:map {:title "UIProjectMenu"} - [:project some?] - [:show? :boolean] - [:on-menu-close {:optional true} ::sm/fn] - [:on-error {:optional true} ::sm/fn] - [:top {:optional true} [:maybe :double]] - [:left {:optional true} [:maybe :double]] - [:on-import {:optional true} ::sm/fn]]) - (mf/defc project-menu [{:keys [project show? on-edit on-menu-close top left on-import] :as props}] - (dm/assert! (sm/valid? schema:project-menu props)) (let [top (or top 0) left (or left 0) diff --git a/frontend/src/app/main/ui/workspace/context_menu.cljs b/frontend/src/app/main/ui/workspace/context_menu.cljs index 44f45c04a..d8ac33625 100644 --- a/frontend/src/app/main/ui/workspace/context_menu.cljs +++ b/frontend/src/app/main/ui/workspace/context_menu.cljs @@ -154,7 +154,7 @@ (let [do-copy #(st/emit! (dw/copy-selected)) do-cut #(st/emit! (dw/copy-selected) (dw/delete-selected)) - do-paste #(st/emit! dw/paste) + do-paste #(st/emit! (dw/paste-from-clipboard)) do-duplicate #(st/emit! (dw/duplicate-selected true))] [:* [:& menu-entry {:title (tr "workspace.shape.menu.copy") @@ -531,7 +531,7 @@ (mf/defc viewport-context-menu [] (let [focus (mf/deref refs/workspace-focus-selected) - do-paste #(st/emit! dw/paste) + do-paste #(st/emit! (dw/paste-from-clipboard)) do-hide-ui #(st/emit! (-> (dw/toggle-layout-flag :hide-ui) (vary-meta assoc ::ev/origin "workspace-context-menu"))) do-toggle-focus-mode #(st/emit! (dw/toggle-focus-mode))] diff --git a/frontend/src/app/main/ui/workspace/viewport/actions.cljs b/frontend/src/app/main/ui/workspace/viewport/actions.cljs index 2be3f84e8..c9a699db3 100644 --- a/frontend/src/app/main/ui/workspace/viewport/actions.cljs +++ b/frontend/src/app/main/ui/workspace/viewport/actions.cljs @@ -501,13 +501,16 @@ :blobs (seq files)}] (st/emit! (dwm/upload-media-workspace params)))))))) -(defn on-paste [disable-paste in-viewport? workspace-read-only?] - (mf/use-callback +(defn on-paste + [disable-paste in-viewport? workspace-read-only?] + (mf/use-fn (mf/deps workspace-read-only?) (fn [event] - ;; We disable the paste just after mouse-up of a middle button so when panning won't - ;; paste the content into the workspace + ;; We disable the paste just after mouse-up of a middle button so + ;; when panning won't paste the content into the workspace (let [tag-name (-> event dom/get-target dom/get-tag-name)] - (when (and (not (#{"INPUT" "TEXTAREA"} tag-name)) (not @disable-paste) (not workspace-read-only?)) + (when (and (not (#{"INPUT" "TEXTAREA"} tag-name)) + (not @disable-paste) + (not workspace-read-only?)) (st/emit! (dw/paste-from-event event @in-viewport?))))))) diff --git a/frontend/src/app/util/object.cljs b/frontend/src/app/util/object.cljs index bb5d24fcc..892e9e7fe 100644 --- a/frontend/src/app/util/object.cljs +++ b/frontend/src/app/util/object.cljs @@ -6,7 +6,7 @@ (ns app.util.object "A collection of helpers for work with javascript objects." - (:refer-clojure :exclude [set! new get get-in merge clone contains? array?]) + (:refer-clojure :exclude [set! new get get-in merge clone contains? array? into-array]) (:require [cuerdas.core :as str])) @@ -14,6 +14,10 @@ [o] (.isArray js/Array o)) +(defn into-array + [o] + (js/Array.from o)) + (defn create [] #js {}) (defn get diff --git a/frontend/src/app/util/webapi.cljs b/frontend/src/app/util/webapi.cljs index 039f287ac..97994f240 100644 --- a/frontend/src/app/util/webapi.cljs +++ b/frontend/src/app/util/webapi.cljs @@ -93,6 +93,10 @@ (create-blob content mtype))) +(defn get-current-selected-text + [] + (.. js/window getSelection toString)) + (defn write-to-clipboard [data] (assert (string? data) "`data` should be string") @@ -101,44 +105,47 @@ (defn read-from-clipboard [] - (let [cboard (unchecked-get js/navigator "clipboard")] - (if (.-readText ^js cboard) - (rx/from (.readText ^js cboard)) - (throw (ex-info "This browser does not implement read from clipboard protocol" - {:not-implemented true}))))) + (try + (let [cboard (unchecked-get js/navigator "clipboard")] + (if (.-readText ^js cboard) + (rx/from (.readText ^js cboard)) + (rx/throw (ex-info "This browser does not implement read from clipboard protocol" + {:not-implemented true})))) + (catch :default cause + (rx/throw cause)))) (defn read-image-from-clipboard [] - (let [cboard (unchecked-get js/navigator "clipboard") - read-item (fn [item] - (let [img-type (->> (.-types ^js item) - (d/seek #(str/starts-with? % "image/")))] - (if img-type - (rx/from (.getType ^js item img-type)) - (rx/empty))))] - (->> (rx/from (.read ^js cboard)) ;; Get a stream of item lists - (rx/mapcat identity) ;; Convert each item into an emission - (rx/switch-map read-item)))) + (try + (let [cboard (unchecked-get js/navigator "clipboard") + read-item (fn [item] + (let [img-type (->> (.-types ^js item) + (d/seek #(str/starts-with? % "image/")))] + (if img-type + (rx/from (.getType ^js item img-type)) + (rx/empty))))] + (->> (rx/from (.read ^js cboard)) ;; Get a stream of item lists + (rx/mapcat identity) ;; Convert each item into an emission + (rx/switch-map read-item))) + (catch :default cause + (rx/throw cause)))) (defn read-from-paste-event [event] (let [target (.-target ^js event)] - (when (and (not (.-isContentEditable target)) ;; ignore when pasting into - (not= (.-tagName target) "INPUT")) ;; an editable control + (when (and (not (.-isContentEditable ^js target)) ;; ignore when pasting into + (not= (.-tagName ^js target) "INPUT")) ;; an editable control (.. ^js event getBrowserEvent -clipboardData)))) (defn extract-text [clipboard-data] - (when clipboard-data - (.getData clipboard-data "text"))) + (.getData clipboard-data "text")) (defn extract-images + "Get image files from clipboard data. Returns a native js array." [clipboard-data] - (when clipboard-data - (let [file-list (-> (.-files ^js clipboard-data))] - (->> (range (.-length ^js file-list)) - (map #(.item ^js file-list %)) - (filter #(str/starts-with? (.-type %) "image/")))))) + (let [files (obj/into-array (.-files ^js clipboard-data))] + (.filter ^js files #(str/starts-with? (obj/get % "type") "image/")))) (defn create-canvas-element [width height] diff --git a/frontend/src/app/worker.cljs b/frontend/src/app/worker.cljs index 4b0171cb6..9ee1e1e69 100644 --- a/frontend/src/app/worker.cljs +++ b/frontend/src/app/worker.cljs @@ -24,23 +24,24 @@ ;; --- Messages Handling -(def schema:message - [:map {:title "WorkerMessage"} - [:sender-id ::sm/uuid] - [:payload - [:map - [:cmd :keyword]]] - [:buffer? {:optional true} :boolean]]) - -(def message? - (sm/pred-fn schema:message)) +(def ^:private + schema:message + (sm/define + [:map {:title "WorkerMessage"} + [:sender-id ::sm/uuid] + [:payload + [:map + [:cmd :keyword]]] + [:buffer? {:optional true} :boolean]])) (def buffer (rx/subject)) (defn- handle-message "Process the message and returns to the client" [{:keys [sender-id payload transfer] :as message}] - (dm/assert! (message? message)) + (dm/assert! + "expected valid message" + (sm/check! schema:message message)) (letfn [(post [msg] (let [msg (-> msg (assoc :reply-to sender-id) (wm/encode))] (.postMessage js/self msg))) @@ -86,7 +87,9 @@ (defn- drop-message "Sends to the client a notification that its messages have been dropped" [{:keys [sender-id] :as message}] - (dm/assert! (message? message)) + (dm/assert! + "expected valid message" + (sm/check! schema:message message)) (.postMessage js/self (wm/encode {:reply-to sender-id :dropped true}))) diff --git a/frontend/translations/en.po b/frontend/translations/en.po index 8ff5e68f4..ee120abc4 100644 --- a/frontend/translations/en.po +++ b/frontend/translations/en.po @@ -998,6 +998,13 @@ msgstr "Email or password is incorrect." msgid "errors.wrong-old-password" msgstr "Old password is incorrect" +msgid "errors.validation" +msgstr "Validation Error" + +msgid "errors.paste-data-validation" +msgstr "Invalid data in clipboard" + + #: src/app/main/ui/settings/feedback.cljs msgid "feedback.description" msgstr "Description"