3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-08-07 14:38:33 +02:00
Code Issues Projects Releases Packages Wiki Activity

Merge pull request #2077 from penpot/niwinz-asserts-improvements

Browse source 
Asserts & binfile cosmetic refactor
This commit is contained in:
Alejandro 2022-07-07 13:19:02 +02:00 • committed by GitHub
commit 602cead4ae
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
12 changed files with 315 additions and 267 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -11,6 +11,7 @@
[app.common.data :as d] [app.common.data :as d]
[app.common.exceptions :as ex] [app.common.exceptions :as ex]
[app.common.flags :as flags] [app.common.flags :as flags]
[app.common.logging :as l]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.version :as v] [app.common.version :as v]
[app.util.time :as dt] [app.util.time :as dt]
@ -83,13 +84,10 @@
;; a server prop key where initial project is stored. ;; a server prop key where initial project is stored.
:initial-project-skey "initial-project"}) :initial-project-skey "initial-project"})
(s/def ::flags ::us/set-of-keywords) (s/def ::flags ::us/vec-of-keywords)
;; DEPRECATED PROPERTIES ;; DEPRECATED PROPERTIES
(s/def ::registration-enabled ::us/boolean)
(s/def ::smtp-enabled ::us/boolean)
(s/def ::telemetry-enabled ::us/boolean) (s/def ::telemetry-enabled ::us/boolean)
(s/def ::asserts-enabled ::us/boolean)
;; END DEPRECATED ;; END DEPRECATED
(s/def ::audit-log-archive-uri ::us/string) (s/def ::audit-log-archive-uri ::us/string)
@ -273,7 +271,6 @@
::public-uri ::public-uri
::redis-uri ::redis-uri
::registration-domain-whitelist ::registration-domain-whitelist
::registration-enabled
::rlimit-font ::rlimit-font
::rlimit-file-update ::rlimit-file-update
::rlimit-image ::rlimit-image
@ -284,7 +281,6 @@
::sentry-trace-sample-rate ::sentry-trace-sample-rate
::smtp-default-from ::smtp-default-from
::smtp-default-reply-to ::smtp-default-reply-to
::smtp-enabled
::smtp-host ::smtp-host
::smtp-password ::smtp-password
::smtp-port ::smtp-port
@ -351,8 +347,12 @@
(str/trim)) (str/trim))
"%version%"))) "%version%")))
(def ^:dynamic config (read-config)) (defonce ^:dynamic config (read-config))
(def ^:dynamic flags (parse-flags config))
(defonce ^:dynamic flags
(let [flags (parse-flags config)]
(l/info :hint "flags initialized" :flags (str/join "," (map name flags)))
flags))
(def deletion-delay (def deletion-delay
(dt/duration {:days 7})) (dt/duration {:days 7}))

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

