Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-03-25 06:01:46 -05:00
Code Issues Activity

Merge pull request #3786 from penpot/niwinz-develop-repl-improvements

Browse source 
✨ 🐛 Enhancements & Bugfixes
This commit is contained in:
Alejandro 2023-11-14 12:30:08 +01:00 • committed by GitHub
commit 875e94fad2
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
36 changed files with 986 additions and 1644 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
backend/deps.edn
View file

@ -4,6 +4,8 @@
:deps
{penpot/common {:local/root "../common"}
org.clojure/clojure {:mvn/version "1.12.0-alpha5"}
org.clojure/tools.namespace {:mvn/version "1.4.4"}
com.github.luben/zstd-jni {:mvn/version "1.5.5-10"}
io.prometheus/simpleclient {:mvn/version "0.16.0"}
@ -26,6 +28,8 @@
com.github.seancorfield/next.jdbc {:mvn/version "1.3.894"}
metosin/reitit-core {:mvn/version "0.6.0"}
nrepl/nrepl {:mvn/version "1.1.0"}
cider/cider-nrepl {:mvn/version "0.43.1"}
org.postgresql/postgresql {:mvn/version "42.6.0"}
@ -61,7 +65,6 @@
{:dev
{:extra-deps
{com.bhauman/rebel-readline {:mvn/version "RELEASE"}
org.clojure/tools.namespace {:mvn/version "RELEASE"}
clojure-humanize/clojure-humanize {:mvn/version "0.2.2"}
org.clojure/data.csv {:mvn/version "RELEASE"}
com.clojure-goes-fast/clj-async-profiler {:mvn/version "RELEASE"}

34
backend/dev/user.clj
View file

@ -122,23 +122,23 @@
(stop)
(repl/refresh-all :after 'user/start))
(defn compression-bench
[data]
(let [humanize (fn [v] (hum/filesize v :binary true :format " %.4f "))
v1 (time (humanize (alength (blob/encode data {:version 1}))))
v3 (time (humanize (alength (blob/encode data {:version 3}))))
v4 (time (humanize (alength (blob/encode data {:version 4}))))
v5 (time (humanize (alength (blob/encode data {:version 5}))))
v6 (time (humanize (alength (blob/encode data {:version 6}))))
]
(print-table
[{
:v1 v1
:v3 v3
:v4 v4
:v5 v5
:v6 v6
}])))
;; (defn compression-bench
;; [data]
;; (let [humanize (fn [v] (hum/filesize v :binary true :format " %.4f "))
;; v1 (time (humanize (alength (blob/encode data {:version 1}))))
;; v3 (time (humanize (alength (blob/encode data {:version 3}))))
;; v4 (time (humanize (alength (blob/encode data {:version 4}))))
;; v5 (time (humanize (alength (blob/encode data {:version 5}))))
;; v6 (time (humanize (alength (blob/encode data {:version 6}))))
;; ]
;; (print-table
;; [{
;; :v1 v1
;; :v3 v3
;; :v4 v4
;; :v5 v5
;; :v6 v6
;; }])))
(defonce debug-tap
(do

24
backend/package.json
View file

@ -1,18 +1,16 @@
{
"name": "uxbox-back",
"version": "0.1.0",
"description": "The Open-Source prototyping tool",
"scripts": {
"test": "echo \"Error: no test specified\" && exit 1",
"build-emails": "./scripts/build-email-templates.sh"
"name": "penpot-backend",
"version": "1.0.0",
"main": "index.js",
"license": "MPL-2.0",
"dependencies": {
"luxon": "^3.4.2",
"sax": "^1.2.4"
},
"repository": {
"type": "git",
"url": "git+https://github.com/uxbox/uxbox.git"
},
"author": "Uxbox",
"license": "SEE LICENSE IN <LICENSE>",
"scripts": {},
"devDependencies": {
"mjml": "^4.6.3"
"nodemon": "^3.0.1",
"source-map-support": "^0.5.21",
"ws": "^8.13.0"
}
}

4
backend/resources/log4j2.xml
View file

@ -13,10 +13,14 @@
<Logger name="org.postgresql" level="error" />
<Logger name="app.util" level="info" />
<Logger name="app.loggers" level="debug" />
<Logger name="app" level="info" additivity="false">
<AppenderRef ref="console" />
</Logger>
<Root level="info">
<AppenderRef ref="console" />
</Root>

3
backend/scripts/nrepl Executable file
View file

@ -0,0 +1,3 @@
#!/usr/bin/env bash
clojure -J-Xms50m -J-Xmx256m -J-XX:+UseSerialGC -Sdeps '{:deps {reply/reply {:mvn/version "0.5.0"}}}' -M -m reply.main --attach localhost:6064 -e "(in-ns 'app.main)"

29
backend/scripts/start-dev
View file

@ -6,34 +6,49 @@ export PENPOT_FLAGS="\
$PENPOT_FLAGS \
enable-prepl-server \
enable-urepl-server \
enable-nrepl-server \
enable-webhooks \
enable-backend-asserts \
enable-audit-log \
enable-transit-readable-response \
enable-demo-users \
enable-fdata-storage-pointer-map \
enable-fdata-storage-objets-map \
enable-file-validation \
enable-feature-fdata-pointer-map \
enable-feature-fdata-objects-map \
disable-secure-session-cookies \
enable-smtp \
enable-access-tokens \
disable-file-validation";
set -ex
# Initialize MINIO config
mc alias set penpot-s3/ http://minio:9000 minioadmin minioadmin
mc admin user add penpot-s3 penpot-devenv penpot-devenv
mc admin policy attach penpot-s3 readwrite --user=penpot-devenv
mc mb penpot-s3/penpot -p
export AWS_ACCESS_KEY_ID=penpot-devenv
export AWS_SECRET_ACCESS_KEY=penpot-devenv
export PENPOT_ASSETS_STORAGE_BACKEND=assets-s3
export PENPOT_STORAGE_ASSETS_S3_ENDPOINT=http://minio:9000
export PENPOT_STORAGE_ASSETS_S3_BUCKET=penpot
if [ "$1" = "--watch" ]; then
trap "exit" INT TERM ERR
trap "kill 0" EXIT
echo "Start Watch..."
clojure -A:dev -M -m app.main &
PID=$!
npx nodemon \
--watch src \
--watch ../common \
--ext "clj" \
--signal SIGKILL \
--exec 'echo "(user/restart)" | nc -N localhost 6062'
--exec 'echo "(app.main/stop)\n\r(repl/refresh)\n\r(app.main/start)\n" | nc -N localhost 6062'
wait;
kill -9 $PID
else
clojure -A:dev -M -m app.main
clojure -A:dev -M -m app.main;
fi

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

@ -632,21 +632,21 @@
cfeat/*wrap-with-objects-map-fn*
(if (contains? (:features file) "fdata/objectd-map") omap/wrap identity)]
(let [libs (sequence
(map (fn [{:keys [id] :as lib}]
(binding [pmap/*load-fn* (partial files/load-pointer conn id)]
(-> (db/get conn :file {:id id})
(files/decode-row)
(files/process-pointers deref) ; ensure all pointers resolved
(pmg/migrate-file)))))
(files/get-file-libraries conn id))
libs (-> (d/index-by :id libs)
(assoc (:id file) file))
file (-> file
(let [file (-> file
(update :data blob/decode)
(update :data assoc :id id)
(pmg/migrate-file))
libs (->> (files/get-file-libraries conn id)
(into [file] (map (fn [{:keys [id]}]
(binding [pmap/*load-fn* (partial files/load-pointer conn id)]
(-> (db/get conn :file {:id id})
(files/decode-row)
(files/process-pointers deref) ; ensure all pointers resolved
(pmg/migrate-file))))))
(d/index-by :id))
file (-> file
(update :data migrate-file-data libs)
(update :features conj "components/v2"))]

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

@ -88,11 +88,19 @@
(= code :params-validation)
(let [explain (::sm/explain data)
payload (sm/humanize-data explain)]
explain (sm/humanize-data explain)]
{::yrs/status 400
::yrs/body (-> data
(dissoc ::sm/explain)
(assoc :data payload))})
(assoc :explain explain))})
(= code :data-validation)
(let [explain (::sm/explain data)
explain (sm/humanize-data explain)]
{::yrs/status 400
::yrs/body (-> data
(dissoc ::sm/explain)
(assoc :explain explain))})
(= code :request-body-too-large)
{::yrs/status 413 ::yrs/body data}
@ -114,18 +122,18 @@
(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 cause)
explain (sm/humanize-data explain)]
(l/error :hint "data assertion error" :cause cause)
{::yrs/status 500
::yrs/body {:type :server-error
:code :assertion
:data (-> data
(dissoc ::sm/explain)
(assoc :data payload))}})
(assoc :explain explain))}})
(= code :spec-validation)
(let [explain (ex/explain data)]
(l/error :hint "spec assertion error" :message (ex-message error) :cause cause)
(l/error :hint "spec assertion error" :cause cause)
{::yrs/status 500
::yrs/body {:type :server-error
:code :assertion
@ -135,7 +143,7 @@
:else
(do
(l/error :hint "assertion error" :message (ex-message error) :cause cause)
(l/error :hint "assertion error" :cause cause)
{::yrs/status 500
::yrs/body {:type :server-error
:code :assertion
@ -150,7 +158,7 @@
[error request parent-cause]
(binding [l/*context* (request->context request)]
(let [cause (or parent-cause error)]
(l/error :hint "internal error" :message (ex-message error) :cause cause)
(l/error :hint "internal error" :cause cause)
{::yrs/status 500
::yrs/body {:type :server-error
:code :unhandled
@ -175,7 +183,7 @@
(let [state (.getSQLState ^java.sql.SQLException error)
cause (or parent-cause error)]
(binding [l/*context* (request->context request)]
(l/error :hint "PSQL error" :message (ex-message error)
(l/error :hint "PSQL error"
:cause cause)
(cond
(= state "57014")
@ -205,7 +213,7 @@
;; This means that exception is not a controlled exception.
(nil? edata)
(binding [l/*context* (request->context request)]
(l/error :hint "unexpected error" :message (ex-message error) :cause cause)
(l/error :hint "unexpected error" :cause cause)
{::yrs/status 500
::yrs/body {:type :server-error
:code :unexpected
@ -213,7 +221,7 @@
:else
(binding [l/*context* (request->context request)]
(l/error :hint "unhandled error" :message (ex-message error) :cause cause)
(l/error :hint "unhandled error" :cause cause)
{::yrs/status 500
::yrs/body {:type :server-error
:code :unhandled

61
backend/src/app/main.clj
View file

@ -37,8 +37,12 @@
[app.storage.s3 :as-alias sto.s3]
[app.util.time :as dt]
[app.worker :as-alias wrk]
[cider.nrepl :refer [cider-nrepl-handler]]
[clojure.test :as test]
[clojure.tools.namespace.repl :as repl]
[cuerdas.core :as str]
[integrant.core :as ig]
[nrepl.server :as nrepl]
[promesa.exec :as px])
(:gen-class))
@ -527,22 +531,65 @@
(merge worker-config))
(ig/prep)
(ig/init))))
(l/info :hint "welcome to penpot"
:flags (str/join "," (map name cf/flags))
:worker? (contains? cf/flags :backend-worker)
:version (:full cf/version)))
(l/inf :hint "welcome to penpot"
:flags (str/join "," (map name cf/flags))
:worker? (contains? cf/flags :backend-worker)
:version (:full cf/version)))
(defn stop
[]
(alter-var-root #'system (fn [sys]
(when sys (ig/halt! sys))
nil)))
(defn restart
[]
(stop)
(repl/refresh :after 'app.main/start))
(defn restart-all
[]
(stop)
(repl/refresh-all :after 'app.main/start))
(defmacro run-bench
[& exprs]
`(do
(require 'criterium.core)
(criterium.core/with-progress-reporting (crit/quick-bench (do ~@exprs) :verbose))))
(defn run-tests
([] (run-tests #"^backend-tests.*-test$"))
([o]
(repl/refresh)
(cond
(instance? java.util.regex.Pattern o)
(test/run-all-tests o)
(symbol? o)
(if-let [sns (namespace o)]
(do (require (symbol sns))
(test/test-vars [(resolve o)]))
(test/test-ns o)))))
(repl/disable-reload! (find-ns 'integrant.core))
(defn -main
[& _args]
(try
(start)
(let [p (promise)]
(when (contains? cf/flags :nrepl-server)
(l/inf :hint "start nrepl server" :port 6064)
(nrepl/start-server :bind "0.0.0.0" :port 6064 :handler cider-nrepl-handler))
(start)
(deref p))
(catch Throwable cause
(l/error :hint (ex-message cause)
:cause cause)
(binding [*out* *err*]
(println "==== ERROR ===="))
(.printStackTrace cause)
(when-let [cause' (ex-cause cause)]
(binding [*out* *err*]
(println "==== CAUSE ===="))
(.printStackTrace cause'))
(px/sleep 500)
(System/exit -1))))

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

@ -12,6 +12,7 @@
[app.common.features :as cfeat]
[app.common.files.defaults :as cfd]
[app.common.files.migrations :as pmg]
[app.common.files.validate :as fval]
[app.common.fressian :as fres]
[app.common.logging :as l]
[app.common.spec :as us]
@ -743,7 +744,13 @@
(update :pages-index relink-shapes)
(update :components relink-shapes)
(update :media relink-media)
(pmg/migrate-data))))
(pmg/migrate-data)
(d/without-nils))))
;; Without providing all libs, here we just
;; peform a structural file data validation,
;; full referential check is omited.
(fval/validate-file!)
(postprocess-file)
(update :features #(db/create-array conn "text" %))
(update :data blob/encode))]
@ -973,7 +980,6 @@
:import-id id
:elapsed (dt/format-duration (tp))
:error? (some? @cs)
:cause @cs
)))))
;; --- Command: export-binfile

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

@ -443,10 +443,17 @@
"Given the page data and the object-id returns the page data with all
other not needed objects removed from the `:objects` data
structure."
[{:keys [objects] :as page} object-id]
(let [objects (->> (cph/get-children-with-self objects object-id)
(filter some?))]
(assoc page :objects (d/index-by :id objects))))
[page id-or-ids]
(update page :objects (fn [objects]
(reduce (fn [result object-id]
(->> (cph/get-children-with-self objects object-id)
(filter some?)
(d/index-by :id)
(merge result)))
{}
(if (uuid? id-or-ids)
[id-or-ids]
id-or-ids)))))
(defn- prune-thumbnails
"Given the page data, removes the `:thumbnail` prop from all
@ -480,7 +487,7 @@
page)))]
(cond-> (prune-thumbnails page)
(uuid? object-id)
(some? object-id)
(prune-objects object-id))))
(def schema:get-page
@ -488,7 +495,7 @@
[:file-id ::sm/uuid]
[:page-id {:optional true} ::sm/uuid]
[:share-id {:optional true} ::sm/uuid]
[:object-id {:optional true} ::sm/uuid]
[:object-id {:optional true} [:or ::sm/uuid ::sm/coll-of-uuid]]
[:features {:optional true} ::cfeat/features]])
(sv/defmethod ::get-page
@ -500,7 +507,8 @@
If you specify the object-id, the page-id parameter becomes
mandatory.
Mainly used for rendering purposes."
Mainly used for rendering purposes on the exporter. It does not
accepts client features."
{::doc/added "1.17"
::sm/params schema:get-page}
[cfg {:keys [::rpc/profile-id file-id share-id] :as params}]

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

@ -178,7 +178,8 @@
(l/trace :hint "update-file" :time (dt/format-duration elapsed)))))))))
(defn update-file
[{:keys [::db/conn ::mtx/metrics] :as cfg} {:keys [id file features changes changes-with-metadata skip-validate] :as params}]
[{:keys [::db/conn ::mtx/metrics] :as cfg}
{:keys [id file features changes changes-with-metadata] :as params}]
(binding [cfeat/*current* features
cfeat/*previous* (:features file)]
(let [update-fn (cond-> update-file*
@ -188,16 +189,6 @@
(contains? features "fdata/objects-map")
(wrap-with-objects-map-context))
;; TODO: this ruins performance.
;; We must find some other way to do general validation.
libraries (when (and (contains? cf/flags :file-validation)
(not skip-validate))
(let [libs (->> (files/get-file-libraries conn (:id file))
(map #(get-file conn (:id %)))
(map #(update % :data blob/decode))
(d/index-by :id))]
(assoc libs (:id file) file)))
changes (if changes-with-metadata
(->> changes-with-metadata (mapcat :changes) vec)
(vec changes))
@ -225,9 +216,9 @@
(let [file (assoc file :features features)
params (-> params
(assoc :file file)
(assoc :libraries libraries)
(assoc :changes changes)
(assoc ::created-at (dt/now)))]
(-> (update-fn cfg params)
(vary-meta assoc ::audit/replace-props
{:id (:id file)
@ -237,12 +228,13 @@
:team-id (:team-id file)}))))))
(defn- update-file*
[{:keys [::db/conn] :as cfg} {:keys [profile-id file libraries changes session-id ::created-at skip-validate] :as params}]
[{:keys [::db/conn] :as cfg}
{:keys [profile-id file changes session-id ::created-at skip-validate] :as params}]
(let [;; Process the file data in the CLIMIT context; scheduling it
;; to be executed on a separated executor for avoid to do the
;; CPU intensive operation on vthread.
file (-> (climit/configure cfg :update-file)
(climit/submit! (partial update-file-data file libraries changes skip-validate)))]
(climit/submit! (partial update-file-data conn file changes skip-validate)))]
(db/insert! conn :file-change
{:id (uuid/next)
@ -276,36 +268,44 @@
(get-lagged-changes conn params))))
(defn- update-file-data
[file libraries changes skip-validate]
(let [validate (fn [file]
(when (and (cf/flags :file-validation)
(not skip-validate))
(val/validate-file file libraries :throw? true)))
file (-> file
(update :revn inc)
(update :data (fn [data]
(cond-> data
:always
(-> (blob/decode)
(assoc :id (:id file))
(pmg/migrate-data))
[conn file changes skip-validate]
(let [file (update file :data (fn [data]
(-> data
(blob/decode)
(assoc :id (:id file))
(pmg/migrate-data))))
:always
(cp/process-changes changes))))
(d/tap-r validate))
;; WARNING: this ruins performance; maybe we need to find
;; some other way to do general validation
libs (when (and (contains? cf/flags :file-validation)
(not skip-validate))
;; FIXME: we need properly handle pointer-map here ????
(->> (files/get-file-libraries conn (:id file))
(into [file] (map (fn [{:keys [id]}]
(binding [pmap/*load-fn* (partial files/load-pointer conn id)]
(-> (db/get conn :file {:id id})
(files/decode-row)
(files/process-pointers deref) ; ensure all pointers resolved
(pmg/migrate-file))))))
(d/index-by :id)))]
file (if (and (contains? cfeat/*current* "fdata/objects-map")
(not (contains? cfeat/*previous* "fdata/objects-map")))
(enable-objects-map file)
file)
(-> file
(update :revn inc)
(update :data cp/process-changes changes)
file (if (and (contains? cfeat/*current* "fdata/pointer-map")
(not (contains? cfeat/*previous* "fdata/pointer-map")))
(enable-pointer-map file)
file)
]
;; If `libs` is defined, then full validation is performed
(val/validate-file! libs)
(cond-> (and (contains? cfeat/*current* "fdata/objects-map")
(not (contains? cfeat/*previous* "fdata/objects-map")))
(enable-objects-map))
(cond-> (and (contains? cfeat/*current* "fdata/pointer-map")
(not (contains? cfeat/*previous* "fdata/pointer-map")))
(enable-pointer-map))
(update :data blob/encode))))
(update file :data blob/encode)))
(defn- take-snapshot?
"Defines the rule when file `data` snapshot should be saved."

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

@ -53,7 +53,7 @@
[:props {:optional true}
[:map-of {:title "ProfileProps"} :keyword :any]]])
(def profile?
(def valid-profile?
(sm/pred-fn schema:profile))
;; --- QUERY: Get profile (own)
@ -95,7 +95,7 @@
(dm/assert!
"expected valid profile data"
(profile? params))
(valid-profile? params))
(db/with-atomic [conn pool]
;; NOTE: we need to retrieve the profile independently if we use

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

@ -138,14 +138,20 @@
(declare get-team)
(def ^:private schema:get-team
[:map {:title "get-team"}
[:id ::sm/uuid]])
[:and
[:map {:title "get-team"}
[:id {:optional true} ::sm/uuid]
[:file-id {:optional true} ::sm/uuid]]
[:fn (fn [params]
(or (contains? params :id)
(contains? params :file-id)))]])
(sv/defmethod ::get-team
{::doc/added "1.17"
::sm/params schema:get-team}
[cfg {:keys [::rpc/profile-id id]}]
(db/tx-run! cfg #(get-team % :profile-id profile-id :team-id id)))
[cfg {:keys [::rpc/profile-id id file-id]}]
(db/tx-run! cfg #(get-team % :profile-id profile-id :team-id id :file-id file-id)))
(defn get-team
[conn & {:keys [profile-id team-id project-id file-id] :as params}]

23
backend/src/app/srepl.clj
View file

@ -36,7 +36,9 @@
lock (locks/create)]
(ccs/prepl *in*
(fn [m]
(binding [*out* out, *flush-on-newline* true, *print-readably* true]
(binding [*out* out,
*flush-on-newline* true,
*print-readably* true]
(locks/locking lock
(println (json/encode-str m))))))))
@ -44,13 +46,10 @@
(s/def ::port ::us/integer)
(s/def ::host ::us/not-empty-string)
(s/def ::flag #{:urepl-server :prepl-server})
(s/def ::type #{::prepl ::urepl})
(s/def ::key (s/tuple ::type ::us/keyword))
(defmethod ig/pre-init-spec ::server
[_]
(s/keys :req [::flag ::host ::port]))
(s/keys :req [::host ::port]))
(defmethod ig/prep-key ::server
[[type _] cfg]
@ -59,6 +58,12 @@
(defmethod ig/init-key ::server
[[type _] {:keys [::flag ::port ::host] :as cfg}]
(when (contains? cf/flags flag)
(l/inf :hint "initializing repl server"
:name (name type)
:port port
:host host)
(let [accept (case type
::prepl 'app.srepl/json-repl
::urepl 'app.srepl/user-repl)
@ -67,14 +72,8 @@
:name (name type)
:accept accept}]
(l/info :msg "initializing repl server"
:name (name type)
:port port
:host host)
(ccs/start-server params)
params)))
(assoc params :type type))))
(defmethod ig/halt-key! ::server
[_ params]

1
backend/src/app/srepl/main.clj
View file

@ -31,6 +31,7 @@
[app.util.time :as dt]
[app.worker :as wrk]
[clojure.pprint :refer [pprint print-table]]
[clojure.tools.namespace.repl :as repl]
[cuerdas.core :as str]))
(defn print-available-tasks

1120
backend/yarn.lock
View file

File diff suppressed because it is too large Load diff

7
common/src/app/common/exceptions.cljc
View file

@ -66,9 +66,9 @@
(defn explain
([data] (explain data nil))
([data {:keys [level length] :or {level 8 length 10} :as opts}]
([data {:keys [level length] :or {level 8 length 12} :as opts}]
(cond
;; ;; NOTE: a special case for spec validation errors on integrant
;; NOTE: a special case for spec validation errors on integrant
(and (= (:reason data) :integrant.core/build-failed-spec)
(contains? data :explain))
(explain (:explain data) opts)
@ -81,8 +81,7 @@
(s/explain-out (update data ::s/problems #(take length %)))))
(contains? data ::sm/explain)
(-> (sm/humanize-data (::sm/explain data))
(pp/pprint-str {:level level :length length})))))
(sm/humanize-data (::sm/explain data) :level level :length length))))
#?(:clj
(defn format-throwable

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

@ -190,10 +190,16 @@
(check-supported-features! file-features)
(let [not-supported (-> file-features
(set/difference enabled-features)
(set/difference client-features)
(set/difference frontend-only-features))]
(let [;; We should ignore all features that does not match with
;; the `no-migration-features` set because we can't enable
;; them as-is, because they probably need migrations
client-features (set/intersection client-features no-migration-features)
not-supported (-> file-features
(set/difference enabled-features)
(set/difference client-features)
(set/difference backend-only-features)
(set/difference frontend-only-features))]
(when (seq not-supported)
(ex/raise :type :restriction
:code :feature-mismatch

490
common/src/app/common/files/validate.cljc
View file

@ -61,34 +61,37 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:dynamic *errors* nil)
(def ^:dynamic *throw-on-error* false)
(defn- report-error
[code msg shape file page & args]
(when (some? *errors*)
(if (true? *throw-on-error*)
(ex/raise {:type :validation
:code code
:hint msg
:args args
::explain (str/format "file %s, page %s, shape %s"
(:id file)
(:id page)
(:id shape))})
(vswap! *errors* conj {:code code
:hint msg
:shape shape
:file-id (:id file)
:page-id (:id page)
:args args}))))
(defn report-error!
[code hint shape file page & args]
(if (some? *errors*)
(vswap! *errors* conj {:code code
:hint hint
:shape shape
:file-id (:id file)
:page-id (:id page)
:args args})
(let [explain (str/ffmt "file %, page %, shape %"
(:id file)
(:id page)
(:id shape))]
(ex/raise :type :validation
:code code
:hint hint
:args args
:file-id (:id file)
:page-id (:id page)
:shape-id (:id shape)
::explain explain))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; VALIDATION FUNCTIONS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare validate-shape)
(declare validate-shape!)
(defn validate-geometry
(defn validate-geometry!
"Validate that the shape has valid coordinates, selrect and points."
[shape file page]
(when (and (not (#{:path :bool} (:type shape)))
@ -98,318 +101,357 @@
(nil? (:height shape))
(nil? (:selrect shape))
(nil? (:points shape))))
(report-error :invalid-geometry
(str/format "Shape greometry is invalid")
shape file page)))
(report-error! :invalid-geometry
"Shape greometry is invalid"
shape file page)))
(defn validate-parent-children
(defn validate-parent-children!
"Validate parent and children exists, and the link is bidirectional."
[shape file page]
(let [parent (ctst/get-shape page (:parent-id shape))]
(if (nil? parent)
(report-error :parent-not-found
(str/format "Parent %s not found" (:parent-id shape))
shape file page)
(report-error! :parent-not-found
(str/ffmt "Parent % not found" (:parent-id shape))
shape file page)
(do
(when-not (cph/root? shape)
(when-not (some #{(:id shape)} (:shapes parent))
(report-error :child-not-in-parent
(str/format "Shape %s not in parent's children list" (:id shape))
shape file page)))
(report-error! :child-not-in-parent
(str/ffmt "Shape % not in parent's children list" (:id shape))
shape file page)))
(doseq [child-id (:shapes shape)]
(when (nil? (ctst/get-shape page child-id))
(report-error :child-not-found
(str/format "Child %s not found" child-id)
shape file page
:child-id child-id)))))))
(report-error! :child-not-found
(str/ffmt "Child % not found" child-id)
shape file page
:child-id child-id)))))))
(defn validate-frame
"Validate that the frame-id shape exists and is indeed a frame. Also it must point to the
parent shape (if this is a frame) or to the frame-id of the parent (if not)."
(defn validate-frame!
"Validate that the frame-id shape exists and is indeed a frame. Also
it must point to the parent shape (if this is a frame) or to the
frame-id of the parent (if not)."
[shape file page]
(let [frame (ctst/get-shape page (:frame-id shape))]
(if (nil? frame)
(report-error :frame-not-found
(str/format "Frame %s not found" (:frame-id shape))
shape file page)
(report-error! :frame-not-found
(str/ffmt "Frame % not found" (:frame-id shape))
shape file page)
(if (not= (:type frame) :frame)
(report-error :invalid-frame
(str/format "Frame %s is not actually a frame" (:frame-id shape))
shape file page)
(report-error! :invalid-frame
(str/ffmt "Frame % is not actually a frame" (:frame-id shape))
shape file page)
(let [parent (ctst/get-shape page (:parent-id shape))]
(when (some? parent)
(if (= (:type parent) :frame)
(when-not (= (:frame-id shape) (:id parent))
(report-error :invalid-frame
(str/format "Frame-id should point to parent" (:id parent))
shape file page))
(report-error! :invalid-frame
(str/ffmt "Frame-id should point to parent %" (:id parent))
shape file page))
(when-not (= (:frame-id shape) (:frame-id parent))
(report-error :invalid-frame
(str/format "Frame-id should point to parent frame" (:frame-id parent))
shape file page)))))))))
(report-error! :invalid-frame
(str/ffmt "Frame-id should point to parent frame %" (:frame-id parent))
shape file page)))))))))
(defn validate-component-main-head
"Validate shape is a main instance head, component exists and its main-instance points to this shape."
(defn validate-component-main-head!
"Validate shape is a main instance head, component exists
and its main-instance points to this shape."
[shape file page libraries]
(when (nil? (:main-instance shape))
(report-error :component-not-main
(str/format "Shape expected to be main instance")
shape file page))
(report-error! :component-not-main
"Shape expected to be main instance"
shape file page))
(when-not (= (:component-file shape) (:id file))
(report-error :component-main-external
(str/format "Main instance should refer to a component in the same file")
shape file page))
(report-error! :component-main-external
"Main instance should refer to a component in the same file"
shape file page))
(let [component (ctf/resolve-component shape file libraries :include-deleted? true)]
(if (nil? component)
(report-error :component-not-found
(str/format "Component %s not found in file" (:component-id shape) (:component-file shape))
shape file page)
(report-error! :component-not-found
(str/ffmt "Component % not found in file %" (:component-id shape) (:component-file shape))
shape file page)
(do
(when-not (= (:main-instance-id component) (:id shape))
(report-error :invalid-main-instance-id
(str/format "Main instance id of component %s is not valid" (:component-id shape))
shape file page))
(report-error! :invalid-main-instance-id
(str/ffmt "Main instance id of component % is not valid" (:component-id shape))
shape file page))
(when-not (= (:main-instance-page component) (:id page))
(report-error :invalid-main-instance-page
(str/format "Main instance page of component %s is not valid" (:component-id shape))
shape file page))))))
(report-error! :invalid-main-instance-page
(str/ffmt "Main instance page of component % is not valid" (:component-id shape))
shape file page))))))
(defn validate-component-not-main-head
"Validate shape is a not-main instance head, component exists and its main-instance does not point to this shape."
(defn validate-component-not-main-head!
"Validate shape is a not-main instance head, component
exists and its main-instance does not point to this
shape."
[shape file page libraries]
(when (some? (:main-instance shape))
(report-error :component-not-main
(str/format "Shape not expected to be main instance")
shape file page))
(report-error! :component-not-main
"Shape not expected to be main instance"
shape file page))
(let [component (ctf/resolve-component shape file libraries {:include-deleted? true})]
(if (nil? component)
(report-error :component-not-found
(str/format "Component %s not found in file" (:component-id shape) (:component-file shape))
shape file page)
(do
(when (and (= (:main-instance-id component) (:id shape))
(= (:main-instance-page component) (:id page)))
(report-error :invalid-main-instance
(str/format "Main instance of component %s should not be this shape" (:id component))
shape file page))))))
(report-error! :component-not-found
(str/ffmt "Component % not found in file %" (:component-id shape) (:component-file shape))
shape file page)
(when (and (= (:main-instance-id component) (:id shape))
(= (:main-instance-page component) (:id page)))
(report-error! :invalid-main-instance
(str/ffmt "Main instance of component % should not be this shape" (:id component))
shape file page)))))
(defn validate-component-not-main-not-head
(defn validate-component-not-main-not-head!
"Validate that this shape is not main instance and not head."
[shape file page]
(when (some? (:main-instance shape))
(report-error :component-main
(str/format "Shape not expected to be main instance")
shape file page))
(report-error! :component-main
"Shape not expected to be main instance"
shape file page))
(when (or (some? (:component-id shape))
(some? (:component-file shape)))
(report-error :component-main
(str/format "Shape not expected to be component head")
shape file page)))
(report-error! :component-main
"Shape not expected to be component head"
shape file page)))
(defn validate-component-root
(defn validate-component-root!
"Validate that this shape is an instance root."
[shape file page]
(when (nil? (:component-root shape))
(report-error :should-be-component-root
(str/format "Shape should be component root")
shape file page)))
(report-error! :should-be-component-root
"Shape should be component root"
shape file page)))
(defn validate-component-not-root
(defn validate-component-not-root!
"Validate that this shape is not an instance root."
[shape file page]
(when (some? (:component-root shape))
(report-error :should-not-be-component-root
(str/format "Shape should not be component root")
shape file page)))
(report-error! :should-not-be-component-root
"Shape should not be component root"
shape file page)))
(defn validate-component-ref
(defn validate-component-ref!
"Validate that the referenced shape exists in the near component."
[shape file page libraries]
(let [ref-shape (ctf/find-ref-shape file page libraries shape :include-deleted? true)]
(when (nil? ref-shape)
(report-error :ref-shape-not-found
(str/format "Referenced shape %s not found in near component" (:shape-ref shape))
shape file page))))
(report-error! :ref-shape-not-found
(str/ffmt "Referenced shape % not found in near component" (:shape-ref shape))
shape file page))))
(defn validate-component-not-ref
(defn validate-component-not-ref!
"Validate that this shape does not reference other one."
[shape file page]
(when (some? (:shape-ref shape))
(report-error :shape-ref-in-main
(str/format "Shape inside main instance should not have shape-ref")
shape file page)))
(report-error! :shape-ref-in-main
"Shape inside main instance should not have shape-ref"
shape file page)))
(defn validate-shape-main-root-top
"Root shape of a top main instance
:main-instance
:component-id
:component-file
:component-root"
(defn validate-shape-main-root-top!
"Root shape of a top main instance:
- :main-instance
- :component-id
- :component-file
- :component-root"
[shape file page libraries]
(validate-component-main-head shape file page libraries)
(validate-component-root shape file page)
(validate-component-not-ref shape file page)
(validate-component-main-head! shape file page libraries)
(validate-component-root! shape file page)
(validate-component-not-ref! shape file page)
(doseq [child-id (:shapes shape)]
(validate-shape child-id file page libraries :context :main-top)))
(validate-shape! child-id file page libraries :context :main-top)))
(defn validate-shape-main-root-nested
(defn validate-shape-main-root-nested!
"Root shape of a nested main instance
:main-instance
:component-id
:component-file"
- :main-instance
- :component-id
- :component-file"
[shape file page libraries]
(validate-component-main-head shape file page libraries)
(validate-component-not-root shape file page)
(validate-component-not-ref shape file page)
(validate-component-main-head! shape file page libraries)
(validate-component-not-root! shape file page)
(validate-component-not-ref! shape file page)
(doseq [child-id (:shapes shape)]
(validate-shape child-id file page libraries :context :main-nested)))
(validate-shape! child-id file page libraries :context :main-nested)))
(defn validate-shape-copy-root-top
(defn validate-shape-copy-root-top!
"Root shape of a top copy instance
:component-id
:component-file
:component-root
:shape-ref"
- :component-id
- :component-file
- :component-root
- :shape-ref"
[shape file page libraries]
(validate-component-not-main-head shape file page libraries)
(validate-component-root shape file page)
(validate-component-ref shape file page libraries)
(validate-component-not-main-head! shape file page libraries)
(validate-component-root! shape file page)
(validate-component-ref! shape file page libraries)
(doseq [child-id (:shapes shape)]
(validate-shape child-id file page libraries :context :copy-top)))
(validate-shape! child-id file page libraries :context :copy-top)))
(defn validate-shape-copy-root-nested
(defn validate-shape-copy-root-nested!
"Root shape of a nested copy instance
:component-id
:component-file
:shape-ref"
- :component-id
- :component-file
- :shape-ref"
[shape file page libraries]
(validate-component-not-main-head shape file page libraries)
(validate-component-not-root shape file page)
(validate-component-ref shape file page libraries)
(validate-component-not-main-head! shape file page libraries)
(validate-component-not-root! shape file page)
(validate-component-ref! shape file page libraries)
(doseq [child-id (:shapes shape)]
(validate-shape child-id file page libraries :context :copy-nested)))
(validate-shape! child-id file page libraries :context :copy-nested)))
(defn validate-shape-main-not-root
"Not-root shape of a main instance
(not any attribute)"
(defn validate-shape-main-not-root!
"Not-root shape of a main instance (not any attribute)"
[shape file page libraries]
(validate-component-not-main-not-head shape file page)
(validate-component-not-root shape file page)
(validate-component-not-ref shape file page)
(validate-component-not-main-not-head! shape file page)
(validate-component-not-root! shape file page)
(validate-component-not-ref! shape file page)
(doseq [child-id (:shapes shape)]
(validate-shape child-id file page libraries :context :main-any)))
(validate-shape! child-id file page libraries :context :main-any)))
(defn validate-shape-copy-not-root
"Not-root shape of a copy instance
:shape-ref"
(defn validate-shape-copy-not-root!
"Not-root shape of a copy instance :shape-ref"
[shape file page libraries]
(validate-component-not-main-not-head shape file page)
(validate-component-not-root shape file page)
(validate-component-ref shape file page libraries)
(validate-component-not-main-not-head! shape file page)
(validate-component-not-root! shape file page)
(validate-component-ref! shape file page libraries)
(doseq [child-id (:shapes shape)]
(validate-shape child-id file page libraries :context :copy-any)))
(validate-shape! child-id file page libraries :context :copy-any)))
(defn validate-shape-not-component
"Shape is not in a component or is a fostered children
(not any attribute)"
(defn validate-shape-not-component!
"Shape is not in a component or is a fostered children (not any
attribute)"
[shape file page libraries]
(validate-component-not-main-not-head shape file page)
(validate-component-not-root shape file page)
(validate-component-not-ref shape file page)
(validate-component-not-main-not-head! shape file page)
(validate-component-not-root! shape file page)
(validate-component-not-ref! shape file page)
(doseq [child-id (:shapes shape)]
(validate-shape child-id file page libraries :context :not-component)))
(validate-shape! child-id file page libraries :context :not-component)))
(defn validate-shape
"Validate referential integrity and semantic coherence of a shape and all its children.
(defn validate-shape!
"Validate referential integrity and semantic coherence of
a shape and all its children. Raises an exception on first
error found.
The context is the situation of the parent in respect to components:
:not-component
:main-top
:main-nested
:copy-top
:copy-nested
:main-any
:copy-any"
[shape-id file page libraries & {:keys [context throw?]
:or {context :not-component
throw? nil}}]
(binding [*throw-on-error* (if (some? throw?) throw? *throw-on-error*)
*errors* (or *errors* (volatile! []))]
(let [shape (ctst/get-shape page shape-id)]
The context is the situation of the parent in respect to components:
- :not-component
- :main-top
- :main-nested
- :copy-top
- :copy-nested
- :main-any
- :copy-any
"
[shape-id file page libraries & {:keys [context] :or {context :not-component}}]
(let [shape (ctst/get-shape page shape-id)]
; If this happens it's a bug in this validate functions
(dm/verify! (str/format "Shape %s not found" shape-id) (some? shape))
;; If this happens it's a bug in this validate functions
(dm/verify!
["Shape % not found" shape-id]
(some? shape))
(validate-geometry shape file page)
(validate-parent-children shape file page)
(validate-frame shape file page)
(validate-parent-children shape file page)
(validate-frame shape file page)
(validate-geometry! shape file page)
(validate-parent-children! shape file page)
(validate-frame! shape file page)
(if (ctk/instance-head? shape)
(if (not= :frame (:type shape))
(report-error :instance-head-not-frame
(str/format "Instance head should be a frame")
shape file page)
(report-error! :instance-head-not-frame
"Instance head should be a frame"
shape file page)
(if (ctk/instance-root? shape)
(if (ctk/main-instance? shape)
(if (not= context :not-component)
(report-error :root-main-not-allowed
(str/format "Root main component not allowed inside other component")
shape file page)
(validate-shape-main-root-top shape file page libraries))
(report-error! :root-main-not-allowed
"Root main component not allowed inside other component"
shape file page)
(validate-shape-main-root-top! shape file page libraries))
(if (not= context :not-component)
(report-error :root-copy-not-allowed
(str/format "Root copy component not allowed inside other component")
shape file page)
(validate-shape-copy-root-top shape file page libraries)))
(report-error! :root-copy-not-allowed
"Root copy component not allowed inside other component"
shape file page)
(validate-shape-copy-root-top! shape file page libraries)))
(if (ctk/main-instance? shape)
(if (= context :not-component)
(report-error :nested-main-not-allowed
(str/format "Nested main component only allowed inside other component")
shape file page)
(validate-shape-main-root-nested shape file page libraries))
(report-error! :nested-main-not-allowed
"Nested main component only allowed inside other component"
shape file page)
(validate-shape-main-root-nested! shape file page libraries))
(if (= context :not-component)
(report-error :nested-copy-not-allowed
(str/format "Nested copy component only allowed inside other component")
shape file page)
(validate-shape-copy-root-nested shape file page libraries)))))
(report-error! :nested-copy-not-allowed
"Nested copy component only allowed inside other component"
shape file page)
(validate-shape-copy-root-nested! shape file page libraries)))))
(if (ctk/in-component-copy? shape)
(if-not (#{:copy-top :copy-nested :copy-any} context)
(report-error :not-head-copy-not-allowed
(str/format "Non-root copy only allowed inside a copy")
shape file page)
(validate-shape-copy-not-root shape file page libraries))
(report-error! :not-head-copy-not-allowed
"Non-root copy only allowed inside a copy"
shape file page)
(validate-shape-copy-not-root! shape file page libraries))
(if (ctn/inside-component-main? (:objects page) shape)
(if-not (#{:main-top :main-nested :main-any} context)
(report-error :not-head-main-not-allowed
(str/format "Non-root main only allowed inside a main component")
shape file page)
(validate-shape-main-not-root shape file page libraries))
(report-error! :not-head-main-not-allowed
"Non-root main only allowed inside a main component"
shape file page)
(validate-shape-main-not-root! shape file page libraries))
(if (#{:main-top :main-nested :main-any} context)
(report-error :not-component-not-allowed
(str/format "Not compoments are not allowed inside a main")
shape file page)
(validate-shape-not-component shape file page libraries)))))
(report-error! :not-component-not-allowed
"Not compoments are not allowed inside a main"
shape file page)
(validate-shape-not-component! shape file page libraries)))))))
(deref *errors*))))
(defn validate-shape
"Validate referential integrity and semantic coherence of
a shape and all its children. Returns a list of errors."
[shape-id file page libraries]
(binding [*errors* (volatile! [])]
(validate-shape! shape-id file page libraries)
(deref *errors*)))
(def valid-fdata?
"Structural validation of file data using defined schema"
(sm/lazy-validator ::ctf/data))
(def get-fdata-explain
"Get schema explain data for file data"
(sm/lazy-explainer ::ctf/data))
(defn validate-file!
"Validate file data structure.
If libraries are provided, then a full referential integrity and
semantic coherence check will be performed on all content of the
file.
Raises a validation exception on first error found."
([file] (validate-file! file nil))
([{:keys [id data] :as file} libraries]
(when-not (valid-fdata? data)
(ex/raise :type :validation
:code :data-validation
:hint (str/ffmt "invalid file data found on file '%'" id)
:file-id id
::sm/explain (get-fdata-explain data)))
;; If `libraries` is provided, this means the fill file
;; validation is activated so we proceed to execute the
;; validation
(when (seq libraries)
(doseq [page (filter :id (ctpl/pages-seq data))]
(validate-shape! uuid/zero file page libraries)))
file))
(defn validate-file
"Validate referencial integrity and semantic coherence of all contents of a file."
[file libraries & {:keys [throw?] :or {throw? false}}]
(binding [*throw-on-error* throw?
*errors* (volatile! [])]
(->> (ctpl/pages-seq (:data file))
(filter #(some? (:id %)))
(run! #(validate-shape uuid/zero file % libraries :throw? throw?)))
"Validate referencial integrity and semantic coherence of
all contents of a file. Returns a list of errors."
[file libraries]
(binding [*errors* (volatile! [])]
(validate-file! file libraries)
(deref *errors*)))

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

@ -271,7 +271,7 @@
(js/console.error n (pr-str v))
(js/console.error n v))))
(when cause
(when (ex/exception? cause)
(let [data (ex-data cause)
explain (ex/explain data)]
(when explain

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

@ -8,7 +8,9 @@
(:refer-clojure :exclude [deref merge parse-uuid])
#?(:cljs (:require-macros [app.common.schema :refer [ignoring]]))
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.pprint :as pp]
[app.common.schema.generators :as sg]
[app.common.schema.openapi :as-alias oapi]
[app.common.schema.registry :as sr]
@ -141,11 +143,25 @@
([s options transformer]
(m/decoder s options transformer)))
(defn lazy-decoder
[s transformer]
(let [vfn (delay (decoder s transformer))]
(fn [v] (@vfn v))))
(defn humanize-data
[explain-data]
(-> explain-data
(update :schema form)
(update :errors (fn [errors] (map #(update % :schema form) errors)))))
[{:keys [schema errors value]} & {:keys [length level]}]
(let [errors (mapv #(update % :schema form) errors)]
(with-out-str
(println "Schema: ")
(println (pp/pprint-str (form schema)) {:level (d/nilv level 10)
:length (d/nilv length 10)})
(println)
(println "Errors:")
(println (pp/pprint-str errors {:level (d/nilv level 10)
:length (d/nilv length 10)}))
(println "Value:")
(println (pp/pprint-str value {:level (d/nilv level 5)
:length (d/nilv length 10)})))))
(defn pretty-explain
[s d]
@ -191,7 +207,7 @@
(fn [v]
(let [result (v-fn v)]
(when (and (not result) (true? dm/*assert-context*))
(let [hint (str "schema assert: " (pr-str (form s)))
(let [hint "schema validation"
exp (e-fn v)]
(throw (ex-info hint {:type :assertion
:code :data-validation
@ -204,7 +220,7 @@
[s v]
(let [result (validate s v)]
(when (and (not result) (true? dm/*assert-context*))
(let [hint (str "schema assert: " (pr-str (form s)))
(let [hint "schema validation"
exp (explain s v)]
(throw (ex-info hint {:type :assertion
:code :data-validation

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

@ -58,10 +58,10 @@
[:media {:optional true}
[:map-of {:gen/max 5} ::sm/uuid ::media-object]]])
(def file-data?
(def valid-file-data?
(sm/pred-fn ::data))
(def media-object?
(def valid-media-object?
(sm/pred-fn ::media-object))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

4
common/src/app/common/types/pages_list.cljc
View file

@ -33,8 +33,8 @@
(update :pages-index assoc id (dissoc page :index))))
(defn pages-seq
[file-data]
(vals (:pages-index file-data)))
[fdata]
(vals (:pages-index fdata)))
(defn update-page
[file-data page-id f]

3
docker/devenv/docker-compose.yaml
View file

@ -37,6 +37,9 @@ services:
- 3449:3449
- 6060:6060
- 6061:6061
- 6062:6062
- 6063:6063
- 6064:6064
- 9090:9090
environment:

2
exporter/src/app/config.cljs
View file

@ -23,6 +23,7 @@
:host "localhost"
:http-server-port 6061
:http-server-host "0.0.0.0"
:tempdir "/tmp/penpot-exporter"
:redis-uri "redis://redis/0"})
(def ^:private schema:config
@ -32,6 +33,7 @@
[:tenant {:optional true} :string]
[:flags {:optional true} ::sm/set-of-keywords]
[:redis-uri {:optional true} :string]
[:tempdir {:optional true} :string]
[:browser-pool-max {:optional true} :int]
[:browser-pool-min {:optional true} :int]])

5
exporter/src/app/util/shell.cljs
View file

@ -14,6 +14,7 @@
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.uuid :as uuid]
[app.config :as cf]
[cuerdas.core :as str]
[promesa.core :as p]))
@ -22,12 +23,12 @@
(def tempfile-minage (* 1000 60 60 1)) ;; 1h
(def tmpdir
(let [path (path/join (os/tmpdir) "penpot")]
(let [path (cf/get :tempdir)]
(l/inf :hint "tmptdir setup" :path path)
(when-not (fs/existsSync path)
(fs/mkdirSync path #js {:recursive true}))
path))
(defn- schedule-deletion!
[path]
(letfn [(remote-tempfile []

4
frontend/src/app/main/data/workspace.cljs
View file

@ -326,8 +326,8 @@
(rx/map deref)
(rx/map bundle-fetched)))
(rx/take-until
(rx/filter (ptk/type? ::fetch-bundle) stream))))))
(rx/take-until
(rx/filter (ptk/type? ::fetch-bundle) stream))))))
(defn initialize-file
[project-id file-id]

2
frontend/src/app/main/data/workspace/libraries.cljs
View file

@ -182,7 +182,7 @@
(defn add-media
[media]
(dm/assert! (ctf/media-object? media))
(dm/assert! (ctf/valid-media-object? media))
(ptk/reify ::add-media
ptk/WatchEvent
(watch [it _ _]

27
frontend/src/app/main/errors.cljs
View file

@ -25,7 +25,7 @@
[data]
(-> data
(dissoc ::sm/explain)
(dissoc :hint)
(dissoc :explain)
(dissoc ::trace)
(dissoc ::instance)
(pp/pprint {:width 70})))
@ -33,8 +33,9 @@
(defn- print-explain!
[data]
(when-let [explain (::sm/explain data)]
(-> (sm/humanize-data explain)
(pp/pprint {:width 70}))))
(js/console.log (sm/humanize-data explain)))
(when-let [explain (:explain data)]
(js/console.log explain)))
(defn- print-trace!
[data]
@ -98,7 +99,8 @@
(print-group! "Validation Error"
(fn []
(print-data! error))))
(print-data! error)
(print-explain! error))))
;; This is a pure frontend error that can be caused by an active
@ -223,7 +225,22 @@
(print-group! "Server Error"
(fn []
(print-data! error))))
(print-data! (dissoc error :data))
(when-let [werror (:data error)]
(cond
(= :assertion (:type werror))
(print-group! "Assertion Error"
(fn []
(print-data! werror)
(print-explain! werror)))
:else
(print-group! "Unexpected"
(fn []
(print-data! werror)
(print-explain! werror))))))))
(defonce uncaught-error-handler
(letfn [(is-ignorable-exception? [cause]

67
frontend/src/app/main/render.cljs
View file

@ -43,7 +43,6 @@
[app.main.ui.shapes.text :as text]
[app.main.ui.shapes.text.fontfaces :as ff]
[app.util.http :as http]
[app.util.object :as obj]
[app.util.strings :as ust]
[app.util.thumbnails :as th]
[app.util.timers :as ts]
@ -83,11 +82,11 @@
(let [shape-wrapper (shape-wrapper-factory objects)
frame-shape (frame/frame-shape shape-wrapper)]
(mf/fnc frame-wrapper
[{:keys [shape] :as props}]
(let [render-thumbnails? (mf/use-ctx muc/render-thumbnails)
childs (mapv #(get objects %) (:shapes shape))]
(if (and render-thumbnails? (some? (:thumbnail shape)))
{::mf/wrap-props false}
[{:keys [shape]}]
(let [thumbnails? (mf/use-ctx muc/render-thumbnails)
childs (mapv (d/getf objects) (:shapes shape))]
(if (and thumbnails? (some? (:thumbnail shape)))
[:& frame/frame-thumbnail {:shape shape :bounds (:children-bounds shape)}]
[:& frame-shape {:shape shape :childs childs}])))))
@ -193,8 +192,8 @@
(mf/defc page-svg
{::mf/wrap [mf/memo]}
[{:keys [data thumbnails? render-embed? include-metadata?] :as props
:or {render-embed? false include-metadata? false}}]
[{:keys [data use-thumbnails embed include-metadata] :as props
:or {embed false include-metadata false}}]
(let [objects (:objects data)
shapes (cph/get-immediate-children objects)
dim (calculate-dimensions objects)
@ -206,20 +205,20 @@
(mf/deps objects)
#(shape-wrapper-factory objects))]
[:& (mf/provider muc/render-thumbnails) {:value thumbnails?}
[:& (mf/provider embed/context) {:value render-embed?}
[:& (mf/provider export/include-metadata-ctx) {:value include-metadata?}
[:& (mf/provider muc/render-thumbnails) {:value use-thumbnails}
[:& (mf/provider embed/context) {:value embed}
[:& (mf/provider export/include-metadata-ctx) {:value include-metadata}
[:svg {:view-box vbox
:version "1.1"
:xmlns "http://www.w3.org/2000/svg"
:xmlnsXlink "http://www.w3.org/1999/xlink"
:xmlns:penpot (when include-metadata? "https://penpot.app/xmlns")
:xmlns:penpot (when include-metadata "https://penpot.app/xmlns")
:style {:width "100%"
:height "100%"
:background bgcolor}
:fill "none"}
(when include-metadata?
(when include-metadata
[:& export/export-page {:id (:id data) :options (:options data)}])
(let [shapes (->> shapes
@ -250,9 +249,9 @@
;; the viewer and inspector
(mf/defc frame-svg
{::mf/wrap [mf/memo]}
[{:keys [objects frame zoom show-thumbnails?] :or {zoom 1} :as props}]
(let [frame-id (:id frame)
include-metadata? (mf/use-ctx export/include-metadata-ctx)
[{:keys [objects frame zoom use-thumbnails] :or {zoom 1} :as props}]
(let [frame-id (:id frame)
include-metadata (mf/use-ctx export/include-metadata-ctx)
bounds (gsb/get-object-bounds objects frame)
@ -294,14 +293,14 @@
height (* (:height bounds) zoom)
vbox (format-viewbox {:width (:width bounds 0) :height (:height bounds 0)})]
[:& (mf/provider muc/render-thumbnails) {:value show-thumbnails?}
[:& (mf/provider muc/render-thumbnails) {:value use-thumbnails}
[:svg {:view-box vbox
:width (ust/format-precision width viewbox-decimal-precision)
:height (ust/format-precision height viewbox-decimal-precision)
:version "1.1"
:xmlns "http://www.w3.org/2000/svg"
:xmlnsXlink "http://www.w3.org/1999/xlink"
:xmlns:penpot (when include-metadata? "https://penpot.app/xmlns")
:xmlns:penpot (when include-metadata "https://penpot.app/xmlns")
:fill "none"}
[:& shape-wrapper {:shape frame}]]]))
@ -312,7 +311,7 @@
[{:keys [objects root-shape zoom] :or {zoom 1} :as props}]
(when root-shape
(let [root-shape-id (:id root-shape)
include-metadata? (mf/use-ctx export/include-metadata-ctx)
include-metadata (mf/use-ctx export/include-metadata-ctx)
vector
(mf/use-memo
@ -348,7 +347,7 @@
:version "1.1"
:xmlns "http://www.w3.org/2000/svg"
:xmlnsXlink "http://www.w3.org/1999/xlink"
:xmlns:penpot (when include-metadata? "https://penpot.app/xmlns")
:xmlns:penpot (when include-metadata "https://penpot.app/xmlns")
:fill "none"}
[:> shape-container {:shape root-shape'}
@ -357,8 +356,8 @@
(mf/defc object-svg
{::mf/wrap [mf/memo]}
[{:keys [objects object-id render-embed?]
:or {render-embed? false}
[{:keys [objects object-id embed]
:or {embed false}
:as props}]
(let [object (get objects object-id)
object (cond-> object
@ -375,7 +374,7 @@
(shape-wrapper-factory objects))]
[:& (mf/provider export/include-metadata-ctx) {:value false}
[:& (mf/provider embed/context) {:value render-embed?}
[:& (mf/provider embed/context) {:value embed}
[:svg {:id (dm/str "screenshot-" object-id)
:view-box vbox
:width (ust/format-precision width viewbox-decimal-precision)
@ -439,20 +438,16 @@
:group [:& group-wrapper {:shape root-shape :view-box vbox}]
:frame [:& frame-wrapper {:shape root-shape :view-box vbox}])]]))
(mf/defc components-sprite-svg
(mf/defc components-svg
{::mf/wrap-props false}
[props]
(let [data (obj/get props "data")
children (obj/get props "children")
render-embed? (obj/get props "render-embed?")
include-metadata? (obj/get props "include-metadata?")
source (keyword (obj/get props "source" "components"))]
[:& (mf/provider embed/context) {:value render-embed?}
[:& (mf/provider export/include-metadata-ctx) {:value include-metadata?}
[{:keys [data children embed include-metadata source]}]
(let [source (keyword (d/nilv source "components"))]
[:& (mf/provider embed/context) {:value embed}
[:& (mf/provider export/include-metadata-ctx) {:value include-metadata}
[:svg {:version "1.1"
:xmlns "http://www.w3.org/2000/svg"
:xmlnsXlink "http://www.w3.org/1999/xlink"
:xmlns:penpot (when include-metadata? "https://penpot.app/xmlns")
:xmlns:penpot (when include-metadata "https://penpot.app/xmlns")
:style {:display (when-not (some? children) "none")}
:fill "none"}
[:defs
@ -511,7 +506,7 @@
(->> (rx/of data)
(rx/map
(fn [data]
(let [elem (mf/element page-svg #js {:data data :render-embed? true :include-metadata? true})]
(let [elem (mf/element page-svg #js {:data data :embed true :include-metadata true})]
(rds/renderToStaticMarkup elem)))))))
(defn render-components
@ -531,8 +526,8 @@
(->> (rx/of data)
(rx/map
(fn [data]
(let [elem (mf/element components-sprite-svg
#js {:data data :render-embed? true :include-metadata? true
(let [elem (mf/element components-svg
#js {:data data :embed true :include-metadata true
:source (name source)})]
(rds/renderToStaticMarkup elem))))))))

2
frontend/src/app/main/ui/dashboard/import.cljs
View file

@ -258,9 +258,9 @@
{:cmd :analyze-import
:files files})
(rx/delay-emit emit-delay)
(rx/filter some?)
(rx/subs
(fn [{:keys [uri data error type] :as msg}]
(log/debug :uri uri :data data :error error)
(if (some? error)
(swap! state update :files set-analyze-error uri)
(swap! state update :files set-analyze-result uri type data)))))))

2
frontend/src/app/main/ui/viewer/thumbnails.cljs
View file

@ -88,7 +88,7 @@
(assoc :thumbnail (get thumbnail-data (dm/str page-id (:id frame))))
(assoc :children-bounds children-bounds))
:objects objects
:show-thumbnails? true}]]
:use-thumbnails true}]]
[:div.thumbnail-info
[:span.name {:title (:name frame)} (:name frame)]]]))

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

@ -8,125 +8,54 @@
"The main entry point for UI part needed by the exporter."
(:require
[app.common.geom.shapes.bounds :as gsb]
[app.common.logging :as l]
[app.common.logging :as log]
[app.common.math :as mth]
[app.common.spec :as us]
[app.common.schema :as sm]
[app.common.types.components-list :as ctkl]
[app.common.uri :as u]
[app.main.data.fonts :as df]
[app.main.features :as feat]
[app.main.data.users :as du]
[app.main.features :as features]
[app.main.render :as render]
[app.main.repo :as repo]
[app.main.store :as st]
[app.util.dom :as dom]
[app.util.globals :as glob]
[beicon.core :as rx]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[garden.core :refer [css]]
[okulary.core :as l]
[potok.core :as ptk]
[rumext.v2 :as mf]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SETUP
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(log/setup! {:app :info})
(l/setup! {:app :info})
(defonce app-root
(let [el (dom/get-element "app")]
(mf/create-root el)))
(declare ^:private render-single-object)
(declare ^:private render-components)
(declare ^:private render-objects)
(defn- parse-params
[loc]
(let [href (unchecked-get loc "href")]
(some-> href u/uri :query u/query-string->map)))
(defn init-ui
[]
(when-let [params (parse-params glob/location)]
(when-let [component (case (:route params)
"objects" (render-objects params)
"components" (render-components params)
nil)]
(mf/render! app-root component))))
(defn ^:export init
[]
(st/emit! (feat/initialize))
(init-ui))
(defn reinit
[]
(mf/unmount! app-root)
(init-ui))
(defn ^:dev/after-load after-load
[]
(reinit))
(defn- fetch-team
[& {:keys [file-id]}]
(ptk/reify ::fetch-team
ptk/WatchEvent
(watch [_ _ _]
(->> (repo/cmd! :get-team {:file-id file-id})
(rx/mapcat (fn [team]
(rx/of (du/set-current-team team)
(ptk/data-event ::team-fetched team))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; COMPONENTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ---- SINGLE OBJECT
(defn use-resource
"A general purpose hook for retrieve or subscribe to remote changes
using the reactive-streams mechanism mechanism.
It receives a function to execute for retrieve the stream that will
be used for creating the subscription. The function should be
stable, so is the responsibility of the user of this hook to
properly memoize it.
TODO: this should be placed in some generic hooks namespace but his
right now is pending of refactor and it will be done later."
[f]
(let [[state ^js update-state!] (mf/useState {:loaded? false})]
(mf/with-effect [f]
(update-state! (fn [prev] (assoc prev :refreshing? true)))
(let [on-value (fn [data]
(update-state! #(-> %
(assoc :refreshing? false)
(assoc :loaded? true)
(merge data))))
subs (rx/subscribe (f) on-value)]
#(rx/dispose! subs)))
state))
(def ^:private ref:objects
(l/derived :objects st/state))
(mf/defc object-svg
[{:keys [page-id file-id share-id object-id render-embed?]}]
(let [components-v2 (feat/use-feature "components/v2")
fetch-state (mf/use-fn
(mf/deps file-id page-id share-id object-id components-v2)
(fn []
(let [features (cond-> #{} components-v2 (conj "components/v2"))]
(->> (rx/zip
(repo/cmd! :get-font-variants {:file-id file-id :share-id share-id})
(repo/cmd! :get-page {:file-id file-id
:page-id page-id
:share-id share-id
:object-id object-id
:features features}))
(rx/tap (fn [[fonts]]
(when (seq fonts)
(st/emit! (df/fonts-fetched fonts)))))
(rx/map (comp :objects second))
(rx/map (fn [objects]
(let [objects (render/adapt-objects-for-shape objects object-id)]
{:objects objects
:object (get objects object-id)})))))))
{:keys [objects object]} (use-resource fetch-state)]
{::mf/wrap-props false}
[{:keys [object-id embed]}]
(let [objects (mf/deref ref:objects)]
;; Set the globa CSS to assign the page size, needed for PDF
;; exportation process.
(mf/with-effect [object]
(when object
(mf/with-effect [objects]
(when-let [object (get objects object-id)]
(let [{:keys [width height]} (gsb/get-object-bounds [objects] object)]
(dom/set-page-style!
{:size (str/concat
@ -137,90 +66,107 @@
[:& render/object-svg
{:objects objects
:object-id object-id
:render-embed? render-embed?}])))
:embed embed}])))
(mf/defc objects-svg
[{:keys [page-id file-id share-id object-ids render-embed?]}]
(let [components-v2 (feat/use-feature "components/v2")
fetch-state (mf/use-fn
(mf/deps file-id page-id share-id components-v2)
(fn []
(let [features (cond-> #{} components-v2 (conj "components/v2"))]
(->> (rx/zip
(repo/cmd! :get-font-variants {:file-id file-id :share-id share-id})
(repo/cmd! :get-page {:file-id file-id
:page-id page-id
:share-id share-id
:features features}))
(rx/tap (fn [[fonts]]
(when (seq fonts)
(st/emit! (df/fonts-fetched fonts)))))
(rx/map (fn [[_ page]] {:objects (:objects page)}))))))
{::mf/wrap-props false}
[{:keys [object-ids embed]}]
(when-let [objects (mf/deref ref:objects)]
(for [object-id object-ids]
(let [objects (render/adapt-objects-for-shape objects object-id)]
[:& render/object-svg
{:objects objects
:key (str object-id)
:object-id object-id
:embed embed}]))))
{:keys [objects]} (use-resource fetch-state)]
(defn- fetch-objects-bundle
[& {:keys [file-id page-id share-id object-id] :as options}]
(ptk/reify ::fetch-objects-bundle
ptk/WatchEvent
(watch [_ state _]
(let [features (features/get-team-enabled-features state)]
(->> (rx/zip
(repo/cmd! :get-font-variants {:file-id file-id :share-id share-id})
(repo/cmd! :get-page {:file-id file-id
:page-id page-id
:share-id share-id
:object-id object-id
:features features}))
(rx/tap (fn [[fonts]]
(when (seq fonts)
(st/emit! (df/fonts-fetched fonts)))))
(rx/observe-on :async)
(rx/map (comp :objects second))
(rx/map (fn [objects]
(let [objects (render/adapt-objects-for-shape objects object-id)]
#(assoc % :objects objects)))))))))
(when objects
(for [object-id object-ids]
(let [objects (render/adapt-objects-for-shape objects object-id)]
[:& render/object-svg
{:objects objects
:key (str object-id)
:object-id object-id
:render-embed? render-embed?}])))))
(def ^:private schema:render-objects
[:map {:title "render-objets"}
[:page-id ::sm/uuid]
[:file-id ::sm/uuid]
[:share-id {:optional true} ::sm/uuid]
[:embed {:optional true} :boolean]
[:object-id
[:or
::sm/uuid
::sm/coll-of-uuid]]])
(s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::share-id ::us/uuid)
(s/def ::object-id
(s/or :single ::us/uuid
:multiple (s/coll-of ::us/uuid)))
(s/def ::embed ::us/boolean)
(def ^:private render-objects-decoder
(sm/lazy-decoder schema:render-objects
sm/default-transformer))
(s/def ::render-objects
(s/keys :req-un [::file-id ::page-id ::object-id]
:opt-un [::render-embed ::share-id]))
(def ^:private render-objects-validator
(sm/lazy-validator schema:render-objects))
(defn- render-objects
[params]
(let [{:keys [file-id
page-id
render-embed
share-id]
:as params}
(us/conform ::render-objects params)
(let [{:keys [file-id page-id embed share-id object-id] :as params} (render-objects-decoder params)]
(if-not (render-objects-validator params)
(do
(js/console.error "invalid arguments")
(sm/pretty-explain schema:render-objects params)
nil)
[type object-id] (:object-id params)]
(case type
:single
(mf/html
[:& object-svg
{:file-id file-id
:page-id page-id
:share-id share-id
:object-id object-id
:render-embed? render-embed}])
(do
(st/emit! (ptk/reify ::initialize-render-objects
ptk/WatchEvent
(watch [_ _ stream]
(rx/merge
(rx/of (fetch-team :file-id file-id))
:multiple
(mf/html
[:& objects-svg
{:file-id file-id
:page-id page-id
:share-id share-id
:object-ids (into #{} object-id)
:render-embed? render-embed}]))))
(->> stream
(rx/filter (ptk/type? ::team-fetched))
(rx/observe-on :async)
(rx/map (constantly params))
(rx/map fetch-objects-bundle))))))
(if (uuid? object-id)
(mf/html
[:& object-svg
{:file-id file-id
:page-id page-id
:share-id share-id
:object-id object-id
:embed embed}])
(mf/html
[:& objects-svg
{:file-id file-id
:page-id page-id
:share-id share-id
:object-ids (into #{} object-id)
:embed embed}]))))))
;; ---- COMPONENTS SPRITE
(mf/defc components-sprite-svg
[{:keys [file-id embed] :as props}]
(let [fetch (mf/use-fn
(mf/deps file-id)
(fn [] (repo/cmd! :get-file {:id file-id})))
file (use-resource fetch)
state (mf/use-state nil)]
(when file
(mf/defc components-svg
{::mf/wrap-props false}
[{:keys [embed component-id]}]
(let [file-ref (mf/with-memo [] (l/derived :file st/state))
state (mf/use-state {:component-id component-id})]
(when-let [file (mf/deref file-ref)]
[:*
[:style
(css [[:body
@ -266,7 +212,7 @@
[:a {:on-click on-click} (:name data)]]))]
[:main
[:& render/components-sprite-svg
[:& render/components-svg
{:data (:data file)
:embed embed}
@ -275,16 +221,93 @@
])))
(s/def ::component-id ::us/uuid)
(s/def ::render-components
(s/keys :req-un [::file-id]
:opt-un [::embed ::component-id]))
(defn- fetch-components-bundle
[& {:keys [file-id]}]
(ptk/reify ::fetch-components-bundle
ptk/WatchEvent
(watch [_ state _]
(let [features (features/get-team-enabled-features state)]
(->> (repo/cmd! :get-file {:id file-id :features features})
(rx/map (fn [file] #(assoc % :file file))))))))
(def ^:private schema:render-components
[:map {:title "render-components"}
[:file-id ::sm/uuid]
[:embed {:optional true} :boolean]
[:component-id {:optional true} ::sm/uuid]])
(def ^:private render-components-decoder
(sm/lazy-decoder schema:render-components
sm/default-transformer))
(def ^:private render-components-validator
(sm/lazy-validator schema:render-components))
(defn render-components
[params]
(let [{:keys [file-id component-id embed]} (us/conform ::render-components params)]
(mf/html
[:& components-sprite-svg
{:file-id file-id
:component-id component-id
:embed embed}])))
(let [{:keys [file-id component-id embed] :as params} (render-components-decoder params)]
(if-not (render-components-validator params)
(do
(js/console.error "invalid arguments")
(sm/pretty-explain schema:render-components params)
nil)
(do
(st/emit! (ptk/reify ::initialize-render-components
ptk/WatchEvent
(watch [_ _ stream]
(rx/merge
(rx/of (fetch-team :file-id file-id))
(->> stream
(rx/filter (ptk/type? ::team-fetched))
(rx/observe-on :async)
(rx/map (constantly params))
(rx/map fetch-components-bundle))))))
(mf/html
[:& components-svg
{:component-id component-id
:embed embed}])))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SETUP
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defonce app-root
(let [el (dom/get-element "app")]
(mf/create-root el)))
(declare ^:private render-single-object)
(declare ^:private render-components)
(declare ^:private render-objects)
(defn- parse-params
[loc]
(let [href (unchecked-get loc "href")]
(some-> href u/uri :query u/query-string->map)))
(defn init-ui
[]
(when-let [params (parse-params glob/location)]
(when-let [component (case (:route params)
"objects" (render-objects params)
"components" (render-components params)
nil)]
(mf/render! app-root component))))
(defn ^:export init
[]
(st/emit! (features/initialize))
(init-ui))
(defn reinit
[]
(init-ui))
(defn ^:dev/after-load after-load
[]
(reinit))

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

@ -14,6 +14,7 @@
[app.common.geom.shapes.path :as gpa]
[app.common.logging :as log]
[app.common.media :as cm]
[app.common.pprint :as pp]
[app.common.text :as ct]
[app.common.uuid :as uuid]
[app.main.repo :as rp]
@ -639,6 +640,7 @@
(let [error (or (.-message data) (tr "dashboard.import.analyze-error"))]
(rx/of {:uri (:uri file) :error error}))))))))))
(defmethod impl/handler :import-files
[{:keys [project-id files features]}]
@ -648,52 +650,60 @@
zip-files (filter #(= "application/zip" (:type %)) files)
binary-files (filter #(= "application/octet-stream" (:type %)) files)]
(->> (rx/merge
(->> (create-files context zip-files)
(rx/flat-map
(fn [[file data]]
(->> (uz/load-from-url (:uri data))
(rx/map #(-> context (assoc :zip %) (merge data)))
(rx/merge-map
(fn [context]
;; process file retrieves a stream that will emit progress notifications
;; and other that will emit the files once imported
(let [[progress-stream file-stream] (process-file context file)]
(rx/merge progress-stream
(->> file-stream
(rx/map
(fn [file]
{:status :import-finish
:errors (:errors file)
:file-id (:file-id data)})))))))
(rx/catch (fn [cause]
(log/error :hint (ex-message cause) :file-id (:file-id data) :cause cause)
(rx/of {:status :import-error
:file-id (:file-id data)
:error (ex-message cause)
:error-data (ex-data cause)})))))))
(rx/merge
(->> (create-files context zip-files)
(rx/flat-map
(fn [[file data]]
(->> (uz/load-from-url (:uri data))
(rx/map #(-> context (assoc :zip %) (merge data)))
(rx/merge-map
(fn [context]
;; process file retrieves a stream that will emit progress notifications
;; and other that will emit the files once imported
(let [[progress-stream file-stream] (process-file context file)]
(rx/merge progress-stream
(->> file-stream
(rx/map
(fn [file]
{:status :import-finish
:errors (:errors file)
:file-id (:file-id data)})))))))
(rx/catch (fn [cause]
(log/error :hint (ex-message cause)
:file-id (:file-id data)
:cause cause)
(rx/of {:status :import-error
:file-id (:file-id data)
:error (ex-message cause)
:error-data (ex-data cause)})))))))
(->> (rx/from binary-files)
(rx/flat-map
(fn [data]
(->> (http/send!
{:uri (:uri data)
:response-type :blob
:method :get})
(rx/map :body)
(rx/mapcat #(rp/cmd! :import-binfile {:file %
:project-id project-id}))
(rx/map
(fn [_]
{:status :import-finish
:file-id (:file-id data)})))))))
(->> (rx/from binary-files)
(rx/flat-map
(fn [data]
(->> (http/send!
{:uri (:uri data)
:response-type :blob
:method :get})
(rx/map :body)
(rx/mapcat #(rp/cmd! :import-binfile {:file % :project-id project-id}))
(rx/map (fn [_]
{:status :import-finish
:file-id (:file-id data)}))
(rx/catch (fn [cause]
(log/error :hint "unexpected error on import process"
:project-id project-id
::log/sync? true)
;; TODO: consider do thi son logging directly ?
(rx/catch (fn [cause]
(log/error :hint "unexpected error on import process"
:project-id project-id
:cause cause)
(if (map? cause)
(js/console.error (pr-str cause))
(js/console.error cause)))))))
(when (map? cause)
(println "Error data:")
(pp/pprint (dissoc cause :explain) {:level 2 :length 10}))
(when (string? (:explain cause))
(js/console.log (:explain cause)))
(rx/of {:status :import-error
:file-id (:file-id data)
:error (:hint cause)
:error-data cause}))))))))))

4
frontend/src/app/worker/thumbnails.cljs
View file

@ -63,8 +63,8 @@
(let [objects (:objects page)
frame (some->> page :thumbnail-frame-id (get objects))
element (if frame
(mf/element render/frame-svg #js {:objects objects :frame frame :show-thumbnails? true})
(mf/element render/page-svg #js {:data page :thumbnails? true :render-embed? true}))
(mf/element render/frame-svg #js {:objects objects :frame frame :use-thumbnails true})
(mf/element render/page-svg #js {:data page :use-thumbnails true :embed true}))
data (rds/renderToStaticMarkup element)]
{:data data
:fonts @fonts/loaded-hints