Merge pull request #2868 from penpot/alotor-fix-layout-problems

Fix layout problems

CHANGES.md

@@ -1,8 +1,6 @@
 # CHANGELOG
 
-## :rocket: Next (1.17)
-
-### :boom: Breaking changes & Deprecations
+## 1.17.0
 
 ### :sparkles: New features
 
@@ -10,6 +8,18 @@
 - Better overlays interactions on boards inside boards [Taiga #4386](https://tree.taiga.io/project/penpot/us/4386)
 - Show board miniature in manual overlay setting [Taiga #4475](https://tree.taiga.io/project/penpot/issue/4475)
 - Handoff visual improvements [Taiga #3124](https://tree.taiga.io/project/penpot/us/3124)
+- Dynamic alignment only in sight [Github 1971](https://github.com/penpot/penpot/issues/1971)
+- Add some accessibility to shortcut panel [Taiga #4713](https://tree.taiga.io/project/penpot/issue/4713)
+- Add shortcuts for text editing [Taiga #2052](https://tree.taiga.io/project/penpot/us/2052)
+- Second level boards treated as groups in terms of selection [Taiga #4269](https://tree.taiga.io/project/penpot/us/4269)
+- Performance improvements both for backend and frontend
+- Accessibility improvements for login area [Taiga #4353](https://tree.taiga.io/project/penpot/us/4353)
+- Outbound webhooks [Taiga #4577](https://tree.taiga.io/project/penpot/us/4577)
+- Add copy invitation link to the invitation options [Taiga #4213](https://tree.taiga.io/project/penpot/us/4213)
+- Dynamic alignment only in sight [Taiga #3537](https://tree.taiga.io/project/penpot/us/3537)
+- Improve naming of layers [Taiga #4036](https://tree.taiga.io/project/penpot/us/4036)
+- Add zoom lense [Taiga #4691](https://tree.taiga.io/project/penpot/us/4691)
+- Detect potential problems with custom font vertical metrics [Taiga #4697](https://tree.taiga.io/project/penpot/us/4697)
 
 ### :bug: Bugs fixed
 
@@ -22,12 +32,51 @@
 - Fix adding an extra page on import [Taiga #4543](https://tree.taiga.io/project/penpot/task/4543)
 - Fix unable to select text at assets inputs in firefox [Taiga #4572](https://tree.taiga.io/project/penpot/issue/4572)
 - Fix component sync when converting to path [Taiga #3642](https://tree.taiga.io/project/penpot/issue/3642)
-
-### :arrow_up: Deps updates
+- Fix style for team invite in deutsch [Taiga #4614](https://tree.taiga.io/project/penpot/issue/4614)
+- Fix problem with text edition in Safari [Taiga #4046](https://tree.taiga.io/project/penpot/issue/4046)
+- Fix show outline with rounded corners on rects [Taiga #4053](https://tree.taiga.io/project/penpot/issue/4053)
+- Fix wrong interaction between comments and panning modes [Taiga #4297](https://tree.taiga.io/project/penpot/issue/4297)
+- Fix bad element positioning on interaction with fixed scroll [Github #2660](https://github.com/penpot/penpot/issues/2660)
+- Fix display type of component library not persistent [Taiga #4512](https://tree.taiga.io/project/penpot/issue/4512)
+- Fix problem when moving texts with keyboard [#2690](https://github.com/penpot/penpot/issues/2690)
+- Fix problem when drawing boxes won't detect mouse-up [Taiga #4618](https://tree.taiga.io/project/penpot/issue/4618)
+- Fix missing loading icon on shared libraries [Taiga #4148](https://tree.taiga.io/project/penpot/issue/4148)
+- 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)
+- Fix pressing the enter key gives you an internal error [Github 2675](https://github.com/penpot/penpot/issues/2675) [Github 2577](https://github.com/penpot/penpot/issues/2577)
+- Fix confirm group name with enter doesn't work in assets modal [Taiga #4506](https://tree.taiga.io/project/penpot/issue/4506)
+- Fix group/ungroup shapes inside a component [Taiga #4052](https://tree.taiga.io/project/penpot/issue/4052)
+- Fix wrong update of text in components [Taiga #4646](https://tree.taiga.io/project/penpot/issue/4646)
+- Fix problem with SVG imports with style [#2605](https://github.com/penpot/penpot/issues/2605)
+- Fix ghost shapes after sync groups in components [Taiga #4649](https://tree.taiga.io/project/penpot/issue/4649)
+- Fix layer orders messed up on move, group, reparent and undo [Github #2672](https://github.com/penpot/penpot/issues/2672)
+- Fix max height in library dialog [Github #2335](https://github.com/penpot/penpot/issues/2335)
+- Fix undo ungroup (shift+g) scrambles positions [Taiga #4674](https://tree.taiga.io/project/penpot/issue/4674)
+- Fix justified text is stretched [Github #2539](https://github.com/penpot/penpot/issues/2539)
+- Fix mousewheel on viewer inspector [Taiga #4221](https://tree.taiga.io/project/penpot/issue/4221)
+- Fix path edition activated on boards [Taiga #4105](https://tree.taiga.io/project/penpot/issue/4105)
+- Fix hidden layers inside groups become visible after the group visibility is changed[Taiga #4710](https://tree.taiga.io/project/penpot/issue/4710)
+- Fix format of HSLA color on viewer [Taiga #4393](https://tree.taiga.io/project/penpot/issue/4393)
+- Fix some typos [Taiga #4724](https://tree.taiga.io/project/penpot/issue/4724)
+- Fix ctrl+c for inspect code [Taiga #4739](https://tree.taiga.io/project/penpot/issue/4739)
+- Fix text in custom font is not at the expected position at export [Taiga #4394](https://tree.taiga.io/project/penpot/issue/4394)
+- Fix unneeded popup when updating local components [Taiga #4430](https://tree.taiga.io/project/penpot/issue/4430)
+- Fix multiuser - "Shadow" element is not updating immediately [Taiga #4709](https://tree.taiga.io/project/penpot/issue/4709)
+- Fix paths not flagged as modified when resized [Taiga #4742](https://tree.taiga.io/project/penpot/issue/4742)
+- Fix resend invitation doesn't reset the expiration date [Taiga #4741](https://tree.taiga.io/project/penpot/issue/4741)
+- Fix incorrect state after undo page creation [Taiga #4690](https://tree.taiga.io/project/penpot/issue/4690)
+- Fix copy paste texts with typography assets linked [Taiga #4750](https://tree.taiga.io/project/penpot/issue/4750)
 
 ### :heart: Community contributions by (Thank you!)
 
+- To @iprithvitharun: let's make UX Writing contributions in Open Source a trend!
+
 ## 1.16.2-beta
+
+### :bug: Bugs fixed
+
 - Fix strage cursor behaviour after clicking viewport with text pool [Github #2447](https://github.com/penpot/penpot/issues/2447)
 
 ## 1.16.1-beta
@@ -97,7 +146,6 @@
 - Fix grid not syncing immediately in multiuser [Taiga #4339](https://tree.taiga.io/project/penpot/issue/4339)
 - Fix custom font upload fails silently for unsupported formats [Taiga #4279](https://tree.taiga.io/project/penpot/issue/4280)
 
-### :arrow_up: Deps updates
 ### :heart: Community contributions by (Thank you!)
 
 - To @andrewzhurov for many code contributions on this release.

backend/deps.edn

@@ -1,12 +1,12 @@
 {:deps
  {penpot/common {:local/root "../common"}
   org.clojure/clojure {:mvn/version "1.11.1"}
-  org.clojure/core.async {:mvn/version "1.5.648"}
+  org.clojure/core.async {:mvn/version "1.6.673"}
 
   ;; Logging
-  org.zeromq/jeromq {:mvn/version "0.5.2"}
+  org.zeromq/jeromq {:mvn/version "0.5.3"}
 
-  com.github.luben/zstd-jni {:mvn/version "1.5.2-4"}
+  com.github.luben/zstd-jni {:mvn/version "1.5.2-5"}
   org.clojure/data.fressian {:mvn/version "1.0.0"}
 
   io.prometheus/simpleclient {:mvn/version "0.16.0"}
@@ -18,18 +18,18 @@
 
   io.prometheus/simpleclient_httpserver {:mvn/version "0.16.0"}
 
-  io.lettuce/lettuce-core {:mvn/version "6.2.1.RELEASE"}
+  io.lettuce/lettuce-core {:mvn/version "6.2.2.RELEASE"}
   java-http-clj/java-http-clj {:mvn/version "0.4.3"}
 
   funcool/yetti
-  {:git/tag "v9.11"
-   :git/sha "6f9197a"
+  {:git/tag "v9.12"
+   :git/sha "51646d8"
    :git/url "https://github.com/funcool/yetti.git"
    :exclusions [org.slf4j/slf4j-api]}
 
-  com.github.seancorfield/next.jdbc {:mvn/version "1.3.834"}
+  com.github.seancorfield/next.jdbc {:mvn/version "1.3.847"}
   metosin/reitit-core {:mvn/version "0.5.18"}
-  org.postgresql/postgresql {:mvn/version "42.5.0"}
+  org.postgresql/postgresql {:mvn/version "42.5.1"}
   com.zaxxer/HikariCP {:mvn/version "5.0.1"}
 
   io.whitfin/siphash {:mvn/version "2.0.0"}
@@ -37,9 +37,9 @@
   buddy/buddy-hashers {:mvn/version "1.8.158"}
   buddy/buddy-sign {:mvn/version "3.4.333"}
 
-  com.github.ben-manes.caffeine/caffeine {:mvn/version "3.1.1"}
+  com.github.ben-manes.caffeine/caffeine {:mvn/version "3.1.2"}
 
-  org.jsoup/jsoup {:mvn/version "1.15.1"}
+  org.jsoup/jsoup {:mvn/version "1.15.3"}
   org.im4java/im4java
   {:git/tag "1.4.0-penpot-2"
    :git/sha "e2b3e16"
@@ -51,11 +51,12 @@
   integrant/integrant {:mvn/version "0.8.0"}
 
   dawran6/emoji {:mvn/version "0.1.5"}
-  markdown-clj/markdown-clj {:mvn/version "1.11.3"}
+  markdown-clj/markdown-clj {:mvn/version "1.11.4"}
 
   ;; Pretty Print specs
   pretty-spec/pretty-spec {:mvn/version "0.1.4"}
-  software.amazon.awssdk/s3 {:mvn/version "2.17.278"}}
+  software.amazon.awssdk/s3 {:mvn/version "2.19.8"}
+  }
 
  :paths ["src" "resources" "target/classes"]
  :aliases
@@ -69,8 +70,10 @@
     mockery/mockery {:mvn/version "RELEASE"}}
    :extra-paths ["test" "dev"]}
 
+
   :build
-  {:extra-deps {io.github.clojure/tools.build {:git/tag "v0.8.3" :git/sha "0d20256"}}
+  {:extra-deps
+   {io.github.clojure/tools.build {:git/tag "v0.9.0" :git/sha "8c93e0c"}}
    :ns-default build}
 
   :test

backend/scripts/build

@@ -13,9 +13,9 @@ cp ../CHANGES.md target/classes/changelog.md;
 clojure -T:build jar;
 mv target/penpot.jar target/dist/penpot.jar
 cp scripts/run.template.sh target/dist/run.sh;
-cp scripts/manage.template.sh target/dist/manage.sh;
+cp scripts/manage.py target/dist/manage.py
 chmod +x target/dist/run.sh;
-chmod +x target/dist/manage.sh;
+chmod +x target/dist/manage.py
 
 # Prefetch
 bb ./scripts/prefetch-templates.clj resources/app/onboarding.edn builtin-templates/

backend/scripts/manage.py

@@ -0,0 +1,167 @@
+#!/usr/bin/env python3
+#
+# 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
+
+import argparse
+import json
+import socket
+import sys
+
+from getpass import getpass
+from urllib.parse import urlparse
+
+PREPL_URI = "tcp://localhost:6063"
+
+def get_prepl_conninfo():
+    uri_data = urlparse(PREPL_URI)
+    if uri_data.scheme != "tcp":
+        raise RuntimeException(f"invalid PREPL_URI: {PREPL_URI}")
+
+    if not isinstance(uri_data.netloc, str):
+        raise RuntimeException(f"invalid PREPL_URI: {PREPL_URI}")
+
+    host, port = uri_data.netloc.split(":", 2)
+
+    if port is None:
+        port = 6063
+
+    if isinstance(port, str):
+        port = int(port)
+
+    return host, port
+
+def send_eval(expr):
+    host, port = get_prepl_conninfo()
+
+    with socket.socket(socket.AF_INET, socket.SOCK_STREAM) as s:
+        s.connect((host, port))
+        s.send(expr.encode("utf-8"))
+        s.send(b":repl/quit\n\n")
+
+        with s.makefile() as f:
+            result = json.load(f)
+            tag = result.get("tag", None)
+            if tag != "ret":
+                raise RuntimeException("unexpected response from PREPL")
+            return result.get("val", None), result.get("exception", None)
+
+def encode(val):
+    return json.dumps(json.dumps(val))
+
+def print_error(res):
+    for error in res["via"]:
+        print("ERR:", error["message"])
+        break
+
+def run_cmd(params):
+    expr = "(app.srepl.ext/run-json-cmd {})".format(encode(params))
+    res, failed = send_eval(expr)
+    if failed:
+        print_error(res)
+        sys.exit(-1)
+
+    return res
+
+def create_profile(fullname, email, password):
+    params = {
+        "cmd": "create-profile",
+        "params": {
+            "fullname": fullname,
+            "email": email,
+            "password": password
+        }
+    }
+
+    res = run_cmd(params)
+    print(f"Created: {res['email']} / {res['id']}")
+
+def update_profile(email, fullname, password, is_active):
+    params = {
+        "cmd": "update-profile",
+        "params": {
+            "email": email,
+            "fullname": fullname,
+            "password": password,
+            "is_active": is_active
+        }
+    }
+
+    res = run_cmd(params)
+    if res is True:
+        print(f"Updated")
+    else:
+        print(f"No profile found with email {email}")
+
+def derive_password(password):
+    params = {
+        "cmd": "derive-password",
+        "params": {
+            "password": password,
+        }
+    }
+
+    res = run_cmd(params)
+    print(f"Derived password: \"{res}\"")
+
+available_commands = [
+    "create-profile",
+    "update-profile",
+    "derive-password"
+]
+
+parser = argparse.ArgumentParser(
+    description=(
+        "Penpot Command Line Interface (CLI)"
+    )
+)
+
+parser.add_argument("-V", "--version", action="version", version="Penpot CLI %%develop%%")
+parser.add_argument("action", action="store", choices=available_commands)
+parser.add_argument("-n", "--fullname", help="Fullname", action="store")
+parser.add_argument("-e", "--email", help="Email", action="store")
+parser.add_argument("-p", "--password", help="Password", action="store")
+parser.add_argument("-c", "--connect", help="Connect to PREPL", action="store", default="tcp://localhost:6063")
+
+args = parser.parse_args()
+
+PREPL_URI = args.connect
+
+if args.action == "create-profile":
+    email = args.email
+    password = args.password
+    fullname = args.fullname
+
+    if email is None:
+        email = input("Email: ")
+
+    if fullname is None:
+        fullname = input("Fullname: ")
+
+    if password is None:
+        password = getpass("Password: ")
+
+    create_profile(fullname, email, password)
+
+elif args.action == "update-profile":
+    email = args.email
+    password = args.password
+
+    if email is None:
+        email = input("Email: ")
+
+    if password is None:
+        password = getpass("Password: ")
+
+    update_profile(email, None, password, None)
+
+elif args.action == "derive-password":
+    password = args.password
+
+    if password is None:
+        password = getpass("Password: ")
+
+    derive_password(password)

backend/scripts/manage.template.sh

@@ -1,19 +0,0 @@
-#!/usr/bin/env bash
-set +e
-JAVA_CMD=$(type -p java)
-
-set -e
-if [[ ! -n "$JAVA_CMD" ]]; then
-  if [[ -n "$JAVA_HOME" ]] && [[ -x "$JAVA_HOME/bin/java" ]]; then
-    JAVA_CMD="$JAVA_HOME/bin/java"
-  else
-    >&2 echo "Couldn't find 'java'. Please set JAVA_HOME."
-    exit 1
-  fi
-fi
-
-if [ -f ./environ ]; then
-   source ./environ
-fi
-
-exec $JAVA_CMD $JVM_OPTS -jar penpot.jar -m app.cli.manage "$@"

backend/scripts/repl

@@ -2,7 +2,21 @@
 
 export PENPOT_HOST=devenv
 export PENPOT_TENANT=dev
-export PENPOT_FLAGS="$PENPOT_FLAGS enable-backend-asserts enable-audit-log enable-transit-readable-response enable-demo-users disable-secure-session-cookies enable-smtp enable-webhooks"
+export PENPOT_FLAGS="\
+       $PENPOT_FLAGS \
+       enable-backend-asserts \
+       enable-audit-log \
+       enable-transit-readable-response \
+       enable-demo-users \
+       disable-secure-session-cookies \
+       enable-smtp \
+       enable-prepl-server \
+       enable-urepl-server \
+       enable-rpc-climit \
+       enable-rpc-rlimit \
+       enable-soft-rpc-rlimit \
+       enable-webhooks \
+       enable-access-tokens";
 
 # export PENPOT_DATABASE_URI="postgresql://172.17.0.1:5432/penpot"
 # export PENPOT_DATABASE_USERNAME="penpot"

backend/src/app/auth/ldap.clj

@@ -41,15 +41,18 @@
   (reduce-kv clojure.string/replace s replacements))
 
 (defn- search-user
-  [{:keys [conn attrs base-dn] :as cfg} email]
-  (let [query   (replace-several (:query cfg) ":username" email)
+  [{:keys [::conn base-dn] :as cfg} email]
+  (let [query  (replace-several (:query cfg) ":username" email)
+        attrs  [(:attrs-username cfg)
+                (:attrs-email cfg)
+                (:attrs-fullname cfg)]
         params  {:filter query
                  :sizelimit 1
                  :attributes attrs}]
     (first (ldap/search conn base-dn params))))
 
 (defn- retrieve-user
-  [{:keys [conn] :as cfg} {:keys [email password]}]
+  [{:keys [::conn] :as cfg} {:keys [email password]}]
   (when-let [{:keys [dn] :as user} (search-user cfg email)]
     (when (ldap/bind? conn dn password)
       {:fullname (get user (-> cfg :attrs-fullname keyword))
@@ -66,7 +69,7 @@
 (defn authenticate
   [cfg params]
   (with-open [conn (connect cfg)]
-    (when-let [user (-> (assoc cfg :conn conn)
+    (when-let [user (-> (assoc cfg ::conn conn)
                         (retrieve-user params))]
       (when-not (s/valid? ::info-data user)
         (let [explain (s/explain-str ::info-data user)]
@@ -100,17 +103,6 @@
                  :host (:host cfg) :port (:port cfg) :cause cause)
         nil))))
 
-(defn- prepare-attributes
-  [cfg]
-  (assoc cfg :attrs [(:attrs-username cfg)
-                     (:attrs-email cfg)
-                     (:attrs-fullname cfg)]))
-
-(defmethod ig/init-key ::provider
-  [_ cfg]
-  (when (:enabled? cfg)
-    (some-> cfg try-connectivity prepare-attributes)))
-
 (s/def ::enabled? ::us/boolean)
 (s/def ::host ::cf/ldap-host)
 (s/def ::port ::cf/ldap-port)
@@ -124,8 +116,7 @@
 (s/def ::attrs-fullname ::cf/ldap-attrs-fullname)
 (s/def ::attrs-username ::cf/ldap-attrs-username)
 
-(defmethod ig/pre-init-spec ::provider
-  [_]
+(s/def ::provider-params
   (s/keys :opt-un [::host ::port
                    ::ssl ::tls
                    ::enabled?
@@ -135,3 +126,14 @@
                    ::attrs-email
                    ::attrs-username
                    ::attrs-fullname]))
+(s/def ::provider
+  (s/nilable ::provider-params))
+
+(defmethod ig/pre-init-spec ::provider
+  [_]
+  (s/spec ::provider))
+
+(defmethod ig/init-key ::provider
+  [_ cfg]
+  (when (:enabled? cfg)
+    (try-connectivity cfg)))

backend/src/app/config.clj

@@ -61,11 +61,9 @@
 
    :public-uri "http://localhost:3449"
    :host "localhost"
-   :tenant "main"
+   :tenant "default"
 
    :redis-uri "redis://redis/0"
-   :srepl-host "127.0.0.1"
-   :srepl-port 6062
 
    :assets-storage-backend :assets-fs
    :storage-assets-fs-directory "assets"
@@ -102,13 +100,10 @@
 (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)
 
-(s/def ::setup-admin-email ::us/email)
-(s/def ::setup-admin-password ::us/not-empty-string)
-
 (s/def ::default-executor-parallelism ::us/integer)
 (s/def ::scheduled-executor-parallelism ::us/integer)
 
@@ -130,6 +125,16 @@
 (s/def ::database-min-pool-size ::us/integer)
 (s/def ::database-max-pool-size ::us/integer)
 
+(s/def ::quotes-teams-per-profile ::us/integer)
+(s/def ::quotes-projects-per-team ::us/integer)
+(s/def ::quotes-invitations-per-team ::us/integer)
+(s/def ::quotes-profiles-per-team ::us/integer)
+(s/def ::quotes-files-per-project ::us/integer)
+(s/def ::quotes-files-per-team ::us/integer)
+(s/def ::quotes-font-variants-per-team ::us/integer)
+(s/def ::quotes-comment-threads-per-file ::us/integer)
+(s/def ::quotes-comments-per-file ::us/integer)
+
 (s/def ::default-blob-version ::us/integer)
 (s/def ::error-report-webhook ::us/string)
 (s/def ::user-feedback-destination ::us/string)
@@ -189,18 +194,15 @@
 (s/def ::smtp-ssl ::us/boolean)
 (s/def ::smtp-tls ::us/boolean)
 (s/def ::smtp-username (s/nilable ::us/string))
-(s/def ::srepl-host ::us/string)
-(s/def ::srepl-port ::us/integer)
+(s/def ::urepl-host ::us/string)
+(s/def ::urepl-port ::us/integer)
+(s/def ::prepl-host ::us/string)
+(s/def ::prepl-port ::us/integer)
 (s/def ::assets-storage-backend ::us/keyword)
-(s/def ::fdata-storage-backend ::us/keyword)
 (s/def ::storage-assets-fs-directory ::us/string)
 (s/def ::storage-assets-s3-bucket ::us/string)
 (s/def ::storage-assets-s3-region ::us/keyword)
 (s/def ::storage-assets-s3-endpoint ::us/string)
-(s/def ::storage-fdata-s3-bucket ::us/string)
-(s/def ::storage-fdata-s3-region ::us/keyword)
-(s/def ::storage-fdata-s3-prefix ::us/string)
-(s/def ::storage-fdata-s3-endpoint ::us/string)
 (s/def ::telemetry-uri ::us/string)
 (s/def ::telemetry-with-taiga ::us/boolean)
 (s/def ::tenant ::us/string)
@@ -277,6 +279,17 @@
                    ::profile-complaint-max-age
                    ::profile-complaint-threshold
                    ::public-uri
+
+                   ::quotes-teams-per-profile
+                   ::quotes-projects-per-team
+                   ::quotes-invitations-per-team
+                   ::quotes-profiles-per-team
+                   ::quotes-files-per-project
+                   ::quotes-files-per-team
+                   ::quotes-font-variants-per-team
+                   ::quotes-comment-threads-per-file
+                   ::quotes-comments-per-file
+
                    ::redis-uri
                    ::registration-domain-whitelist
                    ::rpc-rlimit-config
@@ -295,22 +308,16 @@
                    ::smtp-tls
                    ::smtp-username
 
-                   ::srepl-host
-                   ::srepl-port
-
-                   ::setup-admin-email
-                   ::setup-admin-password
+                   ::urepl-host
+                   ::urepl-port
+                   ::prepl-host
+                   ::prepl-port
 
                    ::assets-storage-backend
                    ::storage-assets-fs-directory
                    ::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

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]

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

backend/src/app/http.clj

@@ -91,9 +91,7 @@
               (let [params  (:path-params match)
                     result  (:result match)
                     handler (or (:handler result) not-found-handler)
-                    request (-> request
-                                (assoc :path-params params)
-                                (update :params merge params))]
+                    request (assoc request :path-params params)]
                 (handler request respond raise))
               (not-found-handler request respond raise)))
 

backend/src/app/loggers/audit.clj

@@ -8,6 +8,7 @@
   "Services related to the user activity (audit log)."
   (:require
    [app.common.data :as d]
+   [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [app.common.spec :as us]
@@ -20,6 +21,7 @@
    [app.loggers.webhooks :as-alias webhooks]
    [app.main :as-alias main]
    [app.metrics :as mtx]
+   [app.rpc :as-alias rpc]
    [app.tokens :as tokens]
    [app.util.retry :as rtry]
    [app.util.time :as dt]
@@ -171,18 +173,20 @@
                (::webhooks/event? event))
       (let [batch-key     (::webhooks/batch-key event)
             batch-timeout (::webhooks/batch-timeout event)
-            label-suffix  (when (ifn? batch-key)
-                            (str/ffmt ":%" (batch-key (:props params))))
-            dedupe?       (boolean
-                           (and batch-key batch-timeout))]
+            label         (dm/str "rpc:" (:name params))
+            label         (cond
+                            (ifn? batch-key)    (dm/str label ":" (batch-key (::rpc/params event)))
+                            (string? batch-key) (dm/str label ":" batch-key)
+                            :else               label)
+            dedupe?       (boolean (and batch-key batch-timeout))]
+
         (wrk/submit! ::wrk/conn pool
                      ::wrk/task :process-webhook-event
                      ::wrk/queue :webhooks
                      ::wrk/max-retries 0
                      ::wrk/delay (or batch-timeout 0)
                      ::wrk/dedupe dedupe?
-                     ::wrk/label
-                     (str/ffmt "rpc:%1%2" (:name params) label-suffix)
+                     ::wrk/label label
 
                      ::webhooks/event
                      (-> params
@@ -319,7 +323,7 @@
     where archived_at is not null")
 
 (defn- clean-archived
-  [{:keys [pool]}]
+  [{:keys [::db/pool]}]
   (let [result (db/exec-one! pool [sql:clean-archived])
         result (:next.jdbc/update-count result)]
     (l/debug :hint "delete archived audit log entries" :deleted result)

backend/src/app/loggers/database.clj

@@ -11,12 +11,12 @@
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
-   [app.util.async :as aa]
-   [app.worker :as wrk]
+   [app.loggers.zmq :as lzmq]
    [clojure.core.async :as a]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
-   [integrant.core :as ig]))
+   [integrant.core :as ig]
+   [promesa.exec :as px]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Error Listener
@@ -27,7 +27,7 @@
 (defonce enabled (atom true))
 
 (defn- persist-on-database!
-  [{:keys [pool] :as cfg} {:keys [id] :as event}]
+  [{:keys [::db/pool] :as cfg} {:keys [id] :as event}]
   (when-not (db/read-only? pool)
     (db/insert! pool :server-error-report {:id id :content (db/tjson event)})))
 
@@ -53,41 +53,49 @@
       (assoc :version (:full cf/version))
       (update :id #(or % (uuid/next)))))
 
-(defn handle-event
-  [{:keys [executor] :as cfg} event]
-  (aa/with-thread executor
-    (try
-      (let [event (parse-event event)
-            uri   (cf/get :public-uri)]
+(defn- handle-event
+  [cfg event]
+  (try
+    (let [event (parse-event event)
+          uri   (cf/get :public-uri)]
 
-        (l/debug :hint "registering error on database" :id (:id event)
-                 :uri (str uri "/dbg/error/" (:id event)))
+      (l/debug :hint "registering error on database" :id (:id event)
+               :uri (str uri "/dbg/error/" (:id event)))
 
-        (persist-on-database! cfg event))
-      (catch Exception cause
-        (l/warn :hint "unexpected exception on database error logger" :cause cause)))))
+      (persist-on-database! cfg event))
+    (catch Throwable cause
+      (l/warn :hint "unexpected exception on database error logger" :cause cause))))
 
-(defmethod ig/pre-init-spec ::reporter [_]
-  (s/keys :req-un [::wrk/executor ::db/pool ::receiver]))
-
-(defn error-event?
+(defn- error-event?
   [event]
   (= "error" (:logger/level event)))
 
+(defmethod ig/pre-init-spec ::reporter [_]
+  (s/keys :req [::db/pool ::lzmq/receiver]))
+
 (defmethod ig/init-key ::reporter
-  [_ {:keys [receiver] :as cfg}]
-  (l/info :msg "initializing database error persistence")
-  (let [output (a/chan (a/sliding-buffer 5) (filter error-event?))]
-    (receiver :sub output)
-    (a/go-loop []
-      (let [msg (a/<! output)]
-        (if (nil? msg)
-          (l/info :msg "stopping error reporting loop")
-          (do
-            (a/<! (handle-event cfg msg))
-            (recur)))))
-    output))
+  [_ {:keys [::lzmq/receiver] :as cfg}]
+  (px/thread
+    {:name "penpot/database-reporter"}
+    (l/info :hint "initializing database error persistence")
+
+    (let [input (a/chan (a/sliding-buffer 5)
+                        (filter error-event?))]
+      (try
+        (lzmq/sub! receiver input)
+        (loop []
+          (when-let [msg (a/<!! input)]
+            (handle-event cfg msg))
+          (recur))
+
+        (catch InterruptedException _
+          (l/debug :hint "reporter interrupted"))
+        (catch Throwable cause
+          (l/error :hint "unexpected error" :cause cause))
+        (finally
+          (a/close! input)
+          (l/info :hint "reporter terminated"))))))
 
 (defmethod ig/halt-key! ::reporter
-  [_ output]
-  (a/close! output))
+  [_ thread]
+  (some-> thread px/interrupt!))

backend/src/app/loggers/mattermost.clj

@@ -38,13 +38,13 @@
 
 (defn handle-event
   [cfg event]
-  (try
-    (let [event (ldb/parse-event event)]
-      (when @enabled
-        (send-mattermost-notification! cfg event)))
-    (catch Throwable cause
-      (l/warn :hint "unhandled error"
-              :cause cause))))
+  (when @enabled
+    (try
+      (let [event (ldb/parse-event event)]
+        (send-mattermost-notification! cfg event))
+      (catch Throwable cause
+        (l/warn :hint "unhandled error"
+                :cause cause)))))
 
 (defmethod ig/pre-init-spec ::reporter [_]
   (s/keys :req [::http/client

backend/src/app/loggers/webhooks.clj

@@ -8,6 +8,7 @@
   "A mattermost integration for error reporting."
   (:require
    [app.common.data :as d]
+   [app.common.data.macros :as dm]
    [app.common.logging :as l]
    [app.common.transit :as t]
    [app.common.uri :as uri]
@@ -21,6 +22,15 @@
    [cuerdas.core :as str]
    [integrant.core :as ig]))
 
+;; --- HELPERS
+
+(defn key-fn
+  [k & keys]
+  (fn [params]
+    (reduce #(dm/str %1 ":" (get params %2))
+            (dm/str (get params k))
+            keys)))
+
 ;; --- PROC
 
 (defn- lookup-webhooks-by-team

backend/src/app/main.clj

@@ -6,6 +6,7 @@
 
 (ns app.main
   (:require
+   [app.auth.ldap :as-alias ldap]
    [app.auth.oidc :as-alias oidc]
    [app.auth.oidc.providers :as-alias oidc.providers]
    [app.common.logging :as l]
@@ -20,6 +21,7 @@
    [app.metrics :as-alias mtx]
    [app.metrics.definition :as-alias mdef]
    [app.redis :as-alias rds]
+   [app.srepl :as-alias srepl]
    [app.storage :as-alias sto]
    [app.util.time :as dt]
    [app.worker :as-alias wrk]
@@ -231,7 +233,7 @@
     :max-body-size           (cf/get :http-server-max-body-size)
     :max-multipart-body-size (cf/get :http-server-max-multipart-body-size)}
 
-   :app.auth.ldap/provider
+   ::ldap/provider
    {:host           (cf/get :ldap-host)
     :port           (cf/get :ldap-port)
     :ssl            (cf/get :ldap-ssl)
@@ -327,6 +329,7 @@
     ::db/pool            (ig/ref ::db/pool)
     ::wrk/executor       (ig/ref ::wrk/executor)
     ::props              (ig/ref :app.setup/props)
+    ::ldap/provider      (ig/ref ::ldap/provider)
     :pool                (ig/ref ::db/pool)
     :session             (ig/ref :app.http.session/manager)
     :sprops              (ig/ref :app.setup/props)
@@ -335,7 +338,6 @@
     :msgbus              (ig/ref :app.msgbus/msgbus)
     :public-uri          (cf/get :public-uri)
     :redis               (ig/ref ::rds/redis)
-    :ldap                (ig/ref :app.auth.ldap/provider)
     :http-client         (ig/ref ::http.client/client)
     :climit              (ig/ref :app.rpc/climit)
     :rlimit              (ig/ref :app.rpc/rlimit)
@@ -403,12 +405,13 @@
     ::http.client/client (ig/ref ::http.client/client)
     ::props              (ig/ref :app.setup/props)}
 
-   :app.srepl/server
-   {:port (cf/get :srepl-port)
-    :host (cf/get :srepl-host)}
+   [::srepl/urepl ::srepl/server]
+   {:port (cf/get :urepl-port 6062)
+    :host (cf/get :urepl-host "localhost")}
 
-   :app.setup/initial-profile
-   {::db/pool (ig/ref ::db/pool)}
+   [::srepl/prepl ::srepl/server]
+   {:port (cf/get :prepl-port 6063)
+    :host (cf/get :prepl-host "localhost")}
 
    :app.setup/builtin-templates
    {::http.client/client (ig/ref ::http.client/client)}
@@ -450,9 +453,8 @@
     ::http.client/client (ig/ref ::http.client/client)}
 
    :app.loggers.database/reporter
-   {:receiver (ig/ref :app.loggers.zmq/receiver)
-    :pool     (ig/ref ::db/pool)
-    :executor (ig/ref ::wrk/executor)}
+   {::lzmq/receiver (ig/ref :app.loggers.zmq/receiver)
+    ::db/pool       (ig/ref ::db/pool)}
 
    ::sto/storage
    {:pool     (ig/ref ::db/pool)

backend/src/app/migrations.clj

@@ -299,10 +299,10 @@
    {:name "0096-del-storage-pending-table"
     :fn (mg/resource "app/migrations/sql/0096-del-storage-pending-table.sql")}
 
-   {: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)

backend/src/app/migrations/sql/0097-mod-profile-table.sql

@@ -1,2 +0,0 @@
-ALTER TABLE profile
-  ADD COLUMN is_admin boolean DEFAULT false;

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));

backend/src/app/rpc.clj

@@ -6,6 +6,7 @@
 
 (ns app.rpc
   (:require
+   [app.auth.ldap :as-alias ldap]
    [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
@@ -26,7 +27,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]
@@ -70,14 +71,16 @@
 (defn- rpc-query-handler
   "Ring handler that dispatches query requests and convert between
   internal async flow into ring async flow."
-  [methods {:keys [profile-id session-id params] :as request} respond raise]
-  (let [type   (keyword (:type params))
-        data   (into {::http/request request} params)
+  [methods {:keys [profile-id session-id path-params params] :as request} respond raise]
+  (let [type   (keyword (:type path-params))
+        data   (-> params
+                   (assoc ::request-at (dt/now))
+                   (assoc ::http/request request))
         data   (if profile-id
-                 (assoc data
-                        :profile-id profile-id
-                        ::profile-id profile-id
-                        ::session-id session-id)
+                 (-> data
+                     (assoc :profile-id profile-id)
+                     (assoc ::profile-id profile-id)
+                     (assoc ::session-id session-id))
                  (dissoc data :profile-id ::profile-id))
         method (get methods type default-handler)]
 
@@ -91,16 +94,17 @@
 (defn- rpc-mutation-handler
   "Ring handler that dispatches mutation requests and convert between
   internal async flow into ring async flow."
-  [methods {:keys [profile-id session-id params] :as request} respond raise]
-  (let [type   (keyword (:type params))
-        data   (into {::http/request request} params)
+  [methods {:keys [profile-id session-id path-params params] :as request} respond raise]
+  (let [type   (keyword (:type path-params))
+        data   (-> params
+                   (assoc ::request-at (dt/now))
+                   (assoc ::http/request request))
         data   (if profile-id
-                 (assoc data
-                        :profile-id profile-id
-                        ::profile-id profile-id
-                        ::session-id session-id)
+                 (-> data
+                     (assoc :profile-id profile-id)
+                     (assoc ::profile-id profile-id)
+                     (assoc ::session-id session-id))
                  (dissoc data :profile-id ::profile-id))
-
         method (get methods type default-handler)]
     (-> (method data)
         (p/then (partial handle-response request))
@@ -112,13 +116,18 @@
 (defn- rpc-command-handler
   "Ring handler that dispatches cmd requests and convert between
   internal async flow into ring async flow."
-  [methods {:keys [profile-id session-id params] :as request} respond raise]
-  (let [cmd    (keyword (:type params))
+  [methods {:keys [profile-id session-id path-params params] :as request} respond raise]
+  (let [cmd    (keyword (:type path-params))
         etag   (yrq/get-header request "if-none-match")
-        data   (into {::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))
+
+        data   (-> params
+                   (assoc ::request-at (dt/now))
+                   (assoc ::http/request request)
+                   (assoc ::cond/key etag)
+                   (cond-> (uuid? profile-id)
+                     (-> (assoc ::profile-id profile-id)
+                         (assoc ::session-id session-id))))
+
         method (get methods cmd default-handler)]
     (binding [cond/*enabled* true]
       (-> (method data)
@@ -133,7 +142,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 [_ _]
@@ -182,6 +191,12 @@
                                 :profile-id profile-id
                                 :ip-addr (some-> request audit/parse-client-ip)
                                 :props props
+
+                                ;; NOTE: for batch-key lookup we need the params as-is
+                                ;; because the rpc api does not need to know the
+                                ;; audit/webhook specific object layout.
+                                ::params (dissoc params ::http/request)
+
                                 ::webhooks/batch-key
                                 (or (::webhooks/batch-key mdata)
                                     (::webhooks/batch-key resultm))
@@ -275,10 +290,10 @@
   (let [cfg (assoc cfg ::type "command" ::metrics-id :rpc-command-timing)]
     (->> (sv/scan-ns 'app.rpc.commands.binfile
                      'app.rpc.commands.comments
-                     'app.rpc.commands.profile
                      'app.rpc.commands.management
                      'app.rpc.commands.verify-token
                      'app.rpc.commands.search
+                     'app.rpc.commands.media
                      'app.rpc.commands.teams
                      'app.rpc.commands.auth
                      'app.rpc.commands.ldap
@@ -304,6 +319,7 @@
   (s/keys :req [::audit/collector
                 ::http.client/client
                 ::db/pool
+                ::ldap/provider
                 ::wrk/executor]
           :req-un [::sto/storage
                    ::http.session/session
@@ -314,8 +330,7 @@
                    ::climit
                    ::wrk/executor
                    ::mtx/metrics
-                   ::db/pool
-                   ::ldap]))
+                   ::db/pool]))
 
 (defmethod ig/init-key ::methods
   [_ cfg]

backend/src/app/rpc/commands/audit.clj

@@ -72,7 +72,7 @@
 
 (sv/defmethod ::push-audit-events
   {::climit/queue :push-audit-events
-   ::climit/key-fn :profile-id
+   ::climit/key-fn ::rpc/profile-id
    ::audit/skip true
    ::doc/added "1.17"}
   [{:keys [::db/pool ::wrk/executor] :as cfg} params]

backend/src/app/rpc/commands/auth.clj

@@ -69,7 +69,7 @@
 ;; ---- COMMAND: login with password
 
 (defn login-with-password
-  [{:keys [::db/pool session] :as cfg} {:keys [email password scope] :as params}]
+  [{:keys [::db/pool session] :as cfg} {:keys [email password] :as params}]
 
   (when-not (or (contains? cf/flags :login)
                 (contains? cf/flags :login-with-password))
@@ -119,17 +119,8 @@
             ;; accept invitation with other email
             response   (if (and (some? invitation) (= (:id profile) (:member-id invitation)))
                          {:invitation-token (:invitation-token params)}
-                         (update profile :is-admin (fn [admin?]
-                                                     (or admin?
-                                                         (let [admins (cf/get :admins)]
-                                                           (contains? admins (:email profile)))))))]
-
-        (when (and (nil? (:default-team-id profile))
-                   (not= scope "admin"))
-          (ex/raise :type :restriction
-                    :code :admin-only-profile
-                    :hint "can't login with admin-only profile"))
-
+                         (assoc profile :is-admin (let [admins (cf/get :admins)]
+                                                    (contains? admins (:email profile)))))]
         (-> response
             (rph/with-transform (session/create-fn session (:id profile)))
             (rph/with-meta {::audit/props (audit/profile->props profile)
@@ -322,6 +313,7 @@
             (throw e)
             (ex/raise :type :validation
                       :code :email-already-exists
+                      :hint "email already exists"
                       :cause e)))))))
 
 (defn create-profile-relations

backend/src/app/rpc/commands/binfile.clj

@@ -9,6 +9,7 @@
   (:require
    [app.common.data :as d]
    [app.common.exceptions :as ex]
+   [app.common.files.features :as ffeat]
    [app.common.logging :as l]
    [app.common.pages.migrations :as pmg]
    [app.common.spec :as us]
@@ -28,6 +29,7 @@
    [app.tasks.file-gc]
    [app.util.blob :as blob]
    [app.util.fressian :as fres]
+   [app.util.objects-map :as omap]
    [app.util.pointer-map :as pmap]
    [app.util.services :as sv]
    [app.util.time :as dt]
@@ -609,12 +611,23 @@
     (vswap! *state* update :index update-index files)
     (vswap! *state* assoc :version version :files files)))
 
+(defn- postprocess-file
+  [data]
+  (let [omap-wrap ffeat/*wrap-with-objects-map-fn*
+        pmap-wrap ffeat/*wrap-with-pointer-map-fn*]
+    (-> data
+        (update :pages-index update-vals #(update % :objects omap-wrap))
+        (update :pages-index update-vals pmap-wrap)
+        (update :components update-vals #(update % :objects omap-wrap))
+        (update :components pmap-wrap))))
+
 (defmethod read-section :v1/files
   [{:keys [conn ::input ::migrate? ::project-id ::timestamp ::overwrite?]}]
   (doseq [expected-file-id (-> *state* deref :files)]
-    (let [file    (read-obj! input)
-          media'  (read-obj! input)
-          file-id (:id file)]
+    (let [file     (read-obj! input)
+          media'   (read-obj! input)
+          file-id  (:id file)
+          features files/default-features]
 
       (when (not= file-id expected-file-id)
         (ex/raise :type :validation
@@ -629,33 +642,42 @@
       (l/debug :hint "update media references" ::l/async false)
       (vswap! *state* update :media into (map #(update % :id lookup-index)) media')
 
-      (l/debug :hint "processing file" :file-id file-id ::l/async false)
+      (l/debug :hint "processing file" :file-id file-id ::features features ::l/async false)
 
-      (let [file-id' (lookup-index file-id)
-            data     (-> (:data file)
-                         (assoc :id file-id')
-                         (cond-> migrate? (pmg/migrate-data))
-                         (update :pages-index relink-shapes)
-                         (update :components relink-shapes)
-                         (update :media relink-media))
+      (binding [ffeat/*current* features
+                ffeat/*wrap-with-objects-map-fn* (if (features "storage/objects-map") omap/wrap identity)
+                ffeat/*wrap-with-pointer-map-fn* (if (features "storage/pointer-map") pmap/wrap identity)
+                pmap/*tracked* (atom {})]
 
-            params  {:id file-id'
-                     :project-id project-id
-                     :name (:name file)
-                     :revn (:revn file)
-                     :is-shared (:is-shared file)
-                     :data (blob/encode data)
-                     :created-at timestamp
-                     :modified-at timestamp}]
+        (let [file-id' (lookup-index file-id)
+              data     (-> (:data file)
+                           (assoc :id file-id')
+                           (cond-> migrate? (pmg/migrate-data))
+                           (update :pages-index relink-shapes)
+                           (update :components relink-shapes)
+                           (update :media relink-media)
+                           (postprocess-file))
 
-        (l/debug :hint "create file" :id file-id' ::l/async false)
+              params  {:id file-id'
+                       :project-id project-id
+                       :features (db/create-array conn "text" features)
+                       :name (:name file)
+                       :revn (:revn file)
+                       :is-shared (:is-shared file)
+                       :data (blob/encode data)
+                       :created-at timestamp
+                       :modified-at timestamp}]
 
-        (if overwrite?
-          (create-or-update-file conn params)
-          (db/insert! conn :file params))
+          (l/debug :hint "create file" :id file-id' ::l/async false)
 
-        (when overwrite?
-          (db/delete! conn :file-thumbnail {:file-id file-id'}))))))
+          (if overwrite?
+            (create-or-update-file conn params)
+            (db/insert! conn :file params))
+
+          (files/persist-pointers! conn file-id')
+
+          (when overwrite?
+            (db/delete! conn :file-thumbnail {:file-id file-id'})))))))
 
 (defmethod read-section :v1/rels
   [{:keys [conn ::input ::timestamp]}]

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,77 @@
 (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 +374,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 +391,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 +401,7 @@
 
 ;; --- COMMAND: Add Comment
 
+(declare get-comment-thread)
 (declare create-comment)
 
 (s/def ::create-comment
@@ -384,66 +412,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 +465,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 +540,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 +560,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)))

backend/src/app/rpc/commands/files.clj

@@ -15,6 +15,7 @@
    [app.common.spec :as us]
    [app.common.types.file :as ctf]
    [app.common.types.shape-tree :as ctt]
+   [app.config :as cf]
    [app.db :as db]
    [app.db.sql :as sql]
    [app.loggers.audit :as-alias audit]
@@ -43,7 +44,13 @@
     "storage/pointer-map"
     "components/v2"})
 
-(def default-features #{})
+(def default-features
+  (cond-> #{}
+    (contains? cf/flags :fdata-storage-pointer-map)
+    (conj "storage/pointer-map")
+
+    (contains? cf/flags :fdata-storage-objects-map)
+    (conj "storage/objects-map")))
 
 ;; --- SPECS
 
@@ -151,11 +158,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
@@ -241,7 +251,6 @@
   [conn id client-features]
   ;; here we check if client requested features are supported
   (check-features-compatibility! client-features)
-
   (binding [pmap/*load-fn* (partial load-pointer conn id)]
     (-> (db/get-by-id conn :file id)
         (decode-row)
@@ -266,7 +275,7 @@
   {::doc/added "1.17"
    ::cond/get-object #(get-minimal-file %1 (:id %2))
    ::cond/key-fn get-file-etag}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id features] :as params}]
+  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id features]}]
   (with-open [conn (db/open pool)]
     (let [perms (get-permissions conn profile-id id)]
       (check-read-permissions! perms)
@@ -294,7 +303,7 @@
   "Retrieve a file by its ID. Only authenticated users."
   {::doc/added "1.17"
    ::rpc/:auth false}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id fragment-id share-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id fragment-id share-id] }]
   (with-open [conn (db/open pool)]
     (let [perms (get-permissions conn profile-id file-id share-id)]
       (check-read-permissions! perms)
@@ -361,7 +370,7 @@
 (sv/defmethod ::get-project-files
   "Get all files for the specified project."
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id project-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id project-id]}]
   (with-open [conn (db/open pool)]
     (projects/check-read-permissions! conn profile-id project-id)
     (get-project-files conn project-id)))
@@ -374,15 +383,16 @@
 (s/def ::file-id ::us/uuid)
 
 (s/def ::has-file-libraries
-  (s/keys :req [::rpc/profile-id] :req-un [::file-id]))
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::file-id]))
 
 (sv/defmethod ::has-file-libraries
   "Checks if the file has libraries. Returns a boolean"
   {::doc/added "1.15.1"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id]}]
   (with-open [conn (db/open pool)]
     (check-read-permissions! pool profile-id file-id)
-    (get-has-file-libraries conn params)))
+    (get-has-file-libraries conn file-id)))
 
 (def ^:private sql:has-file-libraries
   "SELECT COUNT(*) > 0 AS has_libraries
@@ -393,7 +403,7 @@
            fl.deleted_at > now())")
 
 (defn- get-has-file-libraries
-  [conn {:keys [file-id]}]
+  [conn file-id]
   (let [row (db/exec-one! conn [sql:has-file-libraries file-id])]
     (:has-libraries row)))
 
@@ -472,37 +482,37 @@
     order by f.modified_at desc")
 
 (defn get-team-shared-files
-  [conn {:keys [team-id] :as params}]
-  (let [assets-sample
-        (fn [assets limit]
-          (let [sorted-assets (->> (vals assets)
-                                   (sort-by #(str/lower (:name %))))]
+  [conn team-id]
+  (letfn [(assets-sample [assets limit]
+            (let [sorted-assets (->> (vals assets)
+                                     (sort-by #(str/lower (:name %))))]
+              {:count (count sorted-assets)
+               :sample (into [] (take limit sorted-assets))}))
 
-            {:count (count sorted-assets)
-             :sample (into [] (take limit sorted-assets))}))
+          (library-summary [{:keys [id data] :as file}]
+            (binding [pmap/*load-fn* (partial load-pointer conn id)]
+              {:components (assets-sample (:components data) 4)
+               :media (assets-sample (:media data) 3)
+               :colors (assets-sample (:colors data) 3)
+               :typographies (assets-sample (:typographies data) 3)}))]
 
-        library-summary
-        (fn [data]
-          {:components (assets-sample (:components data) 4)
-           :colors (assets-sample (:colors data) 3)
-           :typographies (assets-sample (:typographies data) 3)})
-
-        xform (comp
-               (map decode-row)
-               (map #(assoc % :library-summary (library-summary (:data %))))
-               (map #(dissoc % :data)))]
-
-    (into #{} xform (db/exec! conn [sql:team-shared-files team-id]))))
+    (->> (db/exec! conn [sql:team-shared-files team-id])
+         (into #{} (comp
+                    (map decode-row)
+                    (map #(assoc % :library-summary (library-summary %)))
+                    (map #(dissoc % :data)))))))
 
 (s/def ::get-team-shared-files
-  (s/keys :req [::rpc/profile-id] :req-un [::team-id]))
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::team-id]))
 
 (sv/defmethod ::get-team-shared-files
   "Get all file (libraries) for the specified team."
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} params]
+  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
   (with-open [conn (db/open pool)]
-    (get-team-shared-files conn params)))
+    (teams/check-read-permissions! conn profile-id team-id)
+    (get-team-shared-files conn team-id)))
 
 
 ;; --- COMMAND QUERY: get-file-libraries
@@ -536,12 +546,14 @@
   [conn file-id client-features]
   (check-features-compatibility! client-features)
   (->> (db/exec! conn [sql:file-libraries file-id])
-       (mapv (fn [{:keys [id] :as row}]
-               (binding [pmap/*load-fn* (partial load-pointer conn id)]
-                 (-> (decode-row row)
-                     (assoc :is-indirect false)
-                     (update :data dissoc :pages-index)
-                     (handle-file-features client-features)))))))
+       (map decode-row)
+       (map #(assoc % :is-indirect false))
+       (map (fn [{:keys [id] :as row}]
+              (binding [pmap/*load-fn* (partial load-pointer conn id)]
+                (-> row
+                    (update :data dissoc :pages-index)
+                    (handle-file-features client-features)))))
+       (vec)))
 
 (s/def ::get-file-libraries
   (s/keys :req [::rpc/profile-id]
@@ -551,7 +563,7 @@
 (sv/defmethod ::get-file-libraries
   "Get libraries used by the specified file."
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id features] :as params}]
+  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id features]}]
   (with-open [conn (db/open pool)]
     (check-read-permissions! conn profile-id file-id)
     (get-file-libraries conn file-id features)))
@@ -582,7 +594,6 @@
     (check-read-permissions! conn profile-id file-id)
     (get-library-file-references conn file-id)))
 
-
 ;; --- COMMAND QUERY: get-team-recent-files
 
 (def sql:team-recent-files
@@ -711,28 +722,30 @@
 
                 objects)))]
 
-    (let [frame     (get-thumbnail-frame data)
-          frame-id  (:id frame)
-          page-id   (or (:page-id frame)
-                        (-> data :pages first))
+    (binding [pmap/*load-fn* (partial load-pointer conn id)]
+      (let [frame     (get-thumbnail-frame data)
+            frame-id  (:id frame)
+            page-id   (or (:page-id frame)
+                          (-> data :pages first))
 
-          page      (dm/get-in data [:pages-index page-id])
-          frame-ids (if (some? frame) (list frame-id) (map :id (ctt/get-frames (:objects page))))
+            page      (dm/get-in data [:pages-index page-id])
+            page      (cond-> page (pmap/pointer-map? page) deref)
+            frame-ids (if (some? frame) (list frame-id) (map :id (ctt/get-frames (:objects page))))
 
-          obj-ids   (map #(str page-id %) frame-ids)
-          thumbs    (get-object-thumbnails conn id obj-ids)]
+            obj-ids   (map #(str page-id %) frame-ids)
+            thumbs    (get-object-thumbnails conn id obj-ids)]
 
-      (cond-> page
-        ;; If we have frame, we need to specify it on the page level
-        ;; and remove the all other unrelated objects.
-        (some? frame-id)
-        (-> (assoc :thumbnail-frame-id frame-id)
-            (update :objects filter-objects frame-id))
+        (cond-> page
+          ;; If we have frame, we need to specify it on the page level
+          ;; and remove the all other unrelated objects.
+          (some? frame-id)
+          (-> (assoc :thumbnail-frame-id frame-id)
+              (update :objects filter-objects frame-id))
 
-        ;; Assoc the available thumbnails and prune not visible shapes
-        ;; for avoid transfer unnecessary data.
-        :always
-        (update :objects assoc-thumbnails page-id thumbs)))))
+          ;; Assoc the available thumbnails and prune not visible shapes
+          ;; for avoid transfer unnecessary data.
+          :always
+          (update :objects assoc-thumbnails page-id thumbs))))))
 
 (s/def ::get-file-data-for-thumbnail
   (s/keys :req [::rpc/profile-id]
@@ -746,12 +759,15 @@
   [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id features] :as props}]
   (with-open [conn (db/open pool)]
     (check-read-permissions! conn profile-id file-id)
-    (let [file (get-file conn file-id features)]
+    ;; NOTE: we force here the "storage/pointer-map" feature, because
+    ;; it used internally only and is independent if user supports it
+    ;; or not.
+    (let [feat (into #{"storage/pointer-map"} features)
+          file (get-file conn file-id feat)]
       {:file-id file-id
        :revn (:revn file)
        :page (get-file-data-for-thumbnail conn file)})))
 
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; MUTATION COMMANDS
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -759,7 +775,7 @@
 ;; --- MUTATION COMMAND: rename-file
 
 (defn rename-file
-  [conn {:keys [id name] :as params}]
+  [conn {:keys [id name]}]
   (db/update! conn :file
               {:name name
                :modified-at (dt/now)}
@@ -893,7 +909,7 @@
 ;; --- MUTATION COMMAND: unlink-file-from-library
 
 (defn unlink-file-from-library
-  [conn {:keys [file-id library-id] :as params}]
+  [conn {:keys [file-id library-id]}]
   (db/delete! conn :file-library-rel
               {:file-id file-id
                :library-file-id library-id}))
@@ -954,7 +970,8 @@
   [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id file-id)
-    (ignore-sync conn params)))
+    (->  (ignore-sync conn params)
+         (update :features db/decode-pgarray #{}))))
 
 
 ;; --- MUTATION COMMAND: upsert-file-object-thumbnail

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})))))
-

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
 

backend/src/app/rpc/commands/files/update.clj

@@ -17,7 +17,7 @@
    [app.config :as cf]
    [app.db :as db]
    [app.loggers.audit :as audit]
-   [app.loggers.webhooks :as-alias webhooks]
+   [app.loggers.webhooks :as webhooks]
    [app.metrics :as mtx]
    [app.msgbus :as mbus]
    [app.rpc :as-alias rpc]
@@ -130,7 +130,7 @@
    ::climit/key-fn :id
    ::webhooks/event? true
    ::webhooks/batch-timeout (dt/duration "2m")
-   ::webhooks/batch-key :id
+   ::webhooks/batch-key (webhooks/key-fn ::rpc/profile-id :id)
    ::doc/added "1.17"}
   [{:keys [pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
   (db/with-atomic [conn pool]
@@ -168,7 +168,18 @@
                         (->> changes-with-metadata (mapcat :changes) vec)
                         (vec changes))
 
-            params    (assoc params :file file :changes changes)]
+            params    (-> params
+                          (assoc :file file)
+                          (assoc :changes changes)
+                          (assoc ::created-at (dt/now)))]
+
+        (when (> (:revn params)
+                 (:revn file))
+          (ex/raise :type :validation
+                    :code :revn-conflict
+                    :hint "The incoming revision number is greater that stored version."
+                    :context {:incoming-revn (:revn params)
+                              :stored-revn (:revn file)}))
 
         (mtx/run! metrics {:id :update-file-changes :inc (count changes)})
 
@@ -180,24 +191,15 @@
 
         (-> (update-fn cfg params)
             (vary-meta assoc ::audit/replace-props
-                       {:id (:id file)
-                        :name (:name file)
-                        :features (:features file)
+                       {:id         (:id file)
+                        :name       (:name file)
+                        :features   (:features file)
                         :project-id (:project-id file)
                         :team-id    (:team-id file)}))))))
 
 (defn- update-file*
-  [{:keys [conn] :as cfg} {:keys [profile-id file changes session-id] :as params}]
-  (when (> (:revn params)
-           (:revn file))
-    (ex/raise :type :validation
-              :code :revn-conflict
-              :hint "The incoming revision number is greater that stored version."
-              :context {:incoming-revn (:revn params)
-                        :stored-revn (:revn file)}))
-
-  (let [ts   (dt/now)
-        file (-> file
+  [{:keys [conn] :as cfg} {:keys [profile-id file changes session-id ::created-at] :as params}]
+  (let [file (-> file
                  (update :revn inc)
                  (update :data (fn [data]
                                  (cond-> data
@@ -217,7 +219,7 @@
                 {:id (uuid/next)
                  :session-id session-id
                  :profile-id profile-id
-                 :created-at ts
+                 :created-at created-at
                  :file-id (:id file)
                  :revn (:revn file)
                  :features (db/create-array conn "text" (:features file))
@@ -229,12 +231,12 @@
                 {:revn (:revn file)
                  :data (:data file)
                  :data-backend nil
-                 :modified-at ts
+                 :modified-at created-at
                  :has-media-trimmed false}
                 {:id (:id file)})
 
     (db/update! conn :project
-                {:modified-at ts}
+                {:modified-at created-at}
                 {:id (:project-id file)})
 
     (let [params (assoc params :file file)]
@@ -265,13 +267,10 @@
     order by s.created_at asc")
 
 (defn- get-lagged-changes
-  [conn params]
-  (->> (db/exec! conn [sql:lagged-changes (:id params) (:revn params)])
-       (into [] (comp (map files/decode-row)
-                      (map (fn [row]
-                             (cond-> row
-                               (= (:revn row) (:revn (:file params)))
-                               (assoc :changes []))))))))
+  [conn {:keys [id revn] :as params}]
+  (->> (db/exec! conn [sql:lagged-changes id revn])
+       (map files/decode-row)
+       (vec)))
 
 (defn- send-notifications!
   [{:keys [conn] :as cfg} {:keys [file changes session-id] :as params}]

backend/src/app/rpc/commands/ldap.clj

@@ -12,10 +12,13 @@
    [app.db :as db]
    [app.http.session :as session]
    [app.loggers.audit :as-alias audit]
+   [app.main :as-alias main]
+   [app.rpc :as-alias rpc]
    [app.rpc.commands.auth :as cmd.auth]
    [app.rpc.doc :as-alias doc]
    [app.rpc.helpers :as rph]
    [app.rpc.queries.profile :as profile]
+   [app.tokens :as tokens]
    [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
 
@@ -34,15 +37,15 @@
 (sv/defmethod ::login-with-ldap
   "Performs the authentication using LDAP backend. Only works if LDAP
   is properly configured and enabled with `login-with-ldap` flag."
-  {:auth false
+  {::rpc/auth false
    ::doc/added "1.15"}
-  [{:keys [session tokens ldap] :as cfg} params]
-  (when-not ldap
+  [{:keys [::main/props ::ldap/provider session] :as cfg} params]
+  (when-not provider
     (ex/raise :type :restriction
               :code :ldap-not-initialized
               :hide "ldap auth provider is not initialized"))
 
-  (let [info (ldap/authenticate ldap params)]
+  (let [info (ldap/authenticate provider params)]
     (when-not info
       (ex/raise :type :validation
                 :code :wrong-credentials))
@@ -58,12 +61,11 @@
         ;; user comes from team-invitation process; in this case,
         ;; regenerate token and send back to the user a new invitation
         ;; token (and mark current session as logged).
-        (let [claims (tokens :verify {:token token :iss :team-invitation})
+        (let [claims (tokens/verify props {:token token :iss :team-invitation})
               claims (assoc claims
                             :member-id  (:id profile)
                             :member-email (:email profile))
-              token  (tokens :generate claims)]
-
+              token  (tokens/generate props claims)]
           (-> {:invitation-token token}
               (rph/with-transform (session/create-fn session (:id profile)))
               (rph/with-meta {::audit/props (:props profile)

backend/src/app/rpc/commands/management.clj

@@ -46,9 +46,9 @@
   "Duplicate a single file in the same team."
   {::doc/added "1.16"
    ::webhooks/event? true}
-  [{:keys [pool] :as cfg} params]
+  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
   (db/with-atomic [conn pool]
-    (duplicate-file conn (assoc params :profile-id (::rpc/profile-id params)))))
+    (duplicate-file conn (assoc params :profile-id profile-id))))
 
 (defn- remap-id
   [item index key]
@@ -136,7 +136,7 @@
       and so.deleted_at is null")
 
 (defn duplicate-file*
-  [conn {:keys [profile-id file index project-id name flibs fmeds]} {:keys [reset-shared-flag] :as opts}]
+  [conn {:keys [profile-id file index project-id name flibs fmeds]} {:keys [reset-shared-flag]}]
   (let [flibs    (or flibs (db/exec! conn [sql:retrieve-used-libraries (:id file)]))
         fmeds    (or fmeds (db/exec! conn [sql:retrieve-used-media-objects (:id file)]))
 
@@ -329,10 +329,9 @@
   "Move a set of files from one project to other."
   {::doc/added "1.16"
    ::webhooks/event? true}
-  [{:keys [pool] :as cfg} params]
+  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
   (db/with-atomic [conn pool]
-    (move-files conn (assoc params :profile-id (::rpc/profile-id params)))))
-
+    (move-files conn (assoc params :profile-id profile-id))))
 
 ;; --- COMMAND: Move project
 
@@ -370,9 +369,9 @@
   "Move projects between teams."
   {::doc/added "1.16"
    ::webhooks/event? true}
-  [{:keys [pool] :as cfg} params]
+  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
   (db/with-atomic [conn pool]
-    (move-project conn (assoc params :profile-id (::rpc/profile-id params)))))
+    (move-project conn (assoc params :profile-id profile-id))))
 
 ;; --- COMMAND: Clone Template
 
@@ -387,10 +386,10 @@
   "Clone into the specified project the template by its id."
   {::doc/added "1.16"
    ::webhooks/event? true}
-  [{:keys [pool] :as cfg} params]
+  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
   (db/with-atomic [conn pool]
     (-> (assoc cfg :conn conn)
-        (clone-template (assoc params :profile-id (::rpc/profile-id params))))))
+        (clone-template (assoc params :profile-id profile-id)))))
 
 (defn- clone-template
   [{:keys [conn templates] :as cfg} {:keys [profile-id template-id project-id]}]

backend/src/app/rpc/commands/media.clj

@@ -0,0 +1,274 @@
+;; 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.commands.media
+  (:require
+   [app.common.data :as d]
+   [app.common.exceptions :as ex]
+   [app.common.media :as cm]
+   [app.common.spec :as us]
+   [app.common.uuid :as uuid]
+   [app.config :as cf]
+   [app.db :as db]
+   [app.http.client :as http]
+   [app.media :as media]
+   [app.rpc :as-alias rpc]
+   [app.rpc.climit :as climit]
+   [app.rpc.commands.files :as files]
+   [app.rpc.doc :as-alias doc]
+   [app.storage :as sto]
+   [app.storage.tmp :as tmp]
+   [app.util.services :as sv]
+   [app.util.time :as dt]
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [datoteka.io :as io]
+   [promesa.core :as p]
+   [promesa.exec :as px]))
+
+(def default-max-file-size
+  (* 1024 1024 10)) ; 10 MiB
+
+(def thumbnail-options
+  {:width 100
+   :height 100
+   :quality 85
+   :format :jpeg})
+
+(s/def ::id ::us/uuid)
+(s/def ::name ::us/string)
+(s/def ::file-id ::us/uuid)
+(s/def ::team-id ::us/uuid)
+
+(defn validate-content-size!
+  [content]
+  (when (> (:size content) (cf/get :media-max-file-size default-max-file-size))
+    (ex/raise :type :restriction
+              :code :media-max-file-size-reached
+              :hint (str/ffmt "the uploaded file size % is greater than the maximum %"
+                              (:size content)
+                              default-max-file-size))))
+
+;; --- Create File Media object (upload)
+
+(declare create-file-media-object)
+
+(s/def ::content ::media/upload)
+(s/def ::is-local ::us/boolean)
+
+(s/def ::upload-file-media-object
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::file-id ::is-local ::name ::content]
+          :opt-un [::id]))
+
+(sv/defmethod ::upload-file-media-object
+  {::doc/added "1.17"}
+  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id content] :as params}]
+  (let [cfg (update cfg :storage media/configure-assets-storage)]
+    (files/check-edition-permissions! pool profile-id file-id)
+    (media/validate-media-type! content)
+    (validate-content-size! content)
+
+    (create-file-media-object cfg params)))
+
+(defn- big-enough-for-thumbnail?
+  "Checks if the provided image info is big enough for
+  create a separate thumbnail storage object."
+  [info]
+  (or (> (:width info) (:width thumbnail-options))
+      (> (:height info) (:height thumbnail-options))))
+
+(defn- svg-image?
+  [info]
+  (= (:mtype info) "image/svg+xml"))
+
+;; NOTE: we use the `on conflict do update` instead of `do nothing`
+;; because postgresql does not returns anything if no update is
+;; performed, the `do update` does the trick.
+
+(def sql:create-file-media-object
+  "insert into file_media_object (id, file_id, is_local, name, media_id, thumbnail_id, width, height, mtype)
+   values (?, ?, ?, ?, ?, ?, ?, ?, ?)
+       on conflict (id) do update set created_at=file_media_object.created_at
+       returning *")
+
+;; NOTE: the following function executes without a transaction, this
+;; means that if something fails in the middle of this function, it
+;; will probably leave leaked/unreferenced objects in the database and
+;; probably in the storage layer. For handle possible object leakage,
+;; we create all media objects marked as touched, this ensures that if
+;; something fails, all leaked (already created storage objects) will
+;; be eventually marked as deleted by the touched-gc task.
+;;
+;; The touched-gc task, performs periodic analysis of all touched
+;; storage objects and check references of it. This is the reason why
+;; `reference` metadata exists: it indicates the name of the table
+;; witch holds the reference to storage object (it some kind of
+;; inverse, soft referential integrity).
+
+(defn create-file-media-object
+  [{:keys [storage pool climit executor]}
+   {:keys [id file-id is-local name content]}]
+  (letfn [;; Function responsible to retrieve the file information, as
+          ;; it is synchronous operation it should be wrapped into
+          ;; with-dispatch macro.
+          (get-info [content]
+            (climit/with-dispatch (:process-image climit)
+              (media/run {:cmd :info :input content})))
+
+          ;; Function responsible of calculating cryptographyc hash of
+          ;; the provided data.
+          (calculate-hash [data]
+            (px/with-dispatch executor
+              (sto/calculate-hash data)))
+
+          ;; Function responsible of generating thumnail. As it is synchronous
+          ;; opetation, it should be wrapped into with-dispatch macro
+          (generate-thumbnail [info]
+            (climit/with-dispatch (:process-image climit)
+              (media/run (assoc thumbnail-options
+                                :cmd :generic-thumbnail
+                                :input info))))
+
+          (create-thumbnail [info]
+            (when (and (not (svg-image? info))
+                       (big-enough-for-thumbnail? info))
+              (p/let [thumb   (generate-thumbnail info)
+                      hash    (calculate-hash (:data thumb))
+                      content (-> (sto/content (:data thumb) (:size thumb))
+                                  (sto/wrap-with-hash hash))]
+                (sto/put-object! storage
+                                 {::sto/content content
+                                  ::sto/deduplicate? true
+                                  ::sto/touched-at (dt/now)
+                                  :content-type (:mtype thumb)
+                                  :bucket "file-media-object"}))))
+
+          (create-image [info]
+            (p/let [data    (:path info)
+                    hash    (calculate-hash data)
+                    content (-> (sto/content data)
+                                (sto/wrap-with-hash hash))]
+              (sto/put-object! storage
+                               {::sto/content content
+                                ::sto/deduplicate? true
+                                ::sto/touched-at (dt/now)
+                                :content-type (:mtype info)
+                                :bucket "file-media-object"})))
+
+          (insert-into-database [info image thumb]
+            (px/with-dispatch executor
+              (db/exec-one! pool [sql:create-file-media-object
+                                  (or id (uuid/next))
+                                  file-id is-local name
+                                  (:id image)
+                                  (:id thumb)
+                                  (:width info)
+                                  (:height info)
+                                  (:mtype info)])))]
+
+    (p/let [info  (get-info content)
+            thumb (create-thumbnail info)
+            image (create-image info)]
+      (insert-into-database info image thumb))))
+
+;; --- Create File Media Object (from URL)
+
+(declare ^:private create-file-media-object-from-url)
+
+(s/def ::create-file-media-object-from-url
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::file-id ::is-local ::url]
+          :opt-un [::id ::name]))
+
+(sv/defmethod ::create-file-media-object-from-url
+  {::doc/added "1.17"}
+  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  (let [cfg (update cfg :storage media/configure-assets-storage)]
+    (files/check-edition-permissions! pool profile-id file-id)
+    (create-file-media-object-from-url cfg params)))
+
+(defn- create-file-media-object-from-url
+  [cfg {:keys [url name] :as params}]
+  (letfn [(parse-and-validate-size [headers]
+            (let [size     (some-> (get headers "content-length") d/parse-integer)
+                  mtype    (get headers "content-type")
+                  format   (cm/mtype->format mtype)
+                  max-size (cf/get :media-max-file-size default-max-file-size)]
+
+              (when-not size
+                (ex/raise :type :validation
+                          :code :unknown-size
+                          :hint "seems like the url points to resource with unknown size"))
+
+              (when (> size max-size)
+                (ex/raise :type :validation
+                          :code :file-too-large
+                          :hint (str/ffmt "the file size % is greater than the maximum %"
+                                          size
+                                          default-max-file-size)))
+
+              (when (nil? format)
+                (ex/raise :type :validation
+                          :code :media-type-not-allowed
+                          :hint "seems like the url points to an invalid media object"))
+
+              {:size size
+               :mtype mtype
+               :format format}))
+
+          (download-media [uri]
+            (-> (http/req! cfg {:method :get :uri uri} {:response-type :input-stream})
+                (p/then process-response)))
+
+          (process-response [{:keys [body headers] :as response}]
+            (let [{:keys [size mtype]} (parse-and-validate-size headers)
+                  path                 (tmp/tempfile :prefix "penpot.media.download.")
+                  written              (io/write-to-file! body path :size size)]
+
+              (when (not= written size)
+                (ex/raise :type :internal
+                          :code :mismatch-write-size
+                          :hint "unexpected state: unable to write to file"))
+
+              {:filename "tempfile"
+               :size size
+               :path path
+               :mtype mtype}))]
+
+    (p/let [content (download-media url)]
+      (->> (merge params {:content content :name (or name (:filename content))})
+           (create-file-media-object cfg)))))
+
+;; --- Clone File Media object (Upload and create from url)
+
+(declare clone-file-media-object)
+
+(s/def ::clone-file-media-object
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::file-id ::is-local ::id]))
+
+(sv/defmethod ::clone-file-media-object
+  {::doc/added "1.17"}
+  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
+  (db/with-atomic [conn pool]
+    (files/check-edition-permissions! conn profile-id file-id)
+    (-> (assoc cfg :conn conn)
+        (clone-file-media-object params))))
+
+(defn clone-file-media-object
+  [{:keys [conn]} {:keys [id file-id is-local]}]
+  (let [mobj (db/get-by-id conn :file-media-object id)]
+    (db/insert! conn :file-media-object
+                {:id (uuid/next)
+                 :file-id file-id
+                 :is-local is-local
+                 :name (:name mobj)
+                 :media-id (:media-id mobj)
+                 :thumbnail-id (:thumbnail-id mobj)
+                 :width  (:width mobj)
+                 :height (:height mobj)
+                 :mtype  (:mtype mobj)})))

backend/src/app/rpc/commands/profile.clj

@@ -1,75 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; Copyright (c) KALEIDOS INC
-
-(ns app.rpc.commands.profile
-  (:require
-   [app.auth :as auth]
-   [app.common.exceptions :as ex]
-   [app.common.spec :as us]
-   [app.config :as cf]
-   [app.db :as db]
-   [app.rpc :as-alias rpc]
-   [app.rpc.climit :as-alias climit]
-   [app.rpc.doc :as-alias doc]
-   [app.util.services :as sv]
-   [clojure.spec.alpha :as s]))
-
-;; --- MUTATION: Set profile password
-
-(declare update-profile-password!)
-
-(s/def ::profile-id ::us/uuid)
-(s/def ::password ::us/not-empty-string)
-
-(s/def ::get-derived-password
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::password]))
-
-(sv/defmethod ::get-derived-password
-  "Get derived password, only ADMINS allowed to call this RPC
-  methods. Designed for administration pannel integration."
-  {::climit/queue :auth
-   ::climit/key-fn ::rpc/profile-id
-   ::doc/added "1.18"}
-  [{:keys [::db/pool]} {:keys [password] :as params}]
-  (db/with-atomic [conn pool]
-    (let [admins  (cf/get :admins)
-          profile (db/get-by-id conn :profile (::rpc/profile-id params))]
-
-      (if (or (:is-admin profile)
-              (contains? admins (:email profile)))
-        {:password (auth/derive-password password)}
-        (ex/raise :type :authentication
-                  :code :only-admins-allowed
-                  :hint "only admins allowed to call this RPC method")))))
-
-;; --- MUTATION: Check profile password
-
-(s/def ::attempt ::us/not-empty-string)
-(s/def ::check-profile-password
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::profile-id ::password]))
-
-(sv/defmethod ::check-profile-password
-  "Check profile password, only ADMINS allowed to call this RPC
-  methods. Designed for administration pannel integration."
-  {::climit/queue :auth
-   ::climit/key-fn ::rpc/profile-id
-   ::doc/added "1.18"}
-  [{:keys [::db/pool]} {:keys [profile-id password] :as params}]
-  (db/with-atomic [conn pool]
-    (let [admins  (cf/get :admins)
-          profile (db/get-by-id pool :profile (::rpc/profile-id params))]
-
-      (if (or (:is-admin profile)
-              (contains? admins (:email profile)))
-        (let [profile (if (not= (::rpc/profile-id params) profile-id)
-                        (db/get-by-id conn :profile profile-id)
-                        profile)]
-          (auth/verify-password password (:password profile)))
-        (ex/raise :type :authentication
-                  :code :only-admins-allowed
-                  :hint "only admins allowed to call this RPC method")))))

backend/src/app/rpc/commands/search.clj

@@ -48,7 +48,7 @@
     order by f.created_at asc")
 
 (defn search-files
-  [conn {:keys [::rpc/profile-id team-id search-term] :as params}]
+  [conn profile-id team-id search-term]
   (db/exec! conn [sql:search-files
                   profile-id team-id
                   profile-id team-id
@@ -64,6 +64,5 @@
 
 (sv/defmethod ::search-files
   {::doc/added "1.17"}
-  [{:keys [pool]} {:keys [search-term] :as params}]
-  (when search-term
-    (search-files pool params)))
+  [{:keys [pool]} {:keys [::rpc/profile-id team-id search-term]}]
+  (some->> search-term (search-files pool profile-id team-id)))

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
@@ -381,14 +385,8 @@
 
 (declare role->params)
 
-(s/def ::reassign-to ::us/uuid)
-(s/def ::leave-team
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::id]
-          :opt-un [::reassign-to]))
-
 (defn leave-team
-  [conn {:keys [::rpc/profile-id id reassign-to]}]
+  [conn {:keys [profile-id id reassign-to]}]
   (let [perms   (get-permissions conn profile-id id)
         members (retrieve-team-members conn id)]
 
@@ -433,12 +431,17 @@
 
     nil))
 
+(s/def ::reassign-to ::us/uuid)
+(s/def ::leave-team
+  (s/keys :req [::rpc/profile-id]
+          :req-un [::id]
+          :opt-un [::reassign-to]))
 
 (sv/defmethod ::leave-team
   {::doc/added "1.17"}
-  [{:keys [pool] :as cfg} params]
+  [{:keys [pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
   (db/with-atomic [conn pool]
-    (leave-team conn params)))
+    (leave-team conn (assoc params :profile-id profile-id))))
 
 ;; --- Mutation: Delete Team
 
@@ -535,9 +538,9 @@
 
 (sv/defmethod ::update-team-member-role
   {::doc/added "1.17"}
-  [{:keys [::db/pool] :as cfg} params]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
   (db/with-atomic [conn pool]
-    (update-team-member-role conn (assoc params :profile-id (::rpc/profile-id params)))))
+    (update-team-member-role conn (assoc params :profile-id profile-id))))
 
 
 ;; --- Mutation: Delete Team Member
@@ -638,7 +641,7 @@
   "insert into team_invitation(team_id, email_to, role, valid_until)
    values (?, ?, ?, ?)
        on conflict(team_id, email_to) do
-          update set role = ?, updated_at = now();")
+          update set role = ?, valid_until = ?, updated_at = now();")
 
 (defn- create-invitation-token
   [cfg {:keys [profile-id valid-until team-id member-id member-email role]}]
@@ -709,7 +712,7 @@
                       {:id (:id member)})))
       (do
         (db/exec-one! conn [sql:upsert-team-invitation
-                            (:id team) (str/lower email) (name role) expire (name role)])
+                            (:id team) (str/lower email) (name role) expire (name role) expire])
         (eml/send! {::eml/conn conn
                     ::eml/factory eml/invite-to-team
                     :public-uri (cf/get :public-uri)
@@ -739,6 +742,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))
@@ -772,7 +786,8 @@
   {::doc/added "1.17"}
   [{:keys [pool] :as cfg} {:keys [::rpc/profile-id emails role] :as params}]
   (db/with-atomic [conn pool]
-    (let [team     (create-team conn params)
+    (let [params   (assoc params :profile-id profile-id)
+          team     (create-team conn params)
           profile  (db/get-by-id conn :profile profile-id)
           cfg      (assoc cfg ::conn conn)]
 
@@ -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

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})
 

backend/src/app/rpc/commands/viewer.clj

@@ -84,6 +84,6 @@
    ::cond/key-fn files/get-file-etag
    ::cond/reuse-key? true
    ::doc/added "1.17"}
-  [{:keys [pool]} params]
+  [{:keys [pool]} {:keys [::rpc/profile-id] :as params}]
   (with-open [conn (db/open pool)]
-    (get-view-only-bundle conn (assoc params :profile-id (::rpc/profile-id params)))))
+    (get-view-only-bundle conn (assoc params :profile-id profile-id))))

backend/src/app/rpc/commands/webhooks.clj

@@ -29,7 +29,6 @@
 (s/def ::is-active ::us/boolean)
 (s/def ::mtype
   #{"application/json"
-    "application/x-www-form-urlencoded"
     "application/transit+json"})
 
 (s/def ::create-webhook

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

backend/src/app/rpc/mutations/media.clj

@@ -6,280 +6,49 @@
 
 (ns app.rpc.mutations.media
   (:require
-   [app.common.data :as d]
-   [app.common.exceptions :as ex]
-   [app.common.media :as cm]
-   [app.common.spec :as us]
-   [app.common.uuid :as uuid]
-   [app.config :as cf]
    [app.db :as db]
-   [app.http.client :as http]
    [app.media :as media]
-   [app.rpc.climit :as climit]
-   [app.rpc.commands.teams :as teams]
-   [app.storage :as sto]
-   [app.storage.tmp :as tmp]
+   [app.rpc.commands.files :as files]
+   [app.rpc.commands.media :as cmd.media]
+   [app.rpc.doc :as-alias doc]
    [app.util.services :as sv]
-   [app.util.time :as dt]
-   [clojure.spec.alpha :as s]
-   [cuerdas.core :as str]
-   [datoteka.io :as io]
-   [promesa.core :as p]
-   [promesa.exec :as px]))
-
-(def default-max-file-size (* 1024 1024 10)) ; 10 MiB
-
-(def thumbnail-options
-  {:width 100
-   :height 100
-   :quality 85
-   :format :jpeg})
-
-(s/def ::id ::us/uuid)
-(s/def ::name ::us/string)
-(s/def ::profile-id ::us/uuid)
-(s/def ::file-id ::us/uuid)
-(s/def ::team-id ::us/uuid)
+   [clojure.spec.alpha :as s]))
 
 ;; --- Create File Media object (upload)
 
-(declare create-file-media-object)
-(declare select-file)
-
-(s/def ::content ::media/upload)
-(s/def ::is-local ::us/boolean)
-
-(s/def ::upload-file-media-object
-  (s/keys :req-un [::profile-id ::file-id ::is-local ::name ::content]
-          :opt-un [::id]))
+(s/def ::upload-file-media-object ::cmd.media/upload-file-media-object)
 
 (sv/defmethod ::upload-file-media-object
+  {::doc/added "1.2"
+   ::doc/deprecated "1.17"}
   [{:keys [pool] :as cfg} {:keys [profile-id file-id content] :as params}]
-  (let [file (select-file pool file-id)
-        cfg  (update cfg :storage media/configure-assets-storage)]
-
-    (teams/check-edition-permissions! pool profile-id (:team-id file))
+  (let [cfg (update cfg :storage media/configure-assets-storage)]
+    (files/check-edition-permissions! pool profile-id file-id)
     (media/validate-media-type! content)
-
-    (when (> (:size content) (cf/get :media-max-file-size default-max-file-size))
-      (ex/raise :type :restriction
-                :code :media-max-file-size-reached
-                :hint (str/ffmt "the uploaded file size % is greater than the maximum %"
-                                (:size content)
-                                default-max-file-size)))
-
-    (create-file-media-object cfg params)))
-
-(defn- big-enough-for-thumbnail?
-  "Checks if the provided image info is big enough for
-  create a separate thumbnail storage object."
-  [info]
-  (or (> (:width info) (:width thumbnail-options))
-      (> (:height info) (:height thumbnail-options))))
-
-(defn- svg-image?
-  [info]
-  (= (:mtype info) "image/svg+xml"))
-
-;; NOTE: we use the `on conflict do update` instead of `do nothing`
-;; because postgresql does not returns anything if no update is
-;; performed, the `do update` does the trick.
-
-(def sql:create-file-media-object
-  "insert into file_media_object (id, file_id, is_local, name, media_id, thumbnail_id, width, height, mtype)
-   values (?, ?, ?, ?, ?, ?, ?, ?, ?)
-       on conflict (id) do update set created_at=file_media_object.created_at
-       returning *")
-
-;; NOTE: the following function executes without a transaction, this
-;; means that if something fails in the middle of this function, it
-;; will probably leave leaked/unreferenced objects in the database and
-;; probably in the storage layer. For handle possible object leakage,
-;; we create all media objects marked as touched, this ensures that if
-;; something fails, all leaked (already created storage objects) will
-;; be eventually marked as deleted by the touched-gc task.
-;;
-;; The touched-gc task, performs periodic analysis of all touched
-;; storage objects and check references of it. This is the reason why
-;; `reference` metadata exists: it indicates the name of the table
-;; witch holds the reference to storage object (it some kind of
-;; inverse, soft referential integrity).
-
-(defn create-file-media-object
-  [{:keys [storage pool climit executor] :as cfg}
-   {:keys [id file-id is-local name content] :as params}]
-  (letfn [;; Function responsible to retrieve the file information, as
-          ;; it is synchronous operation it should be wrapped into
-          ;; with-dispatch macro.
-          (get-info [content]
-            (climit/with-dispatch (:process-image climit)
-              (media/run {:cmd :info :input content})))
-
-          ;; Function responsible of calculating cryptographyc hash of
-          ;; the provided data.
-          (calculate-hash [data]
-            (px/with-dispatch executor
-              (sto/calculate-hash data)))
-
-          ;; Function responsible of generating thumnail. As it is synchronous
-          ;; opetation, it should be wrapped into with-dispatch macro
-          (generate-thumbnail [info]
-            (climit/with-dispatch (:process-image climit)
-              (media/run (assoc thumbnail-options
-                                :cmd :generic-thumbnail
-                                :input info))))
-
-          (create-thumbnail [info]
-            (when (and (not (svg-image? info))
-                       (big-enough-for-thumbnail? info))
-              (p/let [thumb   (generate-thumbnail info)
-                      hash    (calculate-hash (:data thumb))
-                      content (-> (sto/content (:data thumb) (:size thumb))
-                                  (sto/wrap-with-hash hash))]
-                (sto/put-object! storage
-                                 {::sto/content content
-                                  ::sto/deduplicate? true
-                                  ::sto/touched-at (dt/now)
-                                  :content-type (:mtype thumb)
-                                  :bucket "file-media-object"}))))
-
-          (create-image [info]
-            (p/let [data    (:path info)
-                    hash    (calculate-hash data)
-                    content (-> (sto/content data)
-                                (sto/wrap-with-hash hash))]
-              (sto/put-object! storage
-                               {::sto/content content
-                                ::sto/deduplicate? true
-                                ::sto/touched-at (dt/now)
-                                :content-type (:mtype info)
-                                :bucket "file-media-object"})))
-
-          (insert-into-database [info image thumb]
-            (px/with-dispatch executor
-              (db/exec-one! pool [sql:create-file-media-object
-                                  (or id (uuid/next))
-                                  file-id is-local name
-                                  (:id image)
-                                  (:id thumb)
-                                  (:width info)
-                                  (:height info)
-                                  (:mtype info)])))]
-
-    (p/let [info  (get-info content)
-            thumb (create-thumbnail info)
-            image (create-image info)]
-      (insert-into-database info image thumb))))
+    (cmd.media/validate-content-size! content)
+    (cmd.media/create-file-media-object cfg params)))
 
 ;; --- Create File Media Object (from URL)
 
-(declare ^:private create-file-media-object-from-url)
-
-(s/def ::create-file-media-object-from-url
-  (s/keys :req-un [::profile-id ::file-id ::is-local ::url]
-          :opt-un [::id ::name]))
+(s/def ::create-file-media-object-from-url ::cmd.media/create-file-media-object-from-url)
 
 (sv/defmethod ::create-file-media-object-from-url
+  {::doc/added "1.3"
+   ::doc/deprecated "1.17"}
   [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
-  (let [file (select-file pool file-id)
-        cfg  (update cfg :storage media/configure-assets-storage)]
-    (teams/check-edition-permissions! pool profile-id (:team-id file))
-    (create-file-media-object-from-url cfg params)))
-
-(defn- create-file-media-object-from-url
-  [cfg {:keys [url name] :as params}]
-  (letfn [(parse-and-validate-size [headers]
-            (let [size     (some-> (get headers "content-length") d/parse-integer)
-                  mtype    (get headers "content-type")
-                  format   (cm/mtype->format mtype)
-                  max-size (cf/get :media-max-file-size default-max-file-size)]
-
-              (when-not size
-                (ex/raise :type :validation
-                          :code :unknown-size
-                          :hint "seems like the url points to resource with unknown size"))
-
-              (when (> size max-size)
-                (ex/raise :type :validation
-                          :code :file-too-large
-                          :hint (str/ffmt "the file size % is greater than the maximum %"
-                                          size
-                                          default-max-file-size)))
-
-              (when (nil? format)
-                (ex/raise :type :validation
-                          :code :media-type-not-allowed
-                          :hint "seems like the url points to an invalid media object"))
-
-              {:size size
-               :mtype mtype
-               :format format}))
-
-          (download-media [uri]
-            (-> (http/req! cfg {:method :get :uri uri} {:response-type :input-stream})
-                (p/then process-response)))
-
-          (process-response [{:keys [body headers] :as response}]
-            (let [{:keys [size mtype]} (parse-and-validate-size headers)
-                  path                 (tmp/tempfile :prefix "penpot.media.download.")
-                  written              (io/write-to-file! body path :size size)]
-
-              (when (not= written size)
-                (ex/raise :type :internal
-                          :code :mismatch-write-size
-                          :hint "unexpected state: unable to write to file"))
-
-              {:filename "tempfile"
-               :size size
-               :path path
-               :mtype mtype}))]
-
-    (p/let [content (download-media url)]
-      (->> (merge params {:content content :name (or name (:filename content))})
-           (create-file-media-object cfg)))))
+  (let [cfg (update cfg :storage media/configure-assets-storage)]
+    (files/check-edition-permissions! pool profile-id file-id)
+    (#'cmd.media/create-file-media-object-from-url cfg params)))
 
 ;; --- Clone File Media object (Upload and create from url)
 
-(declare clone-file-media-object)
-
-(s/def ::clone-file-media-object
-  (s/keys :req-un [::profile-id ::file-id ::is-local ::id]))
+(s/def ::clone-file-media-object ::cmd.media/clone-file-media-object)
 
 (sv/defmethod ::clone-file-media-object
+  {::doc/added "1.2"
+   ::doc/deprecated "1.17"}
   [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
-    (let [file (select-file conn file-id)]
-      (teams/check-edition-permissions! conn profile-id (:team-id file))
-      (-> (assoc cfg :conn conn)
-          (clone-file-media-object params)))))
-
-(defn clone-file-media-object
-  [{:keys [conn] :as cfg} {:keys [id file-id is-local]}]
-  (let [mobj (db/get-by-id conn :file-media-object id)]
-    (db/insert! conn :file-media-object
-                {:id (uuid/next)
-                 :file-id file-id
-                 :is-local is-local
-                 :name (:name mobj)
-                 :media-id (:media-id mobj)
-                 :thumbnail-id (:thumbnail-id mobj)
-                 :width  (:width mobj)
-                 :height (:height mobj)
-                 :mtype  (:mtype mobj)})))
-
-;; --- HELPERS
-
-(def ^:private
-  sql:select-file
-  "select file.*,
-          project.team_id as team_id
-     from file
-    inner join project on (project.id = file.project_id)
-    where file.id = ?")
-
-(defn- select-file
-  [conn id]
-  (let [row (db/exec-one! conn [sql:select-file id])]
-    (when-not row
-      (ex/raise :type :not-found))
-    row))
+    (files/check-edition-permissions! conn profile-id file-id)
+    (-> (assoc cfg :conn conn)
+        (cmd.media/clone-file-media-object params))))

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)
 

backend/src/app/rpc/queries/files.clj

@@ -179,6 +179,5 @@
 (sv/defmethod ::search-files
   {::doc/added "1.0"
    ::doc/deprecated "1.17"}
-  [{:keys [pool]} {:keys [search-term] :as params}]
-  (when search-term
-    (search/search-files pool params)))
+  [{:keys [pool]} {:keys [profile-id team-id search-term]}]
+  (some->> search-term (search/search-files pool profile-id team-id)))

backend/src/app/rpc/queries/fonts.clj

@@ -17,6 +17,7 @@
 
 ;; --- Query: Font Variants
 
+(s/def ::team-id ::us/uuid)
 (s/def ::file-id ::us/uuid)
 (s/def ::project-id ::us/uuid)
 (s/def ::font-variants

backend/src/app/rpc/quotes.clj

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

backend/src/app/rpc/rlimit.clj

@@ -182,78 +182,94 @@
                         (assoc ::lresult/remaining remaining)
                         (assoc ::lresult/reset (dt/plus ts {unit 1})))))))))
 
-(defn- process-limits
+(defn- process-limits!
   [redis user-id limits now]
-  (-> (p/all (map (partial process-limit redis user-id now) limits))
-      (p/then (fn [results]
-                (let [remaining (->> results
-                                     (d/index-by ::name ::lresult/remaining)
-                                     (uri/map->query-string))
-                      reset     (->> results
-                                     (d/index-by ::name (comp dt/->seconds ::lresult/reset))
-                                     (uri/map->query-string))
-                      rejected  (->> results
-                                     (filter (complement ::lresult/allowed?))
-                                     (first))]
+  (->> (p/all (map (partial process-limit redis user-id now) limits))
+       (p/fmap (fn [results]
+                 (let [remaining (->> results
+                                      (d/index-by ::name ::lresult/remaining)
+                                      (uri/map->query-string))
+                       reset     (->> results
+                                      (d/index-by ::name (comp dt/->seconds ::lresult/reset))
+                                      (uri/map->query-string))
+                       rejected  (->> results
+                                      (filter (complement ::lresult/allowed?))
+                                      (first))]
 
-                  (when rejected
-                    (l/warn :hint "rejected rate limit"
-                            :user-id (str user-id)
-                            :limit-service (-> rejected ::service name)
-                            :limit-name (-> rejected ::name name)
-                            :limit-strategy (-> rejected ::strategy name)))
+                   (when rejected
+                     (l/warn :hint "rejected rate limit"
+                             :user-id (str user-id)
+                             :limit-service (-> rejected ::service name)
+                             :limit-name (-> rejected ::name name)
+                             :limit-strategy (-> rejected ::strategy name)))
 
-                  {:enabled? true
-                   :allowed? (not (some? rejected))
-                   :headers  {"x-rate-limit-remaining" remaining
-                              "x-rate-limit-reset" reset}})))))
+                   {:enabled? true
+                    :allowed? (not (some? rejected))
+                    :headers  {"x-rate-limit-remaining" remaining
+                               "x-rate-limit-reset" reset}})))))
 
 (defn- handle-response
   [f cfg params result]
   (if (:enabled? result)
     (let [headers (:headers result)]
-      (when-not (:allowed? result)
-        (ex/raise :type :rate-limit
-                  :code :request-blocked
-                  :hint "rate limit reached"
-                  ::http/headers headers))
-      (-> (f cfg params)
-          (p/then (fn [response]
-                    (vary-meta response update ::http/headers merge headers)))))
+      (if (:allowed? result)
+        (->> (f cfg params)
+             (p/fmap (fn [response]
+                       (vary-meta response update ::http/headers merge headers))))
+        (p/rejected
+         (ex/error :type :rate-limit
+                   :code :request-blocked
+                   :hint "rate limit reached"
+                   ::http/headers headers))))
     (f cfg params)))
 
+(defn- get-limits
+  [state skey sname]
+  (some->> (or (get-in @state [::limits skey])
+               (get-in @state [::limits :default]))
+           (map #(assoc % ::service sname))
+           (seq)))
+
+(defn- get-uid
+  [{:keys [::http/request] :as params}]
+  (or (::rpc/profile-id params)
+      (some-> request parse-client-ip)
+      uuid/zero))
+
 (defn wrap
   [{:keys [rlimit redis] :as cfg} f mdata]
   (if rlimit
     (let [skey  (keyword (::rpc/type cfg) (->> mdata ::sv/spec name))
           sname (str (::rpc/type cfg) "." (->> mdata ::sv/spec name))]
-      (fn [cfg {:keys [::http/request] :as params}]
-        (let [uid (or (:profile-id params)
-                      (some-> request parse-client-ip)
-                      uuid/zero)
 
-              rsp (when (and uid @enabled?)
-                    (when-let [limits (or (get-in @rlimit [::limits skey])
-                                          (get-in @rlimit [::limits :default]))]
-                      (let [redis  (redis/get-or-connect redis ::rlimit default-options)
-                            limits (map #(assoc % ::service sname) limits)
-                            resp   (-> (process-limits redis uid limits (dt/now))
-                                       (p/catch (fn [cause]
-                                                  ;; If we have an error on processing the rate-limit we just skip
-                                                  ;; it for do not cause service interruption because of redis
-                                                  ;; downtime or similar situation.
-                                                  (l/error :hint "error on processing rate-limit" :cause cause)
-                                                  {:enabled? false})))]
+      (fn [cfg params]
+        (if @enabled?
+          (try
+            (let [uid (get-uid params)
+                  rsp (when-let [limits (get-limits rlimit skey sname)]
+                        (let [redis (redis/get-or-connect redis ::rpc/rlimit default-options)
+                              rsp   (->> (process-limits! redis uid limits (dt/now))
+                                         (p/merr (fn [cause]
+                                                   ;; If we have an error on processing the rate-limit we just skip
+                                                   ;; it for do not cause service interruption because of redis
+                                                   ;; downtime or similar situation.
+                                                   (l/error :hint "error on processing rate-limit" :cause cause)
+                                                   (p/resolved {:enabled? false}))))]
 
-                        ;; If soft rate are enabled, we process the rate-limit but return unprotected
-                        ;; response.
-                        (if (contains? cf/flags :soft-rpc-rlimit)
-                          (p/resolved {:enabled? false})
-                          resp))))
+                          ;; If soft rate are enabled, we process the rate-limit but return unprotected
+                          ;; response.
+                          (if (contains? cf/flags :soft-rpc-rlimit)
+                            {:enabled? false}
+                            rsp)))]
 
-              rsp (or rsp (p/resolved {:enabled? false}))]
+              (->> (p/promise rsp)
+                   (p/fmap #(or % {:enabled? false}))
+                   (p/mcat #(handle-response f cfg params %))))
 
-          (p/then rsp (partial handle-response f cfg params)))))
+            (catch Throwable cause
+              (p/rejected cause)))
+
+          (f cfg params))))
     f))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

backend/src/app/setup.clj

@@ -13,7 +13,6 @@
    [app.db :as db]
    [app.main :as-alias main]
    [app.setup.builtin-templates]
-   [app.setup.initial-user]
    [app.setup.keys :as keys]
    [buddy.core.codecs :as bc]
    [buddy.core.nonce :as bn]
@@ -69,5 +68,5 @@
     (let [secret (or key (generate-random-key))]
       (-> (retrieve-all conn)
           (assoc :secret-key secret)
-          (assoc :tokens-key (keys/derive secret :salt "tokens" :size 32))
+          (assoc :tokens-key (keys/derive secret :salt "tokens"))
           (update :instance-id handle-instance-id conn (db/read-only? pool))))))

backend/src/app/setup/initial_user.clj

@@ -1,41 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; Copyright (c) KALEIDOS INC
-
-(ns app.setup.initial-user
-  "Initial data setup of instance."
-  (:require
-   [app.auth :as auth]
-   [app.common.logging :as l]
-   [app.common.uuid :as uuid]
-   [app.config :as cf]
-   [app.db :as db]
-   [app.setup :as-alias setup]
-   [clojure.spec.alpha :as s]
-   [integrant.core :as ig]))
-
-(def ^:private sql:insert-profile
-  "insert into profile (id, fullname, email, password, is_active, is_admin, created_at, modified_at)
-   values ('00000000-0000-0000-0000-000000000000', 'Admin', ?, ?, true, true, now(), now())
-       on conflict (id)
-       do update set email = ?, password = ?")
-
-(defmethod ig/pre-init-spec ::setup/initial-profile [_]
-  (s/keys :req [::db/pool]))
-
-(defmethod ig/init-key ::setup/initial-profile
-  [_ {:keys [::db/pool]}]
-  (let [email    (cf/get :setup-admin-email)
-        password (cf/get :setup-admin-password)]
-    (when (and email password)
-      (db/with-atomic [conn pool]
-        (let [pwd (auth/derive-password password)]
-          (db/exec-one! conn [sql:insert-profile email pwd email pwd])
-          (l/info :hint "setting initial user (admin)"
-                  :email email
-                  :password "********"))))
-    nil))
-
-

backend/src/app/setup/keys.clj

@@ -13,7 +13,7 @@
 
 (defn derive
   "Derive a key from secret-key"
-  [secret-key & {:keys [salt size]}]
+  [secret-key & {:keys [salt size] :or {size 32}}]
   (us/assert! ::us/not-empty-string secret-key)
   (let [engine (bk/engine {:key secret-key
                            :salt salt

backend/src/app/srepl.clj

@@ -9,7 +9,11 @@
   (:require
    [app.common.logging :as l]
    [app.common.spec :as us]
+   [app.config :as cf]
+   [app.srepl.ext]
    [app.srepl.main]
+   [app.util.json :as json]
+   [app.util.locks :as locks]
    [clojure.core.server :as ccs]
    [clojure.main :as cm]
    [clojure.spec.alpha :as s]
@@ -20,39 +24,59 @@
   (ccs/repl-init)
   (in-ns 'app.srepl.main))
 
-(defn repl
+(defn user-repl
   []
   (cm/repl
    :init repl-init
    :read ccs/repl-read))
 
+(defn json-repl
+  []
+  (let [out  *out*
+        lock (locks/create)]
+    (ccs/prepl *in*
+               (fn [m]
+                 (binding [*out* out, *flush-on-newline* true, *print-readably* true]
+                   (locks/locking lock
+                     (println (json/encode-str m))))))))
+
 ;; --- State initialization
 
-(s/def ::name ::us/not-empty-string)
-(s/def ::port int?)
+(s/def ::port ::us/integer)
 (s/def ::host ::us/not-empty-string)
+(s/def ::flag #{:urepl-server :prepl-server})
+(s/def ::type #{::prepl ::urepl})
+(s/def ::key (s/tuple ::type ::us/keyword))
 
 (defmethod ig/pre-init-spec ::server
   [_]
-  (s/keys :opt-un [::port ::host ::name]))
+  (s/keys :req [::flag]
+          :req-un [::port ::host]))
 
 (defmethod ig/prep-key ::server
-  [_ cfg]
-  (merge {:name "main"} cfg))
+  [[type _] cfg]
+  (assoc cfg ::flag (keyword (str (name type) "-server"))))
 
 (defmethod ig/init-key ::server
-  [_ {:keys [port host name] :as cfg}]
-  (when (and port host name)
-    (l/info :msg "initializing server repl" :port port :host host :name name)
-    (ccs/start-server {:address host
-                       :port port
-                       :name name
-                       :accept 'app.srepl/repl})
-    cfg))
+  [[type _] {:keys [::flag port host] :as cfg}]
+  (when (contains? cf/flags flag)
+    (let [accept (case type
+                   ::prepl 'app.srepl/json-repl
+                   ::urepl 'app.srepl/user-repl)
+          params {:address host
+                  :port port
+                  :name (name type)
+                  :accept accept}]
+
+      (l/info :msg "initializing repl server"
+              :name (name type)
+              :port port
+              :host host)
+
+      (ccs/start-server params)
+
+      params)))
 
 (defmethod ig/halt-key! ::server
-  [_ cfg]
-  (when cfg
-    (ccs/stop-server (:name cfg))))
-
-
+  [_ params]
+  (some-> params :name ccs/stop-server))

backend/src/app/srepl/ext.clj

@@ -0,0 +1,77 @@
+;; 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.srepl.ext
+  "PREPL API for external usage (CLI or ADMIN)"
+  (:require
+   [app.auth :as auth]
+   [app.common.exceptions :as ex]
+   [app.common.uuid :as uuid]
+   [app.db :as db]
+   [app.rpc.commands.auth :as cmd.auth]
+   [app.util.json :as json]
+   [cuerdas.core :as str]))
+
+(defn- get-current-system
+  []
+  (or (deref (requiring-resolve 'app.main/system))
+      (deref (requiring-resolve 'user/system))))
+
+(defmulti ^:private run-json-cmd* ::cmd)
+
+(defn run-json-cmd
+  "Entry point with external tools integrations that uses PREPL
+  interface for interacting with running penpot backend."
+  [data]
+  (let [data (json/decode data)
+        params (merge {::cmd (keyword (:cmd data "default"))}
+                      (:params data))]
+    (run-json-cmd* params)))
+
+(defmethod run-json-cmd* :create-profile
+  [{:keys [fullname email password is-active]
+    :or {is-active true}}]
+  (when-let [system (get-current-system)]
+    (db/with-atomic [conn (:app.db/pool system)]
+      (let [params  {:id (uuid/next)
+                     :email email
+                     :fullname fullname
+                     :is-active is-active
+                     :password password
+                     :props {}}]
+        (->> (cmd.auth/create-profile conn params)
+             (cmd.auth/create-profile-relations conn))))))
+
+(defmethod run-json-cmd* :update-profile
+  [{:keys [fullname email password is-active]}]
+  (when-let [system (get-current-system)]
+    (db/with-atomic [conn (:app.db/pool system)]
+      (let [params (cond-> {}
+                     (some? fullname)
+                     (assoc :fullname fullname)
+
+                     (some? password)
+                     (assoc :password (auth/derive-password password))
+
+                     (some? is-active)
+                     (assoc :is-active is-active))]
+        (when (seq params)
+          (let [res (db/update! conn :profile
+                                params
+                                {:email email
+                                 :deleted-at nil}
+                                {:return-keys false})]
+            (pos? (:next.jdbc/update-count res))))))))
+
+(defmethod run-json-cmd* :derive-password
+  [{:keys [password]}]
+  (auth/derive-password password))
+
+(defmethod run-json-cmd* :default
+  [{:keys [::cmd]}]
+  (ex/raise :type :internal
+            :code :not-implemented
+            :hint (str/ffmt "command '%' not implemented" (name cmd))))

backend/src/app/srepl/fixes.clj

@@ -41,3 +41,35 @@
   ([file state]
    (repair-orphaned-shapes (:data file))
    (update state :total (fnil inc 0))))
+
+(defn rename-layout-attrs
+  ([file]
+   (let [found? (volatile! false)]
+     (letfn [(update-shape
+               [shape]
+               (when (or (= (:layout-flex-dir shape) :reverse-row)
+                         (= (:layout-flex-dir shape) :reverse-column)
+                         (= (:layout-wrap-type shape) :no-wrap))
+                 (vreset! found? true))
+               (cond-> shape
+                 (= (:layout-flex-dir shape) :reverse-row)
+                 (assoc :layout-flex-dir :row-reverse)
+                 (= (:layout-flex-dir shape) :reverse-column)
+                 (assoc :layout-flex-dir :column-reverse)
+                 (= (:layout-wrap-type shape) :no-wrap)
+                 (assoc :layout-wrap-type :nowrap)))
+
+             (update-page
+               [page]
+               (h/update-shapes page update-shape))]
+
+       (let [new-file (update file :data h/update-pages update-page)]
+         (when @found?
+           (l/info :hint "Found attrs to rename in file"
+                   :id (:id file)
+                   :name (:name file)))
+         new-file))))
+
+   ([file state]
+    (rename-layout-attrs file)
+    (update state :total (fnil inc 0))))

backend/src/app/srepl/helpers.clj

@@ -11,6 +11,7 @@
    [app.auth :refer [derive-password]]
    [app.common.data :as d]
    [app.common.exceptions :as ex]
+   [app.common.files.features :as ffeat]
    [app.common.logging :as l]
    [app.common.pages :as cp]
    [app.common.pages.migrations :as pmg]
@@ -21,8 +22,11 @@
    [app.db :as db]
    [app.db.sql :as sql]
    [app.main :refer [system]]
+   [app.rpc.commands.files :as files]
    [app.rpc.queries.profile :as prof]
    [app.util.blob :as blob]
+   [app.util.objects-map :as omap]
+   [app.util.pointer-map :as pmap]
    [app.util.time :as dt]
    [clojure.spec.alpha :as s]
    [clojure.stacktrace :as strace]
@@ -66,23 +70,33 @@
   [system & {:keys [update-fn id save? migrate? inc-revn?]
              :or {save? false migrate? true inc-revn? true}}]
   (db/with-atomic [conn (:app.db/pool system)]
-    (let [file (db/get-by-id conn :file id {:for-update true})
-          file (-> file
-                   (update :features db/decode-pgarray #{})
-                   (update :data blob/decode)
-                   (cond-> migrate? (update :data pmg/migrate-data)))
-          file (binding [*conn* conn]
-                 (-> (update-fn file)
-                     (cond-> inc-revn? (update :revn inc))))]
-      (when save?
-        (let [features (db/create-array conn "text" (:features file))
-              data     (blob/encode (:data file))]
-          (db/update! conn :file
-                      {:data data
-                       :revn (:revn file)
-                       :features features}
-                      {:id id})))
-      file)))
+    (let [file (-> (db/get-by-id conn :file id {:for-update true})
+                   (update :features db/decode-pgarray #{}))]
+      (binding [*conn* conn
+                pmap/*tracked* (atom {})
+                pmap/*load-fn* (partial files/load-pointer conn id)
+                ffeat/*wrap-with-pointer-map-fn*
+                (if (contains? (:features file) "storage/pointer-map") pmap/wrap identity)
+                ffeat/*wrap-with-objects-map-fn*
+                (if (contains? (:features file) "storage/objectd-map") omap/wrap identity)]
+        (let [file (-> file
+                       (update :data blob/decode)
+                       (cond-> migrate? (update :data pmg/migrate-data))
+                       (update-fn)
+                       (cond-> inc-revn? (update :revn inc)))]
+          (when save?
+            (let [features (db/create-array conn "text" (:features file))
+                  data     (blob/encode (:data file))]
+              (db/update! conn :file
+                          {:data data
+                           :revn (:revn file)
+                           :features features}
+                          {:id id})
+
+              (when (contains? (:features file) "storage/pointer-map")
+                (files/persist-pointers! conn id))))
+
+          (dissoc file :data))))))
 
 (def ^:private sql:retrieve-files-chunk
   "SELECT id, name, created_at, data FROM file

backend/src/app/srepl/main.clj

@@ -110,10 +110,10 @@
             (if (contains? features "storage/objects-map")
               file
               (-> file
-                  (update :data migrate-to-omap)
+                  (update :data migrate)
                   (update :features conj "storage/objects-map"))))
 
-          (migrate-to-omap [data]
+          (migrate [data]
             (-> data
                 (update :pages-index update-vals #(update % :objects omap/wrap))
                 (update :components update-vals #(update % :objects omap/wrap))))]
@@ -125,24 +125,17 @@
 
 (defn enable-pointer-map-feature-on-file!
   [system & {:keys [save? id]}]
-  (letfn [(update-file [{:keys [features id] :as file}]
+  (letfn [(update-file [{:keys [features] :as file}]
             (if (contains? features "storage/pointer-map")
               file
               (-> file
-                  (update :data migrate-to-omap id)
+                  (update :data migrate)
                   (update :features conj "storage/pointer-map"))))
 
-          (migrate-to-omap [data file-id]
-            (binding [pmap/*tracked* (atom {})]
-              (let [data (-> data
-                             (update :pages-index update-vals pmap/wrap)
-                             (update :components pmap/wrap))]
-                (doseq [[id item] @pmap/*tracked*]
-                  (db/insert! h/*conn* :file-data-fragment
-                              {:id id
-                               :file-id file-id
-                               :content (-> item deref blob/encode)}))
-                data)))]
+          (migrate [data]
+            (-> data
+                (update :pages-index update-vals pmap/wrap)
+                (update :components pmap/wrap)))]
 
     (h/update-file! system
                     :id id

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

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]
@@ -322,7 +323,9 @@
   [{:keys [::type] :as data}]
   (let [method-fn (get-in *system* [:app.rpc/methods :commands type])]
     ;; (app.common.pprint/pprint (:app.rpc/methods *system*))
-    (try-on! (method-fn (dissoc data ::type)))))
+    (try-on! (method-fn (-> data
+                            (dissoc ::type)
+                            (assoc :app.rpc/request-at (dt/now)))))))
 
 (defn mutation!
   [{:keys [::type profile-id] :as data}]

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))))))
+
+      )))

backend/test/backend_tests/rpc_file_test.clj

@@ -6,13 +6,14 @@
 
 (ns backend-tests.rpc-file-test
   (:require
-   [backend-tests.helpers :as th]
    [app.common.uuid :as uuid]
    [app.db :as db]
    [app.db.sql :as sql]
    [app.http :as http]
+   [app.rpc :as-alias rpc]
    [app.storage :as sto]
    [app.util.time :as dt]
+   [backend-tests.helpers :as th]
    [clojure.test :as t]
    [datoteka.core :as fs]))
 
@@ -28,13 +29,13 @@
 
     (t/testing "create file"
       (let [data {::th/type :create-file
-                  :profile-id (:id prof)
+                  ::rpc/profile-id (:id prof)
                   :project-id proj-id
                   :id file-id
                   :name "foobar"
                   :is-shared false
                   :components-v2 true}
-            out (th/mutation! data)]
+            out (th/command! data)]
 
         ;; (th/print-result! out)
         (t/is (nil? (:error out)))
@@ -47,8 +48,8 @@
       (let [data {::th/type :rename-file
                   :id file-id
                   :name "new name"
-                  :profile-id (:id prof)}
-            out  (th/mutation! data)]
+                  ::rpc/profile-id (:id prof)}
+            out  (th/command! data)]
 
         ;; (th/print-result! out)
         (let [result (:result out)]
@@ -56,10 +57,10 @@
           (t/is (= (:name data) (:name result))))))
 
     (t/testing "query files"
-      (let [data {::th/type :project-files
-                  :project-id proj-id
-                  :profile-id (:id prof)}
-            out  (th/query! data)]
+      (let [data {::th/type :get-project-files
+                  ::rpc/profile-id (:id prof)
+                  :project-id proj-id}
+            out  (th/command! data)]
 
         ;; (th/print-result! out)
         (t/is (nil? (:error out)))
@@ -70,11 +71,11 @@
           (t/is (= "new name" (get-in result [0 :name]))))))
 
     (t/testing "query single file without users"
-      (let [data {::th/type :file
-                  :profile-id (:id prof)
+      (let [data {::th/type :get-file
+                  ::rpc/profile-id (:id prof)
                   :id file-id
                   :components-v2 true}
-            out  (th/query! data)]
+            out  (th/command! data)]
 
         ;; (th/print-result! out)
         (t/is (nil? (:error out)))
@@ -88,18 +89,18 @@
     (t/testing "delete file"
       (let [data {::th/type :delete-file
                   :id file-id
-                  :profile-id (:id prof)}
-            out (th/mutation! data)]
+                  ::rpc/profile-id (:id prof)}
+            out (th/command! data)]
         ;; (th/print-result! out)
         (t/is (nil? (:error out)))
         (t/is (nil? (:result out)))))
 
     (t/testing "query single file after delete"
-      (let [data {::th/type :file
-                  :profile-id (:id prof)
+      (let [data {::th/type :get-file
+                  ::rpc/profile-id (:id prof)
                   :id file-id
                   :components-v2 true}
-            out (th/query! data)]
+            out (th/command! data)]
 
         ;; (th/print-result! out)
 
@@ -109,10 +110,10 @@
           (t/is (= (:type error-data) :not-found)))))
 
     (t/testing "query list files after delete"
-      (let [data {::th/type :project-files
-                  :project-id proj-id
-                  :profile-id (:id prof)}
-            out  (th/query! data)]
+      (let [data {::th/type :get-project-files
+                  ::rpc/profile-id (:id prof)
+                  :project-id proj-id}
+            out  (th/command! data)]
 
         ;; (th/print-result! out)
         (t/is (nil? (:error out)))
@@ -136,19 +137,18 @@
                   out    (th/mutation! params)]
 
               ;; (th/print-result! out)
-
               (t/is (nil? (:error out)))
               (:result out)))
 
           (update-file [{:keys [profile-id file-id changes revn] :or {revn 0}}]
             (let [params {::th/type :update-file
+                          ::rpc/profile-id profile-id
                           :id file-id
                           :session-id (uuid/random)
-                          :profile-id profile-id
                           :revn revn
                           :components-v2 true
                           :changes changes}
-                  out    (th/mutation! params)]
+                  out    (th/command! params)]
               (t/is (nil? (:error out)))
               (:result out)))]
 
@@ -257,12 +257,12 @@
         profile2 (th/create-profile* 2)
 
         data     {::th/type :create-file
-                  :profile-id (:id profile2)
+                  ::rpc/profile-id (:id profile2)
                   :project-id (:default-project-id profile1)
                   :name "foobar"
                   :is-shared false
                   :components-v2 true}
-        out      (th/mutation! data)
+        out      (th/command! data)
         error    (:error out)]
 
     ;; (th/print-result! out)
@@ -277,9 +277,9 @@
                                      :profile-id (:id profile1)})
         data     {::th/type :rename-file
                   :id (:id file)
-                  :profile-id (:id profile2)
+                  ::rpc/profile-id (:id profile2)
                   :name "foobar"}
-        out      (th/mutation! data)
+        out      (th/command! data)
         error    (:error out)]
 
     ;; (th/print-result! out)
@@ -293,9 +293,9 @@
         file     (th/create-file* 1 {:project-id (:default-project-id profile1)
                                      :profile-id (:id profile1)})
         data     {::th/type :delete-file
-                  :profile-id (:id profile2)
+                  ::rpc/profile-id (:id profile2)
                   :id (:id file)}
-        out      (th/mutation! data)
+        out      (th/command! data)
         error    (:error out)]
 
     ;; (th/print-result! out)
@@ -308,10 +308,10 @@
         file     (th/create-file* 1 {:project-id (:default-project-id profile1)
                                      :profile-id (:id profile1)})
         data     {::th/type :set-file-shared
-                  :profile-id (:id profile2)
+                  ::rpc/profile-id (:id profile2)
                   :id (:id file)
                   :is-shared true}
-        out      (th/mutation! data)
+        out      (th/command! data)
         error    (:error out)]
 
     ;; (th/print-result! out)
@@ -328,11 +328,11 @@
                                      :profile-id (:id profile1)})
 
         data     {::th/type :link-file-to-library
-                  :profile-id (:id profile2)
+                  ::rpc/profile-id (:id profile2)
                   :file-id (:id file2)
                   :library-id (:id file1)}
 
-        out      (th/mutation! data)
+        out      (th/command! data)
         error    (:error out)]
 
       ;; (th/print-result! out)
@@ -350,11 +350,11 @@
                                      :profile-id (:id profile2)})
 
         data     {::th/type :link-file-to-library
-                  :profile-id (:id profile2)
+                  ::rpc/profile-id (:id profile2)
                   :file-id (:id file2)
                   :library-id (:id file1)}
 
-        out      (th/mutation! data)
+        out      (th/command! data)
         error    (:error out)]
 
       ;; (th/print-result! out)
@@ -372,10 +372,10 @@
       (t/is (= 0 (:processed result))))
 
     ;; query the list of files
-    (let [data {::th/type :project-files
-                :project-id (:default-project-id profile1)
-                :profile-id (:id profile1)}
-          out  (th/query! data)]
+    (let [data {::th/type :get-project-files
+                ::rpc/profile-id (:id profile1)
+                :project-id (:default-project-id profile1)}
+          out  (th/command! data)]
       ;; (th/print-result! out)
       (t/is (nil? (:error out)))
       (let [result (:result out)]
@@ -384,15 +384,15 @@
     ;; Request file to be deleted
     (let [params {::th/type :delete-file
                   :id (:id file)
-                  :profile-id (:id profile1)}
-          out    (th/mutation! params)]
+                  ::rpc/profile-id (:id profile1)}
+          out    (th/command! params)]
       (t/is (nil? (:error out))))
 
     ;; query the list of files after soft deletion
-    (let [data {::th/type :project-files
-                :project-id (:default-project-id profile1)
-                :profile-id (:id profile1)}
-          out  (th/query! data)]
+    (let [data {::th/type :get-project-files
+                ::rpc/profile-id (:id profile1)
+                :project-id (:default-project-id profile1)}
+          out  (th/command! data)]
       ;; (th/print-result! out)
       (t/is (nil? (:error out)))
       (let [result (:result out)]
@@ -403,10 +403,10 @@
       (t/is (= 0 (:processed result))))
 
     ;; query the list of file libraries of a after hard deletion
-    (let [data {::th/type :file-libraries
-                :file-id (:id file)
-                :profile-id (:id profile1)}
-          out  (th/query! data)]
+    (let [data {::th/type :get-file-libraries
+                ::rpc/profile-id (:id profile1)
+                :file-id (:id file)}
+          out  (th/command! data)]
       ;; (th/print-result! out)
       (t/is (nil? (:error out)))
       (let [result (:result out)]
@@ -417,10 +417,10 @@
       (t/is (= 1 (:processed result))))
 
     ;; query the list of file libraries of a after hard deletion
-    (let [data {::th/type :file-libraries
-                :file-id (:id file)
-                :profile-id (:id profile1)}
-          out  (th/query! data)]
+    (let [data {::th/type :get-file-libraries
+                ::rpc/profile-id (:id profile1)
+                :file-id (:id file)}
+          out  (th/command! data)]
       ;; (th/print-result! out)
       (let [error (:error out)
             error-data (ex-data error)]
@@ -483,11 +483,11 @@
     (t/testing "RPC page query (rendering purposes)"
 
       ;; Query :page RPC method without passing page-id
-      (let [data {::th/type :page
-                  :profile-id (:id prof)
+      (let [data {::th/type :get-page
+                  ::rpc/profile-id (:id prof)
                   :file-id (:id file)
                   :components-v2 true}
-            {:keys [error result] :as out} (th/query! data)]
+            {:keys [error result] :as out} (th/command! data)]
 
         ;; (th/print-result! out)
         (t/is (map? result))
@@ -500,12 +500,12 @@
         )
 
       ;; Query :page RPC method with page-id
-      (let [data {::th/type :page
-                  :profile-id (:id prof)
+      (let [data {::th/type :get-page
+                  ::rpc/profile-id (:id prof)
                   :file-id (:id file)
                   :page-id page-id
                   :components-v2 true}
-            {:keys [error result] :as out} (th/query! data)]
+            {:keys [error result] :as out} (th/command! data)]
         ;; (th/print-result! out)
         (t/is (map? result))
         (t/is (contains? result :objects))
@@ -516,13 +516,13 @@
         (t/is (contains? (:objects result) uuid/zero)))
 
       ;; Query :page RPC method with page-id and object-id
-      (let [data {::th/type :page
-                  :profile-id (:id prof)
+      (let [data {::th/type :get-page
+                  ::rpc/profile-id (:id prof)
                   :file-id (:id file)
                   :page-id page-id
                   :object-id frame1-id
                   :components-v2 true}
-            {:keys [error result] :as out} (th/query! data)]
+            {:keys [error result] :as out} (th/command! data)]
         ;; (th/print-result! out)
         (t/is (nil? error))
         (t/is (map? result))
@@ -534,12 +534,12 @@
         (t/is (not (contains? (:objects result) shape2-id))))
 
       ;; Query :page RPC method with wrong params
-      (let [data {::th/type :page
-                  :profile-id (:id prof)
+      (let [data {::th/type :get-page
+                  ::rpc/profile-id (:id prof)
                   :file-id (:id file)
                   :object-id frame1-id
                   :components-v2 true}
-            out  (th/query! data)]
+            out  (th/command! data)]
 
         (t/is (not (th/success? out)))
         (let [{:keys [type code]} (-> out :error ex-data)]
@@ -551,21 +551,21 @@
     (t/testing "RPC :file-data-for-thumbnail"
       ;; Insert a thumbnail data for the frame-id
       (let [data {::th/type :upsert-file-object-thumbnail
-                  :profile-id (:id prof)
+                  ::rpc/profile-id (:id prof)
                   :file-id (:id file)
                   :object-id (str page-id frame1-id)
                   :data "random-data-1"}
 
-            {:keys [error result] :as out} (th/mutation! data)]
+            {:keys [error result] :as out} (th/command! data)]
         (t/is (nil? error))
         (t/is (nil? result)))
 
       ;; Check the result
-      (let [data {::th/type :file-data-for-thumbnail
-                  :profile-id (:id prof)
+      (let [data {::th/type :get-file-data-for-thumbnail
+                  ::rpc/profile-id (:id prof)
                   :file-id (:id file)
                   :components-v2 true}
-            {:keys [error result] :as out} (th/query! data)]
+            {:keys [error result] :as out} (th/command! data)]
         ;; (th/print-result! out)
         (t/is (map? result))
         (t/is (contains? result :page))
@@ -578,21 +578,21 @@
 
       ;; Delete thumbnail data
       (let [data {::th/type :upsert-file-object-thumbnail
-                  :profile-id (:id prof)
+                  ::rpc/profile-id (:id prof)
                   :file-id (:id file)
                   :object-id (str page-id frame1-id)
                   :data nil}
-            {:keys [error result] :as out} (th/mutation! data)]
+            {:keys [error result] :as out} (th/command! data)]
         ;; (th/print-result! out)
         (t/is (nil? error))
         (t/is (nil? result)))
 
       ;; Check the result
-      (let [data {::th/type :file-data-for-thumbnail
-                  :profile-id (:id prof)
+      (let [data {::th/type :get-file-data-for-thumbnail
+                  ::rpc/profile-id (:id prof)
                   :file-id (:id file)
                   :components-v2 true}
-            {:keys [error result] :as out} (th/query! data)]
+            {:keys [error result] :as out} (th/command! data)]
         ;; (th/print-result! out)
         (t/is (map? result))
         (t/is (contains? result :page))
@@ -606,11 +606,11 @@
 
       ;; insert object snapshot for known frame
       (let [data {::th/type :upsert-file-object-thumbnail
-                  :profile-id (:id prof)
+                  ::rpc/profile-id (:id prof)
                   :file-id (:id file)
                   :object-id (str page-id frame1-id)
                   :data "new-data"}
-            {:keys [error result] :as out} (th/mutation! data)]
+            {:keys [error result] :as out} (th/command! data)]
         (t/is (nil? error))
         (t/is (nil? result)))
 
@@ -629,11 +629,11 @@
 
       ;; insert object snapshot for for unknown frame
       (let [data {::th/type :upsert-file-object-thumbnail
-                  :profile-id (:id prof)
+                  ::rpc/profile-id (:id prof)
                   :file-id (:id file)
                   :object-id (str page-id (uuid/next))
                   :data "new-data-2"}
-            {:keys [error result] :as out} (th/mutation! data)]
+            {:keys [error result] :as out} (th/command! data)]
         (t/is (nil? error))
         (t/is (nil? result)))
 
@@ -661,8 +661,8 @@
                                  :project-id (:default-project-id prof)
                                  :revn 2
                                  :is-shared false})
-        data {::th/type :file-thumbnail
-              :profile-id (:id prof)
+        data {::th/type :get-file-thumbnail
+              ::rpc/profile-id (:id prof)
               :file-id (:id file)}]
 
     (t/testing "query a thumbnail with single revn"
@@ -673,7 +673,7 @@
                       :revn 1
                       :data "testvalue1"})
 
-      (let [{:keys [result error] :as out} (th/query! data)]
+      (let [{:keys [result error] :as out} (th/command! data)]
         ;; (th/print-result! out)
         (t/is (nil? error))
         (t/is (= 4 (count result)))
@@ -687,7 +687,7 @@
                       :revn 2
                       :data "testvalue2"})
 
-      (let [{:keys [result error] :as out} (th/query! data)]
+      (let [{:keys [result error] :as out} (th/command! data)]
         ;; (th/print-result! out)
         (t/is (nil? error))
         (t/is (= 4 (count result)))
@@ -695,7 +695,7 @@
         (t/is (= 2 (:revn result))))
 
       ;; Then query the specific revn
-      (let [{:keys [result error] :as out} (th/query! (assoc data :revn 1))]
+      (let [{:keys [result error] :as out} (th/command! (assoc data :revn 1))]
         ;; (th/print-result! out)
         (t/is (nil? error))
         (t/is (= 4 (count result)))
@@ -704,18 +704,18 @@
 
     (t/testing "upsert file-thumbnail"
       (let [data {::th/type :upsert-file-thumbnail
-                  :profile-id (:id prof)
+                  ::rpc/profile-id (:id prof)
                   :file-id (:id file)
                   :data "foobar"
                   :props {:baz 1}
                   :revn 2}
-            {:keys [result error] :as out} (th/mutation! data)]
+            {:keys [result error] :as out} (th/command! data)]
         ;; (th/print-result! out)
         (t/is (nil? error))
         (t/is (nil? result))))
 
     (t/testing "query last result"
-      (let [{:keys [result error] :as out} (th/query! data)]
+      (let [{:keys [result error] :as out} (th/command! data)]
         ;; (th/print-result! out)
         (t/is (nil? error))
         (t/is (= 4 (count result)))
@@ -734,7 +734,7 @@
         (t/is (= 1 (:processed res))))
 
       ;; Then query the specific revn
-      (let [{:keys [result error] :as out} (th/query! (assoc data :revn 1))]
+      (let [{:keys [result error] :as out} (th/command! (assoc data :revn 1))]
         (t/is (th/ex-of-type? error :not-found))
         (t/is (th/ex-of-code? error :file-thumbnail-not-found))))
     ))

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})

backend/test/backend_tests/rpc_media_test.clj

@@ -6,10 +6,11 @@
 
 (ns backend-tests.rpc-media-test
   (:require
-   [backend-tests.helpers :as th]
    [app.common.uuid :as uuid]
    [app.db :as db]
+   [app.rpc :as-alias rpc]
    [app.storage :as sto]
+   [backend-tests.helpers :as th]
    [clojure.test :as t]
    [datoteka.core :as fs]))
 
@@ -134,3 +135,123 @@
       (t/is (= "image/jpeg" (:mtype result)))
       (t/is (uuid? (:media-id result)))
       (t/is (uuid? (:thumbnail-id result))))))
+
+
+(t/deftest media-object-from-url-command
+  (let [prof   (th/create-profile* 1)
+        proj   (th/create-project* 1 {:profile-id (:id prof)
+                                      :team-id (:default-team-id prof)})
+        file   (th/create-file* 1 {:profile-id (:id prof)
+                                   :project-id (:default-project-id prof)
+                                   :is-shared false})
+        url    "https://raw.githubusercontent.com/uxbox/uxbox/develop/sample_media/images/unsplash/anna-pelzer.jpg"
+        params {::th/type :create-file-media-object-from-url
+                ::rpc/profile-id (:id prof)
+                :file-id    (:id file)
+                :is-local   true
+                :url        url}
+        out   (th/command! params)]
+
+    ;; (th/print-result! out)
+    (t/is (nil? (:error out)))
+    (let [{:keys [media-id thumbnail-id] :as result} (:result out)]
+      (t/is (= (:id file) (:file-id result)))
+      (t/is (= 1024 (:width result)))
+      (t/is (= 683  (:height result)))
+      (t/is (= "image/jpeg" (:mtype result)))
+      (t/is (uuid? media-id))
+      (t/is (uuid? thumbnail-id))
+      (let [storage (:app.storage/storage th/*system*)
+            mobj1   @(sto/get-object storage media-id)
+            mobj2   @(sto/get-object storage thumbnail-id)]
+        (t/is (sto/storage-object? mobj1))
+        (t/is (sto/storage-object? mobj2))
+        (t/is (= 122785 (:size mobj1)))
+        ;; This is because in ubuntu 21.04 generates different
+        ;; thumbnail that in ubuntu 22.04. This hack should be removed
+        ;; when we all use the ubuntu 22.04 devenv image.
+        (t/is (or (= 3302 (:size mobj2))
+                  (= 3303 (:size mobj2))))))))
+
+(t/deftest media-object-upload-command
+  (let [prof   (th/create-profile* 1)
+        proj   (th/create-project* 1 {:profile-id (:id prof)
+                                      :team-id (:default-team-id prof)})
+        file   (th/create-file* 1 {:profile-id (:id prof)
+                                   :project-id (:default-project-id prof)
+                                   :is-shared false})
+        mfile  {:filename "sample.jpg"
+                :path (th/tempfile "backend_tests/test_files/sample.jpg")
+                :mtype "image/jpeg"
+                :size 312043}
+
+        params {::th/type :upload-file-media-object
+                ::rpc/profile-id (:id prof)
+                :file-id (:id file)
+                :is-local true
+                :name "testfile"
+                :content mfile}
+        out    (th/command! params)]
+
+    ;; (th/print-result! out)
+    (t/is (nil? (:error out)))
+    (let [{:keys [media-id thumbnail-id] :as result} (:result out)]
+      (t/is (= (:id file) (:file-id result)))
+      (t/is (= 800 (:width result)))
+      (t/is (= 800  (:height result)))
+      (t/is (= "image/jpeg" (:mtype result)))
+      (t/is (uuid? media-id))
+      (t/is (uuid? thumbnail-id))
+      (let [storage (:app.storage/storage th/*system*)
+            mobj1   @(sto/get-object storage media-id)
+            mobj2   @(sto/get-object storage thumbnail-id)]
+        (t/is (sto/storage-object? mobj1))
+        (t/is (sto/storage-object? mobj2))
+        (t/is (= 312043 (:size mobj1)))
+        (t/is (= 3887   (:size mobj2)))))
+    ))
+
+
+(t/deftest media-object-upload-idempotency-command
+  (let [prof   (th/create-profile* 1)
+        proj   (th/create-project* 1 {:profile-id (:id prof)
+                                      :team-id (:default-team-id prof)})
+        file   (th/create-file* 1 {:profile-id (:id prof)
+                                   :project-id (:default-project-id prof)
+                                   :is-shared false})
+        mfile  {:filename "sample.jpg"
+                :path (th/tempfile "backend_tests/test_files/sample.jpg")
+                :mtype "image/jpeg"
+                :size 312043}
+
+        params {::th/type :upload-file-media-object
+                ::rpc/profile-id (:id prof)
+                :file-id (:id file)
+                :is-local true
+                :name "testfile"
+                :content mfile
+                :id (uuid/next)}]
+
+    ;; First try
+    (let [{:keys [result error] :as out} (th/command! params)]
+      ;; (th/print-result! out)
+      (t/is (nil? error))
+      (t/is (= (:id params) (:id result)))
+      (t/is (= (:file-id params) (:file-id result)))
+      (t/is (= 800 (:width result)))
+      (t/is (= 800 (:height result)))
+      (t/is (= "image/jpeg" (:mtype result)))
+      (t/is (uuid? (:media-id result)))
+      (t/is (uuid? (:thumbnail-id result))))
+
+    ;; Second try
+    (let [{:keys [result error] :as out} (th/command! params)]
+      ;; (th/print-result! out)
+      (t/is (nil? error))
+      (t/is (= (:id params) (:id result)))
+      (t/is (= (:file-id params) (:file-id result)))
+      (t/is (= 800 (:width result)))
+      (t/is (= 800 (:height result)))
+      (t/is (= "image/jpeg" (:mtype result)))
+      (t/is (uuid? (:media-id result)))
+      (t/is (uuid? (:thumbnail-id result))))))

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)
+
+      )))

backend/test/backend_tests/rpc_team_test.clj

@@ -21,7 +21,7 @@
 (t/use-fixtures :once th/state-init)
 (t/use-fixtures :each th/database-reset)
 
-(t/deftest invite-team-member
+(t/deftest create-team-invitations
   (with-mocks [mock {:target 'app.emails/send! :return nil}]
     (let [profile1 (th/create-profile* 1 {:is-active true})
           profile2 (th/create-profile* 2 {:is-active true})
@@ -30,14 +30,14 @@
           team     (th/create-team* 1 {:profile-id (:id profile1)})
 
           pool     (:app.db/pool th/*system*)
-          data     {::th/type :invite-team-member
+          data     {::th/type :create-team-invitations
+                    ::rpc/profile-id (:id profile1)
                     :team-id (:id team)
-                    :role :editor
-                    :profile-id (:id profile1)}]
+                    :role :editor}]
 
       ;; invite external user without complaints
       (let [data       (assoc data :email "foo@bar.com")
-            out        (th/mutation! data)
+            out        (th/command! data)
             ;; retrieve the value from the database and check its content
             invitation (db/exec-one!
                         th/*pool*
@@ -52,7 +52,7 @@
       ;; invite internal user without complaints
       (th/reset-mock! mock)
       (let [data (assoc data :email (:email profile2))
-            out  (th/mutation! data)]
+            out  (th/command! data)]
         (t/is (th/success? out))
         (t/is (= 1 (:call-count (deref mock)))))
 
@@ -60,7 +60,7 @@
       (th/create-global-complaint-for pool {:type :complaint :email "foo@bar.com"})
       (th/reset-mock! mock)
       (let [data (assoc data :email "foo@bar.com")
-            out  (th/mutation! data)]
+            out  (th/command! data)]
         (t/is (th/success? out))
         (t/is (= 1 (:call-count (deref mock)))))
 
@@ -79,7 +79,7 @@
 
       (th/create-global-complaint-for pool {:type :bounce :email "foo@bar.com"})
       (let [data  (assoc data :email "foo@bar.com")
-            out   (th/mutation! data)]
+            out   (th/command! data)]
 
         (t/is (not (th/success? out)))
         (t/is (= 0 (:call-count @mock)))
@@ -92,7 +92,7 @@
       (th/reset-mock! mock)
 
       (let [data  (assoc data :email (:email profile3))
-            out   (th/mutation! data)]
+            out   (th/command! data)]
 
         (t/is (not (th/success? out)))
         (t/is (= 0 (:call-count @mock)))
@@ -115,12 +115,12 @@
           pool     (:app.db/pool th/*system*)]
 
       ;; Try to invite a not existing user
-      (let [data {::th/type :invite-team-member
+      (let [data {::th/type :create-team-invitations
+                  ::rpc/profile-id (:id profile1)
                   :email "notexisting@example.com"
                   :team-id (:id team)
-                  :role :editor
-                  :profile-id (:id profile1)}
-            out  (th/mutation! data)]
+                  :role :editor}
+            out  (th/command! data)]
 
         ;; (th/print-result! out)
         (t/is (th/success? out))
@@ -139,12 +139,12 @@
       (th/reset-mock! mock)
 
       ;; Try to invite existing user
-      (let [data {::th/type :invite-team-member
+      (let [data {::th/type :create-team-invitations
+                  ::rpc/profile-id (:id profile1)
                   :email (:email profile2)
                   :team-id (:id team)
-                  :role :editor
-                  :profile-id (:id profile1)}
-            out  (th/mutation! data)]
+                  :role :editor}
+            out  (th/command! data)]
 
         ;; (th/print-result! out)
         (t/is (th/success? out))
@@ -215,7 +215,9 @@
                    :role "editor"
                    :valid-until (dt/in-future "48h")})
 
-      (let [data {::th/type :verify-token :token token ::rpc/profile-id (:id profile2)}
+      (let [data {::th/type :verify-token
+                  ::rpc/profile-id (:id profile2)
+                  :token token}
             out  (th/command! data)]
         ;; (th/print-result! out)
         (t/is (th/success? out))
@@ -236,7 +238,9 @@
                    :role "editor"
                    :valid-until (dt/in-future "48h")})
 
-      (let [data {::th/type :verify-token :token token ::rpc/profile-id (:id profile1)}
+      (let [data {::th/type :verify-token
+                  ::rpc/profile-id (:id profile1)
+                  :token token}
             out  (th/command! data)]
         ;; (th/print-result! out)
         (t/is (not (th/success? out)))
@@ -246,7 +250,7 @@
 
       )))
 
-(t/deftest invite-team-member-with-email-verification-disabled
+(t/deftest create-team-invitations-with-email-verification-disabled
   (with-mocks [mock {:target 'app.emails/send! :return nil}]
     (let [profile1 (th/create-profile* 1 {:is-active true})
           profile2 (th/create-profile* 2 {:is-active true})
@@ -255,16 +259,16 @@
           team     (th/create-team* 1 {:profile-id (:id profile1)})
 
           pool     (:app.db/pool th/*system*)
-          data     {::th/type :invite-team-member
+          data     {::th/type :create-team-invitations
+                    ::rpc/profile-id (:id profile1)
                     :team-id (:id team)
-                    :role :editor
-                    :profile-id (:id profile1)}]
+                    :role :editor}]
 
       ;; invite internal user without complaints
       (with-redefs [app.config/flags #{}]
         (th/reset-mock! mock)
         (let [data (assoc data :email (:email profile2))
-              out  (th/mutation! data)]
+              out  (th/command! data)]
           (t/is (th/success? out))
           (t/is (= 0 (:call-count (deref mock)))))
 
@@ -279,8 +283,8 @@
         team     (th/create-team* 1 {:profile-id (:id profile1)})
         pool     (:app.db/pool th/*system*)
         data     {::th/type :delete-team
-                  :team-id (:id team)
-                  :profile-id (:id profile1)}]
+                  ::rpc/profile-id (:id profile1)
+                  :team-id (:id team)}]
 
     ;; team is not deleted because it does not meet all
     ;; conditions to be deleted.
@@ -288,9 +292,9 @@
       (t/is (= 0 (:processed result))))
 
     ;; query the list of teams
-    (let [data {::th/type :teams
-                :profile-id (:id profile1)}
-          out  (th/query! data)]
+    (let [data {::th/type :get-teams
+                ::rpc/profile-id (:id profile1)}
+          out  (th/command! data)]
       ;; (th/print-result! out)
       (t/is (th/success? out))
       (let [result (:result out)]
@@ -300,15 +304,15 @@
 
     ;; Request team to be deleted
     (let [params {::th/type :delete-team
-                  :id (:id team)
-                  :profile-id (:id profile1)}
-          out    (th/mutation! params)]
+                  ::rpc/profile-id (:id profile1)
+                  :id (:id team)}
+          out    (th/command! params)]
       (t/is (th/success? out)))
 
     ;; query the list of teams after soft deletion
-    (let [data {::th/type :teams
-                :profile-id (:id profile1)}
-          out  (th/query! data)]
+    (let [data {::th/type :get-teams
+                ::rpc/profile-id (:id profile1)}
+          out  (th/command! data)]
       ;; (th/print-result! out)
       (t/is (th/success? out))
       (let [result (:result out)]
@@ -321,8 +325,8 @@
 
     ;; query the list of projects after hard deletion
     (let [data {::th/type :projects
-                :team-id (:id team)
-                :profile-id (:id profile1)}
+                :profile-id (:id profile1)
+                :team-id (:id team)}
           out  (th/query! data)]
       ;; (th/print-result! out)
       (t/is (not (th/success? out)))
@@ -335,8 +339,8 @@
 
     ;; query the list of projects of a after hard deletion
     (let [data {::th/type :projects
-                :team-id (:id team)
-                :profile-id (:id profile1)}
+                :profile-id (:id profile1)
+                :team-id (:id team)}
           out  (th/query! data)]
       ;; (th/print-result! out)
 
@@ -348,8 +352,8 @@
 (t/deftest query-team-invitations
   (let [prof (th/create-profile* 1 {:is-active true})
         team (th/create-team* 1 {:profile-id (:id prof)})
-        data {::th/type :team-invitations
-              :profile-id (:id prof)
+        data {::th/type :get-team-invitations
+              ::rpc/profile-id (:id prof)
               :team-id (:id team)}]
 
     ;; insert an entry on the database with an enabled invitation
@@ -366,7 +370,7 @@
                  :role "editor"
                  :valid-until (dt/in-past "48h")})
 
-    (let [out (th/query! data)]
+    (let [out (th/command! data)]
       (t/is (th/success? out))
       (let [result (:result out)
             one    (first result)
@@ -381,7 +385,7 @@
   (let [prof (th/create-profile* 1 {:is-active true})
         team (th/create-team* 1 {:profile-id (:id prof)})
         data {::th/type :update-team-invitation-role
-              :profile-id (:id prof)
+              ::rpc/profile-id (:id prof)
               :team-id (:id team)
               :email "TEST1@mail.com"
               :role :admin}]
@@ -393,7 +397,7 @@
                  :role "editor"
                  :valid-until (dt/in-future "48h")})
 
-    (let [out (th/mutation! data)
+    (let [out (th/command! data)
           ;; retrieve the value from the database and check its content
           res (db/get* th/*pool* :team-invitation
                        {:team-id (:team-id data) :email-to "test1@mail.com"})]
@@ -405,7 +409,7 @@
   (let [prof (th/create-profile* 1 {:is-active true})
         team (th/create-team* 1 {:profile-id (:id prof)})
         data {::th/type :delete-team-invitation
-              :profile-id (:id prof)
+              ::rpc/profile-id (:id prof)
               :team-id (:id team)
               :email "TEST1@mail.com"}]
 
@@ -416,7 +420,7 @@
                  :role "editor"
                  :valid-until (dt/in-future "48h")})
 
-    (let [out (th/mutation! data)
+    (let [out (th/command! data)
           ;; retrieve the value from the database and check its content
           res (db/get* th/*pool* :team-invitation
                        {:team-id (:team-id data) :email-to "test1@mail.com"})]

common/deps.edn

@@ -1,8 +1,8 @@
 {:deps
  {org.clojure/clojure {:mvn/version "1.11.1"}
   org.clojure/data.json {:mvn/version "2.4.0"}
-  org.clojure/tools.cli {:mvn/version "1.0.206"}
-  metosin/jsonista {:mvn/version "0.3.6"}
+  org.clojure/tools.cli {:mvn/version "1.0.214"}
+  metosin/jsonista {:mvn/version "0.3.7"}
   org.clojure/clojurescript {:mvn/version "1.11.60"}
   org.clojure/test.check {:mvn/version "1.1.1"}
 
@@ -23,7 +23,7 @@
   com.cognitect/transit-cljs {:mvn/version "0.8.280"}
   java-http-clj/java-http-clj {:mvn/version "0.4.3"}
 
-  funcool/promesa {:mvn/version "10.0.571"}
+  funcool/promesa {:mvn/version "10.0.594"}
   funcool/cuerdas {:mvn/version "2022.06.16-403"}
 
   lambdaisland/uri {:mvn/version "1.13.95"
@@ -37,21 +37,22 @@
 
   ;; exception printing
   fipp/fipp {:mvn/version "0.6.26"}
-  io.aviso/pretty {:mvn/version "1.1.1"}
+  io.aviso/pretty {:mvn/version "1.3"}
   environ/environ {:mvn/version "1.2.0"}}
  :paths ["src" "target/classes"]
  :aliases
  {:dev
   {:extra-deps
    {org.clojure/tools.namespace {:mvn/version "RELEASE"}
-    thheller/shadow-cljs {:mvn/version "2.20.2"}
+    thheller/shadow-cljs {:mvn/version "2.20.16"}
     com.bhauman/rebel-readline {:mvn/version "RELEASE"}
     criterium/criterium {:mvn/version "RELEASE"}
     mockery/mockery {:mvn/version "RELEASE"}}
    :extra-paths ["test" "dev"]}
 
   :build
-  {:extra-deps {io.github.clojure/tools.build {:git/tag "v0.8.3" :git/sha "0d20256"}}
+  {:extra-deps
+   {io.github.clojure/tools.build {:git/tag "v0.9.0" :git/sha "8c93e0c"}}
    :ns-default build}
 
   :test

common/package.json

@@ -4,7 +4,7 @@
   "main": "index.js",
   "license": "MPL-2.0",
   "dependencies": {
-    "luxon": "^1.27.0"
+    "luxon": "^3.1.1"
   },
   "scripts": {
     "compile-and-watch-test": "clojure -M:dev:shadow-cljs watch test",
@@ -13,8 +13,8 @@
     "test": "yarn run compile-test && yarn run run-test"
   },
   "devDependencies": {
-    "shadow-cljs": "2.19.8",
-    "source-map-support": "^0.5.19",
-    "ws": "^7.4.6"
+    "shadow-cljs": "2.20.16",
+    "source-map-support": "^0.5.21",
+    "ws": "^8.11.0"
   }
 }

common/src/app/common/exceptions.cljc

@@ -16,7 +16,7 @@
 
 (defmacro error
   [& {:keys [type hint] :as params}]
-  `(ex-info ~(or hint (pr-str type))
+  `(ex-info ~(or hint (name type))
             (merge
              ~(dissoc params :cause ::data)
              ~(::data params))
@@ -89,9 +89,9 @@
           (contains? data :explain))
      (explain (:explain data) opts)
 
-     (and (::s/problems data)
-          (::s/value data)
-          (::s/spec data))
+     (and (contains? data ::s/problems)
+          (contains? data ::s/value)
+          (contains? data ::s/spec))
      (binding [s/*explain-out* expound/printer]
        (with-out-str
          (s/explain-out (update data ::s/problems #(take max-problems %))))))))

common/src/app/common/file_builder.cljc

@@ -44,7 +44,12 @@
    (let [component-id (:current-component-id file)
          change (cond-> change
                   (and add-container? (some? component-id))
-                  (assoc :component-id component-id)
+                  (cond->
+                   :always
+                    (assoc :component-id component-id)
+
+                    (some? (:current-frame-id file))
+                    (assoc :frame-id (:current-frame-id file)))
 
                   (and add-container? (nil? component-id))
                   (assoc :page-id  (:current-page-id file)
@@ -223,7 +228,6 @@
       (clear-names)))
 
 (defn add-artboard [file data]
-  (assert (nil? (:current-component-id file)))
   (let [obj (-> (cts/make-minimal-shape :frame)
                 (merge data)
                 (check-name file :frame)
@@ -237,11 +241,11 @@
         (update :parent-stack conjv (:id obj)))))
 
 (defn close-artboard [file]
-  (assert (nil? (:current-component-id file)))
-
   (let [parent-id (-> file :parent-id peek)
         parent (lookup-shape file parent-id)
-        current-frame-id (or (:frame-id parent) root-frame)]
+        current-frame-id (or (:frame-id parent)
+                             (when (nil? (:current-component-id file))
+                               root-frame))]
     (-> file
         (assoc :current-frame-id current-frame-id)
         (update :parent-stack pop))))
@@ -561,35 +565,37 @@
           :id id}))))
 
 (defn start-component
-  [file data]
+  ([file data] (start-component file data :group))
+  ([file data root-type]
+   (let [selrect (or (gsh/make-selrect (:x data) (:y data) (:width data) (:height data))
+                     cts/empty-selrect)
+         name               (:name data)
+         path               (:path data)
+         main-instance-id   (:main-instance-id data)
+         main-instance-page (:main-instance-page data)
+         obj (-> (cts/make-shape root-type selrect data)
+                 (dissoc :path
+                         :main-instance-id
+                         :main-instance-page
+                         :main-instance-x
+                         :main-instance-y)
+                 (check-name file root-type)
+                 (d/without-nils))]
+     (-> file
+         (commit-change
+          {:type :add-component
+           :id (:id obj)
+           :name name
+           :path path
+           :main-instance-id main-instance-id
+           :main-instance-page main-instance-page
+           :shapes [obj]})
 
-  (let [selrect cts/empty-selrect
-        name               (:name data)
-        path               (:path data)
-        main-instance-id   (:main-instance-id data)
-        main-instance-page (:main-instance-page data)
-        obj (-> (cts/make-minimal-group nil selrect name)
-                (merge data)
-                (dissoc :path
-                        :main-instance-id
-                        :main-instance-page
-                        :main-instance-x
-                        :main-instance-y)
-                (check-name file :group)
-                (d/without-nils))]
-    (-> file
-        (commit-change
-         {:type :add-component
-          :id (:id obj)
-          :name name
-          :path path
-          :main-instance-id main-instance-id
-          :main-instance-page main-instance-page
-          :shapes [obj]})
-
-        (assoc :last-id (:id obj))
-        (update :parent-stack conjv (:id obj))
-        (assoc :current-component-id (:id obj)))))
+         (assoc :last-id (:id obj))
+         (update :parent-stack conjv (:id obj))
+         (assoc :current-component-id (:id obj))
+         (assoc :current-frame-id (when (= (:type obj) :frame)
+                                    (:id obj)))))))
 
 (defn finish-component
   [file]
@@ -624,7 +630,7 @@
 
              {:add-container? true}))
 
-          :else
+          (= (:type component) :group)
           (let [component' (gsh/update-group-selrect component children)]
             (commit-change
              file
@@ -637,11 +643,13 @@
                {:type :set :attr :y      :val (-> component' :selrect :y) :ignore-touched true}
                {:type :set :attr :width  :val (-> component' :selrect :width) :ignore-touched true}
                {:type :set :attr :height :val (-> component' :selrect :height) :ignore-touched true}]}
+             {:add-container? true}))
 
-             {:add-container? true})))]
+          :else file)]
 
     (-> file
         (dissoc :current-component-id)
+        (dissoc :current-frame-id)
         (update :parent-stack pop))))
 
 (defn finish-deleted-component
@@ -700,7 +708,7 @@
                                      (gpt/point x
                                                 y)
                                      #_{:main-instance? true
-                                      :force-id main-instance-id})]
+                                        :force-id main-instance-id})]
 
     (as-> file $
       (reduce #(commit-change %1

common/src/app/common/geom/matrix.cljc

@@ -19,7 +19,6 @@
 (def precision 6)
 
 ;; --- Matrix Impl
-
 (defrecord Matrix [^double a
                    ^double b
                    ^double c
@@ -28,13 +27,13 @@
                    ^double f]
   Object
   (toString [_]
-    (str "matrix("
-         (mth/precision a precision) ","
-         (mth/precision b precision) ","
-         (mth/precision c precision) ","
-         (mth/precision d precision) ","
-         (mth/precision e precision) ","
-         (mth/precision f precision) ")")))
+    (dm/fmt "matrix(%, %, %, %, %, %)"
+      (mth/to-fixed a precision)
+      (mth/to-fixed b precision)
+      (mth/to-fixed c precision)
+      (mth/to-fixed d precision)
+      (mth/to-fixed e precision)
+      (mth/to-fixed f precision))))
 
 (defn matrix?
   "Return true if `v` is Matrix instance."

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]
@@ -59,10 +60,10 @@
      (point v v)
 
      (point-like? v)
-     (map->Point v)
+     (Point. (:x v) (:y v))
 
      :else
-     (throw (ex-info "Invalid arguments" {:v v}))))
+     (ex/raise :hint "invalid arguments (on pointer constructor)" :value v)))
   ([x y]
    (Point. x y)))
 
@@ -169,8 +170,7 @@
               (dm/get-prop p2 :x))
         dy (- (dm/get-prop p1 :y)
               (dm/get-prop p2 :y))]
-    (mth/sqrt (+ (mth/pow dx 2)
-                 (mth/pow dy 2)))))
+    (mth/hypot dx dy)))
 
 (defn distance-vector
   "Calculate the distance, separated x and y."
@@ -190,8 +190,7 @@
   (assert (point? pt) "point instance expected")
   (let [x (dm/get-prop pt :x)
         y (dm/get-prop pt :y)]
-    (mth/sqrt (+ (mth/pow x 2)
-                 (mth/pow y 2)))))
+    (mth/hypot x y)))
 
 (defn angle
   "Returns the smaller angle between two vectors.
@@ -275,12 +274,12 @@
    (Point. (mth/precision (dm/get-prop pt :x) decimals)
            (mth/precision (dm/get-prop pt :y) decimals))))
 
-(defn half-round
+(defn round-step
   "Round the coordinates to the closest half-point"
-  [pt]
+  [pt step]
   (assert (point? pt) "expected point instance")
-  (Point. (mth/half-round (dm/get-prop pt :x))
-          (mth/half-round (dm/get-prop pt :y))))
+  (Point. (mth/round (dm/get-prop pt :x) step)
+          (mth/round (dm/get-prop pt :y) step)))
 
 (defn transform
   "Transform a point applying a matrix transformation."

common/src/app/common/geom/shapes.cljc

@@ -82,24 +82,12 @@
          (update :height (comp inc inc))))))
 
 (defn selrect->areas [bounds selrect]
-  (let [make-selrect
-        (fn [x1 y1 x2 y2]
-          (let [x1 (min x1 x2)
-                x2 (max x1 x2)
-                y1 (min y1 y2)
-                y2 (max y1 y2)]
-            {:x1 x1 :y1 y1
-             :x2 x2 :y2 y2
-             :x x1  :y y1
-             :width (- x2 x1)
-             :height (- y2 y1)
-             :type :rect}))
-        {bound-x1 :x1 bound-x2 :x2 bound-y1 :y1 bound-y2 :y2} bounds
+  (let [{bound-x1 :x1 bound-x2 :x2 bound-y1 :y1 bound-y2 :y2} bounds
         {sr-x1 :x1 sr-x2 :x2 sr-y1 :y1 sr-y2 :y2} selrect]
-    {:left   (make-selrect bound-x1 sr-y1 sr-x1 sr-y2)
-     :top    (make-selrect sr-x1 bound-y1 sr-x2 sr-y1)
-     :right  (make-selrect sr-x2 sr-y1 bound-x2 sr-y2)
-     :bottom (make-selrect sr-x1 sr-y2 sr-x2 bound-y2)}))
+    {:left (gpr/corners->selrect bound-x1 sr-y1 sr-x1 sr-y2)
+     :top    (gpr/corners->selrect sr-x1 bound-y1 sr-x2 sr-y1)
+     :right  (gpr/corners->selrect sr-x2 sr-y1 bound-x2 sr-y2)
+     :bottom (gpr/corners->selrect sr-x1 sr-y2 sr-x2 bound-y2)}))
 
 (defn distance-selrect [selrect other]
   (let [{:keys [x1 y1]} other
@@ -161,6 +149,7 @@
 (dm/export gpr/contains-selrect?)
 (dm/export gpr/contains-point?)
 (dm/export gpr/close-selrect?)
+(dm/export gpr/clip-selrect)
 
 (dm/export gtr/move)
 (dm/export gtr/absolute-move)
@@ -194,7 +183,6 @@
 (dm/export gsi/rect-contains-shape?)
 
 ;; Bool
-
 (dm/export gsb/calc-bool-content)
 
 ;; Constraints
@@ -207,4 +195,3 @@
 
 ;; Modifiers
 (dm/export gsm/set-objects-modifiers)
-

common/src/app/common/geom/shapes/constraints.cljc

@@ -146,10 +146,13 @@
   ((if (= :x axis) center-horizontal-vector center-vertical-vector) child-points parent-points))
 
 (defn displacement
-  [before-v after-v]
-  (let [angl (gpt/angle-with-other before-v after-v)
-        sign (if (mth/close? angl 180) -1 1)
+  [before-v after-v before-parent-side-v after-parent-side-v]
+
+  (let [before-angl (gpt/angle-with-other before-v before-parent-side-v)
+        after-angl (gpt/angle-with-other after-v after-parent-side-v)
+        sign (if (mth/close? before-angl after-angl) 1 -1)
         length (* sign (gpt/length before-v))]
+
     (if (mth/almost-zero? length)
       after-v
       (gpt/subtract after-v (gpt/scale (gpt/unit after-v) length)))))
@@ -173,14 +176,18 @@
 (defmethod constraint-modifier :start
   [_ axis child-points-before parent-points-before child-points-after parent-points-after]
   (let [start-before (start-vector axis child-points-before parent-points-before)
-        start-after  (start-vector axis child-points-after parent-points-after)]
-    (ctm/move-modifiers (displacement start-before start-after))))
+        start-after  (start-vector axis child-points-after parent-points-after)
+        before-side-vector (side-vector axis parent-points-before)
+        after-side-vector (side-vector axis parent-points-after)]
+    (ctm/move-modifiers (displacement start-before start-after before-side-vector after-side-vector))))
 
 (defmethod constraint-modifier :end
   [_ axis child-points-before parent-points-before child-points-after parent-points-after]
   (let [end-before  (end-vector axis child-points-before parent-points-before)
-        end-after   (end-vector axis child-points-after parent-points-after)]
-    (ctm/move-modifiers (displacement end-before end-after))))
+        end-after   (end-vector axis child-points-after parent-points-after)
+        before-side-vector (side-vector axis parent-points-before)
+        after-side-vector (side-vector axis parent-points-after)]
+    (ctm/move-modifiers (displacement end-before end-after before-side-vector after-side-vector))))
 
 (defmethod constraint-modifier :fixed
   [_ axis child-points-before parent-points-before child-points-after parent-points-after]
@@ -190,8 +197,11 @@
         start-before (start-vector axis child-points-before parent-points-before)
         start-after  (start-vector axis child-points-after parent-points-after)
 
-        disp-end     (displacement end-before end-after)
-        disp-start   (displacement start-before start-after)
+        before-side-vector (side-vector axis parent-points-before)
+        after-side-vector (side-vector axis parent-points-after)
+
+        disp-end     (displacement end-before end-after before-side-vector after-side-vector)
+        disp-start   (displacement start-before start-after before-side-vector after-side-vector)
 
         ;; We get the current axis side and grow it on both side by the end+start displacements
         before-vec   (side-vector axis child-points-after)
@@ -214,8 +224,10 @@
 (defmethod constraint-modifier :center
   [_ axis child-points-before parent-points-before child-points-after parent-points-after]
   (let [center-before  (center-vector axis child-points-before parent-points-before)
-        center-after   (center-vector axis child-points-after parent-points-after)]
-    (ctm/move-modifiers (displacement center-before center-after))))
+        center-after   (center-vector axis child-points-after parent-points-after)
+        before-side-vector (side-vector axis parent-points-before)
+        after-side-vector (side-vector axis parent-points-after)]
+    (ctm/move-modifiers (displacement center-before center-after before-side-vector after-side-vector))))
 
 (defmethod constraint-modifier :default [_ _ _ _ _]
   [])

common/src/app/common/geom/shapes/flex_layout.cljc

@@ -13,9 +13,10 @@
    [app.common.geom.shapes.flex-layout.modifiers :as fmo]))
 
 (dm/export fbo/layout-content-bounds)
+(dm/export fbo/layout-content-points)
 (dm/export fbo/child-layout-bound-points)
 (dm/export fdr/get-drop-index)
-(dm/export fdr/layout-drop-areas)
+(dm/export fdr/get-drop-areas)
 (dm/export fli/calc-layout-data)
 (dm/export fmo/layout-child-modifiers)
 

common/src/app/common/geom/shapes/flex_layout/bounds.cljc

@@ -6,6 +6,7 @@
 
 (ns app.common.geom.shapes.flex-layout.bounds
   (:require
+   [app.common.data :as d]
    [app.common.geom.point :as gpt]
    [app.common.geom.shapes.points :as gpo]
    [app.common.types.shape.layout :as ctl]))
@@ -27,16 +28,19 @@
         h-center? (ctl/h-center? parent)
         h-end? (ctl/h-end? parent)
 
+        fill-w? (ctl/fill-width? child)
+        fill-h? (ctl/fill-height? child)
+
         base-p (gpo/origin child-bounds)
 
         width (gpo/width-points child-bounds)
         height (gpo/height-points child-bounds)
 
-        min-width (if (ctl/fill-width? child)
+        min-width (if fill-w?
                     (ctl/child-min-width child)
                     width)
 
-        min-height (if (ctl/fill-height? child)
+        min-height (if fill-h?
                      (ctl/child-min-height child)
                      height)
 
@@ -60,26 +64,49 @@
         min-width (max min-width 0.01)
         min-height (max min-height 0.01)]
 
-    (-> [base-p]
-        (conj (cond-> base-p
-                (or row? h-start?)
-                (gpt/add (hv min-width))
+    (cond-> [base-p]
+      (or col? h-start?)
+      (conj (gpt/add base-p (hv min-width)))
 
-                (and col? h-center?)
-                (gpt/add (hv (/ min-width 2)))
+      (and col? h-center?)
+      (conj (gpt/add base-p (hv (/ min-width 2))))
 
-                (and col? h-center?)
-                (gpt/subtract (hv min-width))))
+      (and col? h-center?)
+      (conj (gpt/subtract base-p (hv min-width)))
 
-        (conj (cond-> base-p
-                (or col? v-start?)
-                (gpt/add (vv min-height))
+      (or row? v-start?)
+      (conj (gpt/add base-p (vv min-height)))
 
-                (and row? v-center?)
-                (gpt/add (vv (/ min-height 2)))
+      (and row? v-center?)
+      (conj (gpt/add base-p (vv (/ min-height 2))))
 
-                (and row? v-end?)
-                (gpt/subtract (vv min-height)))))))
+      (and row? v-end?)
+      (conj (gpt/subtract base-p (vv min-height))))))
+
+(defn layout-content-points
+  [bounds parent children]
+
+  (let [parent-id (:id parent)
+        parent-bounds @(get bounds parent-id)
+        get-child-bounds
+        (fn [child]
+          (let [child-id (:id child)
+                child-bounds  @(get bounds child-id)
+                [margin-top margin-right margin-bottom margin-left] (ctl/child-margins child)
+
+                child-bounds
+                (if (or (ctl/fill-width? child) (ctl/fill-height? child))
+                  (child-layout-bound-points parent child parent-bounds child-bounds)
+                  child-bounds)
+
+                child-bounds
+                (when (d/not-empty? child-bounds)
+                  (-> (gpo/parent-coords-bounds child-bounds parent-bounds)
+                      (gpo/pad-points (- margin-top) (- margin-right) (- margin-bottom) (- margin-left))))]
+
+            child-bounds))]
+
+    (->> children (map get-child-bounds))))
 
 (defn layout-content-bounds
   [bounds {:keys [layout-padding] :as parent} children]
@@ -87,27 +114,34 @@
   (let [parent-id (:id parent)
         parent-bounds @(get bounds parent-id)
 
+        row?            (ctl/row? parent)
+        col?            (ctl/col? parent)
+        space-around?   (ctl/space-around? parent)
+        content-around? (ctl/content-around? parent)
+        [layout-gap-row layout-gap-col] (ctl/gaps parent)
+
+        row-pad (if (or (and col? space-around?)
+                        (and row? content-around?))
+                  layout-gap-row
+                  0)
+
+        col-pad (if (or(and row? space-around?)
+                       (and col? content-around?))
+                  layout-gap-col
+                  0)
+
         {pad-top :p1 pad-right :p2 pad-bottom :p3 pad-left :p4} layout-padding
-        pad-top    (or pad-top 0)
-        pad-right  (or pad-right 0)
-        pad-bottom (or pad-bottom 0)
-        pad-left   (or pad-left 0)
+        pad-top    (+ (or pad-top 0) row-pad)
+        pad-right  (+ (or pad-right 0) col-pad)
+        pad-bottom (+ (or pad-bottom 0) row-pad)
+        pad-left   (+ (or pad-left 0) col-pad)
 
-        child-bounds
-        (fn [child]
-          (let [child-id (:id child)
-                child-bounds  @(get bounds child-id)
-                child-bounds
-                (if (or (ctl/fill-height? child) (ctl/fill-height? child))
-                  (child-layout-bound-points parent child parent-bounds child-bounds)
-                  child-bounds)
-
-                [margin-top margin-right margin-bottom margin-left] (ctl/child-margins child)]
-            (-> (gpo/parent-coords-bounds child-bounds parent-bounds)
-                (gpo/pad-points (- margin-top) (- margin-right) (- margin-bottom) (- margin-left)))))]
-
-    (as-> children $
-      (map child-bounds $)
-      (gpo/merge-parent-coords-bounds $ parent-bounds)
-      (gpo/pad-points $ (- pad-top) (- pad-right) (- pad-bottom) (- pad-left)))))
+        layout-points
+        (layout-content-points bounds parent children)]
 
+    (if (d/not-empty? layout-points)
+      (-> layout-points
+          (gpo/merge-parent-coords-bounds parent-bounds)
+          (gpo/pad-points (- pad-top) (- pad-right) (- pad-bottom) (- pad-left)))
+      ;; Cannot create some bounds from the children so we return the parent's
+      parent-bounds)))

common/src/app/common/geom/shapes/flex_layout/drop_area.cljc

@@ -8,11 +8,14 @@
   (:require
    [app.common.data :as d]
    [app.common.geom.matrix :as gmt]
+   [app.common.geom.point :as gpt]
    [app.common.geom.shapes.common :as gco]
    [app.common.geom.shapes.flex-layout.lines :as fli]
    [app.common.geom.shapes.points :as gpo]
    [app.common.geom.shapes.rect :as gsr]
+   [app.common.geom.shapes.transforms :as gtr]
    [app.common.pages.helpers :as cph]
+   [app.common.types.modifiers :as ctm]
    [app.common.types.shape.layout :as ctl]))
 
 (defn drop-child-areas
@@ -41,7 +44,7 @@
           (:width parent-rect)
 
           :else
-          (+ box-width (- box-x prev-x) (/ layout-gap-row 2)))
+          (+ box-width (- box-x prev-x) (/ layout-gap-col 2)))
 
         height
         (cond
@@ -52,7 +55,7 @@
           (:height parent-rect)
 
           :else
-          (+ box-height (- box-y prev-y) (/ layout-gap-col 2)))]
+          (+ box-height (- box-y prev-y) (/ layout-gap-row 2)))]
 
     (if row?
       (let [half-point-width (+ (- box-x x) (/ box-width 2))]
@@ -87,14 +90,14 @@
         (if row?
           (:width frame)
           (+ line-width margin-x
-             (if row? (* layout-gap-row (dec num-children)) 0)))
+             (if row? (* layout-gap-col (dec num-children)) 0)))
 
         line-height
         (if col?
           (:height frame)
           (+ line-height margin-y
              (if col?
-               (* layout-gap-col (dec num-children))
+               (* layout-gap-row (dec num-children))
                0)))
 
         box-x
@@ -122,7 +125,7 @@
                 (:width frame)
 
                 :else
-                (+ line-width (- box-x prev-x) (/ layout-gap-row 2)))
+                (+ line-width (- box-x prev-x) (/ layout-gap-col 2)))
 
         height (cond
                  (and row? last?)
@@ -132,7 +135,7 @@
                  (:height frame)
 
                  :else
-                 (+ line-height (- box-y prev-y) (/ layout-gap-col 2)))]
+                 (+ line-height (- box-y prev-y) (/ layout-gap-row 2)))]
     (gsr/make-rect x y width height)))
 
 (defn layout-drop-areas
@@ -179,13 +182,36 @@
                  (+ (:y line-area) (:height line-area))
                  (rest lines)))))))
 
+(defn get-flip-modifiers
+  [{:keys [flip-x flip-y transform transform-inverse] :as shape}]
+
+  (if (or flip-x flip-y)
+    (let [modifiers
+          (-> (ctm/empty)
+              (ctm/resize (gpt/point (if flip-x -1.0 1.0)
+                                     (if flip-y -1.0 1.0))
+                          (gco/center-shape shape)
+                          transform
+                          transform-inverse))]
+      [(gtr/transform-shape shape modifiers) modifiers])
+    [shape nil]))
+
+(defn get-drop-areas
+  [frame objects]
+  (let [[frame modifiers] (get-flip-modifiers frame)
+        children    (->> (cph/get-immediate-children objects (:id frame))
+                         (remove :hidden)
+                         (map #(cond-> % (some? modifiers)
+                                       (gtr/transform-shape modifiers)))
+                         (map #(vector (gpo/parent-coords-bounds (:points %) (:points frame)) %)))
+        layout-data (fli/calc-layout-data frame children (:points frame))
+        drop-areas  (layout-drop-areas frame layout-data children)]
+    drop-areas))
+
 (defn get-drop-index
   [frame-id objects position]
   (let [frame       (get objects frame-id)
+        drop-areas  (get-drop-areas frame objects)
         position    (gmt/transform-point-center position (gco/center-shape frame) (:transform-inverse frame))
-        children    (->> (cph/get-immediate-children objects frame-id)
-                         (map #(vector (gpo/parent-coords-bounds (:points %) (:points frame)) %)))
-        layout-data (fli/calc-layout-data frame children (:points frame))
-        drop-areas  (layout-drop-areas frame layout-data children)
         area        (d/seek #(gsr/contains-point? % position) drop-areas)]
     (:index area)))

common/src/app/common/geom/shapes/flex_layout/lines.cljc

@@ -26,6 +26,7 @@
 
   (let [col?  (ctl/col? shape)
         row?  (ctl/row? shape)
+        space-around?  (ctl/space-around? shape)
 
         wrap? (and (ctl/wrap? shape)
                    (or col? (not (ctl/auto-width? shape)))
@@ -77,8 +78,18 @@
               next-max-width   (+ child-margin-width (if fill-width? child-max-width child-width))
               next-max-height  (+ child-margin-height (if fill-height? child-max-height child-height))
 
-              next-line-min-width  (+ line-min-width  next-min-width  (* layout-gap-row num-children))
-              next-line-min-height (+ line-min-height next-min-height (* layout-gap-col num-children))]
+              total-gap-col (if space-around?
+                              (* layout-gap-col (+ num-children 2))
+                              (* layout-gap-col num-children))
+
+              total-gap-row (if space-around?
+                              (* layout-gap-row (+ num-children 2))
+                              (* layout-gap-row num-children))
+
+              next-line-min-width  (+ line-min-width  next-min-width  total-gap-col)
+              next-line-min-height (+ line-min-height next-min-height total-gap-row)
+
+              ]
 
           (if (and (some? line-data)
                    (or (not wrap?)
@@ -141,6 +152,9 @@
 
   (let [row? (ctl/row? parent)
         col? (ctl/col? parent)
+        auto-width? (ctl/auto-width? parent)
+        auto-height? (ctl/auto-height? parent)
+        space-around? (ctl/space-around? parent)
 
         [layout-gap-row layout-gap-col] (ctl/gaps parent)
 
@@ -168,48 +182,61 @@
       (let [[total-min-width total-min-height total-max-width total-max-height]
             (->> layout-lines (reduce add-ranges [0 0 0 0]))
 
-            get-layout-width (fn [{:keys [num-children]}] (- layout-width (* layout-gap-row (dec num-children))))
-            get-layout-height (fn [{:keys [num-children]}] (- layout-height (* layout-gap-col (dec num-children))))
+            get-layout-width (fn [{:keys [num-children]}]
+                               (let [num-gap (if space-around? (inc num-children) (dec num-children))]
+                                 (- layout-width (* layout-gap-col num-gap))))
+            get-layout-height (fn [{:keys [num-children]}]
+                                (let [num-gap (if space-around? (inc num-children) (dec num-children))]
+                                  (- layout-height (* layout-gap-row num-gap))))
 
             num-lines (count layout-lines)
 
             ;; When align-items is stretch we need to adjust the main axis size to grow for the full content
             stretch-width-fix
-            (if (and col? (ctl/content-stretch? parent))
-              (/ (- layout-width (* layout-gap-row (dec num-lines)) total-max-width) num-lines)
+            (if (and col? (ctl/content-stretch? parent) (not auto-width?))
+              (/ (- layout-width (* layout-gap-col (dec num-lines)) total-max-width) num-lines)
               0)
 
             stretch-height-fix
-            (if (and row? (ctl/content-stretch? parent))
-              (/ (- layout-height (* layout-gap-col (dec num-lines)) total-max-height) num-lines)
+            (if (and row? (ctl/content-stretch? parent) (not auto-height?))
+              (/ (- layout-height (* layout-gap-row (dec num-lines)) total-max-height) num-lines)
               0)
 
+            rest-layout-height (- layout-height (* (dec num-lines) layout-gap-row))
+            rest-layout-width  (- layout-width (* (dec num-lines) layout-gap-col))
+
             ;; Distributes the space between the layout lines based on its max/min constraints
             layout-lines
             (cond->> layout-lines
               row?
-              (map #(assoc % :line-width (max (:line-min-width %) (min (get-layout-width %) (:line-max-width %)))))
+              (map #(assoc % :line-width
+                           (if (ctl/auto-width? parent)
+                             (:line-min-width %)
+                             (max (:line-min-width %) (min (get-layout-width %) (:line-max-width %))))))
 
               col?
-              (map #(assoc % :line-height (max (:line-min-height %) (min (get-layout-height %) (:line-max-height %)))))
+              (map #(assoc % :line-height
+                           (if (ctl/auto-height? parent)
+                             (:line-min-height %)
+                             (max (:line-min-height %) (min (get-layout-height %) (:line-max-height %))))))
 
-              (and row? (>= total-min-height layout-height))
+              (and row? (or (>= total-min-height rest-layout-height) (ctl/auto-height? parent)))
               (map #(assoc % :line-height (:line-min-height %)))
 
-              (and row? (<= total-max-height layout-height))
+              (and row? (<= total-max-height rest-layout-height) (not (ctl/auto-height? parent)))
               (map #(assoc % :line-height (+ (:line-max-height %) stretch-height-fix)))
 
-              (and row? (< total-min-height layout-height total-max-height))
-              (distribute-space :line-height :line-min-height :line-max-height total-min-height (- layout-height (* (dec num-lines) layout-gap-col)))
+              (and row? (< total-min-height rest-layout-height total-max-height) (not (ctl/auto-height? parent)))
+              (distribute-space :line-height :line-min-height :line-max-height total-min-height rest-layout-height)
 
-              (and col? (>= total-min-width layout-width))
+              (and col? (or (>= total-min-width rest-layout-width) (ctl/auto-width? parent)))
               (map #(assoc % :line-width (:line-min-width %)))
 
-              (and col? (<= total-max-width layout-width))
+              (and col? (<= total-max-width rest-layout-width) (not (ctl/auto-width? parent)))
               (map #(assoc % :line-width (+ (:line-max-width %) stretch-width-fix)))
 
-              (and col? (< total-min-width layout-width total-max-width))
-              (distribute-space :line-width :line-min-width :line-max-width total-min-width (- layout-width (* (dec num-lines) layout-gap-row))))
+              (and col? (< total-min-width rest-layout-width total-max-width) (not (ctl/auto-width? parent)))
+              (distribute-space :line-width :line-min-width :line-max-width total-min-width rest-layout-width))
 
             [total-width total-height] (->> layout-lines (reduce add-lines [0 0]))
 
@@ -226,40 +253,52 @@
 
         row?           (ctl/row? shape)
         col?           (ctl/col? shape)
+        auto-height?   (ctl/auto-height? shape)
+        auto-width?    (ctl/auto-width? shape)
         space-between? (ctl/space-between? shape)
         space-around?  (ctl/space-around? shape)
 
         [layout-gap-row layout-gap-col] (ctl/gaps shape)
 
-        layout-gap-row
+        margin-x
+        (cond (and row? space-around? (not auto-width?))
+              (max layout-gap-col (/ (- width line-width) (inc num-children)))
+
+              (and row? space-around? auto-width?)
+              layout-gap-col
+
+              :else
+              0)
+
+        margin-y
+        (cond (and col? space-around? (not auto-height?))
+              (max layout-gap-row (/ (- height line-height) (inc num-children)))
+
+              (and col? space-around? auto-height?)
+              layout-gap-row
+
+              :else
+              0)
+
+        layout-gap-col
         (cond (and row? space-around?)
               0
 
-              (and row? space-between?)
-              (/ (- width line-width) (dec num-children))
-
-              :else
-              layout-gap-row)
-
-        layout-gap-col
-        (cond (and col? space-around?)
-              0
-
-              (and col? space-between?)
-              (/ (- height line-height) (dec num-children))
+              (and row? space-between? (not auto-width?))
+              (max layout-gap-col (/ (- width line-width) (dec num-children)))
 
               :else
               layout-gap-col)
 
-        margin-x
-        (if (and row? space-around?)
-          (/ (- width line-width) (inc num-children))
-          0)
+        layout-gap-row
+        (cond (and col? space-around?)
+              0
 
-        margin-y
-        (if (and col? space-around?)
-          (/ (- height line-height) (inc num-children))
-          0)]
+              (and col? space-between? (not auto-height?))
+              (max layout-gap-row (/ (- height line-height) (dec num-children)))
+
+              :else
+              layout-gap-row)]
     (assoc line-data
            :layout-bounds layout-bounds
            :layout-gap-row layout-gap-row
@@ -308,4 +347,3 @@
     {:layout-lines layout-lines
      :layout-bounds layout-bounds
      :reverse? reverse?}))
-

common/src/app/common/geom/shapes/flex_layout/modifiers.cljc

@@ -68,7 +68,7 @@
         child-height (gpo/height-points child-bounds)
 
         [_ transform transform-inverse]
-        (when (or (ctl/fill-width? child) (ctl/fill-width? child))
+        (when (or (ctl/fill-width? child) (ctl/fill-height? child))
           (gtr/calculate-geometry @parent-bounds))
 
         fill-width   (when (ctl/fill-width? child)  (calc-fill-width-data parent transform transform-inverse child child-origin child-width layout-line))

common/src/app/common/geom/shapes/flex_layout/positions.cljc

@@ -29,8 +29,8 @@
         lines-gap-row (* (dec num-lines) layout-gap-row)
         lines-gap-col (* (dec num-lines) layout-gap-col)
 
-        free-width-gap (- layout-width total-width lines-gap-row)
-        free-height-gap (- layout-height total-height lines-gap-col)
+        free-width-gap (- layout-width total-width lines-gap-col)
+        free-height-gap (- layout-height total-height lines-gap-row)
         free-width (- layout-width total-width)
         free-height (- layout-height total-height)]
 
@@ -43,7 +43,7 @@
         (gpt/add (vv free-height-gap))
 
         around?
-        (gpt/add (vv (/ free-height (inc num-lines)))))
+        (gpt/add (vv (max lines-gap-row (/ free-height (inc num-lines))))))
 
       col?
       (cond-> center?
@@ -53,7 +53,7 @@
         (gpt/add (hv free-width-gap))
 
         around?
-        (gpt/add (hv (/ free-width (inc num-lines))))))))
+        (gpt/add (hv (max lines-gap-col (/ free-width (inc num-lines)))))))))
 
 (defn get-next-line
   [parent layout-bounds {:keys [line-width line-height]} base-p total-width total-height num-lines]
@@ -63,6 +63,9 @@
         row? (ctl/row? parent)
         col? (ctl/col? parent)
 
+        auto-width? (ctl/auto-width? parent)
+        auto-height? (ctl/auto-height? parent)
+
         [layout-gap-row layout-gap-col] (ctl/gaps parent)
 
         hv   #(gpo/start-hv layout-bounds %)
@@ -75,8 +78,11 @@
         free-width  (- layout-width total-width)
         free-height (- layout-height total-height)
 
-        line-gap-row
+        line-gap-col
         (cond
+          auto-width?
+          layout-gap-col
+
           stretch?
           (/ free-width num-lines)
 
@@ -87,10 +93,13 @@
           (/ free-width (inc num-lines))
 
           :else
-          layout-gap-row)
+          layout-gap-col)
 
-        line-gap-col
+        line-gap-row
         (cond
+          auto-height?
+          layout-gap-row
+
           stretch?
           (/ free-height num-lines)
 
@@ -101,14 +110,14 @@
           (/ free-height (inc num-lines))
 
           :else
-          layout-gap-col)]
+          layout-gap-row)]
 
     (cond-> base-p
       row?
-      (gpt/add (vv (+ line-height (max layout-gap-col line-gap-col))))
+      (gpt/add (vv (+ line-height (max layout-gap-row line-gap-row))))
 
       col?
-      (gpt/add (hv (+ line-width (max layout-gap-row line-gap-row)))))))
+      (gpt/add (hv (+ line-width (max layout-gap-col line-gap-col)))))))
 
 (defn get-start-line
   "Cross axis line. It's position is fixed along the different lines"
@@ -126,18 +135,20 @@
         v-center?           (ctl/v-center? parent)
         v-end?              (ctl/v-end? parent)
         content-stretch?    (ctl/content-stretch? parent)
+        auto-width?         (ctl/auto-width? parent)
+        auto-height?        (ctl/auto-height? parent)
         hv                  (partial gpo/start-hv layout-bounds)
         vv                  (partial gpo/start-vv layout-bounds)
-        children-gap-width  (* layout-gap-row (dec num-children))
-        children-gap-height (* layout-gap-col (dec num-children))
+        children-gap-width  (* layout-gap-col (dec num-children))
+        children-gap-height (* layout-gap-row (dec num-children))
 
         line-height
-        (if (and row? content-stretch?)
+        (if (and row? content-stretch? (not auto-height?))
           (+ line-height (/ (- layout-height total-height) num-lines))
           line-height)
 
         line-width
-        (if (and col? content-stretch?)
+        (if (and col? content-stretch? (not auto-width?))
           (+ line-width (/ (- layout-width total-width) num-lines))
           line-width)
 
@@ -257,13 +268,13 @@
         next-p
         (cond-> start-p
           row?
-          (-> (gpt/add (hv (+ child-width layout-gap-row)))
+          (-> (gpt/add (hv (+ child-width layout-gap-col)))
               (gpt/add (hv (+ margin-left margin-right))))
 
           col?
           (-> (gpt/add (vv (+ margin-top margin-bottom)))
-              (gpt/add (vv (+ child-height layout-gap-col))))
-          
+              (gpt/add (vv (+ child-height layout-gap-row))))
+
           (some? margin-x)
           (gpt/add (hv margin-x))
 

common/src/app/common/geom/shapes/intersect.cljc

@@ -363,10 +363,10 @@
         c2 (+ (* a2 (:x c)) (* b2 (:y c)))
 
         ;; Cramer's rule
-        det (- (* a1 b2) (* a2 b1))]
+        det (- (* a1 b2) (* a2 b1))
+        det (if (mth/almost-zero? det) 0.001 det)
 
-    ;; If almost zero the lines are parallel
-    (when (not (mth/almost-zero? det))
-      (let [x (/ (- (* b2 c1) (* b1 c2)) det)
-            y (/ (- (* c2 a1) (* c1 a2)) det)]
-        (gpt/point x y)))))
+        x (/ (- (* b2 c1) (* b1 c2)) det)
+        y (/ (- (* c2 a1) (* c1 a2)) det)]
+
+    (gpt/point x y)))

common/src/app/common/geom/shapes/modifiers.cljc

@@ -28,6 +28,16 @@
 ;;                           [(get-in objects [k :name]) v]))
 ;;                    modif-tree))))
 
+(defn children-sequence
+  "Given an id returns a sequence of its children"
+  [id objects]
+
+  (->> (tree-seq
+        #(d/not-empty? (dm/get-in objects [% :shapes]))
+        #(dm/get-in objects [% :shapes])
+        id)
+       (map #(get objects %))))
+
 (defn resolve-tree-sequence
   "Given the ids that have changed search for layout roots to recalculate"
   [ids objects]
@@ -75,20 +85,12 @@
 
                 (cond-> result
                   (not contains-parent?)
-                  (conj root)))))
-
-          (generate-tree ;; Generate a tree sequence from a given root id
-            [id]
-            (->> (tree-seq
-                  #(d/not-empty? (dm/get-in objects [% :shapes]))
-                  #(dm/get-in objects [% :shapes])
-                  id)
-                 (map #(get objects %))))]
+                  (conj root)))))]
 
     (let [roots (->> ids (reduce calculate-common-roots #{}))]
       (concat
        (when (contains? ids uuid/zero) [(get objects uuid/zero)])
-       (mapcat generate-tree roots)))))
+       (mapcat #(children-sequence % objects) roots)))))
 
 (defn- set-children-modifiers
   "Propagates the modifiers from a parent too its children applying constraints if necesary"
@@ -130,7 +132,7 @@
         children (cph/get-immediate-children objects shape-id)]
 
     (cond
-      (cph/mask-shape? shape)
+      (and (cph/mask-shape? shape) (seq children))
       (get-group-bounds objects bounds modif-tree (-> children first))
 
       (cph/group-shape? shape)
@@ -169,8 +171,9 @@
 
               [layout-line modif-tree]))]
 
-    (let [children     (->> (:shapes parent)
-                            (map (comp apply-modifiers (d/getf objects))))
+    (let [children     (->> (cph/get-immediate-children objects (:id parent))
+                            (remove :hidden)
+                            (map apply-modifiers))
           layout-data  (gcl/calc-layout-data parent children @transformed-parent-bounds)
           children     (into [] (cond-> children (not (:reverse? layout-data)) reverse))
           max-idx      (dec (count children))
@@ -209,7 +212,9 @@
             (-> modifiers
                 (ctm/resize-parent (gpt/point 1 scale-height) origin (:transform parent) (:transform-inverse parent)))))
 
-        children (->> parent :shapes (map (d/getf objects)))
+        children (->> (cph/get-immediate-children objects parent-id)
+                      (remove :hidden))
+
         content-bounds
         (when (and (d/not-empty? children) (or (ctl/auto-height? parent) (ctl/auto-width? parent)))
           (gcl/layout-content-bounds bounds parent children))
@@ -293,57 +298,136 @@
              result (assoc result (:id shape) new-bounds)]
          (recur result (rest shapes)))))))
 
+(defn reflow-layout
+  [objects old-modif-tree bounds ignore-constraints id]
+
+  (let [tree-seq (children-sequence id objects)
+
+        [modif-tree _]
+        (reduce
+         #(propagate-modifiers-layout objects bounds ignore-constraints %1 %2) [{} #{}]
+         tree-seq)
+
+        bounds (transform-bounds bounds objects modif-tree tree-seq)
+
+        modif-tree (merge-modif-tree old-modif-tree modif-tree)]
+    [modif-tree bounds]))
+
 (defn sizing-auto-modifiers
   "Recalculates the layouts to adjust the sizing: auto new sizes"
   [modif-tree sizing-auto-layouts objects bounds ignore-constraints]
-  (loop [modif-tree modif-tree
-         bounds bounds
-         sizing-auto-layouts (reverse sizing-auto-layouts)]
-    (if-let [current (first sizing-auto-layouts)]
-      (let [parent-base (get objects current)
+  (let [;; Step-1 resize the auto-width/height. Reflow the parents if they are also auto-width/height
+        [modif-tree bounds to-reflow]
+        (loop [modif-tree modif-tree
+               bounds bounds
+               sizing-auto-layouts (reverse sizing-auto-layouts)
+               to-reflow #{}]
+          (if-let [current (first sizing-auto-layouts)]
+            (let [parent-base (get objects current)
 
-            resize-modif-tree
-            {current {:modifiers (calc-auto-modifiers objects bounds parent-base)}}
+                  [modif-tree bounds]
+                  (if (contains? to-reflow current)
+                    (reflow-layout objects modif-tree bounds ignore-constraints current)
+                    [modif-tree bounds])
 
-            tree-seq (resolve-tree-sequence #{current} objects)
+                  auto-resize-modifiers
+                  (calc-auto-modifiers objects bounds parent-base)
 
-            [resize-modif-tree _]
-            (reduce #(propagate-modifiers-layout objects bounds ignore-constraints %1 %2) [resize-modif-tree #{}] tree-seq)
+                  to-reflow
+                  (cond-> to-reflow
+                    (contains? to-reflow current)
+                    (disj current))]
 
-            bounds (transform-bounds bounds objects resize-modif-tree tree-seq)
+              (if (ctm/empty? auto-resize-modifiers)
+                (recur modif-tree
+                       bounds
+                       (rest sizing-auto-layouts)
+                       to-reflow)
 
-            modif-tree (merge-modif-tree modif-tree resize-modif-tree)]
-        (recur modif-tree bounds (rest sizing-auto-layouts)))
-      modif-tree)))
+                (let [resize-modif-tree {current {:modifiers auto-resize-modifiers}}
+
+                      tree-seq (children-sequence current objects)
+
+                      [resize-modif-tree _]
+                      (reduce
+                       #(propagate-modifiers-layout objects bounds ignore-constraints %1 %2) [resize-modif-tree #{}]
+                       tree-seq)
+
+                      bounds (transform-bounds bounds objects resize-modif-tree tree-seq)
+
+                      modif-tree (merge-modif-tree modif-tree resize-modif-tree)
+
+                      to-reflow
+                      (cond-> to-reflow
+                        (and (ctl/layout-descent? objects parent-base)
+                             (not= uuid/zero (:frame-id parent-base)))
+                        (conj (:frame-id parent-base)))]
+                  (recur modif-tree
+                         bounds
+                         (rest sizing-auto-layouts)
+                         to-reflow))))
+            [modif-tree bounds to-reflow]))
+
+        ;; Step-2: After resizing we still need to reflow the layout parents that are not auto-width/height
+
+        tree-seq (resolve-tree-sequence to-reflow objects)
+
+        [reflow-modif-tree _]
+        (reduce
+         #(propagate-modifiers-layout objects bounds ignore-constraints %1 %2) [{} #{}]
+         tree-seq)
+
+        result (merge-modif-tree modif-tree reflow-modif-tree)]
+
+    result))
 
 (defn set-objects-modifiers
-  [modif-tree objects ignore-constraints snap-pixel?]
+  ([modif-tree objects]
+   (set-objects-modifiers modif-tree objects nil))
 
-  (let [objects (apply-structure-modifiers objects modif-tree)
+  ([modif-tree objects params]
+   (set-objects-modifiers nil modif-tree objects params))
 
-        bounds (d/lazy-map (keys objects) #(dm/get-in objects [% :points]))
-        shapes-tree (resolve-tree-sequence (-> modif-tree keys set) objects)
+  ([old-modif-tree modif-tree objects
+    {:keys [ignore-constraints snap-pixel? snap-precision snap-ignore-axis]
+     :or {ignore-constraints false snap-pixel? false snap-precision 1 snap-ignore-axis nil}}]
+   (let [objects (-> objects
+                     (cond-> (some? old-modif-tree)
+                       (apply-structure-modifiers old-modif-tree))
+                     (apply-structure-modifiers 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)
+         modif-tree
+         (cond-> modif-tree
+           snap-pixel? (gpp/adjust-pixel-precision objects snap-precision snap-ignore-axis))
 
-        [modif-tree-layout sizing-auto-layouts]
-        (reduce #(propagate-modifiers-layout objects bounds ignore-constraints %1 %2) [{} #{}] shapes-tree)
+         bounds (d/lazy-map (keys objects) #(dm/get-in objects [% :points]))
+         bounds (cond-> bounds
+                  (some? old-modif-tree)
+                  (transform-bounds objects old-modif-tree))
 
-        modif-tree (merge-modif-tree modif-tree modif-tree-layout)
+         shapes-tree (resolve-tree-sequence (-> modif-tree keys set) objects)
 
-        ;; Calculate hug layouts positions
-        bounds (transform-bounds bounds objects modif-tree-layout 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
-        (-> modif-tree
-            (sizing-auto-modifiers sizing-auto-layouts objects bounds ignore-constraints))
+         [modif-tree-layout sizing-auto-layouts]
+         (reduce #(propagate-modifiers-layout objects bounds ignore-constraints %1 %2) [{} #{}] shapes-tree)
 
-        modif-tree
-        (cond-> modif-tree
-          snap-pixel? (gpp/adjust-pixel-precision objects))]
+         modif-tree (merge-modif-tree modif-tree modif-tree-layout)
 
-    ;;#?(:cljs
-    ;;   (.log js/console ">result" (modif->js modif-tree objects)))
-    modif-tree))
+         ;; Calculate hug layouts positions
+         bounds (transform-bounds bounds objects modif-tree-layout shapes-tree)
+
+         modif-tree
+         (-> modif-tree
+             (sizing-auto-modifiers sizing-auto-layouts objects bounds ignore-constraints))
+
+         modif-tree
+         (if old-modif-tree
+           (merge-modif-tree old-modif-tree modif-tree)
+           modif-tree)]
+
+     ;;#?(:cljs
+     ;;   (.log js/console ">result" (modif->js modif-tree objects)))
+     modif-tree)))

common/src/app/common/geom/shapes/path.cljc

@@ -117,7 +117,7 @@
         [x y] (->> coords (mapv solve-derivative))
 
         ;; normalize value
-        d (mth/sqrt (+ (* x x) (* y y)))]
+        d (mth/hypot x y)]
 
     (if (mth/almost-zero? d)
       (gpt/point 0 0)

common/src/app/common/geom/shapes/pixel_precision.cljc

@@ -18,7 +18,7 @@
    [app.common.types.modifiers :as ctm]))
 
 (defn size-pixel-precision
-  [modifiers shape points]
+  [modifiers shape points precision]
   (let [origin        (gpo/origin points)
         curr-width    (gpo/width-points points)
         curr-height   (gpo/height-points points)
@@ -29,34 +29,42 @@
         vertical-line?   (and path? (<= curr-width 0.01))
         horizontal-line? (and path? (<= curr-height 0.01))
 
-        target-width  (if vertical-line? curr-width (max 1 (mth/round curr-width)))
-        target-height (if horizontal-line? curr-height (max 1 (mth/round curr-height)))
+        target-width  (if vertical-line? curr-width (max 1 (mth/round curr-width precision)))
+        target-height (if horizontal-line? curr-height (max 1 (mth/round curr-height precision)))
 
         ratio-width  (/ target-width curr-width)
         ratio-height (/ target-height curr-height)
         scalev       (gpt/point ratio-width ratio-height)]
-
     (-> modifiers
-        (ctm/resize scalev origin transform transform-inverse))))
+        (ctm/resize scalev origin transform transform-inverse {:precise? true}))))
 
 (defn position-pixel-precision
-  [modifiers _ points]
+  [modifiers _ points precision ignore-axis]
   (let [bounds        (gpr/bounds->rect points)
         corner        (gpt/point bounds)
-        target-corner (gpt/round corner)
+        target-corner
+        (cond-> corner
+          (= ignore-axis :x)
+          (update :y mth/round precision)
+
+          (= ignore-axis :y)
+          (update :x mth/round precision)
+
+          (nil? ignore-axis)
+          (gpt/round-step precision))
         deltav        (gpt/to-vec corner target-corner)]
     (ctm/move modifiers deltav)))
 
 (defn set-pixel-precision
   "Adjust modifiers so they adjust to the pixel grid"
-  [modifiers shape]
+  [modifiers shape precision ignore-axis]
   (let [points (-> shape :points (gco/transform-points (ctm/modifiers->transform modifiers)))
         has-resize? (not (ctm/only-move? modifiers))
 
         [modifiers points]
         (let [modifiers
               (cond-> modifiers
-                has-resize? (size-pixel-precision shape points))
+                has-resize? (size-pixel-precision shape points precision))
 
               points
               (if has-resize?
@@ -64,16 +72,16 @@
                     (gco/transform-points (ctm/modifiers->transform modifiers)) )
                 points)]
           [modifiers points])]
-    (position-pixel-precision modifiers shape points)))
+    (position-pixel-precision modifiers shape points precision ignore-axis)))
 
 (defn adjust-pixel-precision
-  [modif-tree objects]
+  [modif-tree objects precision ignore-axis]
   (let [update-modifiers
         (fn [modif-tree shape]
           (let [modifiers (dm/get-in modif-tree [(:id shape) :modifiers])]
             (cond-> modif-tree
               (ctm/has-geometry? modifiers)
-              (update-in [(:id shape) :modifiers] set-pixel-precision shape))))]
+              (update-in [(:id shape) :modifiers] set-pixel-precision shape precision ignore-axis))))]
 
     (->> (keys modif-tree)
          (map (d/getf objects))

common/src/app/common/geom/shapes/points.cljc

@@ -131,6 +131,7 @@
           i2 (gsi/line-line-intersect minv-start minv-end maxh-start maxh-end)
           i3 (gsi/line-line-intersect maxv-start maxv-end maxh-start maxh-end)
           i4 (gsi/line-line-intersect maxv-start maxv-end minh-start minh-end)]
+
       [i1 i2 i3 i4])))
 
 (defn merge-parent-coords-bounds
@@ -143,3 +144,8 @@
         height (height-points points)
         center (gco/center-points points)]
     (gre/center->selrect center width height)))
+
+(defn move
+  [bounds vector]
+  (->> bounds
+       (map #(gpt/add % vector))))

common/src/app/common/geom/shapes/rect.cljc

@@ -212,9 +212,13 @@
        (<= (:y2 sr2) (:y2 sr1))))
 
 (defn corners->selrect
-  [p1 p2]
-  (let [xp1 (:x p1)
-        xp2 (:x p2)
-        yp1 (:y p1)
-        yp2 (:y p2)]
-    (make-selrect (min xp1 xp2) (min yp1 yp2) (abs (- xp1 xp2)) (abs (- yp1 yp2)))))
+  ([p1 p2]
+   (corners->selrect (:x p1) (:y p1) (:x p2) (:y p2)))
+  ([xp1 yp1 xp2 yp2]
+   (make-selrect (min xp1 xp2) (min yp1 yp2) (abs (- xp1 xp2)) (abs (- yp1 yp2)))))
+
+(defn clip-selrect
+  [{:keys [x1 y1 x2 y2] :as sr} bounds]
+  (when (some? sr)
+    (let [{bx1 :x1 by1 :y1 bx2 :x2 by2 :y2} (rect->selrect bounds)]
+      (corners->selrect (max bx1 x1) (max by1 y1) (min bx2 x2) (min by2 y2)))))

common/src/app/common/geom/shapes/transforms.cljc

@@ -17,6 +17,7 @@
    [app.common.geom.shapes.common :as gco]
    [app.common.geom.shapes.path :as gpa]
    [app.common.geom.shapes.rect :as gpr]
+   [app.common.math :as mth]
    [app.common.pages.helpers :as cph]
    [app.common.types.modifiers :as ctm]
    [app.common.uuid :as uuid]))
@@ -43,14 +44,16 @@
     (mapv #(gpt/add % move-vec))))
 
 (defn move-position-data
-  [position-data dx dy]
+  ([position-data {:keys [x y]}]
+   (move-position-data position-data x y))
 
-  (when (some? position-data)
-    (cond->> position-data
-      (d/num? dx dy)
-      (mapv #(-> %
-                 (update :x + dx)
-                 (update :y + dy))))))
+  ([position-data dx dy]
+   (when (some? position-data)
+     (cond->> position-data
+       (d/num? dx dy)
+       (mapv #(-> %
+                  (update :x + dx)
+                  (update :y + dy)))))))
 
 (defn move
   "Move the shape relatively to its current
@@ -111,10 +114,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 +129,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))
      "")))
 
@@ -157,67 +160,79 @@
   "Calculate the transform matrix to convert from the selrect to the points bounds
     TargetM = SourceM * Transform ==> Transform = TargetM * inv(SourceM)"
   [{:keys [x1 y1 x2 y2]} [d1 d2 _ d4]]
-  #?(:clj
-     ;; NOTE: the source matrix may not be invertible we can't
-     ;; calculate the transform, so on exception we return `nil`
-     (ex/ignoring
-      (let [target-points-matrix
-            (->> (list (:x d1) (:x d2) (:x d4)
-                       (:y d1) (:y d2) (:y d4)
-                       1       1       1     )
-                 (into-array Double/TYPE)
-                 (Matrix/from1DArray 3 3))
+  ;; If the coordinates are very close to zero (but not zero) the rounding can mess with the
+  ;; transforms. So we round to zero the values
+  (let [x1  (mth/round-to-zero x1)
+        y1  (mth/round-to-zero y1)
+        x2  (mth/round-to-zero x2)
+        y2  (mth/round-to-zero y2)
+        d1x (mth/round-to-zero (:x d1))
+        d1y (mth/round-to-zero (:y d1))
+        d2x (mth/round-to-zero (:x d2))
+        d2y (mth/round-to-zero (:y d2))
+        d4x (mth/round-to-zero (:x d4))
+        d4y (mth/round-to-zero (:y d4))]
+    #?(:clj
+       ;; NOTE: the source matrix may not be invertible we can't
+       ;; calculate the transform, so on exception we return `nil`
+       (ex/ignoring
+        (let [target-points-matrix
+              (->> (list d1x d2x d4x
+                         d1y d2y d4y
+                         1     1   1)
+                   (into-array Double/TYPE)
+                   (Matrix/from1DArray 3 3))
 
-            source-points-matrix
-            (->> (list x1 x2 x1
-                       y1 y1 y2
-                        1  1  1)
-                 (into-array Double/TYPE)
-                 (Matrix/from1DArray 3 3))
+              source-points-matrix
+              (->> (list x1 x2 x1
+                         y1 y1 y2
+                         1  1  1)
+                   (into-array Double/TYPE)
+                   (Matrix/from1DArray 3 3))
 
-            ;; May throw an exception if the matrix is not invertible
-            source-points-matrix-inv
-            (.. source-points-matrix
-                (withInverter LinearAlgebra/GAUSS_JORDAN)
-                (inverse))
+              ;; May throw an exception if the matrix is not invertible
+              source-points-matrix-inv
+              (.. source-points-matrix
+                  (withInverter LinearAlgebra/GAUSS_JORDAN)
+                  (inverse))
 
-            transform-jvm
-            (.. target-points-matrix
-                (multiply source-points-matrix-inv))]
+              transform-jvm
+              (.. target-points-matrix
+                  (multiply source-points-matrix-inv))]
 
-        (gmt/matrix (.get transform-jvm 0 0)
-                    (.get transform-jvm 1 0)
-                    (.get transform-jvm 0 1)
-                    (.get transform-jvm 1 1)
-                    (.get transform-jvm 0 2)
-                    (.get transform-jvm 1 2))))
+          (gmt/matrix (.get transform-jvm 0 0)
+                      (.get transform-jvm 1 0)
+                      (.get transform-jvm 0 1)
+                      (.get transform-jvm 1 1)
+                      (.get transform-jvm 0 2)
+                      (.get transform-jvm 1 2))))
 
-     :cljs
-     (let [target-points-matrix
-           (Matrix. #js [#js [(:x d1) (:x d2) (:x d4)]
-                         #js [(:y d1) (:y d2) (:y d4)]
-                         #js [      1       1       1]])
+       :cljs
+       (let [target-points-matrix
+             (Matrix. #js [#js [d1x d2x d4x]
+                           #js [d1y d2y d4y]
+                           #js [  1   1   1]])
 
-           source-points-matrix
-           (Matrix. #js [#js [x1 x2 x1]
-                         #js [y1 y1 y2]
-                         #js [ 1  1  1]])
+             source-points-matrix
+             (Matrix. #js [#js [x1 x2 x1]
+                           #js [y1 y1 y2]
+                           #js [ 1  1  1]])
 
-           ;; returns nil if not invertible
-           source-points-matrix-inv (.getInverse source-points-matrix)
+             ;; returns nil if not invertible
+             source-points-matrix-inv (.getInverse source-points-matrix)
 
-           ;; TargetM = SourceM * Transform ==> Transform = TargetM * inv(SourceM)
-           transform-js
-           (when source-points-matrix-inv
-             (.multiply target-points-matrix source-points-matrix-inv))]
+             ;; TargetM = SourceM * Transform ==> Transform = TargetM * inv(SourceM)
+             transform-js
+             (when source-points-matrix-inv
+               (.multiply target-points-matrix source-points-matrix-inv))]
 
-       (when transform-js
-         (gmt/matrix (.getValueAt transform-js 0 0)
-                     (.getValueAt transform-js 1 0)
-                     (.getValueAt transform-js 0 1)
-                     (.getValueAt transform-js 1 1)
-                     (.getValueAt transform-js 0 2)
-                     (.getValueAt transform-js 1 2))))))
+         (when transform-js
+           (gmt/matrix (.getValueAt transform-js 0 0)
+                       (.getValueAt transform-js 1 0)
+                       (.getValueAt transform-js 0 1)
+                       (.getValueAt transform-js 1 1)
+                       (.getValueAt transform-js 0 2)
+                       (.getValueAt transform-js 1 2)))))))
 
 (defn calculate-geometry
   [points]
@@ -236,7 +251,15 @@
            points-transform-mtx
            (gmt/translate-matrix center)))
 
-        transform-inverse (when transform (gmt/inverse transform))]
+        transform-inverse (when transform (gmt/inverse transform))
+
+        ;; There is a rounding error when the matrix returned have float point values
+        ;; when the matrix is unit we return a "pure" matrix so we don't accumulate
+        ;; rounding problems
+        [transform transform-inverse]
+        (if (gmt/unit? transform)
+          [(gmt/matrix) (gmt/matrix)]
+          [transform transform-inverse])]
 
     [sr transform transform-inverse]))
 

common/src/app/common/logging.cljc

@@ -175,14 +175,15 @@
 #?(:clj
    (defn get-error-context
      [error]
-     (when-let [data (ex-data error)]
-       (merge
-        {:hint          (ex-message error)
-         :spec-problems (some->> data ::s/problems (take 10) seq vec)
-         :spec-value    (some->> data ::s/value)
-         :data          (some-> data (dissoc ::s/problems ::s/value ::s/spec))}
-        (when-let [explain (ex/explain data)]
-          {:spec-explain explain})))))
+     (merge
+      {:hint (ex-message error)}
+      (when-let [data (ex-data error)]
+        (merge
+         {:spec-problems (some->> data ::s/problems (take 10) seq vec)
+          :spec-value    (some->> data ::s/value)
+          :data          (some-> data (dissoc ::s/problems ::s/value ::s/spec))}
+         (when-let [explain (ex/explain data)]
+           {:spec-explain explain}))))))
 
 (defmacro log
   [& props]

common/src/app/common/math.cljc

@@ -104,15 +104,16 @@
 
 (defn round
   "Returns the value of a number rounded to
-  the nearest integer."
-  [v]
-  #?(:cljs (js/Math.round v)
-     :clj (Math/round (float v))))
+  the nearest integer.
+  If given step rounds to the next closest step, for example:
+  (round 13.4 0.5) => 13.5
+  (round 13.4 0.3) => 13.3"
+  ([v step]
+   (* (round (/ v step)) step))
 
-(defn half-round
-  "Returns a value rounded to the next point or half point"
-  [v]
-  (/ (round (* v 2)) 2))
+  ([v]
+   #?(:cljs (js/Math.round v)
+      :clj (Math/round (float v)))))
 
 (defn ceil
   "Returns the smallest integer greater than
@@ -127,6 +128,12 @@
     (let [d (pow 10 n)]
       (/ (round (* v d)) d))))
 
+(defn to-fixed
+  "Returns a string representing the given number, using fixed precision."
+  [v n]
+  #?(:cljs (.toFixed ^js v n)
+     :clj (str (precision v n))))
+
 (defn radians
   "Converts degrees to radians."
   [degrees]
@@ -139,12 +146,18 @@
   #?(:cljs (math/toDegrees radians)
      :clj (Math/toDegrees radians)))
 
+(defn hypot
+  "Square root of the squares addition"
+  [a b]
+  #?(:cljs (js/Math.hypot a b)
+     :clj (Math/hypot a b)))
+
 (defn distance
   "Calculate the distance between two points."
   [[x1 y1] [x2 y2]]
   (let [dx (- x1 x2)
         dy (- y1 y2)]
-    (-> (sqrt (+ (pow dx 2) (pow dy 2)))
+    (-> (hypot dx dy)
         (precision 2))))
 
 (defn log10
@@ -161,6 +174,13 @@
 (defn almost-zero? [num]
   (< (abs (double num)) 1e-4))
 
+(defn round-to-zero
+  "Given a number if it's close enough to zero round to the zero to avoid precision problems"
+  [num]
+  (if (almost-zero? num)
+    0
+    num))
+
 (defonce float-equal-precision 0.001)
 
 (defn close?
@@ -182,3 +202,4 @@
   "Get the sign (+1 / -1) for the number"
   [n]
   (if (neg? n) -1 1))
+

common/src/app/common/media.cljc

@@ -9,7 +9,8 @@
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]))
 
-(def valid-font-types #{"font/ttf" "font/woff", "application/font-woff", "font/otf"})
+;; We have added ".ttf" as string to solve a problem with chrome input selector
+(def valid-font-types #{"font/ttf", ".ttf", "font/woff", "application/font-woff", "font/otf"})
 (def valid-image-types #{"image/jpeg", "image/png", "image/webp", "image/gif", "image/svg+xml"})
 (def str-image-types (str/join "," valid-image-types))
 (def str-font-types (str/join "," valid-font-types))

common/src/app/common/pages/changes.cljc

@@ -182,7 +182,7 @@
       (d/update-in-when data [:components component-id :objects] reg-objects))))
 
 (defmethod process-change :mov-objects
-  [data {:keys [parent-id shapes index page-id component-id ignore-touched]}]
+  [data {:keys [parent-id shapes index page-id component-id ignore-touched after-shape]}]
   (letfn [(calculate-invalid-targets [objects shape-id]
             (let [reduce-fn #(into %1 (calculate-invalid-targets objects %2))]
               (->> (get-in objects [shape-id :shapes])
@@ -200,21 +200,9 @@
                 (cph/insert-at-index prev-shapes index shapes)
                 (cph/append-at-the-end prev-shapes shapes))))
 
-          (check-insert-items [prev-shapes parent index shapes]
-            (if-not (:masked-group? parent)
-              (insert-items prev-shapes index shapes)
-              ;; For masked groups, the first shape is the mask
-              ;; and it cannot be moved.
-              (let [mask-id         (first prev-shapes)
-                    other-ids       (rest prev-shapes)
-                    not-mask-shapes (without-obj shapes mask-id)
-                    new-index       (if (nil? index) nil (max (dec index) 0))
-                    new-shapes      (insert-items other-ids new-index not-mask-shapes)]
-                (into [mask-id] new-shapes))))
-
           (add-to-parent [parent index shapes]
             (let [parent (-> parent
-                             (update :shapes check-insert-items parent index shapes)
+                             (update :shapes insert-items index shapes)
                              ;; We need to ensure that no `nil` in the
                              ;; shapes list after adding all the
                              ;; incoming shapes to the parent.
@@ -260,9 +248,13 @@
                 (not= :frame (:type obj))
                 (as-> $$ (reduce (partial assign-frame-id frame-id) $$ (:shapes obj))))))
 
+
+
           (move-objects [objects]
             (let [valid?   (every? (partial is-valid-move? objects) shapes)
                   parent   (get objects parent-id)
+                  after-shape-index (d/index-of (:shapes parent) after-shape)
+                  index (if (nil? after-shape-index) index (inc after-shape-index))
                   frame-id (if (= :frame (:type parent))
                              (:id parent)
                              (:frame-id parent))]
@@ -283,7 +275,7 @@
                   ;; Ensure that all shapes of the new parent has a
                   ;; correct link to the topside frame.
                   (reduce (partial assign-frame-id frame-id) $ shapes))
-              objects)))]
+                objects)))]
 
     (if page-id
       (d/update-in-when data [:pages-index page-id :objects] move-objects)
@@ -395,6 +387,10 @@
         is-geometry?    (and (or (= group :geometry-group)
                                  (and (= group :content-group) (= (:type shape) :path)))
                              (not (#{:width :height} attr))) ;; :content in paths are also considered geometric
+                        ;; TODO: the check of :width and :height probably may be removed
+                        ;;       after the check added in data/workspace/modifiers/check-delta
+                        ;;       function. Better check it and test toroughly when activating
+                        ;;       components-v2 mode.
         shape-ref       (:shape-ref shape)
         root-name?      (and (= group :name-group)
                              (:component-root? shape))

common/src/app/common/pages/changes_builder.cljc

@@ -244,39 +244,32 @@
    (assert-page-id changes)
    (assert-objects changes)
    (let [objects (lookup-objects changes)
-
          set-parent-change
          (cond-> {:type :mov-objects
                   :parent-id parent-id
                   :page-id (::page-id (meta changes))
-                  :shapes (->> shapes (mapv :id))}
+                  :shapes (->> shapes reverse (mapv :id))}
 
            (some? index)
            (assoc :index index))
 
          mk-undo-change
          (fn [change-set shape]
-           (let [idx (or (cph/get-position-on-parent objects (:id shape)) 0)
-                 ;; Different index if the movement was from top to bottom or the other way
-                 ;; Similar that on frontend/src/app/main/ui/workspace/sidebar/layers.cljs
-                 ;; with the 'side' property of the on-drop
-                 idx (if (< index idx)
-                       (inc idx)
-                       idx)]
+           (let [prev-sibling (cph/get-prev-sibling objects (:id shape))]
            (d/preconj
              change-set
              {:type :mov-objects
               :page-id (::page-id (meta changes))
               :parent-id (:parent-id shape)
               :shapes [(:id shape)]
-              :index idx})))]
+              :after-shape prev-sibling
+              :index 0})))] ; index is used in case there is no after-shape (moving bottom shapes)
 
      (-> changes
          (update :redo-changes conj set-parent-change)
          (update :undo-changes #(reduce mk-undo-change % shapes))
          (apply-changes-local)))))
 
-
 (defn changed-attrs
   "Returns the list of attributes that will change when `update-fn` is applied"
   [object update-fn {:keys [attrs]}]
@@ -384,14 +377,16 @@
 
         add-undo-change-parent
         (fn [change-set id]
-          (let [shape (get objects id)]
+          (let [shape (get objects id)
+                prev-sibling (cph/get-prev-sibling objects (:id shape))]
             (d/preconj
              change-set
              {:type :mov-objects
               :page-id page-id
               :parent-id (:parent-id shape)
               :shapes [id]
-              :index (cph/get-position-on-parent objects id)
+              :after-shape prev-sibling
+              :index 0
               :ignore-touched true})))]
 
     (-> changes

common/src/app/common/pages/changes_spec.cljc

@@ -12,6 +12,7 @@
    [app.common.types.page :as ctp]
    [app.common.types.shape :as cts]
    [app.common.types.typography :as ctt]
+   [app.common.uuid :as uuid]
    [clojure.spec.alpha :as s]))
 
 (s/def ::index integer?)
@@ -61,7 +62,7 @@
            (some? (:frame-id o)))
       (and (contains? o :component-id)
            (not (contains? o :page-id))
-           (nil? (:frame-id o)))))
+           (not= (:frame-id o) uuid/zero))))
 
 (defn- valid-container-id?
   [o]

common/src/app/common/pages/common.cljc

@@ -9,89 +9,98 @@
    [app.common.colors :as clr]
    [app.common.uuid :as uuid]))
 
-(def file-version 19)
+(def file-version 20)
 (def default-color clr/gray-20)
 (def root uuid/zero)
 
+;; Attributes that may be synced in components, and the group they belong to.
+;; When one attribute is modified in a shape inside a component, the corresponding
+;; group is marked as :touched. Then, if the shape is synced with the remote shape
+;; in the main component, none of the attributes of the same group is changed.
+
 (def component-sync-attrs
-  {:name                  :name-group
-   :fills                 :fill-group
-   :fill-color            :fill-group
-   :fill-opacity          :fill-group
-   :fill-color-gradient   :fill-group
-   :fill-color-ref-file   :fill-group
-   :fill-color-ref-id     :fill-group
-   :hide-fill-on-export   :fill-group
-   :content               :content-group
-   :hidden                :visibility-group
-   :blocked               :modifiable-group
-   :grow-type             :text-font-group
-   :font-family           :text-font-group
-   :font-size             :text-font-group
-   :font-style            :text-font-group
-   :font-weight           :text-font-group
-   :letter-spacing        :text-display-group
-   :line-height           :text-display-group
-   :text-align            :text-display-group
-   :strokes               :stroke-group
-   :stroke-color          :stroke-group
-   :stroke-color-gradient :stroke-group
-   :stroke-color-ref-file :stroke-group
-   :stroke-color-ref-id   :stroke-group
-   :stroke-opacity        :stroke-group
-   :stroke-style          :stroke-group
-   :stroke-width          :stroke-group
-   :stroke-alignment      :stroke-group
-   :stroke-cap-start      :stroke-group
-   :stroke-cap-end        :stroke-group
-   :rx                    :radius-group
-   :ry                    :radius-group
-   :r1                    :radius-group
-   :r2                    :radius-group
-   :r3                    :radius-group
-   :r4                    :radius-group
-   :type                  :geometry-group
-   :selrect               :geometry-group
-   :points                :geometry-group
-   :locked                :geometry-group
-   :proportion            :geometry-group
-   :proportion-lock       :geometry-group
-   :x                     :geometry-group
-   :y                     :geometry-group
-   :width                 :geometry-group
-   :height                :geometry-group
-   :rotation              :geometry-group
-   :transform             :geometry-group
-   :transform-inverse     :geometry-group
-   :position-data         :geometry-group
-   :opacity               :layer-effects-group
-   :blend-mode            :layer-effects-group
-   :shadow                :shadow-group
-   :blur                  :blur-group
-   :masked-group?         :mask-group
-   :constraints-h         :constraints-group
-   :constraints-v         :constraints-group
-   :fixed-scroll          :constraints-group
-   :exports               :exports-group
+  {:name                    :name-group
+   :fills                   :fill-group
+   :fill-color              :fill-group
+   :fill-opacity            :fill-group
+   :fill-color-gradient     :fill-group
+   :fill-color-ref-file     :fill-group
+   :fill-color-ref-id       :fill-group
+   :hide-fill-on-export     :fill-group
+   :content                 :content-group
+   :position-data           :content-group
+   :hidden                  :visibility-group
+   :blocked                 :modifiable-group
+   :grow-type               :text-font-group
+   :font-family             :text-font-group
+   :font-size               :text-font-group
+   :font-style              :text-font-group
+   :font-weight             :text-font-group
+   :letter-spacing          :text-display-group
+   :line-height             :text-display-group
+   :text-align              :text-display-group
+   :strokes                 :stroke-group
+   :stroke-color            :stroke-group
+   :stroke-color-gradient   :stroke-group
+   :stroke-color-ref-file   :stroke-group
+   :stroke-color-ref-id     :stroke-group
+   :stroke-opacity          :stroke-group
+   :stroke-style            :stroke-group
+   :stroke-width            :stroke-group
+   :stroke-alignment        :stroke-group
+   :stroke-cap-start        :stroke-group
+   :stroke-cap-end          :stroke-group
+   :rx                      :radius-group
+   :ry                      :radius-group
+   :r1                      :radius-group
+   :r2                      :radius-group
+   :r3                      :radius-group
+   :r4                      :radius-group
+   :type                    :geometry-group
+   :selrect                 :geometry-group
+   :points                  :geometry-group
+   :locked                  :geometry-group
+   :proportion              :geometry-group
+   :proportion-lock         :geometry-group
+   :x                       :geometry-group
+   :y                       :geometry-group
+   :width                   :geometry-group
+   :height                  :geometry-group
+   :rotation                :geometry-group
+   :transform               :geometry-group
+   :transform-inverse       :geometry-group
+   :opacity                 :layer-effects-group
+   :blend-mode              :layer-effects-group
+   :shadow                  :shadow-group
+   :blur                    :blur-group
+   :masked-group?           :mask-group
+   :constraints-h           :constraints-group
+   :constraints-v           :constraints-group
+   :fixed-scroll            :constraints-group
+   :exports                 :exports-group
 
-   :layout                :layout-container
-   :layout-dir            :layout-container
-   :layout-gap            :layout-container
-   :layout-wrap-type      :layout-container
-   :layout-padding-type   :layout-container
-   :layout-padding        :layout-container
-   :layout-h-orientation  :layout-container
-   :layout-v-orientation  :layout-container
+   :layout                  :layout-container
+   :layout-align-content    :layout-container
+   :layout-align-items      :layout-container
+   :layout-flex-dir         :layout-container
+   :layout-gap              :layout-container
+   :layout-gap-type         :layout-container
+   :layout-justify-content  :layout-container
+   :layout-wrap-type        :layout-container
+   :layout-padding-type     :layout-container
+   :layout-padding          :layout-container
+   :layout-h-orientation    :layout-container
+   :layout-v-orientation    :layout-container
 
-   :layout-item-margin         :layout-item
-   :layout-item-margin-type    :layout-item
-   :layout-item-h-sizing       :layout-item
-   :layout-item-v-sizing       :layout-item
-   :layout-item-max-h          :layout-item
-   :layout-item-min-h          :layout-item
-   :layout-item-max-w          :layout-item
-   :layout-item-min-w          :layout-item
-   :layout-item-align-self     :layout-item})
+   :layout-item-margin      :layout-item
+   :layout-item-margin-type :layout-item
+   :layout-item-h-sizing    :layout-item
+   :layout-item-v-sizing    :layout-item
+   :layout-item-max-h       :layout-item
+   :layout-item-min-h       :layout-item
+   :layout-item-max-w       :layout-item
+   :layout-item-min-w       :layout-item
+   :layout-item-align-self  :layout-item})
 
 ;; Attributes that may directly be edited by the user with forms
 (def editable-attrs
@@ -373,6 +382,7 @@
            :fill-color-ref-file
            :fill-color-gradient
 
+           :strokes
            :stroke-style
            :stroke-alignment
            :stroke-width
@@ -536,6 +546,7 @@
            :blocked
            :hidden
 
+           :fills
            :fill-color
            :fill-opacity
            :fill-color-ref-id

common/src/app/common/pages/helpers.cljc

@@ -147,6 +147,16 @@
         prt (get objects pid)]
     (d/index-of (:shapes prt) id)))
 
+(defn get-prev-sibling
+  [objects id]
+  (let [obj (get objects id)
+        pid (:parent-id obj)
+        prt (get objects pid)
+        shapes (:shapes prt)
+        pos (d/index-of shapes id)]
+    (if (= 0 pos) nil (nth shapes (dec pos)))))
+
+
 (defn get-immediate-children
   "Retrieve resolved shape objects that are immediate children
    of the specified shape-id"
@@ -336,6 +346,23 @@
          (map second)
          (into #{}))))
 
+(defn order-by-indexed-shapes
+  [objects ids]
+  (->> (indexed-shapes objects)
+       (sort-by first)
+       (filter (comp (into #{} ids) second))
+       (map second)))
+
+(defn get-index-replacement
+  "Given a collection of shapes, calculate their positions 
+   in the parent, find first index and return next one"
+  [shapes objects]
+  (->> shapes
+       (order-by-indexed-shapes objects)
+       first
+       (get-position-on-parent objects)
+       inc))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; SHAPES ORGANIZATION (PATH MANAGEMENT)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

common/src/app/common/pages/migrations.cljc

@@ -7,11 +7,12 @@
 (ns app.common.pages.migrations
   (:require
    [app.common.data :as d]
+   [app.common.data.macros :as dm]
    [app.common.geom.matrix :as gmt]
    [app.common.geom.shapes :as gsh]
    [app.common.geom.shapes.path :as gsp]
    [app.common.geom.shapes.text :as gsht]
-   [app.common.logging :as l]
+   [app.common.logging :as log]
    [app.common.math :as mth]
    [app.common.pages :as cp]
    [app.common.pages.helpers :as cph]
@@ -23,13 +24,15 @@
 
 (defmulti migrate :version)
 
+(log/set-level! :info)
+
 (defn migrate-data
   ([data] (migrate-data data cp/file-version))
   ([data to-version]
    (if (= (:version data) to-version)
      data
      (let [migrate-fn #(do
-                         (l/trace :hint "migrate file" :id (:id %) :version-from %2 :version-to (inc %2))
+                         (log/trace :hint "migrate file" :id (:id %) :version-from %2 :version-to (inc %2))
                          (migrate (assoc %1 :version (inc %2))))]
        (reduce migrate-fn data (range (:version data 0) to-version))))))
 
@@ -427,5 +430,31 @@
         (update :pages-index update-vals update-container)
         (update :components update-vals update-container))))
 
+(defmethod migrate 20
+  [data]
+  (letfn [(update-object [objects object]
+            (let [frame-id (:frame-id object)
+                  calculated-frame-id
+                  (or (->> (cph/get-parent-ids objects (:id object))
+                           (map (d/getf objects))
+                           (d/seek cph/frame-shape?)
+                           :id)
+                      ;; If we cannot find any we let the frame-id as it was before
+                      frame-id)]
+              (when (not= frame-id calculated-frame-id)
+                (log/info :hint "Fix wrong frame-id"
+                          :shape (:name object)
+                          :id (:id object)
+                          :current (dm/get-in objects [frame-id :name])
+                          :calculated (get-in objects [calculated-frame-id :name])))
+              (assoc object :frame-id calculated-frame-id)))
+
+          (update-container [container]
+            (update container :objects #(update-vals % (partial update-object %))))]
+
+    (-> data
+        (update :pages-index update-vals update-container)
+        (update :components update-vals update-container))))
+
 ;; TODO: pending to do a migration for delete already not used fill
 ;; and stroke props. This should be done for >1.14.x version.

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
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

common/src/app/common/types/component.cljc

@@ -49,3 +49,22 @@
   [shape]
   (some? (:shape-ref shape)))
 
+(defn in-component-instance-not-root?
+  "Check if the shape is inside a component instance and
+  is not the root shape."
+  [shape]
+  (and (some? (:shape-ref shape))
+       (nil? (:component-id shape))))
+
+(defn detach-shape
+  "Remove the links and leave it as a plain shape, detached from any component."
+  [shape]
+  (dissoc shape
+          :component-id
+          :component-file
+          :component-root?
+          :remote-synced?
+          :shape-ref
+          :touched))
+
+

common/src/app/common/types/container.cljc

@@ -69,13 +69,16 @@
   (assert (nil? (:component-id shape)))
   (assert (nil? (:component-file shape)))
   (assert (nil? (:shape-ref shape)))
-  (let [;; Ensure that the component root is not an instance and
-        ;; it's no longer tied to a frame.
-        update-new-shape (fn [new-shape _original-shape]
+  (let [frame-ids-map (volatile! {})
+
+        ;; Ensure that the component root is not an instance
+        update-new-shape (fn [new-shape original-shape]
+                           (when (= (:type original-shape) :frame)
+                             (vswap! frame-ids-map assoc (:id original-shape) (:id new-shape)))
+
                            (cond-> new-shape
                              true
-                             (-> (assoc :frame-id nil)
-                                 (dissoc :component-root?))
+                             (dissoc :component-root?)
 
                              (nil? (:parent-id new-shape))
                              (dissoc :component-id
@@ -100,9 +103,17 @@
                                   (assoc :main-instance? true)
 
                                   (some? (:parent-id new-shape))
-                                  (dissoc :component-root?)))]
+                                  (dissoc :component-root?)))
 
-    (ctst/clone-object shape nil objects update-new-shape update-original-shape)))
+        [new-root-shape new-shapes updated-shapes]
+        (ctst/clone-object shape nil objects update-new-shape update-original-shape)
+
+        ;; If frame-id points to a shape inside the component, remap it to the
+        ;; corresponding new frame shape. If not, set it to nil.
+        remap-frame-id (fn [shape]
+                         (update shape :frame-id #(get @frame-ids-map % nil)))]
+
+    [new-root-shape (map remap-frame-id new-shapes) updated-shapes]))
 
 (defn make-component-instance
   "Clone the shapes of the component, generating new names and ids, and linking
@@ -115,29 +126,29 @@
     {:keys [main-instance? force-id] :or {main-instance? false force-id nil}}]
    (let [component-shape (get-shape component (:id component))
 
-         orig-pos  (gpt/point (:x component-shape) (:y component-shape))
-         delta     (gpt/subtract position orig-pos)
+         orig-pos        (gpt/point (:x component-shape) (:y component-shape))
+         delta           (gpt/subtract position orig-pos)
 
-         objects   (:objects container)
-         unames    (volatile! (ctst/retrieve-used-names objects))
+         objects         (:objects container)
+         unames          (volatile! (ctst/retrieve-used-names objects))
 
-         frame-id  (ctst/frame-id-by-position objects (gpt/add orig-pos delta))
+         frame-id        (ctst/frame-id-by-position objects (gpt/add orig-pos delta))
+         frame-ids-map   (volatile! {})
 
          update-new-shape
          (fn [new-shape original-shape]
-           (let [new-name (ctst/generate-unique-name @unames (:name new-shape))]
+           (let [new-name (:name new-shape)]
 
              (when (nil? (:parent-id original-shape))
                (vswap! unames conj new-name))
 
+             (when (= (:type original-shape) :frame)
+               (vswap! frame-ids-map assoc (:id original-shape) (:id new-shape)))
+
              (cond-> new-shape
                true
-               (as-> $
-                 (gsh/move $ delta)
-                 (assoc $ :frame-id frame-id)
-                 (assoc $ :parent-id
-                        (or (:parent-id $) (:frame-id $)))
-                 (dissoc $ :touched))
+               (-> (gsh/move delta)
+                   (dissoc :touched))
 
                (nil? (:shape-ref original-shape))
                (assoc :shape-ref (:id original-shape))
@@ -160,7 +171,15 @@
                             (get component :objects)
                             update-new-shape
                             (fn [object _] object)
-                            force-id)]
+                            force-id)
 
-     [new-shape new-shapes])))
+        ;; If frame-id points to a shape inside the component, remap it to the
+        ;; corresponding new frame shape. If not, set it to the destination frame.
+        ;; Also fix empty parent-id.
+        remap-frame-id (fn [shape]
+                         (as-> shape $
+                           (update $ :frame-id #(get @frame-ids-map % frame-id))
+                           (update $ :parent-id #(or % (:frame-id $)))))]
+
+     [new-shape (map remap-frame-id new-shapes)])))
 

common/src/app/common/types/modifiers.cljc

@@ -177,17 +177,19 @@
 
 (defn- maybe-add-resize
   "Check the last operation to check if we can stack it over the last one"
-  [operations op]
+  ([operations op]
+   (maybe-add-resize operations op nil))
 
-  (if (c/empty? operations)
-    [op]
-    (let [head (peek operations)]
-      (if (mergeable-resize? head op)
-        (let [item (merge-resize head op)]
-          (cond-> (pop operations)
-            (resize-vec? (dm/get-prop item :vector))
-            (conj item)))
-        (conj operations op)))))
+  ([operations op {:keys [precise?]}]
+   (if (c/empty? operations)
+     [op]
+     (let [head (peek operations)]
+       (if (mergeable-resize? head op)
+         (let [item (merge-resize head op)]
+           (cond-> (pop operations)
+             (or precise? (resize-vec? (dm/get-prop item :vector)))
+             (conj item)))
+         (conj operations op))))))
 
 (defn valid-vector?
   [vector]
@@ -259,12 +261,16 @@
        (update :geometry-child maybe-add-resize (resize-op order vector origin)))))
 
   ([modifiers vector origin transform transform-inverse]
+   (resize modifiers vector origin transform transform-inverse nil))
+
+  ;; `precise?` works so we don't remove almost empty resizes. This will be used in the pixel-precision
+  ([modifiers vector origin transform transform-inverse {:keys [precise?]}]
    (assert (valid-vector? vector) (dm/str "Invalid move vector: " (:x vector) "," (:y vector)))
    (let [modifiers (or modifiers (empty))
          order     (inc (dm/get-prop modifiers :last-order))
          modifiers (assoc modifiers :last-order order)]
      (cond-> modifiers
-       (resize-vec? vector)
+       (or precise? (resize-vec? vector))
        (update :geometry-child maybe-add-resize (resize-op order vector origin transform transform-inverse))))))
 
 (defn rotation

common/src/app/common/types/shape.cljc

@@ -278,7 +278,7 @@
 
 (def ^:private minimal-shapes
   [{:type :rect
-    :name "Rect-1"
+    :name "Rectangle"
     :fills [{:fill-color default-color
              :fill-opacity 1}]
     :strokes []
@@ -292,13 +292,13 @@
     :strokes []}
 
    {:type :circle
-    :name "Circle-1"
+    :name "Ellipse"
     :fills [{:fill-color default-color
              :fill-opacity 1}]
     :strokes []}
 
    {:type :path
-    :name "Path-1"
+    :name "Path"
     :fills []
     :strokes [{:stroke-style :solid
                :stroke-alignment :center
@@ -307,7 +307,7 @@
                :stroke-opacity 1}]}
 
    {:type :frame
-    :name "Board-1"
+    :name "Board"
     :fills [{:fill-color clr/white
              :fill-opacity 1}]
     :strokes []
@@ -320,7 +320,7 @@
     :ry 0}
 
    {:type :text
-    :name "Text-1"
+    :name "Text"
     :content nil}
 
    {:type :svg-raw}])

common/src/app/common/types/shape/layout.cljc

@@ -6,17 +6,18 @@
 
 (ns app.common.types.shape.layout
   (:require
+   [app.common.data.macros :as dm]
    [app.common.spec :as us]
    [clojure.spec.alpha :as s]))
 
 ;; :layout                 ;; :flex, :grid in the future
-;; :layout-flex-dir        ;; :row, :reverse-row, :column, :reverse-column
+;; :layout-flex-dir        ;; :row, :row-reverse, :column, :column-reverse
 ;; :layout-gap-type        ;; :simple, :multiple
 ;; :layout-gap             ;; {:row-gap number , :column-gap number}
 ;; :layout-align-items     ;; :start :end :center :stretch
 ;; :layout-justify-content ;; :start :center :end :space-between :space-around
 ;; :layout-align-content   ;; :start :center :end :space-between :space-around :stretch (by default)
-;; :layout-wrap-type       ;; :wrap, :no-wrap
+;; :layout-wrap-type       ;; :wrap, :nowrap
 ;; :layout-padding-type    ;; :simple, :multiple
 ;; :layout-padding         ;; {:p1 num :p2 num :p3 num :p4 num} number could be negative
 
@@ -31,13 +32,13 @@
 ;; :layout-item-min-w       ;; num
 
 (s/def ::layout  #{:flex :grid})
-(s/def ::layout-flex-dir #{:row :reverse-row :column :reverse-column})
+(s/def ::layout-flex-dir #{:row :reverse-row :row-reverse :column :reverse-column :column-reverse}) ;;TODO remove reverse-column and reverse-row after script
 (s/def ::layout-gap-type #{:simple :multiple})
 (s/def ::layout-gap ::us/safe-number)
 (s/def ::layout-align-items #{:start :end :center :stretch})
 (s/def ::layout-align-content #{:start :end :center :space-between :space-around :stretch})
 (s/def ::layout-justify-content #{:start :center :end :space-between :space-around})
-(s/def ::layout-wrap-type #{:wrap :no-wrap})
+(s/def ::layout-wrap-type #{:wrap :nowrap :no-wrap}) ;;TODO remove no-wrap after script
 (s/def ::layout-padding-type #{:simple :multiple})
 
 (s/def ::p1 ::us/safe-number)
@@ -99,17 +100,21 @@
   ([shape]
    (and (= :frame (:type shape)) (= :flex (:layout shape)))))
 
-(defn layout-child? [objects shape]
+(defn layout-immediate-child? [objects shape]
   (let [parent-id (:parent-id shape)
         parent (get objects parent-id)]
     (layout? parent)))
 
-(defn layout-child-id? [objects id]
-  (let [shape (get objects id)
-        parent-id (:parent-id shape)
+(defn layout-immediate-child-id? [objects id]
+  (let [parent-id (dm/get-in objects [id :parent-id])
         parent (get objects parent-id)]
     (layout? parent)))
 
+(defn layout-descent? [objects shape]
+  (let [frame-id (:frame-id shape)
+        frame (get objects frame-id)]
+    (layout? frame)))
+
 (defn inside-layout?
   "Check if the shape is inside a layout"
   [objects shape]
@@ -143,18 +148,16 @@
 
 (defn col?
   [{:keys [layout-flex-dir]}]
-  (or (= :column layout-flex-dir) (= :reverse-column layout-flex-dir)))
+  (or (= :column layout-flex-dir) (= :column-reverse layout-flex-dir)))
 
 (defn row?
   [{:keys [layout-flex-dir]}]
-  (or (= :row layout-flex-dir) (= :reverse-row layout-flex-dir)))
+  (or (= :row layout-flex-dir) (= :row-reverse layout-flex-dir)))
 
 (defn gaps
-  [{:keys [layout-gap layout-gap-type]}]
+  [{:keys [layout-gap]}]
   (let [layout-gap-row (or (-> layout-gap :row-gap) 0)
-        layout-gap-col (if (= layout-gap-type :simple)
-                         layout-gap-row
-                         (or (-> layout-gap :column-gap) 0))]
+        layout-gap-col (or (-> layout-gap :column-gap) 0)]
     [layout-gap-row layout-gap-col]))
 
 (defn child-min-width
@@ -193,7 +196,7 @@
         m4 (or m4 0)]
     (if (= layout-item-margin-type :multiple)
       [m1 m2 m3 m4]
-      [m1 m1 m1 m1])))
+      [m1 m2 m1 m2])))
 
 (defn child-height-margin
   [child]
@@ -275,8 +278,8 @@
 
 (defn reverse?
   [{:keys [layout-flex-dir]}]
-  (or (= :reverse-row layout-flex-dir)
-      (= :reverse-column layout-flex-dir)))
+  (or (= :row-reverse layout-flex-dir)
+      (= :column-reverse layout-flex-dir)))
 
 (defn space-between?
   [{:keys [layout-justify-content]}]

common/src/app/common/types/shape_tree.cljc

@@ -155,21 +155,19 @@
     [base index-base-a index-base-b]))
 
 (defn is-shape-over-shape?
-  [objects base-shape-id over-shape-id {:keys [top-frames?]}]
+  [objects base-shape-id over-shape-id]
 
   (let [[base index-a index-b] (get-base objects base-shape-id over-shape-id)]
     (cond
       (= base base-shape-id)
-      (and (not top-frames?)
-           (let [object (get objects base-shape-id)]
-             (or (cph/frame-shape? object)
-                 (cph/root-frame? object))))
+      (let [object (get objects base-shape-id)]
+        (or (cph/frame-shape? object)
+            (cph/root-frame? object)))
 
       (= base over-shape-id)
-      (or top-frames?
-          (let [object (get objects over-shape-id)]
-            (or (not (cph/frame-shape? object))
-                (not (cph/root-frame? object)))))
+      (let [object (get objects over-shape-id)]
+        (or (not (cph/frame-shape? object))
+            (not (cph/root-frame? object))))
 
       :else
       (< index-a index-b))))
@@ -183,20 +181,20 @@
              (let [type-a (dm/get-in objects [id-a :type])
                    type-b (dm/get-in objects [id-b :type])]
                (cond
-                 (and (= :frame type-a) (not= :frame type-b))
-                 (if bottom-frames? 1 -1)
-
                  (and (not= :frame type-a) (= :frame type-b))
                  (if bottom-frames? -1 1)
 
+                 (and (= :frame type-a) (not= :frame type-b))
+                 (if bottom-frames? 1 -1)
+
                  (= id-a id-b)
                  0
 
-                 (is-shape-over-shape? objects id-a id-b options)
-                 1
+                 (is-shape-over-shape? objects id-b id-a)
+                 -1
 
                  :else
-                 -1)))]
+                 1)))]
      (sort comp ids))))
 
 (defn frame-id-by-position
@@ -247,7 +245,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)]
@@ -268,7 +266,7 @@
                (if all-frames?
                  identity
                  (remove :hide-in-viewer)))
-         (sort-z-index objects (get-frames-ids objects) {:top-frames? true}))))
+         (sort-z-index objects (get-frames-ids objects)))))
 
 (defn start-page-index
   [objects]
@@ -296,11 +294,16 @@
     [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)
+  ;; We have add a condition because UX doesn't want numbers on 
+  ;; layer names. 
   (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)]

common/src/app/common/types/typography.cljc

@@ -70,3 +70,14 @@
                                    remap-typography
                                    content)))))
 
+(defn remove-external-typographies
+  "Change the shape so that any use of an external typography now is removed"
+  [shape file-id]
+  (let [remove-ref-file #(dissoc % :typography-ref-file :typography-ref-id)]
+
+    (update shape :content
+            (fn [content]
+              (txt/transform-nodes #(not= (:typography-ref-file %) file-id)
+                                   remove-ref-file
+                                   content)))))
+

common/test/common_tests/geom_point_test.cljc

@@ -203,7 +203,7 @@
 
 (t/deftest halft-round-point
   (let [p1 (gpt/point 1.34567 3.34567)
-        rs (gpt/half-round p1)]
+        rs (gpt/round-step p1 0.5)]
     (t/is (gpt/point? rs))
     (t/is (mth/close? 1.5 (:x rs)))
     (t/is (mth/close? 3.5 (:y rs)))))

common/yarn.lock

@@ -305,10 +305,10 @@ isexe@^2.0.0:
   resolved "https://registry.yarnpkg.com/isexe/-/isexe-2.0.0.tgz#e8fbf374dc556ff8947a10dcb0572d633f2cfa10"
   integrity sha1-6PvzdNxVb/iUehDcsFctYz8s+hA=
 
-luxon@^1.27.0:
-  version "1.27.0"
-  resolved "https://registry.yarnpkg.com/luxon/-/luxon-1.27.0.tgz#ae10c69113d85dab8f15f5e8390d0cbeddf4f00f"
-  integrity sha512-VKsFsPggTA0DvnxtJdiExAucKdAnwbCCNlMM5ENvHlxubqWd0xhZcdb4XgZ7QFNhaRhilXCFxHuoObP5BNA4PA==
+luxon@^3.1.1:
+  version "3.1.1"
+  resolved "https://registry.yarnpkg.com/luxon/-/luxon-3.1.1.tgz#b492c645b2474fb86f3bd3283213846b99c32c1e"
+  integrity sha512-Ah6DloGmvseB/pX1cAmjbFvyU/pKuwQMQqz7d0yvuDlVYLTs2WeDHQMpC8tGjm1da+BriHROW/OEIT/KfYg6xw==
 
 md5.js@^1.3.4:
   version "1.3.5"
@@ -533,10 +533,10 @@ shadow-cljs-jar@1.3.2:
   resolved "https://registry.yarnpkg.com/shadow-cljs-jar/-/shadow-cljs-jar-1.3.2.tgz#97273afe1747b6a2311917c1c88d9e243c81957b"
   integrity sha512-XmeffAZHv8z7451kzeq9oKh8fh278Ak+UIOGGrapyqrFBB773xN8vMQ3O7J7TYLnb9BUwcqadKkmgaq7q6fhZg==
 
-shadow-cljs@2.19.8:
-  version "2.19.8"
-  resolved "https://registry.yarnpkg.com/shadow-cljs/-/shadow-cljs-2.19.8.tgz#1ce96cab3e4903bed8d401ffbe88b8939f5454d3"
-  integrity sha512-6qek3mcAP0hrnC5FxrTebBrgLGpOuhlnp06vdxp6g0M5Gl6w2Y0hzSwa1s2K8fMOkzE4/ciQor75b2y64INgaw==
+shadow-cljs@2.20.16:
+  version "2.20.16"
+  resolved "https://registry.yarnpkg.com/shadow-cljs/-/shadow-cljs-2.20.16.tgz#32e83586fcc91a246b7fb622349135ad84ca1a19"
+  integrity sha512-k33ssZppDkBSYIfKswiKOX/8bNTnHbHoTmwf3KBPXBQkDPptPR3FeedmWtS5vKWnucFTe9DObhM2exKocErIxw==
   dependencies:
     node-libs-browser "^2.2.1"
     readline-sync "^1.4.7"
@@ -552,10 +552,10 @@ source-map-support@^0.4.15:
   dependencies:
     source-map "^0.5.6"
 
-source-map-support@^0.5.19:
-  version "0.5.19"
-  resolved "https://registry.yarnpkg.com/source-map-support/-/source-map-support-0.5.19.tgz#a98b62f86dcaf4f67399648c085291ab9e8fed61"
-  integrity sha512-Wonm7zOCIJzBGQdB+thsPar0kYuCIzYvxZwlBa87yi/Mdjv7Tip2cyVbLj5o0cFPN4EVkuTwb3GDDyUx2DGnGw==
+source-map-support@^0.5.21:
+  version "0.5.21"
+  resolved "https://registry.yarnpkg.com/source-map-support/-/source-map-support-0.5.21.tgz#04fe7c7f9e1ed2d662233c28cb2b35b9f63f6e4f"
+  integrity sha512-uBHU3L3czsIyYXKX88fdrGovxdSCoTGDRZ6SYXtSRxLZUzHg5P/66Ht6uoUlHu9EZod+inXhKo3qQgwXUT/y1w==
   dependencies:
     buffer-from "^1.0.0"
     source-map "^0.6.0"
@@ -664,6 +664,11 @@ ws@^7.4.6:
   resolved "https://registry.yarnpkg.com/ws/-/ws-7.4.6.tgz#5654ca8ecdeee47c33a9a4bf6d28e2be2980377c"
   integrity sha512-YmhHDO4MzaDLB+M9ym/mDA5z0naX8j7SIlT8f8z+I0VtzsRbekxEutHSme7NPS2qE8StCYQNUnfWdXta/Yu85A==
 
+ws@^8.11.0:
+  version "8.11.0"
+  resolved "https://registry.yarnpkg.com/ws/-/ws-8.11.0.tgz#6a0d36b8edfd9f96d8b25683db2f8d7de6e8e143"
+  integrity sha512-HPG3wQd9sNQoT9xHyNCXoDUa+Xw/VevmY9FoHyQ+g+rrMn4j6FB4np7Z0OhdTgjx6MgQLK7jwSy1YecU1+4Asg==
+
 xtend@^4.0.0:
   version "4.0.2"
   resolved "https://registry.yarnpkg.com/xtend/-/xtend-4.0.2.tgz#bb72779f5fa465186b1f438f674fa347fdb5db54"