@ -268,7 +268,7 @@
(let [file-ids (->> (:file-ids params) (let [file-ids (->> (:file-ids params)
(remove empty?) (remove empty?)
(map parse-uuid)) (mapv parse-uuid))
libs? (contains? params :includelibs) libs? (contains? params :includelibs)
clone? (contains? params :clone) clone? (contains? params :clone)
embed? (contains? params :embedassets)] embed? (contains? params :embedassets)]

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

@ -71,7 +71,7 @@
[error request] [error request]
(let [edata (ex-data error) (let [edata (ex-data error)
explain (us/pretty-explain edata)] explain (us/pretty-explain edata)]
(l/error ::l/raw (ex-message error) (l/error ::l/raw (str (ex-message error) "\n" explain)
::l/context (get-context request) ::l/context (get-context request)
:cause error) :cause error)
(yrs/response :status 500 (yrs/response :status 500

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

@ -16,7 +16,7 @@
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.media :as media] [app.media :as media]
[app.rpc.queries.files :refer [decode-row check-edition-permissions!]] [app.rpc.queries.files :as files]
[app.rpc.queries.profile :as profile] [app.rpc.queries.profile :as profile]
[app.storage :as sto] [app.storage :as sto]
[app.storage.tmp :as tmp] [app.storage.tmp :as tmp]
@ -41,7 +41,32 @@
(set! *warn-on-reflection* true) (set! *warn-on-reflection* true)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LOW LEVEL STREAM IO ;; VARS & DEFAULTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Threshold in MiB when we pass from using
;; in-memory byte-array's to use temporal files.
(def temp-file-threshold
(* 1024 1024 2))
;; Represents the current processing file-id on
;; export process.
(def ^:dynamic *file-id*)
;; Stores all media file object references of
;; processed files on import process.
(def ^:dynamic *media*)
;; Stores the objects index on reamping subprocess
;; part of the import process.
(def ^:dynamic *index*)
;; Has the current connection used on the import
;; process.
(def ^:dynamic *conn*)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LOW LEVEL STREAM IO API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:const buffer-size (:xnio/buffer-size yt/defaults)) (def ^:const buffer-size (:xnio/buffer-size yt/defaults))
@ -62,18 +87,6 @@
:code :invalid-mark-id :code :invalid-mark-id
:hint (format "invalid mark id %s" id)))) :hint (format "invalid mark id %s" id))))
;; (defn buffered-output-stream
;; "Returns a buffered output stream that ignores flush calls. This is
;; needed because transit-java calls flush very aggresivelly on each
;; object write."
;; [^java.io.OutputStream os ^long chunk-size]
;; (proxy [java.io.BufferedOutputStream] [os (int chunk-size)]
;; ;; Explicitly do not forward flush
;; (flush [])
;; (close []
;; (proxy-super flush)
;; (proxy-super close)))
(defmacro assert (defmacro assert
[expr hint] [expr hint]
`(when-not ~expr `(when-not ~expr
@ -98,7 +111,7 @@
:code :unexpected-label :code :unexpected-label
:hint (format "received label %s, expected %s" v# ~label))))) :hint (format "received label %s, expected %s" v# ~label)))))
;; --- PRIMITIVE ;; --- PRIMITIVE IO
(defn write-byte! (defn write-byte!
[^DataOutputStream output data] [^DataOutputStream output data]
@ -142,7 +155,7 @@
(swap! *position* + readed) (swap! *position* + readed)
readed)) readed))
;; --- COMPOSITE ;; --- COMPOSITE IO
(defn write-uuid! (defn write-uuid!
[^DataOutputStream output id] [^DataOutputStream output id]
@ -241,9 +254,6 @@
(copy-stream! output stream size)) (copy-stream! output stream size))
(def size-2mib
(* 1024 1024 2))
(defn read-stream! (defn read-stream!
[^DataInputStream input] [^DataInputStream input]
(l/trace :fn "read-stream!" :position @*position* ::l/async false) (l/trace :fn "read-stream!" :position @*position* ::l/async false)
@ -257,15 +267,12 @@
:code :max-file-size-reached :code :max-file-size-reached
:hint (str/ffmt "unable to import storage object with size % bytes" s))) :hint (str/ffmt "unable to import storage object with size % bytes" s)))
(if (> s size-2mib) (if (> s temp-file-threshold)
;; If size is more than 2MiB, use a temporal file.
(with-open [^OutputStream output (io/output-stream p)] (with-open [^OutputStream output (io/output-stream p)]
(let [readed (bs/copy! input output :offset 0 :size s)] (let [readed (bs/copy! input output :offset 0 :size s)]
(l/trace :fn "read-stream*!" :expected s :readed readed :position @*position* ::l/async false) (l/trace :fn "read-stream*!" :expected s :readed readed :position @*position* ::l/async false)
(swap! *position* + readed) (swap! *position* + readed)
[s p])) [s p]))
;; If not, use an in-memory byte-array.
[s (bs/read-as-bytes input :size s)]))) [s (bs/read-as-bytes input :size s)])))
(defmacro assert-read-label! (defmacro assert-read-label!
@ -278,13 +285,15 @@
:hint (format "unxpected label found: %s, expected: %s" readed# expected#))))) :hint (format "unxpected label found: %s, expected: %s" readed# expected#)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; HIGH LEVEL IMPL ;; API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; --- HELPERS
(defn- retrieve-file (defn- retrieve-file
[pool file-id] [pool file-id]
(->> (db/query pool :file {:id file-id}) (->> (db/query pool :file {:id file-id})
(map decode-row) (map files/decode-row)
(first))) (first)))
(def ^:private sql:file-media-objects (def ^:private sql:file-media-objects
@ -333,57 +342,17 @@
(with-open [^AutoCloseable conn (db/open pool)] (with-open [^AutoCloseable conn (db/open pool)]
(db/exec! conn [sql:file-library-rels (db/create-array conn "uuid" ids)]))) (db/exec! conn [sql:file-library-rels (db/create-array conn "uuid" ids)])))
(defn- embed-file-assets ;; --- EXPORT WRITTER
[pool {:keys [id] :as file}]
(letfn [(walk-map-form [state form]
(cond
(uuid? (:fill-color-ref-file form))
(do
(vswap! state conj [(:fill-color-ref-file form) :colors (:fill-color-ref-id form)])
(assoc form :fill-color-ref-file id))
(uuid? (:stroke-color-ref-file form)) (s/def ::output bs/output-stream?)
(do (s/def ::file-ids (s/every ::us/uuid :kind vector? :min-count 1))
(vswap! state conj [(:stroke-color-ref-file form) :colors (:stroke-color-ref-id form)]) (s/def ::include-libraries? (s/nilable ::us/boolean))
(assoc form :stroke-color-ref-file id)) (s/def ::embed-assets? (s/nilable ::us/boolean))
(uuid? (:typography-ref-file form)) (s/def ::write-export-options
(do (s/keys :req-un [::db/pool ::sto/storage]
(vswap! state conj [(:typography-ref-file form) :typographies (:typography-ref-id form)]) :req [::output ::file-ids]
(assoc form :typography-ref-file id)) :opt [::include-libraries? ::embed-assets?]))
(uuid? (:component-file form))
(do
(vswap! state conj [(:component-file form) :components (:component-id form)])
(assoc form :component-file id))
:else
form))
(process-group-of-assets [data [lib-id items]]
;; NOTE: there are a posibility that shape refers to a not
;; existing file because the file was removed. In this
;; case we just ignore the asset.
(if-let [lib (retrieve-file pool lib-id)]
(reduce #(process-asset %1 lib %2) data items)
data))
(process-asset [data lib [bucket asset-id]]
(let [asset (get-in lib [:data bucket asset-id])
;; Add a special case for colors that need to have
;; correctly set the :file-id prop (pending of the
;; refactor that will remove it).
asset (cond-> asset
(= bucket :colors) (assoc :file-id id))]
(update data bucket assoc asset-id asset)))]
(update file :data (fn [data]
(let [assets (volatile! [])]
(walk/postwalk #(cond->> % (map? %) (walk-map-form assets)) data)
(->> (deref assets)
(filter #(as-> (first %) $ (and (uuid? $) (not= $ id))))
(d/group-by first rest)
(reduce process-group-of-assets data)))))))
(defn write-export! (defn write-export!
"Do the exportation of a speficied file in custom penpot binary "Do the exportation of a speficied file in custom penpot binary
@ -399,54 +368,25 @@
[{:keys [pool storage ::output ::file-ids ::include-libraries? ::embed-assets?] :as options}] [{:keys [pool storage ::output ::file-ids ::include-libraries? ::embed-assets?] :as options}]
(us/assert! :spec ::db/pool :val pool) (us/assert! ::write-export-options options)
(us/assert! :spec ::sto/storage :val storage)
(us/assert! (us/verify!
:expr (every? uuid? file-ids)
:hint "`files` should be a vector of uuid")
(us/assert!
:expr (bs/data-output-stream? output)
:hint "`output` should be an instance of OutputStream")
(us/assert!
:expr (d/boolean-or-nil? include-libraries?)
:hint "invalid value provided for `include-libraries?` option, expected boolean")
(us/assert!
:expr (d/boolean-or-nil? embed-assets?)
:hint "invalid value provided for `embed-assets?` option, expected boolean")
(us/assert!
:always? true
:expr (not (and include-libraries? embed-assets?)) :expr (not (and include-libraries? embed-assets?))
:hint "the `include-libraries?` and `embed-assets?` are mutally excluding options") :hint "the `include-libraries?` and `embed-assets?` are mutally excluding options")
(let [libs (when include-libraries? (retrieve-libraries pool file-ids)) (letfn [(write-header [output files]
files (into file-ids libs)
rels (when include-libraries? (retrieve-library-relations pool file-ids))
sids (volatile! #{})]
;; Write header with metadata
(l/debug :hint "exportation summary"
:files (count files)
:rels (count rels)
:embed-assets? embed-assets?
:include-libs? include-libraries?
::l/async false)
(let [sections [:v1/files :v1/rels :v1/sobjects] (let [sections [:v1/files :v1/rels :v1/sobjects]
mdata {:penpot-version (:full cf/version) mdata {:penpot-version (:full cf/version)
:sections sections :sections sections
:files files}] :files files}]
(write-header! output :version 1 :metadata mdata)) (write-header! output :version 1 :metadata mdata)))
(write-files [output files sids]
(l/debug :hint "write section" :section :v1/files :total (count files) ::l/async false) (l/debug :hint "write section" :section :v1/files :total (count files) ::l/async false)
(write-label! output :v1/files) (write-label! output :v1/files)
(doseq [file-id files] (doseq [file-id files]
(let [file (cond->> (retrieve-file pool file-id) (let [file (cond-> (retrieve-file pool file-id)
embed-assets? (embed-file-assets pool)) embed-assets? (update :data embed-file-assets file-id))
media (retrieve-file-media pool file)] media (retrieve-file-media pool file)]
;; Collect all storage ids for later write them all under ;; Collect all storage ids for later write them all under
@ -460,14 +400,16 @@
(doto output (doto output
(write-obj! file) (write-obj! file)
(write-obj! media)))) (write-obj! media)))))
(write-rels [output files]
(let [rels (when include-libraries? (retrieve-library-relations pool files))]
(l/debug :hint "write section" :section :v1/rels :total (count rels) ::l/async false) (l/debug :hint "write section" :section :v1/rels :total (count rels) ::l/async false)
(doto output (doto output
(write-label! :v1/rels) (write-label! :v1/rels)
(write-obj! rels)) (write-obj! rels))))
(let [sids (into [] @sids)] (write-sobjects [output sids]
(l/debug :hint "write section" (l/debug :hint "write section"
:section :v1/sobjects :section :v1/sobjects
:items (count sids) :items (count sids)
@ -492,15 +434,87 @@
(when (not= written size) (when (not= written size)
(ex/raise :type :validation (ex/raise :type :validation
:code :mismatch-readed-size :code :mismatch-readed-size
:hint (str/ffmt "found unexpected object size; size=% written=%" size written))))))))))) :hint (str/ffmt "found unexpected object size; size=% written=%" size written)))))))))
(embed-file-assets [data file-id]
(binding [*file-id* file-id]
(let [assets (volatile! [])]
(walk/postwalk #(cond-> % (map? %) (walk-map-form assets)) data)
(->> (deref assets)
(filter #(as-> (first %) $ (and (uuid? $) (not= $ file-id))))
(d/group-by first rest)
(reduce process-group-of-assets data)))))
;; Dynamic variables for importation process. (walk-map-form [form state]
(cond
(uuid? (:fill-color-ref-file form))
(do
(vswap! state conj [(:fill-color-ref-file form) :colors (:fill-color-ref-id form)])
(assoc form :fill-color-ref-file *file-id*))
(def ^:dynamic *files*) (uuid? (:stroke-color-ref-file form))
(def ^:dynamic *media*) (do
(def ^:dynamic *index*) (vswap! state conj [(:stroke-color-ref-file form) :colors (:stroke-color-ref-id form)])
(def ^:dynamic *conn*) (assoc form :stroke-color-ref-file *file-id*))
(uuid? (:typography-ref-file form))
(do
(vswap! state conj [(:typography-ref-file form) :typographies (:typography-ref-id form)])
(assoc form :typography-ref-file *file-id*))
(uuid? (:component-file form))
(do
(vswap! state conj [(:component-file form) :components (:component-id form)])
(assoc form :component-file *file-id*))
:else
form))
(process-group-of-assets [data [lib-id items]]
;; NOTE: there are a posibility that shape refers to a not
;; existing file because the file was removed. In this
;; case we just ignore the asset.
(if-let [lib (retrieve-file pool lib-id)]
(reduce #(process-asset %1 lib %2) data items)
data))
(process-asset [data lib [bucket asset-id]]
(let [asset (get-in lib [:data bucket asset-id])
;; Add a special case for colors that need to have
;; correctly set the :file-id prop (pending of the
;; refactor that will remove it).
asset (cond-> asset
(= bucket :colors) (assoc :file-id *file-id*))]
(update data bucket assoc asset-id asset)))]
(with-open [output (bs/zstd-output-stream output :level 12)]
(with-open [output (bs/data-output-stream output)]
(let [libs (when include-libraries? (retrieve-libraries pool file-ids))
files (into file-ids libs)
sids (volatile! #{})]
;; Write header with metadata
(l/debug :hint "exportation summary"
:files (count files)
:embed-assets? embed-assets?
:include-libs? include-libraries?
::l/async false)
(write-header output files)
(write-files output files sids)
(write-rels output files)
(write-sobjects output (vec @sids)))))))
(s/def ::project-id ::us/uuid)
(s/def ::input bs/input-stream?)
(s/def ::overwrite? (s/nilable ::us/boolean))
(s/def ::migrate? (s/nilable ::us/boolean))
(s/def ::ignore-index-errors? (s/nilable ::us/boolean))
(s/def ::read-import-options
(s/keys :req-un [::db/pool ::sto/storage]
:req [::project-id ::input]
:opt [::overwrite? ::migrate? ::ignore-index-errors?]))
(defn read-import! (defn read-import!
"Do the importation of the specified resource in penpot custom binary "Do the importation of the specified resource in penpot custom binary
@ -517,9 +531,11 @@
happen with broken files; defaults to: `false`. happen with broken files; defaults to: `false`.
" "
[{:keys [pool storage ::project-id ::ts ::input ::overwrite? ::migrate? ::ignore-index-errors?] [{:keys [pool storage ::project-id ::timestamp ::input ::overwrite? ::migrate? ::ignore-index-errors?]
:or {overwrite? false migrate? false ts (dt/now)} :or {overwrite? false migrate? false timestamp (dt/now)}
:as cfg}] :as options}]
(us/assert! ::read-import-options options)
(letfn [(lookup-index [id] (letfn [(lookup-index [id]
(if ignore-index-errors? (if ignore-index-errors?
@ -608,12 +624,12 @@
(:modified-at params) (:modified-at params)
(:data params)]))) (:data params)])))
(read-files-section! [input] (read-files-section! [input expected-files]
(l/debug :hint "reading section" :section :v1/files ::l/async false) (l/debug :hint "reading section" :section :v1/files ::l/async false)
(assert-read-label! input :v1/files) (assert-read-label! input :v1/files)
;; Process/Read all file ;; Process/Read all file
(doseq [expected-file-id *files*] (doseq [expected-file-id expected-files]
(let [file (read-obj! input) (let [file (read-obj! input)
media' (read-obj! input) media' (read-obj! input)
file-id (:id file)] file-id (:id file)]
@ -648,8 +664,8 @@
:revn (:revn file) :revn (:revn file)
:is-shared (:is-shared file) :is-shared (:is-shared file)
:data (blob/encode data) :data (blob/encode data)
:created-at ts :created-at timestamp
:modified-at ts}] :modified-at timestamp}]
(l/trace :hint "create file" :id file-id' ::l/async false) (l/trace :hint "create file" :id file-id' ::l/async false)
@ -668,7 +684,7 @@
;; Insert all file relations ;; Insert all file relations
(doseq [rel rels] (doseq [rel rels]
(let [rel (-> rel (let [rel (-> rel
(assoc :synced-at ts) (assoc :synced-at timestamp)
(update :file-id lookup-index) (update :file-id lookup-index)
(update :library-file-id lookup-index))] (update :library-file-id lookup-index))]
(l/trace :hint "create file library link" (l/trace :hint "create file library link"
@ -717,13 +733,7 @@
(update :file-id lookup-index) (update :file-id lookup-index)
(d/update-when :media-id lookup-index) (d/update-when :media-id lookup-index)
(d/update-when :thumbnail-id lookup-index)) (d/update-when :thumbnail-id lookup-index))
{:on-conflict-do-nothing overwrite?})))) {:on-conflict-do-nothing overwrite?}))))]
(read-section! [section input]
(case section
:v1/rels (read-rels-section! input)
:v1/files (read-files-section! input)
:v1/sobjects (read-sobjects-section! input)))]
(with-open [input (bs/zstd-input-stream input)] (with-open [input (bs/zstd-input-stream input)]
(with-open [input (bs/data-input-stream input)] (with-open [input (bs/data-input-stream input)]
@ -735,9 +745,13 @@
(l/debug :hint "import verified" :files files :overwrite? overwrite?) (l/debug :hint "import verified" :files files :overwrite? overwrite?)
(binding [*index* (volatile! (update-index {} files)) (binding [*index* (volatile! (update-index {} files))
*media* (volatile! []) *media* (volatile! [])
*files* files
*conn* conn] *conn* conn]
(run! #(read-section! % input) sections))))))))
(doseq [section sections]
(case section
:v1/rels (read-rels-section! input)
:v1/files (read-files-section! input files)
:v1/sobjects (read-sobjects-section! input))))))))))
(defn export! (defn export!
[cfg] [cfg]
@ -748,11 +762,9 @@
(try (try
(l/info :hint "start exportation" :export-id id) (l/info :hint "start exportation" :export-id id)
(with-open [output (io/output-stream path)] (with-open [output (io/output-stream path)]
(with-open [output (bs/zstd-output-stream output :level 12)]
(with-open [output (bs/data-output-stream output)]
(binding [*position* (atom 0)] (binding [*position* (atom 0)]
(write-export! (assoc cfg ::output output)) (write-export! (assoc cfg ::output output))
path)))) path))
(catch Throwable cause (catch Throwable cause
(vreset! cs cause) (vreset! cs cause)
@ -798,7 +810,7 @@
"Export a penpot file in a binary format." "Export a penpot file in a binary format."
[{:keys [pool] :as cfg} {:keys [profile-id file-id include-libraries? embed-assets?] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file-id include-libraries? embed-assets?] :as params}]
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
(check-edition-permissions! conn profile-id file-id) (files/check-read-permissions! conn profile-id file-id)
(let [path (export! (assoc cfg (let [path (export! (assoc cfg
::file-ids [file-id] ::file-ids [file-id]
::embed-assets? embed-assets? ::embed-assets? embed-assets?
@ -809,17 +821,16 @@
:body (io/input-stream path) :body (io/input-stream path)
:headers {"content-type" "application/octet-stream"}))})))) :headers {"content-type" "application/octet-stream"}))}))))
(s/def ::input ::media/upload) (s/def ::file ::media/upload)
(s/def ::import-binfile (s/def ::import-binfile
(s/keys :req-un [::profile-id ::input])) (s/keys :req-un [::profile-id ::file]))
(sv/defmethod ::import-binfile (sv/defmethod ::import-binfile
"Import a penpot file in a binary format." "Import a penpot file in a binary format."
[{:keys [pool] :as cfg} {:keys [profile-id input] :as params}] [{:keys [pool] :as cfg} {:keys [profile-id file] :as params}]
(let [project-id (some-> (profile/retrieve-additional-data pool profile-id) :default-project-id)] (let [project-id (-> (profile/retrieve-additional-data pool profile-id) :default-project-id)]
(import! (assoc cfg (import! (assoc cfg
::input (:path input) ::input (:path file)
::project-id project-id ::project-id project-id
::ignore-index-errors? true)))) ::ignore-index-errors? true))))

4
backend/src/app/util/bytes.clj
View file

@ -36,6 +36,10 @@
[s] [s]
(instance? OutputStream s)) (instance? OutputStream s))
(defn data-input-stream?
[s]
(instance? DataInputStream s))
(defn data-output-stream? (defn data-output-stream?
[s] [s]
(instance? DataOutputStream s)) (instance? DataOutputStream s))

