Compare commits

...

59 Commits
2.1.1 ... 2.1.4

Author SHA1 Message Date
Alejandro Alonso
689aab32c9 📎 Update changelog 2024-09-03 13:04:04 +02:00
Alejandro Alonso
c642f4afa2 📎 Update version.txt file 2024-09-03 12:52:36 +02:00
Alejandro
a62a083294 Merge pull request #5038 from penpot/palba-add-export-event
🎉 Add export event for telemetry
2024-09-03 12:51:06 +02:00
Pablo Alba
2a13c2ec00 🎉 Add export event for telemetry 2024-09-03 12:03:36 +02:00
Andrey Antukh
bf60bf1848 Merge pull request #5033 from penpot/superalex-revert-test-default-theme
Revert "🎉 Test A/B for starting with light theme"
2024-08-29 11:42:04 +02:00
Andrey Antukh
c581395df2 Merge pull request #5034 from penpot/superalex-track-copy-shared-link-event
 Track copy shared link event
2024-08-29 10:26:34 +02:00
Alejandro Alonso
8a44fb689a 🐛 Fix create share link name 2024-08-29 10:25:08 +02:00
Alejandro Alonso
9fd36526ef Track copy shared link event 2024-08-29 10:25:08 +02:00
Alejandro Alonso
78f4d9cc5d 🎉 Revert test A/B for starting with light theme
This reverts commit b0af94415f.
2024-08-28 13:00:43 +02:00
Alejandro
bd2a3e197a Merge pull request #5032 from penpot/niwinz-backports-1
🐛 Backport several bugfixes from develop
2024-08-28 12:49:16 +02:00
Andrey Antukh
cc98ac5853 🐛 Fix json encoding on zip encoding decoding 2024-08-28 10:43:47 +02:00
Andrey Antukh
05750c3b38 🐛 Add schema validation for color changes 2024-08-28 10:43:47 +02:00
Andrey Antukh
3ddecef5a7 Ensure plain map on path params in several functions 2024-08-28 10:31:22 +02:00
Andrey Antukh
7fd96a0533 🎉 Backport app.common.json namespace from develop 2024-08-28 10:30:11 +02:00
Andrey Antukh
f73e5446ab Merge pull request #5016 from penpot/superalex-bug-render-texts-without-position-data
🐛 Fix render of some texts without position data
2024-08-22 15:43:50 +02:00
Alejandro Alonso
df255b5a6f 🐛 Fix render of some texts without position data 2024-08-22 15:24:13 +02:00
Alejandro
de05521b57 Merge pull request #5001 from penpot/superalex-fix-deleted-fonts
🐛 Fix deleted fonts on file load
2024-08-20 13:13:48 +02:00
Alejandro Alonso
c86afca1d0 🐛 Fix deleted fonts on file load 2024-08-20 13:00:18 +02:00
Andrey Antukh
5617ca24b8 Merge pull request #5008 from penpot/superalex-improve-disabled-registry-flows
 Improve disabled registry flows
2024-08-20 10:11:20 +02:00
Alejandro Alonso
cd51f2f652 Improve disabled registry flows 2024-08-20 08:20:46 +02:00
Pablo Alba
00bb988ecc Merge pull request #5007 from penpot/superalex-a-b-remove-testing-signup-01
 Add a/b remove testing for signup image
2024-08-19 10:49:32 +02:00
Alejandro Alonso
5efc56eb5a Revert " Add a/b testing for signup image"
This reverts commit 5ac6f04857.
2024-08-19 10:22:01 +02:00
Alejandro
0ccae600bc Merge pull request #5000 from penpot/palba-default-light
🎉 Test A/B for starting with light theme
2024-08-19 08:57:10 +02:00
Pablo Alba
b0af94415f 🎉 Test A/B for starting with light theme 2024-08-19 08:20:31 +02:00
Andrey Antukh
380ead2ad6 Merge pull request #4994 from penpot/superalex-make-explicit-test-openldap-devenv-docker-ulimits
 Make explicit test-openldap devenv docker ulimits
2024-08-14 12:57:09 +02:00
Alejandro Alonso
3df45d697d Make explicit test-openldap devenv docker ulimits 2024-08-14 11:07:00 +02:00
Alejandro
efb70f0b97 Merge pull request #4985 from penpot/niwinz-hotfix-2
🐛 Disable ipv6 from docker nginx resolver.
2024-08-14 10:50:26 +02:00
Alejandro
924c1d60f9 Merge pull request #4990 from penpot/niwinz-hotfix-5
🐛 Update storage specs
2024-08-13 12:47:24 +02:00
Andrey Antukh
6b80f19e5f 🐛 Update storage specs 2024-08-13 12:21:16 +02:00
Alejandro
000d2c3935 Merge pull request #4989 from penpot/niwinz-hotfix-3
🐛 Backport  storage changes from develop
2024-08-13 11:26:49 +02:00
Andrey Antukh
91435bf372 🐛 Backport storage backend naming changes from develop
for properly handle backward comaptibility when two
versions are running over a single database
2024-08-13 11:14:38 +02:00
Alejandro
ea5c22c244 Merge pull request #4983 from penpot/niwinz-backports-1
🐛 Backport bugfixes from develop
2024-08-13 08:25:10 +02:00
Andrey Antukh
e07c1bba7a 🐛 Disable ipv6 from docker nginx resolver 2024-08-12 16:22:19 +02:00
Andrey Antukh
ec56a4149b 🐛 Fix unhandled exception on try to reuse registration token 2024-08-12 12:59:18 +02:00
Andrey Antukh
314742a563 Add :params prop to :not-found exception 2024-08-12 12:59:18 +02:00
Andrey Antukh
38c9e3e7cc 🐛 Fix error handling issue on login with oidc
happens when no oidc backend is configured on backend
2024-08-12 12:59:18 +02:00
Andrey Antukh
2533d0ebc0 Add naming consistency changes for file_data_fragment table 2024-08-08 07:42:17 +02:00
Andrey Antukh
a1c78683f5 📎 Update version.txt file 2024-08-07 10:57:51 +02:00
Alejandro
4fe77ca386 Merge pull request #4963 from penpot/niwinz-oidc-fixes-2
🐛 Fix OIDC issues and regressions
2024-08-06 12:02:02 +02:00
Andrey Antukh
ea7ad2aaa0 Add flag oidc-registration for switch on/off registration with oidc 2024-08-06 11:51:26 +02:00
Julian Schacher
0162451205 Revert "🐛 Set proper default tenant on exporter"
This reverts commit 86b2ce4dab.
2024-08-06 10:15:21 +02:00
Andrey Antukh
82ad240053 Merge pull request #4960 from penpot/superalex-fix-custom-smtp-port-with-ssl-enabled
🐛 Fix custom smtp port with ssl enabled
2024-08-05 13:01:17 +02:00
Alejandro Alonso
aa21430a5c 🐛 Fix custom smtp port with ssl enabled 2024-08-05 12:45:05 +02:00
Andrey Antukh
aa4368f97f Merge pull request #4959 from penpot/superalex-fix-user-language-validator
🐛 Fix user language validator
2024-08-05 12:35:32 +02:00
Alejandro Alonso
8eddcd64f1 🐛 Fix user language validator 2024-08-05 11:05:56 +02:00
Pablo Alba
fcf9444b1d Merge pull request #4948 from penpot/superalex-a-b-testing-signup-01
 Add a/b testing for signup image
2024-08-01 10:28:43 +02:00
Alejandro Alonso
5ac6f04857 Add a/b testing for signup image 2024-07-31 13:04:12 +02:00
Alejandro
b4d91b5a48 Merge pull request #4937 from penpot/niwinz-fix-email-complains-handling
 Add improvements to internal sns handler
2024-07-31 12:18:01 +02:00
Andrey Antukh
52425a993a 🐛 Check complaints reports in the same way as bounces are checked 2024-07-31 12:02:42 +02:00
Alejandro
e72e812166 Merge pull request #4943 from penpot/niwinz-temporal-log
 Add temporal log entry for profile insert conflict
2024-07-31 10:45:48 +02:00
Pablo Alba
65a00aa13f Merge pull request #4931 from penpot/hiru-fix-touched-detach
🐛 Fix touched groups when detaching with nested copies
2024-07-31 09:46:16 +02:00
Andrey Antukh
acc0623219 Add temporal log entry for profile insert conflict 2024-07-30 16:46:38 +02:00
Andrés Moya
990a948bcc 🐛 Fix touched groups when detaching with nested copies 2024-07-30 14:28:37 +02:00
Andrey Antukh
e0f2c4e0aa Add the ability to pass body to a log entry 2024-07-29 16:16:39 +02:00
Alejandro
4b6d3546e0 Merge pull request #4926 from penpot/niwinz-fix-error-report
🐛 Fix regression on error reporting
2024-07-26 08:27:37 +02:00
Alejandro
0bd3d80816 Merge pull request #4925 from penpot/niwinz-resolve-thumbnail-on-frontend
 Resolve file thumbnail on frontend instead of backend
2024-07-26 08:24:29 +02:00
Andrey Antukh
a261a57868 Prevent double error asignation on persistence error 2024-07-25 17:17:49 +02:00
Andrey Antukh
af389fe63a 🐛 Fix error reporting regression 2024-07-25 17:17:49 +02:00
Andrey Antukh
defcef3e59 Resolve file thumbnail on frontend instead of backend 2024-07-25 15:17:41 +02:00
71 changed files with 1164 additions and 651 deletions

View File

@@ -1,5 +1,27 @@
# CHANGELOG
## 2.1.4
### :bug: Bugs fixed
- Fix json encoding on zip encoding decoding.
- Add schema validation for color changes.
- Fix render of some texts without position data.
## 2.1.3
### :bug: Bugs fixed
- Don't allow registry with email and password, if password login is disabled (invitation workflow) [Github #4975](https://github.com/penpot/penpot/issues/4975)
## 2.1.2
### :bug: Bugs fixed
- User switch language to "zh_hant" will get 400 [Github #4884](https://github.com/penpot/penpot/issues/4884)
- Smtp config ignoring port if ssl is set [Github #4872](https://github.com/penpot/penpot/issues/4872)
- Ability to let users to authenticate with a private oidc provider only [Github #4963](https://github.com/penpot/penpot/issues/4963)
## 2.1.1
### :sparkles: New features

View File

@@ -592,7 +592,8 @@
:else
(let [info (assoc info :is-active (provider-has-email-verified? cfg info))]
(if (contains? cf/flags :registration)
(if (or (contains? cf/flags :registration)
(contains? cf/flags :oidc-registration))
(redirect-to-register cfg info request)
(redirect-with-error "registration-disabled")))))

View File

@@ -407,6 +407,7 @@
(ex/raise :type :not-found
:code :object-not-found
:table table
:params params
:hint "database object not found"))
row))

View File

@@ -306,6 +306,8 @@
(let [session (create-smtp-session cfg)]
(with-open [transport (.getTransport session (if (::ssl cfg) "smtps" "smtp"))]
(.connect ^Transport transport
^String (::host cfg)
^String (::port cfg)
^String (::username cfg)
^String (::password cfg))
@@ -448,3 +450,11 @@
{:email email :type "bounce"}
{:limit 10}))]
(>= (count reports) threshold))))
(defn has-reports?
([conn email] (has-reports? conn email nil))
([conn email {:keys [threshold] :or {threshold 1}}]
(let [reports (db/exec! conn (sql/select :global-complaint-report
{:email email}
{:limit 10}))]
(>= (count reports) threshold))))

View File

