3pp-mirror/penpot
1
0
Fork 0
mirror of https://github.com/penpot/penpot.git synced 2025-05-29 23:26:10 +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-02-19 16:02:59 +01:00
commit fd641e87c9
42 changed files with 572 additions and 358 deletions
Download patch file Download diff file Expand all files Collapse all files

2
backend/dev/user.clj
View file

@ -44,7 +44,7 @@
[clojure.walk :refer [macroexpand-all]]
[criterium.core :as crit]
[cuerdas.core :as str]
[datoteka.core]
[datoteka.fs :as fs]
[integrant.core :as ig]
[malli.core :as m]
[malli.dev.pretty :as mdp]

2
backend/resources/app/templates/debug.tmpl
View file

@ -157,7 +157,7 @@ Debug Main Page
<legend>Reset file version</legend>
<desc>Allows reset file data version to a specific number/</desc>
<form method="post" action="/dbg/actions/reset-file-data-version">
<form method="post" action="/dbg/actions/reset-file-version">
<div class="row">
<input type="text" style="width:300px" name="file-id" placeholder="file-id" />
</div>

52
backend/resources/log4j2-devenv-repl.xml Normal file
View file

@ -0,0 +1,52 @@
<?xml version="1.0" encoding="UTF-8"?>
<Configuration status="info" monitorInterval="30">
<Appenders>
<Console name="console" target="SYSTEM_OUT">
<PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"
alwaysWriteExceptions="true" />
</Console>
<RollingFile name="main" fileName="logs/main-latest.log" filePattern="logs/main-%i.log">
<PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"
alwaysWriteExceptions="true" />
<Policies>
<SizeBasedTriggeringPolicy size="50M"/>
</Policies>
<DefaultRolloverStrategy max="20"/>
</RollingFile>
</Appenders>
<Loggers>
<Logger name="io.lettuce" level="error" />
<Logger name="com.zaxxer.hikari" level="error"/>
<Logger name="org.postgresql" level="error" />
<Logger name="app.binfile" level="debug" />
<Logger name="app.storage.tmp" level="info" />
<Logger name="app.worker" level="trace" />
<Logger name="app.msgbus" level="info" />
<Logger name="app.http.websocket" level="info" />
<Logger name="app.http.sse" level="info" />
<Logger name="app.util.websocket" level="info" />
<Logger name="app.redis" level="info" />
<Logger name="app.rpc.rlimit" level="info" />
<Logger name="app.rpc.climit" level="debug" />
<Logger name="app.common.files.migrations" level="debug" />
<Logger name="app.loggers" level="debug" additivity="false">
<AppenderRef ref="main" level="debug" />
</Logger>
<Logger name="app" level="all" additivity="false">
<AppenderRef ref="main" level="trace" />
</Logger>
<Logger name="user" level="trace" additivity="false">
<AppenderRef ref="main" level="trace" />
</Logger>
<Root level="info">
<AppenderRef ref="main" />
</Root>
</Loggers>
</Configuration>

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

@ -6,13 +6,13 @@
alwaysWriteExceptions="true" />
</Console>
<RollingFile name="main" fileName="logs/main.log" filePattern="logs/main-%i.log">
<RollingFile name="main" fileName="logs/main-latest.log" filePattern="logs/main-%i.log">
<PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"
alwaysWriteExceptions="true" />
<Policies>
<SizeBasedTriggeringPolicy size="50M"/>
</Policies>
<DefaultRolloverStrategy max="9"/>
<DefaultRolloverStrategy max="20"/>
</RollingFile>
</Appenders>
@ -31,22 +31,26 @@
<Logger name="app.redis" level="info" />
<Logger name="app.rpc.rlimit" level="info" />
<Logger name="app.rpc.climit" level="debug" />
<Logger name="app.common.files.migrations" level="info" />
<Logger name="app.common.files.migrations" level="debug" />
<Logger name="app.loggers" level="debug" additivity="false">
<AppenderRef ref="console" level="info" />
<AppenderRef ref="main" level="debug" />
</Logger>
<Logger name="app" level="all" additivity="false">
<AppenderRef ref="main" level="trace" />
<AppenderRef ref="console" level="info" />
</Logger>
<Logger name="user" level="trace" additivity="false">
<AppenderRef ref="main" level="trace" />
<AppenderRef ref="console" level="info" />
</Logger>
<Root level="info">
<AppenderRef ref="main" />
<AppenderRef ref="console" level="info" />
</Root>
</Loggers>
</Configuration>

9
backend/resources/log4j2.xml
View file

@ -11,16 +11,9 @@
<Logger name="io.lettuce" level="error" />
<Logger name="com.zaxxer.hikari" level="error" />
<Logger name="org.postgresql" level="error" />
<Logger name="app.util" level="info" />
<Logger name="app.loggers" level="debug" />
<Logger name="app" level="info" additivity="false">
<AppenderRef ref="console" />
<AppenderRef ref="console" level="info" />
</Logger>
<Root level="info">
<AppenderRef ref="console" />
</Root>

2
backend/scripts/repl
View file

@ -68,7 +68,7 @@ export OPTIONS="
-J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
-J-Djdk.attach.allowAttachSelf \
-J-Dpolyglot.engine.WarnInterpreterOnly=false \
-J-Dlog4j2.configurationFile=log4j2-devenv.xml \
-J-Dlog4j2.configurationFile=log4j2-devenv-repl.xml \
-J-XX:+EnableDynamicAgentLoading \
-J-XX:-OmitStackTraceInFastThrow \
-J-XX:+UnlockDiagnosticVMOptions \

2
backend/scripts/start-dev
View file

@ -28,7 +28,7 @@ export OPTIONS="
-J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
-J-Djdk.attach.allowAttachSelf \
-J-Dpolyglot.engine.WarnInterpreterOnly=false \
-J-Dlog4j2.configurationFile=log4j2.xml \
-J-Dlog4j2.configurationFile=log4j2-devenv.xml \
-J-XX:+EnableDynamicAgentLoading \
-J-XX:-OmitStackTraceInFastThrow \
-J-XX:+UnlockDiagnosticVMOptions \

32
backend/src/app/binfile/common.clj
View file