139
common/src/app/common/spec.cljc
View file

@ -5,7 +5,7 @@
;; Copyright (c) UXBOX Labs SL ;; Copyright (c) UXBOX Labs SL
(ns app.common.spec (ns app.common.spec
"Data manipulation and query helper functions." "Data validation & assertion helpers."
(:refer-clojure :exclude [assert bytes?]) (:refer-clojure :exclude [assert bytes?])
#?(:cljs (:require-macros [app.common.spec :refer [assert]])) #?(:cljs (:require-macros [app.common.spec :refer [assert]]))
(:require (:require
@ -31,8 +31,6 @@
(def max-safe-int (int 1e6)) (def max-safe-int (int 1e6))
(def min-safe-int (int -1e6)) (def min-safe-int (int -1e6))
(def valid? s/valid?)
;; --- Conformers ;; --- Conformers
(defn uuid-conformer (defn uuid-conformer
@ -220,52 +218,29 @@
(fn [s] (fn [s]
(str/join "," s)))) (str/join "," s))))
;; --- Macros ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MACROS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn spec-assert* (defn explain-data
[spec val hint ctx] [spec value]
(if (s/valid? spec val) (s/explain-data spec value))
val
(let [data (s/explain-data spec val)] (defn valid?
[spec value]
(s/valid? spec value))
(defmacro assert-expr*
"Auxiliar macro for expression assertion."
[expr hint]
`(when-not ~expr
(ex/raise :type :assertion (ex/raise :type :assertion
:code :spec-validation :code :expr-validation
:hint hint :hint ~hint)))
::ex/data (merge ctx data)))))
(defmacro assert (defmacro assert-spec*
"Development only assertion macro." "Auxiliar macro for spec assertion."
[spec x] [spec value hint]
(when *assert*
(let [nsdata (:ns &env)
context (if nsdata
{:ns (str (:name nsdata))
:name (pr-str spec)
:line (:line &env)
:file (:file (:meta nsdata))}
(let [mdata (meta &form)]
{:ns (str (ns-name *ns*))
:name (pr-str spec)
:line (:line mdata)}))
message (str "spec assert: '" (pr-str spec) "'")]
`(spec-assert* ~spec ~x ~message ~context))))
(defmacro verify
"Always active assertion macro (does not obey to :elide-asserts)"
[spec x]
(let [nsdata (:ns &env)
context (when nsdata
{:ns (str (:name nsdata))
:name (pr-str spec)
:line (:line &env)
:file (:file (:meta nsdata))})
message (str "spec verify: '" (pr-str spec) "'")]
`(spec-assert* ~spec ~x ~message ~context)))
(defmacro assert!
"General purpose assertion macro."
[& {:keys [expr spec always? hint val]}]
(cond
(some? spec)
(let [context (if-let [nsdata (:ns &env)] (let [context (if-let [nsdata (:ns &env)]
{:ns (str (:name nsdata)) {:ns (str (:name nsdata))
:name (pr-str spec) :name (pr-str spec)
@ -274,19 +249,71 @@
{:ns (str (ns-name *ns*)) {:ns (str (ns-name *ns*))
:name (pr-str spec) :name (pr-str spec)
:line (:line (meta &form))}) :line (:line (meta &form))})
message (or hint (str "spec assert: " (pr-str spec)))] hint (or hint (str "spec assert: " (pr-str spec)))]
(when (or always? *assert*)
`(spec-assert* ~spec ~val ~message ~context)))
(some? expr) `(if (valid? ~spec ~value)
(let [message (or hint (str "expr assert: " (pr-str expr)))] ~value
(when (or always? *assert*) (let [data# (explain-data ~spec ~value)]
`(when-not ~expr
(ex/raise :type :assertion (ex/raise :type :assertion
:code :expr-validation :code :spec-validation
:hint ~message)))) :hint ~hint
::ex/data (merge ~context data#))))))
:else nil)) (defmacro assert
"Is a spec specific assertion macro that only evaluates if *assert*
is true. DEPRECATED: it should be replaced by the new, general
purpose assert! macro."
[spec value]
(when *assert*
`(assert-spec* ~spec ~value nil)))
(defmacro verify
"Is a spec specific assertion macro that evaluates always,
independently of *assert* value. DEPRECATED: should be replaced by
the new, general purpose `verify!` macro."
[spec value]
`(assert-spec* ~spec ~value nil))
(defmacro assert!
"General purpose assertion macro."
[& params]
;; If we only receive two arguments, this means we use the simplified form
(let [pcnt (count params)]
(cond
;; When we have a single argument, this means a simplified form
;; of expr assertion
(= 1 pcnt)
(let [expr (first params)
hint (str "expr assert failed:" (pr-str expr))]
(when *assert*
`(assert-expr* ~expr ~hint)))
;; If we have two arguments, this can be spec or expr
;; assertion. The spec assertion is determined if the first
;; argument is a qualified keyword.
(= 2 pcnt)
(let [[spec-or-expr value-or-msg] params]
(if (qualified-keyword? spec-or-expr)
`(assert-spec* ~spec-or-expr ~value-or-msg nil)
`(assert-expr* ~spec-or-expr ~value-or-msg)))
(= 3 pcnt)
(let [[spec value hint] params]
`(assert-spec* ~spec ~value ~hint))
:else
(let [{:keys [spec expr hint always? val]} params]
(when (or always? *assert*)
(if spec
`(assert-spec* ~spec ~val ~hint)
`(assert-expr* ~expr ~hint)))))))
(defmacro verify!
"A variant of `assert!` macro that evaluates always, independently
of the *assert* value."
[& params]
(binding [*assert* true]
`(assert! ~@params)))
;; --- Public Api ;; --- Public Api

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

@ -111,11 +111,11 @@
;; --- Helper Functions ;; --- Helper Functions
(defn ^boolean check-browser? [candidate] (defn ^boolean check-browser? [candidate]
(us/verify ::browser candidate) (us/verify! ::browser candidate)
(= candidate @browser)) (= candidate @browser))
(defn ^boolean check-platform? [candidate] (defn ^boolean check-platform? [candidate]
(us/verify ::platform candidate) (us/verify! ::platform candidate)
(= candidate @platform)) (= candidate @platform))
(defn resolve-profile-photo-url (defn resolve-profile-photo-url

10
frontend/src/app/main/data/users.cljs
View file

@ -206,7 +206,7 @@
;; the returned profile is an NOT authenticated profile, we ;; the returned profile is an NOT authenticated profile, we
;; proceed to logout and show an error message. ;; proceed to logout and show an error message.
(->> (rp/command :login-with-password (d/without-nils params)) (->> (rp/command! :login-with-password (d/without-nils params))
(rx/merge-map (fn [data] (rx/merge-map (fn [data]
(rx/merge (rx/merge
(rx/of (fetch-profile)) (rx/of (fetch-profile))
@ -292,7 +292,7 @@
(ptk/reify ::logout (ptk/reify ::logout
ptk/WatchEvent ptk/WatchEvent
(watch [_ _ _] (watch [_ _ _]
(->> (rp/command :logout) (->> (rp/command! :logout)
(rx/delay-at-least 300) (rx/delay-at-least 300)
(rx/catch (constantly (rx/of 1))) (rx/catch (constantly (rx/of 1)))
(rx/map #(logged-out params))))))) (rx/map #(logged-out params)))))))
@ -494,7 +494,7 @@
:or {on-error rx/throw :or {on-error rx/throw
on-success identity}} (meta data)] on-success identity}} (meta data)]
(->> (rp/command :request-profile-recovery data) (->> (rp/command! :request-profile-recovery data)
(rx/tap on-success) (rx/tap on-success)
(rx/catch on-error)))))) (rx/catch on-error))))))
@ -513,7 +513,7 @@
(let [{:keys [on-error on-success] (let [{:keys [on-error on-success]
:or {on-error rx/throw :or {on-error rx/throw
on-success identity}} (meta data)] on-success identity}} (meta data)]
(->> (rp/command :recover-profile data) (->> (rp/command! :recover-profile data)
(rx/tap on-success) (rx/tap on-success)
(rx/catch on-error)))))) (rx/catch on-error))))))
@ -524,7 +524,7 @@
(ptk/reify ::create-demo-profile (ptk/reify ::create-demo-profile
ptk/WatchEvent ptk/WatchEvent
(watch [_ _ _] (watch [_ _ _]
(->> (rp/command :create-demo-profile {}) (->> (rp/command! :create-demo-profile {})
(rx/map login))))) (rx/map login)))))

14
frontend/src/app/main/repo.cljs
View file

@ -76,12 +76,12 @@
(defn- send-command! (defn- send-command!
"A simple helper for a common case of sending and receiving transit "A simple helper for a common case of sending and receiving transit
data to the penpot mutation api." data to the penpot mutation api."
[id {:keys [blob? form-data?] :as params}] [id params {:keys [response-type form-data?]}]
(->> (http/send! {:method :post (->> (http/send! {:method :post
:uri (u/join base-uri "api/rpc/command/" (name id)) :uri (u/join base-uri "api/rpc/command/" (name id))
:credentials "include" :credentials "include"
:body (if form-data? (http/form-data params) (http/transit-data params)) :body (if form-data? (http/form-data params) (http/transit-data params))
:response-type (if blob? :blob :text)}) :response-type (or response-type :text)})
(rx/map http/conditional-decode-transit) (rx/map http/conditional-decode-transit)
(rx/mapcat handle-response))) (rx/mapcat handle-response)))
@ -105,7 +105,15 @@
(defmethod command :default (defmethod command :default
[id params] [id params]
(send-command! id params)) (send-command! id params nil))
(defmethod command :export-binfile
[id params]
(send-command! id params {:response-type :blob}))
(defmethod command :import-binfile
[id params]
(send-command! id params {:form-data? true}))
(defn query! (defn query!
([id] (query id {})) ([id] (query id {}))

4
frontend/src/app/main/ui/auth/register.cljs
View file

@ -90,7 +90,7 @@
(fn [form _event] (fn [form _event]
(reset! submitted? true) (reset! submitted? true)
(let [cdata (:clean-data @form)] (let [cdata (:clean-data @form)]
(->> (rp/command :prepare-register-profile cdata) (->> (rp/command! :prepare-register-profile cdata)
(rx/map #(merge % params)) (rx/map #(merge % params))
(rx/finalize #(reset! submitted? false)) (rx/finalize #(reset! submitted? false))
(rx/subs (rx/subs
@ -225,7 +225,7 @@
(fn [form _event] (fn [form _event]
(reset! submitted? true) (reset! submitted? true)
(let [params (:clean-data @form)] (let [params (:clean-data @form)]
(->> (rp/command :register-profile params) (->> (rp/command! :register-profile params)
(rx/finalize #(reset! submitted? false)) (rx/finalize #(reset! submitted? false))
(rx/subs on-success (rx/subs on-success
(partial handle-register-error form))))))] (partial handle-register-error form))))))]

3
frontend/src/app/worker/export.cljs
View file

@ -457,8 +457,7 @@
(fn [file] (fn [file]
(->> (rp/command! :export-binfile {:file-id (:id file) (->> (rp/command! :export-binfile {:file-id (:id file)
:include-libraries? (= export-type :all) :include-libraries? (= export-type :all)
:embed-assets? (= export-type :merge) :embed-assets? (= export-type :merge)})
:blob? true})
(rx/map #(hash-map :type :finish (rx/map #(hash-map :type :finish
:file-id (:id file) :file-id (:id file)
:filename (:name file) :filename (:name file)

3
frontend/src/app/worker/import.cljs
View file

@ -604,8 +604,7 @@
:response-type :blob :response-type :blob
:method :get}) :method :get})
(rx/map :body) (rx/map :body)
(rx/mapcat #(rp/command! :import-binfile {:input % (rx/mapcat #(rp/command! :import-binfile {:file %}))
:form-data? true}))
(rx/map (rx/map
(fn [_] (fn [_]
{:status :import-finish {:status :import-finish