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

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

Browse source
This commit is contained in:
Andrey Antukh 2024-04-04 12:45:38 +02:00
commit ad0aae375b
40 changed files with 967 additions and 724 deletions
Download patch file Download diff file Expand all files Collapse all files

2
backend/resources/log4j2-devenv.xml
View file

@ -40,7 +40,7 @@
<Logger name="app" level="all" additivity="false"> <Logger name="app" level="all" additivity="false">
<AppenderRef ref="main" level="trace" /> <AppenderRef ref="main" level="trace" />
<AppenderRef ref="console" level="info" /> <AppenderRef ref="console" level="debug" />
</Logger> </Logger>
<Logger name="user" level="trace" additivity="false"> <Logger name="user" level="trace" additivity="false">

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

@ -32,6 +32,7 @@
[app.common.types.container :as ctn] [app.common.types.container :as ctn]
[app.common.types.file :as ctf] [app.common.types.file :as ctf]
[app.common.types.grid :as ctg] [app.common.types.grid :as ctg]
[app.common.types.modifiers :as ctm]
[app.common.types.page :as ctp] [app.common.types.page :as ctp]
[app.common.types.pages-list :as ctpl] [app.common.types.pages-list :as ctpl]
[app.common.types.shape :as cts] [app.common.types.shape :as cts]
@ -978,6 +979,29 @@
(-> file-data (-> file-data
(update :pages-index update-vals fix-container)))) (update :pages-index update-vals fix-container))))
fix-copies-names
(fn [file-data]
;; Rename component heads to add the component path to the name
(letfn [(fix-container [container]
(d/update-when container :objects #(cfh/reduce-objects % fix-shape %)))
(fix-shape [objects shape]
(let [root (ctn/get-component-shape objects shape)
libraries (assoc-in libraries [(:id file-data) :data] file-data)
library (get libraries (:component-file root))
component (ctkl/get-component (:data library) (:component-id root) true)
path (str/trim (:path component))]
(if (and (ctk/instance-head? shape)
(some? component)
(= (:name component) (:name shape))
(not (str/empty? path)))
(update objects (:id shape) assoc :name (str path " / " (:name component)))
objects)))]
(-> file-data
(update :pages-index update-vals fix-container))))
fix-copies-of-detached fix-copies-of-detached
(fn [file-data] (fn [file-data]
;; Find any copy that is referencing a shape inside a component that have ;; Find any copy that is referencing a shape inside a component that have
@ -1027,8 +1051,9 @@
(fix-component-nil-objects) (fix-component-nil-objects)
(fix-false-copies) (fix-false-copies)
(fix-component-root-without-component) (fix-component-root-without-component)
(fix-copies-of-detached); <- Do not add fixes after this and fix-orphan-copies call (fix-copies-names)
))) (fix-copies-of-detached)))); <- Do not add fixes after this and fix-orphan-copies call
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; COMPONENTS MIGRATION ;; COMPONENTS MIGRATION
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -1077,8 +1102,8 @@
{:type :frame {:type :frame
:x (:x position) :x (:x position)
:y (:y position) :y (:y position)
:width (+ width (* 2 grid-gap)) :width (+ width grid-gap)
:height (+ height (* 2 grid-gap)) :height (+ height grid-gap)
:name name :name name
:frame-id uuid/zero :frame-id uuid/zero
:parent-id uuid/zero})) :parent-id uuid/zero}))
@ -1364,7 +1389,7 @@
(sbuilder/create-svg-shapes svg-data position objects frame-id frame-id #{} false))) (sbuilder/create-svg-shapes svg-data position objects frame-id frame-id #{} false)))
(defn- process-media-object (defn- process-media-object
[fdata page-id frame-id mobj position] [fdata page-id frame-id mobj position shape-cb]
(let [page (ctpl/get-page fdata page-id) (let [page (ctpl/get-page fdata page-id)
file-id (get fdata :id) file-id (get fdata :id)
@ -1414,16 +1439,17 @@
cfsh/prepare-create-artboard-from-selection) cfsh/prepare-create-artboard-from-selection)
changes (fcb/concat-changes changes changes2)] changes (fcb/concat-changes changes changes2)]
(shape-cb shape)
(:redo-changes changes))) (:redo-changes changes)))
(defn- create-media-grid (defn- create-media-grid
[fdata page-id frame-id grid media-group] [fdata page-id frame-id grid media-group shape-cb]
(letfn [(process [fdata mobj position] (letfn [(process [fdata mobj position]
(let [position (gpt/add position (gpt/point grid-gap grid-gap)) (let [position (gpt/add position (gpt/point grid-gap grid-gap))
tp (dt/tpoint) tp (dt/tpoint)
err (volatile! false)] err (volatile! false)]
(try (try
(let [changes (process-media-object fdata page-id frame-id mobj position)] (let [changes (process-media-object fdata page-id frame-id mobj position shape-cb)]
(cp/process-changes fdata changes false)) (cp/process-changes fdata changes false))
(catch Throwable cause (catch Throwable cause
@ -1472,6 +1498,43 @@
(or (process fdata mobj position) fdata)) (or (process fdata mobj position) fdata))
(assoc-in fdata [:options :components-v2] true))))) (assoc-in fdata [:options :components-v2] true)))))
(defn- fix-graphics-size
[fdata new-grid page-id frame-id]
(let [modify-shape (fn [page shape-id modifiers]
(ctn/update-shape page shape-id #(gsh/transform-shape % modifiers)))
resize-frame (fn [page]
(let [{:keys [width height]} (meta new-grid)
frame (ctst/get-shape page frame-id)
width (+ width grid-gap)
height (+ height grid-gap)
modif-frame (ctm/resize nil
(gpt/point (/ width (:width frame))
(/ height (:height frame)))
(gpt/point (:x frame) (:y frame)))]
(modify-shape page frame-id modif-frame)))
move-components (fn [page]
(let [frame (get (:objects page) frame-id)
shapes (map (d/getf (:objects page)) (:shapes frame))]
(->> (d/zip shapes new-grid)
(reduce (fn [page [shape position]]
(let [position (gpt/add position (gpt/point grid-gap grid-gap))
modif-shape (ctm/move nil
(gpt/point (- (:x position) (:x (:selrect shape)))
(- (:y position) (:y (:selrect shape)))))
children-ids (cfh/get-children-ids-with-self (:objects page) (:id shape))]
(reduce #(modify-shape %1 %2 modif-shape)
page
children-ids)))
page))))]
(-> fdata
(ctpl/update-page page-id resize-frame)
(ctpl/update-page page-id move-components))))
(defn- migrate-graphics (defn- migrate-graphics
[fdata] [fdata]
(if (empty? (:media fdata)) (if (empty? (:media fdata))
@ -1509,11 +1572,32 @@
(:id frame) (:id frame)
(:id frame) (:id frame)
nil nil
true))] true))
(recur (next groups) new-shapes (volatile! [])
(create-media-grid fdata page-id (:id frame) grid assets)
(gpt/add position (gpt/point 0 (+ height (* 2 grid-gap) frame-gap))))))))))
add-shape (fn [shape]
(vswap! new-shapes conj shape))
fdata' (create-media-grid fdata page-id (:id frame) grid assets add-shape)
;; When svgs had different width&height and viewport, sometimes the old graphics
;; importer didn't calculate well the media object size. So, after migration we
;; recalculate grid size from the actual size of the created shapes.
new-grid (ctst/generate-shape-grid @new-shapes position grid-gap)
{new-width :width new-height :height} (meta new-grid)
fdata'' (if-not (and (mth/close? width new-width) (mth/close? height new-height))
(do
(l/inf :hint "fixing graphics sizes"
:file-id (str (:id fdata))
:group group-name)
(fix-graphics-size fdata' new-grid page-id (:id frame)))
fdata')]
(recur (next groups)
fdata''
(gpt/add position (gpt/point 0 (+ height (* 2 grid-gap) frame-gap))))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PRIVATE HELPERS ;; PRIVATE HELPERS

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

@ -493,7 +493,7 @@
::mtx/metrics (ig/ref ::mtx/metrics) ::mtx/metrics (ig/ref ::mtx/metrics)
::db/pool (ig/ref ::db/pool)} ::db/pool (ig/ref ::db/pool)}
[::default ::wrk/worker] [::default ::wrk/runner]
{::wrk/parallelism (cf/get ::worker-default-parallelism 1) {::wrk/parallelism (cf/get ::worker-default-parallelism 1)
::wrk/queue :default ::wrk/queue :default
::rds/redis (ig/ref ::rds/redis) ::rds/redis (ig/ref ::rds/redis)
@ -501,7 +501,7 @@
::mtx/metrics (ig/ref ::mtx/metrics) ::mtx/metrics (ig/ref ::mtx/metrics)
::db/pool (ig/ref ::db/pool)} ::db/pool (ig/ref ::db/pool)}
[::webhook ::wrk/worker] [::webhook ::wrk/runner]
{::wrk/parallelism (cf/get ::worker-webhook-parallelism 1) {::wrk/parallelism (cf/get ::worker-webhook-parallelism 1)
::wrk/queue :webhooks ::wrk/queue :webhooks
::rds/redis (ig/ref ::rds/redis) ::rds/redis (ig/ref ::rds/redis)

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

@ -201,7 +201,7 @@
(defn- wrap (defn- wrap
[cfg f mdata] [cfg f mdata]
(l/debug :hint "register method" :name (::sv/name mdata)) (l/trc :hint "register method" :name (::sv/name mdata))
(let [f (wrap-all cfg f mdata)] (let [f (wrap-all cfg f mdata)]
(partial f cfg))) (partial f cfg)))

2
backend/src/app/rpc/climit.clj
View file

@ -200,7 +200,7 @@
(reduce (fn [handler [limit-id key-fn]] (reduce (fn [handler [limit-id key-fn]]
(if-let [config (get config limit-id)] (if-let [config (get config limit-id)]
(let [key-fn (or key-fn noop-fn)] (let [key-fn (or key-fn noop-fn)]
(l/dbg :hint "instrumenting method" (l/trc :hint "instrumenting method"
:method label :method label
:limit (id->str limit-id) :limit (id->str limit-id)
:timeout (:timeout config) :timeout (:timeout config)

2
backend/src/app/rpc/cond.clj
View file

@ -51,7 +51,7 @@
[_ f {:keys [::get-object ::key-fn ::reuse-key?] :as mdata}] [_ f {:keys [::get-object ::key-fn ::reuse-key?] :as mdata}]
(if (and (ifn? get-object) (ifn? key-fn)) (if (and (ifn? get-object) (ifn? key-fn))
(do (do
(l/debug :hint "instrumenting method" :service (::sv/name mdata)) (l/trc :hint "instrumenting method" :service (::sv/name mdata))
(fn [cfg {:keys [::key] :as params}] (fn [cfg {:keys [::key] :as params}]
(if *enabled* (if *enabled*
(let [key' (when (or key reuse-key?) (let [key' (when (or key reuse-key?)

2
backend/src/app/rpc/retry.clj
View file

@ -44,7 +44,7 @@
(if (::enabled mdata) (if (::enabled mdata)
(let [max-retries (get mdata ::max-retries 3) (let [max-retries (get mdata ::max-retries 3)
matches? (get mdata ::when always-false)] matches? (get mdata ::when always-false)]
(l/dbg :hint "wrapping retry" :name name :max-retries max-retries) (l/trc :hint "wrapping retry" :name name :max-retries max-retries)
(fn [cfg params] (fn [cfg params]
(-> cfg (-> cfg
(assoc ::max-retries max-retries) (assoc ::max-retries max-retries)

580
backend/src/app/worker.clj
View file

@ -8,69 +8,25 @@
"Async tasks abstraction (impl)." "Async tasks abstraction (impl)."
(:require (:require
[app.common.data :as d] [app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.logging :as l] [app.common.logging :as l]
[app.common.spec :as us] [app.common.spec :as us]
[app.common.transit :as t]
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[app.config :as cf] [app.config :as cf]
[app.db :as db] [app.db :as db]
[app.metrics :as mtx] [app.metrics :as mtx]
[app.redis :as rds]
[app.util.time :as dt] [app.util.time :as dt]
[clojure.spec.alpha :as s] [clojure.spec.alpha :as s]
[cuerdas.core :as str] [cuerdas.core :as str]
[integrant.core :as ig] [integrant.core :as ig]))
[promesa.core :as p]
[promesa.exec :as px])
(:import
java.util.concurrent.Executor
java.util.concurrent.Future
java.util.concurrent.ThreadPoolExecutor))
(set! *warn-on-reflection* true) (set! *warn-on-reflection* true)
(s/def ::executor #(instance? Executor %))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Executor
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod ig/pre-init-spec ::executor [_]
(s/keys :req []))
(defmethod ig/init-key ::executor
[_ _]
(let [factory (px/thread-factory :prefix "penpot/default/")
executor (px/cached-executor :factory factory :keepalive 60000)]
(l/inf :hint "starting executor")
(reify
java.lang.AutoCloseable
(close [_]
(l/inf :hint "stoping executor")
(px/shutdown! executor))
clojure.lang.IDeref
(deref [_]
{:active (.getPoolSize ^ThreadPoolExecutor executor)
:running (.getActiveCount ^ThreadPoolExecutor executor)
:completed (.getCompletedTaskCount ^ThreadPoolExecutor executor)})
Executor
(execute [_ runnable]
(.execute ^Executor executor ^Runnable runnable)))))
(defmethod ig/halt-key! ::executor
[_ instance]
(.close ^java.lang.AutoCloseable instance))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; TASKS REGISTRY ;; TASKS REGISTRY
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- wrap-task-handler (defn- wrap-with-metrics
[metrics tname f] [f metrics tname]
(let [labels (into-array String [tname])] (let [labels (into-array String [tname])]
(fn [params] (fn [params]
(let [tp (dt/tpoint)] (let [tp (dt/tpoint)]
@ -83,6 +39,7 @@
:labels labels}))))))) :labels labels})))))))
(s/def ::registry (s/map-of ::us/string fn?)) (s/def ::registry (s/map-of ::us/string fn?))
(s/def ::tasks (s/map-of keyword? fn?))
(defmethod ig/pre-init-spec ::registry [_] (defmethod ig/pre-init-spec ::registry [_]
(s/keys :req [::mtx/metrics ::tasks])) (s/keys :req [::mtx/metrics ::tasks]))
@ -90,537 +47,13 @@
(defmethod ig/init-key ::registry (defmethod ig/init-key ::registry
[_ {:keys [::mtx/metrics ::tasks]}] [_ {:keys [::mtx/metrics ::tasks]}]
(l/inf :hint "registry initialized" :tasks (count tasks)) (l/inf :hint "registry initialized" :tasks (count tasks))
(reduce-kv (fn [registry k v] (reduce-kv (fn [registry k f]
(let [tname (name k)] (let [tname (name k)]
(l/trc :hint "register task" :name tname) (l/trc :hint "register task" :name tname)
(assoc registry tname (wrap-task-handler metrics tname v)))) (assoc registry tname (wrap-with-metrics f metrics tname))))
{} {}
tasks)) tasks))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; EXECUTOR MONITOR
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(s/def ::name ::us/keyword)
(defmethod ig/pre-init-spec ::monitor [_]
(s/keys :req [::name ::executor ::mtx/metrics]))
(defmethod ig/prep-key ::monitor
[_ cfg]
(merge {::interval (dt/duration "2s")}
(d/without-nils cfg)))
(defmethod ig/init-key ::monitor
[_ {:keys [::executor ::mtx/metrics ::interval ::name]}]
(letfn [(monitor! [executor prev-completed]
(let [labels (into-array String [(d/name name)])
stats (deref executor)
completed (:completed stats)
completed-inc (- completed prev-completed)
completed-inc (if (neg? completed-inc) 0 completed-inc)]
(mtx/run! metrics
:id :executor-active-threads
:labels labels
:val (:active stats))
(mtx/run! metrics
:id :executor-running-threads
:labels labels
:val (:running stats))
(mtx/run! metrics
:id :executors-completed-tasks
:labels labels
:inc completed-inc)
completed-inc))]
(px/thread
{:name "penpot/executors-monitor" :virtual true}
(l/inf :hint "monitor: started" :name name)
(try
(loop [completed 0]
(px/sleep interval)
(recur (long (monitor! executor completed))))
(catch InterruptedException _cause
(l/trc :hint "monitor: interrupted" :name name))
(catch Throwable cause
(l/err :hint "monitor: unexpected error" :name name :cause cause))
(finally
(l/inf :hint "monitor: terminated" :name name))))))
(defmethod ig/halt-key! ::monitor
[_ thread]
(px/interrupt! thread))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SCHEDULER
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn- decode-task-row
[{:keys [props] :as row}]
(cond-> row
(db/pgobject? props)
(assoc :props (db/decode-transit-pgobject props))))
(s/def ::wait-duration ::dt/duration)
(defmethod ig/pre-init-spec ::dispatcher [_]
(s/keys :req [::mtx/metrics
::db/pool
::rds/redis]
:opt [::wait-duration
::batch-size]))
(defmethod ig/prep-key ::dispatcher
[_ cfg]
(merge {::batch-size 100
::wait-duration (dt/duration "5s")}
(d/without-nils cfg)))
(def ^:private sql:select-next-tasks
"select id, queue from task as t
where t.scheduled_at <= now()
and (t.status = 'new' or t.status = 'retry')
and queue ~~* ?::text
order by t.priority desc, t.scheduled_at
limit ?
for update skip locked")
(defmethod ig/init-key ::dispatcher
[_ {:keys [::db/pool ::rds/redis ::batch-size] :as cfg}]
(letfn [(get-tasks [conn]
(let [prefix (str (cf/get :tenant) ":%")]
(seq (db/exec! conn [sql:select-next-tasks prefix batch-size]))))
(push-tasks! [conn rconn [queue tasks]]
(let [ids (mapv :id tasks)
key (str/ffmt "taskq:%" queue)
res (rds/rpush! rconn key (mapv t/encode ids))
sql [(str "update task set status = 'scheduled'"
" where id = ANY(?)")
(db/create-array conn "uuid" ids)]]
(db/exec-one! conn sql)
(l/trc :hist "dispatcher: queue tasks"
:queue queue
:tasks (count ids)
:queued res)))
(run-batch! [rconn]
(try
(db/with-atomic [conn pool]
(if-let [tasks (get-tasks conn)]
(->> (group-by :queue tasks)
(run! (partial push-tasks! conn rconn)))
(px/sleep (::wait-duration cfg))))
(catch InterruptedException cause
(throw cause))
(catch Exception cause
(cond
(rds/exception? cause)
(do
(l/wrn :hint "dispatcher: redis exception (will retry in an instant)" :cause cause)
(px/sleep (::rds/timeout rconn)))
(db/sql-exception? cause)
(do
(l/wrn :hint "dispatcher: database exception (will retry in an instant)" :cause cause)
(px/sleep (::rds/timeout rconn)))
:else
(do
(l/err :hint "dispatcher: unhandled exception (will retry in an instant)" :cause cause)
(px/sleep (::rds/timeout rconn)))))))
(dispatcher []
(l/inf :hint "dispatcher: started")
(try
(dm/with-open [rconn (rds/connect redis)]
(loop []
(run-batch! rconn)
(recur)))
(catch InterruptedException _
(l/trc :hint "dispatcher: interrupted"))
(catch Throwable cause
(l/err :hint "dispatcher: unexpected exception" :cause cause))
(finally
(l/inf :hint "dispatcher: terminated"))))]
(if (db/read-only? pool)
(l/wrn :hint "dispatcher: not started (db is read-only)")
(px/fn->thread dispatcher :name "penpot/worker/dispatcher" :virtual true))))
(defmethod ig/halt-key! ::dispatcher
[_ thread]
(some-> thread px/interrupt!))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; WORKER
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare ^:private run-worker-loop!)
(declare ^:private start-worker!)
(declare ^:private get-error-context)
(defmethod ig/pre-init-spec ::worker [_]
(s/keys :req [::parallelism
::mtx/metrics
::db/pool
::rds/redis
::queue
::registry]))
(defmethod ig/prep-key ::worker
[_ cfg]
(merge {::parallelism 1}
(d/without-nils cfg)))
(defmethod ig/init-key ::worker
[_ {:keys [::db/pool ::queue ::parallelism] :as cfg}]
(let [queue (d/name queue)
cfg (assoc cfg ::queue queue)]
(if (db/read-only? pool)
(l/wrn :hint "worker: not started (db is read-only)" :queue queue :parallelism parallelism)
(doall
(->> (range parallelism)
(map #(assoc cfg ::worker-id %))
(map start-worker!))))))
(defmethod ig/halt-key! ::worker
[_ threads]
(run! px/interrupt! threads))
(defn- start-worker!
[{:keys [::rds/redis ::worker-id ::queue] :as cfg}]
(px/thread
{:name (format "penpot/worker/runner:%s" worker-id)}
(l/inf :hint "worker: started" :worker-id worker-id :queue queue)
(try
(dm/with-open [rconn (rds/connect redis)]
(let [tenant (cf/get :tenant "main")
cfg (-> cfg
(assoc ::queue (str/ffmt "taskq:%:%" tenant queue))
(assoc ::rds/rconn rconn)
(assoc ::timeout (dt/duration "5s")))]
(loop []
(when (px/interrupted?)
(throw (InterruptedException. "interrupted")))
(run-worker-loop! cfg)
(recur))))
(catch InterruptedException _
(l/debug :hint "worker: interrupted"
:worker-id worker-id
:queue queue))
(catch Throwable cause
(l/err :hint "worker: unexpected exception"
:worker-id worker-id
:queue queue
:cause cause))
(finally
(l/inf :hint "worker: terminated"
:worker-id worker-id
:queue queue)))))
(defn- run-worker-loop!
[{:keys [::db/pool ::rds/rconn ::timeout ::queue ::registry ::worker-id]}]
(letfn [(handle-task-retry [{:keys [task error inc-by delay] :or {inc-by 1 delay 1000}}]
(let [explain (ex-message error)
nretry (+ (:retry-num task) inc-by)
now (dt/now)
delay (->> (iterate #(* % 2) delay) (take nretry) (last))]
(db/update! pool :task
{:error explain
:status "retry"
:modified-at now
:scheduled-at (dt/plus now delay)
:retry-num nretry}
{:id (:id task)})
nil))
(handle-task-failure [{:keys [task error]}]
(let [explain (ex-message error)]
(db/update! pool :task
{:error explain
:modified-at (dt/now)
:status "failed"}
{:id (:id task)})
nil))
(handle-task-completion [{:keys [task]}]
(let [now (dt/now)]
(db/update! pool :task
{:completed-at now
:modified-at now
:status "completed"}
{:id (:id task)})
nil))
(decode-payload [^bytes payload]
(try
(let [task-id (t/decode payload)]
(if (uuid? task-id)
task-id
(l/err :hint "worker: received unexpected payload (uuid expected)"
:payload task-id)))
(catch Throwable cause
(l/err :hint "worker: unable to decode payload"
:payload payload
:length (alength payload)
:cause cause))))
(handle-task [{:keys [name] :as task}]
(let [task-fn (get registry name)]
(if task-fn
(task-fn task)
(l/wrn :hint "no task handler found" :name name))
{:status :completed :task task}))
(handle-task-exception [cause task]
(let [edata (ex-data cause)]
(if (and (< (:retry-num task)
(:max-retries task))
(= ::retry (:type edata)))
(cond-> {:status :retry :task task :error cause}
(dt/duration? (:delay edata))
(assoc :delay (:delay edata))
(= ::noop (:strategy edata))
(assoc :inc-by 0))
(do
(l/err :hint "worker: unhandled exception on task"
::l/context (get-error-context cause task)
:cause cause)
(if (>= (:retry-num task) (:max-retries task))
{:status :failed :task task :error cause}
{:status :retry :task task :error cause})))))
(get-task [task-id]
(ex/try!
(some-> (db/get* pool :task {:id task-id})
(decode-task-row))))
(run-task [task-id]
(loop [task (get-task task-id)]
(cond
(ex/exception? task)
(if (or (db/connection-error? task)
(db/serialization-error? task))
(do
(l/wrn :hint "worker: connection error on retrieving task from database (retrying in some instants)"
:worker-id worker-id
:cause task)
(px/sleep (::rds/timeout rconn))
(recur (get-task task-id)))
(do
(l/err :hint "worker: unhandled exception on retrieving task from database (retrying in some instants)"
:worker-id worker-id
:cause task)
(px/sleep (::rds/timeout rconn))
(recur (get-task task-id))))
(nil? task)
(l/wrn :hint "worker: no task found on the database"
:worker-id worker-id
:task-id task-id)
:else
(try
(l/trc :hint "executing task"
:name (:name task)
:id (str (:id task))
:queue queue
:worker-id worker-id
:retry (:retry-num task))
(handle-task task)
(catch InterruptedException cause
(throw cause))
(catch Throwable cause
(handle-task-exception cause task))))))
(process-result [{:keys [status] :as result}]
(ex/try!
(case status
:retry (handle-task-retry result)
:failed (handle-task-failure result)
:completed (handle-task-completion result)
nil)))
(run-task-loop [task-id]
(loop [result (run-task task-id)]
(when-let [cause (process-result result)]
(if (or (db/connection-error? cause)
(db/serialization-error? cause))
(do
(l/wrn :hint "worker: database exeption on processing task result (retrying in some instants)"
:cause cause)
(px/sleep (::rds/timeout rconn))
(recur result))
(do
(l/err :hint "worker: unhandled exception on processing task result (retrying in some instants)"
:cause cause)
(px/sleep (::rds/timeout rconn))
(recur result))))))]
(try
(let [[_ payload] (rds/blpop! rconn timeout queue)]
(some-> payload
decode-payload
run-task-loop))
(catch InterruptedException cause
(throw cause))
(catch Exception cause
(if (rds/timeout-exception? cause)
(do
(l/err :hint "worker: redis pop operation timeout, consider increasing redis timeout (will retry in some instants)"
:timeout timeout
:cause cause)
(px/sleep timeout))
(l/err :hint "worker: unhandled exception" :cause cause))))))
(defn- get-error-context
[_ item]
{:params item})
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; CRON
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare schedule-cron-task)
(declare synchronize-cron-entries!)
(s/def ::fn (s/or :var var? :fn fn?))
(s/def ::id keyword?)
(s/def ::cron dt/cron?)
(s/def ::props (s/nilable map?))
(s/def ::task keyword?)
(s/def ::cron-task
(s/keys :req-un [::cron ::task]
:opt-un [::props ::id]))
(s/def ::entries (s/coll-of (s/nilable ::cron-task)))
(defmethod ig/pre-init-spec ::cron [_]
(s/keys :req [::db/pool ::entries ::registry]))
(defmethod ig/init-key ::cron
[_ {:keys [::entries ::registry ::db/pool] :as cfg}]
(if (db/read-only? pool)
(l/wrn :hint "cron: not started (db is read-only)")
(let [running (atom #{})
entries (->> entries
(filter some?)
;; If id is not defined, use the task as id.
(map (fn [{:keys [id task] :as item}]
(if (some? id)
(assoc item :id (d/name id))
(assoc item :id (d/name task)))))
(map (fn [item]
(update item :task d/name)))
(map (fn [{:keys [task] :as item}]
(let [f (get registry task)]
(when-not f
(ex/raise :type :internal
:code :task-not-found
:hint (str/fmt "task %s not configured" task)))
(-> item
(dissoc :task)
(assoc :fn f))))))
cfg (assoc cfg ::entries entries ::running running)]
(l/inf :hint "cron: started" :tasks (count entries))
(synchronize-cron-entries! cfg)
(->> (filter some? entries)
(run! (partial schedule-cron-task cfg)))
(reify
clojure.lang.IDeref
(deref [_] @running)
java.lang.AutoCloseable
(close [_]
(l/inf :hint "cron: terminated")
(doseq [item @running]
(when-not (.isDone ^Future item)
(.cancel ^Future item true))))))))
(defmethod ig/halt-key! ::cron
[_ instance]
(some-> instance d/close!))
(def sql:upsert-cron-task
"insert into scheduled_task (id, cron_expr)
values (?, ?)
on conflict (id)
do update set cron_expr=?")
(defn- synchronize-cron-entries!
[{:keys [::db/pool ::entries]}]
(db/with-atomic [conn pool]
(doseq [{:keys [id cron]} entries]
(l/trc :hint "register cron task" :id id :cron (str cron))
(db/exec-one! conn [sql:upsert-cron-task id (str cron) (str cron)]))))
(defn- lock-scheduled-task!
[conn id]
(let [sql (str "SELECT id FROM scheduled_task "
" WHERE id=? FOR UPDATE SKIP LOCKED")]
(some? (db/exec-one! conn [sql (d/name id)]))))
(defn- execute-cron-task
[{:keys [::db/pool] :as cfg} {:keys [id] :as task}]
(px/thread
{:name (str "penpot/cront-task/" id)}
(try
(db/with-atomic [conn pool]
(db/exec-one! conn ["SET statement_timeout=0;"])
(db/exec-one! conn ["SET idle_in_transaction_session_timeout=0;"])
(when (lock-scheduled-task! conn id)
(l/dbg :hint "cron: execute task" :task-id id)
((:fn task) task))
(db/rollback! conn))
(catch InterruptedException _
(l/debug :hint "cron: task interrupted" :task-id id))
(catch Throwable cause
(binding [l/*context* (get-error-context cause task)]
(l/err :hint "cron: unhandled exception on running task"
:task-id id
:cause cause)))
(finally
(when-not (px/interrupted? :current)
(schedule-cron-task cfg task))))))
(defn- ms-until-valid
[cron]
(s/assert dt/cron? cron)
(let [now (dt/now)
next (dt/next-valid-instant-from cron now)]
(dt/diff now next)))
(defn- schedule-cron-task
[{:keys [::running] :as cfg} {:keys [cron id] :as task}]
(let [ts (ms-until-valid cron)
ft (px/schedule! ts (partial execute-cron-task cfg task))]
(l/dbg :hint "cron: schedule task" :task-id id
:ts (dt/format-duration ts)
:at (dt/format-instant (dt/in-future ts)))
(swap! running #(into #{ft} (filter p/pending?) %))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SUBMIT API ;; SUBMIT API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -672,6 +105,7 @@
[& {:keys [::task ::delay ::queue ::priority ::max-retries ::conn ::dedupe ::label] [& {:keys [::task ::delay ::queue ::priority ::max-retries ::conn ::dedupe ::label]
:or {delay 0 queue :default priority 100 max-retries 3 label ""} :or {delay 0 queue :default priority 100 max-retries 3 label ""}
:as options}] :as options}]
(us/verify! ::submit-options options) (us/verify! ::submit-options options)
(let [duration (dt/duration delay) (let [duration (dt/duration delay)
interval (db/interval duration) interval (db/interval duration)

157
backend/src/app/worker/cron.clj Normal file
View file

@ -0,0 +1,157 @@
;; 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.worker.cron
(:require
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.db :as db]
[app.util.time :as dt]
[app.worker :as-alias wrk]
[app.worker.runner :refer [get-error-context]]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[integrant.core :as ig]
[promesa.core :as p]
[promesa.exec :as px])
(:import
java.util.concurrent.Future))
(set! *warn-on-reflection* true)
(def sql:upsert-cron-task
"insert into scheduled_task (id, cron_expr)
values (?, ?)
on conflict (id)
do update set cron_expr=?")
(defn- synchronize-cron-entries!
[{:keys [::db/pool ::entries]}]
(db/with-atomic [conn pool]
(doseq [{:keys [id cron]} entries]
(l/trc :hint "register cron task" :id id :cron (str cron))
(db/exec-one! conn [sql:upsert-cron-task id (str cron) (str cron)]))))
(defn- lock-scheduled-task!
[conn id]
(let [sql (str "SELECT id FROM scheduled_task "
" WHERE id=? FOR UPDATE SKIP LOCKED")]
(some? (db/exec-one! conn [sql (d/name id)]))))
(declare ^:private schedule-cron-task)
(defn- execute-cron-task
[cfg {:keys [id] :as task}]
(px/thread
{:name (str "penpot/cron-task/" id)}
(let [tpoint (dt/tpoint)]
(try
(db/tx-run! cfg (fn [{:keys [::db/conn]}]
(db/exec-one! conn ["SET LOCAL statement_timeout=0;"])
(db/exec-one! conn ["SET LOCAL idle_in_transaction_session_timeout=0;"])
(when (lock-scheduled-task! conn id)
(l/dbg :hint "start task" :task-id id)
((:fn task) task)
(let [elapsed (dt/format-duration (tpoint))]
(l/dbg :hint "end task" :task-id id :elapsed elapsed)))))
(catch InterruptedException _
(let [elapsed (dt/format-duration (tpoint))]
(l/debug :hint "task interrupted" :task-id id :elapsed elapsed)))
(catch Throwable cause
(let [elapsed (dt/format-duration (tpoint))]
(binding [l/*context* (get-error-context cause task)]
(l/err :hint "unhandled exception on running task"
:task-id id
:elapsed elapsed
:cause cause))))
(finally
(when-not (px/interrupted? :current)
(schedule-cron-task cfg task)))))))
(defn- ms-until-valid
[cron]
(s/assert dt/cron? cron)
(let [now (dt/now)
next (dt/next-valid-instant-from cron now)]
(dt/diff now next)))
(defn- schedule-cron-task
[{:keys [::running] :as cfg} {:keys [cron id] :as task}]
(let [ts (ms-until-valid cron)
ft (px/schedule! ts (partial execute-cron-task cfg task))]
(l/dbg :hint "schedule task" :task-id id
:ts (dt/format-duration ts)
:at (dt/format-instant (dt/in-future ts)))
(swap! running #(into #{ft} (filter p/pending?) %))))
(s/def ::fn (s/or :var var? :fn fn?))
(s/def ::id keyword?)
(s/def ::cron dt/cron?)
(s/def ::props (s/nilable map?))
(s/def ::task keyword?)
(s/def ::task-item
(s/keys :req-un [::cron ::task]
:opt-un [::props ::id]))
(s/def ::wrk/entries (s/coll-of (s/nilable ::task-item)))
(defmethod ig/pre-init-spec ::wrk/cron [_]
(s/keys :req [::db/pool ::wrk/entries ::wrk/registry]))
(defmethod ig/init-key ::wrk/cron
[_ {:keys [::wrk/entries ::wrk/registry ::db/pool] :as cfg}]
(if (db/read-only? pool)
(l/wrn :hint "service not started (db is read-only)")
(let [running (atom #{})
entries (->> entries
(filter some?)
;; If id is not defined, use the task as id.
(map (fn [{:keys [id task] :as item}]
(if (some? id)
(assoc item :id (d/name id))
(assoc item :id (d/name task)))))
(map (fn [item]
(update item :task d/name)))
(map (fn [{:keys [task] :as item}]
(let [f (get registry task)]
(when-not f
(ex/raise :type :internal
:code :task-not-found
:hint (str/fmt "task %s not configured" task)))
(-> item
(dissoc :task)
(assoc :fn f))))))
cfg (assoc cfg ::entries entries ::running running)]
(l/inf :hint "started" :tasks (count entries))
(synchronize-cron-entries! cfg)
(->> (filter some? entries)
(run! (partial schedule-cron-task cfg)))
(reify
clojure.lang.IDeref
(deref [_] @running)
java.lang.AutoCloseable
(close [_]
(l/inf :hint "terminated")
(doseq [item @running]
(when-not (.isDone ^Future item)
(.cancel ^Future item true))))))))
(defmethod ig/halt-key! ::wrk/cron
[_ instance]
(some-> instance d/close!))

110
backend/src/app/worker/dispatcher.clj Normal file
View file

@ -0,0 +1,110 @@
;; 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.worker.dispatcher
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.logging :as l]
[app.common.transit :as t]
[app.config :as cf]
[app.db :as db]
[app.metrics :as mtx]
[app.redis :as rds]
[app.util.time :as dt]
[app.worker :as-alias wrk]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[integrant.core :as ig]
[promesa.exec :as px]))
(set! *warn-on-reflection* true)
(defmethod ig/pre-init-spec ::wrk/dispatcher [_]
(s/keys :req [::mtx/metrics ::db/pool ::rds/redis]))
(defmethod ig/prep-key ::wrk/dispatcher
[_ cfg]
(merge {::batch-size 100
::wait-duration (dt/duration "5s")}
(d/without-nils cfg)))
(def ^:private sql:select-next-tasks
"select id, queue from task as t
where t.scheduled_at <= now()
and (t.status = 'new' or t.status = 'retry')
and queue ~~* ?::text
order by t.priority desc, t.scheduled_at
limit ?
for update skip locked")
(defmethod ig/init-key ::wrk/dispatcher
[_ {:keys [::db/pool ::rds/redis ::batch-size] :as cfg}]
(letfn [(get-tasks [conn]
(let [prefix (str (cf/get :tenant) ":%")]
(seq (db/exec! conn [sql:select-next-tasks prefix batch-size]))))
(push-tasks! [conn rconn [queue tasks]]
(let [ids (mapv :id tasks)
key (str/ffmt "taskq:%" queue)
res (rds/rpush! rconn key (mapv t/encode ids))
sql [(str "update task set status = 'scheduled'"
" where id = ANY(?)")
(db/create-array conn "uuid" ids)]]
(db/exec-one! conn sql)
(l/trc :hist "queue tasks"
:queue queue
:tasks (count ids)
:queued res)))
(run-batch! [rconn]
(try
(db/with-atomic [conn pool]
(if-let [tasks (get-tasks conn)]
(->> (group-by :queue tasks)
(run! (partial push-tasks! conn rconn)))
(px/sleep (::wait-duration cfg))))
(catch InterruptedException cause
(throw cause))
(catch Exception cause
(cond
(rds/exception? cause)
(do
(l/wrn :hint "redis exception (will retry in an instant)" :cause cause)
(px/sleep (::rds/timeout rconn)))
(db/sql-exception? cause)
(do
(l/wrn :hint "database exception (will retry in an instant)" :cause cause)
(px/sleep (::rds/timeout rconn)))
:else
(do
(l/err :hint "unhandled exception (will retry in an instant)" :cause cause)
(px/sleep (::rds/timeout rconn)))))))
(dispatcher []
(l/inf :hint "started")
(try
(dm/with-open [rconn (rds/connect redis)]
(loop []
(run-batch! rconn)
(recur)))
(catch InterruptedException _
(l/trc :hint "interrupted"))
(catch Throwable cause
(l/err :hint " unexpected exception" :cause cause))
(finally
(l/inf :hint "terminated"))))]
(if (db/read-only? pool)
(l/wrn :hint "not started (db is read-only)")
(px/fn->thread dispatcher :name "penpot/worker/dispatcher" :virtual false))))
(defmethod ig/halt-key! ::wrk/dispatcher
[_ thread]
(some-> thread px/interrupt!))

116
backend/src/app/worker/executor.clj Normal file
View file

@ -0,0 +1,116 @@
;; 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.worker.executor
"Async tasks abstraction (impl)."
(:require
[app.common.data :as d]
[app.common.logging :as l]
[app.common.spec :as us]
[app.metrics :as mtx]
[app.util.time :as dt]
[app.worker :as-alias wrk]
[clojure.spec.alpha :as s]
[integrant.core :as ig]
[promesa.exec :as px])
(:import
java.util.concurrent.Executor
java.util.concurrent.ThreadPoolExecutor))
(set! *warn-on-reflection* true)
(s/def ::wrk/executor #(instance? Executor %))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; EXECUTOR
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod ig/pre-init-spec ::wrk/executor [_]
(s/keys :req []))
(defmethod ig/init-key ::wrk/executor
[_ _]
(let [factory (px/thread-factory :prefix "penpot/default/")
executor (px/cached-executor :factory factory :keepalive 60000)]
(l/inf :hint "executor started")
(reify
java.lang.AutoCloseable
(close [_]
(l/inf :hint "stoping executor")
(px/shutdown! executor))
clojure.lang.IDeref
(deref [_]
{:active (.getPoolSize ^ThreadPoolExecutor executor)
:running (.getActiveCount ^ThreadPoolExecutor executor)
:completed (.getCompletedTaskCount ^ThreadPoolExecutor executor)})
Executor
(execute [_ runnable]
(.execute ^Executor executor ^Runnable runnable)))))
(defmethod ig/halt-key! ::wrk/executor
[_ instance]
(.close ^java.lang.AutoCloseable instance))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MONITOR
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(s/def ::name ::us/keyword)
(defmethod ig/pre-init-spec ::wrk/monitor [_]
(s/keys :req [::wrk/name ::wrk/executor ::mtx/metrics]))
(defmethod ig/prep-key ::wrk/monitor
[_ cfg]
(merge {::interval (dt/duration "2s")}
(d/without-nils cfg)))
(defmethod ig/init-key ::wrk/monitor
[_ {:keys [::wrk/executor ::mtx/metrics ::interval ::wrk/name]}]
(letfn [(monitor! [executor prev-completed]
(let [labels (into-array String [(d/name name)])
stats (deref executor)
completed (:completed stats)
completed-inc (- completed prev-completed)
completed-inc (if (neg? completed-inc) 0 completed-inc)]
(mtx/run! metrics
:id :executor-active-threads
:labels labels
:val (:active stats))
(mtx/run! metrics
:id :executor-running-threads
:labels labels
:val (:running stats))
(mtx/run! metrics
:id :executors-completed-tasks
:labels labels
:inc completed-inc)
completed-inc))]
(px/thread
{:name "penpot/executors-monitor" :virtual true}
(l/inf :hint "monitor started" :name name)
(try
(loop [completed 0]
(px/sleep interval)
(recur (long (monitor! executor completed))))
(catch InterruptedException _cause
(l/trc :hint "monitor: interrupted" :name name))
(catch Throwable cause
(l/err :hint "monitor: unexpected error" :name name :cause cause))
(finally
(l/inf :hint "monitor: terminated" :name name))))))
(defmethod ig/halt-key! ::wrk/monitor
[_ thread]
(px/interrupt! thread))

272
backend/src/app/worker/runner.clj Normal file
View file

@ -0,0 +1,272 @@
;; 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.worker.runner
"Async tasks abstraction (impl)."
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.transit :as t]
[app.config :as cf]
[app.db :as db]
[app.metrics :as mtx]
[app.redis :as rds]
[app.util.time :as dt]
[app.worker :as-alias wrk]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[integrant.core :as ig]
[promesa.exec :as px]))
(set! *warn-on-reflection* true)
(defn- decode-task-row
[{:keys [props] :as row}]
(cond-> row
(db/pgobject? props)
(assoc :props (db/decode-transit-pgobject props))))
(defn get-error-context
[_ item]
{:params item})
(defn- run-worker-loop!
[{:keys [::db/pool ::rds/rconn ::wrk/registry ::timeout ::queue ::id]}]
(letfn [(handle-task-retry [{:keys [task error inc-by delay] :or {inc-by 1 delay 1000}}]
(let [explain (ex-message error)
nretry (+ (:retry-num task) inc-by)
now (dt/now)
delay (->> (iterate #(* % 2) delay) (take nretry) (last))]
(db/update! pool :task
{:error explain
:status "retry"
:modified-at now
:scheduled-at (dt/plus now delay)
:retry-num nretry}
{:id (:id task)})
nil))
(handle-task-failure [{:keys [task error]}]
(let [explain (ex-message error)]
(db/update! pool :task
{:error explain
:modified-at (dt/now)
:status "failed"}
{:id (:id task)})
nil))
(handle-task-completion [{:keys [task]}]
(let [now (dt/now)]
(db/update! pool :task
{:completed-at now
:modified-at now
:status "completed"}
{:id (:id task)})
nil))
(decode-payload [^bytes payload]
(try
(let [task-id (t/decode payload)]
(if (uuid? task-id)
task-id
(l/err :hint "received unexpected payload (uuid expected)"
:payload task-id)))
(catch Throwable cause
(l/err :hint "unable to decode payload"
:payload payload
:length (alength payload)
:cause cause))))
(handle-task [{:keys [name] :as task}]
(let [task-fn (get registry name)]
(if task-fn
(task-fn task)
(l/wrn :hint "no task handler found" :name name))
{:status :completed :task task}))
(handle-task-exception [cause task]
(let [edata (ex-data cause)]
(if (and (< (:retry-num task)
(:max-retries task))
(= ::retry (:type edata)))
(cond-> {:status :retry :task task :error cause}
(dt/duration? (:delay edata))
(assoc :delay (:delay edata))
(= ::noop (:strategy edata))
(assoc :inc-by 0))
(do
(l/err :hint "unhandled exception on task"
::l/context (get-error-context cause task)
:cause cause)
(if (>= (:retry-num task) (:max-retries task))
{:status :failed :task task :error cause}
{:status :retry :task task :error cause})))))
(get-task [task-id]
(ex/try!
(some-> (db/get* pool :task {:id task-id})
(decode-task-row))))
(run-task [task-id]
(loop [task (get-task task-id)]
(cond
(ex/exception? task)
(if (or (db/connection-error? task)
(db/serialization-error? task))
(do
(l/wrn :hint "connection error on retrieving task from database (retrying in some instants)"
:id id
:cause task)
(px/sleep (::rds/timeout rconn))
(recur (get-task task-id)))
(do
(l/err :hint "unhandled exception on retrieving task from database (retrying in some instants)"
:id id
:cause task)
(px/sleep (::rds/timeout rconn))
(recur (get-task task-id))))
(nil? task)
(l/wrn :hint "no task found on the database"
:id id
:task-id task-id)
:else
(try
(l/trc :hint "start task"
:queue queue
:runner-id id
:name (:name task)
:task-id (str task-id)
:retry (:retry-num task))
(let [tpoint (dt/tpoint)
result (handle-task task)
elapsed (dt/format-duration (tpoint))]
(l/trc :hint "end task"
:queue queue
:runner-id id
:name (:name task)
:task-id (str task-id)
:retry (:retry-num task)
:elapsed elapsed)
result)
(catch InterruptedException cause
(throw cause))
(catch Throwable cause
(handle-task-exception cause task))))))
(process-result [{:keys [status] :as result}]
(ex/try!
(case status
:retry (handle-task-retry result)
:failed (handle-task-failure result)
:completed (handle-task-completion result)
nil)))
(run-task-loop [task-id]
(loop [result (run-task task-id)]
(when-let [cause (process-result result)]
(if (or (db/connection-error? cause)
(db/serialization-error? cause))
(do
(l/wrn :hint "database exeption on processing task result (retrying in some instants)"
:cause cause)
(px/sleep (::rds/timeout rconn))
(recur result))
(do
(l/err :hint "unhandled exception on processing task result (retrying in some instants)"
:cause cause)
(px/sleep (::rds/timeout rconn))
(recur result))))))]
(try
(let [queue (str/ffmt "taskq:%" queue)
[_ payload] (rds/blpop! rconn timeout queue)]
(some-> payload
decode-payload
run-task-loop))
(catch InterruptedException cause
(throw cause))
(catch Exception cause
(if (rds/timeout-exception? cause)
(do
(l/err :hint "redis pop operation timeout, consider increasing redis timeout (will retry in some instants)"
:timeout timeout
:cause cause)
(px/sleep timeout))
(l/err :hint "unhandled exception" :cause cause))))))
(defn- start-thread!
[{:keys [::rds/redis ::id ::queue] :as cfg}]
(px/thread
{:name (format "penpot/worker/runner:%s" id)}
(l/inf :hint "started" :id id :queue queue)
(try
(dm/with-open [rconn (rds/connect redis)]
(let [tenant (cf/get :tenant "main")
cfg (-> cfg
(assoc ::queue (str/ffmt "%:%" tenant queue))
(assoc ::rds/rconn rconn)
(assoc ::timeout (dt/duration "5s")))]
(loop []
(when (px/interrupted?)
(throw (InterruptedException. "interrupted")))
(run-worker-loop! cfg)
(recur))))
(catch InterruptedException _
(l/debug :hint "interrupted"
:id id
:queue queue))
(catch Throwable cause
(l/err :hint "unexpected exception"
:id id
:queue queue
:cause cause))
(finally
(l/inf :hint "terminated"
:id id
:queue queue)))))
(s/def ::wrk/queue keyword?)
(defmethod ig/pre-init-spec ::runner [_]
(s/keys :req [::wrk/parallelism
::mtx/metrics
::db/pool
::rds/redis
::wrk/queue
::wrk/registry]))
(defmethod ig/prep-key ::wrk/runner
[_ cfg]
(merge {::wrk/parallelism 1}
(d/without-nils cfg)))
(defmethod ig/init-key ::wrk/runner
[_ {:keys [::db/pool ::wrk/queue ::wrk/parallelism] :as cfg}]
(let [queue (d/name queue)
cfg (assoc cfg ::queue queue)]
(if (db/read-only? pool)
(l/wrn :hint "not started (db is read-only)" :queue queue :parallelism parallelism)
(doall
(->> (range parallelism)
(map #(assoc cfg ::id %))
(map start-thread!))))))
(defmethod ig/halt-key! ::wrk/runner
[_ threads]
(run! px/interrupt! threads))

4
backend/test/backend_tests/helpers.clj
View file

@ -156,8 +156,8 @@
:app.loggers.database/reporter :app.loggers.database/reporter
:app.worker/cron :app.worker/cron
:app.worker/dispatcher :app.worker/dispatcher
[:app.main/default :app.worker/worker] [:app.main/default :app.worker/runner]
[:app.main/webhook :app.worker/worker])) [:app.main/webhook :app.worker/runner]))
_ (ig/load-namespaces system) _ (ig/load-namespaces system)
system (-> (ig/prep system) system (-> (ig/prep system)
(ig/init))] (ig/init))]

12
common/src/app/common/geom/shapes/transforms.cljc
View file

@ -299,12 +299,16 @@
(cond-> shape (cond-> shape
(neg? dot-x) (neg? dot-x)
(-> (cr/update! :flip-x not) (cr/update! :flip-x not)
(cr/update! :rotation -))
(neg? dot-x)
(cr/update! :rotation -)
(neg? dot-y) (neg? dot-y)
(-> (cr/update! :flip-y not) (cr/update! :flip-y not)
(cr/update! :rotation -)))))
(neg? dot-y)
(cr/update! :rotation -))))
(defn- apply-transform-move (defn- apply-transform-move
"Given a new set of points transformed, set up the rectangle so it keeps "Given a new set of points transformed, set up the rectangle so it keeps

2
common/src/app/common/types/shape.cljc
View file

@ -31,7 +31,7 @@
[app.common.uuid :as uuid] [app.common.uuid :as uuid]
[clojure.set :as set])) [clojure.set :as set]))
(cr/defrecord Shape [id name type x y width height rotation selrect points transform transform-inverse parent-id frame-id]) (cr/defrecord Shape [id name type x y width height rotation selrect points transform transform-inverse parent-id frame-id flip-x flip-y])
(defn shape? (defn shape?
[o] [o]

26
frontend/src/app/main/data/comments.cljs
View file

@ -67,6 +67,7 @@
(update :comment-threads assoc id (dissoc thread :comment)) (update :comment-threads assoc id (dissoc thread :comment))
(update-in [:workspace-data :pages-index page-id :options :comment-threads-position] assoc id position) (update-in [:workspace-data :pages-index page-id :options :comment-threads-position] assoc id position)
(update :comments-local assoc :open id) (update :comments-local assoc :open id)
(update :comments-local assoc :options nil)
(update :comments-local dissoc :draft) (update :comments-local dissoc :draft)
(update :workspace-drawing dissoc :comment) (update :workspace-drawing dissoc :comment)
(update-in [:comments id] assoc (:id comment) comment)))) (update-in [:comments id] assoc (:id comment) comment))))
@ -120,6 +121,7 @@
(update :comment-threads assoc id (dissoc thread :comment)) (update :comment-threads assoc id (dissoc thread :comment))
(update-in [:viewer :pages page-id :options :comment-threads-position] assoc id position) (update-in [:viewer :pages page-id :options :comment-threads-position] assoc id position)
(update :comments-local assoc :open id) (update :comments-local assoc :open id)
(update :comments-local assoc :options nil)
(update :comments-local dissoc :draft) (update :comments-local dissoc :draft)
(update :workspace-drawing dissoc :comment) (update :workspace-drawing dissoc :comment)
(update-in [:comments id] assoc (:id comment) comment)))) (update-in [:comments id] assoc (:id comment) comment))))
@ -247,14 +249,16 @@
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(d/update-in-when state [:comments thread-id id] assoc :content content)) (-> state
(d/update-in-when [:comments thread-id id] assoc :content content)))
ptk/WatchEvent ptk/WatchEvent
(watch [_ state _] (watch [_ state _]
(let [share-id (-> state :viewer-local :share-id)] (let [file-id (:current-file-id state)
share-id (-> state :viewer-local :share-id)]
(->> (rp/cmd! :update-comment {:id id :content content :share-id share-id}) (->> (rp/cmd! :update-comment {:id id :content content :share-id share-id})
(rx/catch #(rx/throw {:type :comment-error})) (rx/catch #(rx/throw {:type :comment-error}))
(rx/ignore)))))) (rx/map #(retrieve-comment-threads file-id)))))))
(defn delete-comment-thread-on-workspace (defn delete-comment-thread-on-workspace
[{:keys [id] :as thread}] [{:keys [id] :as thread}]
@ -427,6 +431,7 @@
(update [_ state] (update [_ state]
(-> state (-> state
(update :comments-local assoc :open id) (update :comments-local assoc :open id)
(update :comments-local assoc :options nil)
(update :workspace-drawing dissoc :comment))))) (update :workspace-drawing dissoc :comment)))))
(defn close-thread (defn close-thread
@ -435,7 +440,7 @@
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(-> state (-> state
(update :comments-local dissoc :open :draft) (update :comments-local dissoc :open :draft :options)
(update :workspace-drawing dissoc :comment))))) (update :workspace-drawing dissoc :comment)))))
(defn update-filters (defn update-filters
@ -490,6 +495,19 @@
(d/update-in-when [:workspace-drawing :comment] merge data) (d/update-in-when [:workspace-drawing :comment] merge data)
(d/update-in-when [:comments-local :draft] merge data))))) (d/update-in-when [:comments-local :draft] merge data)))))
(defn toggle-comment-options
[comment]
(ptk/reify ::toggle-comment-options
ptk/UpdateEvent
(update [_ state]
(update-in state [:comments-local :options] #(if (= (:id comment) %) nil (:id comment))))))
(defn hide-comment-options
[]
(ptk/reify ::hide-comment-options
ptk/UpdateEvent
(update [_ state]
(update-in state [:comments-local :options] (constantly nil)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Helpers ;; Helpers

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

@ -355,20 +355,22 @@
(ptk/reify ::finalize-file (ptk/reify ::finalize-file
ptk/UpdateEvent ptk/UpdateEvent
(update [_ state] (update [_ state]
(dissoc state (-> state
:current-file-id (dissoc
:current-project-id :current-file-id
:workspace-data :current-project-id
:workspace-editor-state :workspace-data
:workspace-file :workspace-editor-state
:workspace-libraries :workspace-file
:workspace-ready? :workspace-libraries
:workspace-media-objects :workspace-media-objects
:workspace-persistence :workspace-persistence
:workspace-presence :workspace-presence
:workspace-project :workspace-project
:workspace-project :workspace-ready?
:workspace-undo)) :workspace-undo)
(update :workspace-global dissoc :read-only?)
(assoc-in [:workspace-global :options-mode] :design)))
ptk/WatchEvent ptk/WatchEvent
(watch [_ _ _] (watch [_ _ _]

3
frontend/src/app/main/data/workspace/selection.cljs
View file

@ -28,7 +28,6 @@
[app.main.data.modal :as md] [app.main.data.modal :as md]
[app.main.data.workspace.changes :as dch] [app.main.data.workspace.changes :as dch]
[app.main.data.workspace.collapse :as dwc] [app.main.data.workspace.collapse :as dwc]
[app.main.data.workspace.edition :as dwe]
[app.main.data.workspace.libraries-helpers :as dwlh] [app.main.data.workspace.libraries-helpers :as dwlh]
[app.main.data.workspace.specialized-panel :as-alias dwsp] [app.main.data.workspace.specialized-panel :as-alias dwsp]
[app.main.data.workspace.state-helpers :as wsh] [app.main.data.workspace.state-helpers :as wsh]
@ -151,7 +150,7 @@
objects (wsh/lookup-page-objects state page-id)] objects (wsh/lookup-page-objects state page-id)]
(rx/of (rx/of
(dwc/expand-all-parents [id] objects) (dwc/expand-all-parents [id] objects)
(dwe/clear-edition-mode) :interrupt
::dwsp/interrupt)))))) ::dwsp/interrupt))))))
(defn select-prev-shape (defn select-prev-shape

24
frontend/src/app/main/ui/comments.cljs
View file

@ -27,6 +27,8 @@
[okulary.core :as l] [okulary.core :as l]
[rumext.v2 :as mf])) [rumext.v2 :as mf]))
(def comments-local-options (l/derived :options refs/comments-local))
(mf/defc resizing-textarea (mf/defc resizing-textarea
{::mf/wrap-props false} {::mf/wrap-props false}
[props] [props]
@ -248,25 +250,28 @@
[{:keys [comment thread users origin] :as props}] [{:keys [comment thread users origin] :as props}]
(let [owner (get users (:owner-id comment)) (let [owner (get users (:owner-id comment))
profile (mf/deref refs/profile) profile (mf/deref refs/profile)
options (mf/use-state false) options (mf/deref comments-local-options)
edition? (mf/use-state false) edition? (mf/use-state false)
on-toggle-options on-toggle-options
(mf/use-fn (mf/use-fn
(mf/deps options)
(fn [event] (fn [event]
(dom/stop-propagation event) (dom/stop-propagation event)
(swap! options not))) (st/emit! (dcm/toggle-comment-options comment))))
on-hide-options on-hide-options
(mf/use-fn (mf/use-fn
(mf/deps options)
(fn [event] (fn [event]
(dom/stop-propagation event) (dom/stop-propagation event)
(reset! options false))) (st/emit! (dcm/hide-comment-options))))
on-edit-clicked on-edit-clicked
(mf/use-fn (mf/use-fn
(mf/deps options)
(fn [] (fn []
(reset! options false) (st/emit! (dcm/hide-comment-options))
(reset! edition? true))) (reset! edition? true)))
on-delete-comment on-delete-comment
@ -282,7 +287,6 @@
(dcm/delete-comment-thread-on-viewer thread) (dcm/delete-comment-thread-on-viewer thread)
(dcm/delete-comment-thread-on-workspace thread)))) (dcm/delete-comment-thread-on-workspace thread))))
on-delete-thread on-delete-thread
(mf/use-fn (mf/use-fn
(mf/deps thread) (mf/deps thread)
@ -337,7 +341,7 @@
:on-cancel on-cancel}] :on-cancel on-cancel}]
[:span {:class (stl/css :text)} (:content comment)])]] [:span {:class (stl/css :text)} (:content comment)])]]
[:& dropdown {:show @options [:& dropdown {:show (= options (:id comment))
:on-close on-hide-options} :on-close on-hide-options}
[:ul {:class (stl/css :comment-options-dropdown)} [:ul {:class (stl/css :comment-options-dropdown)}
[:li {:class (stl/css :context-menu-option) [:li {:class (stl/css :context-menu-option)
@ -356,7 +360,8 @@
(l/derived (l/in [:comments thread-id]) st/state)) (l/derived (l/in [:comments thread-id]) st/state))
(defn- offset-position [position viewport zoom bubble-margin] (defn- offset-position [position viewport zoom bubble-margin]
(let [base-x (+ (* (:x position) zoom) (:offset-x viewport)) (let [viewport (or viewport {:offset-x 0 :offset-y 0 :width 0 :height 0})
base-x (+ (* (:x position) zoom) (:offset-x viewport))
base-y (+ (* (:y position) zoom) (:offset-y viewport)) base-y (+ (* (:y position) zoom) (:offset-y viewport))
w (:width viewport) w (:width viewport)
h (:height viewport) h (:height viewport)
@ -381,7 +386,7 @@
(some? position-modifier) (some? position-modifier)
(gpt/transform position-modifier)) (gpt/transform position-modifier))
max-height (int (* (:height viewport) 0.75)) max-height (when (some? viewport) (int (* (:height viewport) 0.75)))
;; We should probably look for a better way of doing this. ;; We should probably look for a better way of doing this.
bubble-margin {:x 24 :y 0} bubble-margin {:x 24 :y 0}
pos (offset-position base-pos viewport zoom bubble-margin) pos (offset-position base-pos viewport zoom bubble-margin)
@ -418,8 +423,7 @@
:id (str "thread-" thread-id) :id (str "thread-" thread-id)
:style {:left (str pos-x "px") :style {:left (str pos-x "px")
:top (str pos-y "px") :top (str pos-y "px")
:max-height max-height :max-height max-height}
:overflow-y "scroll"}
:on-click dom/stop-propagation} :on-click dom/stop-propagation}
[:div {:class (stl/css :comments)} [:div {:class (stl/css :comments)}

12
frontend/src/app/main/ui/comments.scss
View file

@ -142,10 +142,14 @@
// thread-content // thread-content
.thread-content { .thread-content {
position: absolute; position: absolute;
pointer-events: auto; overflow-y: scroll;
user-select: text; scrollbar-gutter: stable;
width: $s-284; width: $s-284;
padding: $s-12; padding: $s-12;
padding-inline-end: 0;
pointer-events: auto;
user-select: text;
border-radius: $br-8; border-radius: $br-8;
border: $s-2 solid var(--modal-border-color); border: $s-2 solid var(--modal-border-color);
background-color: var(--comment-modal-background-color); background-color: var(--comment-modal-background-color);
@ -216,7 +220,8 @@
.comment-options-dropdown { .comment-options-dropdown {
@extend .dropdown-wrapper; @extend .dropdown-wrapper;
position: absolute; position: absolute;
width: $s-120; width: fit-content;
max-width: $s-200;
right: 0; right: 0;
left: unset; left: unset;
.context-menu-option { .context-menu-option {
@ -238,6 +243,7 @@
margin-bottom: $s-8; margin-bottom: $s-8;
padding: $s-8; padding: $s-8;
color: var(--input-foreground-color-active); color: var(--input-foreground-color-active);
resize: vertical;
&:focus { &:focus {
border: $s-1 solid var(--input-border-color-active); border: $s-1 solid var(--input-border-color-active);
outline: none; outline: none;

3
frontend/src/app/main/ui/components/title_bar.scss
View file

@ -14,6 +14,7 @@
width: 100%; width: 100%;
min-height: $s-32; min-height: $s-32;
background-color: var(--title-background-color); background-color: var(--title-background-color);
color: var(--title-foreground-color);
} }
.title, .title,
@ -26,7 +27,7 @@
grid-auto-flow: column; grid-auto-flow: column;
height: 100%; height: 100%;
min-height: $s-32; min-height: $s-32;
color: var(--title-foreground-color);
overflow: hidden; overflow: hidden;
} }

93
frontend/src/app/main/ui/dashboard/templates.cljs
View file

@ -8,7 +8,6 @@
(:require-macros [app.main.style :as stl]) (:require-macros [app.main.style :as stl])
(:require (:require
[app.common.data.macros :as dm] [app.common.data.macros :as dm]
[app.common.math :as mth]
[app.config :as cf] [app.config :as cf]
[app.main.data.dashboard :as dd] [app.main.data.dashboard :as dd]
[app.main.data.events :as ev] [app.main.data.events :as ev]
@ -123,7 +122,9 @@
[:div {:class (stl/css :template-card)} [:div {:class (stl/css :template-card)}
[:div {:class (stl/css :img-container)} [:div {:class (stl/css :img-container)}
[:img {:src (dm/str thb) [:img {:src (dm/str thb)
:alt (:name item)}]] :alt (:name item)
:loading "lazy"
:decoding "async"}]]
[:div {:class (stl/css :card-name)} [:div {:class (stl/css :card-name)}
[:span {:class (stl/css :card-text)} (:name item)] [:span {:class (stl/css :card-text)} (:name item)]
download-icon]]])) download-icon]]]))
@ -164,7 +165,7 @@
(mf/defc templates-section (mf/defc templates-section
{::mf/wrap-props false} {::mf/wrap-props false}
[{:keys [default-project-id profile project-id team-id content-width]}] [{:keys [default-project-id profile project-id team-id]}]
(let [templates (mf/deref builtin-templates) (let [templates (mf/deref builtin-templates)
templates (mf/with-memo [templates] templates (mf/with-memo [templates]
(filterv #(not= (:id %) "tutorial-for-beginners") templates)) (filterv #(not= (:id %) "tutorial-for-beginners") templates))
@ -179,63 +180,41 @@
props (:props profile) props (:props profile)
collapsed (:builtin-templates-collapsed-status props false) collapsed (:builtin-templates-collapsed-status props false)
card-offset* (mf/use-state 0) can-move (mf/use-state {:left false :right true})
card-offset (deref card-offset*)
card-width 275
total (count templates) total (count templates)
container-size (* (+ 2 total) card-width)
;; We need space for total plus the libraries&templates link ;; We need space for total plus the libraries&templates link
more-cards (> (+ card-offset (* (+ 1 total) card-width)) content-width)
card-count (mth/floor (/ content-width 275))
left-moves (/ card-offset -275)
first-card left-moves
last-card (+ (- card-count 1) left-moves)
content-ref (mf/use-ref) content-ref (mf/use-ref)
on-move-left move-left (fn [] (dom/scroll-by! (mf/ref-val content-ref) -300 0))
move-right (fn [] (dom/scroll-by! (mf/ref-val content-ref) 300 0))
update-can-move
(fn [scroll-left scroll-available client-width]
(reset! can-move {:left (> scroll-left 0)
:right (> scroll-available client-width)}))
on-scroll
(mf/use-fn (mf/use-fn
(mf/deps card-offset card-width) (fn [e]
(fn [_event] (let [scroll (dom/get-target-scroll e)
(when-not (zero? card-offset) scroll-left (:scroll-left scroll)
(dom/animate! (mf/ref-val content-ref) scroll-available (- (:scroll-width scroll) scroll-left)
[#js {:left (dm/str card-offset "px")} client-rect (dom/get-client-size (dom/get-target e))]
#js {:left (dm/str (+ card-offset card-width) "px")}] (update-can-move scroll-left scroll-available (unchecked-get client-rect "width")))))
#js {:duration 200 :easing "linear"})
(reset! card-offset* (+ card-offset card-width))))) on-move-left
(mf/use-fn #(move-left))
on-move-left-key-down on-move-left-key-down
(mf/use-fn (mf/use-fn #(move-left))
(mf/deps on-move-left first-card)
(fn [event]
(when (kbd/enter? event)
(dom/stop-propagation event)
(on-move-left event)
(when-let [node (dom/get-element (dm/str "card-container-" first-card))]
(dom/focus! node)))))
on-move-right on-move-right
(mf/use-fn (mf/use-fn #(move-right))
(mf/deps more-cards card-offset card-width)
(fn [_event]
(when more-cards
(swap! card-offset* inc)
(dom/animate! (mf/ref-val content-ref)
[#js {:left (dm/str card-offset "px")}
#js {:left (dm/str (- card-offset card-width) "px")}]
#js {:duration 200 :easing "linear"})
(reset! card-offset* (- card-offset card-width)))))
on-move-right-key-down on-move-right-key-down
(mf/use-fn (mf/use-fn #(move-right))
(mf/deps on-move-right last-card)
(fn [event]
(when (kbd/enter? event)
(dom/stop-propagation event)
(on-move-right event)
(when-let [node (dom/get-element (dm/str "card-container-" last-card))]
(dom/focus! node)))))
on-import-template on-import-template
(mf/use-fn (mf/use-fn
@ -243,6 +222,12 @@
(fn [template _event] (fn [template _event]
(import-template! template team-id project-id default-project-id section)))] (import-template! template team-id project-id default-project-id section)))]
(mf/with-effect [content-ref templates]
(let [content (mf/ref-val content-ref)]
(when (and (some? content) (some? templates))
(dom/scroll-to content #js {:behavior "instant" :left 0 :top 0})
(.dispatchEvent content (js/Event. "scroll")))))
(mf/with-effect [profile collapsed] (mf/with-effect [profile collapsed]
(when (and profile (not collapsed)) (when (and profile (not collapsed))
(st/emit! (dd/fetch-builtin-templates)))) (st/emit! (dd/fetch-builtin-templates))))
@ -252,9 +237,8 @@
[:& title {:collapsed collapsed}] [:& title {:collapsed collapsed}]
[:div {:class (stl/css :content) [:div {:class (stl/css :content)
:ref content-ref :on-scroll on-scroll
:style {:left card-offset :ref content-ref}
:width (dm/str container-size "px")}}
(for [index (range (count templates))] (for [index (range (count templates))]
[:& card-item [:& card-item
@ -262,24 +246,23 @@
:item (nth templates index) :item (nth templates index)
:index index :index index
:key index :key index
:is-visible (and (>= index first-card) :is-visible true
(<= index last-card))
:collapsed collapsed}]) :collapsed collapsed}])
[:& card-item-link [:& card-item-link
{:is-visible (and (>= total first-card) (<= total last-card)) {:is-visible true
:collapsed collapsed :collapsed collapsed
:section section :section section
:total total}]] :total total}]]
(when (< card-offset 0) (when (:left @can-move)
[:button {:class (stl/css :move-button :move-left) [:button {:class (stl/css :move-button :move-left)
:tab-index (if ^boolean collapsed "-1" "0") :tab-index (if ^boolean collapsed "-1" "0")
:on-click on-move-left :on-click on-move-left
:on-key-down on-move-left-key-down} :on-key-down on-move-left-key-down}
arrow-icon]) arrow-icon])
(when more-cards (when (:right @can-move)
[:button {:class (stl/css :move-button :move-right) [:button {:class (stl/css :move-button :move-right)
:tab-index (if collapsed "-1" "0") :tab-index (if collapsed "-1" "0")
:on-click on-move-right :on-click on-move-right

11
frontend/src/app/main/ui/dashboard/templates.scss
View file

@ -109,24 +109,29 @@
} }
.content { .content {
display: grid;
grid-template-columns: repeat(auto-fill, minmax($s-276, $s-276));
grid-auto-flow: column;
pointer-events: all; pointer-events: all;
width: 200%;
height: $s-228; height: $s-228;
margin-left: $s-6; margin-left: $s-6;
position: absolute;
border-top-left-radius: $s-8; border-top-left-radius: $s-8;
background-color: $db-quaternary; background-color: $db-quaternary;
overflow: scroll hidden;
scroll-behavior: smooth;
scroll-snap-type: x mandatory;
scroll-snap-stop: always;
} }
.card-container { .card-container {
width: $s-276; width: $s-276;
margin-top: $s-20; margin-top: $s-20;
display: inline-block;
text-align: center; text-align: center;
vertical-align: top; vertical-align: top;
background-color: transparent; background-color: transparent;
border: none; border: none;
padding: 0; padding: 0;
scroll-snap-align: start;
} }
.template-card { .template-card {

1
frontend/src/app/main/ui/viewer.cljs
View file

@ -613,6 +613,7 @@
:permissions permissions :permissions permissions
:zoom zoom :zoom zoom
:section section :section section
:shown-thumbnails (:show-thumbnails local)
:interactions-mode interactions-mode}]])) :interactions-mode interactions-mode}]]))
;; --- Component: Viewer ;; --- Component: Viewer

31
frontend/src/app/main/ui/viewer/header.cljs
View file

@ -201,7 +201,7 @@
:class (stl/css :go-log-btn)} (tr "labels.log-or-sign")])])) :class (stl/css :go-log-btn)} (tr "labels.log-or-sign")])]))
(mf/defc header-sitemap (mf/defc header-sitemap
[{:keys [project file page frame] :as props}] [{:keys [project file page frame toggle-thumbnails] :as props}]
(let [project-name (:name project) (let [project-name (:name project)
file-name (:name file) file-name (:name file)
page-name (:name page) page-name (:name page)
@ -209,11 +209,6 @@
frame-name (:name frame) frame-name (:name frame)
show-dropdown? (mf/use-state false) show-dropdown? (mf/use-state false)
toggle-thumbnails
(mf/use-fn
(fn []
(st/emit! dv/toggle-thumbnails-panel)))
open-dropdown open-dropdown
(mf/use-fn (mf/use-fn
(fn [] (fn []
@ -254,12 +249,13 @@
(when (= page-id id) (when (= page-id id)
[:span {:class (stl/css :icon-check)} i/tick])])]]] [:span {:class (stl/css :icon-check)} i/tick])])]]]
[:div {:class (stl/css :current-frame) [:div {:class (stl/css :current-frame)
:id "current-frame"
:on-click toggle-thumbnails} :on-click toggle-thumbnails}
[:span {:class (stl/css :frame-name)} frame-name] [:span {:class (stl/css :frame-name)} frame-name]
[:span {:class (stl/css :icon)} i/arrow]]]])) [:span {:class (stl/css :icon)} i/arrow]]]]))
(mf/defc header (mf/defc header
[{:keys [project file page frame zoom section permissions index interactions-mode]}] [{:keys [project file page frame zoom section permissions index interactions-mode shown-thumbnails]}]
(let [go-to-dashboard (let [go-to-dashboard
(mf/use-fn (mf/use-fn
#(st/emit! (dv/go-to-dashboard))) #(st/emit! (dv/go-to-dashboard)))
@ -282,13 +278,27 @@
(keyword))] (keyword))]
(if (or (= section :interactions) (:is-logged permissions)) (if (or (= section :interactions) (:is-logged permissions))
(st/emit! (dv/go-to-section section)) (st/emit! (dv/go-to-section section))
(open-login-dialog)))))] (open-login-dialog)))))
toggle-thumbnails
(mf/use-fn
(fn []
(st/emit! dv/toggle-thumbnails-panel)))
close-thumbnails
(mf/use-fn
(mf/deps shown-thumbnails)
(fn [_]
(when shown-thumbnails
(st/emit! dv/close-thumbnails-panel))))]
[:header {:class (stl/css-case :viewer-header true [:header {:class (stl/css-case :viewer-header true
:fullscreen (mf/deref fullscreen-ref))} :fullscreen (mf/deref fullscreen-ref))
:on-click close-thumbnails}
[:div {:class (stl/css :nav-zone)} [:div {:class (stl/css :nav-zone)}
;; If the user doesn't have permission we disable the link ;; If the user doesn't have permission we disable the link
[:a {:class (stl/css :home-link) [:a {:class (stl/css :home-link)
:on-click go-to-dashboard :on-click go-to-dashboard
:style {:cursor (when-not (:can-edit permissions) "auto") :style {:cursor (when-not (:can-edit permissions) "auto")
@ -300,6 +310,7 @@
:file file :file file
:page page :page page
:frame frame :frame frame
:toggle-thumbnails toggle-thumbnails
:index index}]] :index index}]]
[:div {:class (stl/css :mode-zone)} [:div {:class (stl/css :mode-zone)}

5
frontend/src/app/main/ui/viewer/inspect/exports.scss
View file

@ -16,8 +16,10 @@
} }
.title-spacing-export-viewer { .title-spacing-export-viewer {
@extend .attr-title;
margin: 0; margin: 0;
color: var(--entry-foreground-color-hover);
margin-inline-start: calc(-1 * $s-8);
width: calc(100% + $s-8);
} }
.add-export { .add-export {
@ -26,6 +28,7 @@
width: $s-28; width: $s-28;
svg { svg {
@extend .button-icon; @extend .button-icon;
stroke: var(--icon-foreground);
} }
} }

2
frontend/src/app/main/ui/viewer/inspect/right_sidebar.scss
View file

@ -21,7 +21,7 @@
} }
.viewer-code { .viewer-code {
padding: 0 $s-8; padding-inline-start: $s-8;
} }
.tool-windows { .tool-windows {

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

@ -107,7 +107,8 @@
(mf/defc thumbnails-panel (mf/defc thumbnails-panel
[{:keys [frames page index show? thumbnail-data] :as props}] [{:keys [frames page index show? thumbnail-data] :as props}]
(let [expanded? (mf/use-state false) (let [expanded-state (mf/use-state false)
expanded? (deref expanded-state)
container (mf/use-ref) container (mf/use-ref)
objects (:objects page) objects (:objects page)
@ -115,23 +116,27 @@
selected (mf/use-var false) selected (mf/use-var false)
on-item-click on-item-click
(mf/use-callback (mf/use-fn
(mf/deps @expanded?) (mf/deps expanded?)
(fn [_ index] (fn [_ index]
(compare-and-set! selected false true) (compare-and-set! selected false true)
(st/emit! (dv/go-to-frame-by-index index)) (st/emit! (dv/go-to-frame-by-index index))
(when @expanded? (when expanded?
(on-close))))] (on-close))))
toggle-expand
(mf/use-fn
#(swap! expanded-state not))]
[:section {:class (stl/css-case :viewer-thumbnails true [:section {:class (stl/css-case :viewer-thumbnails true
:expanded @expanded?) :expanded expanded?)
;; This is better as an inline-style so it won't make a reflow of every frame inside ;; This is better as an inline-style so it won't make a reflow of every frame inside
:style {:display (when (not show?) "none")} :style {:display (when (not show?) "none")}
:ref container} :ref container}
[:& thumbnails-summary {:on-toggle-expand #(swap! expanded? not) [:& thumbnails-summary {:on-toggle-expand toggle-expand
:on-close on-close :on-close on-close
:total (count frames)}] :total (count frames)}]
[:& thumbnails-content {:expanded? @expanded? [:& thumbnails-content {:expanded? expanded?
:total (count frames)} :total (count frames)}
(for [[i frame] (d/enumerate frames)] (for [[i frame] (d/enumerate frames)]
[:& thumbnail-item {:index i [:& thumbnail-item {:index i

1
frontend/src/app/main/ui/workspace/left_header.cljs
View file

@ -73,7 +73,6 @@
(fn [] (fn []
(close-modals) (close-modals)
(st/emit! (dw/set-options-mode :design) (st/emit! (dw/set-options-mode :design)
(dw/set-workspace-read-only false)
(dw/go-to-dashboard project)))) (dw/go-to-dashboard project))))
nav-to-project nav-to-project

3
frontend/src/app/main/ui/workspace/sidebar/assets/components.scss
View file

@ -66,8 +66,7 @@
&:hover { &:hover {
.cell-name { .cell-name {
display: grid; display: block;
grid-template-columns: 1fr auto;
} }
} }

5
frontend/src/app/main/ui/workspace/sidebar/layers.cljs
View file

@ -144,7 +144,10 @@
(conj :rect :circle :path :bool))] (conj :rect :circle :path :bool))]
(or (= uuid/zero id) (or (= uuid/zero id)
(and (or (str/includes? (str/lower (:name shape)) (str/lower search)) (and (or (str/includes? (str/lower (:name shape)) (str/lower search))
(str/includes? (dm/str (:id shape)) (str/lower search))) ;; Only for local development we allow search for ids. Otherwise will be hard
;; search for numbers or single letter shape names (ie: "A")
(and *assert*
(str/includes? (dm/str (:id shape)) (str/lower search))))
(or (empty? filters) (or (empty? filters)
(and (contains? filters :component) (and (contains? filters :component)
(contains? shape :component-id)) (contains? shape :component-id))

7
frontend/src/app/main/ui/workspace/sidebar/options/menus/component.cljs
View file

@ -616,9 +616,10 @@
[:div {:class (stl/css :name-wrapper)} [:div {:class (stl/css :name-wrapper)}
[:div {:class (stl/css :component-name)} [:div {:class (stl/css :component-name)}
(if multi [:span {:class (stl/css :component-name-inside)}
(tr "settings.multiple") (if multi
(cfh/last-path shape-name))] (tr "settings.multiple")
(cfh/last-path shape-name))]]
(when (and can-swap? (not multi)) (when (and can-swap? (not multi))
[:div {:class (stl/css :component-parent-name)} [:div {:class (stl/css :component-parent-name)}

7
frontend/src/app/main/ui/workspace/sidebar/options/menus/component.scss
View file

@ -56,7 +56,6 @@
padding-right: 0.5rem; padding-right: 0.5rem;
.component-name-wrapper { .component-name-wrapper {
width: 100%; width: 100%;
border-radius: $br-8; border-radius: $br-8;
} }
} }
@ -93,6 +92,7 @@
min-height: $s-32; min-height: $s-32;
padding: $s-8 0 $s-8 $s-2; padding: $s-8 0 $s-8 $s-2;
border-radius: $br-8 0 0 $br-8; border-radius: $br-8 0 0 $br-8;
overflow: hidden;
} }
.component-name { .component-name {
@ -103,6 +103,11 @@
min-height: $s-16; min-height: $s-16;
} }
.component-name-inside {
direction: ltr;
unicode-bidi: bidi-override;
}
.component-parent-name { .component-parent-name {
@include bodySmallTypography; @include bodySmallTypography;
@include textEllipsis; @include textEllipsis;

1
frontend/src/app/main/ui/workspace/sidebar/shortcuts.cljs
View file

@ -189,6 +189,7 @@
;; shortcuts.unmask ;; shortcuts.unmask
;; shortcuts.v-distribute ;; shortcuts.v-distribute
;; shortcuts.zoom-selected ;; shortcuts.zoom-selected
;; shortcuts.toggle-layout-grid
(let [translat-pre (case type (let [translat-pre (case type
:sc "shortcuts." :sc "shortcuts."
:sec "shortcut-section." :sec "shortcut-section."

4
frontend/src/app/main/ui/workspace/viewport/guides.cljs
View file

@ -26,7 +26,7 @@
(def guide-width 1) (def guide-width 1)
(def guide-opacity 0.7) (def guide-opacity 0.7)
(def guide-opacity-hover 1) (def guide-opacity-hover 1)
(def guide-color colors/new-primary) (def guide-color colors/new-danger)
(def guide-pill-width 34) (def guide-pill-width 34)
(def guide-pill-height 20) (def guide-pill-height 20)
(def guide-pill-corner-radius 4) (def guide-pill-corner-radius 4)
@ -378,7 +378,7 @@
:transform (when (= axis :y) (str "rotate(-90 " text-x "," text-y ")")) :transform (when (= axis :y) (str "rotate(-90 " text-x "," text-y ")"))
:style {:font-size (/ rulers/font-size zoom) :style {:font-size (/ rulers/font-size zoom)
:font-family rulers/font-family :font-family rulers/font-family
:fill colors/black}} :fill colors/white}}
;; If the guide is associated to a frame we show the position relative to the frame ;; If the guide is associated to a frame we show the position relative to the frame
(fmt/format-number (- pos (if (= axis :x) (:x frame) (:y frame))))]]))]))) (fmt/format-number (- pos (if (= axis :x) (:x frame) (:y frame))))]]))])))

6
frontend/src/app/main/ui/workspace/viewport/selection.cljs
View file

@ -335,8 +335,8 @@
flip-x (get shape :flip-x) flip-x (get shape :flip-x)
flip-y (get shape :flip-y) flip-y (get shape :flip-y)
half-flip? (or (and (some? flip-x) (not (some? flip-y))) half-flip? (or (and flip-x (not flip-y))
(and (some? flip-y) (not (some? flip-x))))] (and flip-y (not flip-x)))]
(when (and (not ^boolean read-only?) (when (and (not ^boolean read-only?)
(not (:transforming shape)) (not (:transforming shape))
@ -357,7 +357,7 @@
(and ^boolean half-flip? (and ^boolean half-flip?
(or (= position :top-right) (or (= position :top-right)
(= position :bottom-left))) (= position :bottom-left)))
(- rotation 90) (+ rotation 90)
:else :else
rotation) rotation)

2
frontend/src/app/util/code_gen/style_css_formats.cljs
View file

@ -20,6 +20,8 @@
:height :size :height :size
:min-width :size :min-width :size
:min-height :size :min-height :size
:max-width :size
:max-height :size
:background :color :background :color
:border :border :border :border
:border-radius :string-or-size-array :border-radius :string-or-size-array

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

@ -645,6 +645,12 @@
(when (some? element) (when (some? element)
(.-scrollLeft element))) (.-scrollLeft element)))
(defn scroll-to
([^js element options]
(.scrollTo element options))
([^js element x y]
(.scrollTo element x y)))
(defn set-scroll-pos! (defn set-scroll-pos!
[^js element scroll] [^js element scroll]
(when (some? element) (when (some? element)
@ -756,6 +762,12 @@
[] []
(.reload (.-location js/window))) (.reload (.-location js/window)))
(defn scroll-by!
([element x y]
(.scrollBy ^js element x y))
([x y]
(scroll-by! js/window x y)))
(defn animate! (defn animate!
([item keyframes duration] (animate! item keyframes duration nil)) ([item keyframes duration] (animate! item keyframes duration nil))
([item keyframes duration onfinish] ([item keyframes duration onfinish]

3
frontend/translations/en.po
View file

@ -3023,6 +3023,9 @@ msgstr "Zoom lense increase"
msgid "shortcuts.zoom-selected" msgid "shortcuts.zoom-selected"
msgstr "Zoom to selected" msgstr "Zoom to selected"
msgid "shortcuts.toggle-layout-grid"
msgstr "Add/remove grid layout"
#: src/app/main/ui/dashboard/team.cljs #: src/app/main/ui/dashboard/team.cljs
msgid "team.webhooks.max-length" msgid "team.webhooks.max-length"
msgstr "The webhook name must contain at most 2048 characters." msgstr "The webhook name must contain at most 2048 characters."

3
frontend/translations/es.po
View file

@ -3069,6 +3069,9 @@ msgstr "Incrementar zoom a objetivo"
msgid "shortcuts.zoom-selected" msgid "shortcuts.zoom-selected"
msgstr "Zoom a selección" msgstr "Zoom a selección"
msgid "shortcuts.toggle-layout-grid"
msgstr "Añadir/eliminar grid layout"
#: src/app/main/ui/dashboard/team.cljs #: src/app/main/ui/dashboard/team.cljs
msgid "team.webhooks.max-length" msgid "team.webhooks.max-length"
msgstr "El nombre del webhook debe contener como máximo 2048 caracteres." msgstr "El nombre del webhook debe contener como máximo 2048 caracteres."