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

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

Browse source
This commit is contained in:
Alejandro Alonso 2023-01-02 13:48:36 +01:00
commit 31661d5484
57 changed files with 1838 additions and 495 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
CHANGES.md
View file

@ -36,6 +36,7 @@
- Fix selection stroke missing in properties of multiple texts [Taiga #4048](https://tree.taiga.io/project/penpot/issue/4048)
- Fix missing create component menu for frames [Github #2670](https://github.com/penpot/penpot/issues/2670)
- Fix "currentColor" is not converted when importing SVG [Github 2276](https://github.com/penpot/penpot/issues/2276)
- Fix incorrect color in properties of multiple bool shapes [Taiga #4355](https://tree.taiga.io/project/penpot/issue/4355)
### :arrow_up: Deps updates

3
backend/deps.edn
View file

@ -55,7 +55,8 @@
;; Pretty Print specs
pretty-spec/pretty-spec {:mvn/version "0.1.4"}
software.amazon.awssdk/s3 {:mvn/version "2.19.5"}}
software.amazon.awssdk/s3 {:mvn/version "2.19.8"}
}
:paths ["src" "resources" "target/classes"]
:aliases

36
backend/src/app/config.clj
View file

@ -102,7 +102,7 @@
(s/def ::audit-log-archive-uri ::us/string)
(s/def ::audit-log-http-handler-concurrency ::us/integer)
(s/def ::admins ::us/set-of-strings)
(s/def ::admins ::us/set-of-valid-emails)
(s/def ::file-change-snapshot-every ::us/integer)
(s/def ::file-change-snapshot-timeout ::dt/duration)
@ -130,6 +130,16 @@
(s/def ::database-min-pool-size ::us/integer)
(s/def ::database-max-pool-size ::us/integer)
(s/def ::quotes-teams-per-profile ::us/integer)
(s/def ::quotes-projects-per-team ::us/integer)
(s/def ::quotes-invitations-per-team ::us/integer)
(s/def ::quotes-profiles-per-team ::us/integer)
(s/def ::quotes-files-per-project ::us/integer)
(s/def ::quotes-files-per-team ::us/integer)
(s/def ::quotes-font-variants-per-team ::us/integer)
(s/def ::quotes-comment-threads-per-file ::us/integer)
(s/def ::quotes-comments-per-file ::us/integer)
(s/def ::default-blob-version ::us/integer)
(s/def ::error-report-webhook ::us/string)
(s/def ::user-feedback-destination ::us/string)
@ -192,15 +202,10 @@
(s/def ::srepl-host ::us/string)
(s/def ::srepl-port ::us/integer)
(s/def ::assets-storage-backend ::us/keyword)
(s/def ::fdata-storage-backend ::us/keyword)
(s/def ::storage-assets-fs-directory ::us/string)
(s/def ::storage-assets-s3-bucket ::us/string)
(s/def ::storage-assets-s3-region ::us/keyword)
(s/def ::storage-assets-s3-endpoint ::us/string)
(s/def ::storage-fdata-s3-bucket ::us/string)
(s/def ::storage-fdata-s3-region ::us/keyword)
(s/def ::storage-fdata-s3-prefix ::us/string)
(s/def ::storage-fdata-s3-endpoint ::us/string)
(s/def ::telemetry-uri ::us/string)
(s/def ::telemetry-with-taiga ::us/boolean)
(s/def ::tenant ::us/string)
@ -277,6 +282,17 @@
::profile-complaint-max-age
::profile-complaint-threshold
::public-uri
::quotes-teams-per-profile
::quotes-projects-per-team
::quotes-invitations-per-team
::quotes-profiles-per-team
::quotes-files-per-project
::quotes-files-per-team
::quotes-font-variants-per-team
::quotes-comment-threads-per-file
::quotes-comments-per-file
::redis-uri
::registration-domain-whitelist
::rpc-rlimit-config
@ -306,11 +322,6 @@
::storage-assets-s3-bucket
::storage-assets-s3-region
::storage-assets-s3-endpoint
::fdata-storage-backend
::storage-fdata-s3-bucket
::storage-fdata-s3-region
::storage-fdata-s3-prefix
::storage-fdata-s3-endpoint
::telemetry-enabled
::telemetry-uri
::telemetry-referer
@ -321,7 +332,8 @@
[:enable-backend-api-doc
:enable-backend-worker
:enable-secure-session-cookies
:enable-email-verification])
:enable-email-verification
:enable-quotes])
(defn- parse-flags
[config]

1
backend/src/app/db.clj
View file

@ -167,6 +167,7 @@
(instance? javax.sql.DataSource v))
(s/def ::pool pool?)
(s/def ::conn-or-pool some?)
(defn closed?
[pool]

18
backend/src/app/emails.clj
View file

@ -257,15 +257,17 @@
"Schedule an already defined email to be sent using asynchronously
using worker task."
[{:keys [::conn ::factory] :as context}]
(us/verify fn? factory)
(us/verify some? conn)
(let [email (factory context)]
(wrk/submit! (assoc email
::wrk/task :sendmail
::wrk/delay 0
::wrk/max-retries 4
::wrk/priority 200
::wrk/conn conn))))
(let [email (if factory
(factory context)
(dissoc context ::conn))]
(wrk/submit! (merge
{::wrk/task :sendmail
::wrk/delay 0
::wrk/max-retries 4
::wrk/priority 200
::wrk/conn conn}
email))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; SENDMAIL FN / TASK HANDLER

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

@ -302,7 +302,10 @@
{:name "0097-mod-profile-table"
:fn (mg/resource "app/migrations/sql/0097-mod-profile-table.sql")}
])
{:name "0098-add-quotes-table"
:fn (mg/resource "app/migrations/sql/0098-add-quotes-table.sql")}
])
(defmethod ig/init-key ::migrations [_ _] migrations)

82
backend/src/app/migrations/sql/0098-add-quotes-table.sql Normal file
View file

@ -0,0 +1,82 @@
CREATE TABLE usage_quote (
id uuid NOT NULL DEFAULT uuid_generate_v4() PRIMARY KEY,
target text NOT NULL,
quote bigint NOT NULL,
profile_id uuid NULL REFERENCES profile(id) ON DELETE CASCADE DEFERRABLE,
project_id uuid NULL REFERENCES project(id) ON DELETE CASCADE DEFERRABLE,
team_id uuid NULL REFERENCES team(id) ON DELETE CASCADE DEFERRABLE,
file_id uuid NULL REFERENCES file(id) ON DELETE CASCADE DEFERRABLE
);
ALTER TABLE usage_quote
ALTER COLUMN target SET STORAGE external;
CREATE INDEX usage_quote__profile_id__idx ON usage_quote(profile_id, target);
CREATE INDEX usage_quote__project_id__idx ON usage_quote(project_id, target);
CREATE INDEX usage_quote__team_id__idx ON usage_quote(team_id, target);
-- DROP TABLE IF EXISTS usage_quote_test;
-- CREATE TABLE usage_quote_test (
-- id bigserial NOT NULL PRIMARY KEY,
-- target text NOT NULL,
-- quote bigint NOT NULL,
-- profile_id bigint NULL,
-- team_id bigint NULL,
-- project_id bigint NULL,
-- file_id bigint NULL
-- );
-- ALTER TABLE usage_quote_test
-- ALTER COLUMN target SET STORAGE external;
-- CREATE INDEX usage_quote_test__profile_id__idx ON usage_quote_test(profile_id, target);
-- CREATE INDEX usage_quote_test__project_id__idx ON usage_quote_test(project_id, target);
-- CREATE INDEX usage_quote_test__team_id__idx ON usage_quote_test(team_id, target);
-- -- CREATE INDEX usage_quote_test__target__idx ON usage_quote_test(target);
-- DELETE FROM usage_quote_test;
-- INSERT INTO usage_quote_test (target, quote, profile_id, team_id, project_id)
-- SELECT 'files-per-project', 50*RANDOM(), 2000*RANDOM(), null, null
-- FROM generate_series(1, 5000);
-- INSERT INTO usage_quote_test (target, quote, profile_id, team_id, project_id)
-- SELECT 'files-per-project', 200*RANDOM(), 300*RANDOM(), 300*RANDOM(), null
-- FROM generate_series(1, 1000);
-- INSERT INTO usage_quote_test (target, quote, profile_id, team_id, project_id)
-- SELECT 'files-per-project', 100*RANDOM(), 300*RANDOM(), null, 300*RANDOM()
-- FROM generate_series(1, 1000);
-- INSERT INTO usage_quote_test (target, quote, profile_id, team_id, project_id)
-- SELECT 'files-per-project', 100*RANDOM(), 300*RANDOM(), 300*RANDOM(), 300*RANDOM()
-- FROM generate_series(1, 1000);
-- INSERT INTO usage_quote_test (target, quote, profile_id, team_id, project_id)
-- SELECT 'files-per-project', 30*RANDOM(), null, 2000*RANDOM(), null
-- FROM generate_series(1, 5000);
-- INSERT INTO usage_quote_test (target, quote, profile_id, team_id, project_id)
-- SELECT 'files-per-project', 10*RANDOM(), null, null, 2000*RANDOM()
-- FROM generate_series(1, 5000);
-- VACUUM ANALYZE usage_quote_test;
-- select * from usage_quote_test
-- where target = 'files-per-project'
-- and profile_id = 1
-- and team_id is null
-- and project_id is null;
-- select * from usage_quote_test
-- where target = 'files-per-project'
-- and ((team_id = 1 and (profile_id = 1 or profile_id is null)) or
-- (profile_id = 1 and team_id is null and project_id is null));
-- select * from usage_quote_test
-- where target = 'files-per-project'
-- and ((project_id = 1 and (profile_id = 1 or profile_id is null)) or
-- (team_id = 1 and (profile_id = 1 or profile_id is null)) or
-- (profile_id = 1 and team_id is null and project_id is null));

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

