3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-06-13 05:31:41 +02:00
Code Issues Projects Releases Packages Wiki 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
Download patch file Download diff file Expand all files Collapse all files

5
backend/deps.edn
View file

@ -4,6 +4,8 @@
:deps :deps
{penpot/common {:local/root "../common"} {penpot/common {:local/root "../common"}
org.clojure/clojure {:mvn/version "1.12.0-alpha5"} 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"} com.github.luben/zstd-jni {:mvn/version "1.5.5-10"}
io.prometheus/simpleclient {:mvn/version "0.16.0"} io.prometheus/simpleclient {:mvn/version "0.16.0"}
@ -26,6 +28,8 @@
com.github.seancorfield/next.jdbc {:mvn/version "1.3.894"} com.github.seancorfield/next.jdbc {:mvn/version "1.3.894"}
metosin/reitit-core {:mvn/version "0.6.0"} 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"} org.postgresql/postgresql {:mvn/version "42.6.0"}
@ -61,7 +65,6 @@
{:dev {:dev
{:extra-deps {:extra-deps
{com.bhauman/rebel-readline {:mvn/version "RELEASE"} {com.bhauman/rebel-readline {:mvn/version "RELEASE"}
org.clojure/tools.namespace {:mvn/version "RELEASE"}
clojure-humanize/clojure-humanize {:mvn/version "0.2.2"} clojure-humanize/clojure-humanize {:mvn/version "0.2.2"}
org.clojure/data.csv {:mvn/version "RELEASE"} org.clojure/data.csv {:mvn/version "RELEASE"}
com.clojure-goes-fast/clj-async-profiler {: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) (stop)
(repl/refresh-all :after 'user/start)) (repl/refresh-all :after 'user/start))
(defn compression-bench ;; (defn compression-bench
[data] ;; [data]
(let [humanize (fn [v] (hum/filesize v :binary true :format " %.4f ")) ;; (let [humanize (fn [v] (hum/filesize v :binary true :format " %.4f "))
v1 (time (humanize (alength (blob/encode data {:version 1})))) ;; v1 (time (humanize (alength (blob/encode data {:version 1}))))
v3 (time (humanize (alength (blob/encode data {:version 3})))) ;; v3 (time (humanize (alength (blob/encode data {:version 3}))))
v4 (time (humanize (alength (blob/encode data {:version 4})))) ;; v4 (time (humanize (alength (blob/encode data {:version 4}))))
v5 (time (humanize (alength (blob/encode data {:version 5})))) ;; v5 (time (humanize (alength (blob/encode data {:version 5}))))
v6 (time (humanize (alength (blob/encode data {:version 6})))) ;; v6 (time (humanize (alength (blob/encode data {:version 6}))))
] ;; ]
(print-table ;; (print-table
[{ ;; [{
:v1 v1 ;; :v1 v1
:v3 v3 ;; :v3 v3
:v4 v4 ;; :v4 v4
:v5 v5 ;; :v5 v5
:v6 v6 ;; :v6 v6
}]))) ;; }])))
(defonce debug-tap (defonce debug-tap
(do (do

24
backend/package.json
View file

@ -1,18 +1,16 @@
{ {
"name": "uxbox-back", "name": "penpot-backend",
"version": "0.1.0", "version": "1.0.0",
"description": "The Open-Source prototyping tool", "main": "index.js",
"scripts": { "license": "MPL-2.0",
"test": "echo \"Error: no test specified\" && exit 1", "dependencies": {
"build-emails": "./scripts/build-email-templates.sh" "luxon": "^3.4.2",
"sax": "^1.2.4"
}, },
"repository": { "scripts": {},
"type": "git",
"url": "git+https://github.com/uxbox/uxbox.git"
},
"author": "Uxbox",
"license": "SEE LICENSE IN <LICENSE>",
"devDependencies": { "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="org.postgresql" level="error" />
<Logger name="app.util" level="info" /> <Logger name="app.util" level="info" />
<Logger name="app.loggers" level="debug" />
<Logger name="app" level="info" additivity="false"> <Logger name="app" level="info" additivity="false">
<AppenderRef ref="console" /> <AppenderRef ref="console" />
</Logger> </Logger>
<Root level="info"> <Root level="info">
<AppenderRef ref="console" /> <AppenderRef ref="console" />
</Root> </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 \ $PENPOT_FLAGS \
enable-prepl-server \ enable-prepl-server \
enable-urepl-server \ enable-urepl-server \
enable-nrepl-server \
enable-webhooks \ enable-webhooks \
enable-backend-asserts \ enable-backend-asserts \
enable-audit-log \ enable-audit-log \
enable-transit-readable-response \ enable-transit-readable-response \
enable-demo-users \ enable-demo-users \
enable-fdata-storage-pointer-map \ enable-file-validation \
enable-fdata-storage-objets-map \ enable-feature-fdata-pointer-map \
enable-feature-fdata-objects-map \
disable-secure-session-cookies \ disable-secure-session-cookies \
enable-smtp \ enable-smtp \
enable-access-tokens \ enable-access-tokens \
disable-file-validation"; 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 if [ "$1" = "--watch" ]; then
trap "exit" INT TERM ERR
trap "kill 0" EXIT
echo "Start Watch..." echo "Start Watch..."
clojure -A:dev -M -m app.main & clojure -A:dev -M -m app.main &
PID=$!
npx nodemon \ npx nodemon \
--watch src \ --watch src \
--watch ../common \ --watch ../common \
--ext "clj" \ --ext "clj" \
--signal SIGKILL \ --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 else
clojure -A:dev -M -m app.main clojure -A:dev -M -m app.main;
fi fi

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

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

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

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

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

@ -37,8 +37,12 @@
[app.storage.s3 :as-alias sto.s3] [app.storage.s3 :as-alias sto.s3]
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as-alias wrk] [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] [cuerdas.core :as str]
[integrant.core :as ig] [integrant.core :as ig]
[nrepl.server :as nrepl]
[promesa.exec :as px]) [promesa.exec :as px])
(:gen-class)) (:gen-class))
@ -527,7 +531,7 @@
(merge worker-config)) (merge worker-config))
(ig/prep) (ig/prep)
(ig/init)))) (ig/init))))
(l/info :hint "welcome to penpot" (l/inf :hint "welcome to penpot"
:flags (str/join "," (map name cf/flags)) :flags (str/join "," (map name cf/flags))
:worker? (contains? cf/flags :backend-worker) :worker? (contains? cf/flags :backend-worker)
:version (:full cf/version))) :version (:full cf/version)))
@ -537,12 +541,55 @@
(alter-var-root #'system (fn [sys] (alter-var-root #'system (fn [sys]
(when sys (ig/halt! sys)) (when sys (ig/halt! sys))
nil))) 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 (defn -main
[& _args] [& _args]
(try (try
(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) (start)
(deref p))
(catch Throwable cause (catch Throwable cause
(l/error :hint (ex-message cause) (binding [*out* *err*]
:cause cause) (println "==== ERROR ===="))
(.printStackTrace cause)
(when-let [cause' (ex-cause cause)]
(binding [*out* *err*]
(println "==== CAUSE ===="))
(.printStackTrace cause'))
(px/sleep 500)
(System/exit -1)))) (System/exit -1))))

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

@ -12,6 +12,7 @@
[app.common.features :as cfeat] [app.common.features :as cfeat]
[app.common.files.defaults :as cfd] [app.common.files.defaults :as cfd]
[app.common.files.migrations :as pmg] [app.common.files.migrations :as pmg]
[app.common.files.validate :as fval]
[app.common.fressian :as fres] [app.common.fressian :as fres]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.spec :as us] [app.common.spec :as us]
@ -743,7 +744,13 @@
(update :pages-index relink-shapes) (update :pages-index relink-shapes)
(update :components relink-shapes) (update :components relink-shapes)
(update :media relink-media) (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) (postprocess-file)
(update :features #(db/create-array conn "text" %)) (update :features #(db/create-array conn "text" %))
(update :data blob/encode))] (update :data blob/encode))]
@ -973,7 +980,6 @@
:import-id id :import-id id
:elapsed (dt/format-duration (tp)) :elapsed (dt/format-duration (tp))
:error? (some? @cs) :error? (some? @cs)
:cause @cs
))))) )))))
;; --- Command: export-binfile ;; --- 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 "Given the page data and the object-id returns the page data with all
other not needed objects removed from the `:objects` data other not needed objects removed from the `:objects` data
structure." structure."
[{:keys [objects] :as page} object-id] [page id-or-ids]
(let [objects (->> (cph/get-children-with-self objects object-id) (update page :objects (fn [objects]
(filter some?))] (reduce (fn [result object-id]
(assoc page :objects (d/index-by :id objects)))) (->> (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 (defn- prune-thumbnails
"Given the page data, removes the `:thumbnail` prop from all "Given the page data, removes the `:thumbnail` prop from all
@ -480,7 +487,7 @@
page)))] page)))]
(cond-> (prune-thumbnails page) (cond-> (prune-thumbnails page)
(uuid? object-id) (some? object-id)
(prune-objects object-id)))) (prune-objects object-id))))
(def schema:get-page (def schema:get-page
@ -488,7 +495,7 @@
[:file-id ::sm/uuid] [:file-id ::sm/uuid]
[:page-id {:optional true} ::sm/uuid] [:page-id {:optional true} ::sm/uuid]
[:share-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]]) [:features {:optional true} ::cfeat/features]])
(sv/defmethod ::get-page (sv/defmethod ::get-page
@ -500,7 +507,8 @@
If you specify the object-id, the page-id parameter becomes If you specify the object-id, the page-id parameter becomes
mandatory. mandatory.
Mainly used for rendering purposes." Mainly used for rendering purposes on the exporter. It does not
accepts client features."
{::doc/added "1.17" {::doc/added "1.17"
::sm/params schema:get-page} ::sm/params schema:get-page}
[cfg {:keys [::rpc/profile-id file-id share-id] :as params}] [cfg {:keys [::rpc/profile-id file-id share-id] :as params}]

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

@ -178,7 +178,8 @@
(l/trace :hint "update-file" :time (dt/format-duration elapsed))))))))) (l/trace :hint "update-file" :time (dt/format-duration elapsed)))))))))
(defn update-file (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 (binding [cfeat/*current* features
cfeat/*previous* (:features file)] cfeat/*previous* (:features file)]
(let [update-fn (cond-> update-file* (let [update-fn (cond-> update-file*
@ -188,16 +189,6 @@
(contains? features "fdata/objects-map") (contains? features "fdata/objects-map")
(wrap-with-objects-map-context)) (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 (if changes-with-metadata
(->> changes-with-metadata (mapcat :changes) vec) (->> changes-with-metadata (mapcat :changes) vec)
(vec changes)) (vec changes))
@ -225,9 +216,9 @@
(let [file (assoc file :features features) (let [file (assoc file :features features)
params (-> params params (-> params
(assoc :file file) (assoc :file file)
(assoc :libraries libraries)
(assoc :changes changes) (assoc :changes changes)
(assoc ::created-at (dt/now)))] (assoc ::created-at (dt/now)))]
(-> (update-fn cfg params) (-> (update-fn cfg params)
(vary-meta assoc ::audit/replace-props (vary-meta assoc ::audit/replace-props
{:id (:id file) {:id (:id file)
@ -237,12 +228,13 @@
:team-id (:team-id file)})))))) :team-id (:team-id file)}))))))
(defn- update-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 (let [;; Process the file data in the CLIMIT context; scheduling it
;; to be executed on a separated executor for avoid to do the ;; to be executed on a separated executor for avoid to do the
;; CPU intensive operation on vthread. ;; CPU intensive operation on vthread.
file (-> (climit/configure cfg :update-file) 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 (db/insert! conn :file-change
{:id (uuid/next) {:id (uuid/next)
@ -276,36 +268,44 @@
(get-lagged-changes conn params)))) (get-lagged-changes conn params))))
(defn- update-file-data (defn- update-file-data
[file libraries changes skip-validate] [conn file changes skip-validate]
(let [validate (fn [file] (let [file (update file :data (fn [data]
(when (and (cf/flags :file-validation) (-> data
(not skip-validate)) (blob/decode)
(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)) (assoc :id (:id file))
(pmg/migrate-data)) (pmg/migrate-data))))
:always ;; WARNING: this ruins performance; maybe we need to find
(cp/process-changes changes)))) ;; some other way to do general validation
(d/tap-r validate)) 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") (-> file
(update :revn inc)
(update :data cp/process-changes changes)
;; 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"))) (not (contains? cfeat/*previous* "fdata/objects-map")))
(enable-objects-map file) (enable-objects-map))
file)
file (if (and (contains? cfeat/*current* "fdata/pointer-map") (cond-> (and (contains? cfeat/*current* "fdata/pointer-map")
(not (contains? cfeat/*previous* "fdata/pointer-map"))) (not (contains? cfeat/*previous* "fdata/pointer-map")))
(enable-pointer-map file) (enable-pointer-map))
file)
] (update :data blob/encode))))
(update file :data blob/encode)))
(defn- take-snapshot? (defn- take-snapshot?
"Defines the rule when file `data` snapshot should be saved." "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} [:props {:optional true}
[:map-of {:title "ProfileProps"} :keyword :any]]]) [:map-of {:title "ProfileProps"} :keyword :any]]])
(def profile? (def valid-profile?
(sm/pred-fn schema:profile)) (sm/pred-fn schema:profile))
;; --- QUERY: Get profile (own) ;; --- QUERY: Get profile (own)
@ -95,7 +95,7 @@
(dm/assert! (dm/assert!
"expected valid profile data" "expected valid profile data"
(profile? params)) (valid-profile? params))
(db/with-atomic [conn pool] (db/with-atomic [conn pool]
;; NOTE: we need to retrieve the profile independently if we use ;; NOTE: we need to retrieve the profile independently if we use

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

@ -138,14 +138,20 @@
(declare get-team) (declare get-team)
(def ^:private schema:get-team (def ^:private schema:get-team
[:and
[:map {:title "get-team"} [:map {:title "get-team"}
[:id ::sm/uuid]]) [: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 (sv/defmethod ::get-team
{::doc/added "1.17" {::doc/added "1.17"
::sm/params schema:get-team} ::sm/params schema:get-team}
[cfg {:keys [::rpc/profile-id id]}] [cfg {:keys [::rpc/profile-id id file-id]}]
(db/tx-run! cfg #(get-team % :profile-id profile-id :team-id id))) (db/tx-run! cfg #(get-team % :profile-id profile-id :team-id id :file-id file-id)))
(defn get-team (defn get-team
[conn & {:keys [profile-id team-id project-id file-id] :as params}] [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)] lock (locks/create)]
(ccs/prepl *in* (ccs/prepl *in*
(fn [m] (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 (locks/locking lock
(println (json/encode-str m)))))))) (println (json/encode-str m))))))))
@ -44,13 +46,10 @@
(s/def ::port ::us/integer) (s/def ::port ::us/integer)
(s/def ::host ::us/not-empty-string) (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 (defmethod ig/pre-init-spec ::server
[_] [_]
(s/keys :req [::flag ::host ::port])) (s/keys :req [::host ::port]))
(defmethod ig/prep-key ::server (defmethod ig/prep-key ::server
[[type _] cfg] [[type _] cfg]
@ -59,6 +58,12 @@
(defmethod ig/init-key ::server (defmethod ig/init-key ::server
[[type _] {:keys [::flag ::port ::host] :as cfg}] [[type _] {:keys [::flag ::port ::host] :as cfg}]
(when (contains? cf/flags flag) (when (contains? cf/flags flag)
(l/inf :hint "initializing repl server"
:name (name type)
:port port
:host host)
(let [accept (case type (let [accept (case type
::prepl 'app.srepl/json-repl ::prepl 'app.srepl/json-repl
::urepl 'app.srepl/user-repl) ::urepl 'app.srepl/user-repl)
@ -67,14 +72,8 @@
:name (name type) :name (name type)
:accept accept}] :accept accept}]
(l/info :msg "initializing repl server"
:name (name type)
:port port
:host host)
(ccs/start-server params) (ccs/start-server params)
(assoc params :type type))))
params)))
(defmethod ig/halt-key! ::server (defmethod ig/halt-key! ::server
[_ params] [_ params]

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

@ -31,6 +31,7 @@
[app.util.time :as dt] [app.util.time :as dt]
[app.worker :as wrk] [app.worker :as wrk]
[clojure.pprint :refer [pprint print-table]] [clojure.pprint :refer [pprint print-table]]
[clojure.tools.namespace.repl :as repl]
[cuerdas.core :as str])) [cuerdas.core :as str]))
(defn print-available-tasks (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 (defn explain
([data] (explain data nil)) ([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 (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) (and (= (:reason data) :integrant.core/build-failed-spec)
(contains? data :explain)) (contains? data :explain))
(explain (:explain data) opts) (explain (:explain data) opts)
@ -81,8 +81,7 @@
(s/explain-out (update data ::s/problems #(take length %))))) (s/explain-out (update data ::s/problems #(take length %)))))
(contains? data ::sm/explain) (contains? data ::sm/explain)
(-> (sm/humanize-data (::sm/explain data)) (sm/humanize-data (::sm/explain data) :level level :length length))))
(pp/pprint-str {:level level :length length})))))
#?(:clj #?(:clj
(defn format-throwable (defn format-throwable

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

@ -190,10 +190,16 @@
(check-supported-features! file-features) (check-supported-features! file-features)
(let [not-supported (-> file-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 enabled-features)
(set/difference client-features) (set/difference client-features)
(set/difference backend-only-features)
(set/difference frontend-only-features))] (set/difference frontend-only-features))]
(when (seq not-supported) (when (seq not-supported)
(ex/raise :type :restriction (ex/raise :type :restriction
:code :feature-mismatch :code :feature-mismatch

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

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

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

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

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

@ -58,10 +58,10 @@
[:media {:optional true} [:media {:optional true}
[:map-of {:gen/max 5} ::sm/uuid ::media-object]]]) [:map-of {:gen/max 5} ::sm/uuid ::media-object]]])
(def file-data? (def valid-file-data?
(sm/pred-fn ::data)) (sm/pred-fn ::data))
(def media-object? (def valid-media-object?
(sm/pred-fn ::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)))) (update :pages-index assoc id (dissoc page :index))))
(defn pages-seq (defn pages-seq
[file-data] [fdata]
(vals (:pages-index file-data))) (vals (:pages-index fdata)))
(defn update-page (defn update-page
[file-data page-id f] [file-data page-id f]

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

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

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

@ -23,6 +23,7 @@
:host "localhost" :host "localhost"
:http-server-port 6061 :http-server-port 6061
:http-server-host "0.0.0.0" :http-server-host "0.0.0.0"
:tempdir "/tmp/penpot-exporter"
:redis-uri "redis://redis/0"}) :redis-uri "redis://redis/0"})
(def ^:private schema:config (def ^:private schema:config
@ -32,6 +33,7 @@
[:tenant {:optional true} :string] [:tenant {:optional true} :string]
[:flags {:optional true} ::sm/set-of-keywords] [:flags {:optional true} ::sm/set-of-keywords]
[:redis-uri {:optional true} :string] [:redis-uri {:optional true} :string]
[:tempdir {:optional true} :string]
[:browser-pool-max {:optional true} :int] [:browser-pool-max {:optional true} :int]
[:browser-pool-min {: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.exceptions :as ex]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.config :as cf]
[cuerdas.core :as str] [cuerdas.core :as str]
[promesa.core :as p])) [promesa.core :as p]))
@ -22,12 +23,12 @@
(def tempfile-minage (* 1000 60 60 1)) ;; 1h (def tempfile-minage (* 1000 60 60 1)) ;; 1h
(def tmpdir (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) (when-not (fs/existsSync path)
(fs/mkdirSync path #js {:recursive true})) (fs/mkdirSync path #js {:recursive true}))
path)) path))
(defn- schedule-deletion! (defn- schedule-deletion!
[path] [path]
(letfn [(remote-tempfile [] (letfn [(remote-tempfile []

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

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

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

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

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

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

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

@ -258,9 +258,9 @@
{:cmd :analyze-import {:cmd :analyze-import
:files files}) :files files})
(rx/delay-emit emit-delay) (rx/delay-emit emit-delay)
(rx/filter some?)
(rx/subs (rx/subs
(fn [{:keys [uri data error type] :as msg}] (fn [{:keys [uri data error type] :as msg}]
(log/debug :uri uri :data data :error error)
(if (some? error) (if (some? error)
(swap! state update :files set-analyze-error uri) (swap! state update :files set-analyze-error uri)
(swap! state update :files set-analyze-result uri type data))))))) (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 :thumbnail (get thumbnail-data (dm/str page-id (:id frame))))
(assoc :children-bounds children-bounds)) (assoc :children-bounds children-bounds))
:objects objects :objects objects
:show-thumbnails? true}]] :use-thumbnails true}]]
[:div.thumbnail-info [:div.thumbnail-info
[:span.name {:title (:name frame)} (:name frame)]]])) [:span.name {:title (:name frame)} (:name frame)]]]))

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

@ -8,125 +8,54 @@
"The main entry point for UI part needed by the exporter." "The main entry point for UI part needed by the exporter."
(:require (:require
[app.common.geom.shapes.bounds :as gsb] [app.common.geom.shapes.bounds :as gsb]
[app.common.logging :as l] [app.common.logging :as log]
[app.common.math :as mth] [app.common.math :as mth]
[app.common.spec :as us] [app.common.schema :as sm]
[app.common.types.components-list :as ctkl] [app.common.types.components-list :as ctkl]
[app.common.uri :as u] [app.common.uri :as u]
[app.main.data.fonts :as df] [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.render :as render]
[app.main.repo :as repo] [app.main.repo :as repo]
[app.main.store :as st] [app.main.store :as st]
[app.util.dom :as dom] [app.util.dom :as dom]
[app.util.globals :as glob] [app.util.globals :as glob]
[beicon.core :as rx] [beicon.core :as rx]
[clojure.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
[garden.core :refer [css]] [garden.core :refer [css]]
[okulary.core :as l]
[potok.core :as ptk]
[rumext.v2 :as mf])) [rumext.v2 :as mf]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (log/setup! {:app :info})
;; SETUP
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(l/setup! {:app :info}) (defn- fetch-team
[& {:keys [file-id]}]
(defonce app-root (ptk/reify ::fetch-team
(let [el (dom/get-element "app")] ptk/WatchEvent
(mf/create-root el))) (watch [_ _ _]
(->> (repo/cmd! :get-team {:file-id file-id})
(declare ^:private render-single-object) (rx/mapcat (fn [team]
(declare ^:private render-components) (rx/of (du/set-current-team team)
(declare ^:private render-objects) (ptk/data-event ::team-fetched team))))))))
(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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; COMPONENTS ;; COMPONENTS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ---- SINGLE OBJECT (def ^:private ref:objects
(l/derived :objects st/state))
(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))
(mf/defc object-svg (mf/defc object-svg
[{:keys [page-id file-id share-id object-id render-embed?]}] {::mf/wrap-props false}
(let [components-v2 (feat/use-feature "components/v2") [{:keys [object-id embed]}]
fetch-state (mf/use-fn (let [objects (mf/deref ref:objects)]
(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)]
;; Set the globa CSS to assign the page size, needed for PDF ;; Set the globa CSS to assign the page size, needed for PDF
;; exportation process. ;; exportation process.
(mf/with-effect [object] (mf/with-effect [objects]
(when object (when-let [object (get objects object-id)]
(let [{:keys [width height]} (gsb/get-object-bounds [objects] object)] (let [{:keys [width height]} (gsb/get-object-bounds [objects] object)]
(dom/set-page-style! (dom/set-page-style!
{:size (str/concat {:size (str/concat
@ -137,90 +66,107 @@
[:& render/object-svg [:& render/object-svg
{:objects objects {:objects objects
:object-id object-id :object-id object-id
:render-embed? render-embed?}]))) :embed embed}])))
(mf/defc objects-svg (mf/defc objects-svg
[{:keys [page-id file-id share-id object-ids render-embed?]}] {::mf/wrap-props false}
(let [components-v2 (feat/use-feature "components/v2") [{:keys [object-ids embed]}]
fetch-state (mf/use-fn (when-let [objects (mf/deref ref:objects)]
(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)}))))))
{:keys [objects]} (use-resource fetch-state)]
(when objects
(for [object-id object-ids] (for [object-id object-ids]
(let [objects (render/adapt-objects-for-shape objects object-id)] (let [objects (render/adapt-objects-for-shape objects object-id)]
[:& render/object-svg [:& render/object-svg
{:objects objects {:objects objects
:key (str object-id) :key (str object-id)
:object-id object-id :object-id object-id
:render-embed? render-embed?}]))))) :embed embed}]))))
(s/def ::page-id ::us/uuid) (defn- fetch-objects-bundle
(s/def ::file-id ::us/uuid) [& {:keys [file-id page-id share-id object-id] :as options}]
(s/def ::share-id ::us/uuid) (ptk/reify ::fetch-objects-bundle
(s/def ::object-id ptk/WatchEvent
(s/or :single ::us/uuid (watch [_ state _]
:multiple (s/coll-of ::us/uuid))) (let [features (features/get-team-enabled-features state)]
(s/def ::embed ::us/boolean) (->> (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)))))))))
(s/def ::render-objects (def ^:private schema:render-objects
(s/keys :req-un [::file-id ::page-id ::object-id] [:map {:title "render-objets"}
:opt-un [::render-embed ::share-id])) [: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]]])
(def ^:private render-objects-decoder
(sm/lazy-decoder schema:render-objects
sm/default-transformer))
(def ^:private render-objects-validator
(sm/lazy-validator schema:render-objects))
(defn- render-objects (defn- render-objects
[params] [params]
(let [{:keys [file-id (let [{:keys [file-id page-id embed share-id object-id] :as params} (render-objects-decoder params)]
page-id (if-not (render-objects-validator params)
render-embed (do
share-id] (js/console.error "invalid arguments")
:as params} (sm/pretty-explain schema:render-objects params)
(us/conform ::render-objects params) nil)
[type object-id] (:object-id params)] (do
(case type (st/emit! (ptk/reify ::initialize-render-objects
:single 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-objects-bundle))))))
(if (uuid? object-id)
(mf/html (mf/html
[:& object-svg [:& object-svg
{:file-id file-id {:file-id file-id
:page-id page-id :page-id page-id
:share-id share-id :share-id share-id
:object-id object-id :object-id object-id
:render-embed? render-embed}]) :embed embed}])
:multiple
(mf/html (mf/html
[:& objects-svg [:& objects-svg
{:file-id file-id {:file-id file-id
:page-id page-id :page-id page-id
:share-id share-id :share-id share-id
:object-ids (into #{} object-id) :object-ids (into #{} object-id)
:render-embed? render-embed}])))) :embed embed}]))))))
;; ---- COMPONENTS SPRITE ;; ---- COMPONENTS SPRITE
(mf/defc components-sprite-svg (mf/defc components-svg
[{:keys [file-id embed] :as props}] {::mf/wrap-props false}
(let [fetch (mf/use-fn [{:keys [embed component-id]}]
(mf/deps file-id) (let [file-ref (mf/with-memo [] (l/derived :file st/state))
(fn [] (repo/cmd! :get-file {:id file-id}))) state (mf/use-state {:component-id component-id})]
(when-let [file (mf/deref file-ref)]
file (use-resource fetch)
state (mf/use-state nil)]
(when file
[:* [:*
[:style [:style
(css [[:body (css [[:body
@ -266,7 +212,7 @@
[:a {:on-click on-click} (:name data)]]))] [:a {:on-click on-click} (:name data)]]))]
[:main [:main
[:& render/components-sprite-svg [:& render/components-svg
{:data (:data file) {:data (:data file)
:embed embed} :embed embed}
@ -275,16 +221,93 @@
]))) ])))
(s/def ::component-id ::us/uuid) (defn- fetch-components-bundle
(s/def ::render-components [& {:keys [file-id]}]
(s/keys :req-un [::file-id] (ptk/reify ::fetch-components-bundle
:opt-un [::embed ::component-id])) 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 (defn render-components
[params] [params]
(let [{:keys [file-id component-id embed]} (us/conform ::render-components params)] (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 (mf/html
[:& components-sprite-svg [:& components-svg
{:file-id file-id {:component-id component-id
:component-id component-id :embed embed}])))))
: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))

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

@ -14,6 +14,7 @@
[app.common.geom.shapes.path :as gpa] [app.common.geom.shapes.path :as gpa]
[app.common.logging :as log] [app.common.logging :as log]
[app.common.media :as cm] [app.common.media :as cm]
[app.common.pprint :as pp]
[app.common.text :as ct] [app.common.text :as ct]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.main.repo :as rp] [app.main.repo :as rp]
@ -639,6 +640,7 @@
(let [error (or (.-message data) (tr "dashboard.import.analyze-error"))] (let [error (or (.-message data) (tr "dashboard.import.analyze-error"))]
(rx/of {:uri (:uri file) :error error})))))))))) (rx/of {:uri (:uri file) :error error}))))))))))
(defmethod impl/handler :import-files (defmethod impl/handler :import-files
[{:keys [project-id files features]}] [{:keys [project-id files features]}]
@ -648,7 +650,7 @@
zip-files (filter #(= "application/zip" (:type %)) files) zip-files (filter #(= "application/zip" (:type %)) files)
binary-files (filter #(= "application/octet-stream" (:type %)) files)] binary-files (filter #(= "application/octet-stream" (:type %)) files)]
(->> (rx/merge (rx/merge
(->> (create-files context zip-files) (->> (create-files context zip-files)
(rx/flat-map (rx/flat-map
(fn [[file data]] (fn [[file data]]
@ -667,7 +669,9 @@
:errors (:errors file) :errors (:errors file)
:file-id (:file-id data)}))))))) :file-id (:file-id data)})))))))
(rx/catch (fn [cause] (rx/catch (fn [cause]
(log/error :hint (ex-message cause) :file-id (:file-id data) :cause cause) (log/error :hint (ex-message cause)
:file-id (:file-id data)
:cause cause)
(rx/of {:status :import-error (rx/of {:status :import-error
:file-id (:file-id data) :file-id (:file-id data)
:error (ex-message cause) :error (ex-message cause)
@ -681,19 +685,25 @@
:response-type :blob :response-type :blob
:method :get}) :method :get})
(rx/map :body) (rx/map :body)
(rx/mapcat #(rp/cmd! :import-binfile {:file % (rx/mapcat #(rp/cmd! :import-binfile {:file % :project-id project-id}))
:project-id project-id})) (rx/map (fn [_]
(rx/map
(fn [_]
{:status :import-finish {:status :import-finish
:file-id (:file-id data)}))))))) :file-id (:file-id data)}))
(rx/catch (fn [cause] (rx/catch (fn [cause]
(log/error :hint "unexpected error on import process" (log/error :hint "unexpected error on import process"
:project-id project-id :project-id project-id
:cause cause) ::log/sync? true)
(if (map? cause) ;; TODO: consider do thi son logging directly ?
(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) (let [objects (:objects page)
frame (some->> page :thumbnail-frame-id (get objects)) frame (some->> page :thumbnail-frame-id (get objects))
element (if frame element (if frame
(mf/element render/frame-svg #js {:objects objects :frame frame :show-thumbnails? true}) (mf/element render/frame-svg #js {:objects objects :frame frame :use-thumbnails true})
(mf/element render/page-svg #js {:data page :thumbnails? true :render-embed? true})) (mf/element render/page-svg #js {:data page :use-thumbnails true :embed true}))
data (rds/renderToStaticMarkup element)] data (rds/renderToStaticMarkup element)]
{:data data {:data data
:fonts @fonts/loaded-hints :fonts @fonts/loaded-hints