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

🎉 Add malli based validation and coersion subsystem

Browse source
This commit is contained in:
Andrey Antukh 2023-03-18 10:32:26 +01:00
parent dbc08ba80f
commit 5ca3d01ea1
125 changed files with 4984 additions and 2762 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -323,6 +323,7 @@
(def default-flags
[:enable-backend-api-doc
:enable-backend-openapi-doc
:enable-backend-worker
:enable-secure-session-cookies
:enable-email-verification])

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

@ -154,8 +154,8 @@
[_ cfg]
(rr/router
[["" {:middleware [[mw/server-timing]
[mw/format-response]
[mw/params]
[mw/format-response]
[mw/parse-request]
[session/soft-auth cfg]
[actoken/soft-auth cfg]

10
backend/src/app/http/debug.clj
View file

@ -238,6 +238,9 @@
(-> (io/resource "app/templates/error-report.v2.tmpl")
(tmpl/render report)))
(render-template-v3 [{report :content}]
(-> (io/resource "app/templates/error-report.v3.tmpl")
(tmpl/render report)))
]
(when-not (authorized? pool request)
@ -245,9 +248,10 @@
:code :only-admins-allowed))
(if-let [report (get-report request)]
(let [result (if (= 1 (:version report))
(render-template-v1 report)
(render-template-v2 report))]
(let [result (case (:version report)
1 (render-template-v1 report)
2 (render-template-v2 report)
3 (render-template-v3 report))]
{::yrs/status 200
::yrs/body result
::yrs/headers {"content-type" "text/html; charset=utf-8"

51
backend/src/app/http/errors.clj
View file

@ -9,6 +9,7 @@
(:require
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.schema :as sm]
[app.http :as-alias http]
[app.http.access-token :as-alias actoken]
[app.http.session :as-alias session]
@ -82,6 +83,14 @@
(dissoc ::s/problems ::s/value)
(cond-> explain (assoc :explain explain)))})
(= code :params-validation)
(let [explain (::sm/explain data)
payload (sm/humanize-data explain)]
{::yrs/status 400
::yrs/body (-> data
(dissoc ::sm/explain)
(assoc :data payload))})
(= code :request-body-too-large)
{::yrs/status 413 ::yrs/body data}
@ -90,16 +99,38 @@
(defmethod handle-exception :assertion
[error request]
(let [edata (ex-data error)
explain (ex/explain edata)]
(binding [l/*context* (request->context request)]
(l/error :hint "Assertion error" :message (ex-message error) :cause error)
{::yrs/status 500
::yrs/body {:type :server-error
:code :assertion
:data (-> edata
(dissoc ::s/problems ::s/value ::s/spec)
(cond-> explain (assoc :explain explain)))}})))
(binding [l/*context* (request->context request)]
(let [{:keys [code] :as data} (ex-data error)]
(cond
(= code :data-validation)
(let [explain (::sm/explain data)
payload (sm/humanize-data explain)]
(l/error :hint "Data assertion error" :message (ex-message error) :cause error)
{::yrs/status 500
::yrs/body {:type :server-error
:code :assertion
:data (-> data
(dissoc ::sm/explain)
(assoc :data payload))}})
(= code :spec-validation)
(let [explain (ex/explain data)]
(l/error :hint "Spec assertion error" :message (ex-message error) :cause error)
{::yrs/status 500
::yrs/body {:type :server-error
:code :assertion
:data (-> data
(dissoc ::s/problems ::s/value ::s/spec)
(cond-> explain (assoc :explain explain)))}})
:else
(do
(l/error :hint "Assertion error" :message (ex-message error) :cause error)
{::yrs/status 500
::yrs/body {:type :server-error
:code :assertion
:data data}})))))
(defmethod handle-exception :not-found
[err _]

4
backend/src/app/loggers/audit.clj
View file

@ -141,7 +141,7 @@
(defn prepare-event
[cfg mdata params result]
(let [resultm (meta result)
request (::http/request params)
request (-> params meta ::http/request)
profile-id (or (::profile-id resultm)
(:profile-id result)
(::rpc/profile-id params)
@ -171,7 +171,7 @@
;; NOTE: for batch-key lookup we need the params as-is
;; because the rpc api does not need to know the
;; audit/webhook specific object layout.
::rpc/params (dissoc params ::http/request)
::rpc/params params
::webhooks/batch-key
(or (::webhooks/batch-key mdata)

51
backend/src/app/loggers/database.clj
View file

@ -11,6 +11,7 @@
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.pprint :as pp]
[app.common.schema :as sm]
[app.common.spec :as us]
[app.config :as cf]
[app.db :as db]
@ -32,35 +33,41 @@
(when-not (db/read-only? pool)
(db/insert! pool :server-error-report
{:id id
:version 2
:version 3
:content (db/tjson report)})))
(defn record->report
[{:keys [::l/context ::l/message ::l/props ::l/logger ::l/level ::l/cause] :as record}]
(us/assert! ::l/record record)
(merge
{:context (-> context
(assoc :tenant (cf/get :tenant))
(assoc :host (cf/get :host))
(assoc :public-uri (cf/get :public-uri))
(assoc :version (:full cf/version))
(assoc :logger-name logger)
(assoc :logger-level level)
(dissoc :params)
(pp/pprint-str :width 200))
:params (some-> (:params context)
(pp/pprint-str :width 200))
:props (pp/pprint-str props :width 200)
:hint (or (ex-message cause) @message)
:trace (ex/format-throwable cause :data? false :explain? false :header? false :summary? false)}
(let [data (ex-data cause)]
(merge
{:context (-> context
(assoc :tenant (cf/get :tenant))
(assoc :host (cf/get :host))
(assoc :public-uri (cf/get :public-uri))
(assoc :version (:full cf/version))
(assoc :logger-name logger)
(assoc :logger-level level)
(dissoc :params)
(pp/pprint-str :width 200))
:props (pp/pprint-str props :width 200)
:hint (or (ex-message cause) @message)
:trace (ex/format-throwable cause :data? false :explain? false :header? false :summary? false)}
(when-let [params (:params context)]
{:params (pp/pprint-str params :width 200)})
(when-let [data (some-> data (dissoc ::s/problems ::s/value ::s/spec ::sm/explain :hint))]
{:data (pp/pprint-str data :width 200)})
(when-let [value (-> data ::sm/explain :value)]
{:value (pp/pprint-str value :width 200)})
(when-let [explain (ex/explain data)]
{:explain explain}))))
(when-let [data (ex-data cause)]
{:spec-value (some-> (::s/value data) (pp/pprint-str :width 200))
:spec-explain (ex/explain data)
:data (-> data
(dissoc ::s/problems ::s/value ::s/spec :hint)
(pp/pprint-str :width 200))})))
(defn error-record?
[{:keys [::l/level ::l/cause]}]

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

@ -10,6 +10,9 @@
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.media :as cm]
[app.common.schema :as sm]
[app.common.schema.generators :as sg]
[app.common.schema.openapi :as-alias oapi]
[app.common.spec :as us]
[app.config :as cf]
[app.db :as-alias db]
@ -47,6 +50,27 @@
(s/keys :req-un [::path]
:opt-un [::mtype]))
(sm/def! ::fs/path
{:type ::fs/path
:pred fs/path?
:type-properties
{:title "path"
:description "filesystem path"
:error/message "expected a valid fs path instance"
:gen/gen (sg/generator :string)
::oapi/type "string"
::oapi/format "unix-path"
::oapi/decode fs/path}})
(sm/def! ::upload
[:map {:title "Upload"}
[:filename :string]
[:size :int]
[:path ::fs/path]
[:mtype {:optional true} :string]
[:headers {:optional true}
[:map-of :string :string]]])
(defn validate-media-type!
([upload] (validate-media-type! upload cm/valid-image-types))
([upload allowed]

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

@ -10,6 +10,7 @@
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.schema :as sm]
[app.common.spec :as us]
[app.config :as cf]
[app.db :as db]
@ -74,15 +75,16 @@
etag (yrq/get-header request "if-none-match")
profile-id (or (::session/profile-id request)
(::actoken/profile-id request))
data (-> params
(assoc ::request-at (dt/now))
(assoc ::session/id (::session/id request))
(assoc ::http/request request)
(assoc ::cond/key etag)
(cond-> (uuid? profile-id)
(assoc ::profile-id profile-id)))
method (get methods type default-handler)]
data (vary-meta data assoc ::http/request request)
method (get methods type default-handler)]
(binding [cond/*enabled* true]
(let [response (method data)]
@ -127,9 +129,49 @@
(defn- wrap-spec-conform
[_ f mdata]
(let [spec (or (::sv/spec mdata) (s/spec any?))]
(fn [cfg params]
(f cfg (us/conform spec params)))))
;; NOTE: skip spec conform operation on rpc methods that already
;; uses malli validation mechanism.
(if (contains? mdata ::sm/params)
f
(if-let [spec (ex/ignoring (s/spec (::sv/spec mdata)))]
(fn [cfg params]
(f cfg (us/conform spec params)))
f)))
(defn- wrap-params-validation
[_ f mdata]
(if-let [schema (::sm/params mdata)]
(let [schema (sm/schema schema)
valid? (sm/validator schema)
explain (sm/explainer schema)
decode (sm/decoder schema sm/default-transformer)]
(fn [cfg params]
(let [params (decode params)]
(if (valid? params)
(f cfg 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 (sm/schema schema)
valid? (sm/validator schema)
explain (sm/explainer schema)]
(fn [cfg params]
(let [response (f cfg params)]
(when (map? response)
(when-not (valid? response)
(ex/raise :type :validation
:code :data-validation
::sm/explain (explain response))))
response))))
f)
f))
(defn- wrap-all
[cfg f mdata]
@ -141,6 +183,8 @@
(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)))
(defn- wrap

5
backend/src/app/rpc/commands/audit.clj
View file

@ -39,8 +39,9 @@
:profile-id :ip-addr :props :context])
(defn- handle-events
[{:keys [::db/pool]} {:keys [::rpc/profile-id events ::http/request]}]
(let [ip-addr (audit/parse-client-ip request)
[{:keys [::db/pool]} {:keys [::rpc/profile-id events] :as params}]
(let [request (-> params meta ::http/request)
ip-addr (audit/parse-client-ip request)
xform (comp
(map #(assoc % :profile-id profile-id))
(map #(assoc % :ip-addr ip-addr))

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

@ -11,6 +11,9 @@
[app.common.exceptions :as ex]
[app.common.pages.helpers :as cph]
[app.common.pages.migrations :as pmg]
[app.common.schema :as sm]
[app.common.schema.desc-js-like :as-alias smdj]
[app.common.schema.generators :as sg]
[app.common.spec :as us]
[app.common.types.components-list :as ctkl]
[app.common.types.file :as ctf]
@ -19,7 +22,6 @@
[app.loggers.audit :as-alias audit]
[app.loggers.webhooks :as-alias webhooks]
[app.rpc :as-alias rpc]
[app.rpc.commands.files.thumbnails :as-alias thumbs]
[app.rpc.commands.projects :as projects]
[app.rpc.commands.teams :as teams]
[app.rpc.cond :as-alias cond]
@ -188,7 +190,7 @@
(ex/raise :type :restriction
:code :features-not-supported
:feature (first not-supported)
:hint (format "features %s not supported" (str/join "," not-supported))))
:hint (format "features %s not supported" (str/join "," (map name not-supported)))))
features))
(defn load-pointer
@ -264,6 +266,41 @@
;; --- COMMAND QUERY: get-file (by id)
(sm/def! ::features
[:schema
{:title "FileFeatures"
::smdj/inline true
:gen/gen (sg/subseq supported-features)}
::sm/set-of-strings])
(sm/def! ::file
[:map {:title "File"}
[:id ::sm/uuid]
[:features ::features]
[:has-media-trimmed :boolean]
[:comment-thread-seqn {:min 0} :int]
[:name :string]
[:revn {:min 0} :int]
[:modified-at ::dt/instant]
[:is-shared :boolean]
[:project-id ::sm/uuid]
[:created-at ::dt/instant]
[:data {:optional true} :any]])
(sm/def! ::permissions-mixin
[:map {:title "PermissionsMixin"}
[:permissions ::perms/permissions]])
(sm/def! ::file-with-permissions
[:merge {:title "FileWithPermissions"}
::file
::permissions-mixin])
(sm/def! ::get-file
[:map {:title "get-file"}
[:features {:optional true} ::features]
[:id ::sm/uuid]])
(defn get-file
[conn id client-features]
;; here we check if client requested features are supported
@ -282,17 +319,14 @@
[{:keys [modified-at revn]}]
(str (dt/format-instant modified-at :iso) "-" revn))
(s/def ::get-file
(s/keys :req [::rpc/profile-id]
:req-un [::id]
:opt-un [::features]))
(sv/defmethod ::get-file
"Retrieve a file by its ID. Only authenticated users."
{::doc/added "1.17"
::cond/get-object #(get-minimal-file %1 (:id %2))
::cond/key-fn get-file-etag}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id features]}]
::cond/key-fn get-file-etag
::sm/params ::get-file
::sm/result ::file-with-permissions}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id features] :as params}]
(dm/with-open [conn (db/open pool)]
(let [perms (get-permissions conn profile-id id)]
(check-read-permissions! perms)
@ -303,23 +337,29 @@
;; --- COMMAND QUERY: get-file-fragment (by id)
(sm/def! ::file-fragment
[:map {:title "FileFragment"}
[:id ::sm/uuid]
[:file-id ::sm/uuid]
[:created-at ::dt/instant]
[:content any?]])
(sm/def! ::get-file-fragment
[:map {:title "get-file-fragment"}
[:file-id ::sm/uuid]
[:fragment-id ::sm/uuid]
[:share-id {:optional true} ::sm/uuid]])
(defn- get-file-fragment
[conn file-id fragment-id]
(some-> (db/get conn :file-data-fragment {:file-id file-id :id fragment-id})
(update :content blob/decode)))
(s/def ::share-id ::us/uuid)
(s/def ::fragment-id ::us/uuid)
(s/def ::get-file-fragment
(s/keys :req-un [::file-id ::fragment-id]
:opt [::rpc/profile-id]
:opt-un [::share-id]))
(sv/defmethod ::get-file-fragment
"Retrieve a file by its ID. Only authenticated users."
{::doc/added "1.17"
::rpc/:auth false}
::sm/params ::get-file-fragment
::sm/result ::file-fragment}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id fragment-id share-id] }]
(dm/with-open [conn (db/open pool)]
(let [perms (get-permissions conn profile-id file-id share-id)]
@ -342,16 +382,16 @@
and f.deleted_at is null
order by f.modified_at desc")
(s/def ::get-project-files
(s/keys :req [::rpc/profile-id] :req-un [::project-id]))
(defn get-project-files
[conn project-id]
(db/exec! conn [sql:project-files project-id]))
(sv/defmethod ::get-project-files
"Get all files for the specified project."
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params [:map {:title "get-project-files"}
[:project-id ::sm/uuid]]
::sm/result [:vector ::file]}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id project-id]}]
(dm/with-open [conn (db/open pool)]
(projects/check-read-permissions! conn profile-id project-id)
@ -362,15 +402,12 @@
(declare get-has-file-libraries)
(s/def ::file-id ::us/uuid)
(s/def ::has-file-libraries
(s/keys :req [::rpc/profile-id]
:req-un [::file-id]))
(sv/defmethod ::has-file-libraries
"Checks if the file has libraries. Returns a boolean"
{::doc/added "1.15.1"}
{::doc/added "1.15.1"
::sm/params [:map {:title "has-file-libraries"}
[:file-id ::sm/uuid]]
::sm/result :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)
@ -398,7 +435,7 @@
structure."
[{:keys [objects] :as page} object-id]
(let [objects (cph/get-children-with-self objects object-id)]
(assoc page :objects (d/index-by :id objects))))
(assoc page :objects (d/index-by :id objects))))
(defn- prune-thumbnails
"Given the page data, removes the `:thumbnail` prop from all
@ -408,6 +445,12 @@
(defn get-page
[conn {:keys [file-id page-id object-id features]}]
(when (and (uuid? object-id)
(not (uuid? page-id)))
(ex/raise :type :validation
:code :params-validation
:hint "page-id is required when object-id is provided"))
(let [file (get-file conn file-id features)
page-id (or page-id (-> file :data :pages first))
page (dm/get-in file [:data :pages-index page-id])]
@ -415,17 +458,11 @@
(uuid? object-id)
(prune-objects object-id))))
(s/def ::page-id ::us/uuid)
(s/def ::object-id ::us/uuid)
(s/def ::get-page
(s/and
(s/keys :req [::rpc/profile-id]
:req-un [::file-id]
:opt-un [::page-id ::object-id ::features])
(fn [obj]
(if (contains? obj :object-id)
(contains? obj :page-id)
true))))
(sm/def! ::get-page
[:map {:title "GetPage"}
[:page-id {:optional true} ::sm/uuid]
[:object-id {:optional true} ::sm/uuid]
[:features {:optional true} ::features]])
(sv/defmethod ::get-page
"Retrieves the page data from file and returns it. If no page-id is
@ -437,7 +474,8 @@
mandatory.
Mainly used for rendering purposes."
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params ::get-page}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
(dm/with-open [conn (db/open pool)]
(check-read-permissions! conn profile-id file-id)
@ -635,13 +673,30 @@
:modified-at (dt/now)}
{:id id}))
(s/def ::rename-file
(s/keys :req [::rpc/profile-id]
:req-un [::name ::id]))
(sv/defmethod ::rename-file
{::doc/added "1.17"
::webhooks/event? true}
::webhooks/event? true
::sm/webhook
[:map {:title "RenameFileEvent"}
[:id ::sm/uuid]
[:project-id ::sm/uuid]
[:name :string]
[:created-at ::dt/instant]
[:modified-at ::dt/instant]]
::sm/params
[:map {:title "RenameFileParams"}
[:name {:min 1} :string]
[:id ::sm/uuid]]
::sm/result
[:map {:title "SimplifiedFile"}
[:id ::sm/uuid]
[:name :string]
[:created-at ::dt/instant]
[:modified-at ::dt/instant]]}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
(db/with-atomic [conn pool]
(check-edition-permissions! conn profile-id id)
@ -673,6 +728,7 @@
(let [ldata (-> library decode-row pmg/migrate-file :data)]
(binding [pmap/*load-fn* (partial load-pointer conn id)]
(load-all-pointers! ldata))
(->> (db/query conn :file-library-rel {:library-file-id id})
(map :file-id)
(keep #(db/get-by-id conn :file % ::db/check-deleted? false))

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

@ -40,21 +40,19 @@
:or {is-shared false revn 0 create-page true}
:as params}]
(db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED;"])
(let [id (or id (uuid/next))
features (->> features
(into (files/get-default-features))
(files/check-features-compatibility!))
data (binding [pmap/*tracked* (atom {})
pointers (atom {})
data (binding [pmap/*tracked* pointers
ffeat/*current* features
ffeat/*wrap-with-objects-map-fn* (if (features "storate/objects-map") omap/wrap identity)
ffeat/*wrap-with-pointer-map-fn* (if (features "storage/pointer-map") pmap/wrap identity)]
(let [data (if create-page
(ctf/make-file-data id)
(ctf/make-file-data id nil))]
(files/persist-pointers! conn id)
data))
(if create-page
(ctf/make-file-data id)
(ctf/make-file-data id nil)))
features (db/create-array conn "text" features)
file (db/insert! conn :file
@ -70,6 +68,9 @@
:modified-at modified-at
:deleted-at deleted-at}))]
(binding [pmap/*tracked* pointers]
(files/persist-pointers! conn id))
(->> (assoc params :file-id id :role :owner)
(create-file-role! conn))
@ -89,6 +90,7 @@
(sv/defmethod ::create-file
{::doc/added "1.17"
::doc/module :files
::webhooks/event? true}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id project-id] :as params}]
(db/with-atomic [conn pool]

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

@ -36,7 +36,8 @@
Share links are resources that allows external users access to specific
pages of a file with specific permissions (who-comment and who-inspect)."
{::doc/added "1.18"}
{::doc/added "1.18"
::doc/module :files}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
(db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id file-id)
@ -62,7 +63,8 @@
:req-un [::us/id]))
(sv/defmethod ::delete-share-link
{::doc/added "1.18"}
{::doc/added "1.18"
::doc/module ::files}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
(db/with-atomic [conn pool]
(let [slink (db/get-by-id conn :share-link id)]

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

@ -36,7 +36,8 @@
::create-page]))
(sv/defmethod ::create-temp-file
{::doc/added "1.17"}
{::doc/added "1.17"
::doc/module :files}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id project-id] :as params}]
(db/with-atomic [conn pool]
(projects/check-edition-permissions! conn profile-id project-id)
@ -64,7 +65,8 @@
::files/id]))
(sv/defmethod ::update-temp-file
{::doc/added "1.17"}
{::doc/added "1.17"
::doc/module :files}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
(db/with-atomic [conn pool]
(update-temp-file conn (assoc params :profile-id profile-id))
@ -101,7 +103,8 @@
:req-un [::files/id]))
(sv/defmethod ::persist-temp-file
{::doc/added "1.17"}
{::doc/added "1.17"
::doc/module :files}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
(db/with-atomic [conn pool]
(files/check-edition-permissions! conn profile-id id)

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

@ -11,6 +11,7 @@
[app.common.exceptions :as ex]
[app.common.geom.shapes :as gsh]
[app.common.pages.helpers :as cph]
[app.common.schema :as sm]
[app.common.spec :as us]
[app.common.types.shape-tree :as ctt]
[app.config :as cf]
@ -65,13 +66,12 @@
(or (some-> row :media-id get-public-uri)
(:data row))))))))
(s/def ::file-id ::us/uuid)
(s/def ::get-file-object-thumbnails
(s/keys :req [::rpc/profile-id] :req-un [::file-id]))
(sv/defmethod ::get-file-object-thumbnails
"Retrieve a file object thumbnails."
{::doc/added "1.17"
::sm/params [:map {:title "get-file-object-thumbnails"}
[:file-id ::sm/uuid]]
::sm/result [:map-of :string :string]
::cond/get-object #(files/get-minimal-file %1 (:file-id %2))
::cond/reuse-key? true
::cond/key-fn files/get-file-etag}
@ -102,6 +102,7 @@
:file-id (:file-id row)}))
(s/def ::revn ::us/integer)
(s/def ::file-id ::us/uuid)
(s/def ::get-file-thumbnail
(s/keys :req [::rpc/profile-id]
@ -217,15 +218,18 @@
:always
(update :objects assoc-thumbnails page-id thumbs))))))
(s/def ::get-file-data-for-thumbnail
(s/keys :req [::rpc/profile-id]
:req-un [::file-id]
:opt-un [::features]))
(sv/defmethod ::get-file-data-for-thumbnail
"Retrieves the data for generate the thumbnail of the file. Used
mainly for render thumbnails on dashboard."
{::doc/added "1.17"}
{::doc/added "1.17"
::sm/params [:map {:title "get-file-data-for-thumbnail"}
[:file-id ::sm/uuid]
[:features {:optional true} ::files/features]]
::sm/result [:map {:title "PartialFile"}
[:id ::sm/uuid]
[:revn {:min 0} :int]
[:page :any]]}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id features] :as props}]
(dm/with-open [conn (db/open pool)]
(files/check-read-permissions! conn profile-id file-id)

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

@ -10,7 +10,10 @@
[app.common.files.features :as ffeat]
[app.common.logging :as l]
[app.common.pages :as cp]
[app.common.pages.changes :as cpc]
[app.common.pages.migrations :as pmg]
[app.common.schema :as sm]
[app.common.schema.generators :as smg]
[app.common.spec :as us]
[app.common.types.file :as ctf]
[app.common.uuid :as uuid]
@ -60,6 +63,40 @@
(or (contains? o :changes)
(contains? o :changes-with-metadata)))))
;; --- SCHEMA
(sm/def! ::changes
[:vector ::cpc/change])
(sm/def! ::change-with-metadata
[:map {:title "ChangeWithMetadata"}
[:changes ::changes]
[:hint-origin {:optional true} :keyword]
[:hint-events {:optional true} [:vector :string]]])
(sm/def! ::update-file-params
[:map {:title "UpdateFileParams"}
[:id ::sm/uuid]
[:session-id ::sm/uuid]
[:revn {:min 0} :int]
[:features {:optional true
:gen/max 3
:gen/gen (smg/subseq files/supported-features)}
::sm/set-of-strings]
[:changes {:optional true} ::changes]
[:changes-with-metadata {:optional true}
[:vector ::change-with-metadata]]])
(sm/def! ::update-file-result
[:vector {:title "UpdateFileResults"}
[:map {:title "UpdateFileResult"}
[:changes ::changes]
[:file-id ::sm/uuid]
[:id ::sm/uuid]
[:revn {:min 0} :int]
[:session-id ::sm/uuid]]])
;; --- HELPERS
;; File changes that affect to the library, and must be notified
@ -130,6 +167,11 @@
::webhooks/event? true
::webhooks/batch-timeout (dt/duration "2m")
::webhooks/batch-key (webhooks/key-fn ::rpc/profile-id :id)
::sm/params ::update-file-params
::sm/result ::update-file-result
::doc/module :files
::doc/added "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
(db/with-atomic [conn pool]

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

@ -8,8 +8,9 @@
(:require
[app.auth :as auth]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.common.schema :as sm]
[app.common.uuid :as uuid]
[app.config :as cf]
[app.db :as db]
@ -37,19 +38,35 @@
(declare strip-private-attrs)
(declare verify-password)
;; --- QUERY: Get profile (own)
(def schema:profile
[:map {:title "Profile"}
[:id ::sm/uuid]
[:fullname :string]
[:email ::sm/email]
[:is-active {:optional true} :boolean]
[:is-blocked {:optional true} :boolean]
[:is-demo {:optional true} :boolean]
[:is-muted {:optional true} :boolean]
[:created-at {:optional true} ::sm/inst]
[:modified-at {:optional true} ::sm/inst]
[:default-project-id {:optional true} ::sm/uuid]
[:default-team-id {:optional true} ::sm/uuid]
[:props {:optional true}
[:map-of {:title "ProfileProps"} :keyword :any]]])
(s/def ::get-profile
(s/keys :opt [::rpc/profile-id]))
(def profile?
(sm/pred-fn schema:profile))
;; --- QUERY: Get profile (own)
(sv/defmethod ::get-profile
{::rpc/auth false
::doc/added "1.18"}
::doc/added "1.18"
::sm/result schema:profile}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id]}]
;; We need to return the anonymous profile object in two cases, when
;; no profile-id is in session, and when db call raises not found. In all other
;; cases we need to reraise the exception.
(try
(-> (get-profile pool profile-id)
(strip-private-attrs)
@ -63,22 +80,21 @@
(-> (db/get-by-id conn :profile id attrs)
(decode-row)))
;; --- MUTATION: Update Profile (own)
(s/def ::email ::us/email)
(s/def ::fullname ::us/not-empty-string)
(s/def ::lang ::us/string)
(s/def ::theme ::us/string)
(s/def ::update-profile
(s/keys :req [::rpc/profile-id]
:req-un [::fullname]
:opt-un [::lang ::theme]))
(sv/defmethod ::update-profile
{::doc/added "1.0"}
{::doc/added "1.0"
::sm/params [:map {:title "UpdateProfileParams"}
[:fullname {:min 1} :string]
[:lang {:optional true} :string]
[:theme {:optional true} :string]]
::sm/result schema:profile}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id fullname lang theme] :as params}]
(dm/assert!
"expected valid profile data"
(profile? params))
(db/with-atomic [conn pool]
;; NOTE: we need to retrieve the profile independently if we use
;; it or not for explicit locking and avoid concurrent updates of
@ -112,14 +128,13 @@
(declare update-profile-password!)
(declare invalidate-profile-session!)
(s/def ::password ::us/not-empty-string)
(s/def ::old-password (s/nilable ::us/string))
(s/def ::update-profile-password
(s/keys :req [::rpc/profile-id]
:req-un [::password ::old-password]))
(sv/defmethod ::update-profile-password
{:doc/added "1.0"
::sm/params [:map {:title "UpdateProfilePasswordParams"}
[:password :string]
[:old-password :string]]
::sm/result :nil}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id password] :as params}]
(db/with-atomic [conn pool]
(let [cfg (assoc cfg ::db/conn conn)
@ -163,12 +178,11 @@
(declare upload-photo)
(declare update-profile-photo)
(s/def ::file ::media/upload)
(s/def ::update-profile-photo
(s/keys :req [::rpc/profile-id]
:req-un [::file]))
(sv/defmethod ::update-profile-photo
{:doc/added "1.1"
::sm/params [:map {:title "UpdateProfilePhotoParams"}
[:file ::media/upload]]
::sm/result :nil}
[cfg {:keys [::rpc/profile-id file] :as params}]
;; Validate incoming mime type
(media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})

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

@ -8,57 +8,197 @@
"API autogenerated documentation."
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.pprint :as pp]
[app.common.schema :as sm]
[app.common.schema.desc-js-like :as smdj]
[app.common.schema.desc-native :as smdn]
[app.common.schema.openapi :as oapi]
[app.common.schema.registry :as sr]
[app.config :as cf]
[app.loggers.webhooks :as-alias webhooks]
[app.rpc :as-alias rpc]
[app.util.json :as json]
[app.util.services :as sv]
[app.util.template :as tmpl]
[clojure.java.io :as io]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[integrant.core :as ig]
[malli.transform :as mt]
[pretty-spec.core :as ps]
[yetti.response :as yrs]))
(defn- get-spec-str
[k]
(with-out-str
(ps/pprint (s/form k)
{:ns-aliases {"clojure.spec.alpha" "s"
"clojure.core.specs.alpha" "score"
"clojure.core" nil}})))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; DOC (human readable)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- prepare-context
(defn- prepare-doc-context
[methods]
(letfn [(gen-doc [[{:keys [::sv/name] :as mdata} _f]]
{:name (d/name name)
:module (-> (:ns mdata) (str/split ".") last)
(letfn [(fmt-spec [mdata]
(when-let [spec (ex/ignoring (s/spec (::sv/spec mdata)))]
(with-out-str
(ps/pprint (s/form spec)
{:ns-aliases {"clojure.spec.alpha" "s"
"clojure.core.specs.alpha" "score"
"clojure.core" nil}}))))
(fmt-schema [type mdata key]
(when-let [schema (get mdata key)]
(if (= type :js)
(smdj/describe (sm/schema schema) {::smdj/max-level 4})
(-> (smdn/describe (sm/schema schema))
(pp/pprint-str {:level 5 :width 70})))))
(get-context [mdata]
{:name (::sv/name mdata)
:module (or (some-> (::module mdata) d/name)
(-> (:ns mdata) (str/split ".") last))
:auth (:auth mdata true)
:webhook (::webhooks/event? mdata false)
:docs (::sv/docstring mdata)
:deprecated (::deprecated mdata)
:added (::added mdata)
:changes (some->> (::changes mdata) (partition-all 2) (map vec))
:spec (get-spec-str (::sv/spec mdata))})]
:spec (fmt-spec mdata)
:entrypoint (str (cf/get :public-uri) "/api/rpc/commands/" (::sv/name mdata))
:params-schema-js (fmt-schema :js mdata ::sm/params)
:result-schema-js (fmt-schema :js mdata ::sm/result)
:webhook-schema-js (fmt-schema :js mdata ::sm/webhook)
:params-schema-clj (fmt-schema :clj mdata ::sm/params)
:result-schema-clj (fmt-schema :clj mdata ::sm/result)
:webhook-schema-clj (fmt-schema :clj mdata ::sm/webhook)})]
{:version (:main cf/version)
:methods
(->> methods
(map val)
(map gen-doc)
(map first)
(map get-context)
(sort-by (juxt :module :name)))}))
(defn- handler
[methods]
(defn- doc-handler
[context]
(if (contains? cf/flags :backend-api-doc)
(let [context (prepare-context methods)]
(fn [_]
(fn [request]
(let [params (:query-params request)
pstyle (:type params "js")
context (assoc context :param-style pstyle)]
{::yrs/status 200
::yrs/body (-> (io/resource "app/templates/api-doc.tmpl")
(tmpl/render context))}))
(fn [_]
{::yrs/status 404})))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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}}}}))
(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}}}))
(gen-method-doc [options mdata]
(let [pschema (::sm/params mdata)
rschema (::sm/result mdata)
sparams (-> pschema (oapi/transform options) (gen-params-doc pschema))
sresp (some-> rschema (oapi/transform options) (gen-response-doc rschema))
rpost {:description (::sv/docstring mdata)
:deprecated (::deprecated mdata false)
:requestBody sparams}
rpost (cond-> rpost
(some? sresp)
(assoc :responses sresp))]
{:name (-> mdata ::sv/name d/name)
:module (-> (:ns mdata) (str/split ".") last)
:repr {:post rpost}}))
]
(let [definitions (atom {})
options {:registry sr/default-registry
::oapi/definitions-path "#/components/schemas/"
::oapi/definitions definitions}
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 "/commands/%" (: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 []}
:paths paths
:components {:schemas @definitions}})))
(defn openapi-json-handler
[context]
(if (contains? cf/flags :backend-openapi-doc)
(fn [_]
{::yrs/status 200
::yrs/headers {"content-type" "application/json; charset=utf-8"}
::yrs/body (json/encode context)})
(fn [_]
{::yrs/status 404})))
(defn openapi-handler
[]
(if (contains? cf/flags :backend-openapi-doc)
(fn [_]
(let [swagger-js (slurp (io/resource "app/assets/swagger-ui-4.18.3.js"))
swagger-cs (slurp (io/resource "app/assets/swagger-ui-4.18.3.css"))
context {:public-uri (cf/get :public-uri)
:swagger-js swagger-js
:swagger-css swagger-cs}]
{::yrs/status 200
::yrs/headers {"content-type" "text/html"}
::yrs/body (-> (io/resource "app/templates/openapi.tmpl")
(tmpl/render context))}))
(fn [_]
{::yrs/status 404})))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MODULE INIT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(s/def ::routes vector?)
(defmethod ig/pre-init-spec ::routes [_]
@ -66,6 +206,18 @@
(defmethod ig/init-key ::routes
[_ {:keys [methods] :as cfg}]
["/_doc" {:handler (handler methods)
:allowed-methods #{:get}}])
[(let [context (prepare-doc-context methods)]
[["/_doc"
{:handler (doc-handler context)
:allowed-methods #{:get}}]
["/doc"
{:handler (doc-handler context)
:allowed-methods #{:get}}]])
(let [context (prepare-openapi-context methods)]
[["/openapi"
{:handler (openapi-handler)
:allowed-methods #{:get}}]
["/openapi.json"
{:handler (openapi-json-handler context)
:allowed-methods #{:get}}]])])

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

@ -8,9 +8,20 @@
"A permission checking helper factories."
(:require
[app.common.exceptions :as ex]
[app.common.schema :as sm]
[app.common.spec :as us]
[clojure.spec.alpha :as s]))
(sm/def! ::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]])
(s/def ::role #{:admin :owner :editor :viewer})
(defn assign-role-flags

9
backend/src/app/rpc/rlimit.clj
View file

@ -212,10 +212,11 @@
(into [] (map #(assoc % ::service sname)) limits)))
(defn- get-uid
[{:keys [::http/request] :as params}]
(or (::rpc/profile-id params)
(some-> request parse-client-ip)
uuid/zero))
[{:keys [::rpc/profile-id] :as params}]
(let [request (-> params meta ::http/request)]
(or profile-id
(some-> request parse-client-ip)
uuid/zero)))
(defn process-request!
[{:keys [::rpc/rlimit ::rds/redis ::skey ::sname] :as cfg} params]

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

@ -155,7 +155,7 @@
(defn write-char
[n w o]
(write-tag! w n 1)
(write-int! w o))
(write-int! w (int o)))
(defn read-char
[rdr]
@ -259,8 +259,8 @@
:rfn (comp vec read-object!)}
{:name "clj/list"
:class clojure.lang.IPersistentList
:wfn write-list-like
;; :class clojure.lang.IPersistentList
;; :wfn write-list-like
:rfn #(apply list (read-object! %))}
{:name "clj/seq"

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

@ -8,8 +8,11 @@
(:require
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.schema :as sm]
[app.common.schema.openapi :as-alias oapi]
[app.common.time :as common-time]
[clojure.spec.alpha :as s]
[clojure.test.check.generators :as tgen]
[cuerdas.core :as str]
[fipp.ednize :as fez])
(:import
@ -358,3 +361,27 @@
[]
(let [p1 (System/nanoTime)]
#(duration {:nanos (- (System/nanoTime) p1)})))
(sm/def! ::instant
{:type ::instant
:pred instant?
:type-properties
{:error/message "should be an instant"
:title "instant"
::sm/decode instant
:gen/gen (tgen/fmap (fn [i] (in-past i)) tgen/pos-int)
::oapi/type "string"
::oapi/format "iso"
}})
(sm/def! ::duration
{:type :durations
:pred duration?
:type-properties
{:error/message "should be a duration"
:gen/gen (tgen/fmap duration tgen/pos-int)
:title "duration"
::sm/decode duration
::oapi/type "string"
::oapi/format "duration"
}})