Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-03-28 15:41:25 -05:00
Code Issues Activity

Merge pull request #5003 from penpot/niwinz-json-decoder

Browse source 
🎉 Add json encode/decode mechanism for schemas
This commit is contained in:
Alejandro 2024-08-21 12:48:41 +02:00 • committed by GitHub
commit baa52d432f
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
52 changed files with 1367 additions and 850 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
backend/dev/user.clj
View file

@ -20,6 +20,7 @@
[app.common.schema.desc-native :as smdn]
[app.common.schema.generators :as sg]
[app.common.spec :as us]
[app.common.json :as json]
[app.common.transit :as t]
[app.common.types.file :as ctf]
[app.common.uuid :as uuid]
@ -29,7 +30,6 @@
[app.srepl.helpers :as srepl.helpers]
[app.srepl.main :as srepl]
[app.util.blob :as blob]
[app.util.json :as json]
[app.util.time :as dt]
[clj-async-profiler.core :as prof]
[clojure.contrib.humanize :as hum]

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)))

1
common/dev/user.clj
View file

@ -6,6 +6,7 @@
(ns user
(:require
[app.common.json :as json]
[app.common.pprint :as pp]
[app.common.schema :as sm]
[app.common.schema.desc-js-like :as smdj]

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))

72
common/src/app/common/json.cljc Normal file
View file

@ -0,0 +1,72 @@
;; 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 app.common.json
(:refer-clojure :exclude [read])
(:require
#?(:clj [clojure.data.json :as j])
[cuerdas.core :as str]))
#?(:clj
(defn read
[reader & {:as opts}]
(j/read reader opts)))
#?(:clj
(defn write
[writer data & {:as opts}]
(j/write data writer opts)))
#?(:cljs
(defn map->obj
"A simplified version of clj->js with focus on performance"
[x & {:keys [key-fn]}]
(cond
(nil? x)
nil
(keyword? x)
(name x)
(map? x)
(reduce-kv (fn [m k v]
(let [k (if (keyword? k) (name k) k)]
(unchecked-set m (key-fn k) (map->obj v key-fn))
m))
#js {}
x)
(coll? x)
(reduce (fn [arr v]
(.push arr v)
arr)
(array)
x)
:else x)))
(defn read-kebab-key
[k]
(if (and (string? k) (not (str/includes? k "/")))
(-> k str/kebab keyword)
k))
(defn write-camel-key
[k]
(if (or (keyword? k) (symbol? k))
(str/camel k)
(str k)))
#?(:clj
(defn encode
[data & {:as opts}]
(j/write-str data opts)))
#?(:clj
(defn decode
[data & {:as opts}]
(j/read-str data opts)))

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]))

18
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]
@ -77,14 +77,11 @@
(defn word-string
[]
(as-> tg/string-alphanumeric $$
(tg/such-that (fn [v] (re-matches #"\w+" v)) $$ 50)
(tg/such-that (fn [v]
(and (not (str/blank? v))
(not (re-matches #"^\d+.*" v))))
$$
50)))
(as-> tg/string-ascii $$
(tg/resize 10 $$)
(tg/fmap (fn [v] (apply str (re-seq #"[A-Za-z]+" v))) $$)
(tg/such-that (fn [v] (>= (count v) 4)) $$ 100)
(tg/fmap str/lower $$)))
(defn email
[]
@ -125,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))