3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-01 20:36:19 +02:00
Code Issues Projects Releases Packages Wiki Activity

🎉 Add proper schema encoding/decoding mechanism

Browse source 
this allows almost all api operations to success usin application/json
encoding with the exception of the update-file, which we need to
approach a bit differently;

the reason update-file is different, is because the operations vector
is right now defined without the context of shape type, so we are just
unable to properly parse the value to correct type using the schema
decoding mechanism
This commit is contained in:
Andrey Antukh 2024-08-16 12:07:53 +02:00
parent 0db1eed87f
commit cacee40d11
50 changed files with 1290 additions and 843 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

86
backend/src/app/config.clj
View file

@ -91,25 +91,25 @@
[:public-uri {:optional false} :string]
[:host {:optional false} :string]
[:http-server-port {:optional true} :int]
[:http-server-port {:optional true} ::sm/int]
[:http-server-host {:optional true} :string]
[:http-server-max-body-size {:optional true} :int]
[:http-server-max-multipart-body-size {:optional true} :int]
[:http-server-io-threads {:optional true} :int]
[:http-server-worker-threads {:optional true} :int]
[:http-server-max-body-size {:optional true} ::sm/int]
[:http-server-max-multipart-body-size {:optional true} ::sm/int]
[:http-server-io-threads {:optional true} ::sm/int]
[:http-server-worker-threads {:optional true} ::sm/int]
[:telemetry-uri {:optional true} :string]
[:telemetry-with-taiga {:optional true} :boolean] ;; DELETE
[:telemetry-with-taiga {:optional true} ::sm/boolean] ;; DELETE
[:file-snapshot-total {:optional true} :int]
[:file-snapshot-every {:optional true} :int]
[:file-snapshot-total {:optional true} ::sm/int]
[:file-snapshot-every {:optional true} ::sm/int]
[:file-snapshot-timeout {:optional true} ::dt/duration]
[:media-max-file-size {:optional true} :int]
[:media-max-file-size {:optional true} ::sm/int]
[:deletion-delay {:optional true} ::dt/duration] ;; REVIEW
[:telemetry-enabled {:optional true} :boolean]
[:default-blob-version {:optional true} :int]
[:allow-demo-users {:optional true} :boolean]
[:telemetry-enabled {:optional true} ::sm/boolean]
[:default-blob-version {:optional true} ::sm/int]
[:allow-demo-users {:optional true} ::sm/boolean]
[:error-report-webhook {:optional true} :string]
[:user-feedback-destination {:optional true} :string]
@ -118,30 +118,30 @@
[:rpc-climit-config {:optional true} ::fs/path]
[:audit-log-archive-uri {:optional true} :string]
[:audit-log-http-handler-concurrency {:optional true} :int]
[:audit-log-http-handler-concurrency {:optional true} ::sm/int]
[:default-executor-parallelism {:optional true} :int] ;; REVIEW
[:scheduled-executor-parallelism {:optional true} :int] ;; REVIEW
[:worker-default-parallelism {:optional true} :int]
[:worker-webhook-parallelism {:optional true} :int]
[:default-executor-parallelism {:optional true} ::sm/int] ;; REVIEW
[:scheduled-executor-parallelism {:optional true} ::sm/int] ;; REVIEW
[:worker-default-parallelism {:optional true} ::sm/int]
[:worker-webhook-parallelism {:optional true} ::sm/int]
[:database-password {:optional true} [:maybe :string]]
[:database-uri {:optional true} :string]
[:database-username {:optional true} [:maybe :string]]
[:database-readonly {:optional true} :boolean]
[:database-min-pool-size {:optional true} :int]
[:database-max-pool-size {:optional true} :int]
[:database-readonly {:optional true} ::sm/boolean]
[:database-min-pool-size {:optional true} ::sm/int]
[:database-max-pool-size {:optional true} ::sm/int]
[:quotes-teams-per-profile {:optional true} :int]
[:quotes-access-tokens-per-profile {:optional true} :int]
[:quotes-projects-per-team {:optional true} :int]
[:quotes-invitations-per-team {:optional true} :int]
[:quotes-profiles-per-team {:optional true} :int]
[:quotes-files-per-project {:optional true} :int]
[:quotes-files-per-team {:optional true} :int]
[:quotes-font-variants-per-team {:optional true} :int]
[:quotes-comment-threads-per-file {:optional true} :int]
[:quotes-comments-per-file {:optional true} :int]
[:quotes-teams-per-profile {:optional true} ::sm/int]
[:quotes-access-tokens-per-profile {:optional true} ::sm/int]
[:quotes-projects-per-team {:optional true} ::sm/int]
[:quotes-invitations-per-team {:optional true} ::sm/int]
[:quotes-profiles-per-team {:optional true} ::sm/int]
[:quotes-files-per-project {:optional true} ::sm/int]
[:quotes-files-per-team {:optional true} ::sm/int]
[:quotes-font-variants-per-team {:optional true} ::sm/int]
[:quotes-comment-threads-per-file {:optional true} ::sm/int]
[:quotes-comments-per-file {:optional true} ::sm/int]
[:auth-data-cookie-domain {:optional true} :string]
[:auth-token-cookie-name {:optional true} :string]
@ -178,15 +178,15 @@
[:ldap-bind-dn {:optional true} :string]
[:ldap-bind-password {:optional true} :string]
[:ldap-host {:optional true} :string]
[:ldap-port {:optional true} :int]
[:ldap-ssl {:optional true} :boolean]
[:ldap-starttls {:optional true} :boolean]
[:ldap-port {:optional true} ::sm/int]
[:ldap-ssl {:optional true} ::sm/boolean]
[:ldap-starttls {:optional true} ::sm/boolean]
[:ldap-user-query {:optional true} :string]
[:profile-bounce-max-age {:optional true} ::dt/duration]
[:profile-bounce-threshold {:optional true} :int]
[:profile-bounce-threshold {:optional true} ::sm/int]
[:profile-complaint-max-age {:optional true} ::dt/duration]
[:profile-complaint-threshold {:optional true} :int]
[:profile-complaint-threshold {:optional true} ::sm/int]
[:redis-uri {:optional true} :string]
@ -197,15 +197,15 @@
[:smtp-default-reply-to {:optional true} :string]
[:smtp-host {:optional true} :string]
[:smtp-password {:optional true} [:maybe :string]]
[:smtp-port {:optional true} :int]
[:smtp-ssl {:optional true} :boolean]
[:smtp-tls {:optional true} :boolean]
[:smtp-port {:optional true} ::sm/int]
[:smtp-ssl {:optional true} ::sm/boolean]
[:smtp-tls {:optional true} ::sm/boolean]
[:smtp-username {:optional true} [:maybe :string]]
[:urepl-host {:optional true} :string]
[:urepl-port {:optional true} :int]
[:urepl-port {:optional true} ::sm/int]
[:prepl-host {:optional true} :string]
[:prepl-port {:optional true} :int]
[:prepl-port {:optional true} ::sm/int]
[:media-directory {:optional true} :string] ;; REVIEW
[:media-uri {:optional true} :string]
@ -217,14 +217,14 @@
[:storage-assets-s3-bucket {:optional true} :string]
[:storage-assets-s3-region {:optional true} :keyword]
[:storage-assets-s3-endpoint {:optional true} :string]
[:storage-assets-s3-io-threads {:optional true} :int]
[:storage-assets-s3-io-threads {:optional true} ::sm/int]
[:objects-storage-backend {:optional true} :keyword]
[:objects-storage-fs-directory {:optional true} :string]
[:objects-storage-s3-bucket {:optional true} :string]
[:objects-storage-s3-region {:optional true} :keyword]
[:objects-storage-s3-endpoint {:optional true} :string]
[:objects-storage-s3-io-threads {:optional true} :int]]))
[:objects-storage-s3-io-threads {:optional true} ::sm/int]]))
(def default-flags
[:enable-backend-api-doc
@ -253,7 +253,7 @@
env)))
(def decode-config
(sm/decoder schema:config sm/default-transformer))
(sm/decoder schema:config sm/string-transformer))
(def validate-config
(sm/validator schema:config))

6
backend/src/app/email.clj
View file

@ -157,10 +157,10 @@
[:map
[::username {:optional true} :string]
[::password {:optional true} :string]
[::tls {:optional true} :boolean]
[::ssl {:optional true} :boolean]
[::tls {:optional true} ::sm/boolean]
[::ssl {:optional true} ::sm/boolean]
[::host {:optional true} :string]
[::port {:optional true} :int]
[::port {:optional true} ::sm/int]
[::default-from {:optional true} :string]
[::default-reply-to {:optional true} :string]])

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

@ -114,7 +114,7 @@
(sm/lazy-validator ::ctc/color))
(def valid-fill?
(sm/lazy-validator ::cts/fill))
(sm/lazy-validator cts/schema:fill))
(def valid-stroke?
(sm/lazy-validator ::cts/stroke))
@ -135,10 +135,10 @@
(sm/lazy-validator ::ctc/rgb-color))
(def valid-shape-points?
(sm/lazy-validator ::cts/points))
(sm/lazy-validator cts/schema:points))
(def valid-image-attrs?
(sm/lazy-validator ::cts/image-attrs))
(sm/lazy-validator cts/schema:image-attrs))
(def valid-column-grid-params?
(sm/lazy-validator ::ctg/column-params))

31
backend/src/app/http/middleware.clj
View file

