From 4fc3f316e02362052dcca4df3bdbaff54c504eb6 Mon Sep 17 00:00:00 2001
From: Pablo Alba <pablo.alba@kaleidos.net>
Date: Tue, 27 Dec 2022 07:03:12 +0100
Subject: [PATCH 01/19] :bug: Add function to reparent orphan shapes
---
frontend/src/app/main/data/workspace.cljs | 21 +++++++++++++++++--
.../main/data/workspace/state_helpers.cljs | 15 +++++++++++--
frontend/src/debug.cljs | 3 +++
3 files changed, 35 insertions(+), 4 deletions(-)
diff --git a/frontend/src/app/main/data/workspace.cljs b/frontend/src/app/main/data/workspace.cljs
index 206deef13..6ce0e0e0b 100644
--- a/frontend/src/app/main/data/workspace.cljs
+++ b/frontend/src/app/main/data/workspace.cljs
@@ -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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/frontend/src/app/main/data/workspace/state_helpers.cljs b/frontend/src/app/main/data/workspace/state_helpers.cljs
index b6596511b..dd01688d6 100644
--- a/frontend/src/app/main/data/workspace/state_helpers.cljs
+++ b/frontend/src/app/main/data/workspace/state_helpers.cljs
@@ -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)))
diff --git a/frontend/src/debug.cljs b/frontend/src/debug.cljs
index cfb8b1c40..f2d2e729a 100644
--- a/frontend/src/debug.cljs
+++ b/frontend/src/debug.cljs
@@ -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)))
From ede07e4f448b4090d2326992598e6e0dddbd283b Mon Sep 17 00:00:00 2001
From: Pablo Alba <pablo.alba@kaleidos.net>
Date: Wed, 28 Dec 2022 15:56:16 +0100
Subject: [PATCH 02/19] :bug: Fix incorrect color in properties of multiple
bool shapes
---
CHANGES.md | 1 +
common/src/app/common/pages/common.cljc | 1 +
.../sidebar/options/shapes/multiple.cljs | 17 ++++++++++++++++-
3 files changed, 18 insertions(+), 1 deletion(-)
diff --git a/CHANGES.md b/CHANGES.md
index 774ad0a2b..62ca75f71 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -34,6 +34,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
diff --git a/common/src/app/common/pages/common.cljc b/common/src/app/common/pages/common.cljc
index dbfe83cba..f12ec2d35 100644
--- a/common/src/app/common/pages/common.cljc
+++ b/common/src/app/common/pages/common.cljc
@@ -537,6 +537,7 @@
:blocked
:hidden
+ :fills
:fill-color
:fill-opacity
:fill-color-ref-id
diff --git a/frontend/src/app/main/ui/workspace/sidebar/options/shapes/multiple.cljs b/frontend/src/app/main/ui/workspace/sidebar/options/shapes/multiple.cljs
index fe9365274..5579183e2 100644
--- a/frontend/src/app/main/ui/workspace/sidebar/options/shapes/multiple.cljs
+++ b/frontend/src/app/main/ui/workspace/sidebar/options/shapes/multiple.cljs
@@ -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
From ed4a5f6c6007e7153f53ed588489424d8e156c30 Mon Sep 17 00:00:00 2001
From: Alejandro Alonso <alejandroalonsofernandez@gmail.com>
Date: Fri, 30 Dec 2022 11:30:03 +0100
Subject: [PATCH 03/19] :bug: Fix ignore booleans on ctrl + click selection
---
frontend/src/app/main/ui/workspace/viewport/hooks.cljs | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/frontend/src/app/main/ui/workspace/viewport/hooks.cljs b/frontend/src/app/main/ui/workspace/viewport/hooks.cljs
index 1c0868f36..fb20a66fb 100644
--- a/frontend/src/app/main/ui/workspace/viewport/hooks.cljs
+++ b/frontend/src/app/main/ui/workspace/viewport/hooks.cljs
@@ -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?))))))
From d1dbc3850dcd508061d7b4a50d17ce6eeb2f581f Mon Sep 17 00:00:00 2001
From: Pablo Alba <pablo.alba@kaleidos.net>
Date: Fri, 30 Dec 2022 11:11:12 +0100
Subject: [PATCH 04/19] :bug: Show color name on inspect
---
.../styles/main/partials/color-bullet.scss | 1 +
.../app/main/ui/components/color_bullet.cljs | 4 +--
.../ui/viewer/inspect/attributes/common.cljs | 33 ++++++++++++-------
3 files changed, 25 insertions(+), 13 deletions(-)
diff --git a/frontend/resources/styles/main/partials/color-bullet.scss b/frontend/resources/styles/main/partials/color-bullet.scss
index 7b1c98800..6a86edd37 100644
--- a/frontend/resources/styles/main/partials/color-bullet.scss
+++ b/frontend/resources/styles/main/partials/color-bullet.scss
@@ -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;
diff --git a/frontend/src/app/main/ui/components/color_bullet.cljs b/frontend/src/app/main/ui/components/color_bullet.cljs
index 4342e25dc..0260aa7ee 100644
--- a/frontend/src/app/main/ui/components/color_bullet.cljs
+++ b/frontend/src/app/main/ui/components/color_bullet.cljs
@@ -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
diff --git a/frontend/src/app/main/ui/viewer/inspect/attributes/common.cljs b/frontend/src/app/main/ui/viewer/inspect/attributes/common.cljs
index 0dd81d1d0..b0959c464 100644
--- a/frontend/src/app/main/ui/viewer/inspect/attributes/common.cljs
+++ b/frontend/src/app/main/ui/viewer/inspect/attributes/common.cljs
@@ -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
From 42b69df671cb033a239f0e9602109cd316dc33b8 Mon Sep 17 00:00:00 2001
From: Pablo Alba <pablo.alba@kaleidos.net>
Date: Fri, 30 Dec 2022 13:34:47 +0100
Subject: [PATCH 05/19] :bug: Fix internal error at setting text style
---
.../app/main/ui/workspace/sidebar/options/menus/typography.cljs | 1 +
1 file changed, 1 insertion(+)
diff --git a/frontend/src/app/main/ui/workspace/sidebar/options/menus/typography.cljs b/frontend/src/app/main/ui/workspace/sidebar/options/menus/typography.cljs
index a6fae4c3b..e00b2ef41 100644
--- a/frontend/src/app/main/ui/workspace/sidebar/options/menus/typography.cljs
+++ b/frontend/src/app/main/ui/workspace/sidebar/options/menus/typography.cljs
@@ -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
From 941aa6ad5d2bef660e422f17b61a3f4a397e1a42 Mon Sep 17 00:00:00 2001
From: Andrey Antukh <niwi@niwi.nz>
Date: Wed, 28 Dec 2022 09:22:42 +0100
Subject: [PATCH 06/19] :fire: Remove unused configuration attrs
---
backend/src/app/config.clj | 10 ----------
1 file changed, 10 deletions(-)
diff --git a/backend/src/app/config.clj b/backend/src/app/config.clj
index 1cb1b2aca..c4cc0ee5a 100644
--- a/backend/src/app/config.clj
+++ b/backend/src/app/config.clj
@@ -192,15 +192,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)
@@ -306,11 +301,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
From 3b61a7dd91219cf87b2361ac57d0739090a9fa5d Mon Sep 17 00:00:00 2001
From: Andrey Antukh <niwi@niwi.nz>
Date: Sat, 31 Dec 2022 10:48:27 +0100
Subject: [PATCH 07/19] :bug: Fix incorrect arguments to process-changes
---
.../app/main/data/workspace/persistence.cljs | 35 ++++++++++---------
1 file changed, 19 insertions(+), 16 deletions(-)
diff --git a/frontend/src/app/main/data/workspace/persistence.cljs b/frontend/src/app/main/data/workspace/persistence.cljs
index 29df1fd43..2d8d1d8e9 100644
--- a/frontend/src/app/main/data/workspace/persistence.cljs
+++ b/frontend/src/app/main/data/workspace/persistence.cljs
@@ -216,29 +216,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))))
From 7a8b0e710b0b5d16abed2170a5791e3d1b862ae3 Mon Sep 17 00:00:00 2001
From: Andrey Antukh <niwi@niwi.nz>
Date: Sat, 31 Dec 2022 10:49:04 +0100
Subject: [PATCH 08/19] :sparkles: Improve trace reporting on unhandled
exception
---
frontend/src/app/main/errors.cljs | 11 +++++++++--
1 file changed, 9 insertions(+), 2 deletions(-)
diff --git a/frontend/src/app/main/errors.cljs b/frontend/src/app/main/errors.cljs
index fe9eb8744..d6d732923 100644
--- a/frontend/src/app/main/errors.cljs
+++ b/frontend/src/app/main/errors.cljs
@@ -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)))
From d68be0869b502f453fd2edaabcea07a3eabd658b Mon Sep 17 00:00:00 2001
From: Andrey Antukh <niwi@niwi.nz>
Date: Sat, 31 Dec 2022 10:49:29 +0100
Subject: [PATCH 09/19] :sparkles: Improve error report on point constructor
---
common/src/app/common/geom/point.cljc | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/common/src/app/common/geom/point.cljc b/common/src/app/common/geom/point.cljc
index e15f0fff0..bfc55dc6d 100644
--- a/common/src/app/common/geom/point.cljc
+++ b/common/src/app/common/geom/point.cljc
@@ -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)))
From 73a3e0c0ae7444feef28b1e4d56b42186989e2f8 Mon Sep 17 00:00:00 2001
From: Andrey Antukh <niwi@niwi.nz>
Date: Tue, 27 Dec 2022 20:04:41 +0100
Subject: [PATCH 10/19] :tada: Add usage quotes
---
backend/src/app/config.clj | 22 +-
backend/src/app/db.clj | 1 +
backend/src/app/emails.clj | 18 +-
backend/src/app/migrations.clj | 5 +-
.../migrations/sql/0098-add-quotes-table.sql | 82 +++++
backend/src/app/rpc/commands/files/create.clj | 9 +-
backend/src/app/rpc/commands/teams.clj | 27 ++
backend/src/app/rpc/commands/verify_token.clj | 6 +
backend/src/app/rpc/mutations/fonts.clj | 4 +
backend/src/app/rpc/mutations/projects.clj | 5 +
backend/src/app/rpc/quotes.clj | 327 +++++++++++++++++
backend/test/backend_tests/helpers.clj | 3 +-
backend/test/backend_tests/rpc_font_test.clj | 68 ++--
.../test/backend_tests/rpc_quotes_test.clj | 344 ++++++++++++++++++
common/src/app/common/spec.cljc | 15 +-
common/src/app/common/types/shape_tree.cljc | 13 +-
.../main/data/workspace/notifications.cljs | 1 -
frontend/src/app/main/errors.cljs | 16 +-
frontend/translations/en.po | 4 +
frontend/translations/es.po | 12 +
20 files changed, 914 insertions(+), 68 deletions(-)
create mode 100644 backend/src/app/migrations/sql/0098-add-quotes-table.sql
create mode 100644 backend/src/app/rpc/quotes.clj
create mode 100644 backend/test/backend_tests/rpc_quotes_test.clj
diff --git a/backend/src/app/config.clj b/backend/src/app/config.clj
index c4cc0ee5a..1fe8ddd2b 100644
--- a/backend/src/app/config.clj
+++ b/backend/src/app/config.clj
@@ -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,14 @@
(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 ::default-blob-version ::us/integer)
(s/def ::error-report-webhook ::us/string)
(s/def ::user-feedback-destination ::us/string)
@@ -272,6 +280,15 @@
::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
+
::redis-uri
::registration-domain-whitelist
::rpc-rlimit-config
@@ -311,7 +328,8 @@
[:enable-backend-api-doc
:enable-backend-worker
:enable-secure-session-cookies
- :enable-email-verification])
+ :enable-email-verification
+ :enable-quotes])
(defn- parse-flags
[config]
diff --git a/backend/src/app/db.clj b/backend/src/app/db.clj
index 6e4d12061..045ee46a9 100644
--- a/backend/src/app/db.clj
+++ b/backend/src/app/db.clj
@@ -167,6 +167,7 @@
(instance? javax.sql.DataSource v))
(s/def ::pool pool?)
+(s/def ::conn-or-pool some?)
(defn closed?
[pool]
diff --git a/backend/src/app/emails.clj b/backend/src/app/emails.clj
index d072845a5..8a69f11d6 100644
--- a/backend/src/app/emails.clj
+++ b/backend/src/app/emails.clj
@@ -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
diff --git a/backend/src/app/migrations.clj b/backend/src/app/migrations.clj
index d8b13bcbb..b50bf97c6 100644
--- a/backend/src/app/migrations.clj
+++ b/backend/src/app/migrations.clj
@@ -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)
diff --git a/backend/src/app/migrations/sql/0098-add-quotes-table.sql b/backend/src/app/migrations/sql/0098-add-quotes-table.sql
new file mode 100644
index 000000000..3041f7846
--- /dev/null
+++ b/backend/src/app/migrations/sql/0098-add-quotes-table.sql
@@ -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));
diff --git a/backend/src/app/rpc/commands/files/create.clj b/backend/src/app/rpc/commands/files/create.clj
index 4a2b4d641..2d4a7a808 100644
--- a/backend/src/app/rpc/commands/files/create.clj
+++ b/backend/src/app/rpc/commands/files/create.clj
@@ -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})))))
-
diff --git a/backend/src/app/rpc/commands/teams.clj b/backend/src/app/rpc/commands/teams.clj
index f09ce9ede..f040a034f 100644
--- a/backend/src/app/rpc/commands/teams.clj
+++ b/backend/src/app/rpc/commands/teams.clj
@@ -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
diff --git a/backend/src/app/rpc/commands/verify_token.clj b/backend/src/app/rpc/commands/verify_token.clj
index b9b1673d2..6eb455f22 100644
--- a/backend/src/app/rpc/commands/verify_token.clj
+++ b/backend/src/app/rpc/commands/verify_token.clj
@@ -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})
diff --git a/backend/src/app/rpc/mutations/fonts.clj b/backend/src/app/rpc/mutations/fonts.clj
index 1f00de84c..e354074f8 100644
--- a/backend/src/app/rpc/mutations/fonts.clj
+++ b/backend/src/app/rpc/mutations/fonts.clj
@@ -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
diff --git a/backend/src/app/rpc/mutations/projects.clj b/backend/src/app/rpc/mutations/projects.clj
index 9c9188217..1a49d4fc1 100644
--- a/backend/src/app/rpc/mutations/projects.clj
+++ b/backend/src/app/rpc/mutations/projects.clj
@@ -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)
diff --git a/backend/src/app/rpc/quotes.clj b/backend/src/app/rpc/quotes.clj
new file mode 100644
index 000000000..b3c083cdd
--- /dev/null
+++ b/backend/src/app/rpc/quotes.clj
@@ -0,0 +1,327 @@
+;; 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.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}]
+ (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 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"))
diff --git a/backend/test/backend_tests/helpers.clj b/backend/test/backend_tests/helpers.clj
index 1fa09c4d7..9c3fcf75f 100644
--- a/backend/test/backend_tests/helpers.clj
+++ b/backend/test/backend_tests/helpers.clj
@@ -59,7 +59,8 @@
(def default-flags
[:enable-secure-session-cookies
:enable-email-verification
- :enable-smtp])
+ :enable-smtp
+ :enable-quotes])
(defn state-init
[next]
diff --git a/backend/test/backend_tests/rpc_font_test.clj b/backend/test/backend_tests/rpc_font_test.clj
index 6116b8d8a..bf27cba90 100644
--- a/backend/test/backend_tests/rpc_font_test.clj
+++ b/backend/test/backend_tests/rpc_font_test.clj
@@ -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})
diff --git a/backend/test/backend_tests/rpc_quotes_test.clj b/backend/test/backend_tests/rpc_quotes_test.clj
new file mode 100644
index 000000000..99dae0327
--- /dev/null
+++ b/backend/test/backend_tests/rpc_quotes_test.clj
@@ -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)
+
+ )))
diff --git a/common/src/app/common/spec.cljc b/common/src/app/common/spec.cljc
index 1dd0eff35..76deea9f4 100644
--- a/common/src/app/common/spec.cljc
+++ b/common/src/app/common/spec.cljc
@@ -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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
diff --git a/common/src/app/common/types/shape_tree.cljc b/common/src/app/common/types/shape_tree.cljc
index 6304264a8..d7fd2c8db 100644
--- a/common/src/app/common/types/shape_tree.cljc
+++ b/common/src/app/common/types/shape_tree.cljc
@@ -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)]
diff --git a/frontend/src/app/main/data/workspace/notifications.cljs b/frontend/src/app/main/data/workspace/notifications.cljs
index cc5a0adfb..7c1900dd8 100644
--- a/frontend/src/app/main/data/workspace/notifications.cljs
+++ b/frontend/src/app/main/data/workspace/notifications.cljs
@@ -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)
diff --git a/frontend/src/app/main/errors.cljs b/frontend/src/app/main/errors.cljs
index fe9eb8744..0aec80229 100644
--- a/frontend/src/app/main/errors.cljs
+++ b/frontend/src/app/main/errors.cljs
@@ -173,20 +173,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
diff --git a/frontend/translations/en.po b/frontend/translations/en.po
index 6bf469c94..9f177f8c4 100644
--- a/frontend/translations/en.po
+++ b/frontend/translations/en.po
@@ -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."
diff --git a/frontend/translations/es.po b/frontend/translations/es.po
index b3982938e..252c88ffc 100644
--- a/frontend/translations/es.po
+++ b/frontend/translations/es.po
@@ -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"
From 27451b97962a36d0d1161770ceb9d4cdf3872221 Mon Sep 17 00:00:00 2001
From: Andrey Antukh <niwi@niwi.nz>
Date: Fri, 30 Dec 2022 00:27:05 +0100
Subject: [PATCH 11/19] :recycle: Refactor comments RPC methods and add tests
---
backend/src/app/config.clj | 4 +
backend/src/app/rpc.clj | 8 +-
backend/src/app/rpc/commands/comments.clj | 444 +++++++++---------
backend/src/app/rpc/commands/files.clj | 9 +-
backend/src/app/rpc/quotes.clj | 14 +-
backend/test/backend_tests/helpers.clj | 4 +-
.../test/backend_tests/rpc_comment_test.clj | 290 ++++++++++++
frontend/src/app/main/data/comments.cljs | 27 +-
.../src/app/main/data/workspace/comments.cljs | 1 -
frontend/src/app/main/ui/comments.cljs | 3 +-
10 files changed, 571 insertions(+), 233 deletions(-)
create mode 100644 backend/test/backend_tests/rpc_comment_test.clj
diff --git a/backend/src/app/config.clj b/backend/src/app/config.clj
index 1fe8ddd2b..c333be29f 100644
--- a/backend/src/app/config.clj
+++ b/backend/src/app/config.clj
@@ -137,6 +137,8 @@
(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)
@@ -288,6 +290,8 @@
::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
diff --git a/backend/src/app/rpc.clj b/backend/src/app/rpc.clj
index 7ba271128..26e39ef09 100644
--- a/backend/src/app/rpc.clj
+++ b/backend/src/app/rpc.clj
@@ -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 [_ _]
diff --git a/backend/src/app/rpc/commands/comments.clj b/backend/src/app/rpc/commands/comments.clj
index 2d0d6734f..168c5a295 100644
--- a/backend/src/app/rpc/commands/comments.clj
+++ b/backend/src/app/rpc/commands/comments.clj
@@ -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)))
diff --git a/backend/src/app/rpc/commands/files.clj b/backend/src/app/rpc/commands/files.clj
index 054bf22ff..affa92e57 100644
--- a/backend/src/app/rpc/commands/files.clj
+++ b/backend/src/app/rpc/commands/files.clj
@@ -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
diff --git a/backend/src/app/rpc/quotes.clj b/backend/src/app/rpc/quotes.clj
index b3c083cdd..76cfc82f7 100644
--- a/backend/src/app/rpc/quotes.clj
+++ b/backend/src/app/rpc/quotes.clj
@@ -8,6 +8,7 @@
"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]
@@ -60,6 +61,16 @@
(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"
@@ -286,7 +297,8 @@
(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 project-id profile-id team-id profile-id profile-id])
+ (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!)))
diff --git a/backend/test/backend_tests/helpers.clj b/backend/test/backend_tests/helpers.clj
index 9c3fcf75f..a14dd4374 100644
--- a/backend/test/backend_tests/helpers.clj
+++ b/backend/test/backend_tests/helpers.clj
@@ -323,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}]
diff --git a/backend/test/backend_tests/rpc_comment_test.clj b/backend/test/backend_tests/rpc_comment_test.clj
new file mode 100644
index 000000000..d088f8b06
--- /dev/null
+++ b/backend/test/backend_tests/rpc_comment_test.clj
@@ -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))))))
+
+ )))
diff --git a/frontend/src/app/main/data/comments.cljs b/frontend/src/app/main/data/comments.cljs
index 9b87ec18a..aced66cdc 100644
--- a/frontend/src/app/main/data/comments.cljs
+++ b/frontend/src/app/main/data/comments.cljs
@@ -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
diff --git a/frontend/src/app/main/data/workspace/comments.cljs b/frontend/src/app/main/data/workspace/comments.cljs
index 571e59e1f..25f59ffe2 100644
--- a/frontend/src/app/main/data/workspace/comments.cljs
+++ b/frontend/src/app/main/data/workspace/comments.cljs
@@ -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)
diff --git a/frontend/src/app/main/ui/comments.cljs b/frontend/src/app/main/ui/comments.cljs
index d8d451307..ea2a00ab9 100644
--- a/frontend/src/app/main/ui/comments.cljs
+++ b/frontend/src/app/main/ui/comments.cljs
@@ -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
From e372e8ba3e9abf1a9e6c9b8b8633fca7b968c074 Mon Sep 17 00:00:00 2001
From: Andrey Antukh <niwi@niwi.nz>
Date: Sat, 31 Dec 2022 16:37:42 +0100
Subject: [PATCH 12/19] :bug: Fix s3 client issues with s3 compatible services
---
backend/deps.edn | 3 +-
backend/src/app/storage/s3.clj | 86 +++++++++++++++++++---------------
2 files changed, 49 insertions(+), 40 deletions(-)
diff --git a/backend/deps.edn b/backend/deps.edn
index 4e9256efa..51898e67c 100644
--- a/backend/deps.edn
+++ b/backend/deps.edn
@@ -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
diff --git a/backend/src/app/storage/s3.clj b/backend/src/app/storage/s3.clj
index 0f6d017d7..6933b3d41 100644
--- a/backend/src/app/storage/s3.clj
+++ b/backend/src/app/storage/s3.clj
@@ -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
From 7e21d827c97584ac0bbafed54cf49be2ba3edf57 Mon Sep 17 00:00:00 2001
From: Alejandro Alonso <alejandroalonsofernandez@gmail.com>
Date: Mon, 2 Jan 2023 08:41:21 +0100
Subject: [PATCH 13/19] :bug: Fix duplicate frame issues
---
.../app/main/data/workspace/selection.cljs | 23 +++++++++++++------
1 file changed, 16 insertions(+), 7 deletions(-)
diff --git a/frontend/src/app/main/data/workspace/selection.cljs b/frontend/src/app/main/data/workspace/selection.cljs
index 3ef4a4bf6..838f21812 100644
--- a/frontend/src/app/main/data/workspace/selection.cljs
+++ b/frontend/src/app/main/data/workspace/selection.cljs
@@ -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]
From 407831ffd1a5bb45fa47e5bd494875444b3f88e8 Mon Sep 17 00:00:00 2001
From: Eva <eva.marco@kaleidos.net>
Date: Mon, 2 Jan 2023 09:34:19 +0100
Subject: [PATCH 14/19] :bug: Fix some visual errors
---
.../resources/styles/main/partials/dashboard-header.scss | 3 ++-
.../resources/styles/main/partials/dashboard-sidebar.scss | 8 +++++++-
frontend/src/app/main/ui/dashboard/team.cljs | 2 +-
3 files changed, 10 insertions(+), 3 deletions(-)
diff --git a/frontend/resources/styles/main/partials/dashboard-header.scss b/frontend/resources/styles/main/partials/dashboard-header.scss
index 9df42505b..8da45d989 100644
--- a/frontend/resources/styles/main/partials/dashboard-header.scss
+++ b/frontend/resources/styles/main/partials/dashboard-header.scss
@@ -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;
}
}
diff --git a/frontend/resources/styles/main/partials/dashboard-sidebar.scss b/frontend/resources/styles/main/partials/dashboard-sidebar.scss
index 070c5b199..0298cb704 100644
--- a/frontend/resources/styles/main/partials/dashboard-sidebar.scss
+++ b/frontend/resources/styles/main/partials/dashboard-sidebar.scss
@@ -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;
diff --git a/frontend/src/app/main/ui/dashboard/team.cljs b/frontend/src/app/main/ui/dashboard/team.cljs
index 9ab754741..e8dc7e20e 100644
--- a/frontend/src/app/main/ui/dashboard/team.cljs
+++ b/frontend/src/app/main/ui/dashboard/team.cljs
@@ -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])]]))
From 32d39c35e4fec74f718926f240182dffb4f02a3a Mon Sep 17 00:00:00 2001
From: "alonso.torres" <alonso.torres@kaleidos.net>
Date: Fri, 30 Dec 2022 13:50:37 +0100
Subject: [PATCH 15/19] :bug: Fix problem with flipped shapes
---
.../app/common/geom/shapes/transforms.cljc | 8 +++----
.../src/app/main/ui/shapes/text/svg_text.cljs | 20 +-----------------
.../app/main/ui/workspace/shapes/text.cljs | 2 +-
.../shapes/text/text_edition_outline.cljs | 2 +-
.../main/ui/workspace/viewport/selection.cljs | 21 ++++++++++++++++---
5 files changed, 25 insertions(+), 28 deletions(-)
diff --git a/common/src/app/common/geom/shapes/transforms.cljc b/common/src/app/common/geom/shapes/transforms.cljc
index 4383d92bb..3d9852680 100644
--- a/common/src/app/common/geom/shapes/transforms.cljc
+++ b/common/src/app/common/geom/shapes/transforms.cljc
@@ -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))
"")))
diff --git a/frontend/src/app/main/ui/shapes/text/svg_text.cljs b/frontend/src/app/main/ui/shapes/text/svg_text.cljs
index 6086efb9d..5e93ce855 100644
--- a/frontend/src/app/main/ui/shapes/text/svg_text.cljs
+++ b/frontend/src/app/main/ui/shapes/text/svg_text.cljs
@@ -32,23 +32,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 +43,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 +79,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)
diff --git a/frontend/src/app/main/ui/workspace/shapes/text.cljs b/frontend/src/app/main/ui/workspace/shapes/text.cljs
index b51432b5b..39ae91b1c 100644
--- a/frontend/src/app/main/ui/workspace/shapes/text.cljs
+++ b/frontend/src/app/main/ui/workspace/shapes/text.cljs
@@ -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)
diff --git a/frontend/src/app/main/ui/workspace/shapes/text/text_edition_outline.cljs b/frontend/src/app/main/ui/workspace/shapes/text/text_edition_outline.cljs
index aa4e29164..d7766d517 100644
--- a/frontend/src/app/main/ui/workspace/shapes/text/text_edition_outline.cljs
+++ b/frontend/src/app/main/ui/workspace/shapes/text/text_edition_outline.cljs
@@ -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
diff --git a/frontend/src/app/main/ui/workspace/viewport/selection.cljs b/frontend/src/app/main/ui/workspace/viewport/selection.cljs
index f4f829fc7..57fc23d8a 100644
--- a/frontend/src/app/main/ui/workspace/viewport/selection.cljs
+++ b/frontend/src/app/main/ui/workspace/viewport/selection.cljs
@@ -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
From 733b35dd538c431f882bf661e6fe0a7a9b07b15a Mon Sep 17 00:00:00 2001
From: "alonso.torres" <alonso.torres@kaleidos.net>
Date: Fri, 30 Dec 2022 16:08:27 +0100
Subject: [PATCH 16/19] :arrow_up: Updated potok dependency
---
frontend/deps.edn | 2 +-
frontend/src/app/main/store.cljs | 14 ++++++++++++++
2 files changed, 15 insertions(+), 1 deletion(-)
diff --git a/frontend/deps.edn b/frontend/deps.edn
index 606fa73c9..c158bea0e 100644
--- a/frontend/deps.edn
+++ b/frontend/deps.edn
@@ -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
diff --git a/frontend/src/app/main/store.cljs b/frontend/src/app/main/store.cljs
index 431ff6d3a..0c66507fc 100644
--- a/frontend/src/app/main/store.cljs
+++ b/frontend/src/app/main/store.cljs
@@ -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
From ff9b2090cf764e1b7cc68a6fc82e43cc9e728e3c Mon Sep 17 00:00:00 2001
From: "alonso.torres" <alonso.torres@kaleidos.net>
Date: Fri, 30 Dec 2022 16:08:44 +0100
Subject: [PATCH 17/19] :bug: Fix problem with shapes moving randomly
---
.../app/main/data/workspace/persistence.cljs | 69 ++++++++++++-------
1 file changed, 46 insertions(+), 23 deletions(-)
diff --git a/frontend/src/app/main/data/workspace/persistence.cljs b/frontend/src/app/main/data/workspace/persistence.cljs
index 2d8d1d8e9..c6f7d4479 100644
--- a/frontend/src/app/main/data/workspace/persistence.cljs
+++ b/frontend/src/app/main/data/workspace/persistence.cljs
@@ -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)
From ade13d3bca663897cb9167c3a4084f52d5ccb6b5 Mon Sep 17 00:00:00 2001
From: "alonso.torres" <alonso.torres@kaleidos.net>
Date: Mon, 2 Jan 2023 11:13:44 +0100
Subject: [PATCH 18/19] :bug: Fix problem with auto-height text resize
---
.../src/app/common/geom/shapes/modifiers.cljc | 56 ++++++++++------
.../app/main/data/workspace/modifiers.cljs | 64 +++++++++++++------
.../src/app/main/data/workspace/texts.cljs | 3 +-
.../src/app/main/ui/shapes/text/svg_text.cljs | 2 -
4 files changed, 82 insertions(+), 43 deletions(-)
diff --git a/common/src/app/common/geom/shapes/modifiers.cljc b/common/src/app/common/geom/shapes/modifiers.cljc
index 270df14d5..1966fc03f 100644
--- a/common/src/app/common/geom/shapes/modifiers.cljc
+++ b/common/src/app/common/geom/shapes/modifiers.cljc
@@ -317,33 +317,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)))
diff --git a/frontend/src/app/main/data/workspace/modifiers.cljs b/frontend/src/app/main/data/workspace/modifiers.cljs
index 808798457..ec2688421 100644
--- a/frontend/src/app/main/data/workspace/modifiers.cljs
+++ b/frontend/src/app/main/data/workspace/modifiers.cljs
@@ -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))
diff --git a/frontend/src/app/main/data/workspace/texts.cljs b/frontend/src/app/main/data/workspace/texts.cljs
index 7659f8b35..1d4c0098f 100644
--- a/frontend/src/app/main/data/workspace/texts.cljs
+++ b/frontend/src/app/main/data/workspace/texts.cljs
@@ -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
diff --git a/frontend/src/app/main/ui/shapes/text/svg_text.cljs b/frontend/src/app/main/ui/shapes/text/svg_text.cljs
index 5e93ce855..64edf8503 100644
--- a/frontend/src/app/main/ui/shapes/text/svg_text.cljs
+++ b/frontend/src/app/main/ui/shapes/text/svg_text.cljs
@@ -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]
From 3ce1540331e82c53da2381d4a14368948b6a434e Mon Sep 17 00:00:00 2001
From: Pablo Alba <pablo.alba@kaleidos.net>
Date: Mon, 2 Jan 2023 11:20:54 +0100
Subject: [PATCH 19/19] :bug: Fix export/import svg + json format isn't working
---
backend/src/app/rpc/commands/files/temp.clj | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/backend/src/app/rpc/commands/files/temp.clj b/backend/src/app/rpc/commands/files/temp.clj
index 74468f486..0bc2c1c87 100644
--- a/backend/src/app/rpc/commands/files/temp.clj
+++ b/backend/src/app/rpc/commands/files/temp.clj
@@ -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