Penpot/penpot
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-04-06 12:01:19 -05:00
Code Issues Activity

Merge remote-tracking branch 'origin/staging' into develop

Browse source
This commit is contained in:
Andrey Antukh 2024-02-12 16:13:55 +01:00
commit e232beeb59
28 changed files with 659 additions and 562 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -431,9 +431,11 @@
fix-empty-components
(fn [file-data]
(letfn [(fix-component [components id component]
(if (empty? (:objects component))
(dissoc components id)
components))]
(let [root-shape (ctst/get-shape component (:id component))]
(if (or (empty? (:objects component))
(nil? root-shape))
(dissoc components id)
components)))]
(-> file-data
(d/update-when :components #(reduce-kv fix-component % %)))))

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

@ -413,13 +413,8 @@
:code :invalid-version
:hint "provided invalid version"))
(binding [srepl/*system* cfg]
(srepl/process-file! :id file-id
:update-fn (fn [file]
(update file :data assoc :version version))
:migrate? false
:inc-revn? false
:save? true))
(db/tx-run! cfg srepl/process-file! file-id #(update % :data assoc :version version))
{::rres/status 200
::rres/headers {"content-type" "text/plain"}
::rres/body "OK"}))

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

@ -149,9 +149,11 @@
(let [params (decode params)]
(if (validate params)
(f cfg params)
(ex/raise :type :validation
:code :params-validation
::sm/explain (explain params))))))
(let [params (d/without-qualified params)]
(ex/raise :type :validation
:code :params-validation
::sm/explain (explain params)))))))
f))
(defn- wrap-output-validation

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

@ -147,8 +147,9 @@
(restore-file-snapshot! cfg params)))))
(defn take-file-snapshot!
[{:keys [::db/conn]} {:keys [file-id label]}]
(let [file (db/get conn :file {:id file-id})
[cfg {:keys [file-id label]}]
(let [conn (db/get-connection cfg)
file (db/get conn :file {:id file-id})
id (uuid/next)]
(l/debug :hint "creating file snapshot"

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

@ -42,30 +42,28 @@
(def ^:private
schema:update-file
(sm/define
[:map {:title "update-file"}
[:id ::sm/uuid]
[:session-id ::sm/uuid]
[:revn {:min 0} :int]
[:features {:optional true} ::cfeat/features]
[:changes {:optional true} [:vector ::cpc/change]]
[:changes-with-metadata {:optional true}
[:vector [:map
[:changes [:vector ::cpc/change]]
[:hint-origin {:optional true} :keyword]
[:hint-events {:optional true} [:vector :string]]]]]
[:skip-validate {:optional true} :boolean]]))
[:map {:title "update-file"}
[:id ::sm/uuid]
[:session-id ::sm/uuid]
[:revn {:min 0} :int]
[:features {:optional true} ::cfeat/features]
[:changes {:optional true} [:vector ::cpc/change]]
[:changes-with-metadata {:optional true}
[:vector [:map
[:changes [:vector ::cpc/change]]
[:hint-origin {:optional true} :keyword]
[:hint-events {:optional true} [:vector :string]]]]]
[:skip-validate {:optional true} :boolean]])
(def ^:private
schema:update-file-result
(sm/define
[:vector {:title "update-file-result"}
[:map
[:changes [:vector ::cpc/change]]
[:file-id ::sm/uuid]
[:id ::sm/uuid]
[:revn {:min 0} :int]
[:session-id ::sm/uuid]]]))
[:vector {:title "update-file-result"}
[:map
[:changes [:vector ::cpc/change]]
[:file-id ::sm/uuid]
[:id ::sm/uuid]
[:revn {:min 0} :int]
[:session-id ::sm/uuid]]])
;; --- HELPERS
@ -73,14 +71,26 @@
;; to all clients using it.
(def ^:private library-change-types
#{:add-color :mod-color :del-color
:add-media :mod-media :del-media
:add-component :mod-component :del-component :restore-component
:add-typography :mod-typography :del-typography})
#{:add-color
:mod-color
:del-color
:add-media
:mod-media
:del-media
:add-component
:mod-component
:del-component
:restore-component
:add-typography
:mod-typography
:del-typography})
(def ^:private file-change-types
#{:add-obj :mod-obj :del-obj
:reg-objects :mov-objects})
#{:add-obj
:mod-obj
:del-obj
:reg-objects
:mov-objects})
(defn- library-change?
[{:keys [type] :as change}]

94
backend/src/app/srepl/fixes.clj Normal file
View file

@ -0,0 +1,94 @@
;; This Source Code Form is subject to the terms of the Mozilla Public
;; License, v. 2.0. If a copy of the MPL was not distributed with this
;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
;;
;; Copyright (c) KALEIDOS INC
(ns app.srepl.fixes
"A misc of fix functions"
(:refer-clojure :exclude [parse-uuid])
(:require
[app.binfile.common :as bfc]
[app.common.data :as d]
[app.common.files.changes :as cpc]
[app.common.files.repair :as cfr]
[app.common.files.validate :as cfv]
[app.common.logging :as l]
[app.common.uuid :as uuid]
[app.db :as db]
[app.srepl.helpers :as h]))
(defn repair-file-media
"A helper intended to be used with `srepl.main/process-files!` that
fixes all not propertly referenced file-media-object for a file"
[{:keys [id data] :as file} & _]
(let [conn (db/get-connection h/*system*)
used (bfc/collect-used-media data)
ids (db/create-array conn "uuid" used)
sql (str "SELECT * FROM file_media_object WHERE id = ANY(?)")
rows (db/exec! conn [sql ids])
index (reduce (fn [index media]
(if (not= (:file-id media) id)
(let [media-id (uuid/next)]
(l/wrn :hint "found not referenced media"
:file-id (str id)
:media-id (str (:id media)))
(db/insert! conn :file-media-object
(-> media
(assoc :file-id id)
(assoc :id media-id)))
(assoc index (:id media) media-id))
index))
{}
rows)]
(when (seq index)
(binding [bfc/*state* (atom {:index index})]
(update file :data (fn [fdata]
(-> fdata
(update :pages-index #'bfc/relink-shapes)
(update :components #'bfc/relink-shapes)
(update :media #'bfc/relink-media)
(d/without-nils))))))))
(defn repair-file
"Internal helper for validate and repair the file. The operation is
applied multiple times untile file is fixed or max iteration counter
is reached (default 10)"
[file libs & {:keys [max-iterations] :or {max-iterations 10}}]
(let [validate-and-repair
(fn [file libs iteration]
(when-let [errors (not-empty (cfv/validate-file file libs))]
(l/trc :hint "repairing file"
:file-id (str (:id file))
:iteration iteration
:errors (count errors))
(let [changes (cfr/repair-file file libs errors)]
(-> file
(update :revn inc)
(update :data cpc/process-changes changes)))))
process-file
(fn [file libs]
(loop [file file
iteration 0]
(if (< iteration max-iterations)
(if-let [file (validate-and-repair file libs iteration)]
(recur file (inc iteration))
file)
(do
(l/wrn :hint "max retry num reached on repairing file"
:file-id (str (:id file))
:iteration iteration)
file))))
file'
(process-file file libs)]
(when (not= (:revn file) (:revn file'))
(l/trc :hint "file repaired" :file-id (str (:id file))))
file'))

323
backend/src/app/srepl/helpers.clj
View file

@ -7,39 +7,18 @@
(ns app.srepl.helpers
"A main namespace for server repl."
(:refer-clojure :exclude [parse-uuid])
#_:clj-kondo/ignore
(:require
[app.binfile.common :as bfc]
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.features :as cfeat]
[app.common.files.changes :as cpc]
[app.common.files.migrations :as fmg]
[app.common.files.validate :as cfv]
[app.common.logging :as l]
[app.common.pprint :refer [pprint]]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.config :as cfg]
[app.db :as db]
[app.db.sql :as sql]
[app.features.components-v2 :as feat.comp-v2]
[app.features.fdata :as feat.fdata]
[app.main :as main]
[app.rpc.commands.files :as files]
[app.rpc.commands.files-update :as files-update]
[app.rpc.commands.files-snapshot :as fsnap]
[app.util.blob :as blob]
[app.util.objects-map :as omap]
[app.util.pointer-map :as pmap]
[app.util.time :as dt]
[clojure.spec.alpha :as s]
[clojure.stacktrace :as strace]
[clojure.walk :as walk]
[cuerdas.core :as str]
[expound.alpha :as expound]
[promesa.core :as p]
[promesa.exec :as px]
[promesa.exec.semaphore :as ps]
[promesa.util :as pu]))
[app.util.pointer-map :as pmap]))
(def ^:dynamic *system* nil)
@ -54,25 +33,6 @@
(d/parse-uuid v)
v))
;; (def ^:private sql:get-and-lock-team-files
;; "SELECT f.id
;; FROM file AS f
;; JOIN project AS p ON (p.id = f.project_id)
;; WHERE p.team_id = ?
;; FOR UPDATE")
;; (defn get-and-lock-team-files
;; [conn team-id]
;; (->> (db/exec! conn [sql:get-and-lock-team-files team-id])
;; (into #{} (map :id))))
;; (defn get-team
;; [system team-id]
;; (-> (db/get system :team {:id team-id}
;; {::db/remove-deleted false
;; ::db/check-deleted false})
;; (update :features db/decode-pgarray #{})))
(defn get-file
"Get the migrated data of one file."
([id] (get-file (or *system* main/system) id))
@ -107,8 +67,10 @@
{:revn (:revn file)
:data (:data file)
:features (:features file)
:deleted-at (:deleted-at file)
:created-at (:created-at file)
:modified-at (:modified-at file)
:data-backend nil
:modified-at (dt/now)
:has-media-trimmed false}
{:id (:id file)})))
@ -125,213 +87,90 @@
(defn reset-file-data!
"Hardcode replace of the data of one file."
[id data]
(db/tx-run! main/system
[system id data]
(db/tx-run! system
(fn [system]
(db/update! system :file
{:data data}
{:id id}))))
(defn process-file*
[system file-id update-fn]
(let [file (get-file system file-id)
file (-> (update-fn file)
(update :revn inc))]
(cfv/validate-file-schema! file)
(update-file! system file)
(dissoc file :data)))
(def ^:private sql:snapshots-with-file
"WITH files AS (
SELECT f.id AS file_id,
(SELECT fc.id
FROM file_change AS fc
WHERE fc.label = ?
AND fc.file_id = f.id
ORDER BY fc.created_at DESC
LIMIT 1) AS id
FROM file AS f
) SELECT * FROM files
WHERE file_id = ANY(?)
AND id IS NOT NULL")
(defn get-file-snapshots
"Get a seq parirs of file-id and snapshot-id for a set of files
and specified label"
[conn label ids]
(db/exec! conn [sql:snapshots-with-file label
(db/create-array conn "uuid" ids)]))
(defn take-team-snapshot!
[system team-id label]
(let [conn (db/get-connection system)]
(->> (feat.comp-v2/get-and-lock-team-files conn team-id)
(map (fn [file-id]
{:file-id file-id
:label label}))
(reduce (fn [result params]
(fsnap/take-file-snapshot! conn params)
(inc result))
0))))
(defn restore-team-snapshot!
[system team-id label]
(let [conn (db/get-connection system)
ids (->> (feat.comp-v2/get-and-lock-team-files conn team-id)
(into #{}))
snap (get-file-snapshots conn label ids)
ids' (into #{} (map :file-id) snap)
team (-> (feat.comp-v2/get-team conn team-id)
(update :features disj "components/v2"))]
(when (not= ids ids')
(throw (RuntimeException. "no uniform snapshot available")))
(feat.comp-v2/update-team! conn team)
(reduce (fn [result params]
(fsnap/restore-file-snapshot! conn params)
(inc result))
0
snap)))
(defn process-file!
"Apply a function to the data of one file. Optionally save the changes or not.
The function receives the decoded and migrated file data."
[& {:keys [update-fn id rollback?]
:or {rollback? true}}]
[system file-id update-fn & {:keys [label validate? with-libraries?] :or {validate? true} :as opts}]
(let [system (or *system* (assoc main/system ::db/rollback rollback?))]
(db/tx-run! system
(fn [system]
(binding [*system* system]
(process-file* system id update-fn))))))
(when (string? label)
(fsnap/take-file-snapshot! system {:file-id file-id :label label}))
(let [conn (db/get-connection system)
file (get-file system file-id)
libs (when with-libraries?
(->> (files/get-file-libraries conn file-id)
(into [file] (map (fn [{:keys [id]}]
(get-file system id))))
(d/index-by :id)))
(def ^:private sql:get-file-ids
"SELECT id FROM file
WHERE created_at < ? AND deleted_at is NULL
ORDER BY created_at DESC")
file' (if with-libraries?
(update-fn file libs opts)
(update-fn file opts))]
(defn analyze-files
"Apply a function to all files in the database, reading them in
batches. Do not change data.
The `on-file` parameter should be a function that receives the file
and the previous state and returns the new state.
Emits rollback at the end of operation."
[& {:keys [max-items start-at on-file on-error on-end on-init with-libraries?]}]
(letfn [(get-candidates [conn]
(cond->> (db/cursor conn [sql:get-file-ids (or start-at (dt/now))])
(some? max-items)
(take max-items)))
(on-error* [cause file]
(println "unexpected exception happened on processing file: " (:id file))
(strace/print-stack-trace cause))
(process-file [{:keys [::db/conn] :as system} file-id]
(let [file (get-file system file-id)
libs (when with-libraries?
(->> (files/get-file-libraries conn file-id)
(into [file] (map (fn [{:keys [id]}]
(get-file system id))))
(d/index-by :id)))]
(try
(if with-libraries?
(on-file file libs)
(on-file file))
(catch Throwable cause
((or on-error on-error*) cause file)))))]
(db/tx-run! (assoc main/system ::db/rollback true)
(fn [{:keys [::db/conn] :as system}]
(try
(binding [*system* system]
(when (fn? on-init) (on-init))
(run! (partial process-file system)
(get-candidates conn)))
(finally
(when (fn? on-end)
(ex/ignoring (on-end)))))))))
(defn process-files!
"Apply a function to all files in the database"
[& {:keys [max-items
max-jobs
start-at
on-file
validate?
rollback?]
:or {max-jobs 1
max-items Long/MAX_VALUE
validate? true
rollback? true}}]
(l/dbg :hint "process:start"
:rollback rollback?
:max-jobs max-jobs
:max-items max-items)
(let [tpoint (dt/tpoint)
factory (px/thread-factory :virtual false :prefix "penpot/file-process/")
executor (px/cached-executor :factory factory)
sjobs (ps/create :permits max-jobs)
process-file
(fn [file-id idx tpoint]
(try
(l/trc :hint "process:file:start" :file-id (str file-id) :index idx)
(db/tx-run! (assoc main/system ::db/rollback rollback?)
(fn [{:keys [::db/conn] :as system}]
(let [file' (get-file system file-id)
file (binding [*system* system]
(on-file file'))]
(when (and (some? file) (not (identical? file file')))
(when validate?
(cfv/validate-file-schema! file))
(let [file (if (contains? (:features file) "fdata/objects-map")
(feat.fdata/enable-objects-map file)
file)
file (if (contains? (:features file) "fdata/pointer-map")
(binding [pmap/*tracked* (pmap/create-tracked)]
(let [file (feat.fdata/enable-pointer-map file)]
(feat.fdata/persist-pointers! system file-id)
file))
file)]
(db/update! conn :file
{:data (blob/encode (:data file))
:deleted-at (:deleted-at file)
:created-at (:created-at file)
:modified-at (:modified-at file)
:features (db/create-array conn "text" (:features file))
:revn (:revn file)}
{:id file-id}))))))
(catch Throwable cause
(l/wrn :hint "unexpected error on processing file (skiping)"
:file-id (str file-id)
:index idx
:cause cause))
(finally
(ps/release! sjobs)
(let [elapsed (dt/format-duration (tpoint))]
(l/trc :hint "process:file:end"
:file-id (str file-id)
:index idx
:elapsed elapsed)))))]
(try
(db/tx-run! main/system
(fn [{:keys [::db/conn] :as system}]
(db/exec! conn ["SET statement_timeout = 0"])
(db/exec! conn ["SET idle_in_transaction_session_timeout = 0"])
(try
(reduce (fn [idx file-id]
(ps/acquire! sjobs)
(px/run! executor (partial process-file file-id idx (dt/tpoint)))
(inc idx))
0
(->> (db/cursor conn [sql:get-file-ids (or start-at (dt/now))])
(take max-items)
(map :id)))
(finally
;; Close and await tasks
(pu/close! executor)))))
(catch Throwable cause
(l/dbg :hint "process:error" :cause cause))
(finally
(let [elapsed (dt/format-duration (tpoint))]
(l/dbg :hint "process:end"
:rollback rollback?
:elapsed elapsed))))))
(defn repair-file-media
"A helper intended to be used with `process-files!` that fixes all
not propertly referenced file-media-object for a file"
[{:keys [id data] :as file}]
(let [conn (db/get-connection *system*)
used (bfc/collect-used-media data)
ids (db/create-array conn "uuid" used)
sql (str "SELECT * FROM file_media_object WHERE id = ANY(?)")
rows (db/exec! conn [sql ids])
index (reduce (fn [index media]
(if (not= (:file-id media) id)
(let [media-id (uuid/next)]
(l/wrn :hint "found not referenced media"
:file-id (str id)
:media-id (str (:id media)))
(db/insert! *system* :file-media-object
(-> media
(assoc :file-id id)
(assoc :id media-id)))
(assoc index (:id media) media-id))
index))
{}
rows)]
(when (seq index)
(binding [bfc/*state* (atom {:index index})]
(update file :data (fn [fdata]
(-> fdata
(update :pages-index #'bfc/relink-shapes)
(update :components #'bfc/relink-shapes)
(update :media #'bfc/relink-media)
(d/without-nils))))))))
(when (and (some? file)
(not (identical? file file')))
(when validate? (cfv/validate-file-schema! file'))
(let [file' (update file' :revn inc)]
(update-file! system file')
true))))

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

@ -12,9 +12,8 @@
[app.binfile.common :as bfc]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.features :as cfeat]
[app.common.files.changes :as cpc]
[app.common.files.repair :as cfr]
[app.common.files.validate :as cfv]
[app.common.logging :as l]
[app.common.pprint :as p]
@ -31,17 +30,19 @@
[app.rpc.commands.files-snapshot :as fsnap]
[app.rpc.commands.management :as mgmt]
[app.rpc.commands.profile :as profile]
[app.srepl.cli :as cli]
[app.srepl.fixes :as fixes]
[app.srepl.helpers :as h]
[app.storage :as sto]
[app.util.blob :as blob]
[app.util.objects-map :as omap]
[app.util.pointer-map :as pmap]
[app.util.time :as dt]
[app.worker :as wrk]
[clojure.pprint :refer [pprint print-table]]
[clojure.pprint :refer [print-table]]
[clojure.stacktrace :as strace]
[clojure.tools.namespace.repl :as repl]
[cuerdas.core :as str]))
[cuerdas.core :as str]
[promesa.exec :as px]
[promesa.exec.semaphore :as ps]
[promesa.util :as pu]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TASKS
@ -138,24 +139,20 @@
;; FEATURES
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare process-file!)
(defn enable-objects-map-feature-on-file!
[& {:keys [save? id]}]
(h/process-file! main/system
:id id
:update-fn feat.fdata/enable-objects-map
:save? save?))
[file-id & {:as opts}]
(process-file! file-id feat.fdata/enable-objects-map opts))
(defn enable-pointer-map-feature-on-file!
[& {:keys [save? id]}]
(h/process-file! main/system
:id id
:update-fn feat.fdata/enable-pointer-map
:save? save?))
[file-id & {:as opts}]
(process-file! file-id feat.fdata/enable-pointer-map opts))
(defn enable-storage-features-on-file!
[& {:as params}]
(enable-objects-map-feature-on-file! main/system params)
(enable-pointer-map-feature-on-file! main/system params))
[file-id & {:as opts}]
(enable-objects-map-feature-on-file! file-id opts)
(enable-pointer-map-feature-on-file! file-id opts))
(defn enable-team-feature!
[team-id feature]
@ -308,84 +305,40 @@
(db/tx-run! main/system fsnap/take-file-snapshot! {:file-id file-id :label label})))
(defn restore-file-snapshot!
[& {:keys [file-id id]}]
(db/tx-run! main/system
(fn [cfg]
(let [file-id (h/parse-uuid file-id)
id (h/parse-uuid id)]
(if (and (uuid? id) (uuid? file-id))
(fsnap/restore-file-snapshot! cfg {:id id :file-id file-id})
(println "=> invalid parameters"))))))
[file-id label]
(let [file-id (h/parse-uuid file-id)]
(db/tx-run! main/system
(fn [{:keys [::db/conn] :as system}]
(when-let [snapshot (->> (h/get-file-snapshots conn label #{file-id})
(map :id)
(first))]
(fsnap/restore-file-snapshot! system
{:id (:id snapshot)
:file-id file-id}))))))
(defn list-file-snapshots!
[& {:keys [file-id limit]}]
(db/tx-run! main/system
(fn [system]
(let [params {:file-id (h/parse-uuid file-id)
:limit limit}]
(->> (fsnap/get-file-snapshots system (d/without-nils params))
(print-table [:id :revn :created-at :label]))))))
[file-id & {:keys [limit]}]
(let [file-id (h/parse-uuid file-id)]
(db/tx-run! main/system
(fn [system]
(let [params {:file-id file-id :limit limit}]
(->> (fsnap/get-file-snapshots system (d/without-nils params))
(print-table [:label :id :revn :created-at])))))))
(defn take-team-snapshot!
[& {:keys [team-id label rollback?]
:or {rollback? true}}]
[team-id & {:keys [label rollback?] :or {rollback? true}}]
(let [team-id (h/parse-uuid team-id)
label (or label (fsnap/generate-snapshot-label))
take-snapshot
(fn [{:keys [::db/conn] :as system}]
(->> (feat.comp-v2/get-and-lock-team-files conn team-id)
(map (fn [file-id]
{:file-id file-id
:label label}))
(run! (partial fsnap/take-file-snapshot! system))))]
label (or label (fsnap/generate-snapshot-label))]
(-> (assoc main/system ::db/rollback rollback?)
(db/tx-run! take-snapshot))))
(def ^:private sql:snapshots-with-file
"WITH files AS (
SELECT f.id AS file_id,
(SELECT fc.id
FROM file_change AS fc
WHERE fc.label = ?
AND fc.file_id = f.id
ORDER BY fc.created_at DESC
LIMIT 1) AS id
FROM file AS f
) SELECT * FROM files
WHERE file_id = ANY(?)
AND id IS NOT NULL")
(db/tx-run! h/take-team-snapshot! team-id label))))
(defn restore-team-snapshot!
"Restore a snapshot on all files of the team. The snapshot should
exists for all files; if is not the case, an exception is raised."
[& {:keys [team-id label rollback?] :or {rollback? true}}]
(let [team-id (h/parse-uuid team-id)
get-file-snapshots
(fn [conn ids]
(db/exec! conn [sql:snapshots-with-file label
(db/create-array conn "uuid" ids)]))
restore-snapshot
(fn [{:keys [::db/conn] :as system}]
(let [ids (->> (feat.comp-v2/get-and-lock-team-files conn team-id)
(into #{}))
snap (get-file-snapshots conn ids)
ids' (into #{} (map :file-id) snap)
team (-> (feat.comp-v2/get-team conn team-id)
(update :features disj "components/v2"))]
(when (not= ids ids')
(throw (RuntimeException. "no uniform snapshot available")))
(feat.comp-v2/update-team! conn team)
(run! (partial fsnap/restore-file-snapshot! system) snap)))]
[team-id label & {:keys [rollback?] :or {rollback? true}}]
(let [team-id (h/parse-uuid team-id)]
(-> (assoc main/system ::db/rollback rollback?)
(db/tx-run! restore-snapshot))))
(db/tx-run! h/restore-team-snapshot! team-id label))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FILE VALIDATION & REPAIR
@ -394,68 +347,163 @@
(defn validate-file
"Validate structure, referencial integrity and semantic coherence of
all contents of a file. Returns a list of errors."
[id]
(db/tx-run! main/system
(fn [{:keys [::db/conn] :as system}]
(let [id (if (string? id) (parse-uuid id) id)
file (h/get-file system id)
libs (->> (files/get-file-libraries conn id)
(into [file] (map (fn [{:keys [id]}]
(h/get-file system id))))
(d/index-by :id))]
(cfv/validate-file file libs)))))
(defn- repair-file*
"Internal helper for validate and repair the file. The operation is
applied multiple times untile file is fixed or max iteration counter
is reached (default 10)"
[system id & {:keys [max-iterations label] :or {max-iterations 10}}]
(let [id (parse-uuid id)
validate-and-repair
(fn [file libs iteration]
(when-let [errors (not-empty (cfv/validate-file file libs))]
(l/trc :hint "repairing file"
:file-id (str id)
:iteration iteration
:errors (count errors))
(let [changes (cfr/repair-file file libs errors)]
(-> file
(update :revn inc)
(update :data cpc/process-changes changes)))))
process-file
(fn [file libs]
(loop [file file
iteration 0]
(if (< iteration max-iterations)
(if-let [file (validate-and-repair file libs iteration)]
(recur file (inc iteration))
file)
(do
(l/wrn :hint "max retry num reached on repairing file"
:file-id (str id)
:iteration iteration)
file))))]
(db/tx-run! system
[file-id]
(let [file-id (h/parse-uuid file-id)]
(db/tx-run! (assoc main/system ::db/rollback true)
(fn [{:keys [::db/conn] :as system}]
(when (string? label)
(fsnap/take-file-snapshot! system {:file-id id :label label}))
(let [file (h/get-file system id)
libs (->> (files/get-file-libraries conn id)
(let [file (h/get-file system file-id)
libs (->> (files/get-file-libraries conn file-id)
(into [file] (map (fn [{:keys [id]}]
(h/get-file system id))))
(d/index-by :id))
file (process-file file libs)]
(h/update-file! system file))))))
(d/index-by :id))]
(cfv/validate-file file libs))))))
(defn repair-file!
"Repair the list of errors detected by validation."
[file-id & {:keys [rollback?] :or {rollback? true} :as opts}]
(let [system (assoc main/system ::db/rollback rollback?)]
(repair-file* system file-id (dissoc opts :rollback?))))
(let [system (assoc main/system ::db/rollback rollback?)
file-id (h/parse-uuid file-id)
opts (assoc opts :with-libraries? true)]
(db/tx-run! system h/process-file! file-id fixes/repair-file opts)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PROCESSING
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private
sql:get-file-ids
"SELECT id FROM file
WHERE created_at < ? AND deleted_at is NULL
ORDER BY created_at DESC")
(defn analyze-files
"Apply a function to all files in the database, reading them in
batches. Do not change data.
The `on-file` parameter should be a function that receives the file
and the previous state and returns the new state.
Emits rollback at the end of operation."
[on-file & {:keys [max-items start-at with-libraries?]}]
(letfn [(get-candidates [conn]
(cond->> (db/cursor conn [sql:get-file-ids (or start-at (dt/now))])
(some? max-items)
(take max-items)))
(process-file [{:keys [::db/conn] :as system} file-id]
(let [file (h/get-file system file-id)
libs (when with-libraries?
(->> (files/get-file-libraries conn file-id)
(into [file] (map (fn [{:keys [id]}]
(h/get-file system id))))
(d/index-by :id)))]
(if with-libraries?
(on-file file libs)
(on-file file))))]
(db/tx-run! (assoc main/system ::db/rollback true)
(fn [{:keys [::db/conn] :as system}]
(binding [h/*system* system]
(run! (partial process-file system)
(get-candidates conn)))))))
(defn process-file!
"Apply a function to the file. Optionally save the changes or not.
The function receives the decoded and migrated file data."
[file-id update-fn & {:keys [rollback?] :or {rollback? true}}]
(db/tx-run! (assoc main/system ::db/rollback rollback?)
(fn [system]
(binding [h/*system* system]
(h/process-file! system file-id update-fn)))))
(defn process-team-files!
"Apply a function to each file of the specified team."
[team-id update-fn & {:keys [rollback? label] :or {rollback? true} :as opts}]
(let [team-id (h/parse-uuid team-id)
opts (dissoc opts :label)]
(db/tx-run! (assoc main/system ::db/rollback rollback?)
(fn [{:keys [::db/conn] :as system}]
(when (string? label)
(h/take-team-snapshot! system team-id label))
(binding [h/*system* system]
(->> (feat.comp-v2/get-and-lock-team-files conn team-id)
(reduce (fn [result file-id]
(if (h/process-file! system file-id update-fn opts)
(inc result)
result))
0)))))))
(defn process-files!
"Apply a function to all files in the database"
[update-fn & {:keys [max-items
max-jobs
start-at
rollback?]
:or {max-jobs 1
max-items Long/MAX_VALUE
rollback? true}
:as opts}]
(l/dbg :hint "process:start"
:rollback rollback?
:max-jobs max-jobs
:max-items max-items)
(let [tpoint (dt/tpoint)
factory (px/thread-factory :virtual false :prefix "penpot/file-process/")
executor (px/cached-executor :factory factory)
sjobs (ps/create :permits max-jobs)
process-file
(fn [file-id idx tpoint]
(try
(l/trc :hint "process:file:start" :file-id (str file-id) :index idx)
(let [system (assoc main/system ::db/rollback rollback?)]
(db/tx-run! system h/process-file! file-id update-fn opts))
(catch Throwable cause
(l/wrn :hint "unexpected error on processing file (skiping)"
:file-id (str file-id)
:index idx
:cause cause))
(finally
(ps/release! sjobs)
(let [elapsed (dt/format-duration (tpoint))]
(l/trc :hint "process:file:end"
:file-id (str file-id)
:index idx
:elapsed elapsed)))))
process-files
(fn [{:keys [::db/conn] :as system}]
(db/exec! conn ["SET statement_timeout = 0"])
(db/exec! conn ["SET idle_in_transaction_session_timeout = 0"])
(try
(reduce (fn [idx file-id]
(ps/acquire! sjobs)
(px/run! executor (partial process-file file-id idx (dt/tpoint)))
(inc idx))
0
(->> (db/cursor conn [sql:get-file-ids (or start-at (dt/now))])
(take max-items)
(map :id)))
(finally
;; Close and await tasks
(pu/close! executor))))]
(try
(db/tx-run! main/system process-files)
(catch Throwable cause
(l/dbg :hint "process:error" :cause cause))
(finally
(let [elapsed (dt/format-duration (tpoint))]
(l/dbg :hint "process:end"
:rollback rollback?
:elapsed elapsed))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MISC

3
backend/src/app/tasks/tasks_gc.clj
View file

@ -16,8 +16,7 @@
(def ^:private
sql:delete-completed-tasks
"delete from task_completed
where scheduled_at < now() - ?::interval")
"DELETE FROM task WHERE scheduled_at < now() - ?::interval")
(defmethod ig/pre-init-spec ::handler [_]
(s/keys :req [::db/pool]))

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

@ -242,7 +242,12 @@
([]
(remove (comp qualified-keyword? key)))
([data]
(into {} (without-qualified) data)))
(reduce-kv (fn [data k _]
(if (qualified-keyword? k)
(dissoc data k)
data))
data
data)))
(defn without-keys
"Return a map without the keys provided

1
common/src/app/common/media.cljc
View file

@ -58,6 +58,7 @@
"application/zip" ".zip"
"application/penpot" ".penpot"
"application/pdf" ".pdf"
"text/plain" ".txt"
nil))
(s/def ::id uuid?)

10
common/src/app/common/types/container.cljc
View file

@ -302,13 +302,19 @@
objects (:objects container)
unames (volatile! (cfh/get-used-names objects))
component-children
(d/index-by :id (cfh/get-children-with-self objects (:id component-shape)))
frame-id (or force-frame-id
(ctst/get-frame-id-by-position objects
(gpt/add orig-pos delta)
{:skip-components? true
:bottom-frames? true}))
:bottom-frames? true
;; We must avoid that destiny frame is inside the component frame
:validator #(nil? (get component-children (:id %)))}))
frame (get-shape container frame-id)
component-frame (get-component-shape (:objects container) frame {:allow-main? true})
component-frame (get-component-shape objects frame {:allow-main? true})
ids-map (volatile! {})

7
common/src/app/common/types/shape_tree.cljc
View file

@ -276,9 +276,12 @@
(gpt/point? position))
(let [frames (get-frames objects options)
frames (sort-z-index-objects objects frames options)]
frames (sort-z-index-objects objects frames options)
;; Validator is a callback to add extra conditions to the suggested frame
validator (or (get options :validator) #(-> true))]
(or (d/seek #(and ^boolean (some? position)
^boolean (gsh/has-point? % position))
^boolean (gsh/has-point? % position)
^boolean (validator %))
frames)
(get objects uuid/zero)))))

17
frontend/src/app/main/data/workspace/colors.cljs
View file

@ -439,6 +439,23 @@
(rx/of (change-stroke ids (merge uc/empty-color color) 0))
(rx/of (change-fill ids (merge uc/empty-color color) 0)))))))
(declare activate-colorpicker-color)
(declare activate-colorpicker-gradient)
(declare activate-colorpicker-image)
(defn apply-color-from-colorpicker
[color]
(ptk/reify ::apply-color-from-colorpicker
ptk/WatchEvent
(watch [_ _ _]
(rx/of
(cond
(:image color) (activate-colorpicker-image)
(:color color) (activate-colorpicker-color)
(= :linear (get-in color [:gradient :type])) (activate-colorpicker-gradient :linear-gradient)
(= :radial (get-in color [:gradient :type])) (activate-colorpicker-gradient :radial-gradient))
(apply-color-from-palette color false)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; COLORPICKER STATE MANAGEMENT

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

@ -161,9 +161,7 @@
component
(:data library)
position
components-v2
;; The position can generate a frame calculation inside the base component so we force the frame-id
{:force-frame-id frame-id})
components-v2)
first-shape (cond-> (first new-shapes)
(not (nil? parent-id))

13
frontend/src/app/main/data/workspace/persistence.cljs
View file

@ -16,7 +16,6 @@
[app.main.features :as features]
[app.main.repo :as rp]
[app.main.store :as st]
[app.util.router :as rt]
[app.util.time :as dt]
[beicon.v2.core :as rx]
[okulary.core :as l]
@ -177,19 +176,11 @@
(rx/of (shapes-changes-persisted-finished))))))
(rx/catch (fn [cause]
(cond
(= :authentication (:type cause))
(rx/throw cause)
(instance? js/TypeError cause)
(if (instance? js/TypeError cause)
(->> (rx/timer 2000)
(rx/map (fn [_]
(persist-changes file-id file-revn changes pending-commits))))
:else
(rx/concat
(rx/of (rt/assign-exception cause))
(rx/throw cause))))))))))
(rx/throw cause)))))))))
;; Event to be thrown after the changes have been persisted
(defn shapes-changes-persisted-finished

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

@ -116,7 +116,6 @@
(defmethod ptk/handle-error :validation
[{:keys [code] :as error}]
(print-group! "Validation Error"
(fn []
(print-data! error)
@ -130,12 +129,7 @@
:timeout 3000})))
:else
(let [message (tr "errors.generic-validation")]
(st/async-emit!
(msg/show {:content message
:type :error
:timeout 3000})))))
(st/async-emit! (rt/assign-exception error))))
;; This is a pure frontend error that can be caused by an active
@ -256,12 +250,7 @@
(defmethod ptk/handle-error :server-error
[error]
(ts/schedule
#(st/emit!
(msg/show {:content "Something wrong has happened (on backend)."
:type :error
:timeout 3000})))
(st/async-emit! (rt/assign-exception error))
(print-group! "Server Error"
(fn []
(print-data! (dissoc error :data))

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

@ -23,28 +23,31 @@
(rx/of nil)
(= 502 status)
(rx/throw {:type :bad-gateway})
(rx/throw (ex-info "http error" {:type :bad-gateway}))
(= 503 status)
(rx/throw {:type :service-unavailable})
(rx/throw (ex-info "http error" {:type :service-unavailable}))
(= 0 (:status response))
(rx/throw {:type :offline})
(rx/throw (ex-info "http error" {:type :offline}))
(= 200 status)
(rx/of body)
(= 413 status)
(rx/throw {:type :validation
:code :request-body-too-large})
(rx/throw (ex-info "http error"
{:type :validation
:code :request-body-too-large}))
(and (>= status 400) (map? body))
(rx/throw body)
(rx/throw (ex-info "http error" body))
:else
(rx/throw {:type :unexpected-error
(rx/throw
(ex-info "http error"
{:type :unexpected-error
:status status
:data body})))
:data body}))))
(def default-options
{:update-file {:query-params [:id]}

22
frontend/src/app/main/store.cljs
View file

@ -58,22 +58,22 @@
(defonce last-events
(let [buffer (atom [])
allowed #{:app.main.data.workspace/initialize-page
:app.main.data.workspace/finalize-page
:app.main.data.workspace/initialize-file
:app.main.data.workspace/finalize-file}]
omitset #{:potok.v2.core/undefined
:app.main.data.workspace.persistence/update-persistence-status
:app.main.data.websocket/send-message
:app.main.data.workspace.notifications/handle-pointer-send
:app.util.router/assign-exception}]
(->> (rx/merge
(->> stream
(rx/filter (ptk/type? :app.main.data.workspace.changes/commit-changes))
(rx/map #(-> % deref :hint-origin str))
(rx/pipe (rxo/distinct-contiguous)))
(->> stream
(rx/map ptk/type)
(rx/filter #(contains? allowed %))
(rx/map str)))
(rx/map #(-> % deref :hint-origin)))
(rx/map ptk/type stream))
(rx/filter #(not (contains? omitset %)))
(rx/map str)
(rx/pipe (rxo/distinct-contiguous))
(rx/scan (fn [buffer event]
(cond-> (conj buffer event)
(> (count buffer) 20)
(> (count buffer) 50)
(pop)))
#queue [])
(rx/subs! #(reset! buffer (vec %))))

3
frontend/src/app/main/ui.cljs
View file

@ -128,12 +128,11 @@
{:keys [file-id]} path-params]
[:? {}
(if (:token query-params)
[:> static/static-header {}
[:> static/error-container {}
[:div.image i/unchain]
[:div.main-message (tr "viewer.breaking-change.message")]
[:div.desc-message (tr "viewer.breaking-change.description")]]
[:& viewer-page
{:page-id page-id
:file-id file-id

35
frontend/src/app/main/ui/components/color_bullet_new.cljs
View file

@ -13,6 +13,37 @@
[cuerdas.core :as str]
[rumext.v2 :as mf]))
(defn- color-title
[color-item]
(let [name (:name color-item)
gradient (:gradient color-item)
image (:image color-item)
color (:color color-item)]
(if (some? name)
(cond
(some? color)
(str/ffmt "% (%)" name color)
(some? gradient)
(str/ffmt "% (%)" name (uc/gradient-type->string (:type gradient)))
(some? image)
(str/ffmt "% (%)" name (tr "media.image"))
:else
name)
(cond
(some? color)
color
(some? gradient)
(uc/gradient-type->string (:type gradient))
(some? image)
(tr "media.image")))))
(mf/defc color-bullet
{::mf/wrap [mf/memo]
::mf/wrap-props false}
@ -28,7 +59,7 @@
(if (uc/multiple? color)
[:div {:class (stl/css :color-bullet :multiple)
:on-click on-click
:title (:color color)}]
:title (color-title color)}]
;; No multiple selection
(let [color (if (string? color) {:color color :opacity 1} color)
id (:id color)
@ -47,7 +78,7 @@
:read-only read-only?)
:data-readonly (str read-only?)
:on-click on-click
:title (:color color)}
:title (color-title color)}
(cond
(some? gradient)

8
frontend/src/app/main/ui/components/forms.cljs
View file

@ -286,13 +286,17 @@
(mf/defc submit-button*
{::mf/wrap-props false}
[{:keys [on-click children label form class name disabled] :as props}]
[{:keys [on-click children label form class name disabled large?] :as props}]
(let [form (or form (mf/use-ctx form-ctx))
disabled? (or (and (some? form) (not (:valid @form)))
(true? disabled))
class (dm/str (d/nilv class "btn-primary btn-large")
large? (d/nilv large? true)
class (dm/str (d/nilv class "btn-primary")
" "
(if large? "btn-large" "")
" "
(if disabled? (stl/css :btn-disabled) ""))

14
frontend/src/app/main/ui/components/select.cljs
View file

@ -15,6 +15,7 @@
[app.util.dom :as dom]
[rumext.v2 :as mf]))
(defn- as-key-value
[item]
(if (map? item)
@ -37,6 +38,10 @@
current-label (get label-index current-value)
is-open? (:is-open? state)
dropdown-element* (mf/use-ref nil)
dropdown-direction* (mf/use-state "down")
dropdown-direction-change* (mf/use-ref 0)
open-dropdown
(mf/use-fn
(mf/deps disabled)
@ -81,6 +86,13 @@
(mf/with-effect [default-value]
(swap! state* assoc :current-value default-value))
(mf/with-effect [is-open? dropdown-element*]
(let [dropdown-element (mf/ref-val dropdown-element*)]
(when (and (= 0 (mf/ref-val dropdown-direction-change*)) dropdown-element)
(let [is-outside? (dom/is-element-outside? dropdown-element)]
(reset! dropdown-direction* (if is-outside? "up" "down"))
(mf/set-ref-val! dropdown-direction-change* (inc (mf/ref-val dropdown-direction-change*)))))))
(let [selected-option (first (filter #(= (:value %) default-value) options))
current-icon (:icon selected-option)
current-icon-ref (i/key->icon current-icon)]
@ -93,7 +105,7 @@
[:span {:class (stl/css :current-label)} current-label]
[:span {:class (stl/css :dropdown-button)} i/arrow-refactor]
[:& dropdown {:show is-open? :on-close close-dropdown}
[:ul {:class (dm/str dropdown-class " " (stl/css :custom-select-dropdown))}
[:ul {:ref dropdown-element* :data-direction @dropdown-direction* :class (dm/str dropdown-class " " (stl/css :custom-select-dropdown))}
(for [[index item] (d/enumerate options)]
(if (= :separator item)
[:li {:class (dom/classnames (stl/css :separator) true)

6
frontend/src/app/main/ui/components/select.scss
View file

@ -51,6 +51,12 @@
border-top: $s-1 solid var(--dropdown-separator-color);
}
}
.custom-select-dropdown[data-direction="up"] {
bottom: $s-32;
top: auto;
}
.checked-element {
@extend .dropdown-element-base;
.icon {

2
frontend/src/app/main/ui/settings/access_tokens.cljs
View file

@ -176,7 +176,7 @@
:value (tr "labels.cancel")
:on-click #(modal/hide!)}]
[:> fm/submit-button*
{:label (tr "modals.create-access-token.submit-label")}]])]]]]]))
{:large? false :label (tr "modals.create-access-token.submit-label")}]])]]]]]))
(mf/defc access-tokens-hero
[]

103
frontend/src/app/main/ui/static.cljs
View file

@ -7,19 +7,21 @@
(ns app.main.ui.static
(:require-macros [app.main.style :as stl])
(:require
[app.common.data :as d]
[app.common.pprint :as pp]
[app.main.store :as st]
[app.main.ui.icons :as i]
[app.util.dom :as dom]
[app.util.globals :as globals]
[app.util.i18n :refer [tr]]
[app.util.object :as obj]
[app.util.router :as rt]
[app.util.webapi :as wapi]
[rumext.v2 :as mf]))
(mf/defc static-header
(mf/defc error-container
{::mf/wrap-props false}
[props]
(let [children (obj/get props "children")
on-click (mf/use-callback #(set! (.-href globals/location) "/"))]
[{:keys [children]}]
(let [on-click (mf/use-callback #(set! (.-href globals/location) "/"))]
[:section {:class (stl/css :exception-layout)}
[:button
{:class (stl/css :exception-header)
@ -34,13 +36,13 @@
(mf/defc invalid-token
[]
[:> static-header {}
[:> error-container {}
[:div {:class (stl/css :main-message)} (tr "errors.invite-invalid")]
[:div {:class (stl/css :desc-message)} (tr "errors.invite-invalid.info")]])
(mf/defc not-found
[]
[:> static-header {}
[:> error-container {}
[:div {:class (stl/css :main-message)} (tr "labels.not-found.main-message")]
[:div {:class (stl/css :desc-message)} (tr "labels.not-found.desc-message")]])
@ -49,7 +51,7 @@
(let [handle-retry
(mf/use-callback
(fn [] (st/emit! (rt/assign-exception nil))))]
[:> static-header {}
[:> error-container {}
[:div {:class (stl/css :main-message)} (tr "labels.bad-gateway.main-message")]
[:div {:class (stl/css :desc-message)} (tr "labels.bad-gateway.desc-message")]
[:div {:class (stl/css :sign-info)}
@ -57,27 +59,88 @@
(mf/defc service-unavailable
[]
(let [handle-retry
(mf/use-callback
(fn [] (st/emit! (rt/assign-exception nil))))]
[:> static-header {}
(let [on-click (mf/use-fn #(st/emit! (rt/assign-exception nil)))]
[:> error-container {}
[:div {:class (stl/css :main-message)} (tr "labels.service-unavailable.main-message")]
[:div {:class (stl/css :desc-message)} (tr "labels.service-unavailable.desc-message")]
[:div {:class (stl/css :sign-info)}
[:button {:on-click handle-retry} (tr "labels.retry")]]]))
[:button {:on-click on-click} (tr "labels.retry")]]]))
(defn generate-report
[data]
(let [team-id (:current-team-id @st/state)
profile-id (:profile-id @st/state)
trace (:app.main.errors/trace data)
instance (:app.main.errors/instance data)
content (with-out-str
(println "Hint: " (or (:hint data) (ex-message instance) "--"))
(println "Prof ID:" (str (or profile-id "--")))
(println "Team ID:" (str (or team-id "--")))
(when-let [file-id (:file-id data)]
(println "File ID:" (str file-id)))
(println)
(println "Data:")
(loop [data data]
(-> (d/without-qualified data)
(dissoc :explain)
(d/update-when :data (constantly "(...)"))
(pp/pprint {:level 8 :length 10}))
(println)
(when-let [explain (:explain data)]
(print explain))
(when (and (= :server-error (:type data))
(contains? data :data))
(recur (:data data))))
(println "Trace:")
(println trace)
(println)
(println "Last events:")
(pp/pprint @st/last-events {:length 200})
(println))]
(wapi/create-blob content "text/plain")))
(mf/defc internal-error
[]
(let [handle-retry
(mf/use-callback
(fn [] (st/emit! (rt/assign-exception nil))))]
[:> static-header {}
{::mf/props :obj}
[{:keys [data]}]
(let [on-click (mf/use-fn #(st/emit! (rt/assign-exception nil)))
report-uri (mf/use-ref nil)
on-download
(mf/use-fn
(fn [event]
(dom/prevent-default event)
(when-let [uri (mf/ref-val report-uri)]
(dom/trigger-download-uri "report" "text/plain" uri))))]
(mf/with-effect [data]
(let [report (generate-report data)
uri (wapi/create-uri report)]
(mf/set-ref-val! report-uri uri)
(fn []
(wapi/revoke-uri uri))))
[:> error-container {}
[:div {:class (stl/css :main-message)} (tr "labels.internal-error.main-message")]
[:div {:class (stl/css :desc-message)} (tr "labels.internal-error.desc-message")]
[:a {:on-click on-download} "Download report.txt"]
[:div {:class (stl/css :sign-info)}
[:button {:on-click handle-retry} (tr "labels.retry")]]]))
[:button {:on-click on-click} (tr "labels.retry")]]]))
(mf/defc exception-page
{::mf/props :obj}
[{:keys [data] :as props}]
(case (:type data)
:not-found
@ -89,4 +152,4 @@
:service-unavailable
[:& service-unavailable]
[:& internal-error]))
[:> internal-error props]))

75
frontend/src/app/main/ui/workspace/colorpicker.cljs
View file

@ -144,50 +144,8 @@
on-select-library-color
(mf/use-fn
(fn [state color]
(let [type-origin selected-mode
editig-stop-origin (:editing-stop state)
is-gradient? (some? (:gradient color))
change-to (fn [new-color]
(st/emit! (dc/update-colorpicker new-color))
(on-change new-color))
clean-stop (fn [stops index color]
(-> (nth stops index)
(merge color)
(assoc :offset index)
(dissoc :r)
(dissoc :g)
(dissoc :b)
(dissoc :alpha)
(dissoc :s)
(dissoc :h)
(dissoc :v)
(dissoc :hex)))
set-new-gradient (fn [state color index]
(let [old-stops (:stops state)
old-gradient (:gradient state)
new-gradient (-> old-gradient
(cond-> (= index 0) (assoc :stops [(clean-stop old-stops 0 color) (nth old-stops 1)]))
(cond-> (= index 1) (assoc :stops [(nth old-stops 0) (clean-stop old-stops 1 color)]))
(dissoc :shape-id))]
(change-to {:gradient new-gradient})))
new-mode (cond
(:image color) :image
(:color color) :color
(= :linear (get-in color [:gradient :type])) :linear-gradient
(= :radial (get-in color [:gradient :type])) :radial-gradient)]
;; If we have any kind of gradient and:
;; Click on a solid color -> This color is applied to the selected offset
;; Click on a color with transparency -> The same to solid color will happend
;; Click on any kind of gradient -> The color changes completly to new gradient
;; If we have a non gradient color the new color is applied without any change
(if (or (= :radial-gradient type-origin) (= :linear-gradient type-origin))
(if is-gradient?
(change-to color)
(set-new-gradient state color editig-stop-origin))
(change-to color))
(handle-change-mode new-mode))))
(fn [_ color]
(st/emit! (dc/apply-color-from-colorpicker color))))
on-add-library-color
(mf/use-fn
@ -384,20 +342,27 @@
rulers? (mf/deref refs/rulers?)
left-offset (if rulers? 40 18)
x-pos 400]
x-pos 400]
(cond
(or (nil? x) (nil? y)) {:left "auto" :right "16rem" :top "4rem"}
(or (nil? x) (nil? y)) #js {:left "auto" :right "16rem" :top "4rem"}
(= position :left)
(if (> y max-y)
{:left (str (- x x-pos) "px")
:bottom "1rem"}
{:left (str (- x x-pos) "px")
:top (str (- y 70) "px")})
#js {:left (str (- x x-pos) "px")
:bottom "1rem"}
#js {:left (str (- x x-pos) "px")
:top (str (- y 70) "px")})
(= position :right)
(if (> y max-y)
#js {:left (str (+ x 80) "px")
:bottom "1rem"}
#js {:left (str (+ x 80) "px")
:top (str (- y 70) "px")})
:else (if (> y max-y)
{:left (str (+ x left-offset) "px")
:bottom "1rem"}
{:left (str (+ x left-offset) "px")
:top (str (- y 70) "px")}))))
#js {:left (str (+ x left-offset) "px")
:bottom "1rem"}
#js {:left (str (+ x left-offset) "px")
:top (str (- y 70) "px")}))))
(mf/defc colorpicker-modal
{::mf/register modal/components
@ -428,7 +393,7 @@
(on-close @last-change))))
[:div {:class (stl/css :colorpicker-tooltip)
:style (clj->js style)}
:style style}
[:& colorpicker {:data data
:disable-gradient disable-gradient
:disable-opacity disable-opacity

14
frontend/src/app/util/dom.cljs
View file

@ -24,6 +24,7 @@
cljs.core/IDeref
(-deref [it] (.getBrowserEvent it)))
(declare get-window-size)
(defn browser-event?
[o]
@ -411,6 +412,19 @@
:width (.-width ^js rect)
:height (.-height ^js rect)}))
(defn is-bounding-rect-outside?
[rect]
(let [{:keys [left top right bottom]} rect
{:keys [width height]} (get-window-size)]
(or (< left 0)
(< top 0)
(> right width)
(> bottom height))))
(defn is-element-outside?
[element]
(is-bounding-rect-outside? (get-bounding-rect element)))
(defn bounding-rect->rect
[rect]
(when (some? rect)