@ -26,7 +26,7 @@
[app.rpc.rlimit :as rlimit]
[app.storage :as-alias sto]
[app.util.services :as sv]
[app.util.time :as ts]
[app.util.time :as dt]
[app.worker :as-alias wrk]
[clojure.spec.alpha :as s]
[integrant.core :as ig]
@ -115,7 +115,9 @@
[methods {:keys [profile-id session-id params] :as request} respond raise]
(let [cmd (keyword (:type params))
etag (yrq/get-header request "if-none-match")
data (into {::http/request request ::cond/key etag} params)
data (into {::request-at (dt/now)
::http/request request
::cond/key etag} params)
data (if profile-id
(assoc data ::profile-id profile-id ::session-id session-id)
(dissoc data ::profile-id))
@ -133,7 +135,7 @@
[{:keys [metrics ::metrics-id]} f mdata]
(let [labels (into-array String [(::sv/name mdata)])]
(fn [cfg params]
(let [tp (ts/tpoint)]
(let [tp (dt/tpoint)]
(p/finally
(f cfg params)
(fn [_ _]

444
backend/src/app/rpc/commands/comments.clj
View file

@ -6,9 +6,11 @@
(ns app.rpc.commands.comments
(:require
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.geom.point :as gpt]
[app.common.spec :as us]
[app.common.uuid :as uuid]
[app.db :as db]
[app.loggers.audit :as-alias audit]
[app.loggers.webhooks :as-alias webhooks]
@ -16,16 +18,14 @@
[app.rpc.commands.files :as files]
[app.rpc.commands.teams :as teams]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.util.blob :as blob]
[app.rpc.quotes :as quotes]
[app.util.pointer-map :as pmap]
[app.util.retry :as rtry]
[app.util.services :as sv]
[app.util.time :as dt]
[clojure.spec.alpha :as s]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUERY COMMANDS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; --- GENERAL PURPOSE INTERNAL HELPERS
(defn decode-row
[{:keys [participants position] :as row}]
@ -33,9 +33,61 @@
(db/pgpoint? position) (assoc :position (db/decode-pgpoint position))
(db/pgobject? participants) (assoc :participants (db/decode-transit-pgobject participants))))
(def sql:get-file
"select f.id, f.modified_at, f.revn, f.features,
f.project_id, p.team_id, f.data
from file as f
join project as p on (p.id = f.project_id)
where f.id = ?
and f.deleted_at is null")
(defn- get-file
"A specialized version of get-file for comments module."
[conn file-id page-id]
(binding [pmap/*load-fn* (partial files/load-pointer conn file-id)]
(if-let [{:keys [data] :as file} (some-> (db/exec-one! conn [sql:get-file file-id]) (files/decode-row))]
(-> file
(assoc :page-name (dm/get-in data [:pages-index page-id :name]))
(assoc :page-id page-id))
(ex/raise :type :not-found
:code :object-not-found
:hint "file not found"))))
(defn- get-comment-thread
[conn thread-id & {:keys [for-update?]}]
(-> (db/get-by-id conn :comment-thread thread-id {:for-update for-update?})
(decode-row)))
(defn- get-comment
[conn comment-id & {:keys [for-update?]}]
(db/get-by-id conn :comment comment-id {:for-update for-update?}))
(defn- get-next-seqn
[conn file-id]
(let [sql "select (f.comment_thread_seqn + 1) as next_seqn from file as f where f.id = ?"
res (db/exec-one! conn [sql file-id])]
(:next-seqn res)))
(def sql:upsert-comment-thread-status
"insert into comment_thread_status (thread_id, profile_id, modified_at)
values (?, ?, ?)
on conflict (thread_id, profile_id)
do update set modified_at = ?
returning modified_at;")
(defn upsert-comment-thread-status!
([conn profile-id thread-id]
(upsert-comment-thread-status! conn profile-id thread-id (dt/now)))
([conn profile-id thread-id mod-at]
(db/exec-one! conn [sql:upsert-comment-thread-status thread-id profile-id mod-at mod-at])))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUERY COMMANDS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; --- COMMAND: Get Comment Threads
(declare retrieve-comment-threads)
(declare ^:private get-comment-threads)
(s/def ::team-id ::us/uuid)
(s/def ::file-id ::us/uuid)
@ -48,9 +100,10 @@
(sv/defmethod ::get-comment-threads
{::doc/added "1.15"}
[{:keys [pool] :as cfg} params]
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id share-id] :as params}]
(with-open [conn (db/open pool)]
(retrieve-comment-threads conn params)))
(files/check-comment-permissions! conn profile-id file-id share-id)
(get-comment-threads conn profile-id file-id)))
(def sql:comment-threads
"select distinct on (ct.id)
@ -74,15 +127,14 @@
where ct.file_id = ?
window w as (partition by c.thread_id order by c.created_at asc)")
(defn retrieve-comment-threads
[conn {:keys [::rpc/profile-id file-id share-id]}]
(files/check-comment-permissions! conn profile-id file-id share-id)
(defn- get-comment-threads
[conn profile-id file-id]
(->> (db/exec! conn [sql:comment-threads profile-id file-id])
(into [] (map decode-row))))
;; --- COMMAND: Get Unread Comment Threads
(declare retrieve-unread-comment-threads)
(declare ^:private get-unread-comment-threads)
(s/def ::team-id ::us/uuid)
(s/def ::get-unread-comment-threads
@ -94,7 +146,7 @@
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id team-id] :as params}]
(with-open [conn (db/open pool)]
(teams/check-read-permissions! conn profile-id team-id)
(retrieve-unread-comment-threads conn params)))
(get-unread-comment-threads conn profile-id team-id)))
(def sql:comment-threads-by-team
"select distinct on (ct.id)
@ -123,19 +175,17 @@
(str "with threads as (" sql:comment-threads-by-team ")"
"select * from threads where count_unread_comments > 0"))
(defn retrieve-unread-comment-threads
[conn {:keys [::rpc/profile-id team-id]}]
(defn- get-unread-comment-threads
[conn profile-id team-id]
(->> (db/exec! conn [sql:unread-comment-threads-by-team profile-id team-id])
(into [] (map decode-row))))
;; --- COMMAND: Get Single Comment Thread
(s/def ::id ::us/uuid)
(s/def ::share-id (s/nilable ::us/uuid))
(s/def ::get-comment-thread
(s/keys :req [::rpc/profile-id]
:req-un [::file-id ::id]
:req-un [::file-id ::us/id]
:opt-un [::share-id]))
(sv/defmethod ::get-comment-thread
@ -148,19 +198,10 @@
(-> (db/exec-one! conn [sql profile-id file-id id])
(decode-row)))))
(defn get-comment-thread
[conn {:keys [::rpc/profile-id file-id id] :as params}]
(let [sql (str "with threads as (" sql:comment-threads ")"
"select * from threads where id = ?")]
(-> (db/exec-one! conn [sql profile-id file-id id])
(decode-row))))
;; --- COMMAND: Retrieve Comments
(declare get-comments)
(declare ^:private get-comments)
(s/def ::file-id ::us/uuid)
(s/def ::share-id (s/nilable ::us/uuid))
(s/def ::thread-id ::us/uuid)
(s/def ::get-comments
(s/keys :req [::rpc/profile-id]
@ -171,16 +212,16 @@
{::doc/added "1.15"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id thread-id share-id] :as params}]
(with-open [conn (db/open pool)]
(let [thread (db/get-by-id conn :comment-thread thread-id)]
(files/check-comment-permissions! conn profile-id (:file-id thread) share-id))
(get-comments conn thread-id)))
(let [{:keys [file-id] :as thread} (get-comment-thread conn thread-id)]
(files/check-comment-permissions! conn profile-id file-id share-id)
(get-comments conn thread-id))))
(def sql:comments
"select c.* from comment as c
where c.thread_id = ?
order by c.created_at asc")
(defn get-comments
(defn- get-comments
[conn thread-id]
(->> (db/query conn :comment
{:thread-id thread-id}
@ -189,26 +230,6 @@
;; --- COMMAND: Get file comments users
(declare get-file-comments-users)
(s/def ::file-id ::us/uuid)
(s/def ::share-id (s/nilable ::us/uuid))
(s/def ::get-profiles-for-file-comments
(s/keys :req [::rpc/profile-id]
:req-un [::file-id]
:opt-un [::share-id]))
(sv/defmethod ::get-profiles-for-file-comments
"Retrieves a list of profiles with limited set of properties of all
participants on comment threads of the file."
{::doc/added "1.15"
::doc/changes ["1.15" "Imported from queries and renamed."]}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id share-id]}]
(with-open [conn (db/open pool)]
(files/check-comment-permissions! conn profile-id file-id share-id)
(get-file-comments-users conn file-id profile-id)))
;; All the profiles that had comment the file, plus the current
;; profile.
@ -231,20 +252,30 @@
[conn file-id profile-id]
(db/exec! conn [sql:file-comment-users file-id profile-id]))
(s/def ::get-profiles-for-file-comments
(s/keys :req [::rpc/profile-id]
:req-un [::file-id]
:opt-un [::share-id]))
(sv/defmethod ::get-profiles-for-file-comments
"Retrieves a list of profiles with limited set of properties of all
participants on comment threads of the file."
{::doc/added "1.15"
::doc/changes ["1.15" "Imported from queries and renamed."]}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id share-id]}]
(with-open [conn (db/open pool)]
(files/check-comment-permissions! conn profile-id file-id share-id)
(get-file-comments-users conn file-id profile-id)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MUTATION COMMANDS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(declare ^:private create-comment-thread)
;; --- COMMAND: Create Comment Thread
(declare upsert-comment-thread-status!)
(declare create-comment-thread)
(declare retrieve-page-name)
(s/def ::page-id ::us/uuid)
(s/def ::file-id ::us/uuid)
(s/def ::share-id (s/nilable ::us/uuid))
(s/def ::position ::gpt/point)
(s/def ::content ::us/string)
(s/def ::frame-id ::us/uuid)
@ -257,63 +288,75 @@
(sv/defmethod ::create-comment-thread
{::doc/added "1.15"
::webhooks/event? true}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id share-id] :as params}]
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id ::rpc/request-at file-id page-id share-id position content frame-id]}]
(db/with-atomic [conn pool]
(files/check-comment-permissions! conn profile-id file-id share-id)
(let [{:keys [team-id project-id page-name] :as file} (get-file conn file-id page-id)]
(files/check-comment-permissions! conn profile-id file-id share-id)
(rtry/with-retry {::rtry/when rtry/conflict-exception?
::rtry/max-retries 3
::rtry/label "create-comment-thread"}
(create-comment-thread conn params))))
(run! (partial quotes/check-quote! conn)
(list {::quotes/id ::quotes/comment-threads-per-file
::quotes/profile-id profile-id
::quotes/team-id team-id
::quotes/project-id project-id
::quotes/file-id file-id}
{::quotes/id ::quotes/comments-per-file
::quotes/profile-id profile-id
::quotes/team-id team-id
::quotes/project-id project-id
::quotes/file-id file-id}))
(defn- retrieve-next-seqn
[conn file-id]
(let [sql "select (f.comment_thread_seqn + 1) as next_seqn from file as f where f.id = ?"
res (db/exec-one! conn [sql file-id])]
(:next-seqn res)))
(defn create-comment-thread
[conn {:keys [::rpc/profile-id file-id page-id position content frame-id] :as params}]
(let [seqn (retrieve-next-seqn conn file-id)
now (dt/now)
pname (retrieve-page-name conn params)
thread (db/insert! conn :comment-thread
{:file-id file-id
:owner-id profile-id
:participants (db/tjson #{profile-id})
:page-name pname
:page-id page-id
:created-at now
:modified-at now
:seqn seqn
:position (db/pgpoint position)
:frame-id frame-id})]
(rtry/with-retry {::rtry/when rtry/conflict-exception?
::rtry/max-retries 3
::rtry/label "create-comment-thread"}
(create-comment-thread conn
{:created-at request-at
:profile-id profile-id
:file-id file-id
:page-id page-id
:page-name page-name
:position position
:content content
:frame-id frame-id})))))
;; Create a comment entry
(db/insert! conn :comment
{:thread-id (:id thread)
:owner-id profile-id
:created-at now
:modified-at now
:content content})
(defn- create-comment-thread
[conn {:keys [profile-id file-id page-id page-name created-at position content frame-id]}]
(let [;; NOTE: we take the next seq number from a separate query because the whole
;; operation can be retried on conflict, and in this case the new seq shold be
;; retrieved from the database.
seqn (get-next-seqn conn file-id)
thread-id (uuid/next)
thread (db/insert! conn :comment-thread
{:id thread-id
:file-id file-id
:owner-id profile-id
:participants (db/tjson #{profile-id})
:page-name page-name
:page-id page-id
:created-at created-at
:modified-at created-at
:seqn seqn
:position (db/pgpoint position)
:frame-id frame-id})
comment (db/insert! conn :comment
{:id (uuid/next)
:thread-id thread-id
:owner-id profile-id
:created-at created-at
:modified-at created-at
:content content})]
;; Make the current thread as read.
(upsert-comment-thread-status! conn profile-id (:id thread))
(upsert-comment-thread-status! conn profile-id thread-id created-at)
;; Optimistic update of current seq number on file.
(db/update! conn :file
{:comment-thread-seqn seqn}
{:id file-id})
(select-keys thread [:id :file-id :page-id])))
(defn- retrieve-page-name
[conn {:keys [file-id page-id]}]
(let [{:keys [data]} (db/get-by-id conn :file file-id)
data (blob/decode data)]
(get-in data [:pages-index page-id :name])))
(-> thread
(select-keys [:id :file-id :page-id])
(assoc :comment-id (:id comment)))))
;; --- COMMAND: Update Comment Thread Status
@ -329,23 +372,9 @@
{::doc/added "1.15"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id id share-id] :as params}]
(db/with-atomic [conn pool]
(let [cthr (db/get-by-id conn :comment-thread id {:for-update true})]
(when-not cthr
(ex/raise :type :not-found))
(files/check-comment-permissions! conn profile-id (:file-id cthr) share-id)
(upsert-comment-thread-status! conn profile-id (:id cthr)))))
(def sql:upsert-comment-thread-status
"insert into comment_thread_status (thread_id, profile_id)
values (?, ?)
on conflict (thread_id, profile_id)
do update set modified_at = clock_timestamp()
returning modified_at;")
(defn upsert-comment-thread-status!
[conn profile-id thread-id]
(db/exec-one! conn [sql:upsert-comment-thread-status thread-id profile-id]))
(let [{:keys [file-id] :as thread} (get-comment-thread conn id :for-update? true)]
(files/check-comment-permissions! conn profile-id file-id share-id)
(upsert-comment-thread-status! conn profile-id id))))
;; --- COMMAND: Update Comment Thread
@ -360,12 +389,8 @@
{::doc/added "1.15"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id id is-resolved share-id] :as params}]
(db/with-atomic [conn pool]
(let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
(when-not thread
(ex/raise :type :not-found))
(files/check-comment-permissions! conn profile-id (:file-id thread) share-id)
(let [{:keys [file-id] :as thread} (get-comment-thread conn id :for-update? true)]
(files/check-comment-permissions! conn profile-id file-id share-id)
(db/update! conn :comment-thread
{:is-resolved is-resolved}
{:id id})
@ -374,6 +399,7 @@
;; --- COMMAND: Add Comment
(declare get-comment-thread)
(declare create-comment)
(s/def ::create-comment
@ -384,66 +410,52 @@
(sv/defmethod ::create-comment
{::doc/added "1.15"
::webhooks/event? true}
[{:keys [pool] :as cfg} params]
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id ::rpc/request-at thread-id share-id content] :as params}]
(db/with-atomic [conn pool]
(create-comment conn params)))
(let [{:keys [file-id page-id] :as thread} (get-comment-thread conn thread-id :for-update? true)
{:keys [team-id project-id page-name] :as file} (get-file conn file-id page-id)]
(defn create-comment
[conn {:keys [::rpc/profile-id thread-id content share-id] :as params}]
(let [thread (-> (db/get-by-id conn :comment-thread thread-id {:for-update true})
(decode-row))
pname (retrieve-page-name conn thread)]
(files/check-comment-permissions! conn profile-id (:id file) share-id)
(quotes/check-quote! conn
{::quotes/id ::quotes/comments-per-file
::quotes/profile-id profile-id
::quotes/team-id team-id
::quotes/project-id project-id
::quotes/file-id (:id file)})
;; Standard Checks
(when-not thread (ex/raise :type :not-found))
;; Update the page-name cached attribute on comment thread table.
(when (not= page-name (:page-name thread))
(db/update! conn :comment-thread
{:page-name page-name}
{:id thread-id}))
;; Permission Checks
(files/check-comment-permissions! conn profile-id (:file-id thread) share-id)
(let [comment (db/insert! conn :comment
{:id (uuid/next)
:created-at request-at
:modified-at request-at
:thread-id thread-id
:owner-id profile-id
:content content})
props {:file-id file-id
:share-id nil}]
;; Update the page-name cachedattribute on comment thread table.
(when (not= pname (:page-name thread))
(db/update! conn :comment-thread
{:page-name pname}
{:id thread-id}))
;; Update thread modified-at attribute and assoc the current
;; profile to the participant set.
(db/update! conn :comment-thread
{:modified-at request-at
:participants (-> (:participants thread #{})
(conj profile-id)
(db/tjson))}
{:id thread-id})
;; NOTE: is important that all timestamptz related fields are
;; created or updated on the database level for avoid clock
;; inconsistencies (some user sees something read that is not
;; read, etc...)
(let [ppants (:participants thread #{})
comment (db/insert! conn :comment
{:thread-id thread-id
:owner-id profile-id
:content content})]
;; Update the current profile status in relation to the
;; current thread.
(upsert-comment-thread-status! conn profile-id thread-id request-at)
;; NOTE: this is done in SQL instead of using db/update!
;; helper because currently the helper does not allow pass raw
;; function call parameters to the underlying prepared
;; statement; in a future when we fix/improve it, this can be
;; changed to use the helper.
;; Update thread modified-at attribute and assoc the current
;; profile to the participant set.
(let [ppants (conj ppants profile-id)
sql "update comment_thread
set modified_at = clock_timestamp(),
participants = ?
where id = ?"]
(db/exec-one! conn [sql (db/tjson ppants) thread-id]))
;; Update the current profile status in relation to the
;; current thread.
(upsert-comment-thread-status! conn profile-id thread-id)
;; Return the created comment object.
(rph/with-meta comment
{::audit/props {:file-id (:file-id thread)
:share-id nil}}))))
(vary-meta comment assoc ::audit/props props)))))
;; --- COMMAND: Update Comment
(declare update-comment)
(s/def ::update-comment
(s/keys :req [::rpc/profile-id]
:req-un [::id ::content]
@ -451,72 +463,70 @@
(sv/defmethod ::update-comment
{::doc/added "1.15"}
[{:keys [pool] :as cfg} params]
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id ::rpc/request-at id share-id content] :as params}]
(db/with-atomic [conn pool]
(update-comment conn params)))
(let [{:keys [thread-id] :as comment} (get-comment conn id :for-update? true)
{:keys [file-id page-id owner-id] :as thread} (get-comment-thread conn thread-id :for-update? true)]
(defn update-comment
[conn {:keys [::rpc/profile-id id content share-id] :as params}]
(let [comment (db/get-by-id conn :comment id {:for-update true})
_ (when-not comment (ex/raise :type :not-found))
thread (db/get-by-id conn :comment-thread (:thread-id comment) {:for-update true})
_ (when-not thread (ex/raise :type :not-found))
pname (retrieve-page-name conn thread)]
(files/check-comment-permissions! conn profile-id file-id share-id)
(files/check-comment-permissions! conn profile-id (:file-id thread) share-id)
;; Don't allow edit comments to not owners
(when-not (= owner-id profile-id)
(ex/raise :type :validation
:code :not-allowed))
;; Don't allow edit comments to not owners
(when-not (= (:owner-id thread) profile-id)
(ex/raise :type :validation
:code :not-allowed))
(db/update! conn :comment
{:content content
:modified-at (dt/now)}
{:id (:id comment)})
(db/update! conn :comment-thread
{:modified-at (dt/now)
:page-name pname}
{:id (:id thread)})
nil))
(let [{:keys [page-name] :as file} (get-file conn file-id page-id)]
(db/update! conn :comment
{:content content
:modified-at request-at}
{:id id})
(db/update! conn :comment-thread
{:modified-at request-at
:page-name page-name}
{:id thread-id})
nil))))
;; --- COMMAND: Delete Comment Thread
(s/def ::delete-comment-thread
(s/keys :req [::rpc/profile-id]
:req-un [::id]))
:req-un [::id]
:opt-un [::share-id]))
(sv/defmethod ::delete-comment-thread
{::doc/added "1.15"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id id share-id] :as params}]
(db/with-atomic [conn pool]
(let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
(when-not (= (:owner-id thread) profile-id)
(let [{:keys [owner-id file-id] :as thread} (get-comment-thread conn id :for-update? true)]
(files/check-comment-permissions! conn profile-id file-id share-id)
(when-not (= owner-id profile-id)
(ex/raise :type :validation
:code :not-allowed))
(db/delete! conn :comment-thread {:id id})
nil)))
;; --- COMMAND: Delete comment
(s/def ::delete-comment
(s/keys :req [::rpc/profile-id]
:req-un [::id]))
:req-un [::id]
:opt-un [::share-id]))
(sv/defmethod ::delete-comment
{::doc/added "1.15"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id id share-id] :as params}]
(db/with-atomic [conn pool]
(let [comment (db/get-by-id conn :comment id {:for-update true})]
(when-not (= (:owner-id comment) profile-id)
(let [{:keys [owner-id thread-id] :as comment} (get-comment conn id :for-update? true)
{:keys [file-id] :as thread} (get-comment-thread conn thread-id)]
(files/check-comment-permissions! conn profile-id file-id share-id)
(when-not (= owner-id profile-id)
(ex/raise :type :validation
:code :not-allowed))
(db/delete! conn :comment {:id id}))))
;; --- COMMAND: Update comment thread position
(s/def ::update-comment-thread-position
@ -528,10 +538,10 @@
{::doc/added "1.15"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id id position frame-id share-id] :as params}]
(db/with-atomic [conn pool]
(let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
(files/check-comment-permissions! conn profile-id (:file-id thread) share-id)
(let [{:keys [file-id] :as thread} (get-comment-thread conn id :for-update? true)]
(files/check-comment-permissions! conn profile-id file-id share-id)
(db/update! conn :comment-thread
{:modified-at (dt/now)
{:modified-at (::rpc/request-at params)
:position (db/pgpoint position)
:frame-id frame-id}
{:id (:id thread)})
@ -548,10 +558,10 @@
{::doc/added "1.15"}
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id id frame-id share-id] :as params}]
(db/with-atomic [conn pool]
(let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
(files/check-comment-permissions! conn profile-id (:file-id thread) share-id)
(let [{:keys [file-id] :as thread} (get-comment-thread conn id :for-update? true)]
(files/check-comment-permissions! conn profile-id file-id share-id)
(db/update! conn :comment-thread
{:modified-at (dt/now)
{:modified-at (::rpc/request-at params)
:frame-id frame-id}
{:id (:id thread)})
{:id id})
nil)))

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

@ -151,11 +151,14 @@
(def check-read-permissions!
(perms/make-check-fn has-read-permissions?))
;; A user has comment permissions if she has read permissions, or comment permissions
;; A user has comment permissions if she has read permissions, or
;; explicit comment permissions through the share-id
(defn check-comment-permissions!
[conn profile-id file-id share-id]
(let [can-read (has-read-permissions? conn profile-id file-id)
can-comment (has-comment-permissions? conn profile-id file-id share-id)]
(let [perms (get-permissions conn profile-id file-id share-id)
can-read (has-read-permissions? perms)
can-comment (has-comment-permissions? perms)]
(when-not (or can-read can-comment)
(ex/raise :type :not-found
:code :object-not-found

9
backend/src/app/rpc/commands/files/create.clj
View file

@ -18,6 +18,7 @@
[app.rpc.doc :as-alias doc]
[app.rpc.permissions :as perms]
[app.rpc.queries.projects :as proj]
[app.rpc.quotes :as quotes]
[app.util.blob :as blob]
[app.util.objects-map :as omap]
[app.util.pointer-map :as pmap]
@ -84,6 +85,12 @@
(proj/check-edition-permissions! conn profile-id project-id)
(let [team-id (files/get-team-id conn project-id)
params (assoc params :profile-id profile-id)]
(run! (partial quotes/check-quote! conn)
(list {::quotes/id ::quotes/files-per-project
::quotes/team-id team-id
::quotes/profile-id profile-id
::quotes/project-id project-id}))
(-> (create-file conn params)
(vary-meta assoc ::audit/props {:team-id team-id})))))

2
backend/src/app/rpc/commands/files/temp.clj
View file

@ -40,7 +40,7 @@
[{:keys [pool] :as cfg} {:keys [::rpc/profile-id project-id] :as params}]
(db/with-atomic [conn pool]
(proj/check-edition-permissions! conn profile-id project-id)
(files.create/create-file conn (assoc params :deleted-at (dt/in-future {:days 1})))))
(files.create/create-file conn (assoc params :profile-id profile-id :deleted-at (dt/in-future {:days 1})))))
;; --- MUTATION COMMAND: update-temp-file

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

@ -23,6 +23,7 @@
[app.rpc.helpers :as rph]
[app.rpc.permissions :as perms]
[app.rpc.queries.profile :as profile]
[app.rpc.quotes :as quotes]
[app.storage :as sto]
[app.tokens :as tokens]
[app.util.services :as sv]
@ -297,6 +298,9 @@
{::doc/added "1.17"}
[{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
(db/with-atomic [conn pool]
(quotes/check-quote! conn {::quotes/id ::quotes/teams-per-profile
::quotes/profile-id profile-id})
(create-team conn (assoc params :profile-id profile-id))))
(defn create-team
@ -739,6 +743,17 @@
team (db/get-by-id conn :team team-id)
emails (cond-> (or emails #{}) (string? email) (conj email))]
(run! (partial quotes/check-quote! conn)
(list {::quotes/id ::quotes/invitations-per-team
::quotes/profile-id profile-id
::quotes/team-id (:id team)
::quotes/incr (count emails)}
{::quotes/id ::quotes/profiles-per-team
::quotes/profile-id profile-id
::quotes/team-id (:id team)
::quotes/incr (count emails)}))
(when-not (:is-admin perms)
(ex/raise :type :validation
:code :insufficient-permissions))
@ -785,6 +800,18 @@
:role role}))
(run! (partial create-invitation cfg)))
(run! (partial quotes/check-quote! conn)
(list {::quotes/id ::quotes/teams-per-profile
::quotes/profile-id profile-id}
{::quotes/id ::quotes/invitations-per-team
::quotes/profile-id profile-id
::quotes/team-id (:id team)
::quotes/incr (count emails)}
{::quotes/id ::quotes/profiles-per-team
::quotes/profile-id profile-id
::quotes/team-id (:id team)
::quotes/incr (count emails)}))
(-> team
(vary-meta assoc ::audit/props {:invitations (count emails)})
(rph/with-defer

6
backend/src/app/rpc/commands/verify_token.clj
View file

@ -16,6 +16,7 @@
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.queries.profile :as profile]
[app.rpc.quotes :as quotes]
[app.tokens :as tokens]
[app.tokens.spec.team-invitation :as-alias spec.team-invitation]
[app.util.services :as sv]
@ -96,6 +97,11 @@
(ex/raise :type :restriction
:code :profile-blocked))
(quotes/check-quote! conn
{::quotes/id ::quotes/profiles-per-team
::quotes/profile-id (:id member)
::quotes/team-id team-id})
;; Insert the invited member to the team
(db/insert! conn :team-profile-rel params {:on-conflict-do-nothing true})

4
backend/src/app/rpc/mutations/fonts.clj
View file

@ -18,6 +18,7 @@
[app.rpc.commands.teams :as teams]
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.quotes :as quotes]
[app.storage :as sto]
[app.util.services :as sv]
[app.util.time :as dt]
@ -49,6 +50,9 @@
[{:keys [pool] :as cfg} {:keys [team-id profile-id] :as params}]
(let [cfg (update cfg :storage media/configure-assets-storage)]
(teams/check-edition-permissions! pool profile-id team-id)
(quotes/check-quote! pool {::quotes/id ::quotes/font-variants-per-team
::quotes/profile-id profile-id
::quotes/team-id team-id})
(create-font-variant cfg params)))
(defn create-font-variant

5
backend/src/app/rpc/mutations/projects.clj
View file

@ -14,6 +14,7 @@
[app.rpc.doc :as-alias doc]
[app.rpc.helpers :as rph]
[app.rpc.queries.projects :as proj]
[app.rpc.quotes :as quotes]
[app.util.services :as sv]
[app.util.time :as dt]
[clojure.spec.alpha :as s]))
@ -37,6 +38,10 @@
[{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
(db/with-atomic [conn pool]
(teams/check-edition-permissions! conn profile-id team-id)
(quotes/check-quote! conn {::quotes/id ::quotes/projects-per-team
::quotes/profile-id profile-id
::quotes/team-id team-id})
(let [project (teams/create-project conn params)]
(teams/create-project-role conn profile-id (:id project) :owner)

339
backend/src/app/rpc/quotes.clj Normal file
View file

@ -0,0 +1,339 @@
;; 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.rpc.quotes
"Penpot resource usage quotes."
(:require
[app.common.exceptions :as ex]
[app.common.logging :as l]
[app.common.spec :as us]
[app.config :as cf]
[app.db :as db]
[app.util.time :as dt]
[app.worker :as wrk]
[clojure.spec.alpha :as s]
[cuerdas.core :as str]))
(defmulti check-quote ::id)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; PUBLIC API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(s/def ::conn ::db/conn-or-pool)
(s/def ::file-id ::us/uuid)
(s/def ::team-id ::us/uuid)
(s/def ::project-id ::us/uuid)
(s/def ::profile-id ::us/uuid)
(s/def ::incr (s/and int? pos?))
(s/def ::target ::us/string)
(s/def ::quote
(s/keys :req [::id ::profile-id]
:opt [::conn
::team-id
::project-id
::file-id
::incr]))
(def ^:private enabled (volatile! true))
(defn enable!
"Enable quotes checking at runtime (from server REPL)."
[]
(vswap! enabled (constantly true)))
(defn disable!
"Disable quotes checking at runtime (from server REPL)."
[]
(vswap! enabled (constantly false)))
(defn check-quote!
[conn quote]
(us/assert! ::db/conn-or-pool conn)
(us/assert! ::quote quote)
(when (contains? cf/flags :quotes)
(when @enabled
(check-quote (assoc quote ::conn conn ::target (name (::id quote)))))))
(defn- send-notification!
[{:keys [::conn] :as params}]
(l/warn :hint "max quote reached"
:target (::target params)
:profile-id (some-> params ::profile-id str)
:team-id (some-> params ::team-id str)
:project-id (some-> params ::project-id str)
:file-id (some-> params ::file-id str)
:quote (::quote params)
:total (::total params)
:incr (::inc params 1))
(when-let [admins (seq (cf/get :admins))]
(let [subject (str/istr "[quotes:notification]: max quote reached ~(::target params)")
content (str/istr "- Param: profile-id '~(::profile-id params)}'\n"
"- Param: team-id '~(::team-id params)'\n"
"- Param: project-id '~(::project-id params)'\n"
"- Param: file-id '~(::file-id params)'\n"
"- Quote ID: '~(::target params)'\n"
"- Max: ~(::quote params)\n"
"- Total: ~(::total params) (INCR ~(::incr params 1))\n")]
(wrk/submit! {::wrk/task :sendmail
::wrk/delay (dt/duration "30s")
::wrk/max-retries 4
::wrk/priority 200
::wrk/conn conn
::wrk/dedupe true
::wrk/label "quotes-notification"
:to (vec admins)
:subject subject
:body [{:type "text/plain"
:content content}]}))))
(defn- generic-check!
[{:keys [::conn ::incr ::quote-sql ::count-sql ::default ::target] :or {incr 1} :as params}]
(let [quote (->> (db/exec! conn quote-sql)
(map :quote)
(reduce max (- Integer/MAX_VALUE)))
quote (if (pos? quote) quote default)
total (->> (db/exec! conn count-sql) first :total)]
(when (> (+ total incr) quote)
(if (contains? cf/flags :soft-quotes)
(send-notification! (assoc params ::quote quote ::total total))
(ex/raise :type :restriction
:code :max-quote-reached
:target target
:quote quote
:count total)))))
(def ^:private sql:get-quotes-1
"select id, quote from usage_quote
where target = ?
and profile_id = ?
and team_id is null
and project_id is null
and file_id is null;")
(def ^:private sql:get-quotes-2
"select id, quote from usage_quote
where target = ?
and ((team_id = ? and (profile_id = ? or profile_id is null)) or
(profile_id = ? and team_id is null and project_id is null and file_id is null));")
(def ^:private sql:get-quotes-3
"select id, quote from usage_quote
where target = ?
and ((project_id = ? and (profile_id = ? or profile_id is null)) or
(team_id = ? and (profile_id = ? or profile_id is null)) or
(profile_id = ? and team_id is null and project_id is null and file_id is null));")
(def ^:private sql:get-quotes-4
"select id, quote from usage_quote
where target = ?
and ((file_id = ? and (profile_id = ? or profile_id is null)) or
(project_id = ? and (profile_id = ? or profile_id is null)) or
(team_id = ? and (profile_id = ? or profile_id is null)) or
(profile_id = ? and team_id is null and project_id is null and file_id is null));")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUOTE: TEAMS-PER-PROFILE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private sql:get-teams-per-profile
"select count(*) as total
from team_profile_rel
where profile_id = ?")
(s/def ::profile-id ::us/uuid)
(s/def ::teams-per-profile
(s/keys :req [::profile-id ::target]))
(defmethod check-quote ::teams-per-profile
[{:keys [::profile-id ::target] :as quote}]
(us/assert! ::teams-per-profile quote)
(-> quote
(assoc ::default (cf/get :quotes-teams-per-profile Integer/MAX_VALUE))
(assoc ::quote-sql [sql:get-quotes-1 target profile-id])
(assoc ::count-sql [sql:get-teams-per-profile profile-id])
(generic-check!)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUOTE: PROJECTS-PER-TEAM
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private sql:get-projects-per-team
"select count(*) as total
from project as p
where p.team_id = ?
and p.deleted_at is null")
(s/def ::team-id ::us/uuid)
(s/def ::projects-per-team
(s/keys :req [::profile-id ::team-id ::target]))
(defmethod check-quote ::projects-per-team
[{:keys [::profile-id ::team-id ::target] :as quote}]
(-> quote
(assoc ::default (cf/get :quotes-projects-per-team Integer/MAX_VALUE))
(assoc ::quote-sql [sql:get-quotes-2 target team-id profile-id profile-id])
(assoc ::count-sql [sql:get-projects-per-team team-id])
(generic-check!)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUOTE: FONT-VARIANTS-PER-TEAM
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private sql:get-font-variants-per-team
"select count(*) as total
from team_font_variant as v
where v.team_id = ?")
(s/def ::font-variants-per-team
(s/keys :req [::profile-id ::team-id ::target]))
(defmethod check-quote ::font-variants-per-team
[{:keys [::profile-id ::team-id ::target] :as quote}]
(us/assert! ::font-variants-per-team quote)
(-> quote
(assoc ::default (cf/get :quotes-font-variants-per-team Integer/MAX_VALUE))
(assoc ::quote-sql [sql:get-quotes-2 target team-id profile-id profile-id])
(assoc ::count-sql [sql:get-font-variants-per-team team-id])
(generic-check!)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUOTE: INVITATIONS-PER-TEAM
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private sql:get-invitations-per-team
"select count(*) as total
from team_invitation
where team_id = ?")
(s/def ::invitations-per-team
(s/keys :req [::profile-id ::team-id ::target]))
(defmethod check-quote ::invitations-per-team
[{:keys [::profile-id ::team-id ::target] :as quote}]
(us/assert! ::invitations-per-team quote)
(-> quote
(assoc ::default (cf/get :quotes-invitations-per-team Integer/MAX_VALUE))
(assoc ::quote-sql [sql:get-quotes-2 target team-id profile-id profile-id])
(assoc ::count-sql [sql:get-invitations-per-team team-id])
(generic-check!)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUOTE: PROFILES-PER-TEAM
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private sql:get-profiles-per-team
"select (select count(*)
from team_profile_rel
where team_id = ?) +
(select count(*)
from team_invitation
where team_id = ?
and valid_until > now()) as total;")
;; NOTE: the total number of profiles is determined by the number of
;; effective members plus ongoing valid invitations.
(s/def ::profiles-per-team
(s/keys :req [::profile-id ::team-id ::target]))
(defmethod check-quote ::profiles-per-team
[{:keys [::profile-id ::team-id ::target] :as quote}]
(us/assert! ::profiles-per-team quote)
(-> quote
(assoc ::default (cf/get :quotes-profiles-per-team Integer/MAX_VALUE))
(assoc ::quote-sql [sql:get-quotes-2 target team-id profile-id profile-id])
(assoc ::count-sql [sql:get-profiles-per-team team-id team-id])
(generic-check!)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUOTE: FILES-PER-PROJECT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private sql:get-files-per-project
"select count(*) as total
from file as f
where f.project_id = ?
and f.deleted_at is null")
(s/def ::project-id ::us/uuid)
(s/def ::files-per-project
(s/keys :req [::profile-id ::project-id ::team-id ::target]))
(defmethod check-quote ::files-per-project
[{:keys [::profile-id ::project-id ::team-id ::target] :as quote}]
(us/assert! ::files-per-project quote)
(-> quote
(assoc ::default (cf/get :quotes-files-per-project Integer/MAX_VALUE))
(assoc ::quote-sql [sql:get-quotes-3 target project-id profile-id team-id profile-id profile-id])
(assoc ::count-sql [sql:get-files-per-project project-id])
(generic-check!)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUOTE: COMMENT-THREADS-PER-FILE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private sql:get-comment-threads-per-file
"select count(*) as total
from comment_thread as ct
where ct.file_id = ?")
(s/def ::comment-threads-per-file
(s/keys :req [::profile-id ::project-id ::team-id ::target]))
(defmethod check-quote ::comment-threads-per-file
[{:keys [::profile-id ::file-id ::team-id ::project-id ::target] :as quote}]
(us/assert! ::files-per-project quote)
(-> quote
(assoc ::default (cf/get :quotes-comment-threads-per-file Integer/MAX_VALUE))
(assoc ::quote-sql [sql:get-quotes-4 target file-id profile-id project-id
profile-id team-id profile-id profile-id])
(assoc ::count-sql [sql:get-comment-threads-per-file file-id])
(generic-check!)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUOTE: COMMENTS-PER-FILE
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def ^:private sql:get-comments-per-file
"select count(*) as total
from comment as c
join comment_thread as ct on (ct.id = c.thread_id)
where ct.file_id = ?")
(s/def ::comments-per-file
(s/keys :req [::profile-id ::project-id ::team-id ::target]))
(defmethod check-quote ::comments-per-file
[{:keys [::profile-id ::file-id ::team-id ::project-id ::target] :as quote}]
(us/assert! ::files-per-project quote)
(-> quote
(assoc ::default (cf/get :quotes-comments-per-file Integer/MAX_VALUE))
(assoc ::quote-sql [sql:get-quotes-4 target file-id profile-id project-id
profile-id team-id profile-id profile-id])
(assoc ::count-sql [sql:get-comments-per-file file-id])
(generic-check!)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; QUOTE: DEFAULT
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defmethod check-quote :default
[{:keys [::id]}]
(ex/raise :type :internal
:code :quote-not-defined
:quote id
:hint "backend using a quote identifier not defined"))

86
backend/src/app/storage/s3.clj
View file

@ -24,7 +24,9 @@
(:import
java.io.FilterInputStream
java.io.InputStream
java.net.URI
java.nio.ByteBuffer
java.nio.file.Path
java.time.Duration
java.util.Collection
java.util.Optional
@ -40,6 +42,7 @@
software.amazon.awssdk.http.nio.netty.SdkEventLoopGroup
software.amazon.awssdk.regions.Region
software.amazon.awssdk.services.s3.S3AsyncClient
software.amazon.awssdk.services.s3.S3Configuration
software.amazon.awssdk.services.s3.model.Delete
software.amazon.awssdk.services.s3.model.DeleteObjectRequest
software.amazon.awssdk.services.s3.model.DeleteObjectsRequest
@ -151,46 +154,51 @@
(defn build-s3-client
[{:keys [region endpoint executor]}]
(let [hclient (.. (NettyNioAsyncHttpClient/builder)
(eventLoopGroupBuilder (.. (SdkEventLoopGroup/builder)
(numberOfThreads (int default-eventloop-threads))))
(connectionAcquisitionTimeout default-timeout)
(connectionTimeout default-timeout)
(readTimeout default-timeout)
(writeTimeout default-timeout)
(build))
client (.. (S3AsyncClient/builder)
(asyncConfiguration (.. (ClientAsyncConfiguration/builder)
(advancedOption SdkAdvancedAsyncClientOption/FUTURE_COMPLETION_EXECUTOR
executor)
(build)))
(httpClient hclient)
(region (lookup-region region)))]
(let [aconfig (-> (ClientAsyncConfiguration/builder)
(.advancedOption SdkAdvancedAsyncClientOption/FUTURE_COMPLETION_EXECUTOR executor)
(.build))
(when-let [uri (some-> endpoint (java.net.URI.))]
(.endpointOverride client uri))
sconfig (-> (S3Configuration/builder)
(cond-> (some? endpoint) (.pathStyleAccessEnabled true))
(.build))
(let [client (.build client)]
(reify
clojure.lang.IDeref
(deref [_] client)
hclient (-> (NettyNioAsyncHttpClient/builder)
(.eventLoopGroupBuilder (-> (SdkEventLoopGroup/builder)
(.numberOfThreads (int default-eventloop-threads))))
(.connectionAcquisitionTimeout default-timeout)
(.connectionTimeout default-timeout)
(.readTimeout default-timeout)
(.writeTimeout default-timeout)
(.build))
java.lang.AutoCloseable
(close [_]
(.close hclient)
(.close client))))))
client (-> (S3AsyncClient/builder)
(.serviceConfiguration ^S3Configuration sconfig)
(.asyncConfiguration ^ClientAsyncConfiguration aconfig)
(.httpClient ^NettyNioAsyncHttpClient hclient)
(.region (lookup-region region))
(cond-> (some? endpoint) (.endpointOverride (URI. endpoint)))
(.build))]
(reify
clojure.lang.IDeref
(deref [_] client)
java.lang.AutoCloseable
(close [_]
(.close ^NettyNioAsyncHttpClient hclient)
(.close ^S3AsyncClient client)))))
(defn build-s3-presigner
[{:keys [region endpoint]}]
(if (string? endpoint)
(let [uri (java.net.URI. endpoint)]
(.. (S3Presigner/builder)
(endpointOverride uri)
(region (lookup-region region))
(build)))
(.. (S3Presigner/builder)
(region (lookup-region region))
(build))))
(let [config (-> (S3Configuration/builder)
(cond-> (some? endpoint) (.pathStyleAccessEnabled true))
(.build))]
(-> (S3Presigner/builder)
(cond-> (some? endpoint) (.endpointOverride (URI. endpoint)))
(.region (lookup-region region))
(.serviceConfiguration ^S3Configuration config)
(.build))))
(defn- make-request-body
[content]
@ -198,7 +206,7 @@
buff-size (* 1024 64)
sem (Semaphore. 0)
writer-fn (fn [s]
writer-fn (fn [^Subscriber s]
(try
(loop []
(.acquire sem 1)
@ -261,7 +269,7 @@
;; not, read the contento into memory using bytearrays.
(if (> size (* 1024 1024 2))
(p/let [path (tmp/tempfile :prefix "penpot.storage.s3.")
rxf (AsyncResponseTransformer/toFile path)
rxf (AsyncResponseTransformer/toFile ^Path path)
_ (.getObject ^S3AsyncClient client
^GetObjectRequest gor
^AsyncResponseTransformer rxf)]
@ -283,9 +291,9 @@
(key (str prefix (impl/id->path id)))
(build))
rxf (AsyncResponseTransformer/toBytes)
obj (.getObjectAsBytes ^S3AsyncClient client
^GetObjectRequest gor
^AsyncResponseTransformer rxf)]
obj (.getObject ^S3AsyncClient client
^GetObjectRequest gor
^AsyncResponseTransformer rxf)]
(.asByteArray ^ResponseBytes obj)))
(def default-max-age

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

@ -59,7 +59,8 @@
(def default-flags
[:enable-secure-session-cookies
:enable-email-verification
:enable-smtp])
:enable-smtp
:enable-quotes])
(defn state-init
[next]
@ -322,7 +323,9 @@
[{:keys [::type] :as data}]
(let [method-fn (get-in *system* [:app.rpc/methods :commands type])]
;; (app.common.pprint/pprint (:app.rpc/methods *system*))
(try-on! (method-fn (dissoc data ::type)))))
(try-on! (method-fn (-> data
(dissoc ::type)
(assoc :app.rpc/request-at (dt/now)))))))
(defn mutation!
[{:keys [::type profile-id] :as data}]

290
backend/test/backend_tests/rpc_comment_test.clj Normal file
View file

@ -0,0 +1,290 @@
;; 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 backend-tests.rpc-comment-test
(:require
[app.common.geom.point :as gpt]
[app.common.uuid :as uuid]
[app.db :as db]
[app.http :as http]
[app.rpc :as-alias rpc]
[app.rpc.commands.comments :as comments]
[app.rpc.cond :as cond]
[app.rpc.quotes :as-alias quotes]
[app.util.time :as dt]
[backend-tests.helpers :as th]
[clojure.test :as t]
[datoteka.core :as fs]
[mockery.core :refer [with-mocks]]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(t/deftest comment-and-threads-crud
(with-mocks [mock {:target 'app.config/get
:return (th/config-get-mock
{:quotes-teams-per-profile 200})}]
(let [profile-1 (th/create-profile* 1 {:is-active true})
profile-2 (th/create-profile* 2 {:is-active true})
team (th/create-team* 1 {:profile-id (:id profile-1)})
;; role (th/create-team-role* {:team-id (:id team)
;; :profile-id (:id profile-2)
;; :role :admin})
project (th/create-project* 1 {:team-id (:id team)
:profile-id (:id profile-1)})
file-1 (th/create-file* 1 {:profile-id (:id profile-1)
:project-id (:id project)})
file-2 (th/create-file* 2 {:profile-id (:id profile-1)
:project-id (:id project)})
page-id (get-in file-1 [:data :pages 0])]
(t/testing "comment thread creation"
(let [data {::th/type :create-comment-thread
::rpc/profile-id (:id profile-1)
:file-id (:id file-1)
:page-id page-id
:position (gpt/point 0)
:content "hello world"
:frame-id uuid/zero}
out (th/command! data)]
;; (th/print-result! out)
(t/is (th/success? out))
(let [result (:result out)]
(t/is (uuid? (:id result)))
(t/is (uuid? (:file-id result)))
(t/is (uuid? (:page-id result)))
(t/is (uuid? (:comment-id result)))
(t/is (= (:file-id result) (:id file-1)))
(t/is (= (:page-id result) page-id)))))
(t/testing "comment thread status update"
(let [thread (-> (th/db-query :comment-thread {:file-id (:id file-1)}) first)
;; comment (-> (th/db-query :comment {:thread-id (:id thread)}) first)
data {::th/type :update-comment-thread-status
::rpc/profile-id (:id profile-1)
:id (:id thread)}
status (th/db-get :comment-thread-status
{:thread-id (:id thread)
:profile-id (:id profile-1)})]
(t/is (= (:modified-at status) (:modified-at thread)))
(let [{:keys [result] :as out} (th/command! data)]
(t/is (th/success? out))
(t/is (dt/instant? (:modified-at result))))
(let [status' (th/db-get :comment-thread-status
{:thread-id (:id thread)
:profile-id (:id profile-1)})]
(t/is (not= (:modified-at status') (:modified-at thread))))))
(t/testing "comment thread status update 2"
(let [thread (-> (th/db-query :comment-thread {:file-id (:id file-1)}) first)
data {::th/type :update-comment-thread-status
::rpc/profile-id (:id profile-2)
:id (:id thread)}]
(let [{:keys [error] :as out} (th/command! data)]
;; (th/print-result! out)
(t/is (not (th/success? out)))
(t/is (= :not-found (th/ex-type error))))))
(t/testing "update comment thread"
(let [thread (-> (th/db-query :comment-thread {:file-id (:id file-1)}) first)
data {::th/type :update-comment-thread
::rpc/profile-id (:id profile-1)
:is-resolved true
:id (:id thread)}]
(t/is (false? (:is-resolved thread)))
(let [{:keys [result] :as out} (th/command! data)]
(t/is (th/success? out))
(t/is (nil? result)))
(let [thread (th/db-get :comment-thread {:id (:id thread)})]
(t/is (true? (:is-resolved thread))))))
(t/testing "create comment"
(let [thread (-> (th/db-query :comment-thread {:file-id (:id file-1)}) first)
data {::th/type :create-comment
::rpc/profile-id (:id profile-1)
:thread-id (:id thread)
:content "comment 2"}]
(let [{:keys [result] :as out} (th/command! data)
{:keys [modified-at]} (th/db-get :comment-thread-status
{:thread-id (:id thread)
:profile-id (:id profile-1)})]
;; (th/print-result! out)
(t/is (th/success? out))
(t/is (uuid? (:id result)))
(t/is (= (:owner-id result) (:id profile-1)))
(t/is (:modified-at result) modified-at))))
(t/testing "update comment"
(let [thread (-> (th/db-query :comment-thread {:file-id (:id file-1)}) first)
comment (-> (th/db-query :comment {:thread-id (:id thread) :content "comment 2"}) first)
data {::th/type :update-comment
::rpc/profile-id (:id profile-1)
:id (:id comment)
:content "comment 2 mod"}]
(let [{:keys [result] :as out} (th/command! data)]
;; (th/print-result! out)
(t/is (th/success? out))
(t/is (nil? result)))
(let [comment' (th/db-get :comment {:id (:id comment)})]
(t/is (not= (:modified-at comment) (:modified-at comment')))
(t/is (= (:content data) (:content comment'))))))
(t/testing "retrieve threads"
(let [data {::th/type :get-comment-threads
::rpc/profile-id (:id profile-1)
:file-id (:id file-1)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (th/success? out))
(let [[thread :as result] (:result out)]
(t/is (= 1 (count result)))
(t/is (= "Page-1" (:page-name thread)))
(t/is (= "hello world" (:content thread)))
(t/is (= 2 (:count-comments thread)))
(t/is (true? (:is-resolved thread))))))
(t/testing "unread comment threads"
(let [thread (-> (th/db-query :comment-thread {:file-id (:id file-1)}) first)
data {::th/type :get-unread-comment-threads
::rpc/profile-id (:id profile-1)}]
(let [{:keys [result] :as out} (th/command! (assoc data :team-id (:default-team-id profile-1)))]
(t/is (th/success? out))
(t/is (= [] result)))
(let [{:keys [error] :as out} (th/command! (assoc data :team-id (:default-team-id profile-2)))]
(t/is (not (th/success? out)))
(t/is (= :not-found (th/ex-type error))))
(let [{:keys [result] :as out} (th/command! (assoc data :team-id (:id team)))]
;; (th/print-result! out)
(t/is (th/success? out))
(let [[thread :as result] (:result out)]
(t/is (= 1 (count result)))))
(let [data {::th/type :update-comment-thread-status
::rpc/profile-id (:id profile-1)
:id (:id thread)}
out (th/command! data)]
(t/is (th/success? out)))
(let [{:keys [result] :as out} (th/command! (assoc data :team-id (:id team)))]
;; (th/print-result! out)
(t/is (th/success? out))
(let [result (:result out)]
(t/is (= 0 (count result)))))))
(t/testing "get comment thread"
(let [thread (-> (th/db-query :comment-thread {:file-id (:id file-1)}) first)
data {::th/type :get-comment-thread
::rpc/profile-id (:id profile-1)
:file-id (:id file-1)
:id (:id thread)}]
(let [{:keys [result] :as out} (th/command! data)]
;; (th/print-result! out)
(t/is (th/success? out))
(t/is (= (:id thread) (:id result))))))
(t/testing "get comments"
(let [thread (-> (th/db-query :comment-thread {:file-id (:id file-1)}) first)
data {::th/type :get-comments
::rpc/profile-id (:id profile-1)
:thread-id (:id thread)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (th/success? out))
(let [comments (:result out)]
(t/is (= 2 (count comments))))))
(t/testing "get profiles"
(let [data {::th/type :get-profiles-for-file-comments
::rpc/profile-id (:id profile-1)
:file-id (:id file-1)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (th/success? out))
(let [[profile :as profiles] (:result out)]
(t/is (= 1 (count profiles)))
(t/is (= (:id profile-1) (:id profile))))))
(t/testing "get profiles 2"
(let [data {::th/type :get-profiles-for-file-comments
::rpc/profile-id (:id profile-2)
:file-id (:id file-1)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (not (th/success? out)))
(t/is (= :not-found (th/ex-type (:error out))))))
(t/testing "delete comment"
(let [thread (-> (th/db-query :comment-thread {:file-id (:id file-1)}) first)
comment (-> (th/db-query :comment {:thread-id (:id thread) :content "comment 2 mod"}) first)
data {::th/type :delete-comment
::rpc/profile-id (:id profile-2)
:id (:id comment)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (not (th/success? out)))
(t/is (= :not-found (th/ex-type (:error out))))
(let [comments (th/db-query :comment {:thread-id (:id thread)})]
(t/is (= 2 (count comments))))))
(t/testing "delete comment 2"
(let [thread (-> (th/db-query :comment-thread {:file-id (:id file-1)}) first)
comment (-> (th/db-query :comment {:thread-id (:id thread) :content "comment 2 mod"}) first)
data {::th/type :delete-comment
::rpc/profile-id (:id profile-1)
:id (:id comment)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (th/success? out))
(let [comments (th/db-query :comment {:thread-id (:id thread)})]
(t/is (= 1 (count comments))))))
(t/testing "delete comment thread"
(let [thread (-> (th/db-query :comment-thread {:file-id (:id file-1)}) first)
data {::th/type :delete-comment-thread
::rpc/profile-id (:id profile-2)
:id (:id thread)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (not (th/success? out)))
(t/is (= :not-found (th/ex-type (:error out))))
(let [threads (th/db-query :comment-thread {:file-id (:id file-1)})]
(t/is (= 1 (count threads))))))
(t/testing "delete comment thread 2"
(let [thread (-> (th/db-query :comment-thread {:file-id (:id file-1)}) first)
data {::th/type :delete-comment-thread
::rpc/profile-id (:id profile-1)
:id (:id thread)}
out (th/command! data)]
;; (th/print-result! out)
(t/is (th/success? out))
(let [threads (th/db-query :comment-thread {:file-id (:id file-1)})]
(t/is (= 0 (count threads))))))
)))

68
backend/test/backend_tests/rpc_font_test.clj
View file

@ -6,52 +6,56 @@
(ns backend-tests.rpc-font-test
(:require
[backend-tests.helpers :as th]
[app.common.uuid :as uuid]
[app.db :as db]
[app.http :as http]
[app.storage :as sto]
[backend-tests.helpers :as th]
[clojure.test :as t]
[datoteka.fs :as fs]
[datoteka.io :as io]))
[datoteka.io :as io]
[mockery.core :refer [with-mocks]]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(t/deftest ttf-font-upload-1
(let [prof (th/create-profile* 1 {:is-active true})
team-id (:default-team-id prof)
proj-id (:default-project-id prof)
font-id (uuid/custom 10 1)
(with-mocks [mock {:target 'app.rpc.quotes/check-quote! :return nil}]
(let [prof (th/create-profile* 1 {:is-active true})
team-id (:default-team-id prof)
proj-id (:default-project-id prof)
font-id (uuid/custom 10 1)
ttfdata (-> (io/resource "backend_tests/test_files/font-1.ttf")
io/input-stream
io/read-as-bytes)
ttfdata (-> (io/resource "backend_tests/test_files/font-1.ttf")
io/input-stream
io/read-as-bytes)
params {::th/type :create-font-variant
:profile-id (:id prof)
:team-id team-id
:font-id font-id
:font-family "somefont"
:font-weight 400
:font-style "normal"
:data {"font/ttf" ttfdata}}
out (th/mutation! params)]
params {::th/type :create-font-variant
:profile-id (:id prof)
:team-id team-id
:font-id font-id
:font-family "somefont"
:font-weight 400
:font-style "normal"
:data {"font/ttf" ttfdata}}
out (th/mutation! params)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (uuid? (:id result)))
(t/is (uuid? (:ttf-file-id result)))
(t/is (uuid? (:otf-file-id result)))
(t/is (uuid? (:woff1-file-id result)))
(t/are [k] (= (get params k)
(get result k))
:team-id
:font-id
:font-family
:font-weight
:font-style))))
(t/is (= 1 (:call-count @mock)))
;; (th/print-result! out)
(t/is (nil? (:error out)))
(let [result (:result out)]
(t/is (uuid? (:id result)))
(t/is (uuid? (:ttf-file-id result)))
(t/is (uuid? (:otf-file-id result)))
(t/is (uuid? (:woff1-file-id result)))
(t/are [k] (= (get params k)
(get result k))
:team-id
:font-id
:font-family
:font-weight
:font-style)))))
(t/deftest ttf-font-upload-2
(let [prof (th/create-profile* 1 {:is-active true})

344
backend/test/backend_tests/rpc_quotes_test.clj Normal file
View file

@ -0,0 +1,344 @@
;; 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 backend-tests.rpc-quotes-test
(:require
[app.common.uuid :as uuid]
[app.db :as db]
[app.http :as http]
[app.rpc :as-alias rpc]
[app.rpc.cond :as cond]
[app.rpc.quotes :as-alias quotes]
[backend-tests.helpers :as th]
[clojure.test :as t]
[datoteka.core :as fs]
[mockery.core :refer [with-mocks]]))
(t/use-fixtures :once th/state-init)
(t/use-fixtures :each th/database-reset)
(t/deftest teams-per-profile-quote
(with-mocks [mock {:target 'app.config/get
:return (th/config-get-mock
{:quotes-teams-per-profile 2})}]
(let [profile-1 (th/create-profile* 1)
profile-2 (th/create-profile* 2)
data {::th/type :create-team
::rpc/profile-id (:id profile-1)}
check-ok! (fn [n]
(let [data (assoc data :name (str "team" n))
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (some? (:result out)))))
check-ko! (fn [n]
(let [data (assoc data :name (str "team" n))
out (th/command! data)]
;; (th/print-result! out)
(t/is (not (th/success? out)))
(let [error (:error out)]
(t/is (= :restriction (th/ex-type error)))
(t/is (= :max-quote-reached (th/ex-code error)))
(t/is (= "teams-per-profile" (:target (ex-data error)))))))]
(th/db-insert! :usage-quote
{:profile-id (:id profile-2)
:target "teams-per-profile"
:quote 100})
(check-ok! 1)
(check-ko! 2)
(th/db-insert! :usage-quote
{:profile-id (:id profile-1)
:target "teams-per-profile"
:quote 3})
(check-ok! 2)
(check-ko! 3))))
(t/deftest projects-per-team-quote
(with-mocks [mock {:target 'app.config/get
:return (th/config-get-mock
{:quotes-projects-per-team 2})}]
(let [profile-1 (th/create-profile* 1)
profile-2 (th/create-profile* 2)
team-id (:default-team-id profile-1)
data {::th/type :create-project
:profile-id (:id profile-1)
:team-id team-id}
check-ok! (fn [name]
(let [data (assoc data :name (str "project" name))
out (th/mutation! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (some? (:result out)))))
check-ko! (fn [name]
;; create second project
(let [data (assoc data :name (str "project" name))
out (th/mutation! data)]
;; (th/print-result! out)
(t/is (not (th/success? out)))
(let [error (:error out)]
(t/is (= :restriction (th/ex-type error)))
(t/is (= :max-quote-reached (th/ex-code error)))
(t/is (= "projects-per-team" (:target (ex-data error)))))))]
(check-ok! 1)
(check-ko! 2)
(th/db-insert! :usage-quote
{:team-id team-id
:target "projects-per-team"
:quote 3})
(th/db-insert! :usage-quote
{:team-id team-id
:profile-id (:id profile-2)
:target "projects-per-team"
:quote 10})
(check-ok! 2)
(check-ko! 3)
(th/db-insert! :usage-quote
{:team-id team-id
:profile-id (:id profile-1)
:target "projects-per-team"
:quote 4})
(check-ok! 3)
(check-ko! 4)
(th/db-insert! :usage-quote
{:profile-id (:id profile-1)
:target "projects-per-team"
:quote 5})
(check-ok! 4)
(check-ko! 5)
)))
(t/deftest invitations-per-team-quote
(with-mocks [mock {:target 'app.config/get
:return (th/config-get-mock
{:quotes-invitations-per-team 2})}]
(let [profile-1 (th/create-profile* 1)
profile-2 (th/create-profile* 2)
data {::th/type :create-team-invitations
::rpc/profile-id (:id profile-1)
:team-id (:default-team-id profile-1)
:role :editor}
check-ok! (fn [n]
(let [data (assoc data :emails [(str "foo" n "@example.net")])
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (some? (:result out)))))
check-ko! (fn [n]
(let [data (assoc data :emails [(str "foo" n "@example.net")])
out (th/command! data)]
;; (th/print-result! out)
(t/is (not (th/success? out)))
(let [error (:error out)]
(t/is (= :restriction (th/ex-type error)))
(t/is (= :max-quote-reached (th/ex-code error)))
(t/is (= "invitations-per-team" (:target (ex-data error)))))))]
(th/db-insert! :usage-quote
{:profile-id (:id profile-2)
:target "invitations-per-team"
:quote 100})
(th/db-insert! :usage-quote
{:team-id (:default-team-id profile-2)
:target "invitations-per-team"
:quote 100})
(check-ok! 1)
(check-ok! 2)
(check-ko! 3)
(th/db-insert! :usage-quote
{:team-id (:default-team-id profile-1)
:target "invitations-per-team"
:quote 3})
(th/db-insert! :usage-quote
{:team-id (:default-team-id profile-1)
:profile-id (:id profile-2)
:target "invitations-per-team"
:quote 100})
(check-ok! 3)
(check-ko! 4)
(th/db-insert! :usage-quote
{:team-id (:default-team-id profile-1)
:profile-id (:id profile-1)
:target "invitations-per-team"
:quote 4})
(check-ok! 4)
(check-ko! 5)
(th/db-insert! :usage-quote
{:profile-id (:id profile-1)
:target "invitations-per-team"
:quote 5})
(check-ok! 5)
(check-ko! 6))))
(t/deftest profiles-per-team-quote
(with-mocks [mock {:target 'app.config/get
:return (th/config-get-mock
{:quotes-profiles-per-team 3})}]
(let [profile-1 (th/create-profile* 1)
profile-2 (th/create-profile* 2)
data {::th/type :create-team-invitations
::rpc/profile-id (:id profile-1)
:team-id (:default-team-id profile-1)
:role :editor}
check-ok! (fn [n]
(let [data (assoc data :emails [(str "foo" n "@example.net")])
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (some? (:result out)))))
check-ko! (fn [n]
(let [data (assoc data :emails [(str "foo" n "@example.net")])
out (th/command! data)]
;; (th/print-result! out)
(t/is (not (th/success? out)))
(let [error (:error out)]
(t/is (= :restriction (th/ex-type error)))
(t/is (= :max-quote-reached (th/ex-code error)))
(t/is (= "profiles-per-team" (:target (ex-data error)))))))]
(th/create-team-role* {:team-id (:default-team-id profile-1)
:profile-id (:id profile-2)
:role :admin})
(th/db-insert! :usage-quote
{:profile-id (:id profile-2)
:target "profiles-per-team"
:quote 100})
(th/db-insert! :usage-quote
{:team-id (:default-team-id profile-2)
:target "profiles-per-team"
:quote 100})
(check-ok! 1)
(check-ko! 2)
(th/db-insert! :usage-quote
{:team-id (:default-team-id profile-1)
:target "profiles-per-team"
:quote 4})
(check-ok! 2)
(check-ko! 3))))
(t/deftest files-per-project-quote
(with-mocks [mock {:target 'app.config/get
:return (th/config-get-mock
{:quotes-files-per-project 1})}]
(let [profile-1 (th/create-profile* 1)
profile-2 (th/create-profile* 2)
project-1 (th/create-project* 1 {:profile-id (:id profile-1)
:team-id (:default-team-id profile-1)})
project-2 (th/create-project* 2 {:profile-id (:id profile-2)
:team-id (:default-team-id profile-2)})
data {::th/type :create-file
::rpc/profile-id (:id profile-1)
:project-id (:id project-1)}
check-ok! (fn [n]
(let [data (assoc data :name (str "file" n))
out (th/command! data)]
;; (th/print-result! out)
(t/is (nil? (:error out)))
(t/is (some? (:result out)))))
check-ko! (fn [n]
(let [data (assoc data :name (str "file" n))
out (th/command! data)]
;; (th/print-result! out)
(t/is (not (th/success? out)))
(let [error (:error out)]
(t/is (= :restriction (th/ex-type error)))
(t/is (= :max-quote-reached (th/ex-code error)))
(t/is (= "files-per-project" (:target (ex-data error)))))))]
(th/db-insert! :usage-quote
{:project-id (:id project-2)
:target "files-per-project"
:quote 100})
(th/db-insert! :usage-quote
{:team-id (:team-id project-2)
:target "files-per-project"
:quote 100})
(th/db-insert! :usage-quote
{:profile-id (:id profile-2)
:target "files-per-project"
:quote 100})
(check-ok! 1)
(check-ko! 2)
(th/db-insert! :usage-quote
{:project-id (:id project-1)
:target "files-per-project"
:quote 2})
(th/db-insert! :usage-quote
{:project-id (:id project-1)
:profile-id (:id profile-2)
:target "files-per-project"
:quote 100})
(check-ok! 2)
(check-ko! 3)
(th/db-insert! :usage-quote
{:team-id (:team-id project-1)
:target "files-per-project"
:quote 3})
(th/db-insert! :usage-quote
{:team-id (:team-id project-1)
:profile-id (:id profile-2)
:target "files-per-project"
:quote 100})
(check-ok! 3)
(check-ko! 4)
(th/db-insert! :usage-quote
{:profile-id (:id profile-1)
:target "files-per-project"
:quote 4})
(check-ok! 4)
(check-ko! 5)
)))

3
common/src/app/common/geom/point.cljc
View file

@ -13,6 +13,7 @@
:clj [clojure.core :as c])
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.exceptions :as ex]
[app.common.math :as mth]
[app.common.spec :as us]
[clojure.spec.alpha :as s]
@ -62,7 +63,7 @@
(map->Point v)
:else
(throw (ex-info "Invalid arguments" {:v v}))))
(ex/raise :hint "invalid arguments (on pointer constructor)" :value v)))
([x y]
(Point. x y)))

56
common/src/app/common/geom/shapes/modifiers.cljc
View file

@ -320,33 +320,47 @@
modif-tree)))
(defn set-objects-modifiers
[modif-tree objects ignore-constraints snap-pixel?]
([modif-tree objects ignore-constraints snap-pixel?]
(set-objects-modifiers nil modif-tree objects ignore-constraints snap-pixel?))
(let [objects (apply-structure-modifiers objects modif-tree)
([old-modif-tree modif-tree objects ignore-constraints snap-pixel?]
(let [objects (-> objects
(cond-> (some? old-modif-tree)
(apply-structure-modifiers old-modif-tree))
(apply-structure-modifiers modif-tree))
bounds (d/lazy-map (keys objects) #(dm/get-in objects [% :points]))
shapes-tree (resolve-tree-sequence (-> modif-tree keys set) objects)
bounds (d/lazy-map (keys objects) #(dm/get-in objects [% :points]))
bounds (cond-> bounds
(some? old-modif-tree)
(transform-bounds objects old-modif-tree))
;; Calculate the input transformation and constraints
modif-tree (reduce #(propagate-modifiers-constraints objects bounds ignore-constraints %1 %2) modif-tree shapes-tree)
bounds (transform-bounds bounds objects modif-tree shapes-tree)
shapes-tree (resolve-tree-sequence (-> modif-tree keys set) objects)
[modif-tree-layout sizing-auto-layouts]
(reduce #(propagate-modifiers-layout objects bounds ignore-constraints %1 %2) [{} #{}] shapes-tree)
;; Calculate the input transformation and constraints
modif-tree (reduce #(propagate-modifiers-constraints objects bounds ignore-constraints %1 %2) modif-tree shapes-tree)
bounds (transform-bounds bounds objects modif-tree shapes-tree)
modif-tree (merge-modif-tree modif-tree modif-tree-layout)
[modif-tree-layout sizing-auto-layouts]
(reduce #(propagate-modifiers-layout objects bounds ignore-constraints %1 %2) [{} #{}] shapes-tree)
;; Calculate hug layouts positions
bounds (transform-bounds bounds objects modif-tree-layout shapes-tree)
modif-tree (merge-modif-tree modif-tree modif-tree-layout)
modif-tree
(-> modif-tree
(sizing-auto-modifiers sizing-auto-layouts objects bounds ignore-constraints))
;; Calculate hug layouts positions
bounds (transform-bounds bounds objects modif-tree-layout shapes-tree)
modif-tree
(cond-> modif-tree
snap-pixel? (gpp/adjust-pixel-precision objects))]
modif-tree
(-> modif-tree
(sizing-auto-modifiers sizing-auto-layouts objects bounds ignore-constraints))
;;#?(:cljs
;; (.log js/console ">result" (modif->js modif-tree objects)))
modif-tree))
modif-tree
(if old-modif-tree
(merge-modif-tree old-modif-tree modif-tree)
modif-tree)
modif-tree
(cond-> modif-tree
snap-pixel? (gpp/adjust-pixel-precision objects))]
;;#?(:cljs
;; (.log js/console ">result" (modif->js modif-tree objects)))
modif-tree)))

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

@ -111,10 +111,10 @@
(cond-> (some? transform)
(gmt/multiply transform))
(cond-> (and flip-x (not no-flip))
(cond-> (and flip-x no-flip)
(gmt/scale (gpt/point -1 1)))
(cond-> (and flip-y (not no-flip))
(cond-> (and flip-y no-flip)
(gmt/scale (gpt/point 1 -1)))
(gmt/translate (gpt/negate shape-center)))))
@ -126,8 +126,8 @@
([{:keys [transform flip-x flip-y] :as shape} {:keys [no-flip] :as params}]
(if (and (some? shape)
(or (some? transform)
(and (not no-flip) flip-x)
(and (not no-flip) flip-y)))
(and no-flip flip-x)
(and no-flip flip-y)))
(dm/str (transform-matrix shape params))
"")))

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

@ -537,6 +537,7 @@
:blocked
:hidden
:fills
:fill-color
:fill-opacity
:fill-color-ref-id

15
common/src/app/common/spec.cljc
View file

@ -249,14 +249,6 @@
(s/with-gen (s/and string? #(not (str/empty? %)))
#(tgen/such-that (complement str/empty?) (s/gen ::string))))
(s/def ::url ::string)
(s/def ::fn fn?)
(s/def ::id ::uuid)
(s/def ::set-of-string (s/every ::string :kind set?))
(s/def ::coll-of-uuid (s/every ::uuid))
(s/def ::set-of-uuid (s/every ::uuid :kind set?))
#?(:clj
(s/def ::agent #(instance? clojure.lang.Agent %)))
@ -300,6 +292,13 @@
(s/with-gen safe-number? #(tgen/one-of [(s/gen ::safe-integer)
(s/gen ::safe-float)])))
(s/def ::url ::string)
(s/def ::fn fn?)
(s/def ::id ::uuid)
(s/def ::some some?)
(s/def ::coll-of-uuid (s/every ::uuid))
(s/def ::set-of-uuid (s/every ::uuid :kind set?))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; MACROS
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

@ -247,7 +247,7 @@
(defn top-nested-frame-ids
"Search the top nested frame in a list of ids"
[objects ids]
(let [frame-ids (->> ids (filter #(cph/frame-shape? objects %)))
frame-set (set frame-ids)]
(loop [current-id (first frame-ids)]
@ -296,11 +296,14 @@
[p1 (+ 1 (d/parse-integer p2))]
[basename 1]))
(s/def ::set-of-strings
(s/every ::us/string :kind set?))
(defn generate-unique-name
"A unique name generator"
[used basename]
(s/assert ::us/set-of-string used)
(s/assert ::us/string basename)
(us/assert! ::set-of-strings used)
(us/assert! ::us/string basename)
(if-not (contains? used basename)
basename
(let [[prefix initial] (extract-numeric-suffix basename)]
@ -355,8 +358,8 @@
[new-object new-objects updated-objects])
(let [child-id (first child-ids)
child (get objects child-id)
_ (us/assert some? child)
child (get objects child-id)
_ (us/assert! ::us/some child)
[new-child new-child-objects updated-child-objects]
(clone-object child new-id objects update-new-object update-original-object)]

2
frontend/deps.edn
View file

@ -9,7 +9,7 @@
funcool/beicon {:mvn/version "2021.07.05-1"}
funcool/okulary {:mvn/version "2022.04.11-16"}
funcool/potok {:mvn/version "2022.04.28-67"}
funcool/potok {:mvn/version "2022.12.16-71"}
funcool/tubax {:mvn/version "2021.05.20-0"}
funcool/rumext

1
frontend/resources/styles/main/partials/color-bullet.scss
View file

@ -184,6 +184,7 @@ ul.palette-menu .color-bullet {
.color-bullet.is-not-library-color {
border-radius: $br-small;
overflow: hidden;
& .color-bullet-wrapper {
clip-path: none;

3
frontend/resources/styles/main/partials/dashboard-header.scss
View file

@ -57,9 +57,10 @@
color: $color-gray-30;
height: 40px;
padding: $size-1 $size-5;
font-weight: 400;
&:hover {
color: $color-black;
text-decoration: none;
}
}

8
frontend/resources/styles/main/partials/dashboard-sidebar.scss
View file

@ -203,7 +203,11 @@
flex-shrink: 0;
padding: $size-2;
a {
font-weight: 400;
width: 100%;
&:hover {
text-decoration: none;
}
}
svg {
@ -279,7 +283,9 @@
}
&.current {
font-weight: bold;
a {
font-weight: bold;
}
&::before {
background-color: $color-primary;

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

@ -96,7 +96,11 @@
(->> (rp/cmd! :create-comment-thread params)
(rx/mapcat #(rp/cmd! :get-comment-thread {:file-id (:file-id %) :id (:id %)}))
(rx/map created-thread-on-workspace)
(rx/catch #(rx/throw {:type :comment-error})))))))
(rx/catch (fn [{:keys [type code] :as cause}]
(if (and (= type :restriction)
(= code :max-quote-reached))
(rx/throw cause)
(rx/throw {:type :comment-error})))))))))
(defn created-thread-on-viewer
[{:keys [id comment page-id] :as thread}]
@ -114,8 +118,7 @@
(defn create-thread-on-viewer
[params]
(us/assert ::create-thread-on-viewer-params params)
(us/assert! ::create-thread-on-viewer-params params)
(ptk/reify ::create-thread-on-viewer
ptk/WatchEvent
(watch [_ state _]
@ -125,7 +128,11 @@
(->> (rp/cmd! :create-comment-thread params)
(rx/mapcat #(rp/cmd! :get-comment-thread {:file-id (:file-id %) :id (:id %) :share-id share-id}))
(rx/map created-thread-on-viewer)
(rx/catch #(rx/throw {:type :comment-error})))))))
(rx/catch (fn [{:keys [type code] :as cause}]
(if (and (= type :restriction)
(= code :max-quote-reached))
(rx/throw cause)
(rx/throw {:type :comment-error})))))))))
(defn update-comment-thread-status
[{:keys [id] :as thread}]
@ -154,7 +161,11 @@
(watch [_ state _]
(let [share-id (-> state :viewer-local :share-id)]
(->> (rp/cmd! :update-comment-thread {:id id :is-resolved is-resolved :share-id share-id})
(rx/catch #(rx/throw {:type :comment-error}))
(rx/catch (fn [{:keys [type code] :as cause}]
(if (and (= type :restriction)
(= code :max-quote-reached))
(rx/throw cause)
(rx/throw {:type :comment-error}))))
(rx/ignore))))))
(defn add-comment
@ -170,7 +181,11 @@
(rx/concat
(->> (rp/cmd! :create-comment {:thread-id (:id thread) :content content :share-id share-id})
(rx/map #(partial created %))
(rx/catch #(rx/throw {:type :comment-error})))
(rx/catch (fn [{:keys [type code] :as cause}]
(if (and (= type :restriction)
(= code :max-quote-reached))
(rx/throw cause)
(rx/throw {:type :comment-error})))))
(rx/of (refresh-comment-thread thread))))))))
(defn update-comment

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

@ -696,7 +696,7 @@
(pcb/resize-parents parents))))
(defn relocate-shapes
[ids parent-id to-index]
[ids parent-id to-index & [ignore-parents?]]
(us/verify (s/coll-of ::us/uuid) ids)
(us/verify ::us/uuid parent-id)
(us/verify number? to-index)
@ -712,7 +712,9 @@
;; If we try to move a parent into a child we remove it
ids (filter #(not (cph/is-parent? objects parent-id %)) ids)
parents (into #{parent-id} (map #(cph/get-parent-id objects %)) ids)
parents (if ignore-parents?
#{parent-id}
(into #{parent-id} (map #(cph/get-parent-id objects %)) ids))
groups-to-delete
(loop [current-id (first parents)
@ -1832,6 +1834,21 @@
(rx/empty)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Orphan Shapes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defn fix-orphan-shapes
[]
(ptk/reify ::fix-orphan-shapes
ptk/WatchEvent
(watch [_ state _]
(let [orphans (set (into [] (keys (wsh/find-orphan-shapes state))))]
(rx/of (relocate-shapes orphans uuid/zero 0 true))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Inspect
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

1
frontend/src/app/main/data/workspace/comments.cljs
View file

@ -39,7 +39,6 @@
(rx/filter ms/mouse-click?)
(rx/switch-map #(rx/take 1 ms/mouse-position))
(rx/with-latest-from ms/keyboard-space)
(rx/tap prn)
(rx/filter (fn [[_ space]] (not space)) )
(rx/map first)
(rx/map handle-comment-layer-click)

64
frontend/src/app/main/data/workspace/modifiers.cljs
View file

@ -190,26 +190,27 @@
[(get-in objects [k :name]) v]))
modif-tree)))
(defn apply-text-modifier
[shape {:keys [width height]}]
(cond-> shape
(some? width)
(assoc :width width)
(some? height)
(assoc :height height)
(or (some? width) (some? height))
(cts/setup-rect-selrect)))
(defn apply-text-modifiers
[objects text-modifiers]
(letfn [(apply-text-modifier
[shape {:keys [width height]}]
(cond-> shape
(some? width)
(assoc :width width)
(some? height)
(assoc :height height)
(or (some? width) (some? height))
(cts/setup-rect-selrect)))]
(loop [modifiers (seq text-modifiers)
result objects]
(if (empty? modifiers)
result
(let [[id text-modifier] (first modifiers)]
(recur (rest modifiers)
(update objects id apply-text-modifier text-modifier)))))))
(loop [modifiers (seq text-modifiers)
result objects]
(if (empty? modifiers)
result
(let [[id text-modifier] (first modifiers)]
(recur (rest modifiers)
(update objects id apply-text-modifier text-modifier))))))
#_(defn apply-path-modifiers
[objects path-modifiers]
@ -242,6 +243,33 @@
;;(apply-path-modifiers $ (get-in state [:workspace-local :edit-path]))
(gsh/set-objects-modifiers modif-tree $ ignore-constraints snap-pixel?)))))
(defn- calculate-update-modifiers
[old-modif-tree state ignore-constraints ignore-snap-pixel modif-tree]
(let [objects
(wsh/lookup-page-objects state)
snap-pixel?
(and (not ignore-snap-pixel) (contains? (:workspace-layout state) :snap-pixel-grid))
objects
(-> objects
(apply-text-modifiers (get state :workspace-text-modifier)))]
(gsh/set-objects-modifiers old-modif-tree modif-tree objects ignore-constraints snap-pixel?)))
(defn update-modifiers
([modif-tree]
(update-modifiers modif-tree false))
([modif-tree ignore-constraints]
(update-modifiers modif-tree ignore-constraints false))
([modif-tree ignore-constraints ignore-snap-pixel]
(ptk/reify ::update-modifiers
ptk/UpdateEvent
(update [_ state]
(update state :workspace-modifiers calculate-update-modifiers state ignore-constraints ignore-snap-pixel modif-tree)))))
(defn set-modifiers
([modif-tree]
(set-modifiers modif-tree false))

1
frontend/src/app/main/data/workspace/notifications.cljs
View file

@ -189,7 +189,6 @@
(s/def ::file-change-event
(s/keys :req-un [::type ::profile-id ::file-id ::session-id ::revn ::changes]))
(defn handle-file-change
[{:keys [file-id changes] :as msg}]
(us/assert ::file-change-event msg)

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

@ -30,6 +30,7 @@
(declare persist-changes)
(declare persist-synchronous-changes)
(declare shapes-changes-persisted)
(declare shapes-changes-persisted-finished)
(declare update-persistence-status)
;; --- Persistence
@ -42,6 +43,7 @@
(log/debug :hint "initialize persistence")
(let [stoper (rx/filter (ptk/type? ::initialize-persistence) stream)
commits (l/atom [])
saving? (l/atom false)
local-file?
#(as-> (:file-id %) event-file-id
@ -61,13 +63,15 @@
on-saving
(fn []
(reset! saving? true)
(st/emit! (update-persistence-status {:status :saving})))
on-saved
(fn []
;; Disable reload stoper
(swap! st/ongoing-tasks disj :workspace-change)
(st/emit! (update-persistence-status {:status :saved})))]
(st/emit! (update-persistence-status {:status :saved}))
(reset! saving? false))]
(rx/merge
(->> stream
@ -88,12 +92,15 @@
(->> (rx/from-atom commits)
(rx/filter (complement empty?))
(rx/sample-when (rx/merge
(rx/interval 5000)
(rx/filter #(= ::force-persist %) stream)
(->> (rx/from-atom commits)
(rx/filter (complement empty?))
(rx/debounce 2000))))
(rx/sample-when
(->> (rx/merge
(rx/interval 5000)
(rx/filter #(= ::force-persist %) stream)
(->> (rx/from-atom commits)
(rx/filter (complement empty?))
(rx/debounce 2000)))
;; Not sample while saving so there are no race conditions
(rx/filter #(not @saving?))))
(rx/tap #(reset! commits []))
(rx/tap on-saving)
(rx/mapcat (fn [changes]
@ -101,9 +108,11 @@
;; next persistence before this one is
;; finished.
(rx/merge
(rx/of (persist-changes file-id changes))
(->> (rx/of (persist-changes file-id changes commits))
(rx/observe-on :async))
(->> stream
(rx/filter (ptk/type? ::changes-persisted))
;; We wait for every change to be persisted
(rx/filter (ptk/type? ::shapes-changes-persisted-finished))
(rx/take 1)
(rx/tap on-saved)
(rx/ignore)))))
@ -123,7 +132,7 @@
(log/debug :hint "finalize persistence: synchronous save loop")))))))))
(defn persist-changes
[file-id changes]
[file-id changes pending-commits]
(log/debug :hint "persist changes" :changes (count changes))
(us/verify ::us/uuid file-id)
(ptk/reify ::persist-changes
@ -150,20 +159,29 @@
(log/debug :hint "changes persisted" :lagged (count lagged))
(let [frame-updates
(-> (group-by :page-id changes)
(update-vals #(into #{} (mapcat :frames) %)))]
(update-vals #(into #{} (mapcat :frames) %)))
(rx/merge
(->> (rx/from frame-updates)
(rx/mapcat (fn [[page-id frames]]
(->> frames (map #(vector page-id %)))))
(rx/map (fn [[page-id frame-id]] (dwt/update-thumbnail (:id file) page-id frame-id))))
(->> (rx/from lagged)
(rx/merge-map (fn [{:keys [changes] :as entry}]
(rx/merge
(rx/from
(for [[page-id changes] (group-by :page-id changes)]
(dch/update-indices page-id changes)))
(rx/of (shapes-changes-persisted file-id entry))))))))))
commits
(->> @pending-commits
(map #(assoc % :revn (:revn file))))]
(rx/concat
(rx/merge
(->> (rx/from frame-updates)
(rx/mapcat (fn [[page-id frames]]
(->> frames (map #(vector page-id %)))))
(rx/map (fn [[page-id frame-id]] (dwt/update-thumbnail (:id file) page-id frame-id))))
(->> (rx/from (concat lagged commits))
(rx/merge-map
(fn [{:keys [changes] :as entry}]
(rx/merge
(rx/from
(for [[page-id changes] (group-by :page-id changes)]
(dch/update-indices page-id changes)))
(rx/of (shapes-changes-persisted file-id entry)))))))
(rx/of (shapes-changes-persisted-finished))))))
(rx/catch (fn [cause]
(rx/concat
(if (= :authentication (:type cause))
@ -171,6 +189,11 @@
(rx/of (rt/assign-exception cause)))
(rx/throw cause))))))))))
;; Event to be thrown after the changes have been persisted
(defn shapes-changes-persisted-finished
[]
(ptk/reify ::shapes-changes-persisted-finished))
(defn persist-synchronous-changes
[{:keys [file-id changes]}]
(us/verify ::us/uuid file-id)
@ -216,29 +239,32 @@
[file-id {:keys [revn changes] :as params}]
(us/verify! ::us/uuid file-id)
(us/verify! ::shapes-changes-persisted params)
(ptk/reify ::changes-persisted
(ptk/reify ::shapes-changes-persisted
ptk/UpdateEvent
(update [_ state]
;; NOTE: we don't set the file features context here because
;; there are no useful context for code that need to be executed
;; on the frontend side
(let [changes (group-by :page-id changes)]
(if (= file-id (:current-file-id state))
(-> state
(update-in [:workspace-file :revn] max revn)
(update :workspace-data (fn [file]
(loop [fdata file
entries (seq changes)]
(if-let [[page-id changes] (first entries)]
(recur (-> fdata
(cp/process-changes changes)
(ctst/update-object-indices page-id))
(rest entries))
fdata)))))
(if-let [current-file-id (:current-file-id state)]
(if (= file-id current-file-id)
(let [changes (group-by :page-id changes)]
(-> state
(update-in [:workspace-file :revn] max revn)
(update :workspace-data (fn [file]
(loop [fdata file
entries (seq changes)]
(if-let [[page-id changes] (first entries)]
(recur (-> fdata
(cp/process-changes changes)
(ctst/update-object-indices page-id))
(rest entries))
fdata))))))
(-> state
(update-in [:workspace-libraries file-id :revn] max revn)
(update-in [:workspace-libraries file-id :data]
cp/process-changes changes)))))))
(update-in [:workspace-libraries file-id :data] cp/process-changes changes)))
state))))

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

@ -23,6 +23,7 @@
[app.main.data.workspace.collapse :as dwc]
[app.main.data.workspace.state-helpers :as wsh]
[app.main.data.workspace.thumbnails :as dwt]
[app.main.data.workspace.undo :as dwu]
[app.main.data.workspace.zoom :as dwz]
[app.main.refs :as refs]
[app.main.streams :as ms]
@ -502,8 +503,11 @@
[obj state objects]
(let [{:keys [id-original id-duplicated]}
(get-in state [:workspace-local :duplicated])]
(if (and (not= id-original (:id obj))
(not= id-duplicated (:id obj)))
(if (or (and (not= id-original (:id obj))
(not= id-duplicated (:id obj)))
;; As we can remove duplicated elements may be we can still caching a deleted id
(not (contains? objects id-original))
(not (contains? objects id-duplicated)))
;; The default is leave normal shapes in place, but put
;; new frames to the right of the original.
@ -556,16 +560,21 @@
frames (into #{}
(map #(get-in objects [% :frame-id]))
selected)]
selected)
undo-id (uuid/next)]
(rx/concat
(->> (rx/from dup-frames)
(rx/map (fn [[old-id new-id]] (dwt/duplicate-thumbnail old-id new-id))))
;; Warning: This order is important for the focus mode.
(rx/of (dch/commit-changes changes)
(select-shapes new-selected)
(ptk/data-event :layout/update frames)
(memorize-duplicated id-original id-duplicated))))))))))
(rx/of
(dwu/start-undo-transaction undo-id)
(dch/commit-changes changes)
(select-shapes new-selected)
(ptk/data-event :layout/update frames)
(memorize-duplicated id-original id-duplicated)
(dwu/commit-undo-transaction undo-id))))))))))
(defn change-hover-state
[id value]

15
frontend/src/app/main/data/workspace/state_helpers.cljs
View file

@ -11,7 +11,8 @@
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.common.pages.helpers :as cph]
[app.common.path.commands :as upc]))
[app.common.path.commands :as upc]
[app.common.uuid :as uuid]))
(defn lookup-page
([state]
@ -146,4 +147,14 @@
(let [{:keys [x y width height]} (get-in state [:workspace-local :vbox])]
(gpt/point (+ x (/ width 2)) (+ y (/ height 2)))))
(defn find-orphan-shapes
([state]
(find-orphan-shapes state (:current-page-id state)))
([state page-id]
(let [objects (lookup-page-objects state page-id)
objects (filter (fn [item]
(and
(not= (key item) uuid/zero)
(not (contains? objects (:parent-id (val item))))))
objects)]
objects)))

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

@ -408,8 +408,7 @@
(not (mth/close? (:height props) current-height))))
(let [modif-tree (dwm/create-modif-tree [id] (ctm/reflow-modifiers))]
(->> (rx/of (dwm/set-modifiers modif-tree))
(rx/observe-on :async)))
(rx/of (dwm/update-modifiers modif-tree)))
(rx/empty)))))))
(defn clean-text-modifier

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

@ -30,7 +30,14 @@
[error]
(cond
(instance? ExceptionInfo error)
(-> error ex-data ptk/handle-error)
(let [data (ex-data error)]
(if (contains? data :type)
(ptk/handle-error data)
(let [hint (str/ffmt "Unexpected error: '%'" (ex-message error))]
(ts/schedule #(st/emit! (rt/assign-exception error)))
(js/console.group hint)
(js/console.log (.-stack error))
(js/console.groupEnd hint))))
(map? error)
(ptk/handle-error error)
@ -49,7 +56,7 @@
(defmethod ptk/handle-error :default
[error]
(let [hint (str/concat "Unexpected error: " (:hint error))]
(let [hint (str/ffmt "Unhandled error: '%'" (:hint error "[no hint]"))]
(ts/schedule #(st/emit! (rt/assign-exception error)))
(js/console.group hint)
(ex/ignoring (js/console.error (pr-str error)))
@ -173,20 +180,18 @@
(cond
(= :feature-mismatch code)
(let [message (tr "errors.feature-mismatch" (:feature error))]
(st/emit! (modal/show
{:type :alert
:message message
:on-accept #(prn "kaka")})))
(st/emit! (modal/show {:type :alert :message message})))
(= :features-not-supported code)
(let [message (tr "errors.feature-not-supported" (:feature error))]
(st/emit! (modal/show
{:type :alert
:message message
:on-accept #(prn "kaka")})))
(st/emit! (modal/show {:type :alert :message message})))
(= :max-quote-reached code)
(let [message (tr "errors.max-quote-reached" (:target error))]
(st/emit! (modal/show {:type :alert :message message})))
:else
(ptk/handle-error (assoc error :type :server-error))))
(ptk/handle-error {:type :server-error :data error})))
;; This happens when the backed server fails to process the
;; request. This can be caused by an internal assertion or any other

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

@ -23,8 +23,22 @@
[type data]
(ptk/data-event type data))
;;(def debug-exclude-events
;; #{:app.main.data.workspace.notifications/handle-pointer-update
;; :app.main.data.workspace.notifications/handle-pointer-send
;; :app.main.data.workspace.persistence/update-persistence-status
;; :app.main.data.workspace.changes/update-indices
;; :app.main.data.websocket/send-message
;; :app.main.data.workspace.selection/change-hover-state})
;; (def ^:dynamic *debug-events* false)
(defonce state
(ptk/store {:resolve ptk/resolve
;;:on-event (fn [e]
;; (when (and *debug-events*
;; (ptk/event? e)
;; (not (debug-exclude-events (ptk/type e))))
;; (.log js/console (str "[stream]: " (ptk/repr-event e)) )))
:on-error (fn [e] (@on-error e))}))
(defonce stream

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

@ -6,6 +6,7 @@
(ns app.main.ui.comments
(:require
[app.common.data.macros :as dm]
[app.common.geom.point :as gpt]
[app.config :as cfg]
[app.main.data.comments :as dcm]
@ -333,7 +334,7 @@
:thread thread
:origin origin}]
(for [item (rest comments)]
[:*
[:* {:key (dm/str (:id item))}
[:hr]
[:& comment-item {:comment item
:users users

4
frontend/src/app/main/ui/components/color_bullet.cljs
View file

@ -31,12 +31,12 @@
;; No multiple selection
(let [color (if (string? color) {:color color :opacity 1} color)]
[:div.color-bullet.tooltip.tooltip-right
[:div.color-bullet
{:class (dom/classnames :is-library-color (some? (:id color))
:is-not-library-color (nil? (:id color))
:is-gradient (some? (:gradient color)))
:on-click on-click
:title (or (:name color) (:color color) (gradient-type->string (:type (:gradient color))))}
:title (or (:color-library-name color) (:name color) (:color color) (gradient-type->string (:type (:gradient color))))}
(if (:gradient color)
[:div.color-bullet-wrapper {:style {:background (uc/color->background color)}}]
[:div.color-bullet-wrapper

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

@ -68,7 +68,7 @@
[:a {:on-click go-settings} (tr "labels.settings")]]]]
[:div.dashboard-buttons
(if (and (or invitations-section? members-section?) (:is-admin permissions))
[:a.btn-primary.btn-small {:on-click invite-member :data-test "invite-member"}
[:a.btn-secondary.btn-small {:on-click invite-member :data-test "invite-member"}
(tr "dashboard.invite-profile")]
[:div.blank-space])]]))

22
frontend/src/app/main/ui/shapes/text/svg_text.cljs
View file

@ -8,8 +8,6 @@
(:require
[app.common.data :as d]
[app.common.data.macros :as dm]
[app.common.geom.matrix :as gmt]
[app.common.geom.point :as gpt]
[app.common.geom.shapes :as gsh]
[app.config :as cf]
[app.main.ui.context :as muc]
@ -32,23 +30,6 @@
(d/update-when :position-data #(mapv update-color %))
(assoc :stroke-color "#FFFFFF" :stroke-opacity 1))))
(defn position-data-transform
[shape {:keys [x y width height]}]
(let [rect (gsh/make-rect x (- y height) width height)
center (gsh/center-rect rect)]
(when (or (:flip-x shape) (:flip-y shape))
(-> (gmt/matrix)
(gmt/translate center)
(cond-> (:flip-x shape)
(gmt/scale (gpt/point -1 1))
(:flip-y shape)
(gmt/scale (gpt/point 1 -1)))
(gmt/translate (gpt/negate center))
(dm/str)))))
(mf/defc text-shape
{::mf/wrap-props false
::mf/wrap [mf/memo]}
@ -60,7 +41,7 @@
{:keys [x y width height position-data]} shape
transform (gsh/transform-str shape {:no-flip true})
transform (gsh/transform-str shape)
;; These position attributes are not really necessary but they are convenient for for the export
group-props (-> #js {:transform transform
@ -96,7 +77,6 @@
:y (- (:y data) (:height data))
:textLength (:width data)
:lengthAdjust "spacingAndGlyphs"
:transform (position-data-transform shape data)
:alignmentBaseline alignment-bl
:dominantBaseline dominant-bl
:style (-> #js {:fontFamily (:font-family data)

33
frontend/src/app/main/ui/viewer/inspect/attributes/common.cljs
View file

@ -6,6 +6,7 @@
(ns app.main.ui.viewer.inspect.attributes.common
(:require
[app.main.refs :as refs]
[app.main.store :as st]
[app.main.ui.components.color-bullet :refer [color-bullet color-name]]
[app.main.ui.components.copy-button :refer [copy-button]]
@ -20,21 +21,31 @@
(def file-colors-ref
(l/derived (l/in [:viewer :file :data :colors]) st/state))
(defn make-colors-library-ref [file-id]
(defn make-colors-library-ref [libraries-place file-id]
(let [get-library
(fn [state]
(get-in state [:viewer-libraries file-id :data :colors]))]
#(l/derived get-library st/state)))
(get-in state [libraries-place file-id :data :colors]))]
(l/derived get-library st/state)))
(defn- get-colors-library [color]
(let [colors-library-v (-> (mf/use-memo
(mf/deps (:file-id color))
#(make-colors-library-ref :viewer-libraries (:file-id color)))
mf/deref)
colors-library-ws (-> (mf/use-memo
(mf/deps (:file-id color))
#(make-colors-library-ref :workspace-libraries (:file-id color)))
mf/deref)]
(or colors-library-v colors-library-ws)))
(defn- get-file-colors []
(or (mf/deref file-colors-ref) (mf/deref refs/workspace-file-colors)))
(mf/defc color-row [{:keys [color format copy-data on-change-format]}]
(let [colors-library-ref (mf/use-memo
(mf/deps (:file-id color))
(make-colors-library-ref (:file-id color)))
colors-library (mf/deref colors-library-ref)
file-colors (mf/deref file-colors-ref)
color-library-name (get-in (or colors-library file-colors) [(:id color) :name])]
(let [colors-library (get-colors-library color)
file-colors (get-file-colors)
color-library-name (get-in (or colors-library file-colors) [(:id color) :name])
color (assoc color :color-library-name color-library-name)]
[:div.attributes-color-row
(when color-library-name
[:div.attributes-color-id

2
frontend/src/app/main/ui/workspace/shapes/text.cljs
View file

@ -39,7 +39,7 @@
[:& text/text-shape {:shape shape}]]
(when (and (debug? :text-outline) (d/not-empty? (:position-data shape)))
[:g {:transform (gsh/transform-str shape {:no-flip true})}
[:g {:transform (gsh/transform-str shape)}
(let [bounding-box (gsht/position-data-selrect shape)]
[:rect {
:x (:x bounding-box)

2
frontend/src/app/main/ui/workspace/shapes/text/text_edition_outline.cljs
View file

@ -28,7 +28,7 @@
(some? text-modifier)
(dwt/apply-text-modifier text-modifier))
transform (gsh/transform-str shape {:no-flip true})
transform (gsh/transform-str shape)
{:keys [x y width height]} shape]
[:rect.main.viewport-selrect

1
frontend/src/app/main/ui/workspace/sidebar/options/menus/typography.cljs
View file

@ -462,6 +462,7 @@
on-change-ref (mf/use-ref nil)
workspace-read-only? (mf/use-ctx ctx/workspace-read-only?)
editable? (and local? (not workspace-read-only?))
open? (if (nil? open?) (mf/use-state editing?) open?)
on-name-blur
(mf/use-callback

17
frontend/src/app/main/ui/workspace/sidebar/options/shapes/multiple.cljs
View file

@ -247,6 +247,18 @@
(= (:type shape) :path)
(dissoc :content)))
(defn- is-bool-descendant?
[shape all-shapes selected-shape-ids]
(let [parent-id (:parent-id shape)
parent (->> all-shapes
(filter #(= (:id %) parent-id))
first)]
(cond
(nil? shape) false ;; failsafe
(some #{(:id shape)} selected-shape-ids) false ;; if it is one of the selected shapes, it is considerer not a bool descendant
(= :bool (:type parent)) true ;; if its parent is of type bool, it is a bool descendant
:else (is-bool-descendant? parent all-shapes selected-shape-ids)))) ;; else, check its parent
(mf/defc options
{::mf/wrap [#(mf/memo' % (mf/check-props ["shapes" "shapes-with-children" "page-id" "file-id"]))]
::mf/wrap-props false}
@ -254,6 +266,10 @@
(let [shapes (unchecked-get props "shapes")
shapes-with-children (unchecked-get props "shapes-with-children")
;; remove children from bool shapes
shape-ids (map :id shapes)
shapes-with-children (filter #(not (is-bool-descendant? % shapes-with-children shape-ids)) shapes-with-children)
workspace-modifiers (mf/deref refs/workspace-modifiers)
shapes (map #(gsh/transform-shape % (get-in workspace-modifiers [(:id %) :modifiers])) shapes)
@ -279,7 +295,6 @@
[measure-ids measure-values] (get-attrs shapes objects :measure)
[layer-ids layer-values
constraint-ids constraint-values
fill-ids fill-values

3
frontend/src/app/main/ui/workspace/viewport/hooks.cljs
View file

@ -126,7 +126,6 @@
(mf/deps page-id)
(fn [point]
(let [zoom (mf/ref-val zoom-ref)
mod? (mf/ref-val mod-ref)
rect (gsh/center->rect point (/ 5 zoom) (/ 5 zoom))]
(if (mf/ref-val hover-disabled-ref)
(rx/of nil)
@ -135,7 +134,7 @@
:page-id page-id
:rect rect
:include-frames? true
:clip-children? (not mod?)})
:clip-children? true})
;; When the ask-buffered is canceled returns null. We filter them
;; to improve the behavior
(rx/filter some?))))))

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

@ -272,7 +272,7 @@
current-transform (mf/deref refs/current-transform)
selrect (:selrect shape)
transform (gsh/transform-str shape {:no-flip true})]
transform (gsh/transform-str shape)]
(when (not (#{:move :rotate} current-transform))
[:g.controls {:pointer-events (if disable-handlers "none" "visible")}
@ -297,7 +297,7 @@
workspace-read-only? (mf/use-ctx ctx/workspace-read-only?)
selrect (:selrect shape)
transform (gsh/transform-matrix shape {:no-flip true})
transform (gsh/transform-matrix shape)
rotation (-> (gpt/point 1 0)
(gpt/transform (:transform shape))
@ -309,7 +309,22 @@
[:g.controls {:pointer-events (if disable-handlers "none" "visible")}
;; Handlers
(for [{:keys [type position props]} (handlers-for-selection selrect shape zoom)]
(let [common-props {:key (dm/str (name type) "-" (name position))
(let [rotation
(cond
(and (#{:top-left :bottom-right} position)
(or (and (:flip-x shape) (not (:flip-y shape)))
(and (:flip-y shape) (not (:flip-x shape)))))
(- rotation 90)
(and (#{:top-right :bottom-left} position)
(or (and (:flip-x shape) (not (:flip-y shape)))
(and (:flip-y shape) (not (:flip-x shape)))))
(+ rotation 90)
:else
rotation)
common-props {:key (dm/str (name type) "-" (name position))
:zoom zoom
:position position
:on-rotate on-rotate

3
frontend/src/debug.cljs
View file

@ -346,3 +346,6 @@
[read-only?]
(st/emit! (dw/set-workspace-read-only read-only?)))
(defn ^:export fix-orphan-shapes
[]
(st/emit! (dw/fix-orphan-shapes)))

4
frontend/translations/en.po
View file

@ -765,6 +765,10 @@ msgstr "Your browser cannot do this operation"
msgid "errors.feature-not-supported"
msgstr "Feature '%s' is not supported."
#: src/app/main/errors.cljs
msgid "errors.max-quote-reached"
msgstr "You have reached the '%s' quote. Contact with support."
#: src/app/main/errors.cljs
msgid "errors.feature-mismatch"
msgstr "Looks like you are opening a file that has the feature '%s' enabled bug your penpot frontend does not supports it or has it disabled."

12
frontend/translations/es.po
View file

@ -743,6 +743,18 @@ msgstr "Webhook modificado con éxito"
msgid "dashboard.webhooks.create.success"
msgstr "Webhook creado con éxito"
#: src/app/main/errors.cljs
msgid "errors.feature-not-supported"
msgstr "Caracteristica no soportada: '%s'."
#: src/app/main/errors.cljs
msgid "errors.max-quote-reached"
msgstr "Ha alcalzando el maximo de la quota '%s'. Contacte con soporte tecnico."
#: src/app/main/errors.cljs
msgid "errors.feature-mismatch"
msgstr "Parece que esta abriendo un fichero con la caracteristica '%s' habilitada pero la aplicacion web de penpot que esta usando no tiene soporte para ella o esta deshabilitada."
msgid "errors.webhooks.timeout"
msgstr "Timeout"