@ -12,7 +12,6 @@
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.features :as cfeat]
[app.common.files.defaults :as cfd]
[app.common.files.migrations :as fmg]
[app.common.files.validate :as fval]
[app.common.logging :as l]
@ -381,23 +380,24 @@
(d/group-by first rest)
(reduce (partial process-group-of-assets) data)))))
(defn- fix-version
[file]
(let [file (fmg/fix-version file)]
;; FIXME: We're temporarily activating all migrations because a
;; problem in the environments messed up with the version numbers
;; When this problem is fixed delete the following line
(if (> (:version file) 22)
(assoc file :version 22)
file)))
(defn process-file
[{:keys [id] :as file}]
(-> file
(fix-version)
(update :data (fn [fdata]
(-> fdata
(assoc :id id)
(dissoc :recent-colors)
(cond-> (> (:version fdata) cfd/version)
(assoc :version cfd/version))
;; FIXME: We're temporarily activating all
;; migrations because a problem in the
;; environments messed up with the version
;; numbers When this problem is fixed delete
;; the following line
(cond-> (> (:version fdata) 22)
(assoc :version 22)))))
(dissoc :recent-colors))))
(fmg/migrate-file)
(update :data (fn [fdata]
(-> fdata
@ -409,19 +409,21 @@
(defn- upsert-file!
[conn file]
(let [sql (str "INSERT INTO file (id, project_id, name, revn, is_shared, data, created_at, modified_at) "
"VALUES (?, ?, ?, ?, ?, ?, ?, ?) "
"ON CONFLICT (id) DO UPDATE SET data=?")]
(let [sql (str "INSERT INTO file (id, project_id, name, revn, version, is_shared, data, created_at, modified_at) "
"VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?) "
"ON CONFLICT (id) DO UPDATE SET data=?, version=?")]
(db/exec-one! conn [sql
(:id file)
(:project-id file)
(:name file)
(:revn file)
(:version file)
(:is-shared file)
(:data file)
(:created-at file)
(:modified-at file)
(:data file)])))
(:data file)
(:version file)])))
(defn persist-file!
"Applies all the final validations and perist the file."

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

@ -1496,6 +1496,13 @@
fdata (migrate-graphics fdata)]
(update fdata :options assoc :components-v2 true)))))
(defn- fix-version
[file]
(let [file (fmg/fix-version file)]
(if (> (:version file) 22)
(assoc file :version 22)
file)))
(defn- get-file
[system id]
(binding [pmap/*load-fn* (partial fdata/load-pointer system id)]
@ -1506,10 +1513,7 @@
(update :data assoc :id id)
(update :data fdata/process-pointers deref)
(update :data fdata/process-objects (partial into {}))
(update :data (fn [data]
(if (> (:version data) 22)
(assoc data :version 22)
data)))
(fix-version)
(fmg/migrate-file))))
(defn get-team
@ -1524,21 +1528,9 @@
(cfv/validate-file! file libs)
(cfv/validate-file-schema! file))
(defn- process-file
[{:keys [::db/conn] :as system} {:keys [id] :as file} & {:keys [validate?]}]
(let [libs (->> (files/get-file-libraries conn id)
(into [file] (comp (map :id)
(map (partial get-file system))))
(d/index-by :id))
file (-> file
(update :data migrate-fdata libs)
(update :features conj "components/v2"))
_ (when validate?
(validate-file! file libs))
file (if (contains? (:features file) "fdata/objects-map")
(defn- persist-file!
[{:keys [::db/conn] :as system} {:keys [id] :as file}]
(let [file (if (contains? (:features file) "fdata/objects-map")
(fdata/enable-objects-map file)
file)
@ -1547,15 +1539,32 @@
(let [file (fdata/enable-pointer-map file)]
(fdata/persist-pointers! system id)
file))
file)]
file)
;; Ensure all files has :data with id
file (update file :data assoc :id id)]
(db/update! conn :file
{:data (blob/encode (:data file))
:features (db/create-array conn "text" (:features file))
:revn (:revn file)}
{:id (:id file)})
{:id (:id file)})))
(dissoc file :data)))
(defn- process-file!
[{:keys [::db/conn] :as system} {:keys [id] :as file} & {:keys [validate?]}]
(let [libs (->> (files/get-file-libraries conn id)
(into [file] (comp (map :id)
(map (partial get-file system))))
(d/index-by :id))
file (-> file
(update :data migrate-fdata libs)
(update :features conj "components/v2"))]
(when validate?
(validate-file! file libs))
file))
(def ^:private sql:get-and-lock-team-files
"SELECT f.id
@ -1605,13 +1614,15 @@
(when (string? label)
(fsnap/take-file-snapshot! system {:file-id file-id
:label (str "migration/" label)}))
(let [file (get-file system file-id)]
(let [file (get-file system file-id)
file (process-file! system file :validate? validate?)]
(events/tap :progress
{:op :migrate-file
:name (:name file)
:id (:id file)})
(process-file system file :validate? validate?)))))
(persist-file! system file)))))
(catch Throwable cause
(vreset! err true)

57
backend/src/app/features/fdata.clj
View file

@ -22,18 +22,16 @@
(defn enable-objects-map
[file]
(let [update-container
(fn [container]
(if (and (pmap/pointer-map? container)
(not (pmap/loaded? container)))
container
(d/update-when container :objects omap/wrap)))
(let [update-page
(fn [page]
(if (and (pmap/pointer-map? page)
(not (pmap/loaded? page)))
page
(update page :objects omap/wrap)))
update-data
(fn [fdata]
(-> fdata
(update :pages-index d/update-vals update-container)
(d/update-when :components d/update-vals update-container)))]
(update fdata :pages-index d/update-vals update-page))]
(-> file
(update :data update-data)
@ -43,19 +41,15 @@
"Apply a function to all objects-map on the file. Usualy used for convert
the objects-map instances to plain maps"
[fdata update-fn]
(let [update-container
(fn [container]
(d/update-when container :objects
(fn [objects]
(if (omap/objects-map? objects)
(update-fn objects)
objects))))]
(cond-> fdata
(contains? fdata :pages-index)
(update :pages-index update-vals update-container)
(contains? fdata :components)
(update :components update-vals update-container))))
(if (contains? fdata :pages-index)
(update fdata :pages-index d/update-vals
(fn [page]
(update page :objects
(fn [objects]
(if (omap/objects-map? objects)
(update-fn objects)
objects)))))
fdata))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; POINTER-MAP
@ -95,15 +89,13 @@
"Apply a function to all pointers on the file. Usuly used for
dereference the pointer to a plain value before some processing."
[fdata update-fn]
(cond-> fdata
(contains? fdata :pages-index)
(update :pages-index process-pointers update-fn)
:always
(update-vals (fn [val]
(if (pmap/pointer-map? val)
(update-fn val)
val)))))
(let [update-fn' (fn [val]
(if (pmap/pointer-map? val)
(update-fn val)
val))]
(-> fdata
(d/update-vals update-fn')
(update :pages-index d/update-vals update-fn'))))
(defn get-used-pointer-ids
"Given a file, return all pointer ids used in the data."
@ -119,7 +111,6 @@
(-> file
(update :data (fn [fdata]
(-> fdata
(update :pages-index update-vals pmap/wrap)
(update :pages-index d/update-vals pmap/wrap)
(d/update-when :components pmap/wrap))))
(update :features conj "fdata/pointer-map")))

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

@ -393,7 +393,7 @@
::rres/body (str/ffmt "PROFILE '%' ACTIVATED" (:email profile))}))))
(defn- reset-file-data-version
(defn- reset-file-version
[cfg {:keys [params] :as request}]
(let [file-id (some-> params :file-id d/parse-uuid)
version (some-> params :version d/parse-integer)]
@ -413,7 +413,7 @@
:code :invalid-version
:hint "provided invalid version"))
(db/tx-run! cfg srepl/process-file! file-id #(update % :data assoc :version version))
(db/tx-run! cfg srepl/process-file! file-id #(assoc % :version version))
{::rres/status 200
::rres/headers {"content-type" "text/plain"}
@ -486,8 +486,8 @@
["/error" {:handler (partial error-list-handler cfg)}]
["/actions/resend-email-verification"
{:handler (partial resend-email-notification cfg)}]
["/actions/reset-file-data-version"
{:handler (partial reset-file-data-version cfg)}]
["/actions/reset-file-version"
{:handler (partial reset-file-version cfg)}]
["/file/export" {:handler (partial export-handler cfg)}]
["/file/import" {:handler (partial import-handler cfg)}]
["/file/data" {:handler (partial file-data-handler cfg)}]

5
backend/src/app/migrations.clj
View file

@ -373,7 +373,10 @@
:fn (mg/resource "app/migrations/sql/0117-mod-file-object-thumbnail-table.sql")}
{:name "0118-mod-task-table"
:fn (mg/resource "app/migrations/sql/0118-mod-task-table.sql")}])
:fn (mg/resource "app/migrations/sql/0118-mod-task-table.sql")}
{:name "0119-mod-file-table"
:fn (mg/resource "app/migrations/sql/0119-mod-file-table.sql")}])
(defn apply-migrations!
[pool name migrations]

2
backend/src/app/migrations/sql/0119-mod-file-table.sql Normal file
View file

@ -0,0 +1,2 @@
ALTER TABLE file
ADD COLUMN version integer NULL;

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

@ -197,40 +197,41 @@
config (::config climit)
label (::sv/name mdata)]
(reduce (fn [handler [limit-id key-fn]]
(if-let [config (get config limit-id)]
(let [key-fn (or key-fn noop-fn)]
(l/dbg :hint "instrumenting method"
:method label
:limit (id->str limit-id)
:timeout (:timeout config)
:permits (:permits config)
:queue (:queue config)
:keyed (not= key-fn noop-fn))
(if climit
(reduce (fn [handler [limit-id key-fn]]
(if-let [config (get config limit-id)]
(let [key-fn (or key-fn noop-fn)]
(l/dbg :hint "instrumenting method"
:method label
:limit (id->str limit-id)
:timeout (:timeout config)
:permits (:permits config)
:queue (:queue config)
:keyed (not= key-fn noop-fn))
(if (and (= key-fn ::rpc/profile-id)
(false? (::rpc/auth mdata true)))
(if (and (= key-fn ::rpc/profile-id)
(false? (::rpc/auth mdata true)))
;; We don't enforce by-profile limit on methods that does
;; not require authentication
handler
;; We don't enforce by-profile limit on methods that does
;; not require authentication
handler
(fn [cfg params]
(let [limit-key (key-fn params)
cache-key [limit-id limit-key]
limiter (cache/get cache cache-key (partial create-limiter config))
profile-id (if (= key-fn ::rpc/profile-id)
limit-key
(get params ::rpc/profile-id))]
(invoke limiter metrics limit-id limit-key label profile-id handler [cfg params])))))
(fn [cfg params]
(let [limit-key (key-fn params)
cache-key [limit-id limit-key]
limiter (cache/get cache cache-key (partial create-limiter config))
profile-id (if (= key-fn ::rpc/profile-id)
limit-key
(get params ::rpc/profile-id))]
(invoke limiter metrics limit-id limit-key label profile-id handler [cfg params])))))
(do
(l/wrn :hint "no config found for specified queue" :id (id->str limit-id))
handler)))
(do
(l/wrn :hint "no config found for specified queue" :id (id->str limit-id))
handler)))
handler
(concat global-limits (get-limits mdata)))))
handler
(concat global-limits (get-limits mdata)))
handler)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PUBLIC API

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

@ -71,19 +71,14 @@
data (assoc :data (blob/decode data)))))
(defn check-version!
[{:keys [data] :as file}]
(dm/assert!
"expect data to be decoded"
(map? data))
(let [version (:version data 0)]
[file]
(let [version (:version file)]
(when (> version fmg/version)
(ex/raise :type :restriction
:code :file-version-not-supported
:hint "file version is greated that the maximum"
:file-version version
:max-version fmg/version))
file))
;; --- FILE PERMISSIONS
@ -252,6 +247,7 @@
(db/update! conn :file
{:data (blob/encode (:data file))
:version (:version file)
:features (db/create-array conn "text" (:features file))}
{:id id})

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

@ -9,6 +9,7 @@
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.features :as cfeat]
[app.common.files.defaults :refer [version]]
[app.common.schema :as sm]
[app.common.types.file :as ctf]
[app.common.uuid :as uuid]
@ -61,6 +62,7 @@
:name name
:revn revn
:is-shared is-shared
:version version
:data data
:features features
:ignore-sync-until ignore-sync-until

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

@ -183,8 +183,8 @@
(l/trace :hint "update-file" :time (dt/format-duration elapsed))))))))))
(defn update-file
[{:keys [::db/conn ::mtx/metrics] :as cfg}
{:keys [id file features changes changes-with-metadata] :as params}]
[{:keys [::mtx/metrics] :as cfg}
{:keys [file features changes changes-with-metadata] :as params}]
(let [features (-> features
(set/difference cfeat/frontend-only-features)
(set/union (:features file)))
@ -207,12 +207,6 @@
(mtx/run! metrics {:id :update-file-changes :inc (count changes)})
(when (not= features (:features file))
(let [features (db/create-array conn "text" features)]
(db/update! conn :file
{:features features}
{:id id})))
(binding [cfeat/*current* features
cfeat/*previous* (:features file)]
(let [file (assoc file :features features)
@ -234,7 +228,8 @@
{:keys [profile-id file changes session-id ::created-at skip-validate] :as params}]
(let [;; Process the file data on separated thread for avoid to do
;; the CPU intensive operation on vthread.
file (px/invoke! executor (partial update-file-data cfg file changes skip-validate))]
file (px/invoke! executor (partial update-file-data cfg file changes skip-validate))
features (db/create-array conn "text" (:features file))]
(db/insert! conn :file-change
{:id (uuid/next)
@ -252,6 +247,8 @@
(db/update! conn :file
{:revn (:revn file)
:data (:data file)
:version (:version file)
:features features
:data-backend nil
:modified-at created-at
:has-media-trimmed false}

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

@ -66,6 +66,7 @@
(db/update! conn :file
{:revn (:revn file)
:data (:data file)
:version (:version file)
:features (:features file)
:deleted-at (:deleted-at file)
:created-at (:created-at file)

19
backend/src/app/storage/tmp.clj
View file

@ -19,6 +19,8 @@
[promesa.exec :as px]
[promesa.exec.csp :as sp]))
(def default-tmp-dir "/tmp/penpot")
(declare ^:private remove-temp-file)
(declare ^:private io-loop)
@ -33,6 +35,7 @@
(defmethod ig/init-key ::cleaner
[_ cfg]
(fs/create-dir default-tmp-dir)
(px/fn->thread (partial io-loop cfg)
{:name "penpot/storage/tmp-cleaner" :virtual true}))
@ -70,18 +73,14 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn tempfile
"Returns a tmpfile candidate (without creating it)"
[& {:keys [suffix prefix min-age]
:or {prefix "penpot."
suffix ".tmp"}}]
(let [path (fs/tempfile :suffix suffix :prefix prefix)]
(sp/offer! queue [path (some-> min-age dt/duration)])
path))
(defn create-tempfile
[& {:keys [suffix prefix min-age]
:or {prefix "penpot."
suffix ".tmp"}}]
(let [path (fs/create-tempfile :suffix suffix :prefix prefix)]
(let [path (fs/create-tempfile
:perms "rw-r--r--"
:dir default-tmp-dir
:suffix suffix
:prefix prefix)]
(fs/delete-on-exit! path)
(sp/offer! queue [path (some-> min-age dt/duration)])
path))

5
backend/src/app/tasks/file_gc.clj
View file

@ -62,6 +62,8 @@
(db/update! conn :file
{:has-media-trimmed true
:features (:features file)
:version (:version file)
:data (:data file)}
{:id id})))
@ -82,6 +84,7 @@
"SELECT f.id,
f.data,
f.revn,
f.version,
f.features,
f.modified_at
FROM file AS f
@ -175,7 +178,7 @@
(def ^:private sql:get-files-for-library
"SELECT f.id, f.data, f.modified_at, f.features
"SELECT f.id, f.data, f.modified_at, f.features, f.version
FROM file AS f
LEFT JOIN file_library_rel AS fl ON (fl.file_id = f.id)
WHERE fl.library_file_id = ?

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

@ -38,7 +38,7 @@
[clojure.spec.alpha :as s]
[clojure.test :as t]
[cuerdas.core :as str]
[datoteka.core :as fs]
[datoteka.fs :as fs]
[environ.core :refer [env]]
[expound.alpha :as expound]
[integrant.core :as ig]
@ -127,6 +127,8 @@
app.auth/verify-password (fn [a b] {:valid (= a b)})
app.common.features/get-enabled-features (fn [& _] app.common.features/supported-features)]
(fs/create-dir "/tmp/penpot")
(let [templates [{:id "test"
:name "test"
:file-uri "test"
@ -191,6 +193,7 @@
(let [path (fs/path "/tmp/penpot")]
(when (fs/exists? path)
(fs/delete (fs/path "/tmp/penpot")))
(fs/create-dir "/tmp/penpot")
(next)))
(defn serial
@ -496,7 +499,7 @@
(defn tempfile
[source]
(let [rsc (io/resource source)
tmp (fs/create-tempfile)]
tmp (fs/create-tempfile :dir "/tmp/penpot" :prefix "test-")]
(io/copy (io/file rsc)
(io/file tmp))
tmp))

2
backend/test/backend_tests/rpc_comment_test.clj
View file

@ -17,7 +17,7 @@
[app.util.time :as dt]
[backend-tests.helpers :as th]
[clojure.test :as t]
[datoteka.core :as fs]
[datoteka.fs :as fs]
[mockery.core :refer [with-mocks]]))
(t/use-fixtures :once th/state-init)

2
backend/test/backend_tests/rpc_cond_middleware_test.clj
View file

@ -15,7 +15,7 @@
[backend-tests.helpers :as th]
[backend-tests.storage-test :refer [configure-storage-backend]]
[clojure.test :as t]
[datoteka.core :as fs]))
[datoteka.fs :as fs]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)

3
backend/test/backend_tests/rpc_file_thumbnails_test.clj
View file

@ -21,7 +21,7 @@
[clojure.java.io :as io]
[clojure.test :as t]
[cuerdas.core :as str]
[datoteka.core :as fs]
[datoteka.fs :as fs]
[mockery.core :refer [with-mocks]]))
(t/use-fixtures :once th/state-init)
@ -82,7 +82,6 @@
(t/is (nil? (:error out)))
(t/is (map? (:result out))))
;; run the task again
(let [res (th/run-task! "storage-gc-touched" {:min-age 0})]
(t/is (= 2 (:freeze res))))

2
backend/test/backend_tests/rpc_management_test.clj
View file

@ -16,7 +16,7 @@
[backend-tests.storage-test :refer [configure-storage-backend]]
[buddy.core.bytes :as b]
[clojure.test :as t]
[datoteka.core :as fs]))
[datoteka.fs :as fs]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)

2
backend/test/backend_tests/rpc_media_test.clj
View file

@ -12,7 +12,7 @@
[app.storage :as sto]
[backend-tests.helpers :as th]
[clojure.test :as t]
[datoteka.core :as fs]))
[datoteka.fs :as fs]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)

2
backend/test/backend_tests/rpc_profile_test.clj
View file

@ -18,7 +18,7 @@
[clojure.java.io :as io]
[clojure.test :as t]
[cuerdas.core :as str]
[datoteka.core :as fs]
[datoteka.fs :as fs]
[mockery.core :refer [with-mocks]]))
;; TODO: profile deletion with teams

2
backend/test/backend_tests/rpc_quotes_test.clj
View file

@ -14,7 +14,7 @@
[app.rpc.quotes :as-alias quotes]
[backend-tests.helpers :as th]
[clojure.test :as t]
[datoteka.core :as fs]
[datoteka.fs :as fs]
[mockery.core :refer [with-mocks]]))
(t/use-fixtures :once th/state-init)

2
backend/test/backend_tests/rpc_team_test.clj
View file

@ -16,7 +16,7 @@
[app.util.time :as dt]
[backend-tests.helpers :as th]
[clojure.test :as t]
[datoteka.core :as fs]
[datoteka.fs :as fs]
[mockery.core :refer [with-mocks]]))
(t/use-fixtures :once th/state-init)

2
backend/test/backend_tests/rpc_viewer_test.clj
View file

@ -11,7 +11,7 @@
[app.rpc :as-alias rpc]
[backend-tests.helpers :as th]
[clojure.test :as t]
[datoteka.core :as fs]))
[datoteka.fs :as fs]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)

2
backend/test/backend_tests/storage_test.clj
View file

@ -15,7 +15,7 @@
[backend-tests.helpers :as th]
[clojure.test :as t]
[cuerdas.core :as str]
[datoteka.core :as fs]
[datoteka.fs :as fs]
[datoteka.io :as io]
[mockery.core :refer [with-mocks]]))

11
common/deps.edn
View file

@ -32,11 +32,14 @@
funcool/tubax {:mvn/version "2021.05.20-0"}
funcool/cuerdas {:mvn/version "2023.11.09-407"}
funcool/promesa {:git/sha "0c5ed6ad033515a2df4b55addea044f60e9653d0"
:git/url "https://github.com/funcool/promesa"}
funcool/promesa
{:git/sha "0c5ed6ad033515a2df4b55addea044f60e9653d0"
:git/url "https://github.com/funcool/promesa"}
funcool/datoteka {:mvn/version "3.0.66"
:exclusions [funcool/promesa]}
funcool/datoteka
{:git/sha "5ac3781"
:git/tag "3.0.0"
:git/url "https://github.com/funcool/datoteka"}
lambdaisland/uri {:mvn/version "1.16.134"
:exclusions [org.clojure/data.json]}

234
common/src/app/common/files/migrations.cljc
View file

@ -29,33 +29,74 @@
#?(:cljs (l/set-level! :info))
(declare ^:private migrations)
(def version cfd/version)
(defmulti migrate :version)
(defn need-migration?
[{:keys [data]}]
(> cfd/version (:version data 0)))
[file]
(or (nil? (:version file))
(not= cfd/version (:version file))))
(defn- apply-migrations
[data migrations from-version]
(loop [migrations migrations
data data]
(if-let [[to-version migrate-fn] (first migrations)]
(let [migrate-fn (or migrate-fn identity)]
(l/inf :hint "migrate file"
:op (if (>= from-version to-version) "down" "up")
:file-id (str (:id data))
:version to-version)
(recur (rest migrations)
(migrate-fn data)))
data)))
(defn migrate-data
([data] (migrate-data data version))
([data to-version]
(if (= (:version data) to-version)
data
(let [migrate-fn #(do
(l/dbg :hint "migrate file" :id (:id %) :version-from %2 :version-to (inc %2))
(migrate (assoc %1 :version (inc %2))))]
(reduce migrate-fn data (range (:version data 0) to-version))))))
[data migrations from-version to-version]
(if (= from-version to-version)
data
(let [migrations (if (< from-version to-version)
(->> migrations
(drop-while #(<= (get % :id) from-version))
(take-while #(<= (get % :id) to-version))
(map (juxt :id :migrate-up)))
(->> (reverse migrations)
(drop-while #(> (get % :id) from-version))
(take-while #(> (get % :id) to-version))
(map (juxt :id :migrate-down))))]
(apply-migrations data migrations from-version))))
(defn fix-version
"Fixes the file versioning numbering"
[{:keys [version] :as file}]
(if (int? version)
file
(let [version (or version (-> file :data :version))]
(-> file
(assoc :version version)
(update :data dissoc :version)))))
(defn migrate-file
[{:keys [id data features] :as file}]
[{:keys [id data features version] :as file}]
(binding [cfeat/*new* (atom #{})]
(let [file (-> file
(update :data assoc :id id)
(update :data migrate-data)
(update :features (fnil into #{}) (deref cfeat/*new*))
(update :features cfeat/migrate-legacy-features))]
(if (or (not= (:version data) (:version (:data file)))
(let [version (or version (:version data))
file (-> file
(assoc :version cfd/version)
(update :data (fn [data]
(-> data
(assoc :id id)
(dissoc :version)
(migrate-data migrations version cfd/version))))
(update :features (fnil into #{}) (deref cfeat/*new*))
;; NOTE: in some future we can consider to apply
;; a migration to the whole database and remove
;; this code from this function that executes on
;; each file migration operation
(update :features cfeat/migrate-legacy-features))]
(if (or (not= version (:version file))
(not= features (:features file)))
(vary-meta file assoc ::migrated true)
file))))
@ -64,13 +105,10 @@
[file]
(true? (-> file meta ::migrated)))
;; Default handler, noop
(defmethod migrate :default [data] data)
;; -- MIGRATIONS --
;; Ensure that all :shape attributes on shapes are vectors.
(defmethod migrate 2
(defn migrate-up-2
"Ensure that all :shape attributes on shapes are vectors"
[data]
(letfn [(update-object [object]
(d/update-when object :shapes
@ -83,8 +121,8 @@
(update data :pages-index update-vals update-page)))
;; Changes paths formats
(defmethod migrate 3
(defn migrate-up-3
"Changes paths formats"
[data]
(letfn [(migrate-path [shape]
(if-not (contains? shape :content)
@ -137,12 +175,9 @@
(update data :pages-index update-vals update-page)))
;; We did rollback version 4 migration.
;; Keep this in order to remember the next version to be 5
(defmethod migrate 4 [data] data)
;; Put the id of the local file in :component-file in instances of local components
(defmethod migrate 5
(defn migrate-up-5
"Put the id of the local file in :component-file in instances of
local components"
[data]
(letfn [(update-object [object]
(if (and (some? (:component-id object))
@ -155,9 +190,9 @@
(update data :pages-index update-vals update-page)))
(defmethod migrate 6
(defn migrate-up-6
"Fixes issues with selrect/points for shapes with width/height = 0 (line-like paths)"
[data]
;; Fixes issues with selrect/points for shapes with width/height = 0 (line-like paths)"
(letfn [(fix-line-paths [shape]
(if (= (:type shape) :path)
(let [{:keys [width height]} (grc/points->rect (:points shape))]
@ -181,8 +216,8 @@
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
;; Remove interactions pointing to deleted frames
(defmethod migrate 7
(defn migrate-up-7
"Remove interactions pointing to deleted frames"
[data]
(letfn [(update-object [page object]
(d/update-when object :interactions
@ -194,9 +229,8 @@
(update data :pages-index update-vals update-page)))
;; Remove groups without any shape, both in pages and components
(defmethod migrate 8
(defn migrate-up-8
"Remove groups without any shape, both in pages and components"
[data]
(letfn [(clean-parents [obj deleted?]
(d/update-when obj :shapes
@ -236,7 +270,7 @@
(update :pages-index update-vals clean-container)
(update :components update-vals clean-container))))
(defmethod migrate 9
(defn migrate-up-9
[data]
(letfn [(find-empty-groups [objects]
(->> (vals objects)
@ -264,13 +298,13 @@
(recur (cpc/process-changes data changes))
data)))))
(defmethod migrate 10
(defn migrate-up-10
[data]
(letfn [(update-page [page]
(d/update-in-when page [:objects uuid/zero] dissoc :points :selrect))]
(update data :pages-index update-vals update-page)))
(defmethod migrate 11
(defn migrate-up-11
[data]
(letfn [(update-object [objects shape]
(if (cfh/frame-shape? shape)
@ -284,7 +318,7 @@
(update data :pages-index update-vals update-page)))
(defmethod migrate 12
(defn migrate-up-12
[data]
(letfn [(update-grid [grid]
(cond-> grid
@ -296,8 +330,8 @@
(update data :pages-index update-vals update-page)))
;; Add rx and ry to images
(defmethod migrate 13
(defn migrate-up-13
"Add rx and ry to images"
[data]
(letfn [(fix-radius [shape]
(if-not (or (contains? shape :rx) (contains? shape :r1))
@ -316,7 +350,7 @@
(update data :pages-index update-vals update-page)))
(defmethod migrate 14
(defn migrate-up-14
[data]
(letfn [(process-shape [shape]
(let [fill-color (str/upper (:fill-color shape))
@ -347,11 +381,8 @@
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate 15 [data] data)
;; Add fills and strokes
(defmethod migrate 16
(defn migrate-up-16
"Add fills and strokes"
[data]
(letfn [(assign-fills [shape]
(let [attrs {:fill-color (:fill-color shape)
@ -397,7 +428,7 @@
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate 17
(defn migrate-up-17
[data]
(letfn [(affected-object? [object]
(and (cfh/image-shape? object)
@ -426,8 +457,8 @@
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
;;Remove position-data to solve a bug with the text positioning
(defmethod migrate 18
(defn migrate-up-18
"Remove position-data to solve a bug with the text positioning"
[data]
(letfn [(update-object [object]
(cond-> object
@ -441,7 +472,7 @@
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate 19
(defn migrate-up-19
[data]
(letfn [(update-object [object]
(cond-> object
@ -457,7 +488,7 @@
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate 25
(defn migrate-up-25
[data]
(some-> cfeat/*new* (swap! conj "fdata/shape-data-type"))
(letfn [(update-object [object]
@ -470,7 +501,7 @@
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate 26
(defn migrate-up-26
[data]
(letfn [(update-object [object]
(cond-> object
@ -487,7 +518,7 @@
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate 27
(defn migrate-up-27
[data]
(letfn [(update-object [object]
(cond-> object
@ -518,7 +549,7 @@
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate 28
(defn migrate-up-28
[data]
(letfn [(update-object [objects object]
(let [frame-id (:frame-id object)
@ -544,10 +575,7 @@
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
;; TODO: pending to do a migration for delete already not used fill
;; and stroke props. This should be done for >1.14.x version.
(defmethod migrate 29
(defn migrate-up-29
[data]
(letfn [(valid-ref? [ref]
(or (uuid? ref)
@ -582,7 +610,7 @@
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate 31
(defn migrate-up-31
[data]
(letfn [(update-object [object]
(cond-> object
@ -596,7 +624,7 @@
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate 32
(defn migrate-up-32
[data]
(some-> cfeat/*new* (swap! conj "fdata/shape-data-type"))
(letfn [(update-object [object]
@ -615,7 +643,7 @@
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate 33
(defn migrate-up-33
[data]
(letfn [(update-object [object]
;; Ensure all root objects are well formed shapes.
@ -635,7 +663,7 @@
(-> data
(update :pages-index update-vals update-container))))
(defmethod migrate 34
(defn migrate-up-34
[data]
(letfn [(update-object [object]
(if (or (cfh/path-shape? object)
@ -648,17 +676,7 @@
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
;; NOTE: We need to repeat this migration for correct feature handling
(defmethod migrate 35
[data]
(-> data
(assoc :version 25)
(migrate)
(assoc :version 35)))
(defmethod migrate 36
(defn migrate-up-36
[data]
(letfn [(update-container [container]
(d/update-when container :objects (fn [objects]
@ -669,11 +687,12 @@
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate 37
(defn migrate-up-37
"Clean nil values on data"
[data]
(d/without-nils data))
(defmethod migrate 38
(defn migrate-up-38
[data]
(letfn [(fix-gradient [{:keys [type] :as gradient}]
(if (string? type)
@ -701,7 +720,7 @@
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate 39
(defn migrate-up-39
[data]
(letfn [(update-shape [shape]
(cond
@ -723,7 +742,7 @@
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate 40
(defn migrate-up-40
[data]
(letfn [(update-shape [{:keys [content shapes] :as shape}]
;; Fix frame shape that in reallity is a path shape
@ -747,7 +766,7 @@
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate 41
(defn migrate-up-41
[data]
(letfn [(update-shape [shape]
(cond
@ -780,7 +799,7 @@
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate 42
(defn migrate-up-42
[data]
(letfn [(update-object [object]
(if (and (or (cfh/frame-shape? object)
@ -800,7 +819,7 @@
(def ^:private valid-fill?
(sm/lazy-validator ::cts/fill))
(defmethod migrate 43
(defn migrate-up-43
[data]
(letfn [(number->string [v]
(if (number? v)
@ -829,7 +848,7 @@
(def ^:private valid-shadow?
(sm/lazy-validator ::ctss/shadow))
(defmethod migrate 44
(defn migrate-up-44
[data]
(letfn [(fix-shadow [shadow]
(if (string? (:color shadow))
@ -851,7 +870,7 @@
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(defmethod migrate 45
(defn migrate-up-45
[data]
(letfn [(fix-shape [shape]
(let [frame-id (or (:frame-id shape)
@ -866,7 +885,7 @@
(-> data
(update :pages-index update-vals update-container))))
(defmethod migrate 46
(defn migrate-up-46
[data]
(letfn [(update-object [object]
(dissoc object :thumbnail))
@ -876,3 +895,42 @@
(-> data
(update :pages-index update-vals update-container)
(update :components update-vals update-container))))
(def migrations
"A vector of all applicable migrations"
[{:id 2 :migrate-up migrate-up-2}
{:id 3 :migrate-up migrate-up-3}
{:id 5 :migrate-up migrate-up-5}
{:id 6 :migrate-up migrate-up-6}
{:id 7 :migrate-up migrate-up-7}
{:id 8 :migrate-up migrate-up-8}
{:id 9 :migrate-up migrate-up-9}
{:id 10 :migrate-up migrate-up-10}
{:id 11 :migrate-up migrate-up-11}
{:id 12 :migrate-up migrate-up-12}
{:id 13 :migrate-up migrate-up-13}
{:id 14 :migrate-up migrate-up-14}
{:id 16 :migrate-up migrate-up-16}
{:id 17 :migrate-up migrate-up-17}
{:id 18 :migrate-up migrate-up-18}
{:id 19 :migrate-up migrate-up-19}
{:id 25 :migrate-up migrate-up-25}
{:id 26 :migrate-up migrate-up-26}
{:id 27 :migrate-up migrate-up-27}
{:id 28 :migrate-up migrate-up-28}
{:id 29 :migrate-up migrate-up-29}
{:id 31 :migrate-up migrate-up-31}
{:id 32 :migrate-up migrate-up-32}
{:id 33 :migrate-up migrate-up-33}
{:id 34 :migrate-up migrate-up-34}
{:id 36 :migrate-up migrate-up-36}
{:id 37 :migrate-up migrate-up-37}
{:id 38 :migrate-up migrate-up-38}
{:id 39 :migrate-up migrate-up-39}
{:id 40 :migrate-up migrate-up-40}
{:id 41 :migrate-up migrate-up-41}
{:id 42 :migrate-up migrate-up-42}
{:id 43 :migrate-up migrate-up-43}
{:id 44 :migrate-up migrate-up-44}
{:id 45 :migrate-up migrate-up-45}
{:id 46 :migrate-up migrate-up-46}])

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

@ -9,7 +9,6 @@
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.features :as cfeat]
[app.common.files.defaults :refer [version]]
[app.common.files.helpers :as cfh]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
@ -70,8 +69,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def empty-file-data
{:version version
:pages []
{:pages []
:pages-index {}})
(defn make-file-data
@ -82,7 +80,7 @@
(let [page (when (some? page-id)
(ctp/make-empty-page page-id "Page 1"))]
(cond-> (assoc empty-file-data :id file-id :version version)
(cond-> (assoc empty-file-data :id file-id)
(some? page-id)
(ctpl/add-page page)

54
common/test/common_tests/files_migrations_test.cljc
View file

@ -7,11 +7,42 @@
(ns common-tests.files-migrations-test
(:require
[app.common.data :as d]
[app.common.files.migrations :as cpm]
[app.common.files.migrations :as cfm]
[app.common.pprint :as pp]
[app.common.uuid :as uuid]
[clojure.pprint :refer [pprint]]
[clojure.test :as t]))
(t/deftest test-generic-migration-subsystem-1
(let [migrations [{:id 1 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
{:id 2 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
{:id 3 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
{:id 4 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
{:id 5 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
{:id 6 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
{:id 7 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
{:id 8 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
{:id 9 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
{:id 10 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
{:id 11 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
{:id 12 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}
{:id 13 :migrate-up (comp inc inc) :migrate-down (comp dec dec)}]]
(t/testing "migrate up 1"
(let [result (cfm/migrate-data 0 migrations 0 2)]
(t/is (= result 4))))
(t/testing "migrate up 2"
(let [result (cfm/migrate-data 0 migrations 0 20)]
(t/is (= result 26))))
(t/testing "migrate down 1"
(let [result (cfm/migrate-data 12 migrations 6 3)]
(t/is (= result 6))))
(t/testing "migrate down 2"
(let [result (cfm/migrate-data 12 migrations 6 0)]
(t/is (= result 0))))))
(t/deftest test-migration-8-1
(let [page-id (uuid/custom 0 0)
objects [{:type :rect :id (uuid/custom 1 0)}
@ -34,16 +65,11 @@
{:type :path :id (uuid/custom 1 5)}]
data {:pages-index {page-id {:objects (d/index-by :id objects)}}
:components {}
:version 7}
:components {}}
res (cpm/migrate-data data 8)]
res (cfm/migrate-data data cfm/migrations 7 8)]
;; (pprint data)
;; (pprint res)
(t/is (= (dissoc data :version)
(dissoc res :version)))))
(t/is (= data res))))
(t/deftest test-migration-8-2
(let [page-id (uuid/custom 0 0)
@ -67,8 +93,7 @@
{:type :path :id (uuid/custom 1 5)}]
data {:pages-index {page-id {:objects (d/index-by :id objects)}}
:components {}
:version 7}
:components {}}
expect (-> data
(update-in [:pages-index page-id :objects] dissoc
@ -80,10 +105,9 @@
(let [id (uuid/custom 1 2)]
(into [] (remove #(= id %)) shapes)))))
res (cpm/migrate-data data 8)]
res (cfm/migrate-data data cfm/migrations 7 8)]
;; (pprint res)
;; (pprint expect)
(t/is (= (dissoc expect :version)
(dissoc res :version)))))
(t/is (= expect res))))

31
frontend/scripts/find-mf-use-fn.sh Executable file
View file

@ -0,0 +1,31 @@
#!/bin/bash
echo -e "\x1B[0;41mmf/use-fn\x1B[0m\n"
#
# Get count of expressions
#
FN_COUNT=$(egrep -rn ":on-.*?\s+\(fn" src/app/main/ui | wc -l)
PARTIAL_COUNT=$(egrep -rn ":on-.*?\s+\(partial" src/app/main/ui | wc -l)
AFN_COUNT=$(egrep -rn ":on-.*?\s+#\(" src/app/main/ui | wc -l)
#
# Show counts
#
echo -e ":on-.*? (fn \x1B[0;31m" $FN_COUNT "\x1B[0m"
echo -e ":on-.*? (partial \x1B[0;31m" $PARTIAL_COUNT "\x1B[0m"
echo -e ":on-.*? #(\x1B[0;31m" $AFN_COUNT "\x1B[0m\n"
echo -e "total: \x1B[0;31m" $((FN_COUNT + PARTIAL_COUNT + AFN_COUNT)) "\x1B[0m\n"
# Show summary or show file list
if [[ $1 == "-s" ]]; then
#
# Files with handlers that don't use mf/use-fn
#
egrep -rn ":on-.*?\s+#?\((fn|partial)" src/app/main/ui | egrep -o "src/app/.*?\.cljs:" | uniq
else
#
# List files with lines
#
egrep -rn ":on-.*?\s+#?\((fn|partial)" src/app/main/ui | egrep -o "src/app/.*?\.cljs:([0-9]+)"
fi

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

@ -227,9 +227,14 @@
(ptk/reify ::login-from-token
ptk/WatchEvent
(watch [_ _ _]
(rx/of (logged-in
(with-meta profile
{::ev/source "login-with-token"}))))))
(->> (rx/of (logged-in (with-meta profile {::ev/source "login-with-token"})))
;; NOTE: we need this to be asynchronous because the effect
;; should be called before proceed with the login process
(rx/observe-on :async)))
ptk/EffectEvent
(effect [_ _ _]
(set-current-team! nil))))
(defn login-from-register
"Event used mainly for mark current session as logged-in in after the
@ -274,6 +279,7 @@
(effect [_ _ _]
;; We prefer to keek some stuff in the storage like the current-team-id and the profile
(swap! storage dissoc :redirect-url)
(set-current-team! nil)
(i18n/reset-locale)))))
(defn logout

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

@ -865,7 +865,7 @@
0)))))
(defn- add-component-for-swap
[shape file-id id-new-component index target-cell keep-props-values]
[shape file-id id-new-component index target-cell keep-props-values {:keys [undo-group]}]
(dm/assert! (uuid? id-new-component))
(dm/assert! (uuid? file-id))
(ptk/reify ::add-component-for-swap
@ -877,6 +877,7 @@
objects (:objects page)
position (gpt/point (:x shape) (:y shape))
changes (-> (pcb/empty-changes it (:id page))
(pcb/set-undo-group undo-group)
(pcb/with-objects objects))
position (-> position (with-meta {:cell target-cell}))
@ -925,10 +926,20 @@
index (find-shape-index objects (:parent-id shape) (:id shape))
;; Store the properties that need to be maintained when the component is swapped
keep-props-values (select-keys shape ctk/swap-keep-attrs)]
(rx/of (dwsh/delete-shapes nil (d/ordered-set (:id shape)) {:component-swap true})
(add-component-for-swap shape file-id id-new-component index target-cell keep-props-values)
(ptk/data-event :layout/update [(:parent-id shape)]))))))
keep-props-values (select-keys shape ctk/swap-keep-attrs)
undo-id (js/Symbol)
undo-group (uuid/next)]
(rx/of
(dwu/start-undo-transaction undo-id)
(dwsh/delete-shapes nil (d/ordered-set (:id shape)) {:component-swap true
:undo-id undo-id
:undo-group undo-group})
(add-component-for-swap shape file-id id-new-component index target-cell keep-props-values
{:undo-group undo-group})
(ptk/data-event :layout/update [(:parent-id shape)])
(dwu/commit-undo-transaction undo-id))))))
(defn component-multi-swap
"Swaps several components with another one"
@ -946,7 +957,6 @@
(rx/of (dwu/commit-undo-transaction undo-id))
(rx/of (dwsp/open-specialized-panel :component-swap)))))))
(def valid-asset-types
#{:colors :components :typographies})
@ -1012,6 +1022,7 @@
(dwlh/generate-sync-library it file-id :colors asset-id library-id state))
(when sync-typographies?
(dwlh/generate-sync-library it file-id :typographies asset-id library-id state))])
file-changes (reduce
pcb/concat-changes
(-> (pcb/empty-changes it)
@ -1025,17 +1036,14 @@
changes (pcb/concat-changes library-changes file-changes)
find-frames (fn [change]
(->> (ch/frames-changed file change)
(map #(assoc %1 :page-id (:page-id change)))))
find-frames (fn [change]
(->> (ch/frames-changed file change)
(map #(assoc %1 :page-id (:page-id change)))))
updated-frames (->> changes
:redo-changes
(mapcat find-frames)
distinct)]
updated-frames (->> changes
:redo-changes
(mapcat find-frames)
distinct)]
(log/debug :msg "SYNC-FILE finished" :js/rchanges (log-changes
(:redo-changes changes)

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

@ -64,6 +64,11 @@
"<local>"
(str "<" (get-in state [:workspace-libraries file-id :name]) ">")))
(defn pretty-uuid
[uuid]
(let [uuid-str (str uuid)]
(subs uuid-str (- (count uuid-str) 6))))
;; ---- Components and instances creation ----
(defn duplicate-component
@ -590,8 +595,14 @@
instance, and all its children, from the given component."
[changes libraries container shape-id reset? components-v2]
(log/debug :msg "Sync shape direct" :shape (str shape-id) :reset? reset?)
(let [shape-inst (ctn/get-shape container shape-id)]
(if (ctk/in-component-copy? shape-inst)
(let [shape-inst (ctn/get-shape container shape-id)
library (dm/get-in libraries [(:component-file shape-inst) :data])
component (or (ctkl/get-component library (:component-id shape-inst))
(and reset?
(ctkl/get-deleted-component library (:component-id shape-inst))))
component-shape (ctn/get-component-shape (:objects container) shape-inst)]
(if (and (ctk/in-component-copy? shape-inst)
(or (= (:id component) (:component-id component-shape)) reset?)) ; In a normal sync, we don't want to sync remote mains, only near
(let [redirect-shaperef (partial redirect-shaperef container libraries)
library (dm/get-in libraries [(:component-file shape-inst) :data])
component (or (ctkl/get-component library (:component-id shape-inst))
@ -1004,7 +1015,10 @@
(defn- add-shape-to-instance
[changes component-shape index component-page container root-instance root-main omit-touched? set-remote-synced?]
(log/info :msg (str "ADD [P] " (:name component-shape)))
(log/info :msg (str "ADD [P " (pretty-uuid (:id container)) "] "
(:name component-shape)
" "
(pretty-uuid (:id component-shape))))
(let [component-parent-shape (ctn/get-shape component-page (:parent-id component-shape))
parent-shape (d/seek #(ctk/is-main-of? component-parent-shape %)
(cfh/get-children-with-self (:objects container)
@ -1075,7 +1089,10 @@
(defn- add-shape-to-main
[changes shape index component component-container page root-instance root-main]
(log/info :msg (str "ADD [C] " (:name shape)))
(log/info :msg (str "ADD [C " (pretty-uuid (:id component-container)) "] "
(:name shape)
" "
(pretty-uuid (:id shape))))
(let [parent-shape (ctn/get-shape page (:parent-id shape))
component-parent-shape (d/seek #(ctk/is-main-of? % parent-shape)
(cfh/get-children-with-self (:objects component-container)
@ -1176,8 +1193,11 @@
(defn- remove-shape
[changes shape container omit-touched?]
(log/info :msg (str "REMOVE-SHAPE "
(if (cfh/page? container) "[P] " "[C] ")
(:name shape)))
(if (cfh/page? container) "[P " "[C ")
(pretty-uuid (:id container)) "] "
(:name shape)
" "
(pretty-uuid (:id shape))))
(let [objects (get container :objects)
parents (cfh/get-parent-ids objects (:id shape))
parent (first parents)
@ -1225,9 +1245,12 @@
(defn- move-shape
[changes shape index-before index-after container omit-touched?]
(log/info :msg (str "MOVE "
(if (cfh/page? container) "[P] " "[C] ")
(if (cfh/page? container) "[P " "[C ")
(pretty-uuid (:id container)) "] "
(:name shape)
" "
(pretty-uuid (:id shape))
" "
index-before
" -> "
index-after))
@ -1263,8 +1286,11 @@
changes
(do
(log/info :msg (str "CHANGE-TOUCHED "
(if (cfh/page? container) "[P] " "[C] ")
(:name dest-shape))
(if (cfh/page? container) "[P " "[C ")
(pretty-uuid (:id container)) "] "
(:name dest-shape)
" "
(pretty-uuid (:id dest-shape)))
:options options)
(let [new-touched (cond
reset-touched?
@ -1298,8 +1324,11 @@
changes
(do
(log/info :msg (str "CHANGE-REMOTE-SYNCED? "
(if (cfh/page? container) "[P] " "[C] ")
(:name shape))
(if (cfh/page? container) "[P " "[C ")
(pretty-uuid (:id container)) "] "
(:name shape)
" "
(pretty-uuid (:id shape)))
:remote-synced remote-synced?)
(-> changes
(update :redo-changes conj (make-change
@ -1327,9 +1356,14 @@
(log/info :msg (str "SYNC "
(:name origin-shape)
" "
(pretty-uuid (:id origin-shape))
" -> "
(if (cfh/page? container) "[P] " "[C] ")
(:name dest-shape)))
(if (cfh/page? container) "[P " "[C ")
(pretty-uuid (:id container)) "] "
(:name dest-shape)
" "
(pretty-uuid (:id dest-shape))))
(let [;; To synchronize geometry attributes we need to make a prior
;; operation, because coordinates are absolute, but we need to

26
frontend/src/app/main/data/workspace/shapes.cljs
View file

@ -137,22 +137,25 @@
ids-to-hide)))))
[ids []])
undo-id (js/Symbol)]
undo-id (or (:undo-id options) (js/Symbol))]
(rx/concat
(rx/of (dwu/start-undo-transaction undo-id)
(update-shape-flags ids-to-hide {:hidden true}))
(real-delete-shapes file page objects ids-to-delete it components-v2 (:component-swap options))
(real-delete-shapes file page objects ids-to-delete it {:components-v2 components-v2
:ignore-touched (:component-swap options)
:undo-group (:undo-group options)})
(rx/of (dwu/commit-undo-transaction undo-id))))))))
(defn- real-delete-shapes-changes
([file page objects ids it components-v2 ignore-touched]
([file page objects ids it {:keys [undo-group] :as options}]
(let [changes (-> (pcb/empty-changes it (:id page))
(pcb/set-undo-group undo-group)
(pcb/with-page page)
(pcb/with-objects objects)
(pcb/with-library-data file))]
(real-delete-shapes-changes changes file page objects ids it components-v2 ignore-touched)))
([changes file page objects ids _it components-v2 ignore-touched]
(real-delete-shapes-changes changes file page objects ids it options)))
([changes file page objects ids _it {:keys [components-v2 ignore-touched]}]
(let [lookup (d/getf objects)
groups-to-unmask
(reduce (fn [group-ids id]
@ -275,12 +278,19 @@
(defn delete-shapes-changes
[changes file page objects ids it components-v2 ignore-touched]
(let [[changes _all-parents] (real-delete-shapes-changes changes file page objects ids it components-v2 ignore-touched)]
(let [[changes _all-parents] (real-delete-shapes-changes changes
file
page
objects
ids
it
{:components-v2 components-v2
:ignore-touched ignore-touched})]
changes))
(defn- real-delete-shapes
[file page objects ids it components-v2 ignore-touched]
(let [[changes all-parents] (real-delete-shapes-changes file page objects ids it components-v2 ignore-touched)
[file page objects ids it options]
(let [[changes all-parents] (real-delete-shapes-changes file page objects ids it options)
undo-id (js/Symbol)]
(rx/of (dwu/start-undo-transaction undo-id)
(dc/detach-comment-thread ids)

2
frontend/src/app/main/ui/auth/verify_token.cljs
View file

@ -25,7 +25,7 @@
(defmethod handle-token :verify-email
[data]
(let [msg (tr "dashboard.notifications.email-verified-successfully")]
(ts/schedule 100 #(st/emit! (dm/success msg)))
(ts/schedule 1000 #(st/emit! (dm/success msg)))
(st/emit! (du/login-from-token data))))
(defmethod handle-token :change-email

73
frontend/src/app/main/ui/components/radio_buttons.cljs
View file

@ -18,26 +18,24 @@
(mf/defc radio-button
{::mf/props :obj}
[props]
(let [context (mf/use-ctx context)
icon (unchecked-get props "icon")
id (unchecked-get props "id")
value (unchecked-get props "value")
disabled (unchecked-get props "disabled")
title (unchecked-get props "title")
unique-key (unchecked-get props "unique-key")
icon-class (unchecked-get props "icon-class")
type (or (unchecked-get props "type")
(if (unchecked-get context "allow-empty")
"checkbox"
"radio"))
[{:keys [icon id value disabled title unique-key icon-class type]}]
(let [context (mf/use-ctx context)
allow-empty (unchecked-get context "allow-empty")
type (if ^boolean type
type
(if ^boolean allow-empty
"checkbox"
"radio"))
on-change (unchecked-get context "on-change")
selected (unchecked-get context "selected")
name (unchecked-get context "name")
on-change (unchecked-get context "on-change")
selected (unchecked-get context "selected")
name (unchecked-get context "name")
encode-fn (unchecked-get context "encode-fn")
checked? (= selected value)
value (encode-fn value)]
encode-fn (unchecked-get context "encode-fn")
checked? (= selected value)]
[:label {:html-for id
:title title
@ -48,33 +46,22 @@
:disabled disabled)}
(if (some? icon)
[:span {:class (when icon-class icon-class)}
icon]
[:span {:class (stl/css :title-name)}
(encode-fn value)])
[:span {:class icon-class} icon]
[:span {:class (stl/css :title-name)} value])
[:input {:id id
:on-change on-change
:type type
:name name
:disabled disabled
:value (encode-fn value)
:value value
:checked checked?}]]))
(mf/defc radio-buttons
{::mf/props :obj}
[props]
(let [children (unchecked-get props "children")
on-change (unchecked-get props "on-change")
selected (unchecked-get props "selected")
name (unchecked-get props "name")
class (unchecked-get props "class")
wide (unchecked-get props "wide")
allow-empty? (unchecked-get props "allow-empty")
encode-fn (d/nilv (unchecked-get props "encode-fn") identity)
decode-fn (d/nilv (unchecked-get props "encode-fn") identity)
[{:keys [children on-change selected class wide encode-fn decode-fn] :as props}]
(let [encode-fn (d/nilv encode-fn identity)
decode-fn (d/nilv decode-fn identity)
nitems (if (array? children)
(alength children)
1)
@ -90,21 +77,17 @@
(mf/use-fn
(mf/deps on-change)
(fn [event]
(let [input-node (dom/get-target event)
(let [input (dom/get-target event)
value (dom/get-target-val event)
value (when (not= value selected) value)]
(when (fn? on-change)
(do (on-change (decode-fn value) event)
(dom/blur! input-node))))))
(on-change (decode-fn value) event)
(dom/blur! input)))))
context-value
(mf/with-memo [selected on-change' name encode-fn decode-fn]
#js {:selected selected
:on-change on-change'
:name name
:encode-fn encode-fn
:decode-fn decode-fn
:allow-empty allow-empty?})]
(mf/spread-obj props {:on-change on-change'
:encode-fn encode-fn
:decode-fn decode-fn})]
[:& (mf/provider context) {:value context-value}
[:div {:class (dm/str class " " (stl/css :radio-btn-wrapper))