@ -7,11 +7,13 @@
(ns app.http.middleware
(:require
[app.common.exceptions :as ex]
[app.common.json :as json]
[app.common.logging :as l]
[app.common.schema :as-alias sm]
[app.common.transit :as t]
[app.config :as cf]
[app.http.errors :as errors]
[clojure.data.json :as json]
[app.util.pointer-map :as pmap]
[cuerdas.core :as str]
[ring.request :as rreq]
[ring.response :as rres]
@ -39,16 +41,6 @@
(java.io.BufferedReader.
(java.io.InputStreamReader. body))))
(defn- read-json-key
[k]
(-> k str/kebab keyword))
(defn- write-json-key
[k]
(if (or (keyword? k) (symbol? k))
(str/camel k)
(str k)))
(defn wrap-parse-request
[handler]
(letfn [(process-request [request]
@ -63,7 +55,7 @@
(str/starts-with? header "application/json")
(with-open [reader (get-reader request)]
(let [params (json/read reader :key-fn read-json-key)]
(let [params (json/read reader :key-fn json/read-kebab-key)]
(-> request
(assoc :body-params params)
(update :params merge params))))
@ -113,6 +105,12 @@
(def ^:const buffer-size (:xnio/buffer-size yt/defaults))
(defn- write-json-value
[_ val]
(if (pmap/pointer-map? val)
[(pmap/get-id val) (meta val)]
val))
(defn wrap-format-response
[handler]
(letfn [(transit-streamable-body [data opts]
@ -134,10 +132,11 @@
(reify rres/StreamableResponseBody
(-write-body-to-stream [_ _ output-stream]
(try
(with-open [^OutputStream bos (buffered-output-stream output-stream buffer-size)]
(with-open [^java.io.OutputStreamWriter writer (java.io.OutputStreamWriter. bos)]
(json/write data writer :key-fn write-json-key)))
(let [encode (or (-> data meta :encode/json) identity)
data (encode data)]
(with-open [^OutputStream bos (buffered-output-stream output-stream buffer-size)]
(with-open [^java.io.OutputStreamWriter writer (java.io.OutputStreamWriter. bos)]
(json/write writer data :key-fn json/write-camel-key :value-fn write-json-value))))
(catch java.io.IOException _)
(catch Throwable cause
(binding [l/*context* {:value data}]

2
backend/src/app/media.clj
View file

@ -49,7 +49,7 @@
(sm/register! ::upload
[:map {:title "Upload"}
[:filename :string]
[:size :int]
[:size ::sm/int]
[:path ::fs/path]
[:mtype {:optional true} :string]
[:headers {:optional true}

30
backend/src/app/rpc.clj
View file

@ -178,38 +178,21 @@
(if-let [schema (::sm/params mdata)]
(let [validate (sm/validator schema)
explain (sm/explainer schema)
decode (sm/decoder schema)]
decode (sm/decoder schema sm/json-transformer)
encode (sm/encoder schema sm/json-transformer)]
(fn [cfg params]
(let [params (decode params)]
(if (validate params)
(f cfg params)
(let [result (f cfg params)]
(if (instance? clojure.lang.IObj result)
(vary-meta result assoc :encode/json encode)
result))
(let [params (d/without-qualified params)]
(ex/raise :type :validation
:code :params-validation
::sm/explain (explain params)))))))
f))
(defn- wrap-output-validation
[_ f mdata]
(if (contains? cf/flags :rpc-output-validation)
(or (when-let [schema (::sm/result mdata)]
(let [schema (if (sm/lazy-schema? schema)
schema
(sm/define schema))
validate (sm/validator schema)
explain (sm/explainer schema)]
(fn [cfg params]
(let [response (f cfg params)]
(when (map? response)
(when-not (validate response)
(ex/raise :type :validation
:code :data-validation
::sm/explain (explain response))))
response))))
f)
f))
(defn- wrap-all
[cfg f mdata]
(as-> f $
@ -220,7 +203,6 @@
(rlimit/wrap cfg $ mdata)
(wrap-audit cfg $ mdata)
(wrap-spec-conform cfg $ mdata)
(wrap-output-validation cfg $ mdata)
(wrap-params-validation cfg $ mdata)
(wrap-authentication cfg $ mdata)))

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

@ -178,12 +178,12 @@
[:map {:title "File"}
[:id ::sm/uuid]
[:features ::cfeat/features]
[:has-media-trimmed :boolean]
[:comment-thread-seqn {:min 0} :int]
[:has-media-trimmed ::sm/boolean]
[:comment-thread-seqn [::sm/int {:min 0}]]
[:name [:string {:max 250}]]
[:revn {:min 0} :int]
[:revn [::sm/int {:min 0}]]
[:modified-at ::dt/instant]
[:is-shared :boolean]
[:is-shared ::sm/boolean]
[:project-id ::sm/uuid]
[:created-at ::dt/instant]
[:data {:optional true} :any]]))
@ -408,7 +408,7 @@
"Checks if the file has libraries. Returns a boolean"
{::doc/added "1.15.1"
::sm/params schema:has-file-libraries
::sm/result :boolean}
::sm/result ::sm/boolean}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id]}]
(dm/with-open [conn (db/open pool)]
(check-read-permissions! pool profile-id file-id)
@ -917,7 +917,7 @@
(sm/define
[:map {:title "set-file-shared"}
[:id ::sm/uuid]
[:is-shared :boolean]]))
[:is-shared ::sm/boolean]]))
(sv/defmethod ::set-file-shared
{::doc/added "1.17"

2
backend/src/app/rpc/commands/files_create.clj
View file

@ -91,7 +91,7 @@
[:name [:string {:max 250}]]
[:project-id ::sm/uuid]
[:id {:optional true} ::sm/uuid]
[:is-shared {:optional true} :boolean]
[:is-shared {:optional true} ::sm/boolean]
[:features {:optional true} ::cfeat/features]])
(sv/defmethod ::create-file

6
backend/src/app/rpc/commands/files_temp.clj
View file

@ -38,9 +38,9 @@
[:name [:string {:max 250}]]
[:project-id ::sm/uuid]
[:id {:optional true} ::sm/uuid]
[:is-shared :boolean]
[:is-shared ::sm/boolean]
[:features ::cfeat/features]
[:create-page :boolean]])
[:create-page ::sm/boolean]])
(sv/defmethod ::create-temp-file
{::doc/added "1.17"
@ -83,7 +83,7 @@
(def ^:private schema:update-temp-file
[:map {:title "update-temp-file"}
[:changes [:vector ::cpc/change]]
[:revn {:min 0} :int]
[:revn [::sm/int {:min 0}]]
[:session-id ::sm/uuid]
[:id ::sm/uuid]])

4
backend/src/app/rpc/commands/files_thumbnails.clj
View file

@ -189,7 +189,7 @@
(sm/define
[:map {:title "PartialFile"}
[:id ::sm/uuid]
[:revn {:min 0} :int]
[:revn {:min 0} ::sm/int]
[:page :any]]))
(sv/defmethod ::get-file-data-for-thumbnail
@ -385,7 +385,7 @@
schema:create-file-thumbnail
[:map {:title "create-file-thumbnail"}
[:file-id ::sm/uuid]
[:revn :int]
[:revn ::sm/int]
[:media ::media/upload]])
(sv/defmethod ::create-file-thumbnail

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

@ -44,7 +44,7 @@
[:map {:title "update-file"}
[:id ::sm/uuid]
[:session-id ::sm/uuid]
[:revn {:min 0} :int]
[:revn {:min 0} ::sm/int]
[:features {:optional true} ::cfeat/features]
[:changes {:optional true} [:vector ::cpc/change]]
[:changes-with-metadata {:optional true}
@ -52,7 +52,7 @@
[:changes [:vector ::cpc/change]]
[:hint-origin {:optional true} :keyword]
[:hint-events {:optional true} [:vector [:string {:max 250}]]]]]]
[:skip-validate {:optional true} :boolean]])
[:skip-validate {:optional true} ::sm/boolean]])
(def ^:private
schema:update-file-result
@ -61,7 +61,7 @@
[:changes [:vector ::cpc/change]]
[:file-id ::sm/uuid]
[:id ::sm/uuid]
[:revn {:min 0} :int]
[:revn {:min 0} ::sm/int]
[:session-id ::sm/uuid]]])
;; --- HELPERS

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

@ -382,10 +382,9 @@
(def ^:private
schema:move-project
(sm/define
[:map {:title "move-project"}
[:team-id ::sm/uuid]
[:project-id ::sm/uuid]]))
[:map {:title "move-project"}
[:team-id ::sm/uuid]
[:project-id ::sm/uuid]])
(sv/defmethod ::move-project
"Move projects between teams"
@ -425,10 +424,9 @@
(def ^:private
schema:clone-template
(sm/define
[:map {:title "clone-template"}
[:project-id ::sm/uuid]
[:template-id ::sm/word-string]]))
[:map {:title "clone-template"}
[:project-id ::sm/uuid]
[:template-id ::sm/word-string]])
(sv/defmethod ::clone-template
"Clone into the specified project the template by its id."

6
backend/src/app/rpc/commands/media.clj
View file

@ -46,7 +46,7 @@
[:map {:title "upload-file-media-object"}
[:id {:optional true} ::sm/uuid]
[:file-id ::sm/uuid]
[:is-local :boolean]
[:is-local ::sm/boolean]
[:name [:string {:max 250}]]
[:content ::media/upload]])
@ -172,7 +172,7 @@
(def ^:private schema:create-file-media-object-from-url
[:map {:title "create-file-media-object-from-url"}
[:file-id ::sm/uuid]
[:is-local :boolean]
[:is-local ::sm/boolean]
[:url ::sm/uri]
[:id {:optional true} ::sm/uuid]
[:name {:optional true} [:string {:max 250}]]])
@ -253,7 +253,7 @@
(def ^:private schema:clone-file-media-object
[:map {:title "clone-file-media-object"}
[:file-id ::sm/uuid]
[:is-local :boolean]
[:is-local ::sm/boolean]
[:id ::sm/uuid]])
(sv/defmethod ::clone-file-media-object

8
backend/src/app/rpc/commands/profile.clj
View file

@ -60,10 +60,10 @@
[:id ::sm/uuid]
[:fullname [::sm/word-string {:max 250}]]
[:email ::sm/email]
[:is-active {:optional true} :boolean]
[:is-blocked {:optional true} :boolean]
[:is-demo {:optional true} :boolean]
[:is-muted {:optional true} :boolean]
[:is-active {:optional true} ::sm/boolean]
[:is-blocked {:optional true} ::sm/boolean]
[:is-demo {:optional true} ::sm/boolean]
[:is-muted {:optional true} ::sm/boolean]
[:created-at {:optional true} ::sm/inst]
[:modified-at {:optional true} ::sm/inst]
[:default-project-id {:optional true} ::sm/uuid]

2
backend/src/app/rpc/commands/projects.clj
View file

@ -208,7 +208,7 @@
(def ^:private schema:update-project-pin
[:map {:title "update-project-pin"}
[:team-id ::sm/uuid]
[:is-pinned :boolean]
[:is-pinned ::sm/boolean]
[:id ::sm/uuid]])
(sv/defmethod ::update-project-pin

6
backend/src/app/rpc/commands/teams.clj
View file

@ -906,7 +906,7 @@
[:map {:title "create-team-invitations"}
[:team-id ::sm/uuid]
[:role schema:role]
[:emails ::sm/set-of-emails]])
[:emails [::sm/set ::sm/email]]])
(sv/defmethod ::create-team-invitations
"A rpc call that allow to send a single or multiple invitations to
@ -972,7 +972,7 @@
[:name [:string {:max 250}]]
[:features {:optional true} ::cfeat/features]
[:id {:optional true} ::sm/uuid]
[:emails ::sm/set-of-emails]
[:emails [::sm/set ::sm/email]]
[:role schema:role]])
(sv/defmethod ::create-team-with-invitations
@ -1175,7 +1175,7 @@
[:map {:title "create-team-access-request"}
[:file-id {:optional true} ::sm/uuid]
[:team-id {:optional true} ::sm/uuid]
[:is-viewer {:optional true} :boolean]]
[:is-viewer {:optional true} ::sm/boolean]]
[:fn (fn [params]
(or (contains? params :file-id)

2
backend/src/app/rpc/commands/webhooks.clj
View file

@ -111,7 +111,7 @@
[:id ::sm/uuid]
[:uri ::sm/uri]
[:mtype [::sm/one-of {:format "string"} valid-mtypes]]
[:is-active :boolean]])
[:is-active ::sm/boolean]])
(sv/defmethod ::update-webhook
{::doc/added "1.17"

121
backend/src/app/rpc/doc.clj
View file

@ -26,7 +26,6 @@
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[integrant.core :as ig]
[malli.transform :as mt]
[pretty-spec.core :as ps]
[ring.response :as-alias rres]))
@ -98,77 +97,79 @@
;; OPENAPI / SWAGGER (v3.1)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def output-transformer
(mt/transformer
sm/default-transformer
(mt/key-transformer {:encode str/camel
:decode (comp keyword str/kebab)})))
(defn prepare-openapi-context
[methods]
(letfn [(gen-response-doc [tsx schema]
(let [schema (sm/schema schema)
example (sm/generate schema)
example (sm/encode schema example output-transformer)]
{:default
{:description "A default response"
:content
{"application/json"
{:schema tsx
:example example}}}}))
(let [definitions (atom {})
options {:registry sr/default-registry
::oapi/definitions-path "#/components/schemas/"
::oapi/definitions definitions}
(gen-params-doc [tsx schema]
(let [example (sm/generate schema)
example (sm/encode schema example output-transformer)]
{:required true
:content
{"application/json"
{:schema tsx
:example example}}}))
output-transformer
(sm/json-transformer)
(gen-method-doc [options mdata]
(let [pschema (::sm/params mdata)
rschema (::sm/result mdata)
gen-response-doc
(fn [tsx schema]
(let [schema (sm/schema schema)
example (sm/generate schema)
example (sm/encode schema example output-transformer)]
{:default
{:description "A default response"
:content
{"application/json"
{:schema tsx
:example example}}}}))
sparams (-> pschema (oapi/transform options) (gen-params-doc pschema))
sresp (some-> rschema (oapi/transform options) (gen-response-doc rschema))
gen-params-doc
(fn [tsx schema]
(let [example (sm/generate schema)
example (sm/encode schema example output-transformer)]
{:required true
:content
{"application/json"
{:schema tsx
:example example}}}))
rpost {:description (::sv/docstring mdata)
:deprecated (::deprecated mdata false)
:requestBody sparams}
gen-method-doc
(fn [mdata]
(let [pschema (::sm/params mdata)
rschema (::sm/result mdata)
rpost (cond-> rpost
(some? sresp)
(assoc :responses sresp))]
sparams (-> pschema (oapi/transform options) (gen-params-doc pschema))
sresp (some-> rschema (oapi/transform options) (gen-response-doc rschema))
{:name (-> mdata ::sv/name d/name)
:module (-> (:ns mdata) (str/split ".") last)
:repr {:post rpost}}))]
rpost {:description (::sv/docstring mdata)
:deprecated (::deprecated mdata false)
:requestBody sparams}
(let [definitions (atom {})
options {:registry sr/default-registry
::oapi/definitions-path "#/components/schemas/"
::oapi/definitions definitions}
rpost (cond-> rpost
(some? sresp)
(assoc :responses sresp))]
paths (binding [oapi/*definitions* definitions]
(->> methods
(map (comp first val))
(filter ::sm/params)
(map (partial gen-method-doc options))
(sort-by (juxt :module :name))
(map (fn [doc]
[(str/ffmt "/command/%" (:name doc)) (:repr doc)]))
(into {})))]
{:openapi "3.0.0"
:info {:version (:main cf/version)}
:servers [{:url (str/ffmt "%/api/rpc" (cf/get :public-uri))
{:name (-> mdata ::sv/name d/name)
:module (-> (:ns mdata) (str/split ".") last)
:repr {:post rpost}}))
paths
(binding [oapi/*definitions* definitions]
(->> methods
(map (comp first val))
(filter ::sm/params)
(map gen-method-doc)
(sort-by (juxt :module :name))
(map (fn [doc]
[(str/ffmt "/command/%" (:name doc)) (:repr doc)]))
(into {})))]
{:openapi "3.0.0"
:info {:version (:main cf/version)}
:servers [{:url (str/ffmt "%/api/rpc" (cf/get :public-uri))
;; :description "penpot backend"
}]
:security
{:api_key []}
}]
:security
{:api_key []}
:paths paths
:components {:schemas @definitions}})))
:paths paths
:components {:schemas @definitions}}))
(defn openapi-json-handler
[context]

10
backend/src/app/rpc/permissions.clj
View file

@ -15,11 +15,11 @@
(sm/register! ::permissions
[:map {:title "Permissions"}
[:type {:gen/elements [:membership :share-link]} :keyword]
[:is-owner :boolean]
[:is-admin :boolean]
[:can-edit :boolean]
[:can-read :boolean]
[:is-logged :boolean]])
[:is-owner ::sm/boolean]
[:is-admin ::sm/boolean]
[:can-edit ::sm/boolean]
[:can-read ::sm/boolean]
[:is-logged ::sm/boolean]])
(s/def ::role #{:admin :owner :editor :viewer})

2
backend/src/app/rpc/quotes.clj
View file

@ -31,7 +31,7 @@
[::team-id {:optional true} ::sm/uuid]
[::project-id {:optional true} ::sm/uuid]
[::file-id {:optional true} ::sm/uuid]
[::incr {:optional true} [:int {:min 0}]]
[::incr {:optional true} [::sm/int {:min 0}]]
[::id :keyword]
[::profile-id ::sm/uuid]]))

6
backend/src/app/util/overrides.clj
View file

@ -13,7 +13,6 @@
[clojure.pprint :as pprint]
[datoteka.fs :as fs]))
(prefer-method print-method
clojure.lang.IRecord
clojure.lang.IDeref)
@ -26,7 +25,6 @@
clojure.lang.IPersistentMap
clojure.lang.IDeref)
(sm/register! ::fs/path
{:type ::fs/path
:pred fs/path?
@ -36,6 +34,6 @@
:error/message "expected a valid fs path instance"
:error/code "errors.invalid-path"
:gen/gen (sg/generator :string)
:decode/string fs/path
::oapi/type "string"
::oapi/format "unix-path"
::oapi/decode fs/path}})
::oapi/format "unix-path"}})

10
backend/src/app/util/time.clj
View file

@ -374,7 +374,10 @@
:type-properties
{:error/message "should be an instant"
:title "instant"
::sm/decode instant
:decode/string instant
:encode/string format-instant
:decode/json instant
:encode/json format-instant
:gen/gen (tgen/fmap (fn [i] (in-past i)) tgen/pos-int)
::oapi/type "string"
::oapi/format "iso"}})
@ -386,6 +389,9 @@
{:error/message "should be a duration"
:gen/gen (tgen/fmap duration tgen/pos-int)
:title "duration"
::sm/decode duration
:decode/string duration
:encode/string format-duration
:decode/json duration
:encode/json format-duration
::oapi/type "string"
::oapi/format "duration"}})

52
backend/test/backend_tests/rpc_file_test.clj
View file

@ -25,6 +25,20 @@
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(defn- update-file!
[& {:keys [profile-id file-id changes revn] :or {revn 0}}]
(let [params {::th/type :update-file
::rpc/profile-id profile-id
:id file-id
:session-id (uuid/random)
:revn revn
:features cfeat/supported-features
:changes changes}
out (th/command! params)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(:result out)))
(t/deftest files-crud
(let [prof (th/create-profile* 1 {:is-active true})
team-id (:default-team-id prof)
@ -569,18 +583,18 @@
(t/is (nil? (:error out)))
(:result out)))
(update-file! [& {:keys [profile-id file-id changes revn] :or {revn 0}}]
(let [params {::th/type :update-file
::rpc/profile-id profile-id
:id file-id
:session-id (uuid/random)
:revn revn
:features cfeat/supported-features
:changes changes}
out (th/command! params)]
#_(update-file! [& {:keys [profile-id file-id changes revn] :or {revn 0}}]
(let [params {::th/type :update-file
::rpc/profile-id profile-id
:id file-id
:session-id (uuid/random)
:revn revn
:features cfeat/supported-features
:changes changes}
out (th/command! params)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(:result out)))]
(t/is (nil? (:error out)))
(:result out)))]
(let [storage (:app.storage/storage th/*system*)
profile (th/create-profile* 1)
@ -604,7 +618,6 @@
:frame-id frame-id-2)]
;; Add a two frames
(update-file!
:file-id (:id file)
:profile-id (:id profile)
@ -1214,21 +1227,6 @@
(let [rows (th/db-query :file-thumbnail {:file-id (:id file)})]
(t/is (= 1 (count rows)))))))
(defn- update-file!
[& {:keys [profile-id file-id changes revn] :or {revn 0}}]
(let [params {::th/type :update-file
::rpc/profile-id profile-id
:id file-id
:session-id (uuid/random)
:revn revn
:features cfeat/supported-features
:changes changes}
out (th/command! params)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(:result out)))
(t/deftest file-tiered-storage
(let [profile (th/create-profile* 1)
file (th/create-file* 1 {:profile-id (:id profile)

1
backend/test/backend_tests/rpc_team_test.clj
View file

@ -260,6 +260,7 @@
(th/reset-mock! mock)
(let [data (assoc data :emails [(:email profile2)])
out (th/command! data)]
;; (th/print-result! out)
(t/is (th/success? out))
(t/is (= 0 (:call-count (deref mock)))))

1
backend/test/backend_tests/rpc_webhooks_test.clj
View file

@ -166,7 +166,6 @@
out9 (th/command! params)]
(t/is (= 8 (:call-count @http-mock)))
(t/is (nil? (:error out1)))
(t/is (nil? (:error out2)))
(t/is (nil? (:error out3)))

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

@ -89,7 +89,7 @@
{:title "FileFeatures"
::smdj/inline true
:gen/gen (smg/subseq supported-features)}
::sm/set-of-strings])
[::sm/set :string]])
(defn- flag->feature
"Translate a flag to a feature name"

103
common/src/app/common/geom/matrix.cljc
View file

@ -67,16 +67,6 @@
([a b c d e f]
(pos->Matrix a b c d e f)))
(def number-regex
#"[+-]?\d*(\.\d+)?([eE][+-]?\d+)?")
(defn str->matrix
[matrix-str]
(let [params (->> (re-seq number-regex matrix-str)
(filter #(-> % first seq))
(map (comp d/parse-double first)))]
(apply matrix params)))
(def ^:private schema:matrix-attrs
[:map {:title "MatrixAttrs"}
[:a ::sm/safe-double]
@ -87,41 +77,70 @@
[:f ::sm/safe-double]])
(def valid-matrix?
(sm/lazy-validator
(sm/validator
[:and [:fn matrix?] schema:matrix-attrs]))
(sm/register! ::matrix
(letfn [(decode [o]
(if (map? o)
(map->Matrix o)
(if (string? o)
(str->matrix o)
o)))
(encode [o]
(dm/str (dm/get-prop o :a) ","
(dm/get-prop o :b) ","
(dm/get-prop o :c) ","
(dm/get-prop o :d) ","
(dm/get-prop o :e) ","
(dm/get-prop o :f) ","))]
(defn matrix-generator
[]
(->> (sg/tuple (sg/small-double)
(sg/small-double)
(sg/small-double)
(sg/small-double)
(sg/small-double)
(sg/small-double))
(sg/fmap #(apply pos->Matrix %))))
{:type ::matrix
:pred valid-matrix?
:type-properties
{:title "matrix"
:description "Matrix instance"
:error/message "expected a valid point"
:gen/gen (->> (sg/tuple (sg/small-double)
(sg/small-double)
(sg/small-double)
(sg/small-double)
(sg/small-double)
(sg/small-double))
(sg/fmap #(apply pos->Matrix %)))
::oapi/type "string"
::oapi/format "matrix"
::oapi/decode decode
::oapi/encode encode}}))
(def ^:private number-regex
#"[+-]?\d*(\.\d+)?([eE][+-]?\d+)?")
(defn str->matrix
[matrix-str]
(let [params (->> (re-seq number-regex matrix-str)
(filter #(-> % first seq))
(map (comp d/parse-double first)))]
(apply matrix params)))
(defn- matrix->str
[o]
(if (matrix? o)
(dm/str (dm/get-prop o :a) ","
(dm/get-prop o :b) ","
(dm/get-prop o :c) ","
(dm/get-prop o :d) ","
(dm/get-prop o :e) ","
(dm/get-prop o :f) ",")
o))
(defn- matrix->json
[o]
(if (matrix? o)
(into {} o)
o))
(defn- decode-matrix
[o]
(if (map? o)
(map->Matrix o)
(if (string? o)
(str->matrix o)
o)))
(def schema:matrix
{:type :map
:pred valid-matrix?
:type-properties
{:title "matrix"
:description "Matrix instance"
:error/message "expected a valid matrix instance"
:gen/gen (matrix-generator)
:decode/json decode-matrix
:decode/string decode-matrix
:encode/json matrix->json
:encode/string matrix->str
::oapi/type "string"
::oapi/format "matrix"}})
(sm/register! ::matrix schema:matrix)
;; FIXME: deprecated
(s/def ::a ::us/safe-float)

64
common/src/app/common/geom/point.cljc
View file

@ -51,41 +51,55 @@
(s/def ::point
(s/and ::point-attrs point?))
(def ^:private schema:point-attrs
[:map {:title "PointAttrs"}
[:x ::sm/safe-number]
[:y ::sm/safe-number]])
(def valid-point?
(sm/lazy-validator
(sm/validator
[:and [:fn point?] schema:point-attrs]))
(sm/register! ::point
(letfn [(decode [p]
(if (map? p)
(map->Point p)
(if (string? p)
(let [[x y] (->> (str/split p #",") (mapv parse-double))]
(pos->Point x y))
p)))
(defn decode-point
[p]
(if (map? p)
(map->Point p)
(if (string? p)
(let [[x y] (->> (str/split p #",") (mapv parse-double))]
(pos->Point x y))
p)))
(encode [p]
(dm/str (dm/get-prop p :x) ","
(dm/get-prop p :y)))]
(defn point->str
[p]
(if (point? p)
(dm/str (dm/get-prop p :x) ","
(dm/get-prop p :y))
p))
{:type ::point
:pred valid-point?
:type-properties
{:title "point"
:description "Point"
:error/message "expected a valid point"
:gen/gen (->> (sg/tuple (sg/small-int) (sg/small-int))
(sg/fmap #(apply pos->Point %)))
::oapi/type "string"
::oapi/format "point"
::oapi/decode decode
::oapi/encode encode}}))
(defn point->json
[p]
(if (point? p)
(into {} p)
p))
;; FIXME: make like matrix
(def schema:point
{:type :map
:pred valid-point?
:type-properties
{:title "point"
:description "Point"
:error/message "expected a valid point"
:gen/gen (->> (sg/tuple (sg/small-int) (sg/small-int))
(sg/fmap #(apply pos->Point %)))
::oapi/type "string"
::oapi/format "point"
:decode/json decode-point
:decode/string decode-point
:encode/json point->json
:encode/string point->str}})
(sm/register! ::point schema:point)
(defn point-like?
[{:keys [x y] :as v}]

41
common/src/app/common/geom/rect.cljc
View file

@ -80,19 +80,38 @@
[:x2 ::sm/safe-number]
[:y2 ::sm/safe-number]])
(sm/register! ::rect
[:and
{:gen/gen (->> (sg/tuple (sg/small-double)
(sg/small-double)
(sg/small-double)
(sg/small-double))
(sg/fmap #(apply make-rect %)))}
[:fn rect?]
schema:rect-attrs])
(defn- rect-generator
[]
(->> (sg/tuple (sg/small-double)
(sg/small-double)
(sg/small-double)
(sg/small-double))
(sg/fmap #(apply make-rect %))))
(defn- decode-rect
[o]
(if (map? o)
(map->Rect o)
o))
(defn- rect->json
[o]
(if (rect? o)
(into {} o)
o))
(def schema:rect
[:and {:error/message "errors.invalid-rect"
:gen/gen (rect-generator)
:decode/json {:leave decode-rect}
:encode/json rect->json}
schema:rect-attrs
[:fn rect?]])
(def valid-rect?
(sm/lazy-validator
[:and [:fn rect?] schema:rect-attrs]))
(sm/validator schema:rect))
(sm/register! ::rect schema:rect)
(def empty-rect
(make-rect 0 0 0.01 0.01))

4
common/src/app/common/json.cljc
View file

@ -7,8 +7,8 @@
(ns app.common.json
(:refer-clojure :exclude [read])
(:require
[cuerdas.core :as str]
#?(:clj [clojure.data.json :as j])))
#?(:clj [clojure.data.json :as j])
[cuerdas.core :as str]))
#?(:clj

567
common/src/app/common/schema.cljc
View file

@ -5,7 +5,7 @@
;; Copyright (c) KALEIDOS INC
(ns app.common.schema
(:refer-clojure :exclude [deref merge parse-uuid])
(:refer-clojure :exclude [deref merge parse-uuid parse-long parse-double parse-boolean])
#?(:cljs (:require-macros [app.common.schema :refer [ignoring]]))
(:require
[app.common.data :as d]
@ -113,34 +113,49 @@
[schema]
(mu/optional-keys schema default-options))
(def default-transformer
(let [default-decoder
{:compile (fn [s _registry]
(let [props (m/type-properties s)]
(or (::oapi/decode props)
(::decode props))))}
(defn transformer
[& transformers]
(apply mt/transformer transformers))
default-encoder
{:compile (fn [s _]
(let [props (m/type-properties s)]
(or (::oapi/encode props)
(::encode props))))}
;; (defn key-transformer
;; [& {:as opts}]
;; (mt/key-transformer opts))
coders {:vector mt/-sequential-or-set->vector
:sequential mt/-sequential-or-set->seq
:set mt/-sequential->set
:tuple mt/-sequential->vector}]
;; (defn- transform-map-keys
;; [f o]
;; (cond
;; (record? o)
;; (reduce-kv (fn [res k v]
;; (let [k' (f k)]
;; (if (= k k')
;; res
;; (-> res
;; (assoc k' v)
;; (dissoc k)))))
;; o
;; o)
(mt/transformer
{:name :penpot
:default-decoder default-decoder
:default-encoder default-encoder}
{:name :string
:decoders (mt/-string-decoders)
:encoders (mt/-string-encoders)}
{:name :collections
:decoders coders
:encoders coders})))
;; (map? o)
;; (persistent!
;; (reduce-kv (fn [res k v]
;; (assoc! res (f k) v))
;; (transient {})
;; o))
;; :else
;; o))
(defn json-transformer
[]
(mt/transformer
(mt/json-transformer)
(mt/collection-transformer)))
(defn string-transformer
[]
(mt/transformer
(mt/string-transformer)
(mt/collection-transformer)))
(defn encode
([s val transformer]
@ -149,8 +164,6 @@
(m/encode s val options transformer)))
(defn decode
([s val]
(m/decode s val default-options default-transformer))
([s val transformer]
(m/decode s val default-options transformer))
([s val options transformer]
@ -170,9 +183,8 @@
(defn encoder
([s]
(if (lazy-schema? s)
(-get-decoder s)
(encoder s default-options default-transformer)))
(assert (lazy-schema? s) "expected lazy schema")
(-get-decoder s))
([s transformer]
(m/encoder s default-options transformer))
([s options transformer]
@ -180,9 +192,8 @@
(defn decoder
([s]
(if (lazy-schema? s)
(-get-decoder s)
(decoder s default-options default-transformer)))
(assert (lazy-schema? s) "expected lazy schema")
(-get-decoder s))
([s transformer]
(m/decoder s default-options transformer))
([s options transformer]
@ -199,10 +210,9 @@
(fn [v] (@vfn v))))
(defn lazy-decoder
([s] (lazy-decoder s default-transformer))
([s transformer]
(let [vfn (delay (decoder (if (delay? s) (deref s) s) transformer))]
(fn [v] (@vfn v)))))
[s transformer]
(let [vfn (delay (decoder (if (delay? s) (deref s) s) transformer))]
(fn [v] (@vfn v))))
(defn humanize-explain
"Returns a string representation of the explain data structure"
@ -244,27 +254,6 @@
`(try ~expr (catch :default e# nil))
`(try ~expr (catch Throwable e# nil))))
(defn simple-schema
[& {:keys [pred] :as options}]
(cond-> options
(contains? options :type-properties)
(update :type-properties (fn [props]
(cond-> props
(contains? props :decode/string)
(update :decode/string (fn [decode-fn]
(fn [s]
(if (pred s)
s
(or (ignoring (decode-fn s)) s)))))
(contains? props ::decode)
(update ::decode (fn [decode-fn]
(fn [s]
(if (pred s)
s
(or (ignoring (decode-fn s)) s))))))))
:always
(m/-simple-schema)))
(defn lookup
"Lookups schema from registry."
([s] (lookup sr/default-registry s))
@ -308,7 +297,6 @@
::explain explain}))))
true)))
(defn fast-validate!
"A fast path for validation process, assumes the ILazySchema protocol
implemented on the provided `s` schema. Sould not be used directly."
@ -353,19 +341,18 @@
params))
(defn register! [type s]
(let [s (if (map? s) (simple-schema s) s)]
(let [s (if (map? s) (m/-simple-schema s) s)]
(swap! sr/registry assoc type s)
nil))
(defn define
"Create ans instance of ILazySchema"
[s & {:keys [transformer] :as options}]
[s & {:keys [transformer] :or {transformer json-transformer} :as options}]
(let [schema (delay (schema s))
validator (delay (m/validator @schema))
explainer (delay (m/explainer @schema))
options (c/merge default-options (dissoc options :transformer))
transformer (or transformer default-transformer)
decoder (delay (m/decoder @schema options transformer))
encoder (delay (m/encoder @schema options transformer))]
@ -449,9 +436,12 @@
:description "UUID formatted string"
:error/message "should be an uuid"
:gen/gen (sg/uuid)
:decode/string parse-uuid
:decode/json parse-uuid
:encode/string str
:encode/json str
::oapi/type "string"
::oapi/format "uuid"
::oapi/decode parse-uuid}})
::oapi/format "uuid"}})
(def email-re #"[a-zA-Z0-9_.+-\\\\]+@[a-zA-Z0-9-]+\.[a-zA-Z0-9-.]+")
@ -481,11 +471,10 @@
:description "string with valid email address"
:error/code "errors.invalid-email"
:gen/gen (sg/email)
:decode/string (fn [v] (or (parse-email v) v))
:decode/json (fn [v] (or (parse-email v) v))
::oapi/type "string"
::oapi/format "email"
::oapi/decode
(fn [v]
(or (parse-email v) v))}})
::oapi/format "email"}})
(def non-empty-strings-xf
(comp
@ -505,36 +494,59 @@
(comp non-empty-strings-xf (map coerce))
non-empty-strings-xf)
kind (or (last children) kind)
pred (cond
(fn? kind) kind
(nil? kind) any?
:else (validator kind))
pred (cond
(and max min)
(fn [value]
(let [size (count value)]
(and (set? value)
(<= min size max)
(every? pred value))))
pred
(cond
(fn? kind) kind
(nil? kind) any?
:else (validator kind))
min
(fn [value]
(let [size (count value)]
(and (set? value)
(<= min size)
(every? pred value))))
encode-child
(encoder kind string-transformer)
max
(fn [value]
(let [size (count value)]
(and (set? value)
(<= size max)
(every? pred value))))
pred
(cond
(and max min)
(fn [value]
(let [size (count value)]
(and (set? value)
(<= min size max)
(every? pred value))))
:else
(fn [value]
(every? pred value)))]
min
(fn [value]
(let [size (count value)]
(and (set? value)
(<= min size)
(every? pred value))))
max
(fn [value]
(let [size (count value)]
(and (set? value)
(<= size max)
(every? pred value))))
:else
(fn [value]
(every? pred value)))
decode
(fn [v]
(let [v (if (string? v) (str/split v #"[\s,]+") v)]
(into #{} xform v)))
encode-json
(fn [o]
(if (set? o)
(vec o)
o))
encode-string
(fn [o]
(if (set? o)
(str/join ", " (map encode-child o))
o))]
{:pred pred
:type-properties
@ -542,13 +554,14 @@
:description "Set of Strings"
:error/message "should be a set of strings"
:gen/gen (-> kind sg/generator sg/set)
:decode/string decode
:decode/json decode
:encode/string encode-string
:encode/json encode-json
::oapi/type "array"
::oapi/format "set"
::oapi/items {:type "string"}
::oapi/unique-items true
::oapi/decode (fn [v]
(let [v (if (string? v) (str/split v #"[\s,]+") v)]
(into #{} xform v)))}}))})
::oapi/unique-items true}}))})
(register! ::vec
@ -562,36 +575,52 @@
non-empty-strings-xf)
kind (or (last children) kind)
pred (cond
(fn? kind) kind
(nil? kind) any?
:else (validator kind))
pred
(cond
(fn? kind) kind
(nil? kind) any?
:else (validator kind))
pred (cond
(and max min)
(fn [value]
(let [size (count value)]
(and (set? value)
(<= min size max)
(every? pred value))))
encode-child
(encoder kind string-transformer)
min
(fn [value]
(let [size (count value)]
(and (set? value)
(<= min size)
(every? pred value))))
pred
(cond
(and max min)
(fn [value]
(let [size (count value)]
(and (set? value)
(<= min size max)
(every? pred value))))
max
(fn [value]
(let [size (count value)]
(and (set? value)
(<= size max)
(every? pred value))))
min
(fn [value]
(let [size (count value)]
(and (set? value)
(<= min size)
(every? pred value))))
:else
(fn [value]
(every? pred value)))]
max
(fn [value]
(let [size (count value)]
(and (set? value)
(<= size max)
(every? pred value))))
:else
(fn [value]
(every? pred value)))
decode
(fn [v]
(let [v (if (string? v) (str/split v #"[\s,]+") v)]
(into [] xform v)))
encode-string
(fn [o]
(if (vector? o)
(str/join ", " (map encode-child o))
o))]
{:pred pred
:type-properties
@ -599,14 +628,13 @@
:description "Set of Strings"
:error/message "should be a set of strings"
:gen/gen (-> kind sg/generator sg/set)
:decode/string decode
:decode/json decode
:encode/string encode-string
::oapi/type "array"
::oapi/format "set"
::oapi/items {:type "string"}
::oapi/unique-items true
::oapi/decode (fn [v]
(let [v (if (string? v) (str/split v #"[\s,]+") v)]
(into [] xform v)))}}))})
::oapi/unique-items true}}))})
(register! ::set-of-strings
{:type ::set-of-strings
@ -616,13 +644,13 @@
:description "Set of Strings"
:error/message "should be a set of strings"
:gen/gen (-> :string sg/generator sg/set)
:decode/string (fn [v]
(let [v (if (string? v) (str/split v #"[\s,]+") v)]
(into #{} non-empty-strings-xf v)))
::oapi/type "array"
::oapi/format "set"
::oapi/items {:type "string"}
::oapi/unique-items true
::oapi/decode (fn [v]
(let [v (if (string? v) (str/split v #"[\s,]+") v)]
(into #{} non-empty-strings-xf v)))}})
::oapi/unique-items true}})
(register! ::set-of-keywords
{:type ::set-of-keywords
@ -632,29 +660,13 @@
:description "Set of Strings"
:error/message "should be a set of strings"
:gen/gen (-> :keyword sg/generator sg/set)
:decode/string (fn [v]
(let [v (if (string? v) (str/split v #"[\s,]+") v)]
(into #{} (comp non-empty-strings-xf (map keyword)) v)))
::oapi/type "array"
::oapi/format "set"
::oapi/items {:type "string" :format "keyword"}
::oapi/unique-items true
::oapi/decode (fn [v]
(let [v (if (string? v) (str/split v #"[\s,]+") v)]
(into #{} (comp non-empty-strings-xf (map keyword)) v)))}})
(register! ::set-of-emails
{:type ::set-of-emails
:pred #(and (set? %) (every? string? %))
:type-properties
{:title "set[email]"
:description "Set of Emails"
:error/message "should be a set of emails"
:gen/gen (-> ::email sg/generator sg/set)
::oapi/type "array"
::oapi/format "set"
::oapi/items {:type "string" :format "email"}
::oapi/unique-items true
::decode (fn [v]
(let [v (if (string? v) (str/split v #"[\s,]+") v)]
(into #{} (keep parse-email) v)))}})
::oapi/unique-items true}})
(register! ::set-of-uuid
{:type ::set-of-uuid
@ -664,13 +676,13 @@
:description "Set of UUID"
:error/message "should be a set of UUID instances"
:gen/gen (-> ::uuid sg/generator sg/set)
:decode/string (fn [v]
(let [v (if (string? v) (str/split v #"[\s,]+") v)]
(into #{} (keep parse-uuid) v)))
::oapi/type "array"
::oapi/format "set"
::oapi/items {:type "string" :format "uuid"}
::oapi/unique-items true
::oapi/decode (fn [v]
(let [v (if (string? v) (str/split v #"[\s,]+") v)]
(into #{} (keep parse-uuid) v)))}})
::oapi/unique-items true}})
(register! ::coll-of-uuid
{:type ::set-of-uuid
@ -680,13 +692,13 @@
:description "Coll of UUID"
:error/message "should be a coll of UUID instances"
:gen/gen (-> ::uuid sg/generator sg/set)
:decode/string (fn [v]
(let [v (if (string? v) (str/split v #"[\s,]+") v)]
(into [] (keep parse-uuid) v)))
::oapi/type "array"
::oapi/format "array"
::oapi/items {:type "string" :format "uuid"}
::oapi/unique-items false
::oapi/decode (fn [v]
(let [v (if (string? v) (str/split v #"[\s,]+") v)]
(into [] (keep parse-uuid) v)))}})
::oapi/unique-items false}})
(register! ::one-of
{:type ::one-of
@ -694,70 +706,168 @@
:max 1
:compile (fn [props children _]
(let [options (into #{} (last children))
format (:format props "keyword")]
format (:format props "keyword")
decode (if (= format "keyword")
keyword
identity)]
{:pred #(contains? options %)
:type-properties
{:title "one-of"
:description "One of the Set"
:gen/gen (sg/elements options)
:decode/string decode
:decode/json decode
::oapi/type "string"
::oapi/format (:format props "keyword")
::oapi/decode (if (= format "keyword")
keyword
identity)}}))})
::oapi/format (:format props "keyword")}}))})
;; Integer/MAX_VALUE
(def max-safe-int 2147483647)
;; Integer/MIN_VALUE
(def min-safe-int -2147483648)
(register! ::safe-int
{:type ::safe-int
:pred #(and (int? %) (>= max-safe-int %) (>= % min-safe-int))
:type-properties
{:title "int"
:description "Safe Integer"
:error/message "expected to be int in safe range"
:gen/gen (sg/small-int)
::oapi/type "integer"
::oapi/format "int64"
::oapi/decode (fn [s]
(if (string? s)
(parse-long s)
s))}})
(defn parse-long
[v]
(or (ignoring
(if (string? v)
(c/parse-long v)
v))
v))
(register! ::safe-number
{:type ::safe-number
:pred #(and (number? %) (>= max-safe-int %) (>= % min-safe-int))
:type-properties
{:title "number"
:description "Safe Number"
:error/message "expected to be number in safe range"
:gen/gen (sg/one-of (sg/small-int)
(sg/small-double))
::oapi/type "number"
::oapi/format "double"
::oapi/decode (fn [s]
(if (string? s)
(parse-double s)
s))}})
(def type:int
{:type :int
:min 0
:max 0
:compile
(fn [{:keys [max min] :as props} _ _]
(let [pred int?
pred (if (some? min)
(fn [v]
(and (>= v min)
(pred v)))
pred)
pred (if (some? max)
(fn [v]
(and (>= max v)
(pred v)))
pred)]
(register! ::safe-double
{:type ::safe-double
:pred #(and (double? %) (>= max-safe-int %) (>= % min-safe-int))
:type-properties
{:title "number"
:description "Safe Number"
:error/message "expected to be number in safe range"
:gen/gen (sg/small-double)
::oapi/type "number"
::oapi/format "double"
::oapi/decode (fn [s]
(if (string? s)
(parse-double s)
s))}})
{:pred pred
:type-properties
{:title "int"
:description "int"
:error/message "expected to be int/long"
:error/code "errors.invalid-integer"
:gen/gen (sg/small-int :max max :min min)
:decode/string parse-long
:decode/json parse-long
::oapi/type "integer"
::oapi/format "int64"}}))})
(register! ::contains-any
(defn parse-double
[v]
(or (ignoring
(if (string? v)
(c/parse-double v)
v))
v))
(def type:double
{:type :double
:min 0
:max 0
:compile
(fn [{:keys [max min] :as props} _ _]
(let [pred double?
pred (if (some? min)
(fn [v]
(and (>= v min)
(pred v)))
pred)
pred (if (some? max)
(fn [v]
(and (>= max v)
(pred v)))
pred)]
{:pred pred
:type-properties
{:title "doble"
:description "double number"
:error/message "expected to be double"
:error/code "errors.invalid-double"
:gen/gen (sg/small-double :max max :min min)
:decode/string parse-double
:decode/json parse-double
::oapi/type "number"
::oapi/format "double"}}))})
(def type:number
{:type :number
:min 0
:max 0
:compile
(fn [{:keys [max min] :as props} _ _]
(let [pred number?
pred (if (some? min)
(fn [v]
(and (>= v min)
(pred v)))
pred)
pred (if (some? max)
(fn [v]
(and (>= max v)
(pred v)))
pred)
gen (sg/one-of
(sg/small-int :max max :min min)
(sg/small-double :max max :min min))]
{:pred pred
:type-properties
{:title "int"
:description "int"
:error/message "expected to be number"
:error/code "errors.invalid-number"
:gen/gen gen
:decode/string parse-double
:decode/json parse-double
::oapi/type "number"}}))})
(register! ::int type:int)
(register! ::double type:double)
(register! ::number type:number)
(register! ::safe-int [::int {:max max-safe-int :min min-safe-int}])
(register! ::safe-double [::double {:max max-safe-int :min min-safe-int}])
(register! ::safe-number [::number {:max max-safe-int :min min-safe-int}])
(defn parse-boolean
[v]
(if (string? v)
(case v
("true" "t" "1") true
("false" "f" "0") false
v)
v))
(def type:boolean
{:type :boolean
:pred boolean?
:type-properties
{:title "boolean"
:description "boolean"
:error/message "expected boolean"
:error/code "errors.invalid-boolean"
:gen/gen sg/boolean
:decode/string parse-boolean
:decode/json parse-boolean
:encode/string str
::oapi/type "boolean"}})
(register! ::boolean type:boolean)
(def type:contains-any
{:type ::contains-any
:min 1
:max 1
@ -775,17 +885,26 @@
{:title "contains"
:description "contains predicate"}}))})
(register! ::inst
(register! ::contains-any type:contains-any)
(def type:inst
{:type ::inst
:pred inst?
:type-properties
{:title "inst"
:description "Satisfies Inst protocol"
:error/message "expected to be number in safe range"
:error/message "should be an instant"
:gen/gen (->> (sg/small-int)
(sg/fmap (fn [v] (tm/instant v))))
::oapi/type "number"
::oapi/format "int64"}})
:decode/string tm/instant
:encode/string tm/format-instant
:decode/json tm/instant
:encode/json tm/format-instant
::oapi/type "string"
::oapi/format "iso"}})
(register! ::inst type:inst)
(register! ::fn
[:schema fn?])
@ -804,6 +923,13 @@
::oapi/type "string"
::oapi/format "string"}})
(defn decode-uri
[val]
(if (u/uri? val)
val
(-> val str/trim u/uri)))
(register! ::uri
{:type ::uri
:pred u/uri?
@ -839,13 +965,10 @@
:description "URI formatted string"
:error/code "errors.invalid-uri"
:gen/gen (sg/uri)
:decode/string decode-uri
:decode/json decode-uri
::oapi/type "string"
::oapi/format "uri"
::oapi/decode
(fn [val]
(if (u/uri? val)
val
(-> val str/trim u/uri)))}})
::oapi/format "uri"}})
(register! ::text
{:type :string
@ -926,4 +1049,4 @@
(check-fn ::set-of-uuid))
(def check-set-of-emails!
(check-fn ::set-of-emails))
(check-fn [::set ::email]))

5
common/src/app/common/schema/generators.cljc
View file

@ -5,7 +5,7 @@
;; Copyright (c) KALEIDOS INC
(ns app.common.schema.generators
(:refer-clojure :exclude [set subseq uuid for filter map let])
(:refer-clojure :exclude [set subseq uuid for filter map let boolean])
#?(:cljs (:require-macros [app.common.schema.generators]))
(:require
[app.common.schema.registry :as sr]
@ -122,6 +122,9 @@
(c/map second))
(c/map list bools elements)))))))
(def any tg/any)
(def boolean tg/boolean)
(defn set
[g]
(tg/set g))

18
common/src/app/common/time.cljc
View file

@ -5,13 +5,14 @@
;; Copyright (c) KALEIDOS INC
(ns app.common.time
"A new cross-platform date and time API. It should be preferred over
a platform specific implementation found on `app.util.time`."
"Minimal cross-platoform date time api for specific use cases on types
definition and other common code."
#?(:cljs
(:require
["luxon" :as lxn])
:clj
(:import
java.time.format.DateTimeFormatter
java.time.Instant
java.time.Duration)))
@ -28,8 +29,16 @@
(defn instant
[s]
#?(:clj (Instant/ofEpochMilli s)
:cljs (.fromMillis ^js DateTime s #js {:zone "local" :setZone false})))
(if (int? s)
#?(:clj (Instant/ofEpochMilli s)
:cljs (.fromMillis ^js DateTime s #js {:zone "local" :setZone false}))
#?(:clj (Instant/parse s)
:cljs (.fromISO ^js DateTime s))))
(defn format-instant
[v]
#?(:clj (.format DateTimeFormatter/ISO_INSTANT ^Instant v)
:cljs (.toISO ^js v)))
#?(:cljs
(extend-protocol IComparable
@ -45,7 +54,6 @@
0
(if (< (inst-ms it) (inst-ms other)) -1 1)))))
#?(:cljs
(extend-type DateTime
cljs.core/IEquiv

76
common/src/app/common/types/color.cljc
View file

@ -9,48 +9,51 @@
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.schema :as sm]
[app.common.schema.generators :as sg]
[app.common.schema.openapi :as-alias oapi]
[app.common.text :as txt]
[app.common.types.color.generic :as-alias color-generic]
[app.common.types.color.gradient :as-alias color-gradient]
[app.common.types.color.gradient.stop :as-alias color-gradient-stop]
[app.common.types.plugins :as ctpg]
[app.common.uuid :as uuid]
[clojure.test.check.generators :as tgen]
[cuerdas.core :as str]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SCHEMAS
;; SCHEMAS & TYPES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def rgb-color-re
#"^#(?:[0-9a-fA-F]{3}){1,2}$")
(defn- random-rgb-color
(defn- generate-rgb-color
[]
#?(:clj (format "#%06x" (rand-int 16rFFFFFF))
:cljs
(let [r (rand-int 255)
g (rand-int 255)
b (rand-int 255)]
(str "#"
(.. r (toString 16) (padStart 2 "0"))
(.. g (toString 16) (padStart 2 "0"))
(.. b (toString 16) (padStart 2 "0"))))))
(sg/fmap (fn [_]
#?(:clj (format "#%06x" (rand-int 16rFFFFFF))
:cljs
(let [r (rand-int 255)
g (rand-int 255)
b (rand-int 255)]
(str "#"
(.. r (toString 16) (padStart 2 "0"))
(.. g (toString 16) (padStart 2 "0"))
(.. b (toString 16) (padStart 2 "0"))))))
sg/any))
(sm/register! ::rgb-color
{:type ::rgb-color
:pred #(and (string? %) (some? (re-matches rgb-color-re %)))
(defn rgb-color-string?
[o]
(and (string? o) (some? (re-matches rgb-color-re o))))
(def ^:private type:rgb-color
{:type :string
:pred rgb-color-string?
:type-properties
{:title "rgb-color"
:description "RGB Color String"
:error/message "expected a valid RGB color"
:gen/gen (->> tgen/any (tgen/fmap (fn [_] (random-rgb-color))))
:error/code "errors.invalid-rgb-color"
:gen/gen (generate-rgb-color)
::oapi/type "integer"
::oapi/format "int64"}})
(sm/register! ::image-color
(def schema:image-color
[:map {:title "ImageColor"}
[:name {:optional true} :string]
[:width :int]
@ -59,7 +62,10 @@
[:id ::sm/uuid]
[:keep-aspect-ratio {:optional true} :boolean]])
(sm/register! ::gradient
(def gradient-types
#{:linear :radial})
(def schema:gradient
[:map {:title "Gradient"}
[:type [::sm/one-of #{:linear :radial}]]
[:start-x ::sm/safe-number]
@ -74,7 +80,7 @@
[:opacity {:optional true} [:maybe ::sm/safe-number]]
[:offset ::sm/safe-number]]]]])
(sm/register! ::color
(def schema:color
[:and
[:map {:title "Color"}
[:id {:optional true} ::sm/uuid]
@ -86,26 +92,32 @@
[:modified-at {:optional true} ::sm/inst]
[:ref-id {:optional true} ::sm/uuid]
[:ref-file {:optional true} ::sm/uuid]
[:gradient {:optional true} [:maybe ::gradient]]
[:image {:optional true} [:maybe ::image-color]]
[:plugin-data {:optional true}
[:map-of {:gen/max 5} :keyword ::ctpg/plugin-data]]]
[:gradient {:optional true} [:maybe schema:gradient]]
[:image {:optional true} [:maybe schema:image-color]]
[:plugin-data {:optional true} ::ctpg/plugin-data]]
[::sm/contains-any {:strict true} [:color :gradient :image]]])
(sm/register! ::recent-color
(def schema:recent-color
[:and
[:map {:title "RecentColor"}
[:opacity {:optional true} [:maybe ::sm/safe-number]]
[:color {:optional true} [:maybe ::rgb-color]]
[:gradient {:optional true} [:maybe ::gradient]]
[:image {:optional true} [:maybe ::image-color]]]
[:gradient {:optional true} [:maybe schema:gradient]]
[:image {:optional true} [:maybe schema:image-color]]]
[::sm/contains-any {:strict true} [:color :gradient :image]]])
(sm/register! ::rgb-color type:rgb-color)
(sm/register! ::color schema:color)
(sm/register! ::gradient schema:gradient)
(sm/register! ::image-color schema:image-color)
(sm/register! ::recent-color schema:recent-color)
(def check-color!
(sm/check-fn ::color))
(sm/check-fn schema:color))
(def check-recent-color!
(sm/check-fn ::recent-color))
(sm/check-fn schema:recent-color))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HELPERS

3
common/src/app/common/types/container.cljc
View file

@ -37,8 +37,7 @@
[:modified-at {:optional true} ::sm/inst]
[:objects {:optional true}
[:map-of {:gen/max 10} ::sm/uuid :map]]
[:plugin-data {:optional true}
[:map-of {:gen/max 5} :keyword ::ctpg/plugin-data]]])
[:plugin-data {:optional true} ::ctpg/plugin-data]])
(def check-container!
(sm/check-fn ::container))

3
common/src/app/common/types/file.cljc
View file

@ -59,8 +59,7 @@
[:map-of {:gen/max 2} ::sm/uuid ::cty/typography]]
[:media {:optional true}
[:map-of {:gen/max 5} ::sm/uuid ::media-object]]
[:plugin-data {:optional true}
[:map-of {:gen/max 5} :keyword ::ctpg/plugin-data]]])
[:plugin-data {:optional true} ::ctpg/plugin-data]])
(def check-file-data!
(sm/check-fn ::data))

29
common/src/app/common/types/grid.cljc
View file

@ -13,47 +13,54 @@
;; SCHEMA
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sm/register! ::grid-color
(def schema:grid-color
[:map {:title "PageGridColor"}
[:color ::ctc/rgb-color]
[:opacity ::sm/safe-number]])
(sm/register! ::column-params
(def schema:column-params
[:map
[:color ::grid-color]
[:color schema:grid-color]
[:type {:optional true} [::sm/one-of #{:stretch :left :center :right}]]
[:size {:optional true} [:maybe ::sm/safe-number]]
[:margin {:optional true} [:maybe ::sm/safe-number]]
[:item-length {:optional true} [:maybe ::sm/safe-number]]
[:gutter {:optional true} [:maybe ::sm/safe-number]]])
(sm/register! ::square-params
(def schema:square-params
[:map
[:size {:optional true} [:maybe ::sm/safe-number]]
[:color ::grid-color]])
[:color schema:grid-color]])
(sm/register! ::grid
[:multi {:dispatch :type}
(def schema:grid
[:multi {:title "Grid"
:dispatch :type
:decode/json #(update % :type keyword)}
[:column
[:map
[:type [:= :column]]
[:display :boolean]
[:params ::column-params]]]
[:params schema:column-params]]]
[:row
[:map
[:type [:= :row]]
[:display :boolean]
[:params ::column-params]]]
[:params schema:column-params]]]
[:square
[:map
[:type [:= :square]]
[:display :boolean]
[:params ::square-params]]]])
[:params schema:square-params]]]])
(sm/register! ::saved-grids
(def schema:saved-grids
[:map {:title "PageGrid"}
[:square {:optional true} ::square-params]
[:row {:optional true} ::column-params]
[:column {:optional true} ::column-params]])
(sm/register! ::square-params schema:square-params)
(sm/register! ::column-params schema:column-params)
(sm/register! ::grid schema:grid)
(sm/register! ::saved-grids schema:saved-grids)

3
common/src/app/common/types/page.cljc
View file

@ -45,8 +45,7 @@
[:vector {:gen/max 2} ::flow]]
[:guides {:optional true}
[:map-of {:gen/max 2} ::sm/uuid ::guide]]
[:plugin-data {:optional true}
[:map-of {:gen/max 5} :keyword ::ctpg/plugin-data]]]]])
[:plugin-data {:optional true} ::ctpg/plugin-data]]]])
(def check-page-guide!
(sm/check-fn ::guide))

21
common/src/app/common/types/plugins.cljc
View file

@ -6,11 +6,26 @@
(ns app.common.types.plugins
(:require
[app.common.schema :as sm]))
[app.common.schema :as sm]
[app.common.schema.generators :as sg]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SCHEMAS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(sm/register! ::plugin-data
[:map-of {:gen/max 5} :string :string])
(def ^:private schema:string
[:schema {:gen/gen (sg/word-string)} :string])
(def ^:private schema:keyword
[:schema {:gen/gen (->> (sg/word-string)
(sg/fmap keyword))}
:keyword])
(def schema:plugin-data
[:map-of {:gen/max 5}
schema:keyword
[:map-of {:gen/max 5}
schema:string
schema:string]])
(sm/register! ::plugin-data schema:plugin-data)

285
common/src/app/common/types/shape.cljc
View file

@ -86,10 +86,15 @@
:exclude
:intersection})
(sm/register! ::points
(def grow-types
#{:auto-width
:auto-height
:fixed})
(def schema:points
[:vector {:gen/max 4 :gen/min 4} ::gpt/point])
(sm/register! ::fill
(def schema:fill
[:map {:title "Fill"}
[:fill-color {:optional true} ::ctc/rgb-color]
[:fill-opacity {:optional true} ::sm/safe-number]
@ -98,7 +103,9 @@
[:fill-color-ref-id {:optional true} [:maybe ::sm/uuid]]
[:fill-image {:optional true} ::ctc/image-color]])
(sm/register! ::stroke
(sm/register! ::fill schema:fill)
(def ^:private schema:stroke
[:map {:title "Stroke"}
[:stroke-color {:optional true} :string]
[:stroke-color-ref-file {:optional true} ::sm/uuid]
@ -116,43 +123,42 @@
[:stroke-color-gradient {:optional true} ::ctc/gradient]
[:stroke-image {:optional true} ::ctc/image-color]])
(sm/register! ::shape-base-attrs
(sm/register! ::stroke schema:stroke)
(def ^:private schema:shape-base-attrs
[:map {:title "ShapeMinimalRecord"}
[:id ::sm/uuid]
[:name :string]
[:type [::sm/one-of shape-types]]
[:selrect ::grc/rect]
[:points ::points]
[:points schema:points]
[:transform ::gmt/matrix]
[:transform-inverse ::gmt/matrix]
[:parent-id ::sm/uuid]
[:frame-id ::sm/uuid]])
(sm/register! ::shape-geom-attrs
(def ^:private schema:shape-geom-attrs
[:map {:title "ShapeGeometryAttrs"}
[:x ::sm/safe-number]
[:y ::sm/safe-number]
[:width ::sm/safe-number]
[:height ::sm/safe-number]])
(sm/register! ::shape-attrs
(def schema:shape-attrs
[:map {:title "ShapeAttrs"}
[:name {:optional true} :string]
[:component-id {:optional true} ::sm/uuid]
[:component-file {:optional true} ::sm/uuid]
[:component-root {:optional true} :boolean]
[:main-instance {:optional true} :boolean]
[:remote-synced {:optional true} :boolean]
[:shape-ref {:optional true} ::sm/uuid]
[:selrect {:optional true} ::grc/rect]
[:points {:optional true} ::points]
[:blocked {:optional true} :boolean]
[:collapsed {:optional true} :boolean]
[:locked {:optional true} :boolean]
[:hidden {:optional true} :boolean]
[:masked-group {:optional true} :boolean]
[:fills {:optional true}
[:vector {:gen/max 2} ::fill]]
[:vector {:gen/max 2} schema:fill]]
[:hide-fill-on-export {:optional true} :boolean]
[:proportion {:optional true} ::sm/safe-number]
[:proportion-lock {:optional true} :boolean]
@ -167,36 +173,30 @@
[:r2 {:optional true} ::sm/safe-number]
[:r3 {:optional true} ::sm/safe-number]
[:r4 {:optional true} ::sm/safe-number]
[:x {:optional true} [:maybe ::sm/safe-number]]
[:y {:optional true} [:maybe ::sm/safe-number]]
[:width {:optional true} [:maybe ::sm/safe-number]]
[:height {:optional true} [:maybe ::sm/safe-number]]
[:opacity {:optional true} ::sm/safe-number]
[:grids {:optional true}
[:vector {:gen/max 2} ::ctg/grid]]
[:exports {:optional true}
[:vector {:gen/max 2} ::ctse/export]]
[:strokes {:optional true}
[:vector {:gen/max 2} ::stroke]]
[:transform {:optional true} ::gmt/matrix]
[:transform-inverse {:optional true} ::gmt/matrix]
[:blend-mode {:optional true} [::sm/one-of blend-modes]]
[:vector {:gen/max 2} schema:stroke]]
[:blend-mode {:optional true}
[::sm/one-of blend-modes]]
[:interactions {:optional true}
[:vector {:gen/max 2} ::ctsi/interaction]]
[:shadow {:optional true}
[:vector {:gen/max 1} ::ctss/shadow]]
[:blur {:optional true} ::ctsb/blur]
[:grow-type {:optional true}
[::sm/one-of #{:auto-width :auto-height :fixed}]]
[:plugin-data {:optional true}
[:map-of {:gen/max 5} :keyword ::ctpg/plugin-data]]])
[::sm/one-of grow-types]]
[:plugin-data {:optional true} ::ctpg/plugin-data]])
(sm/register! ::group-attrs
(def schema:group-attrs
[:map {:title "GroupAttrs"}
[:type [:= :group]]
[:shapes [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]])
(sm/register! ::frame-attrs
(def ^:private schema:frame-attrs
[:map {:title "FrameAttrs"}
[:type [:= :frame]]
[:shapes [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]
@ -204,166 +204,169 @@
[:show-content {:optional true} :boolean]
[:hide-in-viewer {:optional true} :boolean]])
(sm/register! ::bool-attrs
(def ^:private schema:bool-attrs
[:map {:title "BoolAttrs"}
[:type [:= :bool]]
[:shapes [:vector {:gen/max 10 :gen/min 1} ::sm/uuid]]
[:bool-type [::sm/one-of bool-types]]
[:bool-content ::ctsp/content]])
[:bool-type :keyword]
;; FIXME: This should be the spec but we need to create a migration
;; to make this transition safely
;; [:bool-type [::sm/one-of bool-types]]
[:bool-content
[:vector {:gen/max 2}
[:map
[:command :keyword]
[:relative {:optional true} :boolean]
[:prev-pos {:optional true} ::gpt/point]
[:params {:optional true}
[:maybe
[:map-of {:gen/max 5} :keyword ::sm/safe-number]]]]]]])
(sm/register! ::rect-attrs
(def ^:private schema:rect-attrs
[:map {:title "RectAttrs"}
[:type [:= :rect]]])
(sm/register! ::circle-attrs
(def ^:private schema:circle-attrs
[:map {:title "CircleAttrs"}
[:type [:= :circle]]])
(sm/register! ::svg-raw-attrs
(def ^:private schema:svg-raw-attrs
[:map {:title "SvgRawAttrs"}
[:type [:= :svg-raw]]])
(sm/register! ::image-attrs
(def schema:image-attrs
[:map {:title "ImageAttrs"}
[:type [:= :image]]
[:metadata
[:map
[:width :int]
[:height :int]
[:mtype {:optional true} [:maybe :string]]
[:width {:gen/gen (sg/small-int :min 1)} :int]
[:height {:gen/gen (sg/small-int :min 1)} :int]
[:mtype {:optional true
:gen/gen (sg/elements ["image/jpeg"
"image/png"])}
[:maybe :string]]
[:id ::sm/uuid]]]])
(sm/register! ::path-attrs
(def ^:private schema:path-attrs
[:map {:title "PathAttrs"}
[:type [:= :path]]
[:content ::ctsp/content]])
(sm/register! ::text-attrs
(def ^:private schema:text-attrs
[:map {:title "TextAttrs"}
[:type [:= :text]]
[:content {:optional true} [:maybe ::ctsx/content]]])
(sm/register! ::shape-map
[:multi {:dispatch :type :title "Shape"}
[:group
[:and {:title "GroupShape"}
::shape-base-attrs
::shape-geom-attrs
::shape-attrs
::group-attrs
::ctsl/layout-child-attrs]]
(defn- decode-shape
[o]
(if (map? o)
(map->Shape o)
o))
[:frame
[:and {:title "FrameShape"}
::shape-base-attrs
::shape-geom-attrs
::frame-attrs
::ctsl/layout-attrs
::ctsl/layout-child-attrs]]
(defn- shape-generator
"Get the shape generator."
[]
(->> (sg/generator schema:shape-base-attrs)
(sg/mcat (fn [{:keys [type] :as shape}]
(sg/let [attrs1 (sg/generator schema:shape-attrs)
attrs2 (sg/generator schema:shape-geom-attrs)
attrs3 (case type
:text (sg/generator schema:text-attrs)
:path (sg/generator schema:path-attrs)
:svg-raw (sg/generator schema:svg-raw-attrs)
:image (sg/generator schema:image-attrs)
:circle (sg/generator schema:circle-attrs)
:rect (sg/generator schema:rect-attrs)
:bool (sg/generator schema:bool-attrs)
:group (sg/generator schema:group-attrs)
:frame (sg/generator schema:frame-attrs))]
(if (or (= type :path)
(= type :bool))
(merge attrs1 shape attrs3)
(merge attrs1 shape attrs2 attrs3)))))
(sg/fmap map->Shape)))
[:bool
[:and {:title "BoolShape"}
::shape-base-attrs
::shape-attrs
::bool-attrs
::ctsl/layout-child-attrs]]
(def schema:shape
[:and {:title "Shape"
:gen/gen (shape-generator)
:decode/json {:leave decode-shape}}
[:fn shape?]
[:multi {:dispatch :type
:decode/json (fn [shape]
(update shape :type keyword))
:title "Shape"}
[:group
[:merge {:title "GroupShape"}
::ctsl/layout-child-attrs
schema:group-attrs
schema:shape-attrs
schema:shape-geom-attrs
schema:shape-base-attrs]]
[:rect
[:and {:title "RectShape"}
::shape-base-attrs
::shape-geom-attrs
::shape-attrs
::rect-attrs
::ctsl/layout-child-attrs]]
[:frame
[:merge {:title "FrameShape"}
::ctsl/layout-child-attrs
::ctsl/layout-attrs
schema:frame-attrs
schema:shape-attrs
schema:shape-geom-attrs
schema:shape-base-attrs]]
[:circle
[:and {:title "CircleShape"}
::shape-base-attrs
::shape-geom-attrs
::shape-attrs
::circle-attrs
::ctsl/layout-child-attrs]]
[:bool
[:merge {:title "BoolShape"}
::ctsl/layout-child-attrs
schema:bool-attrs
schema:shape-attrs
schema:shape-base-attrs]]
[:image
[:and {:title "ImageShape"}
::shape-base-attrs
::shape-geom-attrs
::shape-attrs
::image-attrs
::ctsl/layout-child-attrs]]
[:rect
[:merge {:title "RectShape"}
::ctsl/layout-child-attrs
schema:rect-attrs
schema:shape-attrs
schema:shape-geom-attrs
schema:shape-base-attrs]]
[:svg-raw
[:and {:title "SvgRawShape"}
::shape-base-attrs
::shape-geom-attrs
::shape-attrs
::svg-raw-attrs
::ctsl/layout-child-attrs]]
[:circle
[:merge {:title "CircleShape"}
::ctsl/layout-child-attrs
schema:circle-attrs
schema:shape-attrs
schema:shape-geom-attrs
schema:shape-base-attrs]]
[:path
[:and {:title "PathShape"}
::shape-base-attrs
::shape-attrs
::path-attrs
::ctsl/layout-child-attrs]]
[:image
[:merge {:title "ImageShape"}
::ctsl/layout-child-attrs
schema:image-attrs
schema:shape-attrs
schema:shape-geom-attrs
schema:shape-base-attrs]]
[:text
[:and {:title "TextShape"}
::shape-base-attrs
::shape-geom-attrs
::shape-attrs
::text-attrs
::ctsl/layout-child-attrs]]])
[:svg-raw
[:merge {:title "SvgRawShape"}
::ctsl/layout-child-attrs
schema:svg-raw-attrs
schema:shape-attrs
schema:shape-geom-attrs
schema:shape-base-attrs]]
(sm/register! ::shape
[:and
{:title "Shape"
:gen/gen (->> (sg/generator ::shape-base-attrs)
(sg/mcat (fn [{:keys [type] :as shape}]
(sg/let [attrs1 (sg/generator ::shape-attrs)
attrs2 (sg/generator ::shape-geom-attrs)
attrs3 (case type
:text (sg/generator ::text-attrs)
:path (sg/generator ::path-attrs)
:svg-raw (sg/generator ::svg-raw-attrs)
:image (sg/generator ::image-attrs)
:circle (sg/generator ::circle-attrs)
:rect (sg/generator ::rect-attrs)
:bool (sg/generator ::bool-attrs)
:group (sg/generator ::group-attrs)
:frame (sg/generator ::frame-attrs))]
(if (or (= type :path)
(= type :bool))
(merge attrs1 shape attrs3)
(merge attrs1 shape attrs2 attrs3)))))
(sg/fmap map->Shape))}
::shape-map
[:fn shape?]])
[:path
[:merge {:title "PathShape"}
::ctsl/layout-child-attrs
schema:path-attrs
schema:shape-attrs
schema:shape-base-attrs]]
[:text
[:merge {:title "TextShape"}
::ctsl/layout-child-attrs
schema:text-attrs
schema:shape-attrs
schema:shape-geom-attrs
schema:shape-base-attrs]]]])
(sm/register! ::shape schema:shape)
(def check-shape-attrs!
(sm/check-fn ::shape-attrs))
(sm/check-fn schema:shape-attrs))
(def check-shape!
(sm/check-fn ::shape))
(sm/check-fn schema:shape))
(defn has-images?
[{:keys [fills strokes]}]
(or
(some :fill-image fills)
(some :stroke-image strokes)))
(or (some :fill-image fills)
(some :stroke-image strokes)))
;; --- Initialization

8
common/src/app/common/types/shape/export.cljc
View file

@ -8,10 +8,12 @@
(:require
[app.common.schema :as sm]))
(def export-types #{:png :jpeg :svg :pdf})
(def types #{:png :jpeg :svg :pdf})
(sm/register! ::export
(def schema:export
[:map {:title "ShapeExport"}
[:type [::sm/one-of export-types]]
[:type [::sm/one-of types]]
[:scale ::sm/safe-number]
[:suffix :string]])
(sm/register! ::export schema:export)

178
common/src/app/common/types/shape/interactions.cljc
View file

@ -11,7 +11,8 @@
[app.common.files.helpers :as cfh]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.bounds :as gsb]
[app.common.schema :as sm]))
[app.common.schema :as sm]
[app.common.schema.generators :as sg]))
;; WARNING: options are not deleted when changing event or action type, so it can be
;; restored if the user changes it back later.
@ -71,81 +72,116 @@
(def animation-types
#{:dissolve :slide :push})
(sm/register! ::animation
[:multi {:dispatch :animation-type :title "Animation"}
[:dissolve
[:map {:title "AnimationDisolve"}
[:animation-type [:= :dissolve]]
[:duration ::sm/safe-int]
[:easing [::sm/one-of easing-types]]]]
[:slide
[:map {:title "AnimationSlide"}
[:animation-type [:= :slide]]
[:duration ::sm/safe-int]
[:easing [::sm/one-of easing-types]]
[:way [::sm/one-of way-types]]
[:direction [::sm/one-of direction-types]]
[:offset-effect :boolean]]]
[:push
[:map {:title "AnimationPush"}
[:animation-type [:= :push]]
[:duration ::sm/safe-int]
[:easing [::sm/one-of easing-types]]
[:direction [::sm/one-of direction-types]]]]])
(def schema:dissolve-animation
[:map {:title "AnimationDisolve"}
[:animation-type [:= :dissolve]]
[:duration ::sm/safe-int]
[:easing [::sm/one-of easing-types]]])
(def schema:slide-animation
[:map {:title "AnimationSlide"}
[:animation-type [:= :slide]]
[:duration ::sm/safe-int]
[:easing [::sm/one-of easing-types]]
[:way [::sm/one-of way-types]]
[:direction [::sm/one-of direction-types]]
[:offset-effect :boolean]])
(def schema:push-animation
[:map {:title "PushAnimation"}
[:animation-type [:= :push]]
[:duration ::sm/safe-int]
[:easing [::sm/one-of easing-types]]
[:direction [::sm/one-of direction-types]]])
(def schema:animation
[:multi {:dispatch :animation-type
:title "Animation"
:gen/gen (sg/one-of (sg/generator schema:dissolve-animation)
(sg/generator schema:slide-animation)
(sg/generator schema:push-animation))
:decode/json #(update % :animation-type keyword)}
[:dissolve schema:dissolve-animation]
[:slide schema:slide-animation]
[:push schema:push-animation]])
(sm/register! ::animation schema:animation)
(def check-animation!
(sm/check-fn ::animation))
(sm/check-fn schema:animation))
(sm/register! ::interaction
[:multi {:dispatch :action-type}
[:navigate
[:map
[:action-type [:= :navigate]]
[:event-type [::sm/one-of event-types]]
[:destination {:optional true} [:maybe ::sm/uuid]]
[:preserve-scroll {:optional true} :boolean]
[:animation {:optional true} ::animation]]]
[:open-overlay
[:map
[:action-type [:= :open-overlay]]
[:event-type [::sm/one-of event-types]]
[:overlay-position ::gpt/point]
[:overlay-pos-type [::sm/one-of overlay-positioning-types]]
[:destination {:optional true} [:maybe ::sm/uuid]]
[:close-click-outside {:optional true} :boolean]
[:background-overlay {:optional true} :boolean]
[:animation {:optional true} ::animation]
[:position-relative-to {:optional true} [:maybe ::sm/uuid]]]]
[:toggle-overlay
[:map
[:action-type [:= :toggle-overlay]]
[:event-type [::sm/one-of event-types]]
[:overlay-position ::gpt/point]
[:overlay-pos-type [::sm/one-of overlay-positioning-types]]
[:destination {:optional true} [:maybe ::sm/uuid]]
[:close-click-outside {:optional true} :boolean]
[:background-overlay {:optional true} :boolean]
[:animation {:optional true} ::animation]
[:position-relative-to {:optional true} [:maybe ::sm/uuid]]]]
[:close-overlay
[:map
[:action-type [:= :close-overlay]]
[:event-type [::sm/one-of event-types]]
[:destination {:optional true} [:maybe ::sm/uuid]]
[:animation {:optional true} ::animation]
[:position-relative-to {:optional true} [:maybe ::sm/uuid]]]]
[:prev-screen
[:map
[:action-type [:= :prev-screen]]
[:event-type [::sm/one-of event-types]]]]
[:open-url
[:map
[:action-type [:= :open-url]]
[:event-type [::sm/one-of event-types]]
[:url :string]]]])
(def schema:navigate-interaction
[:map
[:action-type [:= :navigate]]
[:event-type [::sm/one-of event-types]]
[:destination {:optional true} [:maybe ::sm/uuid]]
[:preserve-scroll {:optional true} :boolean]
[:animation {:optional true} ::animation]])
(def schema:open-overlay-interaction
[:map
[:action-type [:= :open-overlay]]
[:event-type [::sm/one-of event-types]]
[:overlay-position ::gpt/point]
[:overlay-pos-type [::sm/one-of overlay-positioning-types]]
[:destination {:optional true} [:maybe ::sm/uuid]]
[:close-click-outside {:optional true} :boolean]
[:background-overlay {:optional true} :boolean]
[:animation {:optional true} ::animation]
[:position-relative-to {:optional true} [:maybe ::sm/uuid]]])
(def schema:toggle-overlay-interaction
[:map
[:action-type [:= :toggle-overlay]]
[:event-type [::sm/one-of event-types]]
[:overlay-position ::gpt/point]
[:overlay-pos-type [::sm/one-of overlay-positioning-types]]
[:destination {:optional true} [:maybe ::sm/uuid]]
[:close-click-outside {:optional true} :boolean]
[:background-overlay {:optional true} :boolean]
[:animation {:optional true} ::animation]
[:position-relative-to {:optional true} [:maybe ::sm/uuid]]])
(def schema:close-overlay-interaction
[:map
[:action-type [:= :close-overlay]]
[:event-type [::sm/one-of event-types]]
[:destination {:optional true} [:maybe ::sm/uuid]]
[:animation {:optional true} ::animation]
[:position-relative-to {:optional true} [:maybe ::sm/uuid]]])
(def schema:prev-scren-interaction
[:map
[:action-type [:= :prev-screen]]
[:event-type [::sm/one-of event-types]]])
(def schema:open-url-interaction
[:map
[:action-type [:= :open-url]]
[:event-type [::sm/one-of event-types]]
[:url :string]])
(def schema:interaction
[:multi {:dispatch :action-type
:title "Interaction"
:gen/gen (sg/one-of (sg/generator schema:navigate-interaction)
(sg/generator schema:open-overlay-interaction)
(sg/generator schema:close-overlay-interaction)
(sg/generator schema:toggle-overlay-interaction)
(sg/generator schema:prev-scren-interaction)
(sg/generator schema:open-url-interaction))
:decode/json #(update % :action-type keyword)}
[:navigate schema:navigate-interaction]
[:open-overlay schema:open-overlay-interaction]
[:toggle-overlay schema:toggle-overlay-interaction]
[:close-overlay schema:close-overlay-interaction]
[:prev-screen schema:prev-scren-interaction]
[:open-url schema:open-url-interaction]])
(sm/register! ::interaction schema:interaction)
(def check-interaction!
(sm/check-fn ::interaction))
(sm/check-fn schema:interaction))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HELPERS

79
common/src/app/common/types/shape/path.cljc
View file

@ -8,40 +8,49 @@
(:require
[app.common.schema :as sm]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SCHEMA
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def schema:line-to-segment
[:map
[:command [:= :line-to]]
[:params
[:map
[:x ::sm/safe-number]
[:y ::sm/safe-number]]]])
(sm/register! ::segment
[:multi {:title "PathSegment" :dispatch :command}
[:line-to
[:map
[:command [:= :line-to]]
[:params
[:map
[:x ::sm/safe-number]
[:y ::sm/safe-number]]]]]
[:close-path
[:map
[:command [:= :close-path]]]]
[:move-to
[:map
[:command [:= :move-to]]
[:params
[:map
[:x ::sm/safe-number]
[:y ::sm/safe-number]]]]]
[:curve-to
[:map
[:command [:= :curve-to]]
[:params
[:map
[:x ::sm/safe-number]
[:y ::sm/safe-number]
[:c1x ::sm/safe-number]
[:c1y ::sm/safe-number]
[:c2x ::sm/safe-number]
[:c2y ::sm/safe-number]]]]]])
(def schema:close-path-segment
[:map
[:command [:= :close-path]]])
(sm/register! ::content
[:vector ::segment])
(def schema:move-to-segment
[:map
[:command [:= :move-to]]
[:params
[:map
[:x ::sm/safe-number]
[:y ::sm/safe-number]]]])
(def schema:curve-to-segment
[:map
[:command [:= :curve-to]]
[:params
[:map
[:x ::sm/safe-number]
[:y ::sm/safe-number]
[:c1x ::sm/safe-number]
[:c1y ::sm/safe-number]
[:c2x ::sm/safe-number]
[:c2y ::sm/safe-number]]]])
(def schema:path-segment
[:multi {:title "PathSegment"
:dispatch :command
:decode/json #(update % :command keyword)}
[:line-to schema:line-to-segment]
[:close-path schema:close-path-segment]
[:move-to schema:move-to-segment]
[:curve-to schema:curve-to-segment]])
(def schema:path-content
[:vector schema:path-segment])
(sm/register! ::segment schema:path-segment)
(sm/register! ::content schema:path-content)

10
common/src/app/common/types/shape/shadow.cljc
View file

@ -7,17 +7,23 @@
(ns app.common.types.shape.shadow
(:require
[app.common.schema :as sm]
[app.common.schema.generators :as sg]
[app.common.types.color :as ctc]))
(def styles #{:drop-shadow :inner-shadow})
(sm/register! ::shadow
(def schema:shadow
[:map {:title "Shadow"}
[:id [:maybe ::sm/uuid]]
[:style [::sm/one-of styles]]
[:style
[:and {:gen/gen (sg/elements styles)}
:keyword
[::sm/one-of styles]]]
[:offset-x ::sm/safe-number]
[:offset-y ::sm/safe-number]
[:blur ::sm/safe-number]
[:spread ::sm/safe-number]
[:hidden :boolean]
[:color ::ctc/color]])
(sm/register! ::shadow schema:shadow)

3
common/src/app/common/types/typography.cljc
View file

@ -31,8 +31,7 @@
[:text-transform :string]
[:modified-at {:optional true} ::sm/inst]
[:path {:optional true} [:maybe :string]]
[:plugin-data {:optional true}
[:map-of {:gen/max 5} :keyword ::ctpg/plugin-data]]])
[:plugin-data {:optional true} ::ctpg/plugin-data]])
(def check-typography!
(sm/check-fn ::typography))

41
common/test/common_tests/schema_test.cljc Normal file
View file

@ -0,0 +1,41 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns common-tests.schema-test
(:require
[app.common.schema :as sm]
[app.common.schema.generators :as sg]
[clojure.test :as t]))
(t/deftest test-set-of-email
(t/testing "decoding"
(let [candidate1 "a@b.com a@c.net"
schema [::sm/set ::sm/email]
result1 (sm/decode schema candidate1 sm/string-transformer)
result2 (sm/decode schema candidate1 sm/json-transformer)]
(t/is (= result1 #{"a@b.com" "a@c.net"}))
(t/is (= result2 #{"a@b.com" "a@c.net"}))))
(t/testing "encoding"
(let [candidate #{"a@b.com" "a@c.net"}
schema [::sm/set ::sm/email]
result1 (sm/encode schema candidate sm/string-transformer)
result2 (sm/decode schema candidate sm/json-transformer)]
(t/is (= result1 "a@b.com, a@c.net"))
(t/is (= result2 candidate))))
(t/testing "validate"
(let [candidate #{"a@b.com" "a@c.net"}
schema [::sm/set ::sm/email]]
(t/is (true? (sm/validate schema candidate)))
(t/is (true? (sm/validate schema #{})))
(t/is (false? (sm/validate schema #{"a"})))))
(t/testing "generate"
(let [schema [::sm/set ::sm/email]
value (sg/generate schema)]
(t/is (true? (sm/validate schema (sg/generate schema)))))))

150
common/test/common_tests/types/decoder_test.clj Normal file
View file

@ -0,0 +1,150 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns common-tests.types.decoder-test
(:require
[app.common.json :as json]
[app.common.pprint :as pp]
[app.common.schema :as sm]
[app.common.schema.generators :as sg]
[app.common.types.color :refer [schema:color schema:gradient]]
[app.common.types.plugins :refer [schema:plugin-data]]
[app.common.types.shape :as tsh]
[app.common.types.shape.interactions :refer [schema:animation schema:interaction]]
[app.common.types.shape.path :refer [schema:path-content]]
[app.common.types.shape.shadow :refer [schema:shadow]]
[app.common.uuid :as uuid]
[clojure.test :as t]))
(defn json-roundtrip
[data]
(-> data
(json/encode :key-fn json/write-camel-key)
(json/decode :key-fn json/read-kebab-key)))
(t/deftest map-of-with-strings
(let [schema [:map [:data [:map-of :string :int]]]
encode (sm/encoder schema (sm/json-transformer))
decode (sm/decoder schema (sm/json-transformer))
data1 {:data {"foo/bar" 1
"foo-baz" 2}}
data2 (encode data1)
data3 (json-roundtrip data2)
data4 (decode data3)]
;; (pp/pprint data1)
;; (pp/pprint data2)
;; (pp/pprint data3)
;; (pp/pprint data4)
(t/is (= data1 data2))
(t/is (= data1 data4))
(t/is (not= data1 data3))))
(t/deftest gradient-json-roundtrip
(let [encode (sm/encoder schema:gradient (sm/json-transformer))
decode (sm/decoder schema:gradient (sm/json-transformer))]
(sg/check!
(sg/for [gradient (sg/generator schema:gradient)]
(let [gradient-1 (encode gradient)
gradient-2 (json-roundtrip gradient-1)
gradient-3 (decode gradient-2)]
;; (app.common.pprint/pprint gradient)
;; (app.common.pprint/pprint gradient-3)
(t/is (= gradient gradient-3))))
{:num 500})))
(t/deftest color-json-roundtrip
(let [encode (sm/encoder schema:color (sm/json-transformer))
decode (sm/decoder schema:color (sm/json-transformer))]
(sg/check!
(sg/for [color (sg/generator schema:color)]
(let [color-1 (encode color)
color-2 (json-roundtrip color-1)
color-3 (decode color-2)]
;; (app.common.pprint/pprint color)
;; (app.common.pprint/pprint color-3)
(t/is (= color color-3))))
{:num 500})))
(t/deftest shape-shadow-json-roundtrip
(let [encode (sm/encoder schema:shadow (sm/json-transformer))
decode (sm/decoder schema:shadow (sm/json-transformer))]
(sg/check!
(sg/for [shadow (sg/generator schema:shadow)]
(let [shadow-1 (encode shadow)
shadow-2 (json-roundtrip shadow-1)
shadow-3 (decode shadow-2)]
;; (app.common.pprint/pprint shadow)
;; (app.common.pprint/pprint shadow-3)
(t/is (= shadow shadow-3))))
{:num 500})))
(t/deftest shape-animation-json-roundtrip
(let [encode (sm/encoder schema:animation (sm/json-transformer))
decode (sm/decoder schema:animation (sm/json-transformer))]
(sg/check!
(sg/for [animation (sg/generator schema:animation)]
(let [animation-1 (encode animation)
animation-2 (json-roundtrip animation-1)
animation-3 (decode animation-2)]
;; (app.common.pprint/pprint animation)
;; (app.common.pprint/pprint animation-3)
(t/is (= animation animation-3))))
{:num 500})))
(t/deftest shape-interaction-json-roundtrip
(let [encode (sm/encoder schema:interaction (sm/json-transformer))
decode (sm/decoder schema:interaction (sm/json-transformer))]
(sg/check!
(sg/for [interaction (sg/generator schema:interaction)]
(let [interaction-1 (encode interaction)
interaction-2 (json-roundtrip interaction-1)
interaction-3 (decode interaction-2)]
;; (app.common.pprint/pprint interaction)
;; (app.common.pprint/pprint interaction-3)
(t/is (= interaction interaction-3))))
{:num 500})))
(t/deftest shape-path-content-json-roundtrip
(let [encode (sm/encoder schema:path-content (sm/json-transformer))
decode (sm/decoder schema:path-content (sm/json-transformer))]
(sg/check!
(sg/for [path-content (sg/generator schema:path-content)]
(let [path-content-1 (encode path-content)
path-content-2 (json-roundtrip path-content-1)
path-content-3 (decode path-content-2)]
;; (app.common.pprint/pprint path-content)
;; (app.common.pprint/pprint path-content-3)
(t/is (= path-content path-content-3))))
{:num 500})))
(t/deftest plugin-data-json-roundtrip
(let [encode (sm/encoder schema:plugin-data (sm/json-transformer))
decode (sm/decoder schema:plugin-data (sm/json-transformer))]
(sg/check!
(sg/for [data (sg/generator schema:plugin-data)]
(let [data-1 (encode data)
data-2 (json-roundtrip data-1)
data-3 (decode data-2)]
(t/is (= data data-3))))
{:num 500})))
(t/deftest shape-json-roundtrip
(let [encode (sm/encoder ::tsh/shape (sm/json-transformer))
decode (sm/decoder ::tsh/shape (sm/json-transformer))]
(sg/check!
(sg/for [shape (sg/generator ::tsh/shape)]
(let [shape-1 (encode shape)
shape-2 (json-roundtrip shape-1)
shape-3 (decode shape-2)]
;; (app.common.pprint/pprint shape)
;; (app.common.pprint/pprint shape-3)
(t/is (= shape shape-3))))
{:num 1000})))

4
frontend/src/app/render.cljs
View file

@ -115,7 +115,7 @@
(def ^:private render-objects-decoder
(sm/lazy-decoder schema:render-objects
sm/default-transformer))
sm/string-transformer))
(def ^:private render-objects-validator
(sm/lazy-validator schema:render-objects))
@ -236,7 +236,7 @@
(def ^:private render-components-decoder
(sm/lazy-decoder schema:render-components
sm/default-transformer))
sm/string-transformer))
(def ^:private render-components-validator
(sm/lazy-validator schema:render-components))

2
frontend/src/app/util/forms.cljs
View file

@ -79,7 +79,7 @@
[f {:keys [schema validators]}]
(fn [& args]
(let [state (apply f args)
cleaned (sm/decode schema (:data state))
cleaned (sm/decode schema (:data state) sm/string-transformer)
valid? (sm/validate schema cleaned)
errors (when-not valid?
(collect-schema-errors schema validators state))]

2
frontend/src/app/util/object.cljs
View file

@ -129,6 +129,8 @@
:else
(transform-prop-key k))))
;; FIXME: REPEATED from app.common.json
(defn map->obj
"A simplified version of clj->js with focus on performance"
([x] (map->obj x identity))