@@ -58,28 +58,26 @@
(defn load-pointer
"A database loader pointer helper"
[system file-id id]
(let [{:keys [content]} (db/get system :file-data-fragment
{:id id :file-id file-id}
{::sql/columns [:content]
::db/check-deleted false})]
(let [fragment (db/get* system :file-data-fragment
{:id id :file-id file-id}
{::sql/columns [:data]})]
(l/trc :hint "load pointer"
:file-id (str file-id)
:id (str id)
:found (some? content))
:found (some? fragment))
(when-not content
(when-not fragment
(ex/raise :type :internal
:code :fragment-not-found
:hint "fragment not found"
:file-id file-id
:fragment-id id))
(blob/decode content)))
(blob/decode (:data fragment))))
(defn persist-pointers!
"Given a database connection and the final file-id, persist all
pointers to the underlying storage (the database)."
"Persist all currently tracked pointer objects"
[system file-id]
(let [conn (db/get-connection system)]
(doseq [[id item] @pmap/*tracked*]
@@ -89,7 +87,7 @@
(db/insert! conn :file-data-fragment
{:id id
:file-id file-id
:content content}))))))
:data content}))))))
(defn process-pointers
"Apply a function to all pointers on the file. Usuly used for

View File

@@ -150,8 +150,8 @@
[["" {:middleware [[mw/server-timing]
[mw/params]
[mw/format-response]
[mw/errors errors/handle]
[mw/parse-request]
[mw/errors errors/handle]
[session/soft-auth cfg]
[actoken/soft-auth cfg]
[mw/restrict-methods]]}

View File

@@ -9,6 +9,7 @@
(:require
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.pprint :as pp]
[app.db :as db]
[app.db.sql :as sql]
[app.http.client :as http]
@@ -16,10 +17,10 @@
[app.setup :as-alias setup]
[app.tokens :as tokens]
[app.worker :as-alias wrk]
[clojure.data.json :as j]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[integrant.core :as ig]
[jsonista.core :as j]
[promesa.exec :as px]
[ring.request :as rreq]
[ring.response :as-alias rres]))
@@ -136,83 +137,110 @@
(defn- parse-json
[v]
(ex/ignoring
(j/read-value v)))
(try
(j/read-str v)
(catch Throwable cause
(l/wrn :hint "unable to decode request body"
:cause cause))))
(defn- register-bounce-for-profile
[{:keys [::db/pool]} {:keys [type kind profile-id] :as report}]
(when (= kind "permanent")
(db/with-atomic [conn pool]
(db/insert! conn :profile-complaint-report
(try
(db/insert! pool :profile-complaint-report
{:profile-id profile-id
:type (name type)
:content (db/tjson report)})
;; TODO: maybe also try to find profiles by mail and if exists
;; register profile reports for them?
(doseq [recipient (:recipients report)]
(db/insert! conn :global-complaint-report
{:email (:email recipient)
:type (name type)
:content (db/tjson report)}))
(catch Throwable cause
(l/warn :hint "unable to persist profile complaint"
:cause cause)))
(let [profile (db/exec-one! conn (sql/select :profile {:id profile-id}))]
(when (some #(= (:email profile) (:email %)) (:recipients report))
;; If the report matches the profile email, this means that
;; the report is for itself, can be caused when a user
;; registers with an invalid email or the user email is
;; permanently rejecting receiving the email. In this case we
;; have no option to mark the user as muted (and in this case
;; the profile will be also inactive.
(db/update! conn :profile
{:is-muted true}
{:id profile-id}))))))
(defn- register-complaint-for-profile
[{:keys [::db/pool]} {:keys [type profile-id] :as report}]
(db/with-atomic [conn pool]
(db/insert! conn :profile-complaint-report
{:profile-id profile-id
:type (name type)
:content (db/tjson report)})
;; TODO: maybe also try to find profiles by email and if exists
;; register profile reports for them?
(doseq [email (:recipients report)]
(db/insert! conn :global-complaint-report
{:email email
(doseq [recipient (:recipients report)]
(db/insert! pool :global-complaint-report
{:email (:email recipient)
:type (name type)
:content (db/tjson report)}))
(let [profile (db/exec-one! conn (sql/select :profile {:id profile-id}))]
(when (some #(= % (:email profile)) (:recipients report))
(let [profile (db/exec-one! pool (sql/select :profile {:id profile-id}))]
(when (some #(= (:email profile) (:email %)) (:recipients report))
;; If the report matches the profile email, this means that
;; the report is for itself, rare case but can happen; In this
;; case just mark profile as muted (very rare case).
(db/update! conn :profile
;; the report is for itself, can be caused when a user
;; registers with an invalid email or the user email is
;; permanently rejecting receiving the email. In this case we
;; have no option to mark the user as muted (and in this case
;; the profile will be also inactive.
(l/inf :hint "mark profile: muted"
:profile-id (str (:id profile))
:email (:email profile)
:reason "bounce report"
:report-id (:feedback-id report))
(db/update! pool :profile
{:is-muted true}
{:id profile-id})))))
{:id profile-id}
{::db/return-keys false})))))
(defn- register-complaint-for-profile
[{:keys [::db/pool]} {:keys [type profile-id] :as report}]
(try
(db/insert! pool :profile-complaint-report
{:profile-id profile-id
:type (name type)
:content (db/tjson report)})
(catch Throwable cause
(l/warn :hint "unable to persist profile complaint"
:cause cause)))
;; TODO: maybe also try to find profiles by email and if exists
;; register profile reports for them?
(doseq [email (:recipients report)]
(db/insert! pool :global-complaint-report
{:email email
:type (name type)
:content (db/tjson report)}))
(let [profile (db/exec-one! pool (sql/select :profile {:id profile-id}))]
(when (some #(= % (:email profile)) (:recipients report))
;; If the report matches the profile email, this means that
;; the report is for itself, rare case but can happen; In this
;; case just mark profile as muted (very rare case).
(l/inf :hint "mark profile: muted"
:profile-id (str (:id profile))
:email (:email profile)
:reason "complaint report"
:report-id (:feedback-id report))
(db/update! pool :profile
{:is-muted true}
{:id profile-id}
{::db/return-keys false}))))
(defn- process-report
[cfg {:keys [type profile-id] :as report}]
(l/trace :action "processing report" :report (pr-str report))
(cond
;; In this case we receive a bounce/complaint notification without
;; confirmed identity, we just emit a warning but do nothing about
;; it because this is not a normal case. All notifications should
;; come with profile identity.
(nil? profile-id)
(l/warn :msg "a notification without identity received from AWS"
:report (pr-str report))
(l/wrn :hint "not-identified report"
::l/body (pp/pprint-str report {:length 40 :level 6}))
(= "bounce" type)
(register-bounce-for-profile cfg report)
(do
(l/trc :hint "bounce report"
::l/body (pp/pprint-str report {:length 40 :level 6}))
(register-bounce-for-profile cfg report))
(= "complaint" type)
(register-complaint-for-profile cfg report)
(do
(l/trc :hint "complaint report"
::l/body (pp/pprint-str report {:length 40 :level 6}))
(register-complaint-for-profile cfg report))
:else
(l/warn :msg "unrecognized report received from AWS"
:report (pr-str report))))
(l/wrn :hint "unrecognized report"
::l/body (pp/pprint-str report {:length 20 :level 4}))))

View File

@@ -14,32 +14,28 @@
[app.http :as-alias http]
[app.http.access-token :as-alias actoken]
[app.http.session :as-alias session]
[app.util.inet :as inet]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]
[ring.request :as rreq]
[ring.response :as rres]))
(defn- parse-client-ip
[request]
(or (some-> (rreq/get-header request "x-forwarded-for") (str/split ",") first)
(rreq/get-header request "x-real-ip")
(rreq/remote-addr request)))
(defn request->context
"Extracts error report relevant context data from request."
[request]
(let [claims (-> {}
(into (::session/token-claims request))
(into (::actoken/token-claims request)))]
{:request/path (:path request)
:request/method (:method request)
:request/params (:params request)
:request/user-agent (rreq/get-header request "user-agent")
:request/ip-addr (parse-client-ip request)
:request/ip-addr (inet/parse-request request)
:request/profile-id (:uid claims)
:version/frontend (or (rreq/get-header request "x-frontend-version") "unknown")
:version/backend (:full cf/version)}))
(defmulti handle-error
(fn [cause _ _]
(-> cause ex-data :type)))

View File

@@ -10,6 +10,7 @@
[app.common.logging :as l]
[app.common.transit :as t]
[app.config :as cf]
[app.http.errors :as errors]
[clojure.data.json :as json]
[cuerdas.core :as str]
[ring.request :as rreq]
@@ -70,12 +71,12 @@
:else
request)))
(handle-error [cause]
(handle-error [cause request]
(cond
(instance? RuntimeException cause)
(if-let [cause (ex-cause cause)]
(handle-error cause)
(throw cause))
(handle-error cause request)
(errors/handle cause request))
(instance? RequestTooBigException cause)
(ex/raise :type :validation
@@ -89,14 +90,14 @@
:cause cause)
:else
(throw cause)))]
(errors/handle cause request)))]
(fn [request]
(if (= (rreq/method request) :post)
(let [request (ex/try! (process-request request))]
(if (ex/exception? request)
(handle-error request)
(handler request)))
(try
(-> request process-request handler)
(catch Throwable cause
(handle-error cause request)))
(handler request)))))
(def parse-request

View File

@@ -449,7 +449,9 @@
{::db/pool (ig/ref ::db/pool)
::sto/backends
{:assets-s3 (ig/ref [::assets :app.storage.s3/backend])
:assets-fs (ig/ref [::assets :app.storage.fs/backend])}}
:assets-fs (ig/ref [::assets :app.storage.fs/backend])
:s3 (ig/ref [::assets :app.storage.s3/backend])
:fs (ig/ref [::assets :app.storage.fs/backend])}}
[::assets :app.storage.s3/backend]
{::sto.s3/region (cf/get :storage-assets-s3-region)

View File

@@ -379,7 +379,10 @@
:fn (mg/resource "app/migrations/sql/0119-mod-file-table.sql")}
{:name "0120-mod-audit-log-table"
:fn (mg/resource "app/migrations/sql/0120-mod-audit-log-table.sql")}])
:fn (mg/resource "app/migrations/sql/0120-mod-audit-log-table.sql")}
{:name "0121-mod-file-data-fragment-table"
:fn (mg/resource "app/migrations/sql/0121-mod-file-data-fragment-table.sql")}])
(defn apply-migrations!
[pool name migrations]

View File

@@ -0,0 +1,8 @@
ALTER TABLE file_data_fragment
ADD COLUMN data bytea NULL;
UPDATE file_data_fragment
SET data = content;
ALTER TABLE file_data_fragment
DROP COLUMN content;

View File

@@ -180,10 +180,11 @@
(defn- validate-register-attempt!
[cfg params]
(when-not (contains? cf/flags :registration)
(when-not (contains? params :invitation-token)
(ex/raise :type :restriction
:code :registration-disabled)))
(when (or
(not (contains? cf/flags :registration))
(not (contains? cf/flags :login-with-password)))
(ex/raise :type :restriction
:code :registration-disabled))
(when (contains? params :invitation-token)
(let [invitation (tokens/verify (::setup/props cfg)
@@ -209,7 +210,19 @@
(str/lower (:password params)))
(ex/raise :type :validation
:code :email-as-password
:hint "you can't use your email as password")))
:hint "you can't use your email as password"))
(when (eml/has-bounce-reports? cfg (:email params))
(ex/raise :type :restriction
:code :email-has-permanent-bounces
:email (:email params)
:hint "looks like the email has bounce reports"))
(when (eml/has-complaint-reports? cfg (:email params))
(ex/raise :type :restriction
:code :email-has-complaints
:email (:email params)
:hint "looks like the email has complaint reports")))
(defn prepare-register
[{:keys [::db/pool] :as cfg} {:keys [email] :as params}]
@@ -270,6 +283,7 @@
is-demo (:is-demo params false)
is-muted (:is-muted params false)
is-active (:is-active params false)
theme (:theme params nil)
email (str/lower email)
params {:id id
@@ -280,20 +294,24 @@
:password password
:deleted-at (:deleted-at params)
:props props
:theme theme
:is-active is-active
:is-muted is-muted
:is-demo is-demo}]
(try
(-> (db/insert! conn :profile params)
(profile/decode-row))
(catch org.postgresql.util.PSQLException e
(let [state (.getSQLState e)]
(catch org.postgresql.util.PSQLException cause
(let [state (.getSQLState cause)]
(if (not= state "23505")
(throw e)
(ex/raise :type :validation
:code :email-already-exists
:hint "email already exists"
:cause e)))))))
(throw cause)
(do
(l/error :hint "not an error" :cause cause)
(ex/raise :type :validation
:code :email-already-exists
:hint "email already exists"
:cause cause))))))))
(defn create-profile-rels!
[conn {:keys [id] :as profile}]
@@ -332,24 +350,32 @@
:extra-data ptoken})))
(defn register-profile
[{:keys [::db/conn] :as cfg} {:keys [token fullname] :as params}]
(let [claims (tokens/verify (::setup/props cfg) {:token token :iss :prepared-register})
[{:keys [::db/conn] :as cfg} {:keys [token fullname theme] :as params}]
(let [theme (when (= theme "light") theme)
claims (tokens/verify (::setup/props cfg) {:token token :iss :prepared-register})
params (-> claims
(into params)
(assoc :fullname fullname))
(assoc :fullname fullname)
(assoc :theme theme))
profile (if-let [profile-id (:profile-id claims)]
(profile/get-profile conn profile-id)
(let [is-active (or (boolean (:is-active claims))
(not (contains? cf/flags :email-verification)))
params (-> params
(assoc :is-active is-active)
(update :password #(profile/derive-password cfg %)))]
(->> (create-profile! conn params)
(create-profile-rels! conn))))
;; NOTE: we first try to match existing profile
;; by email, that in normal circumstances will
;; not return anything, but when a user tries to
;; reuse the same token multiple times, we need
;; to detect if the profile is already registered
(or (profile/get-profile-by-email conn (:email claims))
(let [is-active (or (boolean (:is-active claims))
(not (contains? cf/flags :email-verification)))
params (-> params
(assoc :is-active is-active)
(update :password #(profile/derive-password cfg %)))
profile (->> (create-profile! conn params)
(create-profile-rels! conn))]
(vary-meta profile assoc :created true))))
;; When no profile-id comes on claims means a new register
created? (not (:profile-id claims))
created? (-> profile meta :created true?)
invitation (when-let [token (:invitation-token params)]
(tokens/verify (::setup/props cfg) {:token token :iss :team-invitation}))
@@ -398,7 +424,9 @@
::audit/profile-id (:id profile)}))
(do
(send-email-verification! cfg profile)
(when-not (eml/has-reports? conn (:email profile))
(send-email-verification! cfg profile))
(rph/with-meta {:email (:email profile)}
{::audit/replace-props props
::audit/context {:action "email-verification"}
@@ -406,9 +434,9 @@
:else
(let [elapsed? (elapsed-verify-threshold? profile)
bounce? (eml/has-bounce-reports? conn (:email profile))
action (if bounce?
"ignore-because-bounce"
reports? (eml/has-reports? conn (:email profile))
action (if reports?
"ignore-because-complaints"
(if elapsed?
"resend-email-verification"
"ignore"))]
@@ -433,7 +461,8 @@
(def schema:register-profile
[:map {:title "register-profile"}
[:token schema:token]
[:fullname [::sm/word-string {:max 100}]]])
[:fullname [::sm/word-string {:max 100}]]
[:theme {:optional true} [:string {:max 10}]]])
(sv/defmethod ::register-profile
{::rpc/auth false
@@ -446,7 +475,7 @@
;; ---- COMMAND: Request Profile Recovery
(defn- request-profile-recovery
[{:keys [::db/pool] :as cfg} {:keys [email] :as params}]
[{:keys [::db/conn] :as cfg} {:keys [email] :as params}]
(letfn [(create-recovery-token [{:keys [id] :as profile}]
(let [token (tokens/generate (::setup/props cfg)
{:iss :password-recovery
@@ -468,39 +497,42 @@
:extra-data ptoken})
nil))]
(db/with-atomic [conn pool]
(let [profile (->> (profile/clean-email email)
(profile/get-profile-by-email conn))]
(let [profile (->> (profile/clean-email email)
(profile/get-profile-by-email conn))]
(cond
(not profile)
(l/wrn :hint "attempt of profile recovery: no profile found"
:profile-email email)
(cond
(not profile)
(l/wrn :hint "attempt of profile recovery: no profile found"
:profile-email email)
(not (eml/allow-send-emails? conn profile))
(l/wrn :hint "attempt of profile recovery: profile is muted"
:profile-id (str (:id profile))
:profile-email (:email profile))
(not (eml/allow-send-emails? conn profile))
(l/wrn :hint "attempt of profile recovery: profile is muted"
:profile-id (str (:id profile))
:profile-email (:email profile))
(eml/has-bounce-reports? conn (:email profile))
(l/wrn :hint "attempt of profile recovery: email has bounces"
:profile-id (str (:id profile))
:profile-email (:email profile))
(eml/has-bounce-reports? conn (:email profile))
(l/wrn :hint "attempt of profile recovery: email has bounces"
:profile-id (str (:id profile))
:profile-email (:email profile))
(not (elapsed-verify-threshold? profile))
(l/wrn :hint "attempt of profile recovery: retry attempt threshold not elapsed"
:profile-id (str (:id profile))
:profile-email (:email profile))
(eml/has-complaint-reports? conn (:email profile))
(l/wrn :hint "attempt of profile recovery: email has complaints"
:profile-id (str (:id profile))
:profile-email (:email profile))
(not (elapsed-verify-threshold? profile))
(l/wrn :hint "attempt of profile recovery: retry attempt threshold not elapsed"
:profile-id (str (:id profile))
:profile-email (:email profile))
:else
(do
(db/update! conn :profile
{:modified-at (dt/now)}
{:id (:id profile)})
(->> profile
(create-recovery-token)
(send-email-notification conn))))))))
:else
(do
(db/update! conn :profile
{:modified-at (dt/now)}
{:id (:id profile)})
(->> profile
(create-recovery-token)
(send-email-notification conn)))))))
(def schema:request-profile-recovery
@@ -512,6 +544,6 @@
::doc/added "1.15"
::sm/params schema:request-profile-recovery}
[cfg params]
(request-profile-recovery cfg params))
(db/tx-run! cfg request-profile-recovery params))

View File

@@ -341,9 +341,9 @@
[:share-id {:optional true} ::sm/uuid]])
(defn- get-file-fragment
[conn file-id fragment-id]
(some-> (db/get conn :file-data-fragment {:file-id file-id :id fragment-id})
(update :content blob/decode)))
[cfg file-id fragment-id]
(some-> (db/get cfg :file-data-fragment {:file-id file-id :id fragment-id})
(update :data blob/decode)))
(sv/defmethod ::get-file-fragment
"Retrieve a file fragment by its ID. Only authenticated users."
@@ -351,12 +351,12 @@
::rpc/auth false
::sm/params schema:get-file-fragment
::sm/result schema:file-fragment}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id fragment-id share-id]}]
(dm/with-open [conn (db/open pool)]
(let [perms (get-permissions conn profile-id file-id share-id)]
(check-read-permissions! perms)
(-> (get-file-fragment conn file-id fragment-id)
(rph/with-http-cache long-cache-duration)))))
[cfg {:keys [::rpc/profile-id file-id fragment-id share-id]}]
(db/run! cfg (fn [cfg]
(let [perms (get-permissions cfg profile-id file-id share-id)]
(check-read-permissions! perms)
(-> (get-file-fragment cfg file-id fragment-id)
(rph/with-http-cache long-cache-duration))))))
;; --- COMMAND QUERY: get-project-files
@@ -671,7 +671,7 @@
f.modified_at,
f.name,
f.is_shared,
ft.media_id,
ft.media_id AS thumbnail_id,
row_number() over w as row_num
from file as f
inner join project as p on (p.id = f.project_id)
@@ -690,10 +690,8 @@
[conn team-id]
(->> (db/exec! conn [sql:team-recent-files team-id])
(mapv (fn [row]
(if-let [media-id (:media-id row)]
(-> row
(dissoc :media-id)
(assoc :thumbnail-uri (resolve-public-uri media-id)))
(if-let [media-id (:thumbnail-id row)]
(assoc row :thumbnail-uri (resolve-public-uri media-id))
(dissoc row :media-id))))))
(def ^:private schema:get-team-recent-files

View File

@@ -406,4 +406,5 @@
(when-not (db/read-only? conn)
(let [cfg (update cfg ::sto/storage media/configure-assets-storage)
media (create-file-thumbnail! cfg params)]
{:uri (files/resolve-public-uri (:id media))})))))
{:uri (files/resolve-public-uri (:id media))
:id (:id media)})))))

View File

@@ -102,7 +102,7 @@
(sm/define
[:map {:title "update-profile"}
[:fullname [::sm/word-string {:max 250}]]
[:lang {:optional true} [:string {:max 5}]]
[:lang {:optional true} [:string {:max 8}]]
[:theme {:optional true} [:string {:max 250}]]]))
(sv/defmethod ::update-profile
@@ -276,19 +276,19 @@
(sv/defmethod ::request-email-change
{::doc/added "1.0"
::sm/params schema:request-email-change}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id email] :as params}]
(db/with-atomic [conn pool]
(let [profile (db/get-by-id conn :profile profile-id)
cfg (assoc cfg ::conn conn)
params (assoc params
:profile profile
:email (clean-email email))]
(if (contains? cf/flags :smtp)
(request-email-change! cfg params)
(change-email-immediately! cfg params)))))
[cfg {:keys [::rpc/profile-id email] :as params}]
(db/tx-run! cfg
(fn [cfg]
(let [profile (db/get-by-id cfg :profile profile-id)
params (assoc params
:profile profile
:email (clean-email email))]
(if (contains? cf/flags :smtp)
(request-email-change! cfg params)
(change-email-immediately! cfg params))))))
(defn- change-email-immediately!
[{:keys [::conn]} {:keys [profile email] :as params}]
[{:keys [::db/conn]} {:keys [profile email] :as params}]
(when (not= email (:email profile))
(check-profile-existence! conn params))
@@ -299,7 +299,7 @@
{:changed true})
(defn- request-email-change!
[{:keys [::conn] :as cfg} {:keys [profile email] :as params}]
[{:keys [::db/conn] :as cfg} {:keys [profile email] :as params}]
(let [token (tokens/generate (::setup/props cfg)
{:iss :change-email
:exp (dt/in-future "15m")
@@ -319,9 +319,28 @@
:hint "looks like the profile has reported repeatedly as spam or has permanent bounces."))
(when (eml/has-bounce-reports? conn email)
(ex/raise :type :validation
(ex/raise :type :restriction
:code :email-has-permanent-bounces
:hint "looks like the email you invite has been repeatedly reported as spam or permanent bounce"))
:email email
:hint "looks like the email has bounce reports"))
(when (eml/has-complaint-reports? conn email)
(ex/raise :type :restriction
:code :email-has-complaints
:email email
:hint "looks like the email has spam complaint reports"))
(when (eml/has-bounce-reports? conn (:email profile))
(ex/raise :type :restriction
:code :email-has-permanent-bounces
:email (:email profile)
:hint "looks like the email has bounce reports"))
(when (eml/has-complaint-reports? conn (:email profile))
(ex/raise :type :restriction
:code :email-has-complaints
:email (:email profile)
:hint "looks like the email has spam complaint reports"))
(eml/send! {::eml/conn conn
::eml/factory eml/change-email

View File

@@ -734,12 +734,19 @@
:email email
:hint "the profile has reported repeatedly as spam or has bounces"))
;; Secondly check if the invited member email is part of the global spam/bounce report.
;; Secondly check if the invited member email is part of the global bounce report.
(when (eml/has-bounce-reports? conn email)
(ex/raise :type :validation
(ex/raise :type :restriction
:code :email-has-permanent-bounces
:email email
:hint "the email you invite has been repeatedly reported as spam or bounce"))
:hint "the email you invite has been repeatedly reported as bounce"))
;; Secondly check if the invited member email is part of the global complain report.
(when (eml/has-complaint-reports? conn email)
(ex/raise :type :restriction
:code :email-has-complaints
:email email
:hint "the email you invite has been repeatedly reported as spam"))
;; When we have email verification disabled and invitation user is
;; already present in the database, we proceed to add it to the

View File

@@ -8,6 +8,7 @@
(:require
[app.common.exceptions :as ex]
[app.common.spec :as us]
[app.config :as cf]
[app.db :as db]
[app.db.sql :as-alias sql]
[app.http.session :as session]
@@ -152,11 +153,12 @@
(us/verify! ::team-invitation-claims claims)
(let [invitation (db/get* conn :team-invitation
{:team-id team-id :email-to member-email})
profile (db/get* conn :profile
{:id profile-id}
{:columns [:id :email]})]
(let [invitation (db/get* conn :team-invitation
{:team-id team-id :email-to member-email})
profile (db/get* conn :profile
{:id profile-id}
{:columns [:id :email]})
registration-disabled? (not (contains? cf/flags :registration))]
(when (nil? invitation)
(ex/raise :type :validation
:code :invalid-token
@@ -185,12 +187,12 @@
:hint "logged-in user does not matches the invitation"))
;; If we have not logged-in user, and invitation comes with member-id we
;; redirect user to login, if no memeber-id is present in the invitation
;; token, we redirect user the the register page.
;; redirect user to login, if no memeber-id is present and in the invitation
;; token and registration is enabled, we redirect user the the register page.
{:invitation-token token
:iss :team-invitation
:redirect-to (if member-id :auth-login :auth-register)
:redirect-to (if (or member-id registration-disabled?) :auth-login :auth-register)
:state :pending})))
;; --- Default

View File

@@ -27,7 +27,7 @@
;; Storage Module State
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(s/def ::id #{:assets-fs :assets-s3})
(s/def ::id #{:assets-fs :assets-s3 :s3 :fs})
(s/def ::s3 ::ss3/backend)
(s/def ::fs ::sfs/backend)
(s/def ::type #{:fs :s3})

View File

@@ -505,6 +505,54 @@
(t/is (nil? (:error out)))
(t/is (= 0 (:call-count @mock))))))))
(t/deftest prepare-and-register-with-invitation-and-enabled-registration-1
(let [sprops (:app.setup/props th/*system*)
itoken (tokens/generate sprops
{:iss :team-invitation
:exp (dt/in-future "48h")
:role :editor
:team-id uuid/zero
:member-email "user@example.com"})
data {::th/type :prepare-register-profile
:invitation-token itoken
:email "user@example.com"
:password "foobar"}
{:keys [result error] :as out} (th/command! data)]
(t/is (nil? error))
(t/is (map? result))
(t/is (string? (:token result)))
(let [rtoken (:token result)
data {::th/type :register-profile
:token rtoken
:fullname "foobar"}
{:keys [result error] :as out} (th/command! data)]
;; (th/print-result! out)
(t/is (nil? error))
(t/is (map? result))
(t/is (string? (:invitation-token result))))))
(t/deftest prepare-and-register-with-invitation-and-enabled-registration-2
(let [sprops (:app.setup/props th/*system*)
itoken (tokens/generate sprops
{:iss :team-invitation
:exp (dt/in-future "48h")
:role :editor
:team-id uuid/zero
:member-email "user2@example.com"})
data {::th/type :prepare-register-profile
:invitation-token itoken
:email "user@example.com"
:password "foobar"}
out (th/command! data)]
(t/is (not (th/success? out)))
(let [edata (-> out :error ex-data)]
(t/is (= :restriction (:type edata)))
(t/is (= :email-does-not-match-invitation (:code edata))))))
(t/deftest prepare-and-register-with-invitation-and-disabled-registration-1
(with-redefs [app.config/flags [:disable-registration]]
@@ -519,22 +567,12 @@
:invitation-token itoken
:email "user@example.com"
:password "foobar"}
out (th/command! data)]
{:keys [result error] :as out} (th/command! data)]
(t/is (nil? error))
(t/is (map? result))
(t/is (string? (:token result)))
(let [rtoken (:token result)
data {::th/type :register-profile
:token rtoken
:fullname "foobar"}
{:keys [result error] :as out} (th/command! data)]
;; (th/print-result! out)
(t/is (nil? error))
(t/is (map? result))
(t/is (string? (:invitation-token result)))))))
(t/is (not (th/success? out)))
(let [edata (-> out :error ex-data)]
(t/is (= :restriction (:type edata)))
(t/is (= :registration-disabled (:code edata)))))))
(t/deftest prepare-and-register-with-invitation-and-disabled-registration-2
(with-redefs [app.config/flags [:disable-registration]]
@@ -555,7 +593,28 @@
(t/is (not (th/success? out)))
(let [edata (-> out :error ex-data)]
(t/is (= :restriction (:type edata)))
(t/is (= :email-does-not-match-invitation (:code edata)))))))
(t/is (= :registration-disabled (:code edata)))))))
(t/deftest prepare-and-register-with-invitation-and-disabled-login-with-password
(with-redefs [app.config/flags [:disable-login-with-password]]
(let [sprops (:app.setup/props th/*system*)
itoken (tokens/generate sprops
{:iss :team-invitation
:exp (dt/in-future "48h")
:role :editor
:team-id uuid/zero
:member-email "user2@example.com"})
data {::th/type :prepare-register-profile
:invitation-token itoken
:email "user@example.com"
:password "foobar"}
out (th/command! data)]
(t/is (not (th/success? out)))
(let [edata (-> out :error ex-data)]
(t/is (= :restriction (:type edata)))
(t/is (= :registration-disabled (:code edata)))))))
(t/deftest prepare-register-with-registration-disabled
(with-redefs [app.config/flags #{}]
@@ -590,9 +649,10 @@
(th/create-global-complaint-for pool {:type :bounce :email "user@example.com"})
(let [out (th/command! data)]
(t/is (th/success? out))
(let [result (:result out)]
(t/is (contains? result :token))))))
(t/is (not (th/success? out)))
(let [edata (-> out :error ex-data)]
(t/is (= :restriction (:type edata)))
(t/is (= :email-has-permanent-bounces (:code edata)))))))
(t/deftest register-profile-with-complained-email
(let [pool (:app.db/pool th/*system*)
@@ -603,9 +663,11 @@
(th/create-global-complaint-for pool {:type :complaint :email "user@example.com"})
(let [out (th/command! data)]
(t/is (th/success? out))
(let [result (:result out)]
(t/is (contains? result :token))))))
(t/is (not (th/success? out)))
(let [edata (-> out :error ex-data)]
(t/is (= :restriction (:type edata)))
(t/is (= :email-has-complaints (:code edata)))))))
(t/deftest register-profile-with-email-as-password
(let [data {::th/type :prepare-register-profile
@@ -636,20 +698,26 @@
;; with complaints
(th/create-global-complaint-for pool {:type :complaint :email (:email data)})
(let [out (th/command! data)]
(let [out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:result out)))
(t/is (= 2 (:call-count @mock))))
(let [edata (-> out :error ex-data)]
(t/is (= :restriction (:type edata)))
(t/is (= :email-has-complaints (:code edata))))
(t/is (= 1 (:call-count @mock))))
;; with bounces
(th/create-global-complaint-for pool {:type :bounce :email (:email data)})
(let [out (th/command! data)
error (:error out)]
(let [out (th/command! data)]
;; (th/print-result! out)
(t/is (th/ex-info? error))
(t/is (th/ex-of-type? error :validation))
(t/is (th/ex-of-code? error :email-has-permanent-bounces))
(t/is (= 2 (:call-count @mock)))))))
(let [edata (-> out :error ex-data)]
(t/is (= :restriction (:type edata)))
(t/is (= :email-has-permanent-bounces (:code edata))))
(t/is (= 1 (:call-count @mock)))))))
(t/deftest email-change-request-without-smtp
@@ -714,7 +782,7 @@
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:result out)))
(t/is (= 2 (:call-count @mock))))
(t/is (= 1 (:call-count @mock))))
;; with valid email and active user with global bounce
(th/create-global-complaint-for pool {:type :bounce :email (:email profile2)})
@@ -723,7 +791,7 @@
(t/is (nil? (:result out)))
(t/is (nil? (:error out)))
;; (th/print-result! out)
(t/is (= 2 (:call-count @mock))))))))
(t/is (= 1 (:call-count @mock))))))))
(t/deftest update-profile-password

View File

@@ -62,8 +62,8 @@
(th/reset-mock! mock)
(let [data (assoc data :emails ["foo@bar.com"])
out (th/command! data)]
(t/is (th/success? out))
(t/is (= 1 (:call-count (deref mock)))))
(t/is (not (th/success? out)))
(t/is (= 0 (:call-count (deref mock)))))
;; get invitation token
(let [params {::th/type :get-team-invitation-token
@@ -86,7 +86,7 @@
(t/is (= 0 (:call-count @mock)))
(let [edata (-> out :error ex-data)]
(t/is (= :validation (:type edata)))
(t/is (= :restriction (:type edata)))
(t/is (= :email-has-permanent-bounces (:code edata)))))
;; invite internal user that is muted

View File

@@ -154,12 +154,12 @@
[:add-color
[:map {:title "AddColorChange"}
[:type [:= :add-color]]
[:color :any]]]
[:color ::ctc/color]]]
[:mod-color
[:map {:title "ModColorChange"}
[:type [:= :mod-color]]
[:color :any]]]
[:color ::ctc/color]]]
[:del-color
[:map {:title "DelColorChange"}
@@ -670,52 +670,14 @@
(ctyl/delete-typography data id))
;; === Operations
(defmethod process-operation :set
[on-changed shape op]
(let [attr (:attr op)
group (get ctk/sync-attrs attr)
val (:val op)
shape-val (get shape attr)
ignore (or (:ignore-touched op) (= attr :position-data)) ;; position-data is a derived attribute and
ignore-geometry (:ignore-geometry op) ;; never triggers touched by itself
is-geometry? (and (or (= group :geometry-group)
(and (= group :content-group) (= (:type shape) :path)))
(not (#{:width :height} attr))) ;; :content in paths are also considered geometric
;; TODO: the check of :width and :height probably may be removed
;; after the check added in data/workspace/modifiers/check-delta
;; function. Better check it and test toroughly when activating
;; components-v2 mode.
in-copy? (ctk/in-component-copy? shape)
;; For geometric attributes, there are cases in that the value changes
;; slightly (e.g. when rounding to pixel, or when recalculating text
;; positions in different zoom levels). To take this into account, we
;; ignore geometric changes smaller than 1 pixel.
equal? (if is-geometry?
(gsh/close-attrs? attr val shape-val 1)
(gsh/close-attrs? attr val shape-val))]
;; Notify when value has changed, except when it has not moved relative to the
;; component head.
(when (and group (not equal?) (not (and ignore-geometry is-geometry?)))
(on-changed shape))
(cond-> shape
;; Depending on the origin of the attribute change, we need or not to
;; set the "touched" flag for the group the attribute belongs to.
;; In some cases we need to ignore touched only if the attribute is
;; geometric (position, width or transformation).
(and in-copy? group (not ignore) (not equal?)
(not (and ignore-geometry is-geometry?)))
(-> (update :touched cfh/set-touched-group group)
(dissoc :remote-synced))
(nil? val)
(dissoc attr)
(some? val)
(assoc attr val))))
(ctn/set-shape-attr shape
(:attr op)
(:val op)
:on-changed on-changed
:ignore-touched (:ignore-touched op)
:ignore-geometry (:ignore-geometry op)))
(defmethod process-operation :set-touched
[_ shape op]

View File

@@ -357,15 +357,6 @@
;; COMPONENTS HELPERS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn set-touched-group
[touched group]
(when group
(conj (or touched #{}) group)))
(defn touched-group?
[shape group]
((or (:touched shape) #{}) group))
(defn make-container
[page-or-component type]
(assoc page-or-component :type type))

View File

@@ -0,0 +1,106 @@
;; 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.common.json
(:refer-clojure :exclude [read clj->js js->clj])
(:require
#?(:clj [clojure.data.json :as j])
[cuerdas.core :as str]))
#?(:clj
(defn read
[reader & {:as opts}]
(j/read reader opts)))
#?(:clj
(defn write
[writer data & {:as opts}]
(j/write data writer opts)))
(defn read-kebab-key
[k]
(if (and (string? k) (not (str/includes? k "/")))
(-> k str/kebab keyword)
k))
(defn write-camel-key
[k]
(if (or (keyword? k) (symbol? k))
(str/camel k)
(str k)))
#?(:cljs
(defn ->js
[x & {:keys [key-fn]
:or {key-fn write-camel-key} :as opts}]
(let [f (fn this-fn [x]
(cond
(nil? x)
nil
(satisfies? cljs.core/IEncodeJS x)
(cljs.core/-clj->js x)
(or (keyword? x)
(symbol? x))
(name x)
(number? x)
x
(boolean? x)
x
(map? x)
(reduce-kv (fn [m k v]
(let [k (key-fn k)]
(unchecked-set m k (this-fn v))
m))
#js {}
x)
(coll? x)
(reduce (fn [arr v]
(.push arr (this-fn v))
arr)
(array)
x)
:else
(str x)))]
(f x))))
#?(:cljs
(defn ->clj
[o & {:keys [key-fn val-fn] :or {key-fn read-kebab-key val-fn identity}}]
(let [f (fn this-fn [x]
(let [x (val-fn x)]
(cond
(array? x)
(persistent!
(.reduce ^js/Array x
#(conj! %1 (this-fn %2))
(transient [])))
(identical? (type x) js/Object)
(persistent!
(.reduce ^js/Array (js-keys x)
#(assoc! %1 (key-fn %2) (this-fn (unchecked-get x %2)))
(transient {})))
:else
x)))]
(f o))))
(defn encode
[data & {:as opts}]
#?(:clj (j/write-str data opts)
:cljs (.stringify js/JSON (->js data opts))))
(defn decode
[data & {:as opts}]
#?(:clj (j/read-str data opts)
:cljs (->clj (.parse js/JSON data) opts)))

View File

@@ -153,14 +153,29 @@
(defn build-message
[props]
(loop [props (seq props)
result []]
result []
body nil]
(if-let [[k v] (first props)]
(if (simple-ident? k)
(cond
(simple-ident? k)
(recur (next props)
(conj result (str (name k) "=" (pr-str v))))
(conj result (str (name k) "=" (pr-str v)))
body)
(= ::body k)
(recur (next props)
result))
(str/join ", " result))))
result
v)
:else
(recur (next props)
result
body))
(let [message (str/join ", " result)]
(if (string? body)
(str message "\n" body)
message)))))
(defn build-stack-trace
[cause]

View File

@@ -288,13 +288,23 @@
(some? (:shape-ref ref-shape))
(pcb/update-shapes [(:id shape)] #(assoc % :shape-ref (:shape-ref ref-shape)))
;; When advancing level, if the referenced shape has a swap slot, it must be
;; copied to the current shape, because the shape-ref now will not be pointing
;; to a near main (except for first level subcopies).
;; When advancing level, the normal touched groups (not swap slots) of the
;; ref-shape must be merged into the current shape, because they refer to
;; the new referenced shape.
(some? ref-shape)
(pcb/update-shapes
[(:id shape)]
#(assoc % :touched
(clojure.set/union (:touched shape)
(ctk/normal-touched-groups ref-shape))))
;; Swap slot must also be copied if the current shape has not any,
;; except if this is the first level subcopy.
(and (some? (ctk/get-swap-slot ref-shape))
(nil? (ctk/get-swap-slot shape))
(not= (:id shape) shape-id))
(pcb/update-shapes [(:id shape)] #(ctk/set-swap-slot % (ctk/get-swap-slot ref-shape))))))]
(reduce skip-near changes children)))
(defn prepare-restore-component

View File

@@ -619,20 +619,27 @@
{:title "contains"
:description "contains predicate"}}))})
(define! ::inst
(def type:inst
{:type ::inst
:pred inst?
:type-properties
{:title "inst"
:description "Satisfies Inst protocol"
:error/message "expected to be number in safe range"
:error/message "should be an instant"
:gen/gen (->> (sg/small-int)
(sg/fmap (fn [v] (tm/instant v))))
::oapi/type "number"
::oapi/format "int64"}})
(sg/fmap (fn [v] (tm/parse-instant v))))
(define! ::fn
[:schema fn?])
:decode/string tm/parse-instant
:encode/string tm/format-instant
:decode/json tm/parse-instant
:encode/json tm/format-instant
::oapi/type "string"
::oapi/format "iso"}})
(register! ::inst type:inst)
(register! ::fn
[:schema fn?])
(define! ::word-string
{:type ::word-string

View File

@@ -12,6 +12,7 @@
[app.common.test-helpers.ids-map :as thi]
[app.common.types.color :as ctc]
[app.common.types.colors-list :as ctcl]
[app.common.types.container :as ctn]
[app.common.types.file :as ctf]
[app.common.types.pages-list :as ctpl]
[app.common.types.shape :as cts]
@@ -69,6 +70,19 @@
(thf/current-page file))]
(ctst/get-shape page id)))
(defn update-shape
[file shape-label attr val & {:keys [page-label]}]
(let [page (if page-label
(thf/get-page file page-label)
(thf/current-page file))
shape (ctst/get-shape page (thi/id shape-label))]
(ctf/update-file-data
file
(fn [file-data]
(ctpl/update-page file-data
(:id page)
#(ctst/set-shape % (ctn/set-shape-attr shape attr val)))))))
(defn sample-color
[label & {:keys [] :as params}]
(ctc/make-color (assoc params :id (thi/new-id! label))))

View File

@@ -12,6 +12,7 @@
["luxon" :as lxn])
:clj
(:import
java.time.format.DateTimeFormatter
java.time.Instant
java.time.Duration)))
@@ -26,10 +27,29 @@
#?(:clj (Instant/now)
:cljs (.local ^js DateTime)))
(defn instant
(defn instant?
[o]
#?(:clj (instance? Instant o)
:cljs (instance? DateTime o)))
(defn parse-instant
[s]
#?(:clj (Instant/ofEpochMilli s)
:cljs (.fromMillis ^js DateTime s #js {:zone "local" :setZone false})))
(cond
(instant? s)
s
(int? s)
#?(:clj (Instant/ofEpochMilli s)
:cljs (.fromMillis ^js DateTime s #js {:zone "local" :setZone false}))
(string? s)
#?(:clj (Instant/parse s)
:cljs (.fromISO ^js DateTime s))))
(defn format-instant
[v]
#?(:clj (.format DateTimeFormatter/ISO_INSTANT ^Instant v)
:cljs (.toISO ^js v)))
#?(:cljs
(extend-protocol IComparable

View File

@@ -202,6 +202,11 @@
[group]
(str/starts-with? (name group) "swap-slot-"))
(defn normal-touched-groups
"Gets all touched groups that are not swap slots."
[shape]
(into #{} (remove swap-slot? (:touched shape))))
(defn group->swap-slot
[group]
(uuid/uuid (subs (name group) 10)))

View File

@@ -498,7 +498,7 @@
; original component doesn't exist or is deleted. So for this function purposes, they
; are removed from the list
remove? (fn [shape]
(let [component (get-in libraries [(:component-file shape) :data :components (:component-id shape)])]
(let [component (get-in libraries [(:component-file shape) :data :components (:component-id shape)])]
(and component (not (:deleted component)))))
selected-components (cond->> (mapcat collect-main-shapes children objects)
@@ -534,3 +534,48 @@
(if (or no-changes? (not (invalid-structure-for-component? objects parent children pasting? libraries)))
[parent-id (get-frame parent-id)]
(recur (:parent-id parent) objects children pasting? libraries))))))
;; --- SHAPE UPDATE
(defn set-shape-attr
[shape attr val & {:keys [on-changed ignore-touched ignore-geometry]}]
(let [group (get ctk/sync-attrs attr)
shape-val (get shape attr)
ignore (or ignore-touched (= attr :position-data)) ;; position-data is a derived attribute and
is-geometry? (and (or (= group :geometry-group) ;; never triggers touched by itself
(and (= group :content-group) (= (:type shape) :path)))
(not (#{:width :height} attr))) ;; :content in paths are also considered geometric
;; TODO: the check of :width and :height probably may be removed
;; after the check added in data/workspace/modifiers/check-delta
;; function. Better check it and test toroughly when activating
;; components-v2 mode.
in-copy? (ctk/in-component-copy? shape)
;; For geometric attributes, there are cases in that the value changes
;; slightly (e.g. when rounding to pixel, or when recalculating text
;; positions in different zoom levels). To take this into account, we
;; ignore geometric changes smaller than 1 pixel.
equal? (if is-geometry?
(gsh/close-attrs? attr val shape-val 1)
(gsh/close-attrs? attr val shape-val))]
;; Notify when value has changed, except when it has not moved relative to the
;; component head.
(when (and on-changed group (not equal?) (not (and ignore-geometry is-geometry?)))
(on-changed shape))
(cond-> shape
;; Depending on the origin of the attribute change, we need or not to
;; set the "touched" flag for the group the attribute belongs to.
;; In some cases we need to ignore touched only if the attribute is
;; geometric (position, width or transformation).
(and in-copy? group (not ignore) (not equal?)
(not (and ignore-geometry is-geometry?)))
(-> (update :touched ctk/set-touched-group group)
(dissoc :remote-synced))
(nil? val)
(dissoc attr)
(some? val)
(assoc attr val))))

View File

@@ -501,8 +501,8 @@
(assoc :proportion-lock true)))
(defn setup-shape
"A function that initializes the geometric data of
the shape. The props must have :x :y :width :height."
"A function that initializes the geometric data of the shape. The props must
contain at least :x :y :width :height."
[{:keys [type] :as props}]
(let [shape (make-minimal-shape type)

View File

@@ -4,7 +4,7 @@
;;
;; Copyright (c) KALEIDOS INC
(ns common-tests.logic.comp-detach-with-swap-test
(ns common-tests.logic.comp-detach-with-nested-test
(:require
[app.common.files.changes-builder :as pcb]
[app.common.logic.libraries :as cll]
@@ -18,7 +18,7 @@
(t/use-fixtures :each thi/test-fixture)
;; Related .penpot file: common/test/cases/detach-with-swap.penpot
;; Related .penpot file: common/test/cases/detach-with-nested.penpot
(defn- setup-file
[]
;; {:r-ellipse} [:name Ellipse, :type :frame] # [Component :c-ellipse]
@@ -195,3 +195,177 @@
(t/is (= (:shape-ref copy-nested-rectangle) (thi/id :rectangle)))
(t/is (nil? (ctk/get-swap-slot copy-nested-rectangle)))))
(t/deftest test-propagate-touched
(let [;; ==== Setup
file (-> (setup-file)
(ths/update-shape :nested2-ellipse :fills (ths/sample-fills-color :fill-color "#fabada"))
(thc/instantiate-component :c-big-board
:copy-big-board
:children-labels [:copy-h-board-with-ellipse
:copy-nested2-h-ellipse
:copy-nested2-ellipse]))
page (thf/current-page file)
nested2-ellipse (ths/get-shape file :nested2-ellipse)
copy-nested2-ellipse (ths/get-shape file :copy-nested2-ellipse)
;; ==== Action
changes (cll/generate-detach-instance (-> (pcb/empty-changes nil)
(pcb/with-page page)
(pcb/with-objects (:objects page)))
page
{(:id file) file}
(thi/id :copy-big-board))
file' (thf/apply-changes file changes)
;; ==== Get
nested2-ellipse' (ths/get-shape file' :nested2-ellipse)
copy-nested2-ellipse' (ths/get-shape file' :copy-nested2-ellipse)
fills' (:fills copy-nested2-ellipse')
fill' (first fills')]
;; ==== Check
;; The touched group must be propagated to the copy, because now this copy
;; has the original ellipse component as near main, but its attributes have
;; been inherited from the ellipse inside big-board.
(t/is (= (:touched nested2-ellipse) #{:fill-group}))
(t/is (= (:touched copy-nested2-ellipse) nil))
(t/is (= (:touched nested2-ellipse') #{:fill-group}))
(t/is (= (:touched copy-nested2-ellipse') #{:fill-group}))
(t/is (= (count fills') 1))
(t/is (= (:fill-color fill') "#fabada"))
(t/is (= (:fill-opacity fill') 1))))
(t/deftest test-merge-touched
(let [;; ==== Setup
file (-> (setup-file)
(ths/update-shape :nested2-ellipse :fills (ths/sample-fills-color :fill-color "#fabada"))
(thc/instantiate-component :c-big-board
:copy-big-board
:children-labels [:copy-h-board-with-ellipse
:copy-nested2-h-ellipse
:copy-nested2-ellipse])
(ths/update-shape :copy-nested2-ellipse :name "Modified name")
(ths/update-shape :copy-nested2-ellipse :fills (ths/sample-fills-color :fill-color "#abcdef")))
page (thf/current-page file)
nested2-ellipse (ths/get-shape file :nested2-ellipse)
copy-nested2-ellipse (ths/get-shape file :copy-nested2-ellipse)
;; ==== Action
changes (cll/generate-detach-instance (-> (pcb/empty-changes nil)
(pcb/with-page page)
(pcb/with-objects (:objects page)))
page
{(:id file) file}
(thi/id :copy-big-board))
file' (thf/apply-changes file changes)
;; ==== Get
nested2-ellipse' (ths/get-shape file' :nested2-ellipse)
copy-nested2-ellipse' (ths/get-shape file' :copy-nested2-ellipse)
fills' (:fills copy-nested2-ellipse')
fill' (first fills')]
;; ==== Check
;; If the copy have been already touched, merge the groups and preserve the modifications.
(t/is (= (:touched nested2-ellipse) #{:fill-group}))
(t/is (= (:touched copy-nested2-ellipse) #{:name-group :fill-group}))
(t/is (= (:touched nested2-ellipse') #{:fill-group}))
(t/is (= (:touched copy-nested2-ellipse') #{:name-group :fill-group}))
(t/is (= (count fills') 1))
(t/is (= (:fill-color fill') "#abcdef"))
(t/is (= (:fill-opacity fill') 1))))
(t/deftest test-dont-propagete-touched-when-swapped-copy
(let [;; ==== Setup
file (-> (setup-file)
(ths/update-shape :nested-rectangle :fills (ths/sample-fills-color :fill-color "#fabada"))
(thc/instantiate-component :c-big-board
:copy-big-board
:children-labels [:copy-h-board-with-ellipse
:copy-nested2-h-ellipse
:copy-nested2-ellipse])
(thc/component-swap :copy-h-board-with-ellipse
:c-board-with-rectangle
:copy-h-board-with-rectangle
:children-labels [:copy-nested2-h-rectangle
:copy-nested2-rectangle]))
page (thf/current-page file)
nested2-rectangle (ths/get-shape file :nested2-rectangle)
copy-nested2-rectangle (ths/get-shape file :copy-nested2-rectangle)
;; ==== Action
changes (cll/generate-detach-instance (-> (pcb/empty-changes nil)
(pcb/with-page page)
(pcb/with-objects (:objects page)))
page
{(:id file) file}
(thi/id :copy-big-board))
file' (thf/apply-changes file changes)
;; ==== Get
nested2-rectangle' (ths/get-shape file' :nested2-rectangle)
copy-nested2-rectangle' (ths/get-shape file' :copy-nested2-rectangle)
fills' (:fills copy-nested2-rectangle')
fill' (first fills')]
;; ==== Check
;; If the copy has been swapped, there is nothing to propagate since it's already
;; pointing to the swapped near main.
(t/is (= (:touched nested2-rectangle) nil))
(t/is (= (:touched copy-nested2-rectangle) nil))
(t/is (= (:touched nested2-rectangle') nil))
(t/is (= (:touched copy-nested2-rectangle') nil))
(t/is (= (count fills') 1))
(t/is (= (:fill-color fill') "#fabada"))
(t/is (= (:fill-opacity fill') 1))))
(t/deftest test-propagate-touched-when-swapped-main
(let [;; ==== Setup
file (-> (setup-file)
(thc/component-swap :nested2-h-ellipse
:c-rectangle
:nested2-h-rectangle
:children-labels [:nested2-rectangle])
(ths/update-shape :nested2-rectangle :fills (ths/sample-fills-color :fill-color "#fabada"))
(thc/instantiate-component :c-big-board
:copy-big-board
:children-labels [:copy-h-board-with-ellipse
:copy-nested2-h-rectangle
:copy-nested2-rectangle]))
page (thf/current-page file)
nested2-rectangle (ths/get-shape file :nested2-rectangle)
copy-nested2-rectangle (ths/get-shape file :copy-nested2-rectangle)
;; ==== Action
changes (cll/generate-detach-instance (-> (pcb/empty-changes nil)
(pcb/with-page page)
(pcb/with-objects (:objects page)))
page
{(:id file) file}
(thi/id :copy-big-board))
file' (thf/apply-changes file changes)
;; ==== Get
nested2-rectangle' (ths/get-shape file' :nested2-rectangle)
copy-nested2-rectangle' (ths/get-shape file' :copy-nested2-rectangle)
fills' (:fills copy-nested2-rectangle')
fill' (first fills')]
;; ==== Check
;; If the main has been swapped, there is no difference. It propagates the same as
;; if it were the original component.
(t/is (= (:touched nested2-rectangle) #{:fill-group}))
(t/is (= (:touched copy-nested2-rectangle) nil))
(t/is (= (:touched nested2-rectangle') #{:fill-group}))
(t/is (= (:touched copy-nested2-rectangle') #{:fill-group}))
(t/is (= (count fills') 1))
(t/is (= (:fill-color fill') "#fabada"))
(t/is (= (:fill-opacity fill') 1))))

View File

@@ -125,3 +125,7 @@ services:
ports:
- "10389:10389"
- "10636:10636"
ulimits:
nofile:
soft: "1024"
hard: "1024"

View File

@@ -38,7 +38,10 @@ http {
gzip_types text/plain text/css text/javascript application/javascript application/json application/transit+json;
resolver $PENPOT_INTERNAL_RESOLVER;
proxy_buffer_size 16k;
proxy_busy_buffers_size 24k; # essentially, proxy_buffer_size + 2 small buffers of 4k
proxy_buffers 32 4k;
resolver $PENPOT_INTERNAL_RESOLVER ipv6=off;
map $http_upgrade $connection_upgrade {
default upgrade;

View File

@@ -17,7 +17,7 @@
(def ^:private defaults
{:public-uri "http://localhost:3449"
:tenant "dev"
:tenant "default"
:host "localhost"
:http-server-port 6061
:http-server-host "0.0.0.0"

View File

@@ -2,7 +2,7 @@
"~:id": "~u015fda4f-caa6-8103-8004-862a9e4b4d4b",
"~:file-id": "~u015fda4f-caa6-8103-8004-862a00dd4f31",
"~:created-at": "~m1718718436639",
"~:content": {
"~:data": {
"~ue117f7f6-433c-807e-8004-862a38e1823d": {
"~:id": "~ue117f7f6-433c-807e-8004-862a38e1823d",
"~:name": "Button",
@@ -28,4 +28,4 @@
"~:main-instance-page": "~u015fda4f-caa6-8103-8004-862a00ddbe94"
}
}
}
}

View File

@@ -2,7 +2,7 @@
"~:id": "~u015fda4f-caa6-8103-8004-862a9e4ad279",
"~:file-id": "~u015fda4f-caa6-8103-8004-862a00dd4f31",
"~:created-at": "~m1718718436639",
"~:content": {
"~:data": {
"~:options": {},
"~:objects": {
"~u00000000-0000-0000-0000-000000000000": {
@@ -627,4 +627,4 @@
"~:id": "~u015fda4f-caa6-8103-8004-862a00ddbe94",
"~:name": "Page 1"
}
}
}

View File

@@ -2,7 +2,7 @@
"~:id": "~u03bff843-920f-81a1-8004-7563acdc8ca1",
"~:file-id": "~u03bff843-920f-81a1-8004-756365e1eb6a",
"~:created-at": "~m1717592543081",
"~:content": {
"~:data": {
"~:options": {},
"~:objects": {
"~u00000000-0000-0000-0000-000000000000": {
@@ -360,4 +360,4 @@
"~:id": "~u03bff843-920f-81a1-8004-756365e1eb6b",
"~:name": "Page 1"
}
}
}

View File

@@ -2,7 +2,7 @@
"~:id": "~u0515a066-e303-8169-8004-73eb58e899c2",
"~:file-id": "~uc7ce0794-0992-8105-8004-38f280443849",
"~:created-at": "~m1717493890966",
"~:content": {
"~:data": {
"~:options": {},
"~:objects": {
"~u00000000-0000-0000-0000-000000000000": {
@@ -94,4 +94,4 @@
"~:id": "~uc7ce0794-0992-8105-8004-38f28044384a",
"~:name": "Page 1"
}
}
}

View File

@@ -2,7 +2,7 @@
"~:id": "~udd5cc0bb-91ff-81b9-8004-77dfae2d9e7c",
"~:file-id": "~udd5cc0bb-91ff-81b9-8004-77df9cd3edb1",
"~:created-at": "~m1717759268004",
"~:content": {
"~:data": {
"~:options": {},
"~:objects": {
"~u00000000-0000-0000-0000-000000000000": {
@@ -183,4 +183,4 @@
"~:id": "~udd5cc0bb-91ff-81b9-8004-77df9cd3edb2",
"~:name": "Page 1"
}
}
}

View File

@@ -2,7 +2,7 @@
"~:id": "~ucd90e028-326a-80b4-8004-7cdeefa23ece",
"~:file-id": "~ucd90e028-326a-80b4-8004-7cdec16ffad5",
"~:created-at": "~m1718094617214",
"~:content": {
"~:data": {
"~:options": {},
"~:objects": {
"~u00000000-0000-0000-0000-000000000000": {

View File

@@ -2,7 +2,7 @@
"~:id": "~ude58c8f6-c5c2-8196-8004-3df9e2e52d88",
"~:file-id": "~uc7ce0794-0992-8105-8004-38f280443849",
"~:created-at": "~m1713873823631",
"~:content": {
"~:data": {
"~:options": {},
"~:objects": {
"~u00000000-0000-0000-0000-000000000000": {
@@ -94,4 +94,4 @@
"~:id": "~uc7ce0794-0992-8105-8004-38f28044384a",
"~:name": "Page 1"
}
}
}

View File

@@ -898,8 +898,7 @@
(-> state
(d/update-in-when [:dashboard-files id :is-shared] (constantly is-shared))
(d/update-in-when [:dashboard-recent-files id :is-shared] (constantly is-shared))
(cond->
(not is-shared)
(cond-> (not is-shared)
(d/update-when :dashboard-shared-files dissoc id))))
ptk/WatchEvent
@@ -909,7 +908,7 @@
(rx/ignore))))))
(defn set-file-thumbnail
[file-id thumbnail-uri]
[file-id thumbnail-id]
(ptk/reify ::set-file-thumbnail
ptk/UpdateEvent
(update [_ state]
@@ -917,10 +916,10 @@
(->> files
(mapv #(cond-> %
(= file-id (:id %))
(assoc :thumbnail-uri thumbnail-uri)))))]
(assoc :thumbnail-id thumbnail-id)))))]
(-> state
(d/update-in-when [:dashboard-files file-id] assoc :thumbnail-uri thumbnail-uri)
(d/update-in-when [:dashboard-recent-files file-id] assoc :thumbnail-uri thumbnail-uri)
(d/update-in-when [:dashboard-files file-id] assoc :thumbnail-id thumbnail-id)
(d/update-in-when [:dashboard-recent-files file-id] assoc :thumbnail-id thumbnail-id)
(d/update-when :dashboard-search-result update-search-files))))))
;; --- EVENT: create-file

View File

@@ -49,31 +49,30 @@
(defn show-workspace-export-dialog
([] (show-workspace-export-dialog nil))
([{:keys [selected]}]
(ptk/reify ::show-workspace-export-dialog
ptk/WatchEvent
(watch [_ state _]
(let [file-id (:current-file-id state)
page-id (:current-page-id state)
selected (or selected (wsh/lookup-selected state page-id {}))
[{:keys [selected origin]}]
(ptk/reify ::show-workspace-export-dialog
ptk/WatchEvent
(watch [_ state _]
(let [file-id (:current-file-id state)
page-id (:current-page-id state)
selected (or selected (wsh/lookup-selected state page-id {}))
shapes (if (seq selected)
(wsh/lookup-shapes state selected)
(reverse (wsh/filter-shapes state #(pos? (count (:exports %))))))
shapes (if (seq selected)
(wsh/lookup-shapes state selected)
(reverse (wsh/filter-shapes state #(pos? (count (:exports %))))))
exports (for [shape shapes
export (:exports shape)]
(-> export
(assoc :enabled true)
(assoc :page-id page-id)
(assoc :file-id file-id)
(assoc :object-id (:id shape))
(assoc :shape (dissoc shape :exports))
(assoc :name (:name shape))))]
exports (for [shape shapes
export (:exports shape)]
(-> export
(assoc :enabled true)
(assoc :page-id page-id)
(assoc :file-id file-id)
(assoc :object-id (:id shape))
(assoc :shape (dissoc shape :exports))
(assoc :name (:name shape))))]
(rx/of (modal/show :export-shapes
{:exports (vec exports)})))))))
(rx/of (modal/show :export-shapes
{:exports (vec exports) :origin origin}))))))
(defn show-viewer-export-dialog
[{:keys [shapes page-id file-id share-id exports]}]
@@ -90,7 +89,7 @@
(assoc :shape (dissoc shape :exports))
(assoc :name (:name shape))
(cond-> share-id (assoc :share-id share-id))))]
(rx/of (modal/show :export-shapes {:exports (vec exports)})))))) #_TODO
(rx/of (modal/show :export-shapes {:exports (vec exports) :origin "viewer"})))))) #_TODO
(defn show-workspace-export-frames-dialog
[frames]
@@ -108,7 +107,7 @@
:name (:name frame)})]
(rx/of (modal/show :export-frames
{:exports (vec exports)}))))))
{:exports (vec exports) :origin "workspace:menu"}))))))
(defn- initialize-export-status
[exports cmd resource]

View File

@@ -12,7 +12,6 @@
[app.common.uuid :as uuid]
[app.main.data.changes :as dch]
[app.main.repo :as rp]
[app.util.router :as rt]
[beicon.v2.core :as rx]
[potok.v2.core :as ptk]))
@@ -131,8 +130,7 @@
(rx/concat
(if (= :authentication (:type cause))
(rx/empty)
(rx/of (rt/assign-exception cause)
(ptk/data-event ::error cause)
(rx/of (ptk/data-event ::error cause)
(update-status :error)))
(rx/of (discard-persistence-state))
(rx/throw cause))))))))))

View File

@@ -134,7 +134,7 @@
(uuid? share-id)
(assoc :share-id share-id))]
(->> (rp/cmd! :get-file-fragment params)
(rx/map :content)
(rx/map :data)
(rx/map #(vector key %)))))]
(->> (rp/cmd! :get-view-only-bundle params')

View File

@@ -47,7 +47,6 @@
[app.main.data.workspace.collapse :as dwco]
[app.main.data.workspace.drawing :as dwd]
[app.main.data.workspace.edition :as dwe]
[app.main.data.workspace.fix-bool-contents :as fbc]
[app.main.data.workspace.fix-broken-shapes :as fbs]
[app.main.data.workspace.fix-deleted-fonts :as fdf]
[app.main.data.workspace.groups :as dwg]
@@ -129,7 +128,6 @@
(when (and (not (boolean (-> state :profile :props :v2-info-shown)))
(features/active-feature? state "components/v2"))
(modal/show :v2-info {}))
(fbc/fix-bool-contents)
(fdf/fix-deleted-fonts)
(fbs/fix-broken-shapes)))))

View File

@@ -1,95 +0,0 @@
;; 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.main.data.workspace.fix-bool-contents
(:require
[app.common.data :as d]
[app.common.geom.shapes :as gsh]
[app.main.data.changes :as dch]
[app.main.data.workspace.shapes :as dwsh]
[app.main.data.workspace.state-helpers :as wsh]
[beicon.v2.core :as rx]
[potok.v2.core :as ptk]))
;; This event will update the file so the boolean data has a pre-generated path data
;; to increase performance.
;; For new shapes this will be generated in the :reg-objects but we need to do this for
;; old files.
;; FIXME: Remove me after June 2022
(defn fix-bool-contents
"This event will calculate the bool content and update the page. This is kind of a 'addhoc' migration
to fill the optional value 'bool-content'"
[]
(letfn [(should-migrate-shape? [shape]
(and (= :bool (:type shape)) (not (contains? shape :bool-content))))
(should-migrate-component? [component]
(->> (:objects component)
(vals)
(d/seek should-migrate-shape?)))
(update-shape [shape objects]
(cond-> shape
(should-migrate-shape? shape)
(assoc :bool-content (gsh/calc-bool-content shape objects))))
(migrate-component [component]
(-> component
(update
:objects
(fn [objects]
(d/mapm #(update-shape %2 objects) objects)))))
(update-library
[library]
(-> library
(d/update-in-when
[:data :components]
(fn [components]
(d/mapm #(migrate-component %2) components)))))]
(ptk/reify ::fix-bool-contents
ptk/UpdateEvent
(update [_ state]
;; Update (only-local) the imported libraries
(-> state
(d/update-when
:workspace-libraries
(fn [libraries] (d/mapm #(update-library %2) libraries)))))
ptk/WatchEvent
(watch [it state _]
(let [objects (wsh/lookup-page-objects state)
ids (into #{}
(comp (filter should-migrate-shape?) (map :id))
(vals objects))
components (->> (wsh/lookup-local-components state)
(vals)
(filter should-migrate-component?))
component-changes
(into []
(map (fn [component]
{:type :mod-component
:id (:id component)
:objects (-> component migrate-component :objects)}))
components)]
(rx/of (dwsh/update-shapes ids #(update-shape % objects) {:reg-objects? false
:save-undo? false
:ignore-tree true}))
(if (empty? component-changes)
(rx/empty)
(rx/of (dch/commit-changes {:origin it
:redo-changes component-changes
:undo-changes []
:save-undo? false}))))))))

View File

@@ -6,11 +6,9 @@
(ns app.main.data.workspace.fix-deleted-fonts
(:require
[app.common.data :as d]
[app.common.files.helpers :as cfh]
[app.common.text :as txt]
[app.main.data.changes :as dwc]
[app.main.data.workspace.shapes :as dwsh]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.fonts :as fonts]
[beicon.v2.core :as rx]
@@ -22,14 +20,7 @@
;; - Moving files from one team to another in the same instance
;; - Custom fonts are explicitly deleted in the team area
(defn has-invalid-font-family
[node]
(let [fonts (deref fonts/fontsdb)]
(and
(some? (:font-family node))
(nil? (get fonts (:font-id node))))))
(defn calculate-alternative-font-id
(defn- calculate-alternative-font-id
[value]
(let [fonts (deref fonts/fontsdb)]
(->> (vals fonts)
@@ -37,39 +28,44 @@
(first)
:id)))
(defn should-fix-deleted-font-shape?
(defn- has-invalid-font-family?
[node]
(let [fonts (deref fonts/fontsdb)
font-family (:font-family node)
alternative-font-id (calculate-alternative-font-id font-family)]
(and (some? font-family)
(nil? (get fonts (:font-id node)))
(some? alternative-font-id))))
(defn- should-fix-deleted-font-shape?
[shape]
(let [text-nodes (txt/node-seq txt/is-text-node? (:content shape))]
(and (cfh/text-shape? shape) (some has-invalid-font-family text-nodes))))
(and (cfh/text-shape? shape)
(some has-invalid-font-family? text-nodes))))
(defn should-fix-deleted-font-component?
(defn- should-fix-deleted-font-component?
[component]
(->> (:objects component)
(vals)
(d/seek should-fix-deleted-font-shape?)))
(let [xf (comp (map val)
(filter should-fix-deleted-font-shape?))]
(first (sequence xf (:objects component)))))
(defn should-fix-deleted-font-typography?
[typography]
(let [fonts (deref fonts/fontsdb)]
(nil? (get fonts (:font-id typography)))))
(defn fix-deleted-font
(defn- fix-deleted-font
[node]
(let [alternative-font-id (calculate-alternative-font-id (:font-family node))]
(cond-> node
(some? alternative-font-id) (assoc :font-id alternative-font-id))))
(defn fix-deleted-font-shape
(defn- fix-deleted-font-shape
[shape]
(let [transform (partial txt/transform-nodes has-invalid-font-family fix-deleted-font)]
(let [transform (partial txt/transform-nodes has-invalid-font-family? fix-deleted-font)]
(update shape :content transform)))
(defn fix-deleted-font-component
(defn- fix-deleted-font-component
[component]
(update component
:objects
(fn [objects]
(d/mapm #(fix-deleted-font-shape %2) objects))))
(update-vals objects fix-deleted-font-shape))))
(defn fix-deleted-font-typography
[typography]
@@ -77,54 +73,60 @@
(cond-> typography
(some? alternative-font-id) (assoc :font-id alternative-font-id))))
(defn- generate-deleted-font-shape-changes
[{:keys [objects id]}]
(sequence
(comp (map val)
(filter should-fix-deleted-font-shape?)
(map (fn [shape]
{:type :mod-obj
:id (:id shape)
:page-id id
:operations [{:type :set
:attr :content
:val (:content (fix-deleted-font-shape shape))}
{:type :set
:attr :position-data
:val nil}]})))
objects))
(defn- generate-deleted-font-components-changes
[state]
(sequence
(comp (map val)
(filter should-fix-deleted-font-component?)
(map (fn [component]
{:type :mod-component
:id (:id component)
:objects (-> (fix-deleted-font-component component) :objects)})))
(wsh/lookup-local-components state)))
(defn- generate-deleted-font-typography-changes
[state]
(sequence
(comp (map val)
(filter has-invalid-font-family?)
(map (fn [typography]
{:type :mod-typography
:typography (fix-deleted-font-typography typography)})))
(get-in state [:workspace-data :typographies])))
(defn fix-deleted-fonts
[]
(ptk/reify ::fix-deleted-fonts
ptk/WatchEvent
(watch [it state _]
(let [objects (wsh/lookup-page-objects state)
ids (into #{}
(comp (filter should-fix-deleted-font-shape?) (map :id))
(vals objects))
components (->> (wsh/lookup-local-components state)
(vals)
(filter should-fix-deleted-font-component?))
component-changes
(into []
(map (fn [component]
{:type :mod-component
:id (:id component)
:objects (-> (fix-deleted-font-component component) :objects)}))
components)
typographies (->> (get-in state [:workspace-data :typographies])
(vals)
(filter should-fix-deleted-font-typography?))
typography-changes
(into []
(map (fn [typography]
{:type :mod-typography
:typography (fix-deleted-font-typography typography)}))
typographies)]
(rx/concat
(rx/of (dwsh/update-shapes ids #(fix-deleted-font-shape %) {:reg-objects? false
:save-undo? false
:ignore-tree true}))
(if (empty? component-changes)
(rx/empty)
(rx/of (dwc/commit-changes {:origin it
:redo-changes component-changes
:undo-changes []
:save-undo? false})))
(if (empty? typography-changes)
(rx/empty)
(rx/of (dwc/commit-changes {:origin it
:redo-changes typography-changes
:undo-changes []
:save-undo? false}))))))))
(let [data (get state :workspace-data)
shape-changes (mapcat generate-deleted-font-shape-changes (vals (:pages-index data)))
components-changes (generate-deleted-font-components-changes state)
typography-changes (generate-deleted-font-typography-changes state)
changes (concat shape-changes
components-changes
typography-changes)]
(if (seq changes)
(rx/of (dwc/commit-changes
{:origin it
:redo-changes (vec changes)
:undo-changes []
:save-undo? false}))
(rx/empty))))))

View File

@@ -396,7 +396,7 @@
:command (ds/c-mod "shift+e")
:subsections [:basics :main-menu]
:fn #(st/emit!
(de/show-workspace-export-dialog))}
(de/show-workspace-export-dialog {:origin "workspace:shortcuts"}))}
:toggle-snap-ruler-guide {:tooltip (ds/meta-shift "G")
:command (ds/c-mod "shift+g")

View File

@@ -16,7 +16,7 @@
(letfn [(resolve-pointer [[key val :as kv]]
(if (t/pointer? val)
(->> (rp/cmd! :get-file-fragment {:file-id id :fragment-id @val})
(rx/map #(get % :content))
(rx/map #(get % :data))
(rx/map #(vector key %)))
(rx/of kv)))

View File

@@ -55,14 +55,15 @@
(.replace js/location redirect-uri)
(log/error :hint "unexpected response from OIDC method"
:resp (pr-str rsp))))
(fn [{:keys [type code] :as error}]
(cond
(and (= type :restriction)
(= code :provider-not-configured))
(st/emit! (msg/error (tr "errors.auth-provider-not-configured")))
(fn [cause]
(let [{:keys [type code] :as error} (ex-data cause)]
(cond
(and (= type :restriction)
(= code :provider-not-configured))
(st/emit! (msg/error (tr "errors.auth-provider-not-configured")))
:else
(st/emit! (msg/error (tr "errors.generic"))))))))
:else
(st/emit! (msg/error (tr "errors.generic")))))))))
(s/def ::email ::us/email)
(s/def ::password ::us/not-empty-string)

View File

@@ -59,7 +59,8 @@
:profile-is-muted
(rx/of (msg/error (tr "errors.profile-is-muted")))
:email-has-permanent-bounces
(:email-has-permanent-bounces
:email-has-complaints)
(rx/of (msg/error (tr "errors.email-has-permanent-bounces" (:email data))))
(rx/throw cause)))))

View File

@@ -54,7 +54,7 @@
(defn- on-prepare-register-error
[form cause]
(let [{:keys [type code]} (ex-data cause)]
(let [{:keys [type code] :as edata} (ex-data cause)]
(condp = [type code]
[:restriction :registration-disabled]
(st/emit! (msg/error (tr "errors.registration-disabled")))
@@ -62,6 +62,12 @@
[:restriction :email-domain-is-not-allowed]
(st/emit! (msg/error (tr "errors.email-domain-not-allowed")))
[:restriction :email-has-permanent-bounces]
(st/emit! (msg/error (tr "errors.email-has-permanent-bounces" (:email edata))))
[:restriction :email-has-complaints]
(st/emit! (msg/error (tr "errors.email-has-permanent-bounces" (:email edata))))
[:validation :email-as-password]
(swap! form assoc-in [:errors :password]
{:message "errors.email-as-password"})
@@ -130,7 +136,8 @@
(when login/show-alt-login-buttons?
[:& login/login-buttons {:params params}])
[:hr {:class (stl/css :separator)}]
[:& register-form {:params params :on-success-callback on-success-callback}]])
(when (contains? cf/flags :login-with-password)
[:& register-form {:params params :on-success-callback on-success-callback}])])
(mf/defc register-page
{::mf/props :obj}

View File

@@ -11,6 +11,7 @@
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.common.logging :as log]
[app.config :as cf]
[app.main.data.dashboard :as dd]
[app.main.data.messages :as msg]
[app.main.features :as features]
@@ -47,7 +48,7 @@
[file-id revn blob]
(let [params {:file-id file-id :revn revn :media blob}]
(->> (rp/cmd! :create-file-thumbnail params)
(rx/map :uri))))
(rx/map :id))))
(defn render-thumbnail
[file-id revn]
@@ -71,15 +72,15 @@
(mf/defc grid-item-thumbnail
{::mf/wrap-props false}
[{:keys [file-id revn thumbnail-uri background-color]}]
[{:keys [file-id revn thumbnail-id background-color]}]
(let [container (mf/use-ref)
visible? (h/use-visible container :once? true)]
(mf/with-effect [file-id revn visible? thumbnail-uri]
(when (and visible? (not thumbnail-uri))
(mf/with-effect [file-id revn visible? thumbnail-id]
(when (and visible? (not thumbnail-id))
(->> (ask-for-thumbnail file-id revn)
(rx/subs! (fn [url]
(st/emit! (dd/set-file-thumbnail file-id url)))
(rx/subs! (fn [thumbnail-id]
(st/emit! (dd/set-file-thumbnail file-id thumbnail-id)))
(fn [cause]
(log/error :hint "unable to render thumbnail"
:file-if file-id
@@ -90,9 +91,9 @@
:style {:background-color background-color}
:ref container}
(when visible?
(if thumbnail-uri
(if thumbnail-id
[:img {:class (stl/css :grid-item-thumbnail-image)
:src thumbnail-uri
:src (cf/resolve-media thumbnail-id)
:loading "lazy"
:decoding "async"}]
i/loader-pencil))]))
@@ -365,7 +366,7 @@
[:& grid-item-thumbnail
{:file-id (:id file)
:revn (:revn file)
:thumbnail-uri (:thumbnail-uri file)
:thumbnail-id (:thumbnail-id file)
:background-color (dm/get-in file [:data :options :background])}])
(when (and (:is-shared file) (not library-view?))

View File

@@ -33,7 +33,6 @@
[cuerdas.core :as str]
[rumext.v2 :as mf]))
(def ^:private arrow-icon
(i/icon-xref :arrow (stl/css :arrow-icon)))
@@ -62,10 +61,10 @@
{::mf/wrap [mf/memo]
::mf/wrap-props false}
[{:keys [section team]}]
(let [on-nav-members (mf/use-fn #(st/emit! (dd/go-to-team-members)))
on-nav-settings (mf/use-fn #(st/emit! (dd/go-to-team-settings)))
on-nav-invitations (mf/use-fn #(st/emit! (dd/go-to-team-invitations)))
on-nav-webhooks (mf/use-fn #(st/emit! (dd/go-to-team-webhooks)))
(let [on-nav-members (mf/use-fn #(st/emit! (dd/go-to-team-members)))
on-nav-settings (mf/use-fn #(st/emit! (dd/go-to-team-settings)))
on-nav-invitations (mf/use-fn #(st/emit! (dd/go-to-team-invitations)))
on-nav-webhooks (mf/use-fn #(st/emit! (dd/go-to-team-webhooks)))
members-section? (= section :dashboard-team-members)
settings-section? (= section :dashboard-team-settings)
@@ -157,21 +156,22 @@
(dd/fetch-team-invitations)))
on-error
(fn [{:keys [type code] :as error}]
(cond
(and (= :validation type)
(= :profile-is-muted code))
(st/emit! (msg/error (tr "errors.profile-is-muted"))
(modal/hide))
(fn [_form cause]
(let [{:keys [type code] :as error} (ex-data cause)]
(cond
(and (= :validation type)
(= :profile-is-muted code))
(st/emit! (msg/error (tr "errors.profile-is-muted"))
(modal/hide))
(and (= :validation type)
(or (= :member-is-muted code)
(= :email-has-permanent-bounces code)))
(swap! error-text (tr "errors.email-spam-or-permanent-bounces" (:email error)))
(or (= :member-is-muted code)
(= :email-has-permanent-bounces code)
(= :email-has-complaints code))
(swap! error-text (tr "errors.email-spam-or-permanent-bounces" (:email error)))
:else
(st/emit! (msg/error (tr "errors.generic"))
(modal/hide))))
:else
(st/emit! (msg/error (tr "errors.generic"))
(modal/hide)))))
on-submit
(fn [form]
@@ -563,22 +563,24 @@
on-error
(mf/use-fn
(mf/deps email)
(fn [{:keys [type code] :as error}]
(cond
(and (= :validation type)
(= :profile-is-muted code))
(rx/of (msg/error (tr "errors.profile-is-muted")))
(fn [cause]
(let [{:keys [type code] :as error} (ex-data cause)]
(cond
(and (= :validation type)
(= :profile-is-muted code))
(rx/of (msg/error (tr "errors.profile-is-muted")))
(and (= :validation type)
(= :member-is-muted code))
(rx/of (msg/error (tr "errors.member-is-muted")))
(and (= :validation type)
(= :member-is-muted code))
(rx/of (msg/error (tr "errors.member-is-muted")))
(and (= :validation type)
(= :email-has-permanent-bounces code))
(rx/of (msg/error (tr "errors.email-has-permanent-bounces" email)))
(and (= :restriction type)
(or (= :email-has-permanent-bounces code)
(= :email-has-complaints code)))
(rx/of (msg/error (tr "errors.email-has-permanent-bounces" email)))
:else
(rx/throw error))))
:else
(rx/throw cause)))))
on-delete
(mf/use-fn
@@ -588,7 +590,6 @@
mdata {:on-success #(st/emit! (dd/fetch-team-invitations))}]
(st/emit! (dd/delete-team-invitation (with-meta params mdata))))))
on-resend-success
(mf/use-fn
(fn []

View File

@@ -70,8 +70,9 @@
(on-update-submit form)
(on-create-submit form))))
(mf/defc team-form-modal {::mf/register modal/components
::mf/register-as :team-form}
(mf/defc team-form-modal
{::mf/register modal/components
::mf/register-as :team-form}
[{:keys [team] :as props}]
(let [initial (mf/use-memo (fn [] (or team {})))
form (fm/use-form :spec ::team-form

View File

@@ -11,6 +11,7 @@
[app.common.colors :as clr]
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.main.data.events :as ev]
[app.main.data.exports :as de]
[app.main.data.modal :as modal]
[app.main.refs :as refs]
@@ -23,6 +24,7 @@
[app.util.strings :as ust]
[beicon.v2.core :as rx]
[cuerdas.core :as str]
[potok.v2.core :as ptk]
[rumext.v2 :as mf]))
(def ^:private neutral-icon
@@ -35,10 +37,9 @@
(i/icon-xref :close (stl/css :close-icon)))
(mf/defc export-multiple-dialog
[{:keys [exports title cmd no-selection]}]
[{:keys [exports title cmd no-selection origin]}]
(let [lstate (mf/deref refs/export)
in-progress? (:in-progress lstate)
exports (mf/use-state exports)
all-exports (deref exports)
@@ -61,7 +62,11 @@
(st/emit! (modal/hide)
(de/request-multiple-export
{:exports enabled-exports
:cmd cmd})))
:cmd cmd})
(ptk/event
::ev/event {::ev/name "export-shapes"
::ev/origin origin
:num-shapes (count enabled-exports)})))
on-toggle-enabled
(mf/use-fn
@@ -186,23 +191,25 @@
(mf/defc export-shapes-dialog
{::mf/register modal/components
::mf/register-as :export-shapes}
[{:keys [exports]}]
[{:keys [exports origin]}]
(let [title (tr "dashboard.export-shapes.title")]
[:& export-multiple-dialog
{:exports exports
:title title
:cmd :export-shapes
:no-selection shapes-no-selection}]))
:no-selection shapes-no-selection
:origin origin}]))
(mf/defc export-frames
{::mf/register modal/components
::mf/register-as :export-frames}
[{:keys [exports]}]
[{:keys [exports origin]}]
(let [title (tr "dashboard.export-frames.title")]
[:& export-multiple-dialog
{:exports exports
:title title
:cmd :export-frames}]))
:cmd :export-frames
:origin origin}]))
(mf/defc export-progress-widget
{::mf/wrap [mf/memo]}

View File

@@ -39,21 +39,22 @@
(s/keys :req-un [::email-1 ::email-2]))
(defn- on-error
[form error]
(case (:code (ex-data error))
:email-already-exists
(swap! form (fn [data]
(let [error {:message (tr "errors.email-already-exists")}]
(assoc-in data [:errors :email-1] error))))
[form cause]
(let [{:keys [code] :as error} (ex-data cause)]
(case code
:email-already-exists
(swap! form (fn [data]
(let [error {:message (tr "errors.email-already-exists")}]
(assoc-in data [:errors :email-1] error))))
:profile-is-muted
(rx/of (msg/error (tr "errors.profile-is-muted")))
:profile-is-muted
(rx/of (msg/error (tr "errors.profile-is-muted")))
:email-has-permanent-bounces
(let [email (get @form [:data :email-1])]
(rx/of (msg/error (tr "errors.email-has-permanent-bounces" email))))
(:email-has-permanent-bounces
:email-has-complaints)
(rx/of (msg/error (tr "errors.email-has-permanent-bounces" (:email error))))
(rx/throw error)))
(rx/throw cause))))
(defn- on-success
[profile data]

View File

@@ -8,6 +8,7 @@
(:require-macros [app.main.style :as stl])
(:require
[app.common.data :as d]
[app.main.data.events :as ev]
[app.main.data.exports :as de]
[app.main.refs :as refs]
[app.main.store :as st]
@@ -17,6 +18,7 @@
[app.util.dom :as dom]
[app.util.i18n :refer [tr c]]
[app.util.keyboard :as kbd]
[potok.v2.core :as ptk]
[rumext.v2 :as mf]))
(mf/defc exports
@@ -62,8 +64,14 @@
(cond-> share-id (assoc :share-id share-id)))
exports (mapv #(merge % defaults) @exports)]
(if (= 1 (count exports))
(st/emit! (de/request-simple-export {:export (first exports)}))
(st/emit! (de/request-multiple-export {:exports exports :filename filename}))))))
(st/emit!
(de/request-simple-export {:export (first exports)})
(ptk/event
::ev/event {::ev/name "export-shapes" ::ev/origin "viewer" :num-shapes 1}))
(st/emit!
(de/request-multiple-export {:exports exports})
(ptk/event
::ev/event {::ev/name "export-shapes" ::ev/origin "viewer" :num-shapes (count exports)}))))))
add-export
(mf/use-callback

View File

@@ -126,7 +126,7 @@
(let [params (prepare-params options)
params (assoc params :file-id (:id file))]
(st/emit! (dc/create-share-link params)
(ptk/event ::ev/event {::ev/name "create-shared-link"
(ptk/event ::ev/event {::ev/name "create-share-link"
::ev/origin "viewer"
:can-comment (:who-comment params)
:can-inspect-code (:who-inspect params)}))))
@@ -137,7 +137,9 @@
(st/emit! (msg/show {:type :info
:notification-type :toast
:content (tr "common.share-link.link-copied-success")
:timeout 1000})))
:timeout 1000})
(ptk/event ::ev/event {::ev/name "copy-share-link"
::ev/origin "viewer"})))
try-delete-link
(fn [_]

View File

@@ -508,7 +508,7 @@
(on-add-shared event))))
on-export-shapes
(mf/use-fn #(st/emit! (de/show-workspace-export-dialog)))
(mf/use-fn #(st/emit! (de/show-workspace-export-dialog {:origin "workspace:menu"})))
on-export-shapes-key-down
(mf/use-fn

View File

@@ -64,24 +64,25 @@
[{:keys [grow-type id migrate] :as shape} node]
;; Check if we need to update the size because it's auto-width or auto-height
;; Update the position-data of every text fragment
(p/let [position-data (tsp/calc-position-data id)]
;; At least one paragraph needs to be inside the bounding box
(when (gsht/overlaps-position-data? shape position-data)
(st/emit! (dwt/update-position-data id position-data)))
(->> (tsp/calc-position-data id)
(p/fmap (fn [position-data]
;; At least one paragraph needs to be inside the bounding box
(when (gsht/overlaps-position-data? shape position-data)
(st/emit! (dwt/update-position-data id position-data)))
(when (contains? #{:auto-height :auto-width} grow-type)
(let [{:keys [width height]}
(-> (dom/query node ".paragraph-set")
(dom/get-bounding-rect))
(when (contains? #{:auto-height :auto-width} grow-type)
(let [{:keys [width height]}
(-> (dom/query node ".paragraph-set")
(dom/get-bounding-rect))
width (mth/ceil width)
height (mth/ceil height)]
(when (and (not (mth/almost-zero? width))
(not (mth/almost-zero? height))
(not migrate))
(st/emit! (dwt/resize-text id width height)))))
width (mth/ceil width)
height (mth/ceil height)]
(when (and (not (mth/almost-zero? width))
(not (mth/almost-zero? height))
(not migrate))
(st/emit! (dwt/resize-text id width height)))))
(st/emit! (dwt/clean-text-modifier id))))
(st/emit! (dwt/clean-text-modifier id))))))
(defn- update-text-modifier
[{:keys [grow-type id] :as shape} node]

View File

@@ -8,6 +8,7 @@
(:require-macros [app.main.style :as stl])
(:require
[app.common.data :as d]
[app.main.data.events :as ev]
[app.main.data.exports :as de]
[app.main.data.workspace.shapes :as dwsh]
[app.main.data.workspace.state-helpers :as wsh]
@@ -20,6 +21,7 @@
[app.util.dom :as dom]
[app.util.i18n :refer [tr c]]
[app.util.keyboard :as kbd]
[potok.v2.core :as ptk]
[rumext.v2 :as mf]))
(def exports-attrs
@@ -75,8 +77,12 @@
(cond-> sname
(some? suffix)
(str suffix))
(st/emit! (de/request-simple-export {:export (merge export defaults)})))
(st/emit! (de/show-workspace-export-dialog {:selected (reverse ids)})))
(st/emit!
(de/request-simple-export {:export (merge export defaults)})
(ptk/event
::ev/event {::ev/name "export-shapes" ::ev/origin "workspace:sidebar" :num-shapes 1})))
(st/emit!
(de/show-workspace-export-dialog {:selected (reverse ids) :origin "workspace:sidebar"})))
;; In other all cases we only allowed to have a single
;; shape-id because multiple shape-ids are handled
@@ -88,8 +94,14 @@
exports (mapv #(merge % defaults) exports)]
(if (= 1 (count exports))
(let [export (first exports)]
(st/emit! (de/request-simple-export {:export export})))
(st/emit! (de/request-multiple-export {:exports exports})))))))
(st/emit!
(de/request-simple-export {:export export})
(ptk/event
::ev/event {::ev/name "export-shapes" ::ev/origin "workspace:sidebar" :num-shapes 1})))
(st/emit!
(de/request-multiple-export {:exports exports})
(ptk/event
::ev/event {::ev/name "export-shapes" ::ev/origin "workspace:sidebar" :num-shapes (count exports)})))))))
;; TODO: maybe move to specific events for avoid to have this logic here?
add-export

View File

@@ -28,7 +28,7 @@
(= cur-point handler-c2)
(= pre-point handler-c1))
(assoc content index {:command :line-to
:params cur-point})
:params (into {} cur-point)})
content)))]
(reduce process-command content with-prev)))
@@ -69,10 +69,13 @@
h2 (gpt/add to-p dv2)]
(-> cmd
(assoc :command :curve-to)
(assoc-in [:params :c1x] (:x h1))
(assoc-in [:params :c1y] (:y h1))
(assoc-in [:params :c2x] (:x h2))
(assoc-in [:params :c2y] (:y h2)))))
(update :params (fn [params]
;; ensure plain map
(-> (into {} params)
(assoc :c1x (:x h1))
(assoc :c1y (:y h1))
(assoc :c2x (:x h2))
(assoc :c2y (:y h2))))))))
(defn is-curve?
[content point]

View File

@@ -7,6 +7,7 @@
(ns app.worker.export
(:require
[app.common.data :as d]
[app.common.json :as json]
[app.common.media :as cm]
[app.common.text :as ct]
[app.common.types.components-list :as ctkl]
@@ -16,7 +17,6 @@
[app.main.render :as r]
[app.main.repo :as rp]
[app.util.http :as http]
[app.util.json :as json]
[app.util.webapi :as wapi]
[app.util.zip :as uz]
[app.worker.impl :as impl]

View File

@@ -9,18 +9,21 @@
(:require
["jszip" :as zip]
[app.common.data :as d]
[app.common.exceptions :as ex]
[app.common.files.builder :as fb]
[app.common.geom.point :as gpt]
[app.common.geom.shapes.path :as gpa]
[app.common.json :as json]
[app.common.logging :as log]
[app.common.media :as cm]
[app.common.pprint :as pp]
[app.common.schema :as sm]
[app.common.text :as ct]
[app.common.time :as tm]
[app.common.uuid :as uuid]
[app.main.repo :as rp]
[app.util.http :as http]
[app.util.i18n :as i18n :refer [tr]]
[app.util.json :as json]
[app.util.sse :as sse]
[app.util.webapi :as wapi]
[app.util.zip :as uz]
@@ -37,6 +40,29 @@
(def conjv (fnil conj []))
(def ^:private iso-date-rx
"Incomplete ISO regex for detect datetime-like values on strings"
#"^\d{4}-[01]\d-[0-3]\dT[0-2]\d:[0-5]\d:[0-5]\d.*")
(defn read-json-key
[m]
(or (sm/parse-uuid m)
(json/read-kebab-key m)))
(defn read-json-val
[m]
(cond
(and (string? m)
(re-matches sm/uuid-rx m))
(uuid/uuid m)
(and (string? m)
(re-matches iso-date-rx m))
(or (ex/ignoring (tm/parse-instant m)) m)
:else
m))
(defn get-file
"Resolves the file inside the context given its id and the data"
([context type]
@@ -62,22 +88,22 @@
parse-svg? (and (not= type :media) (str/ends-with? path "svg"))
parse-json? (and (not= type :media) (str/ends-with? path "json"))
no-parse? (or (= type :media)
(not (or parse-svg? parse-json?)))
file-type (if (or parse-svg? parse-json?) "text" "blob")]
file-type (if (or parse-svg? parse-json?) "text" "blob")]
(log/debug :action "parsing" :path path)
(cond->> (uz/get-file (:zip context) path file-type)
parse-svg?
(rx/map (comp tubax/xml->clj :content))
(let [stream (->> (uz/get-file (:zip context) path file-type)
(rx/map :content))]
parse-json?
(rx/map (comp json/decode :content))
(cond
parse-svg?
(rx/map tubax/xml->clj stream)
no-parse?
(rx/map :content)))))
parse-json?
(rx/map #(json/decode % :key-fn read-json-key :val-fn read-json-val) stream)
:else
stream)))))
(defn progress!
([context type]
@@ -319,7 +345,7 @@
(assoc :id (resolve old-id)))
(cond-> (< (:version context 1) 2)
(translate-frame type file))
;; Shapes inside the deleted component should be stored with absolute coordinates
;; Shapes inside the deleted component should be stored with absolute coordinates
;; so we calculate that with the x and y stored in the context
(cond-> (:x context)
(assoc :x (:x context)))
@@ -569,7 +595,7 @@
(update :id resolve))]
(fb/add-library-color file color)))]
(->> (get-file context :colors-list)
(rx/merge-map (comp d/kebab-keys parser/string->uuid))
(rx/merge-map identity)
(rx/mapcat
(fn [[id color]]
(let [color (assoc color :id id)
@@ -599,7 +625,7 @@
(if (:has-typographies context)
(let [resolve (:resolve context)]
(->> (get-file context :typographies)
(rx/merge-map (comp d/kebab-keys parser/string->uuid))
(rx/merge-map identity)
(rx/map (fn [[id typography]]
(-> typography
(d/kebab-keys)
@@ -613,7 +639,7 @@
(if (:has-media context)
(let [resolve (:resolve context)]
(->> (get-file context :media-list)
(rx/merge-map (comp d/kebab-keys parser/string->uuid))
(rx/merge-map identity)
(rx/mapcat
(fn [[id media]]
(let [media (-> media
@@ -725,7 +751,6 @@
(rx/filter (fn [data] (= "application/zip" (:type data))))
(rx/merge-map #(zip/loadAsync (:body %)))
(rx/merge-map #(get-file {:zip %} :manifest))
(rx/map (comp d/kebab-keys parser/string->uuid))
(rx/map
(fn [data]
;; Checks if the file is exported with components v2 and the current team only

View File

@@ -10,8 +10,8 @@
[app.common.data.macros :as dm]
[app.common.files.repair :as cfr]
[app.common.files.validate :as cfv]
[app.common.json :as json]
[app.common.logging :as l]
[app.common.math :as mth]
[app.common.transit :as t]
[app.common.types.file :as ctf]
[app.common.uri :as u]
@@ -97,26 +97,14 @@
(effect-fn input)
(rf result input)))))
(defn prettify
"Prepare x for cleaner output when logged."
[x]
(cond
(map? x) (d/mapm #(prettify %2) x)
(vector? x) (mapv prettify x)
(seq? x) (map prettify x)
(set? x) (into #{} (map prettify) x)
(number? x) (mth/precision x 4)
(uuid? x) (str/concat "#uuid " x)
:else x))
(defn ^:export logjs
([str] (tap (partial logjs str)))
([str val]
(js/console.log str (clj->js (prettify val) :keyword-fn (fn [v] (str/concat v))))
(js/console.log str (json/->js val))
val))
(when (exists? js/window)
(set! (.-dbg ^js js/window) clj->js)
(set! (.-dbg ^js js/window) json/->js)
(set! (.-pp ^js js/window) pprint))
(defonce widget-style "
@@ -479,7 +467,7 @@
(let [result (map (fn [row]
(update row :id str))
result)]
(js/console.table (clj->js result))))
(js/console.table (json/->js result))))
(fn [cause]
(js/console.log "EE:" cause))))
nil))

View File

@@ -1 +1 @@
2.1.0
2.1.4