WIP

✨ Adding prettier to ci

.circleci/config.yml

@@ -47,6 +47,13 @@ jobs:
             clj-kondo --version
             clj-kondo --parallel --lint src/
 
+      - run:
+          name: frontend styles prettier
+          working_directory: "./frontend"
+          command: |
+            yarn install
+            yarn run lint-scss
+
       - run:
           name: backend lint
           working_directory: "./backend"
@@ -74,21 +81,27 @@ jobs:
             node target/tests.js
 
           environment:
-            JAVA_HOME: /usr/lib/jvm/openjdk16
-            PATH: /usr/local/nodejs/bin/:/usr/local/bin:/bin:/usr/bin:/usr/lib/jvm/openjdk16/bin
+            PATH: /usr/local/nodejs/bin/:/usr/local/bin:/bin:/usr/bin
+
+      # - run:
+      #     working_directory: "./common"
+      #     name: common tests (cljs)
+      #     command: |
+      #       yarn install
+      #       yarn run compile-test
+      #       node target/test.js
+      # 
+      #     environment:
+      #       PATH: /usr/local/nodejs/bin/:/usr/local/bin:/bin:/usr/bin
 
       - run:
           working_directory: "./common"
-          name: common tests
+          name: common tests (clj)
           command: |
-            yarn install
-            clojure -M:dev:shadow-cljs compile test
-            node target/tests.js
             clojure -X:dev:test
 
           environment:
-            JAVA_HOME: /usr/lib/jvm/openjdk16
-            PATH: /usr/local/nodejs/bin/:/usr/local/bin:/bin:/usr/bin:/usr/lib/jvm/openjdk16/bin
+            PATH: /usr/local/nodejs/bin/:/usr/local/bin:/bin:/usr/bin
 
       - save_cache:
          paths:

.clj-kondo/config.edn

@@ -3,13 +3,13 @@
   rumext.alpha/defc clojure.core/defn
   rumext.alpha/fnc clojure.core/fn
   app.common.data/export clojure.core/def
-  app.db/with-atomic clojure.core/with-open}
+  app.db/with-atomic clojure.core/with-open
+  app.common.logging/with-context clojure.core/do}
 
  :hooks
  {:analyze-call
   {app.common.data/export hooks.export/export
    potok.core/reify hooks.export/potok-reify
-   cljs.core/specify! hooks.export/clojure-specify
    app.util.services/defmethod hooks.export/service-defmethod
    }}
 

.clj-kondo/hooks/export.clj

@@ -74,5 +74,3 @@
     ;; (prn "==============" rtype (into {} ?meta))
     ;; (prn (api/sexpr result))
     {:node result}))
-
-

.gitignore

@@ -9,6 +9,7 @@ figwheel_server.log
 .nrepl-port
 .cpcache
 .rebel_readline_history
+.nyc_output
 /vendor/**/target
 /cd.md
 node_modules
@@ -32,7 +33,9 @@ node_modules
 /docker/images/bundle*
 /common/.shadow-cljs
 /common/target
+/common/coverage
 /.clj-kondo/.cache
+clj-profiler/
 /bundle*
 /media
 /deploy
@@ -43,3 +46,4 @@ node_modules
 .calva
 .clj-kondo
 .lsp
+/frontend/cypress/videos/*/

CHANGES.md

@@ -4,10 +4,100 @@
 
 ### :boom: Breaking changes
 ### :sparkles: New features
+
+- Add shortcut to create artboard from selected objects [Taiga #2412](https://tree.taiga.io/project/penpot/us/2412).
+- Add shortcut for opacity [Taiga #2442](https://tree.taiga.io/project/penpot/us/2442).
+- Setting fill automatically for new texts [Taiga #2441](https://tree.taiga.io/project/penpot/us/2441).
+- Add shortcut to move action [Github #1213](https://github.com/penpot/penpot/issues/1213).
+- Add alt as mod key to add stroke color from library menu [Taiga #2207](https://tree.taiga.io/project/penpot/us/2207).
+- Add detach in bulk option to context menu [Taiga #2210](https://tree.taiga.io/project/penpot/us/2210).
+- Add penpot look and feel to multiuser cursors [Taiga #1387](https://tree.taiga.io/project/penpot/us/1387).
+- Add actions to go to main component context menu option [Taiga #2053](https://tree.taiga.io/project/penpot/us/2053).
+- Add contrast between component select color and shape select color [Taiga #2121](https://tree.taiga.io/project/penpot/issue/2121).
+- Add animations in interactions [Taiga #2244](https://tree.taiga.io/project/penpot/us/2244).
+
 ### :bug: Bugs fixed
+
+- Fix remove gradient if any when applying color from library [Taiga #2299](https://tree.taiga.io/project/penpot/issue/2299).
+- Fix Enter as key action to exit edit path [Taiga #2444](https://tree.taiga.io/project/penpot/issue/2444).
+- Fix add fill color from palette to groups and components [Taiga #2313](https://tree.taiga.io/project/penpot/issue/2313).
+- Fix default project name in all languages [Taiga #2280](https://tree.taiga.io/project/penpot/issue/2280).
+- Fix line-height and letter-spacing inputs to allow negative values [Taiga #2381](https://tree.taiga.io/project/penpot/issue/2381).
+- Fix typo in Handoff tooltip [Taiga #2428](https://tree.taiga.io/project/penpot/issue/2428).
+- Fix crash when pressing Shift+1 on empty file [#1435](https://github.com/penpot/penpot/issues/1435).
+- Fix masked group resize strange behavior [Taiga #2317](https://tree.taiga.io/project/penpot/issue/2317).
+- Fix problems when exporting all artboards [Taiga #2234](https://tree.taiga.io/project/penpot/issue/2234).
+- Fix problems with team management [#1353](https://github.com/penpot/penpot/issues/1353)
+- Fix problem when importing in shared libraries [#1362](https://github.com/penpot/penpot/issues/1362)
+- Fix problem with join nodes [#1422](https://github.com/penpot/penpot/issues/1422)
+- After team onboarding importing a file will import into the team drafts [Taiga #2408](https://tree.taiga.io/project/penpot/issue/2408)
+- Fix problem exporting shapes from handoff mode [Taiga #2386](https://tree.taiga.io/project/penpot/issue/2386)
+- Fix lock/hide elements in context menu when multiples shapes selected [Taiga #2340](https://tree.taiga.io/project/penpot/issue/2340)
+- Fix problem with booleans [Taiga #2356](https://tree.taiga.io/project/penpot/issue/2356)
+- Fix line-height/letter-spacing inputs behaviour [Taiga #2331](https://tree.taiga.io/project/penpot/issue/2331)
+- Fix dotted style in strokes [Taiga #2312](https://tree.taiga.io/project/penpot/issue/2312)
+- Fix problem when resizing texts inside groups [Taiga #2310](https://tree.taiga.io/project/penpot/issue/2310)
+- Fix problem with multiple exports [Taiga #2468](https://tree.taiga.io/project/penpot/issue/2468)
+- Allow import to continue from recoverable failures [#1412](https://github.com/penpot/penpot/issues/1412)
+- Improved behaviour on text options when not text is selected [Taiga #2390](https://tree.taiga.io/project/penpot/issue/2390)
+- Fix decimal numbers in export viewbox [Taiga #2290](https://tree.taiga.io/project/penpot/issue/2290)
+- Right click over artboard name to open its menu [Taiga #1679](https://tree.taiga.io/project/penpot/issue/1679)
+- Make the default session cookue use SameSite=Lax instead of Strict (causes some issues in latest versions of Chrome).
+- Fix "open in new tab" on dashboard [Taiga #2235](https://tree.taiga.io/project/penpot/issue/2355)
+- Changing pages while comments activated will not close the panel [#1350](https://github.com/penpot/penpot/issues/1350)
+- Fix navigate comments in right sidebar [Taiga #2163](https://tree.taiga.io/project/penpot/issue/2163)
+- Fix keep name of component equal to the shape name [Taiga #2341](https://tree.taiga.io/project/penpot/issue/2341)
+- Fix lossing changes when changing selection and an input was already changed [Taiga #2329](https://tree.taiga.io/project/penpot/issue/2329), [Taiga #2330](https://tree.taiga.io/project/penpot/issue/2330)
+- Fix blur input field when click on viewport [Taiga #2164](https://tree.taiga.io/project/penpot/issue/2164)
+- Fix default page id in workspace [Taiga #2205](https://tree.taiga.io/project/penpot/issue/2205)
+- Fix problem when importing a file with grids [Taiga #2314](https://tree.taiga.io/project/penpot/issue/2314)
+
 ### :arrow_up: Deps updates
+
+- Update devenv docker image dependencies.
+
 ### :heart: Community contributions by (Thank you!)
 
+- Spelling fixes (by @jsoref) [#1340](https://github.com/penpot/penpot/pull/1340).
+- Explain folders in components (by @candideu) [Penpot-docs #42](https://github.com/penpot/penpot-docs/pull/42).
+- Readability improvements of user guide (by @PaulSchulz) [Penpot-docs #50](https://github.com/penpot/penpot-docs/pull/50).
+
+
+# 1.10.4-beta
+
+### :sparkles: Enhacements
+
+- Allow parametrice file snapshoting interval.
+
+### :bug: Bugs fixed
+
+- Fix issue on :mov-object change impl.
+- Minor fix on how file changes log is persisted.
+- Fix many issues on error reporting.
+
+
+# 1.10.3-beta
+
+### :sparkles: Enhacements
+
+- Make all logging asynchronous, this avoid some overhead on jetty threads at cost of logging latency.
+- Increase default session time to 15 days.
+
+### :bug: Bugs fixed
+
+- Fix unexpected exception on saving pages with default grids [#2409](https://tree.taiga.io/project/penpot/issue/2409)
+- Fix react warnings on setting size 1 on row and column grids.
+- Fix minor issues on ZMQ logging listener (used in error reporting service).
+- Remove "ALPHA" from the code.
+- Fix value and nil handling on numeric-input component. This fixes many issues related to typography, components, etc. renaming.
+- Fix NPE on email complains processing.
+- Fix white page after leaving a team.
+- Fix missing leave team button outside members page.
+
+### :arrow_up: Deps updates
+
+- Update log4j2 dependency.
+
 # 1.10.2-beta
 
 ### :bug: Bugs fixed
@@ -39,6 +129,7 @@
 
 ### :sparkles: New features
 
+- Allow ungroup groups in bulk [Taiga #2211](https://tree.taiga.io/project/penpot/us/2211).
 - Enhance corner radius behavior [Taiga #2190](https://tree.taiga.io/project/penpot/issue/2190).
 - Allow preserve scroll position in interactions [Taiga #2250](https://tree.taiga.io/project/penpot/us/2250).
 - Add new onboarding modals.
@@ -63,18 +154,23 @@
 - Add placeholder to create shareable link
 - Fix project files count not refreshing correctly after import [Taiga #2216](https://tree.taiga.io/project/penpot/issue/2216)
 - Remove button after import process finish [Taiga #2215](https://tree.taiga.io/project/penpot/issue/2215)
+- Fix problem with styles in the viewer [Taiga #2467](https://tree.taiga.io/project/penpot/issue/2467)
+- Fix default state in viewer [Taiga #2465](https://tree.taiga.io/project/penpot/issue/2465)
+- Fix division by zero in bool operation [Taiga #2349](https://tree.taiga.io/project/penpot/issue/2349)
 
 ### :heart: Community contributions by (Thank you!)
 
 - To the translation community for the hard work on making penpot
   available on so many languages.
+- Guide to integrate with Azure Directory (by @skrzyneckik) [Penpot-docs #33](https://github.com/penpot/penpot-docs/pull/33).
+- Improve libraries section readability (by @PaulSchulz) [Penpot-docs #39](https://github.com/penpot/penpot-docs/pull/39).
 
 ## 1.9.0-alpha
 
 ### :boom: Breaking changes
 
 - Some stroke-caps can change behaviour.
-- Text display bug fix could potentialy make some texts jump a line.
+- Text display bug fix could potentially make some texts jump a line.
 
 ### :sparkles: New features
 
@@ -113,7 +209,7 @@
 - Fix bug in firefox when a text box is inside a mask [Taiga #2152](https://tree.taiga.io/project/penpot/issue/2152).
 - Fix problem with stroke inside/outside [Taiga #2186](https://tree.taiga.io/project/penpot/issue/2186)
 - Fix masks export area [Taiga #2189](https://tree.taiga.io/project/penpot/issue/2189)
-- Fix paste in place in arboards [Taiga #2188](https://tree.taiga.io/project/penpot/issue/2188)
+- Fix paste in place in artboards [Taiga #2188](https://tree.taiga.io/project/penpot/issue/2188)
 - Fix font size input stuck on selection change [Taiga #2184](https://tree.taiga.io/project/penpot/issue/2184)
 - Fix stroke cut on shapes export [Taiga #2171](https://tree.taiga.io/project/penpot/issue/2171)
 - Fix no color when boolean with an SVG [Taiga #2193](https://tree.taiga.io/project/penpot/issue/2193)
@@ -272,7 +368,7 @@
 ### :bug: Bugs fixed
 
 - Process numeric input changes only if the value actually changed.
-- Remove unnecesary redirect from history when user goes to workspace from dashboard [Taiga #1820](https://tree.taiga.io/project/penpot/issue/1820).
+- Remove unnecessary redirect from history when user goes to workspace from dashboard [Taiga #1820](https://tree.taiga.io/project/penpot/issue/1820).
 - Detach shapes from deleted assets [Taiga #1850](https://tree.taiga.io/project/penpot/issue/1850).
 - Fix tooltip position on view application [Taiga #1819](https://tree.taiga.io/project/penpot/issue/1819).
 - Fix dashboard navigation on moving file to other team [Taiga #1817](https://tree.taiga.io/project/penpot/issue/1817).
@@ -283,7 +379,7 @@
 - Fix negative values in blur [Taiga #1815](https://tree.taiga.io/project/penpot/issue/1815)
 - Fix problem when editing color in group [Taiga #1816](https://tree.taiga.io/project/penpot/issue/1816)
 - Fix resize/rotate with mouse buttons different than left [#1060](https://github.com/penpot/penpot/issues/1060)
-- Fix header partialy visible on fullscreen viewer mode [Taiga #1875](https://tree.taiga.io/project/penpot/issue/1875)
+- Fix header partially visible on fullscreen viewer mode [Taiga #1875](https://tree.taiga.io/project/penpot/issue/1875)
 - Fix dynamic alignment enabled with hidden objects [#1063](https://github.com/penpot/penpot/issues/1063)
 
 
@@ -344,12 +440,12 @@
 ### :bug: Bugs fixed
 
 - Add safety check on reg-objects change impl.
-- Fix custom fonts embbedding issue.
+- Fix custom fonts embedding issue.
 - Fix dashboard ordering issue.
 - Fix problem when creating a component with empty data.
 - Fix problem with moving shapes into frames.
 - Fix problems with mov-objects.
-- Fix unexpected excetion related to rounding integers.
+- Fix unexpected exception related to rounding integers.
 - Fix wrong type usage on libraries changes.
 - Improve editor lifecycle management.
 - Make the navigation async by default.
@@ -367,7 +463,7 @@
 - Transform shapes to path on double click
 - Translate automatic names of new files and projects.
 - Use shift instead of ctrl/cmd to keep aspect ratio [Taiga 1697](https://tree.taiga.io/project/penpot/issue/1697).
-- New translations: Portuguese (Brazil) and Romanias. 
+- New translations: Portuguese (Brazil) and Romanias.
 
 
 ### :bug: Bugs fixed
@@ -552,7 +648,7 @@
 
 - The LDAP configuration variables interpolation starts using `:`
   (example `:username`) instead of `$`. The main reason is avoid
-  unnecesary conflict with bash interpolation.
+  unnecessary conflict with bash interpolation.
 
 
 ### :arrow_up: Deps updates
@@ -575,14 +671,14 @@
 
 - Add emailcatcher and ldap test containers to devenv. [#506](https://github.com/penpot/penpot/pull/506)
 - Add major refactor of internal pubsub/redis code; improves scalability and performance [#640](https://github.com/penpot/penpot/pull/640)
-- Add more chinese transtions [#687](https://github.com/penpot/penpot/pull/687)
+- Add more chinese translations [#687](https://github.com/penpot/penpot/pull/687)
 - Add more presets for artboard [#654](https://github.com/penpot/penpot/pull/654)
 - Add optional loki integration [#645](https://github.com/penpot/penpot/pull/645)
 - Add proper http session lifecycle handling.
 - Allow to set border radius of each rect corner individually
 - Bounce & Complaint handling [#635](https://github.com/penpot/penpot/pull/635)
 - Disable groups interactions when holding "Ctrl" key (deep selection)
-- New action in context menu to "edit" some shapes (binded to key "Enter")
+- New action in context menu to "edit" some shapes (bound to key "Enter")
 
 
 ### :bug: Bugs fixed

CONTRIBUTING.md

@@ -19,9 +19,9 @@ If you found a bug, please report it, as far as possible with:
 - a browser and the browser version used
 - a dev tools console exception stack trace (if it is available)
 
-If you found a bug that you consider better discuse in private (for
+If you found a bug that you consider better discuss in private (for
 example: security bugs), consider first send an email to
-`info@penpot.app`.
+`support@penpot.app`.
 
 **We don't have formal bug bounty program for security reports; this
 is an open source application and your contribution will be recognized

README.md

@@ -70,9 +70,9 @@ You can ask and answer questions, have open-ended conversations, and follow alon
 
 ✉️ [Mail us](mailto:info@penpot.app)
 
-💬 [Github discussions](https://github.com/penpot/penpot/discussions)
+💬 [GitHub discussions](https://github.com/penpot/penpot/discussions)
 
-🐞 [Github issues](mailto:info@penpot.apphttps://github.com/penpot/penpot/issues)
+🐞 [GitHub issues](https://github.com/penpot/penpot/issues)
 
 ✍️️ [Gitter](https://gitter.im/penpot/community)
 
@@ -81,7 +81,7 @@ You can ask and answer questions, have open-ended conversations, and follow alon
 You can ask and answer questions, have open-ended conversations, and follow along on decisions affecting the project.
 Would you like to know more about Penpot? We recommend you to visit our youtube channel and learn more about the functionalities and possibilities of Penpot with our video tutorials.
 
-🎞️ [Youtube channel](https://www.youtube.com/channel/UCAqS8G72uv9P5HG1IfgnQ9g)
+🎞️ [YouTube channel](https://www.youtube.com/channel/UCAqS8G72uv9P5HG1IfgnQ9g)
 
 ## License ##
 

backend/build.clj

@@ -0,0 +1,36 @@
+(ns build
+  (:refer-clojure :exclude [compile])
+  (:require
+   [clojure.tools.build.api :as b]
+   [clojure.java.io]))
+
+(def class-dir "target/classes")
+(def basis (b/create-basis {:project "deps.edn"}))
+(def jar-file "target/penpot.jar")
+
+(defn clean [_]
+  (b/delete {:path "target"}))
+
+(defn jar [_]
+  (b/copy-dir
+   {:src-dirs ["src" "resources"]
+    :target-dir class-dir})
+
+  (b/compile-clj
+   {:basis basis
+    :src-dirs ["src"]
+    :class-dir class-dir})
+
+  (b/uber
+   {:class-dir class-dir
+    :uber-file jar-file
+    :main 'clojure.main
+    :exclude [#"goog.*" #"^javasist.*"]
+    :basis basis}))
+
+(defn compile [_]
+  (b/javac
+   {:src-dirs ["dev/java"]
+    :class-dir class-dir
+    :basis basis
+    :javac-opts ["-source" "11" "-target" "11"]}))

backend/deps.edn

@@ -1,81 +1,77 @@
-{
- ;; :mvn/repos
- ;; {"central" {:url "https://repo1.maven.org/maven2/"}
- ;;  "clojars" {:url "https://clojars.org/repo"}
- ;;  "jcenter" {:url "https://jcenter.bintray.com/"}
- ;;  }
- :deps
- {penpot/common
-  {:local/root "../common"}
+{:deps
+ {penpot/common {:local/root "../common"}
+  org.clojure/core.async {:mvn/version "1.5.648"}
 
   ;; Logging
   org.zeromq/jeromq {:mvn/version "0.5.2"}
 
   com.taoensso/nippy {:mvn/version "3.1.1"}
-  com.github.luben/zstd-jni {:mvn/version "1.5.0-4"}
+  com.github.luben/zstd-jni {:mvn/version "1.5.1-1"}
+  org.clojure/data.fressian {:mvn/version "1.0.0"}
 
-  ;; NOTE: don't upgrade to latest version, breaking change is
-  ;; introduced on 0.10.0 that suffixes counters with _total if they
-  ;; are not already has this suffix.
-  io.prometheus/simpleclient {:mvn/version "0.9.0"}
-  io.prometheus/simpleclient_hotspot {:mvn/version "0.9.0"}
-  io.prometheus/simpleclient_jetty {:mvn/version "0.9.0"
+  io.prometheus/simpleclient {:mvn/version "0.14.1"}
+  io.prometheus/simpleclient_hotspot {:mvn/version "0.14.1"}
+  io.prometheus/simpleclient_jetty {:mvn/version "0.14.1"
                                     :exclusions [org.eclipse.jetty/jetty-server
                                                  org.eclipse.jetty/jetty-servlet]}
-  io.prometheus/simpleclient_httpserver {:mvn/version "0.9.0"}
+  io.prometheus/simpleclient_httpserver {:mvn/version "0.14.1"}
 
   io.lettuce/lettuce-core {:mvn/version "6.1.5.RELEASE"}
   java-http-clj/java-http-clj {:mvn/version "0.4.3"}
 
-  info.sunng/ring-jetty9-adapter {:mvn/version "0.15.2"}
-  com.github.seancorfield/next.jdbc {:mvn/version "1.2.709"}
-  metosin/reitit-ring {:mvn/version "0.5.15"}
-  org.postgresql/postgresql {:mvn/version "42.2.23"}
-  com.zaxxer/HikariCP {:mvn/version "5.0.0"}
+  funcool/yetti {:git/tag "v4.0" :git/sha "59ed2a7"
+                 :git/url "https://github.com/funcool/yetti.git"
+                 :exclusions [org.slf4j/slf4j-api]}
 
+  com.github.seancorfield/next.jdbc {:mvn/version "1.2.761"}
+  metosin/reitit-ring {:mvn/version "0.5.15"}
+  org.postgresql/postgresql {:mvn/version "42.3.1"}
+  com.zaxxer/HikariCP {:mvn/version "5.0.0"}
   funcool/datoteka {:mvn/version "2.0.0"}
 
   buddy/buddy-core {:mvn/version "1.10.1"}
   buddy/buddy-hashers {:mvn/version "1.8.1"}
   buddy/buddy-sign {:mvn/version "3.4.1"}
 
-  org.jsoup/jsoup {:mvn/version "1.14.2"}
+  org.jsoup/jsoup {:mvn/version "1.14.3"}
   org.im4java/im4java {:mvn/version "1.4.0"}
   org.lz4/lz4-java {:mvn/version "1.8.0"}
 
   org.clojars.pntblnk/clj-ldap {:mvn/version "0.0.17"}
   integrant/integrant {:mvn/version "0.8.0"}
 
-  io.sentry/sentry {:mvn/version "5.1.2"}
+  io.sentry/sentry {:mvn/version "5.5.2"}
 
   ;; Pretty Print specs
-  fipp/fipp {:mvn/version "0.6.24"}
   pretty-spec/pretty-spec {:mvn/version "0.1.4"}
+  software.amazon.awssdk/s3 {:mvn/version "2.17.102"}}
 
-  software.amazon.awssdk/s3 {:mvn/version "2.17.40"}}
-
- :paths ["src" "resources"]
+ :paths ["src" "resources" "target/classes"]
  :aliases
  {:dev
   {:extra-deps
    {com.bhauman/rebel-readline {:mvn/version "RELEASE"}
     org.clojure/tools.namespace {:mvn/version "RELEASE"}
     org.clojure/test.check {:mvn/version "RELEASE"}
-    org.clojure/data.csv {:mvn/version "1.0.0"}
-    com.clojure-goes-fast/clj-async-profiler {:mvn/version "0.5.1"}
-
-    criterium/criterium {:mvn/version "RELEASE"}
+    clojure-humanize/clojure-humanize {:mvn/version "0.2.2"}
+    org.clojure/data.csv {:mvn/version "RELEASE"}
+    com.clojure-goes-fast/clj-async-profiler {:mvn/version "RELEASE"}
     mockery/mockery {:mvn/version "RELEASE"}}
    :extra-paths ["test" "dev"]}
 
+  :build
+  {:extra-deps {io.github.clojure/tools.build {:git/tag "v0.7.4" :git/sha "ac442da"}}
+   :ns-default build}
+
   :kaocha
-  {:extra-deps {lambdaisland/kaocha {:mvn/version "1.0.887"}}
+  {:extra-deps {lambdaisland/kaocha {:mvn/version "RELEASE"}}
    :main-opts ["-m" "kaocha.runner"]}
 
   :test
-  {:extra-deps {io.github.cognitect-labs/test-runner
+  {:extra-paths ["test"]
+   :extra-deps {io.github.cognitect-labs/test-runner
                 {:git/url "https://github.com/cognitect-labs/test-runner.git"
-                 :git/sha "dd6da11611eeb87f08780a30ac8ea6012d4c05ce"}}
+                 :sha "dd6da11611eeb87f08780a30ac8ea6012d4c05ce"}}
    :exec-fn cognitect.test-runner.api/test}
 
   :outdated

backend/dev/java/app/Experiments.java

@@ -0,0 +1,133 @@
+package app;
+
+import clojure.lang.Seqable;
+import clojure.lang.RT;
+import clojure.lang.ISeq;
+import clojure.lang.ILookup;
+import clojure.lang.Keyword;
+
+
+  // static public double[] multiply(final double[] m1, final double m2[]) {
+  //   var result = new double[6];
+  //   result[0] = (m1[0] * m2[0]) + (m1[2] * m2[1]);
+  //   result[1] = (m1[1] * m2[0]) + (m1[3] * m2[1]);
+  //   result[2] = (m1[0] * m2[2]) + (m1[2] * m2[3]);
+  //   result[3] = (m1[1] * m2[2]) + (m1[3] * m2[3]);o
+
+  //   result[4] = (m1[0] * m2[4]) + (m1[2] * m2[5]) + m1[4];
+  //   result[5] = (m1[1] * m2[4]) + (m1[3] * m2[5]) + m1[5];
+  //   return result;
+  // }
+
+
+public class Experiments {
+  static public class Matrix implements Seqable, ILookup {
+    public final double[] buff;
+
+    public Matrix(double a, double b, double c, double d, double e, double f) {
+      buff = new double[6];
+      buff[0] = a;
+      buff[1] = b;
+      buff[2] = c;
+      buff[3] = d;
+      buff[4] = e;
+      buff[5] = f;
+    }
+
+    public Matrix(final double [] otherBuffer) {
+      buff = otherBuffer;
+    }
+
+    public ISeq seq() {
+      return RT.seq(this.buff);
+    }
+
+    public Double valAt(final Object key) {
+      var name = ((Keyword) key).getName();
+      switch(name) {
+      case "a": return this.buff[0];
+      case "b": return this.buff[1];
+      case "c": return this.buff[2];
+      case "d": return this.buff[3];
+      case "e": return this.buff[4];
+      default: return this.buff[5];
+      }
+    }
+
+    public Double valAt(final Object key, Object notFound) {
+      throw new IllegalArgumentException("not supported");
+    }
+  }
+
+  static public Matrix create(double a, double b, double c, double d, double e, double f) {
+    var buff = new double[6];
+    buff[0] = a;
+    buff[1] = b;
+    buff[2] = c;
+    buff[3] = d;
+    buff[4] = e;
+    buff[5] = f;
+    return new Matrix(buff);
+  }
+
+  static public Matrix multiply(final Matrix mt1, final Matrix mt2) {
+    var result = new double[6];
+    var m1 = mt1.buff;
+    var m2 = mt1.buff;
+
+    result[0] = (m1[0] * m2[0]) + (m1[2] * m2[1]);
+    result[1] = (m1[1] * m2[0]) + (m1[3] * m2[1]);
+    result[2] = (m1[0] * m2[2]) + (m1[2] * m2[3]);
+    result[3] = (m1[1] * m2[2]) + (m1[3] * m2[3]);
+    result[4] = (m1[0] * m2[4]) + (m1[2] * m2[5]) + m1[4];
+    result[5] = (m1[1] * m2[4]) + (m1[3] * m2[5]) + m1[5];
+    return new Matrix(result);
+  }
+
+  static private void multiplyMutating(final double[] m1, final double[] m2) {
+
+    var m1a = m1[0];
+    var m1b = m1[1];
+    var m1c = m1[2];
+    var m1d = m1[3];
+    var m1e = m1[4];
+    var m1f = m1[5];
+
+    double[] result = m1;
+    result[0] = (m1a * m2[0]) + (m1c * m2[1]);
+    result[1] = (m1b * m2[0]) + (m1d * m2[1]);
+    result[2] = (m1a * m2[2]) + (m1c * m2[3]);
+    result[3] = (m1b * m2[2]) + (m1d * m2[3]);
+    result[4] = (m1a * m2[4]) + (m1c * m2[5]) + m1e;
+    result[5] = (m1b * m2[4]) + (m1d * m2[5]) + m1f;
+  }
+
+  static public Matrix multiplyBulk(final Matrix m1) {
+    return m1;
+  }
+
+  static public Matrix multiplyBulk(final Matrix m1, final Matrix m2) {
+    return multiply(m1, m2);
+  }
+
+  static public Matrix multiplyBulk(final Matrix m1, final Matrix m2, final Matrix m3) {
+    var result = multiply(m1, m2);
+    multiplyMutating(result.buff, m3.buff);
+    return result;
+  }
+
+  static public Matrix multiplyBulk(final Matrix m1, final Matrix m2, final Matrix m3, final Matrix m4) {
+    var result = multiply(m1, m2);
+    multiplyMutating(result.buff, m3.buff);
+    multiplyMutating(result.buff, m4.buff);
+    return result;
+  };
+
+  static public Matrix multiplyBulk(final Matrix m1, final Matrix m2, final Matrix m3, final Matrix m4, final Matrix m5) {
+    var result = multiply(m1, m2);
+    multiplyMutating(result.buff, m3.buff);
+    multiplyMutating(result.buff, m4.buff);
+    multiplyMutating(result.buff, m5.buff);
+    return result;
+  }
+}

backend/dev/user.clj

@@ -7,12 +7,17 @@
 (ns user
   (:require
    [app.common.exceptions :as ex]
+   [app.common.geom.matrix :as gmt]
+   [app.common.perf :as perf]
+   [app.common.transit :as t]
    [app.config :as cfg]
    [app.main :as main]
    [app.util.blob :as blob]
+   [app.util.fressian :as fres]
    [app.util.json :as json]
    [app.util.time :as dt]
-   [app.util.transit :as t]
+   [clj-async-profiler.core :as prof]
+   [clojure.contrib.humanize :as hum]
    [clojure.java.io :as io]
    [clojure.pprint :refer [pprint print-table]]
    [clojure.repl :refer :all]
@@ -22,31 +27,14 @@
    [clojure.test :as test]
    [clojure.tools.namespace.repl :as repl]
    [clojure.walk :refer [macroexpand-all]]
-   [criterium.core :refer [quick-bench bench with-progress-reporting]]
+   [datoteka.core]
    [integrant.core :as ig]))
 
 (repl/disable-reload! (find-ns 'integrant.core))
+(set! *warn-on-reflection* true)
 
 (defonce system nil)
 
-;; --- Benchmarking Tools
-
-(defmacro run-quick-bench
-  [& exprs]
-  `(with-progress-reporting (quick-bench (do ~@exprs) :verbose)))
-
-(defmacro run-quick-bench'
-  [& exprs]
-  `(quick-bench (do ~@exprs)))
-
-(defmacro run-bench
-  [& exprs]
-  `(with-progress-reporting (bench (do ~@exprs) :verbose)))
-
-(defmacro run-bench'
-  [& exprs]
-  `(bench (do ~@exprs)))
-
 ;; --- Development Stuff
 
 (defn- run-tests
@@ -91,7 +79,77 @@
 
 (defn compression-bench
   [data]
-  (print-table
-   [{:v1 (alength (blob/encode data {:version 1}))
-     :v2 (alength (blob/encode data {:version 2}))
-     :v3 (alength (blob/encode data {:version 3}))}]))
+  (let [humanize (fn [v] (hum/filesize v :binary true :format " %.4f "))]
+    (print-table
+     [{:v1 (humanize (alength (blob/encode data {:version 1})))
+       :v2 (humanize (alength (blob/encode data {:version 2})))
+       :v3 (humanize (alength (blob/encode data {:version 3})))
+       :v4 (humanize (alength (blob/encode data {:version 4})))
+       }])))
+
+(defonce debug-tap
+  (do
+    (add-tap #(locking debug-tap
+                (prn "tap debug:" %)))
+    1))
+
+
+;; (import
+;;  'app.Experiments
+;;  'app.Experiments$Matrix)
+
+;; (defn bench-matrix-multiply
+;;   []
+;;   (let [ma1 (Experiments/create 1 2 3 4 5 6)
+;;         ma2 (Experiments/create 6 5 4 3 2 1)]
+;;     (perf/benchmark
+;;      :f (fn []
+;;           (dotimes [i 100]
+;;             (when-not (Experiments/multiply ma1 ma2)
+;;               (throw (ex-info "foobar" {}))))
+;;           :result)
+;;      :name "java matrix"))
+
+;;   (let [ma1 (gmt/matrix 1 2 3 4 5 6)
+;;         ma2 (gmt/matrix 6 5 4 3 2 1)]
+;;     (perf/benchmark
+;;      :f (fn []
+;;           (dotimes [i 100]
+;;             (when-not (gmt/multiply ma1 ma2)
+;;               (throw (ex-info "foobar" {}))))
+;;           :result)
+;;      :name "orig matrix")))
+
+
+;; (defn bench-matrix-multiply-bulk-5
+;;   []
+;;   (let [ma1 (Experiments/create 1 2 3 4 5 6)
+;;         ma2 (Experiments/create 6 5 4 3 2 1)
+;;         ma3 (Experiments/create 9 8 7 6 5 4)
+;;         ma4 (Experiments/create 7 6 5 4 3 2)
+;;         ma5 (Experiments/create 1 9 2 8 4 7)]
+
+;;     (prn "result1" (seq (Experiments/multiplyBulk ma1 ma2 ma3 ma4 ma5)))
+;;     (perf/benchmark
+;;      :f (fn []
+;;           (dotimes [i 100]
+;;             (when-not (Experiments/multiplyBulk ma1 ma2 ma3 ma4 ma5)
+;;               (throw (ex-info "foobar" {}))))
+;;           :result)
+;;      :name "java matrix"))
+
+;;   (let [ma1 (gmt/matrix 1 2 3 4 5 6)
+;;         ma2 (gmt/matrix 6 5 4 3 2 1)
+;;         ma3 (gmt/matrix 9 8 7 6 5 4)
+;;         ma4 (gmt/matrix 7 6 5 4 3 2)
+;;         ma5 (gmt/matrix 1 9 2 8 4 7)]
+
+;;     (prn "result2" (map second (gmt/multiply ma1 ma2 ma3 ma4 ma5)))
+;;     (perf/benchmark
+;;      :f (fn []
+;;           (dotimes [i 100]
+;;             (when-not (gmt/multiply ma1 ma2 ma3 ma4 ma5)
+;;               (throw (ex-info "foobar" {}))))
+;;           :result)
+;;      :name "orig matrix")))
+

backend/resources/error-list.tmpl

@@ -0,0 +1,94 @@
+<!DOCTYPE html>
+<html>
+  <head>
+    <meta charset="utf-8" />
+    <meta name="robots" content="noindex,nofollow">
+    <meta http-equiv="x-ua-compatible" content="ie=edge" />
+    <title>penpot - error report {{id}}</title>
+    <link rel="stylesheet" href="https://fonts.googleapis.com/css2?family=JetBrains+Mono">
+    <style>
+      * {
+        font-family: "JetBrains Mono", monospace; 
+        font-size: 12px;
+      }
+
+      body {
+        margin: 0px;
+        padding: 0px;
+      }
+      
+      h1 {
+        padding: 0px;
+        margin: 0px;
+        font-size: 14px;
+      }
+
+      main {
+        margin: 20px;
+        margin-top: 40px;
+      }
+
+      nav {
+        position: fixed;
+        width: 100vw;
+        top: 0;
+        left: 0;
+        padding: 5px 20px;
+        display: flex;
+        background: #e3e3e3;
+      }
+
+      nav > div {
+        text-transform: uppercase;
+        font-weight: bold;
+      }
+
+      ul {
+        display: flex;
+        margin: 0px;
+        padding: 0px;
+        flex-direction: column;
+        flex-wrap: wrap;
+        height: calc(100vh - 75px);
+        justify-content: flex-start;
+      }
+
+      li {
+        list-style: none;
+        padding: 0px;
+        margin: 0px;
+        line-height: 18px;
+        min-width: 210px;
+        margin: 0px 20px;
+        cursor: pointer;
+        display: flex;
+        justify-content: center;
+        border-radius: 3px;
+      }
+
+      li:hover {
+        background-color: #e9e9e9;
+      }
+
+      li > a {
+        text-decoration: none;
+        color: inherit;
+      }
+
+    </style>
+  </head>
+  <body>
+
+    <nav>
+      <h1>Latest error reports:</h1>
+    </nav>
+    <main>
+      <ul>
+        {% for item in items %}
+          <li><a href="/dbg/error/{{item.id}}">{{item.created-at}}</a></li>
+        {% endfor %}
+      </ul>
+    </main>
+  </body>
+</html>
+

backend/resources/error-report.tmpl

@@ -13,15 +13,40 @@
       }
       pre {
         margin: 0px;
+        line-height: 17px;
       }
+
+      main {
+        margin: 20px;
+      }
+
+      nav {
+        position: fixed;
+        width: 100vw;
+        top: 0;
+        left: 0;
+        padding: 5px 20px;
+        display: flex;
+        background: #e3e3e3;
+      }
+
+      nav > div {
+        text-transform: uppercase;
+        font-weight: bold;
+      }
+
+      nav > div:not(:last-child) {
+        margin-right: 10px;
+      }
+
       * {
         font-family: "JetBrains Mono", monospace; 
         font-size: 12px;
       }
       .table {
+        margin-top: 25px;
         display: flex;
         flex-direction: column;
-        margin: 10px;
       }
 
       .table-row {
@@ -34,6 +59,9 @@
         font-weight: 600;
         width: 60px;
         padding: 4px;
+
+        padding-top: 40px;
+        margin-top: -40px;
       }
 
       .table-val {
@@ -43,7 +71,7 @@
       }
 
       .multiline {
-        margin-top: 15px;
+        margin-top: 30px;
         flex-direction: column;
       }
 
@@ -57,139 +85,70 @@
     </style>
   </head>
   <body>
-    <div class="table">
-      <div class="table-row">
-        <div class="table-key" title="Error ID">ERID: </div>
-        <div class="table-val">{{id}}</div>
-      </div>
-      {% if profile-id %}
-      <div class="table-row">
-        <div class="table-key" title="Profile ID">PFID: </div>
-        <div class="table-val">{{profile-id}}</div>
-      </div>
-      {% endif %}
 
-      {% if user-agent %}
-      <div class="table-row">
-        <div class="table-key">UAGT: </div>
-        <div class="table-val">{{user-agent}}</div>
-      </div>
-      {% endif %}
-
-      {% if frontend-version %}
-      <div class="table-row">
-        <div class="table-key">FVER: </div>
-        <div class="table-val">{{frontend-version}}</div>
-      </div>
-      {% endif %}
-
-      <div class="table-row">
-        <div class="table-key">BVER: </div>
-        <div class="table-val">{{version}}</div>
-      </div>
-
-      {% if host %}
-      <div class="table-row">
-        <div class="table-key">HOST: </div>
-        <div class="table-val">{{host}}</div>
-      </div>
-      {% endif %}
-
-      {% if tenant %}
-      <div class="table-row">
-        <div class="table-key">ENV: </div>
-        <div class="table-val">{{tenant}}</div>
-      </div>
-      {% endif %}
-
-      {% if public-uri %}
-      <div class="table-row">
-        <div class="table-key">PURI: </div>
-        <div class="table-val">{{public-uri}}</div>
-      </div>
-      {% endif %}
-
-      {% if type %}
-      <div class="table-row">
-        <div class="table-key">TYPE: </div>
-        <div class="table-val">{{type}}</div>
-      </div>
-      {% endif %}
-
-      {% if code %}
-      <div class="table-row">
-        <div class="table-key">CODE: </div>
-        <div class="table-val">{{code}}</div>
-      </div>
-      {% endif %}
-
-      {% if error %}
-      <div class="table-row">
-        <div class="table-key">CLSS: </div>
-        <div class="table-val">{{error.class}}</div>
-      </div>
-      {% endif %}
-
-      {% if error %}
-      <div class="table-row">
-        <div class="table-key">HINT: </div>
-        <div class="table-val">{{error.message}}</div>
-      </div>
-      {% endif %}
-
-      {% if method %}
-      <div class="table-row">
-        <div class="table-key">PATH: </div>
-        <div class="table-val">{{method|upper}} {{path}}</div>
-      </div>
-      {% endif %}
-
-      {% if explain %}
-        <div>(<a href="#explain">go to explain</a>)</div>
-      {% endif %}
-      {% if data %}
-        <div>(<a href="#edata">go to edata</a>)</div>
-      {% endif %}
-      {% if error %}
-        <div>(<a href="#trace">go to trace</a>)</div>
-      {% endif %}
-
-      {% if params %}
-      <div id="params" class="table-row multiline">
-        <div class="table-key">PARAMS: </div>
-        <div class="table-val">
-          <pre>{{params}}</pre>
-        </div>
-      </div>
-      {% endif %}
-
-      {% if explain %}
-      <div id="explain" class="table-row multiline">
-        <div class="table-key">EXPLAIN: </div>
-        <div class="table-val">
-          <pre>{{explain}}</pre>
-        </div>
-      </div>
+    <nav>
+      
+      <div>[<a href="/dbg/error"><<</a>]</div>
+      <div>[<a href="#context">context</a>]</div>
+      <div>[<a href="#params">params</a>]</div>
+      {% if spec-problems %}
+      <div>[<a href="#edata">spec</a>]</div>
       {% endif %}
 
       {% if data %}
-      <div id="edata" class="table-row multiline">
-        <div class="table-key">EDATA: </div>
-        <div class="table-val">
-          <pre>{{data}}</pre>
-        </div>
-      </div>
+      <div>[<a href="#edata">data</a>]</div>
       {% endif %}
+      {% if trace %}
+      <div>[<a href="#trace">trace</a>]</div>
+      {% endif %}
+    </nav>
+    <main>
+      <div class="table">
+        <div class="table-row multiline">
+          <div id="context" class="table-key">CONTEXT: </div>
+          <div class="table-val">
+            <pre>{{context}}</pre>
+          </div>
+        </div>
 
-      {% if error %}
-      <div id="trace" class="table-row multiline">
-        <div class="table-key">TRACE:</div>
-        <div class="table-val">
-          <pre>{{error.trace}}</pre>
+        {% if params %}
+        <div class="table-row multiline">
+          <div id="params" class="table-key">PARAMS: </div>
+          <div class="table-val">
+            <pre>{{params}}</pre>
+          </div>
         </div>
+        {% endif %}
+
+        <!-- NOTE: this is legacy, for old error data saved on the database -->
+        {% if data %}
+        <div class="table-row multiline">
+          <div id="edata" class="table-key">ERROR DATA: </div>
+          <div class="table-val">
+            <pre>{{data}}</pre>
+          </div>
+        </div>
+        {% endif %}
+
+        {% if spec-problems %}
+        <div class="table-row multiline">
+          <div id="spec-problems" class="table-key">SPEC PROBLEMS: </div>
+          <div class="table-val">
+            <pre>{{spec-problems}}</pre>
+          </div>
+        </div>
+        {% endif %}
+
+        {% if trace %}
+        <div class="table-row multiline">
+          <div id="trace" class="table-key">TRACE:</div>
+          <div class="table-val">
+            <pre>{{trace}}</pre>
+          </div>
+        </div>
+        {% endif %}
       </div>
-      {% endif %}
-    </div>
+    </main>
   </body>
 </html>
 

backend/resources/log4j2-devenv.xml

@@ -2,7 +2,7 @@
 <Configuration status="info" monitorInterval="30">
   <Appenders>
     <Console name="console" target="SYSTEM_OUT">
-      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] [%t] %level{length=1} %logger{36} - %msg%n"/>
+      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"/>
     </Console>
 
     <RollingFile name="main" fileName="logs/main.log" filePattern="logs/main-%i.log">

backend/resources/log4j2.xml

@@ -2,7 +2,7 @@
 <Configuration status="info" monitorInterval="60">
   <Appenders>
     <Console name="console" target="SYSTEM_OUT">
-      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] [%t] %level{length=1} %logger{36} - %msg%n"/>
+      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"/>
     </Console>
   </Appenders>
 

backend/scripts/build

@@ -1,79 +1,20 @@
-#!/usr/bin/env bb
+#!/usr/bin/env bash
 
-;; 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) UXBOX Labs SL
+CURRENT_VERSION=$1;
 
-(ns build
-  (:require
-   [clojure.string :as str]
-   [clojure.java.io :as io]
-   [clojure.pprint :refer [pprint]]
-   [babashka.fs :as fs]
-   [babashka.process :refer [$ check]]))
+set -ex
 
-(defn split-cp
-  [data]
-  (str/split data #":"))
+rm -rf target;
+mkdir -p target/classes;
+mkdir -p target/dist;
+echo "$CURRENT_VERSION" > target/classes/version.txt;
 
-(def classpath
-  (->> ($ clojure -Spath)
-       (check)
-       (:out)
-       (slurp)
-       (split-cp)
-       (map str/trim)))
+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;
+chmod +x target/dist/run.sh;
+chmod +x target/dist/manage.sh;
 
-(def classpath-jars
-  (let [xfm (filter #(str/ends-with? % ".jar"))]
-    (into #{} xfm classpath)))
 
-(def classpath-paths
-  (let [xfm (comp (remove #(str/ends-with? % ".jar"))
-                  (filter #(.isDirectory (io/file %))))]
-    (into #{} xfm classpath)))
 
-(def version
-  (or (first *command-line-args*) "%version%"))
-
-;; Clean previous dist
-(-> ($ rm -rf "./target/dist") check)
-
-;; Create a new dist
-(-> ($ mkdir -p "./target/dist/deps") check)
-
-;; Copy all jar deps into dist
-(run! (fn [item] (-> ($ cp ~item "./target/dist/deps/") check)) classpath-jars)
-
-;; Create the application jar
-(spit "./target/dist/version.txt" version)
-
-(-> ($ jar cvf "./target/dist/deps/app.jar" -C ~(first classpath-paths) ".") check)
-(-> ($ jar uvf "./target/dist/deps/app.jar" -C "./target/dist" "version.txt") check)
-(run! (fn [item]
-        (-> ($ jar uvf "./target/dist/deps/app.jar" -C ~item ".")  check))
-      (rest classpath-paths))
-
-;; Copy logging configuration
-(-> ($ cp "./resources/log4j2.xml" "./target/dist/") check)
-
-;; Create classpath file
-(let [jars (->> (into ["app.jar"] classpath-jars)
-                (map fs/file-name)
-                (map #(fs/path "deps" %))
-                (map str))]
-  (spit "./target/dist/classpath" (str/join ":" jars)))
-
-;; Copy run script template
-(-> ($ cp "./scripts/run.template.sh" "./target/dist/run.sh") check)
-
-;; Copy run script template
-(-> ($ cp "./scripts/manage.template.sh" "./target/dist/manage.sh") check)
-
-;; Add exec permisions to scripts.
-(-> ($ chmod +x "./target/dist/run.sh") check)
-(-> ($ chmod +x "./target/dist/manage.sh") check)
-
-nil

backend/scripts/manage.template.sh

@@ -16,4 +16,4 @@ if [ -f ./environ ]; then
    source ./environ
 fi
 
-exec $JAVA_CMD $JVM_OPTS -classpath $(cat classpath) -Dlog4j2.configurationFile=./log4j2.xml clojure.main -m app.cli.manage "$@"
+exec $JAVA_CMD $JVM_OPTS -jar penpot.jar -m app.cli.manage "$@"

backend/scripts/repl

@@ -2,12 +2,17 @@
 
 export PENPOT_FLAGS="enable-asserts enable-audit-log $PENPOT_FLAGS"
 
-export OPTIONS="-A:jmx-remote:dev \
-                -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
-                -J-Dlog4j2.contextSelector=org.apache.logging.log4j.core.async.AsyncLoggerContextSelector \
-                -J-Dlog4j2.configurationFile=log4j2-devenv.xml \
-                -J-Dclojure.tools.logging.factory=clojure.tools.logging.impl/log4j2-factory \
-                -J-XX:+UseShenandoahGC -J-XX:-OmitStackTraceInFastThrow -J-Xms50m -J-Xmx512m";
+export OPTIONS="
+       -A:jmx-remote:dev \
+       -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
+       -J-Dlog4j2.configurationFile=log4j2-devenv.xml \
+       -J-XX:+UseZGC \
+       -J-XX:-OmitStackTraceInFastThrow \
+       -J-Xms50m -J-Xmx512m \
+       -J-Djdk.attach.allowAttachSelf \
+       -J-XX:+UnlockDiagnosticVMOptions \
+       -J-XX:+DebugNonSafepoints";
+
 
 # export OPTIONS="$OPTIONS -J-XX:+UnlockDiagnosticVMOptions";
 # export OPTIONS="$OPTIONS -J-XX:-TieredCompilation -J-XX:CompileThreshold=10000";

backend/scripts/run.template.sh

@@ -17,4 +17,4 @@ if [ -f ./environ ]; then
 fi
 
 set -x
-exec $JAVA_CMD $JVM_OPTS -classpath "$(cat classpath)" -Dlog4j2.configurationFile=./log4j2.xml "$@" clojure.main -m app.main
+exec $JAVA_CMD $JVM_OPTS "$@" -jar penpot.jar -m app.main

backend/src/app/config.clj

@@ -42,6 +42,7 @@
 
 (def defaults
   {:http-server-port 6060
+   :http-server-host "localhost"
    :host "devenv"
    :tenant "dev"
    :database-uri "postgresql://postgres/penpot"
@@ -51,6 +52,9 @@
    :default-blob-version 3
    :loggers-zmq-uri "tcp://localhost:45556"
 
+   :file-change-snapshot-every 5
+   :file-change-snapshot-timeout "3h"
+
    :public-uri "http://localhost:3449"
    :redis-uri "redis://redis/0"
 
@@ -98,6 +102,10 @@
 (s/def ::audit-log-archive-uri ::us/string)
 (s/def ::audit-log-gc-max-age ::dt/duration)
 
+(s/def ::admins ::us/set-of-str)
+(s/def ::file-change-snapshot-every ::us/integer)
+(s/def ::file-change-snapshot-timeout ::dt/duration)
+
 (s/def ::secret-key ::us/string)
 (s/def ::allow-demo-users ::us/boolean)
 (s/def ::assets-path ::us/string)
@@ -125,6 +133,7 @@
 (s/def ::oidc-roles-attr ::us/keyword)
 (s/def ::host ::us/string)
 (s/def ::http-server-port ::us/integer)
+(s/def ::http-server-host ::us/string)
 (s/def ::http-session-idle-max-age ::dt/duration)
 (s/def ::http-session-updater-batch-max-age ::dt/duration)
 (s/def ::http-session-updater-batch-max-size ::us/integer)
@@ -185,6 +194,7 @@
 (s/def ::config
   (s/keys :opt-un [::secret-key
                    ::flags
+                   ::admins
                    ::allow-demo-users
                    ::audit-log-archive-uri
                    ::audit-log-gc-max-age
@@ -193,6 +203,8 @@
                    ::database-username
                    ::default-blob-version
                    ::error-report-webhook
+                   ::file-change-snapshot-every
+                   ::file-change-snapshot-timeout
                    ::user-feedback-destination
                    ::github-client-id
                    ::github-client-secret
@@ -211,6 +223,7 @@
                    ::oidc-roles-attr
                    ::oidc-roles
                    ::host
+                   ::http-server-host
                    ::http-server-port
                    ::http-session-idle-max-age
                    ::http-session-updater-batch-max-age

backend/src/app/db.clj

@@ -27,14 +27,16 @@
    com.zaxxer.hikari.HikariConfig
    com.zaxxer.hikari.HikariDataSource
    com.zaxxer.hikari.metrics.prometheus.PrometheusMetricsTrackerFactory
+   java.io.InputStream
+   java.io.OutputStream
    java.lang.AutoCloseable
    java.sql.Connection
    java.sql.Savepoint
    org.postgresql.PGConnection
    org.postgresql.geometric.PGpoint
+   org.postgresql.jdbc.PgArray
    org.postgresql.largeobject.LargeObject
    org.postgresql.largeobject.LargeObjectManager
-   org.postgresql.jdbc.PgArray
    org.postgresql.util.PGInterval
    org.postgresql.util.PGobject))
 
@@ -94,8 +96,8 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (def initsql
-  (str "SET statement_timeout = 200000;\n"
-       "SET idle_in_transaction_session_timeout = 200000;"))
+  (str "SET statement_timeout = 300000;\n"
+       "SET idle_in_transaction_session_timeout = 300000;"))
 
 (defn- create-datasource-config
   [{:keys [metrics read-only] :or {read-only false} :as cfg}]
@@ -356,7 +358,7 @@
         val (.getValue o)]
     (if (or (= typ "json")
             (= typ "jsonb"))
-      (json/decode-str val)
+      (json/read val)
       val)))
 
 (defn decode-transit-pgobject
@@ -392,7 +394,7 @@
   [data]
   (doto (org.postgresql.util.PGobject.)
     (.setType "jsonb")
-    (.setValue (json/encode-str data))))
+    (.setValue (json/write-str data))))
 
 ;; --- Locks
 

backend/src/app/emails.clj

@@ -66,8 +66,8 @@
                               (:id profile)
                               (db/interval bounce-max-age)])]
 
-      (and (< complaints complaint-threshold)
-           (< bounces bounce-threshold)))))
+      (and (< (or complaints 0) complaint-threshold)
+           (< (or bounces 0) bounce-threshold)))))
 
 (defn has-complaint-reports?
   ([conn email] (has-complaint-reports? conn email nil))

backend/src/app/http.clj

@@ -17,96 +17,71 @@
    [clojure.spec.alpha :as s]
    [integrant.core :as ig]
    [reitit.ring :as rr]
-   [ring.adapter.jetty9 :as jetty])
+   [yetti.adapter :as yt])
   (:import
    org.eclipse.jetty.server.Server
-   org.eclipse.jetty.server.handler.ErrorHandler
    org.eclipse.jetty.server.handler.StatisticsHandler))
 
-(declare router-handler)
+(declare wrap-router)
 
 (s/def ::handler fn?)
 (s/def ::router some?)
-(s/def ::ws (s/map-of ::us/string fn?))
 (s/def ::port ::us/integer)
+(s/def ::host ::us/string)
 (s/def ::name ::us/string)
 
 (defmethod ig/pre-init-spec ::server [_]
   (s/keys :req-un [::port]
-          :opt-un [::ws ::name ::mtx/metrics ::router ::handler]))
+          :opt-un [::name ::mtx/metrics ::router ::handler ::host]))
 
 (defmethod ig/prep-key ::server
   [_ cfg]
   (merge {:name "http"} (d/without-nils cfg)))
 
+(defn- instrument-metrics
+  [^Server server metrics]
+  (let [stats (doto (StatisticsHandler.)
+                (.setHandler (.getHandler server)))]
+    (.setHandler server stats)
+    (mtx/instrument-jetty! (:registry metrics) stats)
+    server))
+
 (defmethod ig/init-key ::server
-  [_ {:keys [handler router ws port name metrics] :as opts}]
-  (l/info :msg "starting http server" :port port :name name)
-  (let [pre-start (fn [^Server server]
-                    (let [handler (doto (ErrorHandler.)
-                                    (.setShowStacks true)
-                                    (.setServer server))]
-                      (.setErrorHandler server ^ErrorHandler handler)
-                      (when metrics
-                        (let [stats (StatisticsHandler.)]
-                          (.setHandler ^StatisticsHandler stats (.getHandler server))
-                          (.setHandler server stats)
-                          (mtx/instrument-jetty! (:registry metrics) stats)))))
-
-        options   (merge
-                   {:port port
-                    :h2c? true
-                    :join? false
-                    :allow-null-path-info true
-                    :configurator pre-start}
-                   (when (seq ws)
-                     {:websockets ws}))
-
-        handler   (cond
-                    (fn? handler)  handler
-                    (some? router) (router-handler router)
-                    :else (ex/raise :type :internal
-                                    :code :invalid-argument
-                                    :hint "Missing `handler` or `router` option."))
-
-        server    (jetty/run-jetty handler options)]
-    (assoc opts :server server)))
+  [_ {:keys [handler router port name metrics host] :as opts}]
+  (l/info :msg "starting http server" :port port :host host :name name)
+  (let [options {:http/port port :http/host host}
+        handler (cond
+                  (fn? handler)  handler
+                  (some? router) (wrap-router router)
+                  :else (ex/raise :type :internal
+                                  :code :invalid-argument
+                                  :hint "Missing `handler` or `router` option."))
+        server  (-> (yt/server handler options)
+                    (cond-> metrics (instrument-metrics metrics)))]
+    (assoc opts :server (yt/start! server))))
 
 (defmethod ig/halt-key! ::server
   [_ {:keys [server name port] :as opts}]
-  (l/info :msg "stoping http server"
-          :name name
-          :port port)
-  (jetty/stop-server server))
+  (l/info :msg "stoping http server" :name name :port port)
+  (yt/stop! server))
 
-(defn- router-handler
+(defn- wrap-router
   [router]
-  (let [handler (rr/ring-handler router
-                                 (rr/routes
-                                  (rr/create-resource-handler {:path "/"})
-                                  (rr/create-default-handler))
-                                 {:middleware [middleware/server-timing]})]
+  (let [default (rr/routes
+                 (rr/create-resource-handler {:path "/"})
+                 (rr/create-default-handler))
+        options {:middleware [middleware/server-timing]}
+        handler (rr/ring-handler router default options)]
     (fn [request]
       (try
         (handler request)
         (catch Throwable e
-          (try
-            (let [cdata (errors/get-error-context request e)]
-              (l/update-thread-context! cdata)
-              (l/error :hint "unhandled exception"
-                       :message (ex-message e)
-                       :error-id (str (:id cdata))
-                       :cause e))
-            {:status 500 :body "internal server error"}
-            (catch Throwable e
-              (l/error :hint "unhandled exception"
-                       :message (ex-message e)
-                       :cause e)
-              {:status 500 :body "internal server error"})))))))
-
+          (l/with-context (errors/get-error-context request e)
+            (l/error :hint (ex-message e) :cause e)
+            {:status 500 :body "internal server error"}))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Http Main Handler (Router)
+;; Http Router
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (s/def ::rpc map?)
@@ -115,17 +90,17 @@
 (s/def ::storage map?)
 (s/def ::assets map?)
 (s/def ::feedback fn?)
-(s/def ::error-report-handler fn?)
+(s/def ::ws fn?)
 (s/def ::audit-http-handler fn?)
+(s/def ::debug map?)
 
 (defmethod ig/pre-init-spec ::router [_]
-  (s/keys :req-un [::rpc ::session ::mtx/metrics
+  (s/keys :req-un [::rpc ::session ::mtx/metrics ::ws
                    ::oauth ::storage ::assets ::feedback
-                   ::error-report-handler
-                   ::audit-http-handler]))
+                   ::debug ::audit-http-handler]))
 
 (defmethod ig/init-key ::router
-  [_ {:keys [session rpc oauth metrics assets feedback] :as cfg}]
+  [_ {:keys [ws session rpc oauth metrics assets feedback debug] :as cfg}]
   (rr/router
    [["/metrics" {:get (:handler metrics)}]
     ["/assets" {:middleware [[middleware/format-response-body]
@@ -136,18 +111,36 @@
      ["/by-file-media-id/:id" {:get (:file-objects-handler assets)}]
      ["/by-file-media-id/:id/thumbnail" {:get (:file-thumbnails-handler assets)}]]
 
-    ["/dbg"
-     ["/error-by-id/:id" {:get (:error-report-handler cfg)}]]
+    ["/dbg" {:middleware [[middleware/params]
+                          [middleware/keyword-params]
+                          [middleware/format-response-body]
+                          [middleware/errors errors/handle]
+                          [middleware/cookies]
+                          [(:middleware session)]]}
+     ["/error-by-id/:id" {:get (:retrieve-error debug)}]
+     ["/error/:id" {:get (:retrieve-error debug)}]
+     ["/error" {:get (:retrieve-error-list debug)}]
+     ["/file/data/:id" {:get (:retrieve-file-data debug)}]
+     ["/file/changes/:id" {:get (:retrieve-file-changes debug)}]]
 
     ["/webhooks"
      ["/sns" {:post (:sns-webhook cfg)}]]
 
+    ["/ws/notifications"
+     {:middleware [[middleware/params]
+                   [middleware/keyword-params]
+                   [middleware/format-response-body]
+                   [middleware/errors errors/handle]
+                   [middleware/cookies]
+                   [(:middleware session)]]
+      :get ws}]
+
     ["/api" {:middleware [[middleware/cors]
                           [middleware/etag]
-                          [middleware/format-response-body]
                           [middleware/params]
                           [middleware/multipart-params]
                           [middleware/keyword-params]
+                          [middleware/format-response-body]
                           [middleware/parse-request-body]
                           [middleware/errors errors/handle]
                           [middleware/cookies]]}

backend/src/app/http/awsns.clj

@@ -173,14 +173,14 @@
 
 (defn- process-report
   [cfg {:keys [type profile-id] :as report}]
-  (l/trace :action "procesing report" :report (pr-str report))
+  (l/trace :action "processing report" :report (pr-str report))
   (cond
     ;; In this case we receive a bounce/complaint notification without
     ;; confirmed identity, we just emit a warning but do nothing about
     ;; it because this is not a normal case. All notifications should
     ;; come with profile identity.
     (nil? profile-id)
-    (l/warn :msg "a notification without identity recevied from AWS"
+    (l/warn :msg "a notification without identity received from AWS"
             :report (pr-str report))
 
     (= "bounce" type)

backend/src/app/http/debug.clj

@@ -0,0 +1,162 @@
+;; 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) UXBOX Labs SL
+
+(ns app.http.debug
+  (:require
+   [app.common.data :as d]
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.common.uuid :as uuid]
+   [app.config :as cf]
+   [app.db :as db]
+   [app.rpc.queries.profile :as profile]
+   [app.util.blob :as blob]
+   [app.util.template :as tmpl]
+   [app.util.time :as dt]
+   [clojure.java.io :as io]
+   [clojure.pprint :as ppr]
+   [cuerdas.core :as str]
+   [integrant.core :as ig]))
+
+(def sql:retrieve-range-of-changes
+  "select revn, changes from file_change where file_id=? and revn >= ? and revn <= ? order by revn")
+
+(def sql:retrieve-single-change
+  "select revn, changes, data from file_change where file_id=? and revn = ?")
+
+(defn authorized?
+  [pool {:keys [profile-id]}]
+  (or (= "devenv" (cf/get :host))
+      (let [profile (ex/ignoring (profile/retrieve-profile-data pool profile-id))
+            admins  (or (cf/get :admins) #{})]
+        (contains? admins (:email profile)))))
+
+(defn prepare-response
+  [body]
+  (when-not body
+    (ex/raise :type :not-found
+              :code :enpty-data
+              :hint "empty response"))
+
+  {:status 200
+   :headers {"content-type" "application/transit+json"}
+   :body body})
+
+(defn retrieve-file-data
+  [{:keys [pool]} request]
+  (when-not (authorized? pool request)
+    (ex/raise :type :authentication
+              :code :only-admins-allowed))
+
+  (let [id    (some-> (get-in request [:path-params :id]) uuid/uuid)
+        revn  (some-> (get-in request [:params :revn]) d/parse-integer)]
+    (when-not id
+      (ex/raise :type :validation
+                :code :missing-arguments))
+
+    (if (integer? revn)
+      (let [fchange (db/exec-one! pool [sql:retrieve-single-change id revn])]
+        (prepare-response (some-> fchange :data blob/decode)))
+
+      (let [file (db/get-by-id pool :file id)]
+        (prepare-response (some-> file :data blob/decode))))))
+
+(defn retrieve-file-changes
+  [{:keys [pool]} request]
+  (when-not (authorized? pool request)
+    (ex/raise :type :authentication
+              :code :only-admins-allowed))
+
+  (let [id    (some-> (get-in request [:path-params :id]) uuid/uuid)
+        revn  (get-in request [:params :revn] "latest")]
+
+    (when (or (not id) (not revn))
+      (ex/raise :type :validation
+                :code :invalid-arguments
+                :hint "missing arguments"))
+
+    (cond
+      (d/num-string? revn)
+      (let [item (db/exec-one! pool [sql:retrieve-single-change id (d/parse-integer revn)])]
+        (prepare-response (some-> item :changes blob/decode vec)))
+
+      (str/includes? revn ":")
+      (let [[start end] (->> (str/split revn #":")
+                             (map str/trim)
+                             (map d/parse-integer))
+            items       (db/exec! pool [sql:retrieve-range-of-changes id start end])]
+        (prepare-response  (some->> items
+                                    (map :changes)
+                                    (map blob/decode)
+                                    (mapcat identity)
+                                    (vec))))
+
+      :else
+      (ex/raise :type :validation :code :invalid-arguments))))
+
+
+(defn retrieve-error
+  [{:keys [pool]} request]
+  (letfn [(parse-id [request]
+            (let [id (get-in request [:path-params :id])
+                  id (us/uuid-conformer id)]
+              (when (uuid? id)
+                id)))
+
+          (retrieve-report [id]
+            (ex/ignoring
+             (some-> (db/get-by-id pool :server-error-report id) :content db/decode-transit-pgobject)))
+
+          (render-template [report]
+            (binding [ppr/*print-right-margin* 300]
+              (let [context (dissoc report :trace :cause :params :data :spec-prob :spec-problems :error :explain)
+                    params  {:context (with-out-str (ppr/pprint context))
+                             :data    (:data report)
+                             :trace   (or (:cause report)
+                                          (:trace report)
+                                          (some-> report :error :trace))
+                             :params  (:params report)}]
+                (-> (io/resource "error-report.tmpl")
+                    (tmpl/render params)))))
+          ]
+
+    (when-not (authorized? pool request)
+      (ex/raise :type :authentication
+                :code :only-admins-allowed))
+
+    (let [result (some-> (parse-id request)
+                         (retrieve-report)
+                         (render-template))]
+      (if result
+        {:status 200
+         :headers {"content-type" "text/html; charset=utf-8"
+                   "x-robots-tag" "noindex"}
+         :body result}
+        {:status 404
+         :body "not found"}))))
+
+(def sql:error-reports
+  "select id, created_at from server_error_report order by created_at desc limit 100")
+
+(defn retrieve-error-list
+  [{:keys [pool]} request]
+  (when-not (authorized? pool request)
+    (ex/raise :type :authentication
+              :code :only-admins-allowed))
+  (let [items (db/exec! pool [sql:error-reports])
+        items (map #(update % :created-at dt/format-instant :rfc1123) items)]
+    {:status 200
+     :headers {"content-type" "text/html; charset=utf-8"
+               "x-robots-tag" "noindex"}
+     :body (-> (io/resource "error-list.tmpl")
+               (tmpl/render {:items items}))}))
+
+(defmethod ig/init-key ::handlers
+  [_ cfg]
+  {:retrieve-file-data (partial retrieve-file-data cfg)
+   :retrieve-file-changes (partial retrieve-file-changes cfg)
+   :retrieve-error (partial retrieve-error cfg)
+   :retrieve-error-list (partial retrieve-error-list cfg)})

backend/src/app/http/errors.clj

@@ -7,11 +7,11 @@
 (ns app.http.errors
   "A errors handling for the http server."
   (:require
-   [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [app.common.uuid :as uuid]
    [clojure.pprint]
+   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]))
 
 (defn- parse-client-ip
@@ -20,44 +20,23 @@
       (get headers "x-real-ip")
       (get request :remote-addr)))
 
-
-(defn- simple-prune
-  ([s] (simple-prune s (* 1024 1024)))
-  ([s max-length]
-   (if (> (count s) max-length)
-     (str (subs s 0 max-length) " [...]")
-     s)))
-
-(defn- stringify-data
-  [data]
-  (binding [clojure.pprint/*print-right-margin* 200]
-    (let [result (with-out-str (clojure.pprint/pprint data))]
-      (simple-prune result (* 1024 1024)))))
-
 (defn get-error-context
   [request error]
   (let [data (ex-data error)]
-    (d/without-nils
-     (merge
-      {:id      (str (uuid/next))
-       :path    (str (:uri request))
-       :method  (name (:request-method request))
-       :hint    (or (:hint data) (ex-message error))
-       :params  (stringify-data (:params request))
-       :data    (stringify-data (dissoc data :explain))
-       :ip-addr (parse-client-ip request)
-       :explain (str/prune (:explain data) (* 1024 1024) "[...]")}
-
-     (when-let [id (:profile-id request)]
-       {:profile-id id})
+    (merge
+     {:id            (uuid/next)
+      :path          (:uri request)
+      :method        (:request-method request)
+      :hint          (or (:hint data) (ex-message error))
+      :params        (l/stringify-data (:params request))
+      :spec-problems (some-> data ::s/problems)
+      :data          (some-> data (dissoc ::s/problems))
+      :ip-addr       (parse-client-ip request)
+      :profile-id    (:profile-id request)}
 
      (let [headers (:headers request)]
        {:user-agent (get headers "user-agent")
-        :frontend-version (get headers "x-frontend-version" "unknown")})
-
-     (when (map? data)
-       {:error-type (:type data)
-        :error-code (:code data)})))))
+        :frontend-version (get headers "x-frontend-version" "unknown")}))))
 
 (defmulti handle-exception
   (fn [err & _rest]
@@ -74,32 +53,19 @@
   {:status 400 :body (ex-data err)})
 
 (defmethod handle-exception :validation
-  [err req]
-  (let [header (get-in req [:headers "accept"])
-        edata  (ex-data err)]
-    (if (and (= :spec-validation (:code edata))
-             (str/starts-with? header "text/html"))
-      {:status 400
-       :headers {"content-type" "text/html"}
-       :body (str "<pre style='font-size:16px'>"
-                  (:explain edata)
-                  "</pre>\n")}
-      {:status 400
-       :body   (dissoc edata :data)})))
+  [err _]
+  (let [edata (ex-data err)]
+    {:status 400 :body (dissoc edata ::s/problems)}))
 
 (defmethod handle-exception :assertion
   [error request]
-  (let [edata (ex-data error)
-        cdata (get-error-context request error)]
-    (l/update-thread-context! cdata)
-    (l/error :hint "internal error: assertion"
-             :error-id (str (:id cdata))
-             :cause error)
-
+  (let [edata (ex-data error)]
+    (l/with-context (get-error-context request error)
+      (l/error :hint (ex-message error) :cause error))
     {:status 500
      :body {:type :server-error
             :code :assertion
-            :data (dissoc edata :data)}}))
+            :data (dissoc edata ::s/problems)}}))
 
 (defmethod handle-exception :not-found
   [err _]
@@ -116,12 +82,10 @@
     (if (and (ex/exception? (:rollback edata))
              (ex/exception? (:handling edata)))
       (handle-exception (:handling edata) request)
-      (let [cdata (get-error-context request error)]
-        (l/update-thread-context! cdata)
-        (l/error :hint "internal error"
-                 :error-message (ex-message error)
-                 :error-id (str (:id cdata))
-                 :cause error)
+      (do
+        (l/with-context (get-error-context request error)
+          (l/error :hint (ex-message error) :cause error))
+
         {:status 500
          :body {:type :server-error
                 :code :unexpected
@@ -130,15 +94,13 @@
 
 (defmethod handle-exception org.postgresql.util.PSQLException
   [error request]
-  (let [cdata (get-error-context request error)
-        state (.getSQLState ^java.sql.SQLException error)]
+  (let [state (.getSQLState ^java.sql.SQLException error)]
 
-    (l/update-thread-context! cdata)
-    (l/error :hint "psql exception"
-             :error-message (ex-message error)
-             :error-id (str (:id cdata))
-             :sql-state state
-             :cause error)
+    (l/with-context (get-error-context request error)
+      (l/error :hint "psql exception"
+               :error-message (ex-message error)
+               :state state
+               :cause error))
 
     (cond
       (= state "57014")

backend/src/app/http/middleware.clj

@@ -9,11 +9,9 @@
    [app.common.logging :as l]
    [app.common.transit :as t]
    [app.config :as cf]
-   [app.metrics :as mtx]
    [app.util.json :as json]
    [buddy.core.codecs :as bc]
    [buddy.core.hash :as bh]
-   [clojure.java.io :as io]
    [ring.middleware.cookies :refer [wrap-cookies]]
    [ring.middleware.keyword-params :refer [wrap-keyword-params]]
    [ring.middleware.multipart-params :refer [wrap-multipart-params]]
@@ -36,49 +34,46 @@
               (t/read! reader)))
 
           (parse-json [body]
-            (let [reader (io/reader body)]
-              (json/read reader)))
-
-          (parse [type body]
-            (try
-              (case type
-                :json (parse-json body)
-                :transit (parse-transit body))
-              (catch Exception e
-                (let [data {:type :parse
-                            :hint "unable to parse request body"
-                            :message (ex-message e)}]
-                  {:status 400
-                   :headers {"content-type" "application/transit+json"}
-                   :body (t/encode-str data {:type :json-verbose})}))))]
-
+            (json/read body))]
     (fn [{:keys [headers body] :as request}]
-      (let [ctype (get headers "content-type")]
-        (handler
-         (case ctype
-           "application/transit+json"
-           (let [params (parse :transit body)]
-             (-> request
-                 (assoc :body-params params)
-                 (update :params merge params)))
+      (try
+        (let [ctype (get headers "content-type")]
+          (handler (case ctype
+                     "application/transit+json"
+                     (let [params (parse-transit body)]
+                       (-> request
+                           (assoc :body-params params)
+                           (update :params merge params)))
 
-           "application/json"
-           (let [params (parse :json body)]
-             (-> request
-                 (assoc :body-params params)
-                 (update :params merge params)))
+                     "application/json"
+                     (let [params (parse-json body)]
+                       (-> request
+                           (assoc :body-params params)
+                           (update :params merge params)))
 
-           request))))))
+                     request)))
+        (catch Exception e
+          (let [data {:type :validation
+                      :code :unable-to-parse-request-body
+                      :hint "malformed params"}]
+            (l/error :hint (ex-message e) :cause e)
+            {:status 400
+             :headers {"content-type" "application/transit+json"}
+             :body (t/encode-str data {:type :json-verbose})}))))))
 
 (def parse-request-body
   {:name ::parse-request-body
    :compile (constantly wrap-parse-request-body)})
 
 (defn- impl-format-response-body
-  [response _request]
-  (let [body (:body response)
-        opts {:type :json}]
+  [response request]
+  (let [body   (:body response)
+        params (:query-params request)
+        opts   {:type (if (contains? params "transit_verbose") :json-verbose :json)}]
     (cond
+      (:ws response)
+      response
+
       (coll? body)
       (-> response
           (update :headers assoc "content-type" "application/transit+json")
@@ -113,11 +108,6 @@
   {:name ::errors
    :compile (constantly wrap-errors)})
 
-(def metrics
-  {:name ::metrics
-   :wrap (fn [handler]
-           (mtx/wrap-counter handler {:id "http__requests_counter"
-                                      :help "Absolute http requests counter."}))})
 (def cookies
   {:name ::cookies
    :compile (constantly wrap-cookies)})

backend/src/app/http/oauth.clj

@@ -130,7 +130,7 @@
         (when-not (set/subset? provider-roles profile-roles)
           (ex/raise :type :internal
                     :code :unable-to-auth
-                    :hint "not enought permissions"))))
+                    :hint "not enough permissions"))))
 
     (cond-> info
       (some? (:invitation-token state))
@@ -268,14 +268,29 @@
 
 (defn- discover-oidc-config
   [{:keys [base-uri] :as opts}]
+
   (let [discovery-uri (u/join base-uri ".well-known/openid-configuration")
-        response      (http/send! {:method :get :uri (str discovery-uri)})]
-    (when (= 200 (:status response))
+        response      (ex/try (http/send! {:method :get :uri (str discovery-uri)}))]
+    (cond
+      (ex/exception? response)
+      (do
+        (l/warn :hint "unable to discover oidc configuration"
+                :discover-uri (str discovery-uri)
+                :cause response)
+        nil)
+
+      (= 200 (:status response))
       (let [data (json/read-str (:body response))]
-        (assoc opts
-               :token-uri (get data "token_endpoint")
-               :auth-uri (get data "authorization_endpoint")
-               :user-uri (get data "userinfo_endpoint"))))))
+        {:token-uri (get data "token_endpoint")
+         :auth-uri  (get data "authorization_endpoint")
+         :user-uri  (get data "userinfo_endpoint")})
+
+      :else
+      (do
+        (l/warn :hint "unable to discover OIDC configuration"
+                :uri (str discovery-uri)
+                :response-status-code (:status response))
+        nil))))
 
 (defn- obfuscate-string
   [s]
@@ -299,17 +314,23 @@
     (if (and (string? (:base-uri opts))
              (string? (:client-id opts))
              (string? (:client-secret opts)))
-      (if (and (string? (:token-uri opts))
-               (string? (:user-uri opts))
-               (string? (:auth-uri opts)))
-        (do
-          (l/info :action "initialize" :provider "oidc" :method "static"
-                  :opts (pr-str (update opts :client-secret obfuscate-string)))
-          (assoc-in cfg [:providers "oidc"] opts))
-        (let [opts (discover-oidc-config opts)]
-          (l/info :action "initialize" :provider "oidc" :method "discover"
-                  :opts (pr-str (update opts :client-secret obfuscate-string)))
-          (assoc-in cfg [:providers "oidc"] opts)))
+      (do
+        (l/debug :hint "initialize oidc provider" :name "generic-oidc"
+                 :opts (update opts :client-secret obfuscate-string))
+        (if (and (string? (:token-uri opts))
+                 (string? (:user-uri opts))
+                 (string? (:auth-uri opts)))
+          (do
+            (l/debug :hint "initialized with user provided configuration")
+            (assoc-in cfg [:providers "oidc"] opts))
+          (do
+            (l/debug :hint "trying to discover oidc provider configuration using BASE_URI")
+            (if-let [opts' (discover-oidc-config opts)]
+              (do
+                (l/debug :hint "discovered opts" :additional-opts opts')
+                (assoc-in cfg [:providers "oidc"] (merge opts opts')))
+
+              cfg))))
       cfg)))
 
 (defn- initialize-google-provider

backend/src/app/http/session.clj

@@ -58,7 +58,7 @@
     (assoc response :cookies {cookie-name {:path "/"
                                            :http-only true
                                            :value id
-                                           :same-site (if cors? :none :strict)
+                                           :same-site (if cors? :none :lax)
                                            :secure secure?}})))
 
 (defn- clear-cookies
@@ -71,7 +71,7 @@
     (if-let [{:keys [id profile-id] :as session} (retrieve-from-request cfg request)]
       (do
         (a/>!! (::events-ch cfg) id)
-        (l/update-thread-context! {:profile-id profile-id})
+        (l/set-context! {:profile-id profile-id})
         (handler (assoc request :profile-id profile-id)))
       (handler request))))
 
@@ -178,7 +178,7 @@
 
 (defmethod ig/prep-key ::gc-task
   [_ cfg]
-  (merge {:max-age (dt/duration {:days 2})}
+  (merge {:max-age (dt/duration {:days 15})}
          (d/without-nils cfg)))
 
 (defmethod ig/init-key ::gc-task

backend/src/app/http/websocket.clj

@@ -0,0 +1,145 @@
+;; 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) UXBOX Labs SL
+
+(ns app.http.websocket
+  "A penpot notification service for file cooperative edition."
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.logging :as l]
+   [app.common.spec :as us]
+   [app.db :as db]
+   [app.metrics :as mtx]
+   [app.util.websocket :as ws]
+   [app.worker :as wrk]
+   [clojure.core.async :as a]
+   [clojure.spec.alpha :as s]
+   [integrant.core :as ig]
+   [yetti.websocket :as yws]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; WEBSOCKET HANDLER
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare send-presence!)
+
+(defmulti handle-message
+  (fn [_wsp message] (:type message)))
+
+(defmethod handle-message :connect
+  [wsp _]
+  (let [{:keys [msgbus file-id team-id session-id ::ws/output-ch]} @wsp
+        sub-ch (a/chan (a/dropping-buffer 32))]
+
+    (swap! wsp assoc :sub-ch sub-ch)
+
+    ;; Start a subscription forwarding goroutine
+    (a/go-loop []
+      (when-let [val (a/<! sub-ch)]
+        (when-not (= (:session-id val) session-id)
+          ;; If we receive a connect message of other user, we need
+          ;; to send an update presence to all participants.
+          (when (= :connect (:type val))
+            (a/<! (send-presence! @wsp :presence)))
+
+          ;; Then, just forward the message
+          (a/>! output-ch val))
+        (recur)))
+
+    (a/go
+      (a/<! (msgbus :sub {:topics [file-id team-id] :chan sub-ch}))
+      (a/<! (send-presence! @wsp :connect)))))
+
+(defmethod handle-message :disconnect
+  [wsp _]
+  (a/close! (:sub-ch @wsp))
+  (send-presence! @wsp :disconnect))
+
+(defmethod handle-message :keepalive
+  [_ _]
+  (a/go :nothing))
+
+(defmethod handle-message :pointer-update
+  [wsp message]
+  (let [{:keys [profile-id file-id session-id msgbus]} @wsp]
+    (msgbus :pub {:topic file-id
+                  :message (assoc message
+                                  :profile-id profile-id
+                                  :session-id session-id)})))
+
+(defmethod handle-message :default
+  [_ message]
+  (a/go
+    (l/log :level :warn
+           :msg "received unexpected message"
+           :message message)))
+
+;; --- IMPL
+
+(defn- send-presence!
+  ([ws] (send-presence! ws :presence))
+  ([{:keys [msgbus session-id profile-id file-id]} type]
+   (msgbus :pub {:topic file-id
+                 :message {:type type
+                           :session-id session-id
+                           :profile-id profile-id}})))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; HTTP HANDLER
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare retrieve-file)
+
+(s/def ::msgbus fn?)
+(s/def ::file-id ::us/uuid)
+(s/def ::session-id ::us/uuid)
+
+(s/def ::handler-params
+  (s/keys :req-un [::file-id ::session-id]))
+
+(defmethod ig/pre-init-spec ::handler [_]
+  (s/keys :req-un [::msgbus ::db/pool ::mtx/metrics ::wrk/executor]))
+
+(defmethod ig/init-key ::handler
+  [_ {:keys [metrics pool] :as cfg}]
+  (let [metrics {:connections (get-in metrics [:definitions :websocket-active-connections])
+                 :messages    (get-in metrics [:definitions :websocket-messages-total])
+                 :sessions    (get-in metrics [:definitions :websocket-session-timing])}]
+    (fn [{:keys [profile-id params] :as req}]
+      (let [params (us/conform ::handler-params params)
+            file   (retrieve-file pool (:file-id params))
+            cfg    (-> (merge cfg params)
+                       (assoc :profile-id profile-id)
+                       (assoc :team-id (:team-id file))
+                       (assoc ::ws/metrics metrics))]
+
+        (when-not profile-id
+          (ex/raise :type :authentication
+                    :hint "Authentication required."))
+
+        (when-not file
+          (ex/raise :type :not-found
+                    :code :object-not-found))
+
+        (when-not (yws/upgrade-request? req)
+          (ex/raise :type :validation
+                    :code :websocket-request-expected
+                    :hint "this endpoint only accepts websocket connections"))
+
+        (->> (ws/handler handle-message cfg)
+             (yws/upgrade req))))))
+
+(def ^:private
+  sql:retrieve-file
+  "select f.id as id,
+          p.team_id as team_id
+     from file as f
+     join project as p on (p.id = f.project_id)
+    where f.id = ?")
+
+(defn- retrieve-file
+  [conn id]
+  (db/exec-one! conn [sql:retrieve-file id]))
+

backend/src/app/loggers/audit.clj

@@ -150,7 +150,7 @@
 (defmethod ig/init-key ::collector
   [_ cfg]
   (when (contains? cf/flags :audit-log)
-    (l/info :msg "intializing audit log collector")
+    (l/info :msg "initializing audit log collector")
     (let [input  (a/chan 512 event-xform)
           buffer (aa/batch input {:max-batch-size 100
                                   :max-batch-age (* 10 1000) ; 10s
@@ -159,7 +159,7 @@
         (when-let [[_type events] (a/<! buffer)]
           (let [res (a/<! (persist-events cfg events))]
             (when (ex/exception? res)
-              (l/error :hint "error on persiting events"
+              (l/error :hint "error on persisting events"
                        :cause res)))
           (recur)))
 
@@ -195,7 +195,7 @@
 ;; Archive Task
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-;; This is a task responsible to send the accomulated events to an
+;; This is a task responsible to send the accumulated events to an
 ;; external service for archival.
 
 (declare archive-events)

backend/src/app/loggers/database.clj

@@ -7,17 +7,13 @@
 (ns app.loggers.database
   "A specific logger impl that persists errors on the database."
   (:require
-   [app.common.exceptions :as ex]
    [app.common.logging :as l]
-   [app.common.spec :as us]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
    [app.util.async :as aa]
-   [app.util.template :as tmpl]
    [app.worker :as wrk]
    [clojure.core.async :as a]
-   [clojure.java.io :as io]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig]))
@@ -36,7 +32,7 @@
     (db/insert! conn :server-error-report
                 {:id id :content (db/tjson event)})))
 
-(defn- parse-context
+(defn- parse-event-data
   [event]
   (reduce-kv
    (fn [acc k v]
@@ -46,22 +42,25 @@
        (str/blank? v)    acc
        :else             (assoc acc k v)))
    {}
-   (:context event)))
+   event))
 
 (defn parse-event
   [event]
-  (-> (parse-context event)
-      (merge (dissoc event :context))
+  (-> (parse-event-data event)
       (assoc :tenant (cf/get :tenant))
       (assoc :host (cf/get :host))
       (assoc :public-uri (cf/get :public-uri))
-      (assoc :version (:full cf/version))))
+      (assoc :version (:full cf/version))
+      (update :id (fn [id] (or id (uuid/next))))))
 
 (defn handle-event
   [{:keys [executor] :as cfg} event]
   (aa/with-thread executor
     (try
-      (let [event (parse-event event)]
+      (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)))
         (persist-on-database! cfg event))
       (catch Exception e
         (l/warn :hint "unexpected exception on database error logger"
@@ -74,7 +73,8 @@
   [_ {:keys [receiver] :as cfg}]
   (l/info :msg "initializing database error persistence")
   (let [output (a/chan (a/sliding-buffer 128)
-                       (filter #(= (:level %) "error")))]
+                       (filter (fn [event]
+                                 (= (:logger/level event) "error"))))]
     (receiver :sub output)
     (a/go-loop []
       (let [msg (a/<! output)]
@@ -88,39 +88,3 @@
 (defmethod ig/halt-key! ::reporter
   [_ output]
   (a/close! output))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Http Handler
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defmethod ig/pre-init-spec ::handler [_]
-  (s/keys :req-un [::db/pool]))
-
-(defmethod ig/init-key ::handler
-  [_ {:keys [pool] :as cfg}]
-  (letfn [(parse-id [request]
-            (let [id (get-in request [:path-params :id])
-                  id (us/uuid-conformer id)]
-              (when (uuid? id)
-                id)))
-          (retrieve-report [id]
-            (ex/ignoring
-             (when-let [{:keys [content] :as row} (db/get-by-id pool :server-error-report id)]
-               (assoc row :content (db/decode-transit-pgobject content)))))
-
-          (render-template [{:keys [content] :as report}]
-            (some-> (io/resource "error-report.tmpl")
-                    (tmpl/render content)))]
-
-
-    (fn [request]
-      (let [result (some-> (parse-id request)
-                           (retrieve-report)
-                           (render-template))]
-        (if result
-          {:status 200
-           :headers {"content-type" "text/html; charset=utf-8"
-                     "x-robots-tag" "noindex"}
-           :body result}
-          {:status 404
-           :body "not found"})))))

backend/src/app/loggers/loki.clj

@@ -30,7 +30,7 @@
 (defmethod ig/init-key ::reporter
   [_ {:keys [receiver uri] :as cfg}]
   (when uri
-    (l/info :msg "intializing loki reporter" :uri uri)
+    (l/info :msg "initializing loki reporter" :uri uri)
     (let [input (a/chan (a/dropping-buffer 512))]
       (receiver :sub input)
       (a/go-loop []
@@ -68,7 +68,7 @@
                                 :timeout 6000
                                 :method :post
                                 :headers {"content-type" "application/json"}
-                                :body (json/encode payload)})]
+                                :body (json/write payload)})]
       (cond
         (= (:status response) 204)
         true

backend/src/app/loggers/mattermost.clj

@@ -25,13 +25,13 @@
   [cfg {:keys [host id public-uri] :as event}]
   (try
     (let [uri  (:uri cfg)
-          text (str "Exception on (host: " host ", url: " public-uri "/dbg/error-by-id/" id ")\n"
+          text (str "Exception on (host: " host ", url: " public-uri "/dbg/error/" id ")\n"
                     (when-let [pid (:profile-id event)]
                       (str "- profile-id: #uuid-" pid "\n")))
           rsp  (http/send! {:uri uri
                             :method :post
                             :headers {"content-type" "application/json"}
-                            :body (json/encode-str {:text text})})]
+                            :body (json/write-str {:text text})})]
       (when (not= (:status rsp) 200)
         (l/error :hint "error on sending data to mattermost"
                  :response (pr-str rsp))))
@@ -62,7 +62,8 @@
   (when uri
     (l/info :msg "initializing mattermost error reporter" :uri uri)
     (let [output (a/chan (a/sliding-buffer 128)
-                         (filter #(= (:level %) "error")))]
+                         (filter (fn [event]
+                                   (= (:logger/level event) "error"))))]
       (receiver :sub output)
       (a/go-loop []
         (let [msg (a/<! output)]

backend/src/app/loggers/zmq.clj

@@ -7,6 +7,7 @@
 (ns app.loggers.zmq
   "A generic ZMQ listener."
   (:require
+   [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [app.common.spec :as us]
    [app.util.json :as json]
@@ -30,10 +31,10 @@
 
 (defmethod ig/init-key ::receiver
   [_ {:keys [endpoint] :as cfg}]
-  (l/info :msg "intializing ZMQ receiver" :bind endpoint)
+  (l/info :msg "initializing ZMQ receiver" :bind endpoint)
   (let [buffer (a/chan 1)
         output (a/chan 1 (comp (filter map?)
-                               (map prepare)))
+                               (keep prepare)))
         mult   (a/mult output)]
     (when endpoint
       (a/thread (start-rcv-loop {:out buffer :endpoint endpoint})))
@@ -52,6 +53,11 @@
   [_ f]
   (a/close! (::buffer (meta f))))
 
+(def ^:private json-mapper
+  (json/mapper
+   {:encode-key-fn str/camel
+    :decode-key-fn (comp keyword str/kebab)}))
+
 (defn- start-rcv-loop
   ([] (start-rcv-loop nil))
   ([{:keys [out endpoint] :or {endpoint "tcp://localhost:5556"}}]
@@ -63,7 +69,7 @@
      (.. socket (setReceiveTimeOut 5000))
      (loop []
        (let [msg (.recv ^ZMQ$Socket socket)
-             msg (json/decode msg)
+             msg (ex/ignoring (json/read msg json-mapper))
              msg (if (nil? msg) :empty msg)]
          (if (a/>!! out msg)
            (recur)
@@ -71,18 +77,30 @@
              (.close ^java.lang.AutoCloseable socket)
              (.close ^java.lang.AutoCloseable zctx))))))))
 
+(s/def ::logger-name string?)
+(s/def ::level string?)
+(s/def ::thread string?)
+(s/def ::time-millis integer?)
+(s/def ::message string?)
+(s/def ::context-map map?)
+(s/def ::throw map?)
+
+(s/def ::log4j-event
+  (s/keys :req-un [::logger-name ::level ::thread ::time-millis ::message]
+          :opt-un [::context-map ::thrown]))
+
 (defn- prepare
   [event]
-  (merge
-   {:logger     (:loggerName event)
-    :level      (str/lower (:level event))
-    :thread     (:thread event)
-    :created-at (dt/instant (:timeMillis event))
-    :message    (:message event)}
-   (when-let [ctx (:contextMap event)]
-     {:context ctx})
-   (when-let [thrown (:thrown event)]
-     {:error
-      {:class (:name thrown)
-       :message (:message thrown)
-       :trace (:extendedStackTrace thrown)}})))
+  (if (s/valid? ::log4j-event event)
+    (merge {:message      (:message event)
+            :created-at   (dt/instant (:time-millis event))
+            :logger/name  (:logger-name event)
+            :logger/level (str/lower (:level event))}
+
+           (when-let [thrown (:thrown event)]
+             {:trace (:extended-stack-trace thrown)})
+
+           (:context-map event))
+    (do
+      (l/warn :hint "invalid event" :event event)
+      nil)))

backend/src/app/main.clj

@@ -9,7 +9,8 @@
    [app.common.logging :as l]
    [app.config :as cf]
    [app.util.time :as dt]
-   [integrant.core :as ig]))
+   [integrant.core :as ig])
+  (:gen-class))
 
 (def system-config
   {:app.db/pool
@@ -22,33 +23,15 @@
     :min-pool-size 0
     :max-pool-size 30}
 
+   :app.migrations/migrations
+   {}
+
    :app.metrics/metrics
-   {:definitions
-    {:profile-register
-     {:name "actions_profile_register_count"
-      :help "A global counter of user registrations."
-      :type :counter}
-
-     :profile-activation
-     {:name "actions_profile_activation_count"
-      :help "A global counter of profile activations"
-      :type :counter}
-
-     :update-file-changes
-     {:name "rpc_update_file_changes_total"
-      :help "A total number of changes submitted to update-file."
-      :type :counter}
-
-     :update-file-bytes-processed
-     {:name "rpc_update_file_bytes_processed_total"
-      :help "A total number of bytes processed by update-file."
-      :type :counter}}}
+   {}
 
    :app.migrations/all
    {:main (ig/ref :app.migrations/migrations)}
 
-   :app.migrations/migrations
-   {}
 
    :app.msgbus/msgbus
    {:backend   (cf/get :msgbus-backend :redis)
@@ -91,23 +74,33 @@
 
    :app.http/server
    {:port    (cf/get :http-server-port)
+    :host    (cf/get :http-server-host)
     :router  (ig/ref :app.http/router)
-    :metrics (ig/ref :app.metrics/metrics)
-    :ws      {"/ws/notifications" (ig/ref :app.notifications/handler)}}
+    :metrics (ig/ref :app.metrics/metrics)}
 
    :app.http/router
-   {:rpc         (ig/ref :app.rpc/rpc)
-    :session     (ig/ref :app.http.session/session)
-    :tokens      (ig/ref :app.tokens/tokens)
-    :public-uri  (cf/get :public-uri)
-    :metrics     (ig/ref :app.metrics/metrics)
-    :oauth       (ig/ref :app.http.oauth/handler)
-    :assets      (ig/ref :app.http.assets/handlers)
-    :storage     (ig/ref :app.storage/storage)
-    :sns-webhook (ig/ref :app.http.awsns/handler)
-    :feedback    (ig/ref :app.http.feedback/handler)
+   {:assets               (ig/ref :app.http.assets/handlers)
+    :feedback             (ig/ref :app.http.feedback/handler)
+    :session              (ig/ref :app.http.session/session)
+    :sns-webhook          (ig/ref :app.http.awsns/handler)
+    :oauth                (ig/ref :app.http.oauth/handler)
+    :debug                (ig/ref :app.http.debug/handlers)
+    :ws                   (ig/ref :app.http.websocket/handler)
+    :metrics              (ig/ref :app.metrics/metrics)
+    :public-uri           (cf/get :public-uri)
+    :storage              (ig/ref :app.storage/storage)
+    :tokens               (ig/ref :app.tokens/tokens)
     :audit-http-handler   (ig/ref :app.loggers.audit/http-handler)
-    :error-report-handler (ig/ref :app.loggers.database/handler)}
+    :rpc                  (ig/ref :app.rpc/rpc)}
+
+   :app.http.debug/handlers
+   {:pool (ig/ref :app.db/pool)}
+
+   :app.http.websocket/handler
+   {:pool     (ig/ref :app.db/pool)
+    :executor (ig/ref :app.worker/executor)
+    :metrics  (ig/ref :app.metrics/metrics)
+    :msgbus   (ig/ref :app.msgbus/msgbus)}
 
    :app.http.assets/handlers
    {:metrics           (ig/ref :app.metrics/metrics)
@@ -120,12 +113,12 @@
    {:pool (ig/ref :app.db/pool)}
 
    :app.http.oauth/handler
-   {:rpc           (ig/ref :app.rpc/rpc)
-    :session       (ig/ref :app.http.session/session)
-    :pool          (ig/ref :app.db/pool)
-    :tokens        (ig/ref :app.tokens/tokens)
-    :audit         (ig/ref :app.loggers.audit/collector)
-    :public-uri    (cf/get :public-uri)}
+   {:rpc        (ig/ref :app.rpc/rpc)
+    :session    (ig/ref :app.http.session/session)
+    :pool       (ig/ref :app.db/pool)
+    :tokens     (ig/ref :app.tokens/tokens)
+    :audit      (ig/ref :app.loggers.audit/collector)
+    :public-uri (cf/get :public-uri)}
 
    :app.rpc/rpc
    {:pool       (ig/ref :app.db/pool)
@@ -137,13 +130,6 @@
     :public-uri (cf/get :public-uri)
     :audit      (ig/ref :app.loggers.audit/collector)}
 
-   :app.notifications/handler
-   {:msgbus   (ig/ref :app.msgbus/msgbus)
-    :pool     (ig/ref :app.db/pool)
-    :session  (ig/ref :app.http.session/session)
-    :metrics  (ig/ref :app.metrics/metrics)
-    :executor (ig/ref :app.worker/executor)}
-
    :app.worker/executor
    {:min-threads 0
     :max-threads 256
@@ -306,9 +292,6 @@
     :pool     (ig/ref :app.db/pool)
     :executor (ig/ref :app.worker/executor)}
 
-   :app.loggers.database/handler
-   {:pool (ig/ref :app.db/pool)}
-
    :app.loggers.sentry/reporter
    {:dsn                (cf/get :sentry-dsn)
     :trace-sample-rate  (cf/get :sentry-trace-sample-rate 1.0)

backend/src/app/media.clj

@@ -202,11 +202,9 @@
             :cause error))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; --- Fonts Generation
+;; Fonts Generation
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(def all-fotmats #{"font/woff2", "font/woff", "font/otf", "font/ttf"})
-
 (defmethod process :generate-fonts
   [{:keys [input] :as params}]
   (letfn [(ttf->otf [data]
@@ -326,7 +324,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn configure-assets-storage
-  "Given storage map, returns a storage configured with the apropriate
+  "Given storage map, returns a storage configured with the appropriate
   backend for assets."
   [storage conn]
   (-> storage

backend/src/app/metrics.clj

@@ -26,27 +26,57 @@
 (declare instrument)
 (declare create-registry)
 (declare create)
+(declare handler)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Defaults
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+(def default-metrics
+  {:profile-register
+   {:name "actions_profile_register_count"
+    :help "A global counter of user registrations."
+    :type :counter}
+
+   :profile-activation
+   {:name "actions_profile_activation_count"
+    :help "A global counter of profile activations"
+    :type :counter}
+
+   :update-file-changes
+   {:name "rpc_update_file_changes_total"
+    :help "A total number of changes submitted to update-file."
+    :type :counter}
+
+   :update-file-bytes-processed
+   {:name "rpc_update_file_bytes_processed_total"
+    :help "A total number of bytes processed by update-file."
+    :type :counter}
+
+   :websocket-active-connections
+   {:name "websocket_active_connections"
+    :help "Active websocket connections gauge"
+    :type :gauge}
+
+   :websocket-messages-total
+   {:name "websocket_message_total"
+    :help "Counter of processed messages."
+    :labels ["op"]
+    :type :counter}
+
+   :websocket-session-timing
+   {:name "websocket_session_timing"
+    :help "Websocket session timing (seconds)."
+    :quantiles []
+    :type :summary}})
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Entry Point
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defn- handler
-  [registry _request]
-  (let [samples  (.metricFamilySamples ^CollectorRegistry registry)
-        writer   (StringWriter.)]
-    (TextFormat/write004 writer samples)
-    {:headers {"content-type" TextFormat/CONTENT_TYPE_004}
-     :body (.toString writer)}))
-
-(s/def ::definitions
-  (s/map-of keyword? map?))
-
-(defmethod ig/pre-init-spec ::metrics [_]
-  (s/keys :opt-un [::definitions]))
-
 (defmethod ig/init-key ::metrics
-  [_ {:keys [definitions] :as cfg}]
+  [_ _]
   (l/info :action "initialize metrics")
   (let [registry    (create-registry)
         definitions (reduce-kv (fn [res k v]
@@ -54,7 +84,7 @@
                                       (create)
                                       (assoc res k)))
                                {}
-                               definitions)]
+                               default-metrics)]
     {:handler (partial handler registry)
      :definitions definitions
      :registry registry}))
@@ -64,6 +94,14 @@
 (s/def ::metrics
   (s/keys :req-un [::registry ::handler]))
 
+(defn- handler
+  [registry _request]
+  (let [samples  (.metricFamilySamples ^CollectorRegistry registry)
+        writer   (StringWriter.)]
+    (TextFormat/write004 writer samples)
+    {:headers {"content-type" TextFormat/CONTENT_TYPE_004}
+     :body (.toString writer)}))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Implementation
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

backend/src/app/migrations.clj

@@ -202,6 +202,9 @@
 
    {:name "0064-mod-audit-log-table"
     :fn (mg/resource "app/migrations/sql/0064-mod-audit-log-table.sql")}
+
+   {:name "0065-add-trivial-spelling-fixes"
+    :fn (mg/resource "app/migrations/sql/0065-add-trivial-spelling-fixes.sql")}
    ])
 
 

backend/src/app/migrations/sql/0035-add-storage-tables.sql

@@ -22,7 +22,7 @@ CREATE TABLE storage_data (
 CREATE INDEX storage_data__id__idx ON storage_data(id);
 
 -- Table used for store inflight upload ids, for later recheck and
--- delete possible staled files that exists on the phisical storage
+-- delete possible staled files that exists on the physical storage
 -- but does not exists in the 'storage_object' table.
 
 CREATE TABLE storage_pending (

backend/src/app/migrations/sql/0062-fix-metadata-media.sql

@@ -1,4 +1,4 @@
--- Fix problem with content-type inconherence
+-- Fix problem with content-type incoherence
 
 UPDATE storage_object so
 SET metadata = jsonb_set(metadata, '{~:content-type}', to_jsonb(fmo.mtype))

backend/src/app/migrations/sql/0065-add-trivial-spelling-fixes.sql

@@ -0,0 +1,2 @@
+ALTER INDEX file__modified_at__has_media_trimed__idx RENAME TO file__modified_at__has_media_trimmed__idx;
+ALTER INDEX media_bject__file_id__idx RENAME TO media_object__file_id__idx;

backend/src/app/migrations/sql/XXXX-drop-obsolete-tables.sql

@@ -1,5 +1,5 @@
 --- This is a second migration but it should be applied when manual
---- migration intervention is alteady executed.
+--- migration intervention is already executed.
 
 ALTER TABLE file_media_object ALTER COLUMN media_id SET NOT NULL;
 DROP TABLE file_media_thumbnail;

backend/src/app/msgbus.clj

@@ -179,18 +179,18 @@
     ;; Add a unique listener to connection
     (.addListener sub-conn
                   (reify RedisPubSubListener
-                    (message [it pattern topic message])
-                    (message [it topic message]
+                    (message [_ _pattern _topic _message])
+                    (message [_ topic message]
                       ;; There are no back pressure, so we use a slidding
                       ;; buffer for cases when the pubsub broker sends
                       ;; more messages that we can process.
                       (let [val {:topic topic :message (blob/decode message)}]
                         (when-not (a/offer! rcv-ch val)
                           (l/warn :msg "dropping message on subscription loop"))))
-                    (psubscribed [it pattern count])
-                    (punsubscribed [it pattern count])
-                    (subscribed [it topic count])
-                    (unsubscribed [it topic count])))
+                    (psubscribed [_ _pattern _count])
+                    (punsubscribed [_ _pattern _count])
+                    (subscribed [_ _topic _count])
+                    (unsubscribed [_ _topic _count])))
 
     (letfn [(subscribe-to-single-topic [nsubs topic chan]
               (let [nsubs (if (nil? nsubs) #{chan} (conj nsubs chan))]
@@ -243,7 +243,7 @@
             (recur))
           (a/close! rcv-ch)))
 
-      ;; Asyncrhonous message processing loop;x
+      ;; Asynchronous message processing loop;x
       (a/go-loop []
         (if-let [{:keys [topic message]} (a/<! rcv-ch)]
           ;; This means we receive data from redis and we need to

backend/src/app/notifications.clj

@@ -1,281 +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) UXBOX Labs SL
-
-(ns app.notifications
-  "A websocket based notifications mechanism."
-  (:require
-   [app.common.logging :as l]
-   [app.common.spec :as us]
-   [app.common.transit :as t]
-   [app.db :as db]
-   [app.metrics :as mtx]
-   [app.util.async :as aa]
-   [app.util.time :as dt]
-   [app.worker :as wrk]
-   [clojure.core.async :as a]
-   [clojure.spec.alpha :as s]
-   [integrant.core :as ig]
-   [ring.adapter.jetty9 :as jetty]
-   [ring.middleware.cookies :refer [wrap-cookies]]
-   [ring.middleware.keyword-params :refer [wrap-keyword-params]]
-   [ring.middleware.params :refer [wrap-params]]))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Http Handler
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(declare retrieve-file)
-(declare websocket)
-(declare handler)
-
-(s/def ::session map?)
-(s/def ::msgbus fn?)
-
-(defmethod ig/pre-init-spec ::handler [_]
-  (s/keys :req-un [::msgbus ::db/pool ::session ::mtx/metrics ::wrk/executor]))
-
-(defmethod ig/init-key ::handler
-  [_ {:keys [session metrics] :as cfg}]
-  (let [wrap-session    (:middleware session)
-
-        mtx-active-connections
-        (mtx/create
-         {:name "websocket_active_connections"
-          :registry (:registry metrics)
-          :type :gauge
-          :help "Active websocket connections."})
-
-        mtx-messages
-        (mtx/create
-         {:name "websocket_message_total"
-          :registry (:registry metrics)
-          :labels ["op"]
-          :type :counter
-          :help "Counter of processed messages."})
-
-        mtx-sessions
-        (mtx/create
-         {:name "websocket_session_timing"
-          :registry (:registry metrics)
-          :quantiles []
-          :help "Websocket session timing (seconds)."
-          :type :summary})
-
-        cfg (assoc cfg
-                   :mtx-active-connections mtx-active-connections
-                   :mtx-messages mtx-messages
-                   :mtx-sessions mtx-sessions
-                   )]
-
-    (-> #(handler cfg %)
-        (wrap-session)
-        (wrap-keyword-params)
-        (wrap-cookies)
-        (wrap-params))))
-
-(s/def ::file-id ::us/uuid)
-(s/def ::session-id ::us/uuid)
-
-(s/def ::websocket-handler-params
-  (s/keys :req-un [::file-id ::session-id]))
-
-(defn- handler
-  [{:keys [pool] :as cfg} {:keys [profile-id params] :as req}]
-  (let [params (us/conform ::websocket-handler-params params)
-        file   (retrieve-file pool (:file-id params))
-        cfg    (merge cfg params
-                      {:profile-id profile-id
-                       :team-id (:team-id file)})]
-    (cond
-      (not profile-id)
-      {:error {:code 403 :message "Authentication required"}}
-
-      (not file)
-      {:error {:code 404 :message "File does not exists"}}
-
-      :else
-      (websocket cfg))))
-
-(def ^:private
-  sql:retrieve-file
-  "select f.id as id,
-          p.team_id as team_id
-     from file as f
-     join project as p on (p.id = f.project_id)
-    where f.id = ?")
-
-(defn- retrieve-file
-  [conn id]
-  (db/exec-one! conn [sql:retrieve-file id]))
-
-
-;; --- WEBSOCKET INIT
-
-(declare handle-connect)
-
-(defn- ws-send
-  [conn data]
-  (try
-    (when (jetty/connected? conn)
-      (jetty/send! conn data)
-      true)
-    (catch java.lang.NullPointerException _e
-      false)))
-
-(defn websocket
-  [{:keys [file-id team-id msgbus executor] :as cfg}]
-  (let [rcv-ch       (a/chan 32)
-        out-ch       (a/chan 32)
-        mtx-aconn    (:mtx-active-connections cfg)
-        mtx-messages (:mtx-messages cfg)
-        mtx-sessions (:mtx-sessions cfg)
-        created-at   (dt/now)
-        ws-send      (mtx/wrap-counter ws-send mtx-messages ["send"])]
-
-    (letfn [(on-connect [conn]
-              ((::mtx/fn mtx-aconn) {:cmd :inc :by 1})
-              ;; A subscription channel should use a lossy buffer
-              ;; because we can't penalize normal clients when one
-              ;; slow client is connected to the room.
-              (let [sub-ch (a/chan (a/dropping-buffer 128))
-                    cfg    (assoc cfg
-                                  :conn conn
-                                  :rcv-ch rcv-ch
-                                  :out-ch out-ch
-                                  :sub-ch sub-ch)]
-
-                (l/trace :event "connect" :session (:session-id cfg))
-
-                ;; Forward all messages from out-ch to the websocket
-                ;; connection
-                (a/go-loop []
-                  (let [val (a/<! out-ch)]
-                    (when (some? val)
-                      (when (a/<! (aa/thread-call executor #(ws-send conn (t/encode-str val))))
-                        (recur)))))
-
-                (a/go
-                  ;; Subscribe to corresponding topics
-                  (a/<! (msgbus :sub {:topics [file-id team-id] :chan sub-ch}))
-                  (a/<! (handle-connect cfg))
-
-                  ;; when connection is closed
-                  ((::mtx/fn mtx-aconn) {:cmd :dec :by 1})
-                  ((::mtx/fn mtx-sessions) {:val (/ (inst-ms (dt/diff created-at (dt/now))) 1000.0)})
-
-                  ;; close subscription
-                  (a/close! sub-ch))))
-
-            (on-error [_conn _e]
-              (l/trace :event "error" :session (:session-id cfg))
-
-              (a/close! out-ch)
-              (a/close! rcv-ch))
-
-            (on-close [_conn _status _reason]
-              (l/trace :event "close" :session (:session-id cfg))
-
-              (a/close! out-ch)
-              (a/close! rcv-ch))
-
-            (on-message [_ws message]
-              (let [message (t/decode-str message)]
-                (when-not (a/offer! rcv-ch message)
-                  (l/warn :msg "drop messages"))))]
-
-      {:on-connect on-connect
-       :on-error on-error
-       :on-close on-close
-       :on-text (mtx/wrap-counter on-message mtx-messages ["recv"])
-       :on-bytes (constantly nil)})))
-
-;; --- CONNECTION INIT
-
-(declare send-presence)
-(declare handle-message)
-(declare start-loop!)
-
-(defn- handle-connect
-  [cfg]
-  (a/go
-    (a/<! (handle-message cfg {:type :connect}))
-    (a/<! (start-loop! cfg))
-    (a/<! (handle-message cfg {:type :disconnect}))))
-
-(defn- start-loop!
-  [{:keys [rcv-ch out-ch sub-ch session-id] :as cfg}]
-  (a/go-loop []
-    (let [timeout    (a/timeout 30000)
-          [val port] (a/alts! [rcv-ch sub-ch timeout])]
-      (cond
-        ;; Process message coming from connected client
-        (and (= port rcv-ch) (some? val))
-        (do
-          (a/<! (handle-message cfg val))
-          (recur))
-
-        ;; Process message coming from pubsub.
-        (and (= port sub-ch) (some? val))
-        (do
-          (when-not (= (:session-id val) session-id)
-            ;; If we receive a connect message of other user, we need
-            ;; to send an update presence to all participants.
-            (when (= :connect (:type val))
-              (a/<! (send-presence cfg :presence)))
-
-            ;; Then, just forward the message
-            (a/>! out-ch val))
-          (recur))
-
-        ;; When timeout channel is signaled, we need to send a ping
-        ;; message to the output channel. TODO: we need to make this
-        ;; more smart.
-        (= port timeout)
-        (do
-          (a/>! out-ch {:type :ping})
-          (recur))))))
-
-(defn send-presence
-  ([cfg] (send-presence cfg :presence))
-  ([{:keys [msgbus session-id profile-id file-id]} type]
-   (a/go
-     (a/<! (msgbus :pub {:topic file-id
-                         :message {:type type
-                                   :session-id session-id
-                                   :profile-id profile-id}})))))
-
-;; --- INCOMING MSG PROCESSING
-
-(defmulti handle-message
-  (fn [_ message] (:type message)))
-
-(defmethod handle-message :connect
-  [cfg _]
-  (send-presence cfg :connect))
-
-(defmethod handle-message :disconnect
-  [cfg _]
-  (send-presence cfg :disconnect))
-
-(defmethod handle-message :keepalive
-  [_ _]
-  (a/go :nothing))
-
-(defmethod handle-message :pointer-update
-  [{:keys [profile-id file-id session-id msgbus] :as cfg} message]
-  (let [message (assoc message
-                       :profile-id profile-id
-                       :session-id session-id)]
-    (msgbus :pub {:topic file-id
-                  :message message})))
-
-(defmethod handle-message :default
-  [_ws message]
-  (a/go
-    (l/log :level :warn
-           :msg "received unexpected message"
-           :message message)))
-

backend/src/app/rpc.clj

@@ -29,7 +29,7 @@
   response)
 
 (defn- rpc-query-handler
-  [methods {:keys [profile-id] :as request}]
+  [methods {:keys [profile-id session-id] :as request}]
   (let [type   (keyword (get-in request [:path-params :type]))
 
         data   (merge (:params request)
@@ -38,7 +38,7 @@
                       {::request request})
 
         data   (if profile-id
-                 (assoc data :profile-id profile-id)
+                 (assoc data :profile-id profile-id ::session-id session-id)
                  (dissoc data :profile-id))
 
         result ((get methods type default-handler) data)
@@ -49,7 +49,7 @@
       ((:transform-response mdata) request))))
 
 (defn- rpc-mutation-handler
-  [methods {:keys [profile-id] :as request}]
+  [methods {:keys [profile-id session-id] :as request}]
   (let [type   (keyword (get-in request [:path-params :type]))
         data   (merge (:params request)
                       (:body-params request)
@@ -57,7 +57,7 @@
                       {::request request})
 
         data   (if profile-id
-                 (assoc data :profile-id profile-id)
+                 (assoc data :profile-id profile-id ::session-id session-id)
                  (dissoc data :profile-id))
 
         result ((get methods type default-handler) data)

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

@@ -174,7 +174,7 @@
                                  :content content})]
 
         ;; NOTE: this is done in SQL instead of using db/update!
-        ;; helper bacause currently the helper does not allow pass raw
+        ;; 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.

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

@@ -36,7 +36,8 @@
                   :is-active true
                   :deleted-at (dt/in-future cf/deletion-delay)
                   :password password
-                  :props {:onboarding-viewed true}}]
+                  :props {}
+                  }]
 
     (when-not (contains? cf/flags :demo-users)
       (ex/raise :type :validation

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

@@ -11,6 +11,7 @@
    [app.common.pages.migrations :as pmg]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
+   [app.config :as cf]
    [app.db :as db]
    [app.metrics :as mtx]
    [app.rpc.permissions :as perms]
@@ -181,7 +182,7 @@
                :library-file-id library-id}))
 
 
-;; --- Mutation: Update syncrhonization status of a link
+;; --- Mutation: Update synchronization status of a link
 
 (declare update-sync)
 
@@ -280,11 +281,13 @@
 (defn- take-snapshot?
   "Defines the rule when file `data` snapshot should be saved."
   [{:keys [revn modified-at] :as file}]
-  ;; The snapshot will be saved every 20 changes or if the last
-  ;; modification is older than 3 hour.
-  (or (zero? (mod revn 20))
-      (> (inst-ms (dt/diff modified-at (dt/now)))
-         (inst-ms (dt/duration {:hours 3})))))
+  (let [freq    (or (cf/get :file-change-snapshot-every) 20)
+        timeout (or (cf/get :file-change-snapshot-timeout)
+                    (dt/duration {:hours 1}))]
+    (or (= 1 freq)
+        (zero? (mod revn freq))
+        (> (inst-ms (dt/diff modified-at (dt/now)))
+           (inst-ms timeout)))))
 
 (defn- delete-from-storage
   [{:keys [storage] :as cfg} file]
@@ -309,6 +312,8 @@
                   (mapcat :changes changes-with-metadata)
                   changes)
 
+        changes (vec changes)
+
         ;; Trace the number of changes processed
         _       ((::mtx/fn mtx1) {:by (count changes)})
 
@@ -409,7 +414,6 @@
   [conn project-id]
   (:team-id (db/get-by-id conn :project project-id {:columns [:team-id]})))
 
-
 ;; TEMPORARY FILE CREATION
 
 (s/def ::create-temp-file ::create-file)

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

@@ -62,7 +62,7 @@
                    (= :image (:type form)))
               (update-in [:metadata :id] #(get index % %))))
 
-          ;; A function responsible to analize all file data and
+          ;; A function responsible to analyze all file data and
           ;; replace the old :component-file reference with the new
           ;; ones, using the provided file-index
           (relink-shapes [data]
@@ -294,7 +294,7 @@
       ;; move all files to the project
       (db/exec-one! conn [sql:move-files project-id fids])
 
-      ;; delete posible broken relations on moved files
+      ;; delete possible broken relations on moved files
       (db/exec-one! conn [sql:delete-broken-relations pids])
 
       nil)))
@@ -329,7 +329,7 @@
                   {:team-id team-id}
                   {:id project-id})
 
-      ;; delete posible broken relations on moved files
+      ;; delete possible broken relations on moved files
       (db/exec-one! conn [sql:delete-broken-relations pids])
 
       nil)))

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

@@ -108,7 +108,7 @@
                 :code :email-domain-is-not-allowed)))
 
   ;; Don't allow proceed in preparing registration if the profile is
-  ;; already reported as spamer.
+  ;; already reported as spammer.
   (when (eml/has-bounce-reports? pool (:email params))
     (ex/raise :type :validation
               :code :email-has-permanent-bounces
@@ -177,7 +177,7 @@
              ::audit/profile-id (:id profile)}))
 
         ;; If auth backend is different from "penpot" means user is
-        ;; registring using third party auth mechanism; in this case
+        ;; registering using third party auth mechanism; in this case
         ;; we need to mark this session as logged.
         (not= "penpot" (:auth-backend profile))
         (with-meta (profile/strip-private-attrs profile)
@@ -335,9 +335,9 @@
 ;; --- MUTATION: Logout
 
 (s/def ::logout
-  (s/keys :req-un [::profile-id]))
+  (s/keys :opt-un [::profile-id]))
 
-(sv/defmethod ::logout
+(sv/defmethod ::logout {:auth false}
   [{:keys [session] :as cfg} _]
   (with-meta {}
     {:transform-response (:delete session)}))
@@ -370,6 +370,7 @@
 
 (declare validate-password!)
 (declare update-profile-password!)
+(declare invalidate-profile-session!)
 
 (s/def ::update-profile-password
   (s/keys :req-un [::profile-id ::password ::old-password]))
@@ -378,8 +379,10 @@
   {::rlimit/permits (cf/get :rlimit-password)}
   [{:keys [pool] :as cfg} {:keys [password] :as params}]
   (db/with-atomic [conn pool]
-    (let [profile (validate-password! conn params)]
+    (let [profile    (validate-password! conn params)
+          session-id (:app.rpc/session-id params)]
       (update-profile-password! conn (assoc profile :password password))
+      (invalidate-profile-session! conn (:id profile) session-id)
       nil)))
 
 (defn- validate-password!
@@ -396,6 +399,11 @@
               {:password (derive-password password)}
               {:id id}))
 
+(defn- invalidate-profile-session!
+  "Removes all sessions except the current one."
+  [conn profile-id session-id]
+  (let [sql "delete from http_session where profile_id = ? and id != ?"]
+    (:next.jdbc/update-count (db/exec-one! conn [sql profile-id session-id]))))
 
 ;; --- MUTATION: Update Photo
 
@@ -438,7 +446,7 @@
 ;; --- MUTATION: Request Email Change
 
 (declare request-email-change)
-(declare change-email-inmediatelly)
+(declare change-email-immediately)
 
 (s/def ::request-email-change
   (s/keys :req-un [::email]))
@@ -454,9 +462,9 @@
       (if (or (cf/get :smtp-enabled)
               (contains? cf/flags :smtp))
         (request-email-change cfg params)
-        (change-email-inmediatelly cfg params)))))
+        (change-email-immediately cfg params)))))
 
-(defn- change-email-inmediatelly
+(defn- change-email-immediately
   [{:keys [conn]} {:keys [profile email] :as params}]
   (when (not= email (:email profile))
     (check-profile-existence! conn params))
@@ -639,7 +647,7 @@
   (let [rows (db/exec! conn [sql:owned-teams profile-id])]
     ;; If we found owned teams with more than one profile we don't
     ;; allow delete profile until the user properly transfer ownership
-    ;; or explictly removes all participants from the team.
+    ;; or explicitly removes all participants from the team.
     (when (some #(> (:num-profiles %) 1) rows)
       (ex/raise :type :validation
                 :code :owner-teams-with-people

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

@@ -104,24 +104,53 @@
 
 ;; --- Mutation: Leave Team
 
+(declare role->params)
+
+(s/def ::reassign-to ::us/uuid)
 (s/def ::leave-team
-  (s/keys :req-un [::profile-id ::id]))
+  (s/keys :req-un [::profile-id ::id]
+          :opt-un [::reassign-to]))
 
 (sv/defmethod ::leave-team
-  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [id profile-id reassign-to]}]
   (db/with-atomic [conn pool]
     (let [perms   (teams/get-permissions conn profile-id id)
           members (teams/retrieve-team-members conn id)]
 
-      (when (:is-owner perms)
+      (cond
+        ;; we can only proceed if there are more members in the team
+        ;; besides the current profile
+        (<= (count members) 1)
+        (ex/raise :type :validation
+                  :code :no-enough-members-for-leave
+                  :context {:members (count members)})
+
+        ;; if the `reassign-to` is filled and has a different value
+        ;; than the current profile-id, we proceed to reassing the
+        ;; owner role to profile identified by the `reassign-to`.
+        (and reassign-to (not= reassign-to profile-id))
+        (let [member (d/seek #(= reassign-to (:id %)) members)]
+          (when-not member
+            (ex/raise :type :not-found :code :member-does-not-exist))
+
+          ;; unasign owner role to current profile
+          (db/update! conn :team-profile-rel
+                      {:is-owner false}
+                      {:team-id id
+                       :profile-id profile-id})
+
+          ;; assign owner role to new profile
+          (db/update! conn :team-profile-rel
+                      (role->params :owner)
+                      {:team-id id :profile-id reassign-to}))
+
+        ;; and finally, if all other conditions does not match and the
+        ;; current profile is owner, we dont allow it because there
+        ;; must always be an owner.
+        (:is-owner perms)
         (ex/raise :type :validation
                   :code :owner-cant-leave-team
-                  :hint "reasing owner before leave"))
-
-      (when-not (> (count members) 1)
-        (ex/raise :type :validation
-                  :code :cant-leave-team
-                  :context {:members (count members)}))
+                  :hint "releasing owner before leave"))
 
       (db/delete! conn :team-profile-rel
                   {:profile-id profile-id
@@ -129,14 +158,13 @@
 
       nil)))
 
-
 ;; --- Mutation: Delete Team
 
 (s/def ::delete-team
   (s/keys :req-un [::profile-id ::id]))
 
 ;; TODO: right now just don't allow delete default team, in future it
-;; should raise a speific exception for signal that this acction is
+;; should raise a specific exception for signal that this action is
 ;; not allowed.
 
 (sv/defmethod ::delete-team
@@ -156,7 +184,6 @@
 ;; --- Mutation: Team Update Role
 
 (declare retrieve-team-member)
-(declare role->params)
 
 (s/def ::team-id ::us/uuid)
 (s/def ::member-id ::us/uuid)
@@ -174,8 +201,8 @@
     (let [perms (teams/get-permissions conn profile-id team-id)
           ;; We retrieve all team members instead of query the
           ;; database for a single member. This is just for
-          ;; convenience, if this bocomes a bottleneck or problematic,
-          ;; we will change it to more efficient fetch mechanims.
+          ;; convenience, if this becomes a bottleneck or problematic,
+          ;; we will change it to more efficient fetch mechanisms.
           members (teams/retrieve-team-members conn team-id)
           member  (d/seek #(= member-id (:id %)) members)
 

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

@@ -134,7 +134,7 @@
 
         ;; If the session does not matches the invited member, replace
         ;; the session with a new one matching the invited member.
-        ;; This techinique should be considered secure because the
+        ;; This technique should be considered secure because the
         ;; user clicking the link he already has access to the email
         ;; account.
         (with-meta
@@ -179,7 +179,7 @@
          ::audit/profile-id member-id}))
 
     ;; In this case, we wait until frontend app redirect user to
-    ;; registeration page, the user is correctly registered and the
+    ;; registration page, the user is correctly registered and the
     ;; register mutation call us again with the same token to finally
     ;; create the corresponding team-profile relation from the first
     ;; condition of this if.

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

@@ -84,8 +84,8 @@
    (let [perms  (get-permissions conn profile-id file-id)
          ldata  (retrieve-share-link conn file-id share-id)]
 
-     ;; NOTE: in a future when share-link becomes more powerfull and
-     ;; will allow us specify which parts of the app is availabel, we
+     ;; NOTE: in a future when share-link becomes more powerful and
+     ;; will allow us specify which parts of the app is available, we
      ;; will probably need to tweak this function in order to expose
      ;; this flags to the frontend.
      (cond
@@ -227,7 +227,7 @@
                 (= frame-id uuid/zero)
                 (not (some? (get-in objects [frame-id :thumbnail]))))))
 
-        ;; We need to remove from the attribute :shapes its childrens because
+        ;; We need to remove from the attribute :shapes its children because
         ;; they will not be sent in the data
         remove-frame-children
         (fn [[id shape]]
@@ -260,6 +260,7 @@
 
 (def ^:private sql:team-shared-files
   "select f.id,
+          f.revn,
           f.project_id,
           f.created_at,
           f.modified_at,
@@ -330,6 +331,7 @@
 (def sql:team-recent-files
   "with recent_files as (
      select f.id,
+            f.revn,
             f.project_id,
             f.created_at,
             f.modified_at,

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

@@ -37,10 +37,15 @@
 
 (sv/defmethod ::profile {:auth false}
   [{:keys [pool] :as cfg} {:keys [profile-id] :as params}]
-  (if profile-id
-    (retrieve-profile pool profile-id)
-    {:id uuid/zero
-     :fullname "Anonymous User"}))
+
+  ;; We need to return the anonymous profile object in two cases, when
+  ;; no profile-id is in session, and when db call raises not found. In all other
+  ;; cases we need to reraise the exception.
+  (or (ex/try*
+       #(some->> profile-id (retrieve-profile pool))
+       #(when (not= :not-found (:type (ex-data %))) (throw %)))
+      {:id uuid/zero
+       :fullname "Anonymous User"}))
 
 (def ^:private sql:default-profile-team
   "select t.id, name
@@ -106,6 +111,6 @@
 ;; --- Attrs Helpers
 
 (defn strip-private-attrs
-  "Only selects a publicy visible profile attrs."
+  "Only selects a publicly visible profile attrs."
   [row]
   (dissoc row :password :deleted-at))

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

@@ -21,8 +21,10 @@
           tpr.is_admin,
           tpr.can_edit
      from team_profile_rel as tpr
+     join team as t on (t.id = tpr.team_id)
     where tpr.profile_id = ?
-      and tpr.team_id = ?")
+      and tpr.team_id = ?
+      and t.deleted_at is null")
 
 (defn get-permissions
   [conn profile-id team-id]

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

@@ -65,7 +65,7 @@
         (ex/raise :type :not-found
                   :code :object-not-found))
 
-      ;; When we have only profile, we need to check read permissiones
+      ;; When we have only profile, we need to check read permissions
       ;; on file.
       (when (and profile-id (not slink))
         (files/check-read-permissions! conn profile-id file-id))

backend/src/app/srepl/main.clj

@@ -70,7 +70,7 @@
 
 
 (defn duplicate-file
-  "This is a raw version of duplication of file just only for forensic analisys"
+  "This is a raw version of duplication of file just only for forensic analysis"
   [system file-id email]
   (db/with-atomic [conn (:app.db/pool system)]
     (when-let [profile (some->> (prof/retrieve-profile-data-by-email conn (str/lower email))

backend/src/app/storage.clj

@@ -188,7 +188,7 @@
     object))
 
 (defn clone-object
-  "Creates a clone of the provided object using backend basded efficient
+  "Creates a clone of the provided object using backend based efficient
   method. Always clones objects to the configured default."
   [{:keys [pool conn] :as storage} object]
   (us/assert ::storage storage)
@@ -323,18 +323,18 @@
    returning *;")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Garbage Collection: Analize touched objects
+;; Garbage Collection: Analyze touched objects
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;; This task is part of the garbage collection of storage objects and
-;; is responsible on analizing the touched objects and mark them for deletion
+;; is responsible on analyzing the touched objects and mark them for deletion
 ;; if corresponds.
 ;;
 ;; When file_media_object is deleted, the depending storage_object are
 ;; marked as touched. This means that some files that depend on a
 ;; concrete storage_object are no longer exists and maybe this
-;; storage_object is no longer necessary and can be ellegible for
-;; elimination. This task peridically analizes touched objects and
+;; storage_object is no longer necessary and can be eligible for
+;; elimination. This task periodically analyzes touched objects and
 ;; mark them as freeze (means that has other references and the object
 ;; is still valid) or deleted (no more references to this object so is
 ;; ready to be deleted).
@@ -408,7 +408,7 @@
 ;; For this situations we need to write a "log" of inserted files that
 ;; are checked in some time in future. If physical file exists but the
 ;; database refence does not exists means that leaked file is found
-;; and is inmediatelly deleted. The responsability of this task is
+;; and is immediately deleted. The responsibility of this task is
 ;; check that write log for possible leaked files.
 
 (def recheck-min-age (dt/duration {:hours 1}))

backend/src/app/storage/impl.clj

@@ -117,11 +117,11 @@
       io/IOFactory
       (make-reader [_ opts]
 	    (io/make-reader path opts))
-      (make-writer [_ opts]
+      (make-writer [_ _]
         (throw (UnsupportedOperationException. "not implemented")))
       (make-input-stream [_ opts]
         (io/make-input-stream path opts))
-      (make-output-stream [_ opts]
+      (make-output-stream [_ _]
         (throw (UnsupportedOperationException. "not implemented")))
       clojure.lang.Counted
       (count [_] size)
@@ -138,11 +138,11 @@
       io/IOFactory
       (make-reader [_ opts]
 	    (io/make-reader bais opts))
-      (make-writer [_ opts]
+      (make-writer [_ _]
         (throw (UnsupportedOperationException. "not implemented")))
       (make-input-stream [_ opts]
         (io/make-input-stream bais opts))
-      (make-output-stream [_ opts]
+      (make-output-stream [_ _]
         (throw (UnsupportedOperationException. "not implemented")))
 
       clojure.lang.Counted
@@ -159,11 +159,11 @@
     io/IOFactory
     (make-reader [_ opts]
       (io/make-reader is opts))
-    (make-writer [_ opts]
+    (make-writer [_ _]
       (throw (UnsupportedOperationException. "not implemented")))
     (make-input-stream [_ opts]
       (io/make-input-stream is opts))
-    (make-output-stream [_ opts]
+    (make-output-stream [_ _]
       (throw (UnsupportedOperationException. "not implemented")))
 
     clojure.lang.Counted

backend/src/app/tasks/file_media_gc.clj

@@ -6,7 +6,7 @@
 
 (ns app.tasks.file-media-gc
   "A maintenance task that is responsible to purge the unused media
-  objects from files. A file is ellegible to be garbage collected
+  objects from files. A file is eligible to be garbage collected
   after some period of inactivity (the default threshold is 72h)."
   (:require
    [app.common.logging :as l]
@@ -107,7 +107,7 @@
                :thumbnail-id (:thumbnail-id mobj))
 
       ;; NOTE: deleting the file-media-object in the database
-      ;; automatically marks as toched the referenced storage
+      ;; automatically marks as touched the referenced storage
       ;; objects. The touch mechanism is needed because many files can
       ;; point to the same storage objects and we can't just delete
       ;; them.

backend/src/app/tasks/objects_gc.clj

@@ -129,7 +129,7 @@
     (doseq [{:keys [id] :as profile} profiles]
       (l/trace :action "delete object" :table table :id id)
 
-      ;; Mark the owned teams as deleted; this enables them to be procesed
+      ;; Mark the owned teams as deleted; this enables them to be processed
       ;; in the same transaction in the "team" table step.
       (db/exec-one! conn [sql:mark-owned-teams-deleted id max-age])
 

backend/src/app/tasks/telemetry.clj

@@ -5,7 +5,7 @@
 ;; Copyright (c) UXBOX Labs SL
 
 (ns app.tasks.telemetry
-  "A task that is reponsible to collect anonymous statistical
+  "A task that is responsible to collect anonymous statistical
   information about the current instance and send it to the telemetry
   server."
   (:require
@@ -59,7 +59,7 @@
         response    (http/send! {:method :post
                                  :uri (:uri cfg)
                                  :headers {"content-type" "application/json"}
-                                 :body (json/encode-str data)})]
+                                 :body (json/write-str data)})]
     (when (> (:status response) 206)
       (ex/raise :type :internal
                 :code :invalid-response

backend/src/app/util/blob.clj

@@ -10,6 +10,7 @@
   (:require
    [app.common.transit :as t]
    [app.config :as cf]
+   [app.util.fressian :as fres]
    [taoensso.nippy :as n])
   (:import
    java.io.ByteArrayInputStream
@@ -21,23 +22,28 @@
    net.jpountz.lz4.LZ4FastDecompressor
    net.jpountz.lz4.LZ4Compressor))
 
+(set! *warn-on-reflection* true)
+
 (def lz4-factory (LZ4Factory/fastestInstance))
 
 (declare decode-v1)
 (declare decode-v2)
 (declare decode-v3)
+(declare decode-v4)
 (declare encode-v1)
 (declare encode-v2)
 (declare encode-v3)
+(declare encode-v4)
 
 (defn encode
   ([data] (encode data nil))
   ([data {:keys [version]}]
-   (let [version (or version (cf/get :default-blob-version 1))]
+   (let [version (or version (cf/get :default-blob-version 3))]
      (case (long version)
        1 (encode-v1 data)
        2 (encode-v2 data)
        3 (encode-v3 data)
+       4 (encode-v4 data)
        (throw (ex-info "unsupported version" {:version version}))))))
 
 (defn decode
@@ -51,6 +57,7 @@
         1 (decode-v1 data ulen)
         2 (decode-v2 data ulen)
         3 (decode-v3 data ulen)
+        4 (decode-v4 data ulen)
         (throw (ex-info "unsupported version" {:version version}))))))
 
 ;; --- IMPL
@@ -122,3 +129,26 @@
     (Zstd/decompressByteArray ^bytes udata 0 ulen
                               ^bytes cdata 6 (- (alength cdata) 6))
     (t/decode udata {:type :json})))
+
+(defn- encode-v4
+  [data]
+  (let [data  (fres/encode data)
+        dlen  (alength ^bytes data)
+        mlen  (Zstd/compressBound dlen)
+        cdata (byte-array mlen)
+        clen  (Zstd/compressByteArray ^bytes cdata 0 mlen
+                                      ^bytes data 0 dlen
+                                      0)]
+    (with-open [^ByteArrayOutputStream baos (ByteArrayOutputStream. (+ (alength cdata) 2 4))
+                ^DataOutputStream dos (DataOutputStream. baos)]
+      (.writeShort dos (short 4)) ;; version number
+      (.writeInt dos (int dlen))
+      (.write dos ^bytes cdata (int 0) clen)
+      (.toByteArray baos))))
+
+(defn- decode-v4
+  [^bytes cdata ^long ulen]
+  (let [udata (byte-array ulen)]
+    (Zstd/decompressByteArray ^bytes udata 0 ulen
+                              ^bytes cdata 6 (- (alength cdata) 6))
+    (fres/decode udata)))

backend/src/app/util/emails.clj

@@ -206,7 +206,7 @@
                 :content html}]))}))
 
 (s/def ::priority #{:high :low})
-(s/def ::to (s/or :sigle ::us/email
+(s/def ::to (s/or :single ::us/email
                   :multi (s/coll-of ::us/email)))
 (s/def ::from ::us/email)
 (s/def ::reply-to ::us/email)

backend/src/app/util/fressian.clj

@@ -0,0 +1,259 @@
+;; 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) UXBOX Labs SL
+
+(ns app.util.fressian
+  (:require
+   [app.common.geom.matrix :as gmt]
+   [app.common.geom.point :as gpt]
+   [clojure.data.fressian :as fres])
+  (:import
+   clojure.lang.Ratio
+   org.fressian.handlers.WriteHandler
+   org.fressian.handlers.ReadHandler
+   org.fressian.Writer
+   org.fressian.Reader
+   org.fressian.StreamingWriter
+   app.common.geom.matrix.Matrix
+   app.common.geom.point.Point
+   java.io.ByteArrayInputStream
+   java.io.ByteArrayOutputStream))
+
+;; --- MISC
+
+(set! *warn-on-reflection* true)
+
+(defn str->bytes
+  ([^String s]
+   (str->bytes s "UTF-8"))
+  ([^String s, ^String encoding]
+   (.getBytes s encoding)))
+
+(defn write-named
+  [tag ^Writer w s]
+  (.writeTag w tag 2)
+  (.writeObject w (namespace s) true)
+  (.writeObject w (name s) true))
+
+(defn write-list-like
+  ([^Writer w tag o]
+   (.writeTag w tag 1)
+   (.writeList w o)))
+
+(defn read-list-like
+  [^Reader rdr build-fn]
+  (build-fn (.readObject rdr)))
+
+(defn write-map-like
+  "Writes a map as Fressian with the tag 'map' and all keys cached."
+  [^Writer w tag m]
+  (.writeTag w tag 1)
+  (.beginClosedList ^StreamingWriter w)
+  (loop [items (seq m)]
+    (when-let [^clojure.lang.MapEntry item (first items)]
+      (.writeObject w (.key item) true)
+      (.writeObject w (.val item))
+      (recur (rest items))))
+  (.endList ^StreamingWriter w))
+
+(defn read-map-like
+  [^Reader rdr]
+  (let [kvs ^java.util.List (.readObject rdr)]
+    (if (< (.size kvs) 16)
+      (clojure.lang.PersistentArrayMap. (.toArray kvs))
+      (clojure.lang.PersistentHashMap/create (seq kvs)))))
+
+(def write-handlers
+  { Character
+   {"char"
+    (reify WriteHandler
+      (write [_ w ch]
+        (.writeTag w "char" 1)
+        (.writeInt w (int ch))))}
+
+   app.common.geom.point.Point
+   {"penpot/point"
+    (reify WriteHandler
+      (write [_ w o]
+        (.writeTag ^Writer w "penpot/point" 1)
+        (.writeList ^Writer w (java.util.List/of (.-x ^Point o) (.-y ^Point o)))))}
+
+   app.common.geom.matrix.Matrix
+   {"penpot/matrix"
+    (reify WriteHandler
+      (write [_ w o]
+        (.writeTag ^Writer w "penpot/matrix" 1)
+        (.writeList ^Writer w (java.util.List/of (.-a ^Matrix o)
+                                                 (.-b ^Matrix o)
+                                                 (.-c ^Matrix o)
+                                                 (.-d ^Matrix o)
+                                                 (.-e ^Matrix o)
+                                                 (.-f ^Matrix o)))))}
+
+   Ratio
+   {"ratio"
+    (reify WriteHandler
+      (write [_ w n]
+        (.writeTag w "ratio" 2)
+        (.writeObject w (.numerator ^Ratio n))
+        (.writeObject w (.denominator ^Ratio n))))}
+
+   clojure.lang.IPersistentMap
+   {"clj/map"
+    (reify WriteHandler
+      (write [_ w d]
+        (write-map-like w "clj/map" d)))}
+
+   clojure.lang.Keyword
+   {"clj/keyword"
+    (reify WriteHandler
+      (write [_ w s]
+        (write-named "clj/keyword" w s)))}
+
+   clojure.lang.BigInt
+   {"bigint"
+    (reify WriteHandler
+      (write [_ w d]
+        (let [^BigInteger bi (if (instance? clojure.lang.BigInt d)
+                               (.toBigInteger ^clojure.lang.BigInt d)
+                               d)]
+          (.writeTag w "bigint" 1)
+          (.writeBytes w (.toByteArray bi)))))}
+
+   ;; Persistent set
+   clojure.lang.IPersistentSet
+   {"clj/set"
+    (reify WriteHandler
+      (write [_ w o]
+        (write-list-like w "clj/set" o)))}
+
+   ;; Persistent vector
+   clojure.lang.IPersistentVector
+   {"clj/vector"
+    (reify WriteHandler
+      (write [_ w o]
+        (write-list-like w "clj/vector" o)))}
+
+   ;; Persistent list
+   clojure.lang.IPersistentList
+   {"clj/list"
+    (reify WriteHandler
+      (write [_ w o]
+        (write-list-like w "clj/list" o)))}
+
+   ;; Persistent seq & lazy seqs
+   clojure.lang.ISeq
+   {"clj/seq"
+    (reify WriteHandler
+      (write [_ w o]
+        (write-list-like w "clj/seq" o)))}
+   })
+
+
+(def read-handlers
+  {"bigint"
+   (reify ReadHandler
+     (read [_ rdr _ _]
+       (let [^bytes bibytes (.readObject rdr)]
+         (bigint (BigInteger. bibytes)))))
+
+   "byte"
+   (reify ReadHandler
+     (read [_ rdr _ _]
+       (byte (.readObject rdr))))
+
+   "penpot/matrix"
+   (reify ReadHandler
+     (read [_ rdr _ _]
+       (let [^java.util.List x (.readObject rdr)]
+         (Matrix. (.get x 0) (.get x 1) (.get x 2) (.get x 3) (.get x 4) (.get x 5)))))
+
+   "penpot/point"
+   (reify ReadHandler
+     (read [_ rdr _ _]
+       (let [^java.util.List x (.readObject rdr)]
+         (Point. (.get x 0) (.get x 1)))))
+
+   "char"
+   (reify ReadHandler
+     (read [_ rdr _ _]
+       (char (.readObject rdr))))
+
+   "clj/ratio"
+   (reify ReadHandler
+     (read [_ rdr _ _]
+       (Ratio. (biginteger (.readObject rdr))
+               (biginteger (.readObject rdr)))))
+
+   "clj/keyword"
+   (reify ReadHandler
+     (read [_ rdr _ _]
+       (keyword (.readObject rdr) (.readObject rdr))))
+
+   "clj/map"
+   (reify ReadHandler
+     (read [_ rdr _ _]
+       (read-map-like rdr)))
+
+   "clj/set"
+   (reify ReadHandler
+     (read [_ rdr _ _]
+       (read-list-like rdr set)))
+
+   "clj/vector"
+   (reify ReadHandler
+     (read [_ rdr _ _]
+       (read-list-like rdr vec)))
+
+   "clj/list"
+   (reify ReadHandler
+     (read [_ rdr _ _]
+       (read-list-like rdr #(apply list %))))
+
+   "clj/seq"
+   (reify ReadHandler
+     (read [_ rdr _ _]
+       (read-list-like rdr sequence)))
+   })
+
+(def write-handler-lookup
+  (-> write-handlers
+      fres/associative-lookup
+      fres/inheritance-lookup))
+
+(def read-handler-lookup
+  (-> read-handlers
+      (fres/associative-lookup)))
+
+;; --- Low-Level Api
+
+(defn reader
+  [istream]
+  (fres/create-reader istream :handlers read-handler-lookup))
+
+(defn writer
+  [ostream]
+  (fres/create-writer ostream :handlers write-handler-lookup))
+
+(defn read!
+  [reader]
+  (fres/read-object reader))
+
+(defn write!
+  [writer data]
+  (fres/write-object writer data))
+
+;; --- High-Level Api
+
+(defn encode
+  [data]
+  (with-open [out (ByteArrayOutputStream.)]
+    (write! (writer out) data)
+    (.toByteArray out)))
+
+(defn decode
+  [data]
+  (with-open [input (ByteArrayInputStream. ^bytes data)]
+    (read! (reader input))))

backend/src/app/util/json.clj

@@ -9,22 +9,27 @@
   (:require
    [jsonista.core :as j]))
 
-(defn encode-str
-  [v]
-  (j/write-value-as-string v j/keyword-keys-object-mapper))
+(defn mapper
+  [params]
+  (j/object-mapper params))
+
+(defn write
+  ([v] (j/write-value-as-bytes v j/keyword-keys-object-mapper))
+  ([v mapper] (j/write-value-as-bytes v mapper)))
+
+(defn write-str
+  ([v] (j/write-value-as-string v j/keyword-keys-object-mapper))
+  ([v mapper] (j/write-value-as-string v mapper)))
+
+(defn read
+  ([v] (j/read-value v j/keyword-keys-object-mapper))
+  ([v mapper] (j/read-value v mapper)))
 
 (defn encode
   [v]
   (j/write-value-as-bytes v j/keyword-keys-object-mapper))
 
-(defn decode-str
-  [v]
-  (j/read-value v j/keyword-keys-object-mapper))
-
 (defn decode
   [v]
   (j/read-value v j/keyword-keys-object-mapper))
 
-(defn read
-  [v]
-  (j/read-value v j/keyword-keys-object-mapper))

backend/src/app/util/migrations.clj

@@ -20,7 +20,7 @@
 ;; --- Implementation
 
 (defn- registered?
-  "Check if concrete migration is already registred."
+  "Check if concrete migration is already registered."
   [pool modname stepname]
   (let [sql  "select * from migrations where module=? and step=?"
         rows (jdbc/execute! pool [sql modname stepname])]

backend/src/app/util/websocket.clj

@@ -0,0 +1,202 @@
+;; 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) UXBOX Labs SL
+
+(ns app.util.websocket
+  "A general protocol implementation on top of websockets."
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.logging :as l]
+   [app.common.transit :as t]
+   [app.metrics :as mtx]
+   [app.util.time :as dt]
+   [clojure.core.async :as a]
+   [yetti.websocket :as yws])
+  (:import
+   java.nio.ByteBuffer))
+
+(declare decode-beat)
+(declare encode-beat)
+(declare process-heartbeat)
+(declare process-input)
+(declare process-output)
+(declare ws-ping!)
+(declare ws-send!)
+
+(defmacro call-mtx
+  [definitions name & args]
+  `(when-let [mtx-fn# (some-> ~definitions ~name ::mtx/fn)]
+     (mtx-fn# ~@args)))
+
+(def noop (constantly nil))
+
+(defn handler
+  "A WebSocket upgrade handler factory. Returns a handler that can be
+  used to upgrade to websocket connection. This handler implements the
+  basic custom protocol on top of websocket connection with all the
+  borring stuff already handled (lifecycle, heartbeat,...).
+
+  The provided function should have the `(fn [ws msg])` signature.
+
+  It also accepts some options that allows you parametrize the
+  protocol behavior. The options map will be used as-as for the
+  initial data of the `ws` data structure"
+  ([handle-message] (handler handle-message {}))
+  ([handle-message {:keys [::input-buff-size
+                           ::output-buff-size
+                           ::idle-timeout
+                           ::metrics]
+                    :or {input-buff-size 64
+                         output-buff-size 64
+                         idle-timeout 30000}
+                    :as options}]
+   (fn [_]
+     (let [input-ch   (a/chan input-buff-size)
+           output-ch  (a/chan output-buff-size)
+           pong-ch    (a/chan (a/sliding-buffer 6))
+           close-ch   (a/chan)
+           options    (-> options
+                          (assoc ::input-ch input-ch)
+                          (assoc ::output-ch output-ch)
+                          (assoc ::close-ch close-ch)
+                          (dissoc ::metrics))
+
+           terminated (atom false)
+           created-at (dt/now)
+
+           on-terminate
+           (fn [& _args]
+             (when (compare-and-set! terminated false true)
+               (call-mtx metrics :connections {:cmd :dec :by 1})
+               (call-mtx metrics :sessions {:val (/ (inst-ms (dt/diff created-at (dt/now))) 1000.0)})
+
+               (a/close! close-ch)
+               (a/close! pong-ch)
+               (a/close! output-ch)
+               (a/close! input-ch)))
+
+           on-error
+           (fn [_ error]
+             (on-terminate)
+             (when-not (or (instance? org.eclipse.jetty.websocket.api.exceptions.WebSocketTimeoutException error)
+                           (instance? java.nio.channels.ClosedChannelException error))
+               (l/error :hint (ex-message error) :cause error)))
+
+           on-connect
+           (fn [conn]
+             (call-mtx metrics :connections {:cmd :inc :by 1})
+
+             (let [wsp (atom (assoc options ::conn conn))]
+               ;; Handle heartbeat
+               (yws/idle-timeout! conn (dt/duration idle-timeout))
+               (-> @wsp
+                   (assoc ::pong-ch pong-ch)
+                   (assoc ::on-close on-terminate)
+                   (process-heartbeat))
+
+               ;; Forward all messages from output-ch to the websocket
+               ;; connection
+               (a/go-loop []
+                 (when-let [val (a/<! output-ch)]
+                   (call-mtx metrics :messages {:labels ["send"]})
+                   (a/<! (ws-send! conn (t/encode-str val)))
+                   (recur)))
+
+               ;; React on messages received from the client
+               (process-input wsp handle-message)))
+
+           on-message
+           (fn [_ message]
+             (call-mtx metrics :messages {:labels ["recv"]})
+             (try
+               (let [message (t/decode-str message)]
+                 (a/offer! input-ch message))
+               (catch Throwable e
+                 (l/warn :hint "error on decoding incoming message from websocket"
+                         :wsmsg (pr-str message)
+                         :cause e)
+                 (on-terminate))))
+
+           on-pong
+           (fn [_ buffer]
+             (a/>!! pong-ch buffer))]
+
+       {:on-connect on-connect
+        :on-error on-error
+        :on-close on-terminate
+        :on-text on-message
+        :on-pong on-pong}))))
+
+(defn- ws-send!
+  [conn s]
+  (let [ch (a/chan 1)]
+    (yws/send! conn s (fn [e]
+                        (when e (a/offer! ch e))
+                        (a/close! ch)))
+    ch))
+
+(defn- ws-ping!
+  [conn s]
+  (let [ch (a/chan 1)]
+    (yws/ping! conn s (fn [e]
+                        (when e (a/offer! ch e))
+                        (a/close! ch)))
+    ch))
+
+(defn- encode-beat
+  [n]
+  (doto (ByteBuffer/allocate 8)
+    (.putLong n)
+    (.rewind)))
+
+(defn- decode-beat
+  [^ByteBuffer buffer]
+  (when (= 8 (.capacity buffer))
+    (.rewind buffer)
+    (.getLong buffer)))
+
+(defn- process-input
+  [wsp handler]
+  (let [{:keys [::input-ch ::output-ch ::close-ch]} @wsp]
+    (a/go
+      (a/<! (handler wsp {:type :connect}))
+      (a/<! (a/go-loop []
+              (when-let [request (a/<! input-ch)]
+                (let [[val port] (a/alts! [(handler wsp request) close-ch])]
+                  (when-not (= port close-ch)
+                    (cond
+                      (ex/ex-info? val)
+                      (a/>! output-ch {:type :error :error (ex-data val)})
+
+                      (ex/exception? val)
+                      (a/>! output-ch {:type :error :error {:message (ex-message val)}})
+
+                      (map? val)
+                      (a/>! output-ch (cond-> val (:request-id request) (assoc :request-id (:request-id request)))))
+
+                    (recur))))))
+      (a/<! (handler wsp {:type :disconnect})))))
+
+(defn- process-heartbeat
+  [{:keys [::conn ::close-ch ::on-close ::pong-ch
+           ::heartbeat-interval ::max-missed-heartbeats]
+    :or {heartbeat-interval 2000
+         max-missed-heartbeats 4}}]
+  (let [beats (atom #{})]
+    (a/go-loop [i 0]
+      (let [[_ port] (a/alts! [close-ch (a/timeout heartbeat-interval)])]
+        (when (and (yws/connected? conn)
+                   (not= port close-ch))
+          (a/<! (ws-ping! conn (encode-beat i)))
+          (let [issued (swap! beats conj (long i))]
+            (if (>= (count issued) max-missed-heartbeats)
+              (on-close conn -1 "heartbeat-timeout")
+              (recur (inc i)))))))
+
+    (a/go-loop []
+      (when-let [buffer (a/<! pong-ch)]
+        (swap! beats disj (decode-beat buffer))
+        (recur)))))
+

backend/src/app/worker.clj

@@ -266,13 +266,8 @@
 
         (= ::noop (:strategy edata))
         (assoc :inc-by 0))
-
-      (let [cdata (get-error-context error item)]
-        (l/update-thread-context! cdata)
-        (l/error :cause error
-                 :hint "unhandled exception on task"
-                 :id (:id cdata))
-
+      (l/with-context (get-error-context error item)
+        (l/error :cause error :hint "unhandled exception on task")
         (if (>= (:retry-num item) (:max-retries item))
           {:status :failed :task item :error error}
           {:status :retry :task item :error error})))))
@@ -470,7 +465,7 @@
     :type :summary
     :quantiles []
     :name "tasks_checkout_timing"
-    :help "Latency measured between scheduld_at and execution time."
+    :help "Latency measured between scheduled_at and execution time."
     :wrap (fn [rootf mobj]
             (let [mdata (meta rootf)
                   origf (::original mdata rootf)]

backend/test/app/services_files_test.clj

@@ -174,12 +174,12 @@
                             :type :image
                             :metadata {:id (:id fmo1)}}}]})]
 
-      ;; run the task inmediatelly
+      ;; run the task immediately
       (let [task  (:app.tasks.file-media-gc/handler th/*system*)
             res   (task {})]
         (t/is (= 0 (:processed res))))
 
-      ;; make the file ellegible for GC waiting 300ms (configured
+      ;; make the file eligible for GC waiting 300ms (configured
       ;; timeout for testing)
       (th/sleep 300)
 

backend/test/app/services_management_test.clj

@@ -52,7 +52,7 @@
 
       ;; (th/print-result! out)
 
-      ;; Check tha tresult is correct
+      ;; Check that result is correct
       (t/is (nil? (:error out)))
       (let [result (:result out)]
 
@@ -127,7 +127,7 @@
 
       ;; (th/print-result! out)
 
-      ;; Check tha tresult is correct
+      ;; Check that result is correct
       (t/is (nil? (:error out)))
       (let [result (:result out)]
 
@@ -183,7 +183,7 @@
                 :name "project 1 (copy)"}
           out  (th/mutation! data)]
 
-      ;; Check tha tresult is correct
+      ;; Check that result is correct
       (t/is (nil? (:error out)))
 
       (let [result (:result out)]
@@ -254,7 +254,7 @@
                 :name "project 1 (copy)"}
           out  (th/mutation! data)]
 
-      ;; Check tha tresult is correct
+      ;; Check that result is correct
       (t/is (nil? (:error out)))
 
       (let [result (:result out)]

backend/test/app/services_profile_test.clj

@@ -6,6 +6,7 @@
 
 (ns app.services-profile-test
   (:require
+   [app.common.uuid :as uuid]
    [app.db :as db]
    [app.rpc.mutations.profile :as profile]
    [app.test-helpers :as th]
@@ -153,11 +154,8 @@
                   :profile-id (:id prof)}
           out    (th/query! params)]
       ;; (th/print-result! out)
-      (let [error (:error out)
-            error-data (ex-data error)]
-        (t/is (th/ex-info? error))
-        (t/is (= (:type error-data) :not-found))))
-    ))
+      (let [result (:result out)]
+        (t/is (= uuid/zero (:id result)))))))
 
 (t/deftest registration-domain-whitelist
   (let [whitelist #{"gmail.com" "hey.com" "ya.ru"}]

backend/test/app/services_teams_test.clj

@@ -33,7 +33,6 @@
                     :role :editor
                     :profile-id (:id profile1)}]
 
-
       ;; invite external user without complaints
       (let [data (assoc data :email "foo@bar.com")
             out  (th/mutation! data)]
@@ -136,9 +135,10 @@
                 :profile-id (:id profile1)}
           out  (th/query! data)]
       ;; (th/print-result! out)
-      (t/is (nil? (:error out)))
-      (let [result (:result out)]
-        (t/is (= 0 (count result)))))
+      (let [error (:error out)
+            error-data (ex-data error)]
+        (t/is (th/ex-info? error))
+        (t/is (= (:type error-data) :not-found))))
 
     ;; run permanent deletion
     (let [result (task {:max-age (dt/duration 0)})]

backend/test/app/storage_test.clj

@@ -68,7 +68,7 @@
     (t/is (true? (sto/del-object storage object)))
 
     ;; retrieving the same object should be not nil because the
-    ;; deletion is not inmediate
+    ;; deletion is not immediate
     (t/is (some? (sto/get-object-data storage object)))
     (t/is (some? (sto/get-object-url storage object)))
     (t/is (some? (sto/get-object-path storage object)))
@@ -248,7 +248,7 @@
     (th/sleep 200)
 
     ;; storage_pending table should have the object
-    ;; registred independently of the aborted transaction.
+    ;; registered independently of the aborted transaction.
     (let [rows (db/exec! th/*pool* ["select * from storage_pending"])]
       (t/is (= 1 (count rows))))
 

backend/test/app/test_helpers.clj

@@ -57,6 +57,7 @@
                            :app.http/server
                            :app.http/router
                            :app.notifications/handler
+                           :app.loggers.sentry/reporter
                            :app.http.oauth/google
                            :app.http.oauth/gitlab
                            :app.http.oauth/github

common/deps.edn

@@ -1,44 +1,40 @@
 {:deps
  {org.clojure/clojure {:mvn/version "1.10.3"}
-  org.clojure/data.json {:mvn/version "2.3.1"}
-  org.clojure/core.async {:mvn/version "1.3.618"}
+  org.clojure/data.json {:mvn/version "2.4.0"}
   org.clojure/tools.cli {:mvn/version "1.0.206"}
-  metosin/jsonista {:mvn/version "0.3.3"}
-  org.clojure/clojurescript {:mvn/version "1.10.844"}
+  metosin/jsonista {:mvn/version "0.3.5"}
+  org.clojure/clojurescript {:mvn/version "1.10.914"}
 
   ;; Logging
-  org.clojure/tools.logging {:mvn/version "1.1.0"}
-  org.apache.logging.log4j/log4j-api {:mvn/version "2.16.0"}
-  org.apache.logging.log4j/log4j-core {:mvn/version "2.16.0"}
-  org.apache.logging.log4j/log4j-web {:mvn/version "2.16.0"}
-  org.apache.logging.log4j/log4j-jul {:mvn/version "2.16.0"}
-  org.apache.logging.log4j/log4j-slf4j18-impl {:mvn/version "2.16.0"}
+  org.apache.logging.log4j/log4j-api {:mvn/version "2.17.1"}
+  org.apache.logging.log4j/log4j-core {:mvn/version "2.17.1"}
+  org.apache.logging.log4j/log4j-web {:mvn/version "2.17.1"}
+  org.apache.logging.log4j/log4j-jul {:mvn/version "2.17.1"}
+  org.apache.logging.log4j/log4j-slf4j18-impl {:mvn/version "2.17.1"}
   org.slf4j/slf4j-api {:mvn/version "2.0.0-alpha1"}
-  org.slf4j/jcl-over-slf4j {:mvn/version "2.0.0-alpha1"}
-  org.slf4j/log4j-over-slf4j {:mvn/version "2.0.0-alpha1"}
-  org.slf4j/osgi-over-slf4j {:mvn/version "2.0.0-alpha1"}
-  org.slf4j/jul-to-slf4j {:mvn/version "2.0.0-alpha1"}
-  com.lmax/disruptor {:mvn/version "3.4.4"}
 
-  selmer/selmer {:mvn/version "1.12.40"}
-  expound/expound {:mvn/version "0.8.9"}
+  selmer/selmer {:mvn/version "1.12.48"}
+  criterium/criterium {:mvn/version "0.4.6"}
+
+  expound/expound {:mvn/version "0.8.10"}
   com.cognitect/transit-clj {:mvn/version "1.0.324"}
   com.cognitect/transit-cljs {:mvn/version "0.8.269"}
-  java-http-clj/java-http-clj {:mvn/version "0.4.2"}
+  java-http-clj/java-http-clj {:mvn/version "0.4.3"}
 
-  funcool/promesa {:mvn/version "6.0.1"}
+  funcool/promesa {:mvn/version "6.0.2"}
   funcool/cuerdas {:mvn/version "2021.05.29-0"}
 
-  lambdaisland/uri {:mvn/version "1.4.70"
+  lambdaisland/uri {:mvn/version "1.12.89"
                     :exclusions [org.clojure/data.json]}
 
   frankiesardo/linked {:mvn/version "1.3.0"}
   danlentz/clj-uuid {:mvn/version "0.1.9"}
-  commons-io/commons-io {:mvn/version "2.8.0"}
+  commons-io/commons-io {:mvn/version "2.11.0"}
   com.sun.mail/jakarta.mail {:mvn/version "2.0.1"}
 
   ;; exception printing
-  io.aviso/pretty {:mvn/version "0.1.37"}
+  fipp/fipp {:mvn/version "0.6.25"}
+  io.aviso/pretty {:mvn/version "1.1.1"}
   environ/environ {:mvn/version "1.2.0"}}
  :paths ["src"]
  :aliases
@@ -47,16 +43,12 @@
    {org.clojure/tools.namespace {:mvn/version "RELEASE"}
     org.clojure/test.check {:mvn/version "RELEASE"}
     org.clojure/tools.deps.alpha {:mvn/version "RELEASE"}
-    thheller/shadow-cljs {:mvn/version "2.12.6"}
+    com.bhauman/rebel-readline {:mvn/version "RELEASE"}
+    thheller/shadow-cljs {:mvn/version "2.16.10"}
     criterium/criterium {:mvn/version "RELEASE"}
     mockery/mockery {:mvn/version "RELEASE"}}
    :extra-paths ["test" "dev"]}
 
-  :repl
-  {:extra-deps
-   {com.bhauman/rebel-readline {:mvn/version "RELEASE"}}
-   :main-opts ["-m" "rebel-readline.main"]}
-
   :kaocha
   {:extra-deps {lambdaisland/kaocha {:mvn/version "RELEASE"}}
    :main-opts ["-m" "kaocha.runner"]}
@@ -65,7 +57,7 @@
   {:extra-paths ["test"]
    :extra-deps {io.github.cognitect-labs/test-runner
                 {:git/url "https://github.com/cognitect-labs/test-runner.git"
-                 :sha "705ad25bbf0228b1c38d0244a36001c2987d7337"}}
+                 :sha "dd6da11611eeb87f08780a30ac8ea6012d4c05ce"}}
    :exec-fn cognitect.test-runner.api/test}
 
   :shadow-cljs

common/package.json

@@ -6,7 +6,14 @@
   "dependencies": {
     "luxon": "^1.27.0"
   },
+  "scripts": {
+    "compile-and-watch-test": "clojure -M:dev:shadow-cljs watch test",
+    "compile-test": "clojure -M:dev:shadow-cljs compile test --config-merge '{:autorun false}'",
+    "run-test": "node target/test.js",
+    "test": "yarn run compile-test && yarn run run-test"
+  },
   "devDependencies": {
+    "shadow-cljs": "2.16.9",
     "source-map-support": "^0.5.19",
     "ws": "^7.4.6"
   }

common/scripts/repl

@@ -0,0 +1,9 @@
+#!/usr/bin/env bash
+
+export PENPOT_FLAGS="enable-asserts enable-audit-log $PENPOT_FLAGS"
+export OPTIONS="-A:dev -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager -J-XX:+UseZGC -J-XX:ConcGCThreads=1 -J-XX:-OmitStackTraceInFastThrow -J-Xms50m -J-Xmx512m";
+export OPTIONS_EVAL="nil"
+# export OPTIONS_EVAL="(set! *warn-on-reflection* true)"
+
+set -ex
+exec clojure $OPTIONS -M -e "$OPTIONS_EVAL" -m rebel-readline.main

common/shadow-cljs.edn

@@ -6,12 +6,29 @@
  :builds
  {:test
   {:target :node-test
-   :output-to "target/tests.js"
+   :output-to "target/test.js"
+   :output-dir "target/test/"
    :ns-regexp "^app.common.*-test$"
-   ;; :autorun true
+   :autorun true
 
    :compiler-options
    {:output-feature-set :es-next
     :output-wrapper false
-    :warnings {:fn-deprecated false}}}}}
+    :source-map true
+    :source-map-include-sources-content true
+    :source-map-detail-level :all
+    :warnings {:fn-deprecated false}}}
+
+  :bench
+  {:target :node-script
+   :output-to "target/bench.js"
+   :output-dir "target/bench/"
+   :main bench/main
+   :devtools {:autoload false}
+
+   :compiler-options
+   {:output-feature-set :es-next
+    :output-wrapper false}}}
+ }
+
 

common/src/app/common/attrs.cljc

@@ -9,7 +9,7 @@
 
 ;; Extract some attributes of a list of shapes.
 ;; For each attribute, if the value is the same in all shapes,
-;; wll take this value. If there is any shape that is different,
+;; will take this value. If there is any shape that is different,
 ;; the value of the attribute will be the keyword :multiple.
 ;;
 ;; If some shape has the value nil in any attribute, it's

common/src/app/common/colors.cljc

@@ -0,0 +1,16 @@
+;; 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) UXBOX Labs SL
+
+(ns app.common.colors
+   (:refer-clojure :exclude [test]))
+
+(def black "#000000")
+(def canvas "#E8E9EA")
+(def default-layout "#DE4762")
+(def gray-20 "#B1B2B5")
+(def info "#59B9E2")
+(def test "#fabada")
+(def white "#FFFFFF")

common/src/app/common/data.cljc

@@ -6,7 +6,7 @@
 
 (ns app.common.data
   "Data manipulation and query helper functions."
-  (:refer-clojure :exclude [read-string hash-map merge name])
+  (:refer-clojure :exclude [read-string hash-map merge name parse-double])
   #?(:cljs
      (:require-macros [app.common.data]))
   (:require
@@ -157,7 +157,7 @@
   "Return a map without the keys provided
   in the `keys` parameter."
   [data keys]
-  (when data
+  (when (map? data)
     (persistent!
      (reduce #(dissoc! %1 %2) (transient data) keys))))
 
@@ -201,7 +201,7 @@
   "Maps a function to each pair of values that can be combined inside the
   function without repetition.
 
-  Optional parmeters:
+  Optional parameters:
   `pred?`   A predicate that if not satisfied won't process the pair
   `target?` A collection that will be used as seed to be stored
 
@@ -252,6 +252,11 @@
   #?(:clj (Object.)
      :cljs (js/Object.)))
 
+(defn getf
+  "Returns a function to access a map"
+  [coll]
+  (partial get coll))
+
 (defn update-in-when
   [m key-seq f & args]
   (let [found (get-in m key-seq sentinel)]
@@ -492,7 +497,7 @@
     (keyword (str prefix kw))))
 
 (defn tap
-  "Simpilar to the tap in rxjs but for plain collections"
+  "Similar to the tap in rxjs but for plain collections"
   [f coll]
   (f coll)
   coll)

common/src/app/common/exceptions.cljc

@@ -12,7 +12,7 @@
 
 (s/def ::type keyword?)
 (s/def ::code keyword?)
-(s/def ::mesage string?)
+(s/def ::message string?)
 (s/def ::hint string?)
 (s/def ::cause #?(:clj #(instance? Throwable %)
                   :cljs #(instance? js/Error %)))
@@ -20,7 +20,7 @@
   (s/keys :req-un [::type]
           :opt-un [::code
                    ::hint
-                   ::mesage
+                   ::message
                    ::cause]))
 
 (defn error

common/src/app/common/file_builder.cljc

@@ -12,7 +12,6 @@
    [app.common.geom.shapes :as gsh]
    [app.common.pages.changes :as ch]
    [app.common.pages.init :as init]
-   [app.common.pages.spec :as spec]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
    [cuerdas.core :as str]))
@@ -21,15 +20,14 @@
 (def conjv (fnil conj []))
 (def conjs (fnil conj #{}))
 
-;; This flag controls if we should execute spec validation after every commit
-(def verify-on-commit? true)
-
 (defn- commit-change
   ([file change]
    (commit-change file change nil))
 
-  ([file change {:keys [add-container?]
-                 :or   {add-container? false}}]
+  ([file change {:keys [add-container?
+                        fail-on-spec?]
+                 :or   {add-container? false
+                        fail-on-spec? false}}]
    (let [component-id (:current-component-id file)
          change (cond-> change
                   (and add-container? (some? component-id))
@@ -39,11 +37,20 @@
                   (assoc :page-id  (:current-page-id file)
                          :frame-id (:current-frame-id file)))]
 
-     (when verify-on-commit?
-       (us/assert ::spec/change change))
-     (-> file
-         (update :changes conjv change)
-         (update :data ch/process-changes [change] verify-on-commit?)))))
+     (when fail-on-spec?
+       (us/verify :app.common.pages.spec/change change))
+
+     (let [valid? (us/valid? :app.common.pages.spec/change change)]
+       #?(:cljs
+          (when-not valid? (.warn js/console "Invalid shape" (clj->js change))))
+
+       (cond-> file
+         valid?
+         (-> (update :changes conjv change)
+             (update :data ch/process-changes [change] false))
+
+         (not valid?)
+         (update :errors conjv change))))))
 
 (defn- lookup-objects
   ([file]
@@ -51,20 +58,21 @@
      (get-in file [:data :components  (:current-component-id file) :objects])
      (get-in file [:data :pages-index (:current-page-id file) :objects]))))
 
-(defn- lookup-shape [file shape-id]
+(defn lookup-shape [file shape-id]
   (-> (lookup-objects file)
       (get shape-id)))
 
 (defn- commit-shape [file obj]
-  (let [parent-id (-> file :parent-stack peek)]
-    (-> file
-        (commit-change
-         {:type :add-obj
-          :id (:id obj)
-          :obj obj
-          :parent-id parent-id}
+  (let [parent-id (-> file :parent-stack peek)
+        change {:type :add-obj
+                :id (:id obj)
+                :obj obj
+                :parent-id parent-id}
 
-         {:add-container? true}))))
+        fail-on-spec? (or (= :group (:type obj))
+                          (= :frame (:type obj)))]
+
+    (commit-change file change {:add-container? true :fail-on-spec? fail-on-spec?})))
 
 (defn setup-rect-selrect [obj]
   (let [rect      (select-keys obj [:x :y :width :height])
@@ -321,16 +329,11 @@
         (update :parent-stack pop))))
 
 (defn create-shape [file type data]
-  (let [frame-id (:current-frame-id file)
-        frame (when-not (= frame-id root-frame)
-                (lookup-shape file frame-id))
-        obj (-> (init/make-minimal-shape type)
+  (let [obj (-> (init/make-minimal-shape type)
                 (merge data)
                 (check-name file :type)
                 (setup-selrect)
-                (d/without-nils))
-        obj (cond-> obj
-              frame (gsh/translate-from-frame frame))]
+                (d/without-nils))]
     (-> file
         (commit-shape obj)
         (assoc :last-id (:id obj))
@@ -426,35 +429,36 @@
 (defn add-interaction
   [file from-id interaction-src]
 
-  (assert (some? (lookup-shape file from-id)) (str "Cannot locate shape with id " from-id))
+  (let [shape (lookup-shape file from-id)]
+    (if (nil? shape)
+      file
+      (let [{:keys [event-type action-type]} (read-classifier interaction-src)
+            {:keys [delay]} (read-event-opts interaction-src)
+            {:keys [destination overlay-pos-type overlay-position url
+                    close-click-outside background-overlay preserve-scroll]}
+            (read-action-opts interaction-src)
 
-  (let [{:keys [event-type action-type]} (read-classifier interaction-src)
-        {:keys [delay]} (read-event-opts interaction-src)
-        {:keys [destination overlay-pos-type overlay-position url
-                close-click-outside background-overlay preserve-scroll]}
-        (read-action-opts interaction-src)
+            interactions (-> shape
+                             :interactions
+                             (conjv
+                              (d/without-nils {:event-type event-type
+                                               :action-type action-type
+                                               :delay delay
+                                               :destination destination
+                                               :overlay-pos-type overlay-pos-type
+                                               :overlay-position overlay-position
+                                               :url url
+                                               :close-click-outside close-click-outside
+                                               :background-overlay background-overlay
+                                               :preserve-scroll preserve-scroll})))]
+        (commit-change
+         file
+         {:type :mod-obj
+          :page-id (:current-page-id file)
+          :id from-id
 
-        interactions (-> (lookup-shape file from-id)
-                         :interactions
-                         (conjv
-                          (d/without-nils {:event-type event-type
-                                           :action-type action-type
-                                           :delay delay
-                                           :destination destination
-                                           :overlay-pos-type overlay-pos-type
-                                           :overlay-position overlay-position
-                                           :url url
-                                           :close-click-outside close-click-outside
-                                           :background-overlay background-overlay
-                                           :preserve-scroll preserve-scroll})))]
-    (commit-change
-     file
-     {:type :mod-obj
-      :page-id (:current-page-id file)
-      :id from-id
-
-      :operations
-      [{:type :set :attr :interactions :val interactions}]})))
+          :operations
+          [{:type :set :attr :interactions :val interactions}]})))))
 
 (defn generate-changes
   [file]

common/src/app/common/geom/align.cljc

@@ -81,7 +81,7 @@
   "Distribute equally the space between shapes in the given axis. If
   there is no space enough, it does nothing. It takes into account
   the form of the shape and the rotation, what is distributed is
-  the wrapping recangles of the shapes. If any shape is a group,
+  the wrapping rectangles of the shapes. If any shape is a group,
   move also all of its recursive children."
   [shapes axis objects]
   (let [coord (if (= axis :horizontal) :x :y)
@@ -119,7 +119,7 @@
         (mapcat #(recursive-move %1 {coord %2 other-coord 0} objects)
                 sorted-shapes deltas)))))
 
-;; Adjusto to viewport
+;; Adjust to viewport
 
 (defn adjust-to-viewport
   ([viewport srect] (adjust-to-viewport viewport srect nil))

common/src/app/common/geom/impl/matrix.js

@@ -0,0 +1,65 @@
+/**
+ * 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) UXBOX Labs SL
+ */
+"use strict";
+
+goog.require("cljs.core");
+goog.provide("app.common.geom.impl.matrix");
+
+goog.scope(function() {
+  const self = app.common.geom.impl.matrix;
+
+  self.create = function(a, b, c, d, e, f) {
+    const matrix = new Float64Array(6);
+    matrix[0] = a;
+    matrix[1] = b;
+    matrix[2] = c;
+    matrix[3] = d;
+    matrix[4] = e;
+    matrix[5] = f;
+
+    return matrix;
+  }
+
+
+  // result[0] = (m1[0] * m2[0]) + (m1[2] * m2[1]);
+  // result[1] = (m1[1] * m2[0]) + (m1[3] * m2[1]);
+  // result[2] = (m1[0] * m2[2]) + (m1[2] * m2[3]);
+  // result[3] = (m1[1] * m2[2]) + (m1[3] * m2[3]);
+  // result[4] = (m1[0] * m2[4]) + (m1[2] * m2[5]) + m1[4];
+  // result[5] = (m1[1] * m2[4]) + (m1[3] * m2[5]) + m1[5];
+
+
+  self.multiply = function(m1, m2) {
+    // var result = new Float64Array(6);
+
+    // var m1a = m1[0];
+    // var m1b = m1[1];
+    // var m1c = m1[2];
+    // var m1d = m1[3];
+    // var m1e = m1[4];
+    // var m1f = m1[5];
+
+    // var m2a = m2[0];
+    // var m2b = m2[1];
+    // var m2c = m2[2];
+    // var m2d = m2[3];
+    // var m2e = m2[4];
+    // var m2f = m2[5];
+
+    // result[0] = (m1a * m2a) + (m1c * m2b);
+    // result[1] = (m1b * m2a) + (m1d * m2b);
+    // result[2] = (m1a * m2c) + (m1c * m2d);
+    // result[3] = (m1b * m2c) + (m1d * m2d);
+    // result[4] = (m1a * m2e) + (m1c * m2f) + m1e;
+    // result[5] = (m1b * m2e) + (m1d * m2f) + m1f;
+
+    // return result;
+    return m1;
+  }
+
+});

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

@@ -14,7 +14,12 @@
 
 ;; --- Matrix Impl
 
-(defrecord Matrix [a b c d e f]
+(defrecord Matrix [^double a
+                   ^double b
+                   ^double c
+                   ^double d
+                   ^double e
+                   ^double f]
   Object
   (toString [_]
     (str "matrix(" a "," b "," c "," d "," e "," f ")")))
@@ -36,15 +41,29 @@
     (apply matrix params)))
 
 (defn multiply
-  ([{m1a :a m1b :b m1c :c m1d :d m1e :e m1f :f}
-    {m2a :a m2b :b m2c :c m2d :d m2e :e m2f :f}]
-   (Matrix.
-    (+ (* m1a m2a) (* m1c m2b))
-    (+ (* m1b m2a) (* m1d m2b))
-    (+ (* m1a m2c) (* m1c m2d))
-    (+ (* m1b m2c) (* m1d m2d))
-    (+ (* m1a m2e) (* m1c m2f) m1e)
-    (+ (* m1b m2e) (* m1d m2f) m1f)))
+  ([^Matrix m1 ^Matrix m2]
+   (let [m1a (.-a m1)
+         m1b (.-b m1)
+         m1c (.-c m1)
+         m1d (.-d m1)
+         m1e (.-e m1)
+         m1f (.-f m1)
+
+         m2a (.-a m2)
+         m2b (.-b m2)
+         m2c (.-c m2)
+         m2d (.-d m2)
+         m2e (.-e m2)
+         m2f (.-f m2)]
+
+     (Matrix.
+      (+ (* m1a m2a) (* m1c m2b))
+      (+ (* m1b m2a) (* m1d m2b))
+      (+ (* m1a m2c) (* m1c m2d))
+      (+ (* m1b m2c) (* m1d m2d))
+      (+ (* m1a m2e) (* m1c m2f) m1e)
+      (+ (* m1b m2e) (* m1d m2f) m1f))))
+
   ([m1 m2 & others]
    (reduce multiply (multiply m1 m2) others)))
 
@@ -53,13 +72,8 @@
   values), combine them. Quicker than multiplying them, for this
   precise case."
   ([{m1e :e m1f :f} {m2e :e m2f :f}]
-   (Matrix.
-    1
-    0
-    0
-     1
-    (+ m1e m2e)
-    (+ m1f m2f)))
+   (Matrix. 1 0 0 1 (+ m1e m2e) (+ m1f m2f)))
+
   ([m1 m2 & others]
    (reduce add-translate (add-translate m1 m2) others)))
 

common/src/app/common/geom/point.cljc

@@ -187,14 +187,14 @@
 (defn round
   "Change the precision of the point coordinates."
   ([point] (round point 0))
-  ([{:keys [x y] :as p} decimanls]
+  ([{:keys [x y] :as p} decimals]
    (assert (point? p))
-   (assert (number? decimanls))
-   (Point. (mth/precision x decimanls)
-           (mth/precision y decimanls))))
+   (assert (number? decimals))
+   (Point. (mth/precision x decimals)
+           (mth/precision y decimals))))
 
 (defn transform
-  "Transform a point applying a matrix transfomation."
+  "Transform a point applying a matrix transformation."
   [{:keys [x y] :as p} {:keys [a b c d e f]}]
   (assert (point? p))
   (Point. (+ (* x a) (* y c) e)

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

@@ -10,6 +10,7 @@
    [app.common.geom.point :as gpt]
    [app.common.geom.shapes.bool :as gsb]
    [app.common.geom.shapes.common :as gco]
+   [app.common.geom.shapes.constraints :as gct]
    [app.common.geom.shapes.intersect :as gin]
    [app.common.geom.shapes.path :as gsp]
    [app.common.geom.shapes.rect :as gpr]
@@ -56,8 +57,7 @@
   rotation of each shape. Mainly used for multiple selection."
   [shapes]
   (->> shapes
-       (gtr/transform-shape)
-       (map (comp gpr/points->selrect :points))
+       (map (comp gpr/points->selrect :points gtr/transform-shape))
        (gpr/join-selrects)))
 
 (defn translate-to-frame
@@ -150,6 +150,7 @@
 (d/export gpr/points->rect)
 (d/export gpr/center->rect)
 (d/export gpr/join-rects)
+(d/export gpr/contains-selrect?)
 
 (d/export gtr/move)
 (d/export gtr/absolute-move)
@@ -163,7 +164,12 @@
 (d/export gtr/rotation-modifiers)
 (d/export gtr/merge-modifiers)
 (d/export gtr/transform-shape)
-(d/export gtr/calc-child-modifiers)
+(d/export gtr/transform-selrect)
+(d/export gtr/modifiers->transform)
+(d/export gtr/empty-modifiers?)
+
+;; Constratins
+(d/export gct/calc-child-modifiers)
 
 ;; PATHS
 (d/export gsp/content->selrect)
@@ -178,3 +184,4 @@
 
 ;; Bool
 (d/export gsb/update-bool-selrect)
+(d/export gsb/calc-bool-content)

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

@@ -6,21 +6,31 @@
 
 (ns app.common.geom.shapes.bool
   (:require
+   [app.common.data :as d]
    [app.common.geom.shapes.path :as gsp]
    [app.common.geom.shapes.rect :as gpr]
    [app.common.geom.shapes.transforms :as gtr]
    [app.common.path.bool :as pb]
    [app.common.path.shapes-to-path :as stp]))
 
+(defn calc-bool-content
+  [shape objects]
+
+  (let [extract-content-xf
+        (comp (map (d/getf objects))
+              (filter (comp not :hidden))
+              (map #(stp/convert-to-path % objects))
+              (map :content))
+
+        shapes-content
+        (into [] extract-content-xf (:shapes shape))]
+    (pb/content-bool (:bool-type shape) shapes-content)))
+
 (defn update-bool-selrect
   "Calculates the selrect+points for the boolean shape"
   [shape children objects]
 
-  (let [content (->> children
-                     (map #(stp/convert-to-path % objects))
-                     (mapv :content)
-                     (pb/content-bool (:bool-type shape)))
-
+  (let [content (calc-bool-content shape objects)
         [points selrect]
         (if (empty? content)
           (let [selrect (gtr/selection-rect children)
@@ -29,4 +39,6 @@
           (gsp/content->points+selrect shape content))]
     (-> shape
         (assoc :selrect selrect)
-        (assoc :points points))))
+        (assoc :points points)
+        (assoc :bool-content content))))
+

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

@@ -50,6 +50,22 @@
    :width width
    :height height})
 
+(defn make-centered-selrect
+  "Creates a rect given a center and a width and height"
+  [center width height]
+  (let [x1 (- (:x center) (/ width 2.0))
+        y1 (- (:y center) (/ height 2.0))
+        x2 (+ x1 width)
+        y2 (+ y1 height)]
+    {:x x1
+     :y y1
+     :x1 x1
+     :x2 x2
+     :y1 y1
+     :y2 y2
+     :width width
+     :height height}))
+
 (defn transform-points
   ([points matrix]
    (transform-points points nil matrix))

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

@@ -0,0 +1,182 @@
+;; 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) UXBOX Labs SL
+
+(ns app.common.geom.shapes.constraints
+  (:require
+   [app.common.geom.matrix :as gmt]
+   [app.common.geom.point :as gpt]
+   [app.common.geom.shapes.common :as gco]
+   [app.common.geom.shapes.transforms :as gtr]
+   [app.common.math :as mth]
+   [app.common.pages.spec :as spec]))
+
+;; Auxiliary methods to work in an specifica axis
+(defn get-delta-start [axis rect tr-rect]
+  (if (= :x axis)
+    (- (:x1 tr-rect) (:x1 rect))
+    (- (:y1 tr-rect) (:y1 rect))))
+
+(defn get-delta-end [axis rect tr-rect]
+  (if (= :x axis)
+    (- (:x2 tr-rect) (:x2 rect))
+    (- (:y2 tr-rect) (:y2 rect))))
+
+(defn get-delta-size [axis rect tr-rect]
+  (if (= :x axis)
+    (- (:width tr-rect) (:width rect))
+    (- (:height tr-rect) (:height rect))))
+
+(defn get-delta-center [axis center tr-center]
+  (if (= :x axis)
+    (- (:x tr-center) (:x center))
+    (- (:y tr-center) (:y center))))
+
+(defn get-displacement
+  ([axis delta]
+   (get-displacement axis delta 0 0))
+
+  ([axis delta init-x init-y]
+   (if (= :x axis)
+     (gpt/point (+ init-x delta) init-y)
+     (gpt/point init-x (+ init-y delta)))))
+
+(defn get-scale [axis scale]
+  (if (= :x axis)
+    (gpt/point scale 1)
+    (gpt/point 1 scale)))
+
+(defn get-size [axis rect]
+  (if (= :x axis)
+    (:width rect)
+    (:height rect)))
+
+;; Constraint function definitions
+
+(defmulti constraint-modifier (fn [type & _] type))
+
+(defmethod constraint-modifier :start
+  [_ axis parent _ _ transformed-parent-rect]
+
+  (let [parent-rect (:selrect parent)
+        delta-start (get-delta-start axis parent-rect transformed-parent-rect)]
+    (if-not (mth/almost-zero? delta-start)
+      {:displacement (get-displacement axis delta-start)}
+      {})))
+
+(defmethod constraint-modifier :end
+  [_ axis parent _ _ transformed-parent-rect]
+  (let [parent-rect (:selrect parent)
+        delta-end (get-delta-end axis parent-rect transformed-parent-rect)]
+    (if-not (mth/almost-zero? delta-end)
+      {:displacement (get-displacement axis delta-end)}
+      {})))
+
+(defmethod constraint-modifier :fixed
+  [_ axis parent child _ transformed-parent-rect]
+  (let [parent-rect (:selrect parent)
+        child-rect (:selrect child)
+
+        delta-start  (get-delta-start axis parent-rect transformed-parent-rect)
+        delta-size   (get-delta-size axis parent-rect transformed-parent-rect)
+        child-size   (get-size axis child-rect)
+        child-center (gco/center-rect child-rect)]
+    (if (or (not (mth/almost-zero? delta-start))
+            (not (mth/almost-zero? delta-size)))
+
+      {:displacement (get-displacement axis delta-start)
+       :resize-origin (-> (get-displacement axis delta-start (:x1 child-rect) (:y1 child-rect))
+                          (gtr/transform-point-center child-center (:transform child (gmt/matrix))))
+       :resize-vector (get-scale axis (/ (+ child-size delta-size) child-size))}
+      {})))
+
+(defmethod constraint-modifier :center
+  [_ axis parent _ _ transformed-parent-rect]
+  (let [parent-rect (:selrect parent)
+        parent-center (gco/center-rect parent-rect)
+        transformed-parent-center (gco/center-rect transformed-parent-rect)
+        delta-center (get-delta-center axis parent-center transformed-parent-center)]
+    (if-not (mth/almost-zero? delta-center)
+      {:displacement (get-displacement axis delta-center)}
+      {})))
+
+(defmethod constraint-modifier :scale
+  [_ axis _ _ modifiers _]
+  (let [{:keys [resize-vector resize-vector-2 displacement]} modifiers]
+      (cond-> {}
+        (and (some? resize-vector)
+             (not (mth/close? (axis resize-vector) 1)))
+        (assoc :resize-origin (:resize-origin modifiers)
+               :resize-vector (if (= :x axis)
+                                (gpt/point (:x resize-vector) 1)
+                                (gpt/point 1 (:y resize-vector))))
+
+        (and (= :y axis) (some? resize-vector-2)
+             (not (mth/close? (:y resize-vector-2) 1)))
+        (assoc :resize-origin (:resize-origin-2 modifiers)
+               :resize-vector (gpt/point 1 (:y resize-vector-2)))
+        
+        (some? displacement)
+        (assoc :displacement
+               (get-displacement axis (-> (gpt/point 0 0)
+                                          (gpt/transform displacement)
+                                          (gpt/transform (:resize-transform-inverse modifiers (gmt/matrix)))
+                                          axis))))))
+
+(defmethod constraint-modifier :default [_ _ _ _ _]
+  {})
+
+(def const->type+axis
+  {:left :start
+   :top :start
+   :right :end
+   :bottom :end
+   :leftright :fixed
+   :topbottom :fixed
+   :center :center
+   :scale :scale})
+
+(defn calc-child-modifiers
+  [parent child modifiers ignore-constraints transformed-parent-rect]
+  (let [constraints-h
+        (if-not ignore-constraints
+          (:constraints-h child (spec/default-constraints-h child))
+          :scale)
+
+        constraints-v
+        (if-not ignore-constraints
+          (:constraints-v child (spec/default-constraints-v child))
+          :scale)
+
+        modifiers-h (constraint-modifier (constraints-h const->type+axis) :x parent child modifiers transformed-parent-rect)
+        modifiers-v (constraint-modifier (constraints-v const->type+axis) :y parent child modifiers transformed-parent-rect)]
+
+    ;; Build final child modifiers. Apply transform again to the result, to get the
+    ;; real modifiers that need to be applied to the child, including rotation as needed.
+    (cond-> {}
+      (or (contains? modifiers-h :displacement)
+          (contains? modifiers-v :displacement))
+      (assoc :displacement (cond-> (gpt/point (get-in modifiers-h [:displacement :x] 0)
+                                              (get-in modifiers-v [:displacement :y] 0))
+                             (some? (:resize-transform modifiers))
+                             (gpt/transform (:resize-transform modifiers))
+
+                             :always
+                             (gmt/translate-matrix)))
+
+      (:resize-vector modifiers-h)
+      (assoc :resize-origin (:resize-origin modifiers-h)
+             :resize-vector (gpt/point (get-in modifiers-h [:resize-vector :x] 1)
+                                       (get-in modifiers-h [:resize-vector :y] 1)))
+
+      (:resize-vector modifiers-v)
+      (assoc :resize-origin-2 (:resize-origin modifiers-v)
+             :resize-vector-2 (gpt/point (get-in modifiers-v [:resize-vector :x] 1)
+                                         (get-in modifiers-v [:resize-vector :y] 1)))
+
+      (:resize-transform modifiers)
+      (assoc :resize-transform (:resize-transform modifiers)
+             :resize-transform-inverse (:resize-transform-inverse modifiers)))))
+

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

@@ -147,7 +147,7 @@
       (not= wn 0))))
 
 ;; A intersects with B
-;; Three posible cases:
+;; Three possible cases:
 ;;   1) A is inside of B
 ;;   2) B is inside of A
 ;;   3) A intersects B
@@ -196,8 +196,8 @@
   [point {:keys [cx cy rx ry transform]}]
 
   (let [center (gpt/point cx cy)
-        transform (gmt/transform-in center transform)
-        {px :x py :y} (gpt/transform point transform)
+        transform (when (some? transform) (gmt/transform-in center transform))
+        {px :x py :y} (if (some? transform) (gpt/transform point transform) point)
         ;; Ellipse inequality formula
         ;; https://en.wikipedia.org/wiki/Ellipse#Shifted_ellipse
         v (+ (/ (mth/sq (- px cx))
@@ -207,11 +207,11 @@
     (<= v 1)))
 
 (defn intersects-line-ellipse?
-  "Checks wether a single line intersects with the given ellipse"
+  "Checks whether a single line intersects with the given ellipse"
   [[{x1 :x y1 :y} {x2 :x y2 :y}] {:keys [cx cy rx ry]}]
 
   ;; Given the ellipse inequality after inserting the line parametric equations
-  ;; we resolve t and gives us a cuadratic formula
+  ;; we resolve t and gives us a quadratic formula
   ;; The result of this quadratic will give us a value of T that needs to be
   ;; between 0-1 to be in the segment
 
@@ -256,10 +256,10 @@
   "Checks if a set of lines intersect with an ellipse in any point"
   [rect-lines {:keys [cx cy transform] :as ellipse-data}]
   (let [center (gpt/point cx cy)
-        transform (gmt/transform-in center transform)]
+        transform (when (some? transform) (gmt/transform-in center transform))]
     (some (fn [[p1 p2]]
-            (let [p1 (gpt/transform p1 transform)
-                  p2 (gpt/transform p2 transform)]
+            (let [p1 (if (some? transform) (gpt/transform p1 transform) p1)
+                  p2 (if (some? transform) (gpt/transform p2 transform) p2)]
               (intersects-line-ellipse? [p1 p2] ellipse-data))) rect-lines)))
 
 (defn overlaps-ellipse?
@@ -284,7 +284,7 @@
         (intersects-lines-ellipse? rect-lines ellipse-data))))
 
 (defn overlaps?
-  "General case to check for overlaping between shapes and a rectangle"
+  "General case to check for overlapping between shapes and a rectangle"
   [shape rect]
   (let [stroke-width (/ (or (:stroke-width shape) 0) 2)
         rect (-> rect

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

@@ -22,7 +22,7 @@
   (mth/almost-zero? (- a b)))
 
 (defn calculate-opposite-handler
-  "Given a point and its handler, gives the symetric handler"
+  "Given a point and its handler, gives the symmetric handler"
   [point handler]
   (let [handler-vector (gpt/to-vec point handler)]
     (gpt/add point (gpt/negate handler-vector))))
@@ -119,7 +119,9 @@
         ;; normalize value
         d (mth/sqrt (+ (* x x) (* y y)))]
 
-    (gpt/point (/ x d) (/ y d))))
+    (if (mth/almost-zero? d)
+      (gpt/point 0 0)
+      (gpt/point (/ x d) (/ y d)))))
 
 (defn curve-windup
   [curve t]
@@ -179,7 +181,7 @@
        (and (mth/almost-zero? d) (mth/almost-zero? a))
        [(/ (- c) b)]
 
-       ;; Cuadratic
+       ;; Quadratic
        (mth/almost-zero? d)
        [(/ (+ (- b) sqrt-b2-4ac)
            (* 2 a))
@@ -279,11 +281,19 @@
           (filterv #(and (>= % 0) (<= % 1)))))))
 
 (defn command->point
-  ([command] (command->point command nil))
-  ([{params :params} coord]
-   (let [prefix (if coord (name coord) "")
-         xkey (keyword (str prefix "x"))
-         ykey (keyword (str prefix "y"))
+  ([command]
+   (command->point command nil))
+
+  ([command coord]
+   (let [params (:params command)
+         xkey (case coord
+                :c1 :c1x
+                :c2 :c2x
+                :x)
+         ykey (case coord
+                :c1 :c1y
+                :c2 :c2y
+                :y)
          x (get params xkey)
          y (get params ykey)]
      (when (and (some? x) (some? y))
@@ -322,7 +332,7 @@
                                                (command->point command :c1)
                                                (command->point command :c2)]]
                                     (->> (curve-extremities curve)
-                                         (map #(curve-values curve %)))))
+                                         (mapv #(curve-values curve %)))))
                   [])
          selrect (gpr/points->selrect points)]
      (-> selrect
@@ -361,25 +371,24 @@
         (update :height #(if (mth/almost-zero? %) 1 %)))))
 
 (defn move-content [content move-vec]
-  (let [set-tr (fn [params px py]
-                 (let [tr-point (-> (gpt/point (get params px) (get params py))
-                                    (gpt/add move-vec))]
-                   (assoc params
-                          px (:x tr-point)
-                          py (:y tr-point))))
+  (let [dx (:x move-vec)
+        dy (:y move-vec)
+
+        set-tr
+        (fn [params px py]
+          (assoc params
+                 px (+ (get params px) dx)
+                 py (+ (get params py) dy)))
 
         transform-params
-        (fn [{:keys [x c1x c2x] :as params}]
+        (fn [params]
           (cond-> params
-            (not (nil? x))   (set-tr :x :y)
-            (not (nil? c1x)) (set-tr :c1x :c1y)
-            (not (nil? c2x)) (set-tr :c2x :c2y)))]
+            (contains? params :x)   (set-tr :x :y)
+            (contains? params :c1x) (set-tr :c1x :c1y)
+            (contains? params :c2x) (set-tr :c2x :c2y)))]
 
     (->> content
-         (mapv (fn [cmd]
-                 (cond-> cmd
-                   (map? cmd)
-                   (update :params transform-params)))))))
+         (mapv #(d/update-when % :params transform-params)))))
 
 (defn transform-content
   [content transform]
@@ -393,11 +402,13 @@
         transform-params
         (fn [{:keys [x c1x c2x] :as params}]
           (cond-> params
-            (not (nil? x))   (set-tr :x :y)
-            (not (nil? c1x)) (set-tr :c1x :c1y)
-            (not (nil? c2x)) (set-tr :c2x :c2y)))]
+            (some? x)   (set-tr :x :y)
+            (some? c1x) (set-tr :c1x :c1y)
+            (some? c2x) (set-tr :c2x :c2y)))]
 
-    (mapv #(update % :params transform-params) content)))
+    (into []
+          (map #(update % :params transform-params))
+          content)))
 
 (defn segments->content
   ([segments]
@@ -675,12 +686,10 @@
 
     (curve-roots c2' :y)))
 
-
-
 (defn ray-line-intersect
   [point [a b :as line]]
 
-  ;; If the ray is paralell to the line there will be no crossings
+  ;; If the ray is parallel to the line there will be no crossings
   (let [ray-line [point (gpt/point (inc (:x point)) (:y point))]
         ;; Rays fail when fall just in a vertex so we move a bit upward
         ;; because only want to use this for insideness
@@ -707,20 +716,19 @@
       [[l1-t] [l2-t]])))
 
 (defn ray-curve-intersect
-  [ray-line c2]
+  [ray-line curve]
 
-  (let [;; ray-line [point (gpt/point (inc (:x point)) (:y point))]
-        curve-ts (->> (line-curve-crossing ray-line c2)
-                      (filterv #(let [curve-v (curve-values c2 %)
-                                      curve-tg (curve-tangent c2 %)
+  (let [curve-ts (->> (line-curve-crossing ray-line curve)
+                      (filterv #(let [curve-v (curve-values curve %)
+                                      curve-tg (curve-tangent curve %)
                                       curve-tg-angle (gpt/angle curve-tg)
                                       ray-t (get-line-tval ray-line curve-v)]
                                   (and (> ray-t 0)
                                        (> (mth/abs (- curve-tg-angle 180)) 0.01)
                                        (> (mth/abs (- curve-tg-angle 0)) 0.01)) )))]
     (->> curve-ts
-         (mapv #(vector (curve-values c2 %)
-                        (curve-windup c2 %))))))
+         (mapv #(vector (curve-values curve %)
+                        (curve-windup curve %))))))
 
 (defn line-curve-intersect
   [l1 c2]
@@ -816,32 +824,58 @@
     (->> content
          (some inside-border?))))
 
-(defn is-point-in-content?
-  [point content]
-  (let [selrect (content->selrect content)
-        ray-line [point (gpt/point (inc (:x point)) (:y point))]
+(defn close-content
+  [content]
+  (into []
+        (comp  (filter sp/is-closed?)
+               (mapcat :data))
+        (->> content
+             (sp/close-subpaths)
+             (sp/get-subpaths))))
 
-        closed-content
-        (into []
-              (comp  (filter sp/is-closed?)
-                     (mapcat :data))
-              (->> content
-                   (sp/close-subpaths)
-                   (sp/get-subpaths)))
+
+(defn ray-overlaps?
+  [ray-point {selrect :selrect}]
+  (and (>= (:y ray-point) (:y1 selrect))
+       (<= (:y ray-point) (:y2 selrect))))
+
+(defn content->geom-data
+  [content]
+
+  (->> content
+       (close-content)
+       (filter #(not= (= :line-to (:command %))
+                      (= :curve-to (:command %))))
+       (mapv (fn [segment]
+               {:command (:command segment)
+                :segment segment
+                :geom (if (= :line-to (:command segment))
+                        (command->line segment)
+                        (command->bezier segment))
+                :selrect (command->selrect segment)}))))
+
+(defn is-point-in-geom-data?
+  [point content-geom]
+
+  (let [ray-line [point (gpt/point (inc (:x point)) (:y point))]
 
         cast-ray
-        (fn [cmd]
-          (case (:command cmd)
-            :line-to  (ray-line-intersect  point (command->line cmd))
-            :curve-to (ray-curve-intersect ray-line (command->bezier cmd))
-            #_:else   []))]
+        (fn [data]
+          (case (:command data)
+            :line-to
+            (ray-line-intersect point (:geom data))
 
-    (and (gpr/contains-point? selrect point)
-         (->> closed-content
-              (mapcat cast-ray)
-              (map second)
-              (reduce +)
-              (not= 0)))))
+            :curve-to
+            (ray-curve-intersect ray-line (:geom data))
+
+            #_:default []))]
+
+    (->> content-geom
+         (filter (partial ray-overlaps? point))
+         (mapcat cast-ray)
+         (map second)
+         (reduce +)
+         (not= 0))))
 
 (defn split-line-to
   "Given a point and a line-to command will create a two new line-to commands

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

@@ -121,3 +121,19 @@
          (or (< px x2) (s= px x2))
          (or (> py y1) (s= py y1))
          (or (< py y2) (s= py y2)))))
+
+(defn contains-selrect?
+  "Check if a selrect sr2 is contained inside sr1"
+  [sr1 sr2]
+  (and (>= (:x1 sr2) (:x1 sr1))
+       (<= (:x2 sr2) (:x2 sr1))
+       (>= (:y1 sr2) (:y1 sr1))
+       (<= (:y2 sr2) (:y2 sr1))))
+
+(defn round-selrect
+  [selrect]
+  (-> selrect
+      (update :x mth/round)
+      (update :y mth/round)
+      (update :width mth/round)
+      (update :height mth/round)))

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

@@ -14,27 +14,33 @@
    [app.common.geom.shapes.path :as gpa]
    [app.common.geom.shapes.rect :as gpr]
    [app.common.math :as mth]
-   [app.common.pages.spec :as spec]
    [app.common.spec :as us]
    [app.common.text :as txt]))
 
+(def ^:dynamic *skip-adjust* false)
+
 ;; --- Relative Movement
 
-(defn- move-selrect [selrect {dx :x dy :y}]
-  (-> selrect
-      (d/update-when :x + dx)
-      (d/update-when :y + dy)
-      (d/update-when :x1 + dx)
-      (d/update-when :y1 + dy)
-      (d/update-when :x2 + dx)
-      (d/update-when :y2 + dy)))
+(defn- move-selrect [selrect pt]
+  (when (and (some? selrect) (some? pt))
+    (let [dx (.-x pt)
+          dy (.-y pt)
+          {:keys [x y x1 y1 x2 y2 width height]} selrect]
+      {:x     (if (some? x) (+ dx x) x)
+       :y     (if (some? y) (+ dy y) y)
+       :x1    (if (some? x1) (+ dx x1) x1)
+       :y1    (if (some? y1) (+ dy y1) y1)
+       :x2    (if (some? x2) (+ dx x2) x2)
+       :y2    (if (some? y2) (+ dy y2) y2)
+       :width width
+       :height height})))
 
 (defn- move-points [points move-vec]
   (->> points
        (mapv #(gpt/add % move-vec))))
 
 (defn move
-  "Move the shape relativelly to its current
+  "Move the shape relatively to its current
   position applying the provided delta."
   [shape {dx :x dy :y}]
   (let [dx (d/check-num dx)
@@ -46,6 +52,8 @@
         (update :points move-points move-vec)
         (d/update-when :x + dx)
         (d/update-when :y + dy)
+        (cond-> (= :bool (:type shape))
+          (update :bool-content gpa/move-content move-vec))
         (cond-> (= :path (:type shape))
           (update :content gpa/move-content move-vec)))))
 
@@ -71,7 +79,7 @@
     :else scale))
 
 (defn- calculate-skew-angle
-  "Calculates the skew angle of the paralelogram given by the points"
+  "Calculates the skew angle of the parallelogram given by the points"
   [[p1 _ p3 p4]]
   (let [v1 (gpt/to-vec p3 p4)
         v2 (gpt/to-vec p4 p1)]
@@ -83,13 +91,13 @@
       (- 90 (gpt/angle-with-other v1 v2)))))
 
 (defn- calculate-height
-  "Calculates the height of a paralelogram given by the points"
+  "Calculates the height of a parallelogram given by the points"
   [[p1 _ _ p4]]
   (-> (gpt/to-vec p4 p1)
       (gpt/length)))
 
 (defn- calculate-width
-  "Calculates the width of a paralelogram given by the points"
+  "Calculates the width of a parallelogram given by the points"
   [[p1 p2 _ _]]
   (-> (gpt/to-vec p1 p2)
       (gpt/length)))
@@ -154,11 +162,12 @@
 (defn transform-point-center
   "Transform a point around the shape center"
   [point center matrix]
-  (gpt/transform
-   point
-   (gmt/multiply (gmt/translate-matrix center)
-                 matrix
-                 (gmt/translate-matrix (gpt/negate center)))))
+  (when point
+    (gpt/transform
+     point
+     (gmt/multiply (gmt/translate-matrix center)
+                   matrix
+                   (gmt/translate-matrix (gpt/negate center))))))
 
 (defn transform-rect
   "Transform a rectangles and changes its attributes"
@@ -170,9 +179,11 @@
 
 (defn calculate-adjust-matrix
   "Calculates a matrix that is a series of transformations we have to do to the transformed rectangle so that
-  after applying them the end result is the `shape-pathn-temp`.
+  after applying them the end result is the `shape-path-temp`.
   This is compose of three transformations: skew, resize and rotation"
-  ([points-temp points-rec] (calculate-adjust-matrix points-temp points-rec false false))
+  ([points-temp points-rec]
+   (calculate-adjust-matrix points-temp points-rec false false))
+
   ([points-temp points-rec flip-x flip-y]
    (let [center (gco/center-points points-temp)
 
@@ -210,63 +221,76 @@
          stretch-matrix (gmt/multiply (gmt/rotate-matrix rotation-angle) stretch-matrix)
 
          ;; This is the inverse to be able to remove the transformation
-         stretch-matrix-inverse (-> (gmt/matrix)
-                                    (gmt/scale (gpt/point (/ 1 w3) (/ 1 h3)))
-                                    (gmt/skew (- skew-angle) 0)
-                                    (gmt/rotate (- rotation-angle)))]
+         stretch-matrix-inverse
+         (gmt/multiply (gmt/scale-matrix (gpt/point (/ 1 w3) (/ 1 h3)))
+                       (gmt/skew-matrix (- skew-angle) 0)
+                       (gmt/rotate-matrix (- rotation-angle)))]
      [stretch-matrix stretch-matrix-inverse rotation-angle])))
 
-(defn- apply-transform
-  "Given a new set of points transformed, set up the rectangle so it keeps
-  its properties. We adjust de x,y,width,height and create a custom transform"
-  [shape transform round-coords?]
-  (let [points (-> shape :points (gco/transform-points transform))
-        center (gco/center-points points)
+(defn is-rotated?
+  [[a b _c _d]]
+  ;; true if either a-b or c-d are parallel to the axis
+  (not (mth/close? (:y a) (:y b))))
 
-        ;; Reverse the current transformation stack to get the base rectangle
-        tr-inverse      (:transform-inverse shape (gmt/matrix))
+(defn- adjust-rotated-transform
+  [{:keys [transform transform-inverse flip-x flip-y]} points]
+  (let [center          (gco/center-points points)
 
-        points-temp     (gco/transform-points points center tr-inverse)
+        points-temp     (cond-> points
+                          (some? transform-inverse)
+                          (gco/transform-points center transform-inverse))
         points-temp-dim (calculate-dimensions points-temp)
 
         ;; This rectangle is the new data for the current rectangle. We want to change our rectangle
         ;; to have this width, height, x, y
-        rect-shape      (-> (gco/make-centered-rect
-                             center
-                             (:width points-temp-dim)
-                             (:height points-temp-dim))
-                            (update :width max 1)
-                            (update :height max 1))
+        new-width  (max 1 (:width points-temp-dim))
+        new-height (max 1 (:height points-temp-dim))
+        selrect    (gco/make-centered-selrect center new-width new-height)
 
-        rect-points     (gpr/rect->points rect-shape)
+        rect-points  (gpr/rect->points selrect)
+        [matrix matrix-inverse] (calculate-adjust-matrix points-temp rect-points flip-x flip-y)]
 
-        [matrix matrix-inverse] (calculate-adjust-matrix points-temp rect-points (:flip-x shape) (:flip-y shape))
+    [selrect
+     (if transform (gmt/multiply transform matrix) matrix)
+     (if transform-inverse (gmt/multiply matrix-inverse transform-inverse) matrix-inverse)]))
 
-        rect-shape (cond-> rect-shape
-                     round-coords?
-                     (-> (update :x mth/round)
-                         (update :y mth/round)
-                         (update :width mth/round)
-                         (update :height mth/round)))
+(defn- apply-transform
+  "Given a new set of points transformed, set up the rectangle so it keeps
+  its properties. We adjust de x,y,width,height and create a custom transform"
+  [shape transform-mtx round-coords?]
 
-        shape (cond
-                (= :path (:type shape))
-                (-> shape
-                    (update :content #(gpa/transform-content % transform)))
+  (let [points'  (:points shape)
+        points   (gco/transform-points points' transform-mtx)
+        bool?    (= (:type shape) :bool)
+        path?    (= (:type shape) :path)
+        rotated? (is-rotated? points)
 
-                :else
-                (-> shape
-                    (merge rect-shape)))
+        [selrect transform transform-inverse]
+        (if (not rotated?)
+          [(gpr/points->selrect points) nil nil]
+          (adjust-rotated-transform shape points))
 
+        selrect (cond-> selrect
+                  round-coords? gpr/round-selrect)
+
+        ;; Redondear los points?
         base-rotation  (or (:rotation shape) 0)
-        modif-rotation (or (get-in shape [:modifiers :rotation]) 0)]
+        modif-rotation (or (get-in shape [:modifiers :rotation]) 0)
+        rotation       (mod (+ base-rotation modif-rotation) 360)]
 
-    (as-> shape $
-      (update $ :transform #(gmt/multiply (or % (gmt/matrix)) matrix))
-      (update $ :transform-inverse #(gmt/multiply matrix-inverse (or % (gmt/matrix))))
-      (assoc  $ :points (into [] points))
-      (assoc  $ :selrect (gpr/rect->selrect rect-shape))
-      (assoc  $ :rotation (mod (+ base-rotation modif-rotation) 360)))))
+    (-> shape
+        (cond-> bool?
+          (update :bool-content gpa/transform-content transform-mtx))
+        (cond-> path?
+          (update :content gpa/transform-content transform-mtx))
+        (cond-> (not path?)
+          (-> (merge (select-keys selrect [:x :y :width :height]))))
+        (cond-> transform
+          (-> (assoc :transform transform)
+              (assoc :transform-inverse transform-inverse)))
+        (assoc :selrect selrect)
+        (assoc :points points)
+        (assoc :rotation rotation))))
 
 (defn- update-group-viewbox
   "Updates the viewbox for groups imported from SVG's"
@@ -299,7 +323,7 @@
                        (gpr/rect->points)
                        (gco/transform-points shape-center (:transform group (gmt/matrix))))
 
-        ;; Calculte the new selrect
+        ;; Calculate the new selrect
         new-selrect (gpr/points->selrect base-points)]
 
     ;; Updates the shape and the applytransform-rect will update the other properties
@@ -342,6 +366,9 @@
 ;;   tells if the resize vectors must be applied to text shapes
 ;;   or not.
 
+(defn empty-modifiers? [modifiers]
+  (empty? (dissoc modifiers :ignore-geometry?)))
+
 (defn resize-modifiers
   [shape attr value]
   (us/assert map? shape)
@@ -385,7 +412,7 @@
     {:rotation angle
      :displacement displacement}))
 
-(defn merge-modifiers
+(defn merge-modifiers*
   [objects modifiers]
 
   (let [set-modifier
@@ -395,53 +422,56 @@
     (->> modifiers
          (reduce set-modifier objects))))
 
-(defn- modifiers->transform
-  [center modifiers]
-  (let [ds-modifier (:displacement modifiers (gmt/matrix))
-        {res-x :x res-y :y} (:resize-vector modifiers (gpt/point 1 1))
-        {res-x-2 :x res-y-2 :y} (:resize-vector-2 modifiers (gpt/point 1 1))
+(def merge-modifiers (memoize merge-modifiers*))
 
-        ;; Normalize x/y vector coordinates because scale by 0 is infinite
-        res-x (normalize-scale res-x)
-        res-y (normalize-scale res-y)
-        resize (gpt/point res-x res-y)
+(defn modifiers->transform
+  ([modifiers]
+   (modifiers->transform nil modifiers))
 
-        res-x-2 (normalize-scale res-x-2)
-        res-y-2 (normalize-scale res-y-2)
-        resize-2 (gpt/point res-x-2 res-y-2)
+  ([center modifiers]
+   (let [displacement (:displacement modifiers)
+         resize-v1 (:resize-vector modifiers)
+         resize-v2 (:resize-vector-2 modifiers)
+         origin-1 (:resize-origin modifiers (gpt/point))
+         origin-2 (:resize-origin-2 modifiers (gpt/point))
 
-        origin (:resize-origin modifiers (gpt/point 0 0))
-        origin-2 (:resize-origin-2 modifiers (gpt/point 0 0))
+         ;; Normalize x/y vector coordinates because scale by 0 is infinite
+         resize-1 (when (some? resize-v1)
+                    (gpt/point (normalize-scale (:x resize-v1))
+                               (normalize-scale (:y resize-v1))))
 
-        resize-transform (:resize-transform modifiers (gmt/matrix))
-        resize-transform-inverse (:resize-transform-inverse modifiers (gmt/matrix))
-        rt-modif (or (:rotation modifiers) 0)
+         resize-2 (when (some? resize-v2)
+                    (gpt/point (normalize-scale (:x resize-v2))
+                               (normalize-scale (:y resize-v2))))
 
-        center (gpt/transform center ds-modifier)
 
-        transform (-> (gmt/matrix)
+         resize-transform (:resize-transform modifiers (gmt/matrix))
+         resize-transform-inverse (:resize-transform-inverse modifiers (gmt/matrix))
 
-                      ;; Applies the current resize transformation
-                      (gmt/translate origin)
-                      (gmt/multiply resize-transform)
-                      (gmt/scale resize)
-                      (gmt/multiply resize-transform-inverse)
-                      (gmt/translate (gpt/negate origin))
+         rt-modif (:rotation modifiers)]
 
-                      (gmt/translate origin-2)
-                      (gmt/multiply resize-transform)
-                      (gmt/scale resize-2)
-                      (gmt/multiply resize-transform-inverse)
-                      (gmt/translate (gpt/negate origin-2))
+     (cond-> (gmt/matrix)
+       (some? resize-1)
+       (-> (gmt/translate origin-1)
+           (gmt/multiply resize-transform)
+           (gmt/scale resize-1)
+           (gmt/multiply resize-transform-inverse)
+           (gmt/translate (gpt/negate origin-1)))
 
-                      ;; Applies the stacked transformations
-                      (gmt/translate center)
-                      (gmt/multiply (gmt/rotate-matrix rt-modif))
-                      (gmt/translate (gpt/negate center))
+       (some? resize-2)
+       (-> (gmt/translate origin-2)
+           (gmt/multiply resize-transform)
+           (gmt/scale resize-2)
+           (gmt/multiply resize-transform-inverse)
+           (gmt/translate (gpt/negate origin-2)))
 
-                      ;; Displacement
-                      (gmt/multiply ds-modifier))]
-    transform))
+       (some? displacement)
+       (gmt/multiply displacement)
+
+       (some? rt-modif)
+       (-> (gmt/translate center)
+           (gmt/multiply (gmt/rotate-matrix rt-modif))
+           (gmt/translate (gpt/negate center)))))))
 
 (defn- set-flip [shape modifiers]
   (let [rx (or (get-in modifiers [:resize-vector :x])
@@ -463,7 +493,7 @@
             modifiers (dissoc modifiers :displacement)]
         (-> shape
             (assoc :modifiers modifiers)
-            (cond-> (empty? modifiers)
+            (cond-> (empty-modifiers? modifiers)
               (dissoc :modifiers))))
       shape)))
 
@@ -485,205 +515,77 @@
                                 %)))
     shape))
 
+(defn apply-modifiers
+  [shape modifiers round-coords?]
+  (let [center (gco/center-shape shape)
+        transform (modifiers->transform center modifiers)]
+    (apply-transform shape transform round-coords?)))
+
 (defn transform-shape
   ([shape]
    (transform-shape shape nil))
 
-  ([shape {:keys [round-coords?]
-           :or {round-coords? true}}]
-   (let [shape     (apply-displacement shape)
-         center    (gco/center-shape shape)
-         modifiers (:modifiers shape)]
-     (if (and modifiers center)
-       (let [transform (modifiers->transform center modifiers)]
-         (-> shape
-             (set-flip modifiers)
-             (apply-transform transform round-coords?)
-             (apply-text-resize modifiers)
-             (dissoc :modifiers)))
-       shape))))
+  ([shape {:keys [round-coords?] :or {round-coords? true}}]
+   (let [modifiers (:modifiers shape)]
+     (cond
+       (nil? modifiers)
+       shape
 
-(defn calc-child-modifiers
-  "Given the modifiers to apply to the parent, calculate the corresponding
-  modifiers for the child, depending on the child constraints."
-  [parent child parent-modifiers ignore-constraints]
-  (let [parent-rect             (:selrect parent)
-        child-rect              (:selrect child)
+       (empty-modifiers? modifiers)
+       (dissoc shape :modifiers)
 
-        ;; Apply the modifiers to the parent's selrect, to check the difference with
-        ;; the original, and calculate child transformations from this.
-        ;;
-        ;; Note that a shape's selrect is always "horizontal" (i.e. without applying
-        ;; the shape transform, that may include some rotation and skew). Thus, to
-        ;; apply the modifiers, we first apply to them the transform-inverse.
-        parent-displacement (-> (gpt/point 0 0)
-                                (gpt/transform (get parent-modifiers :displacement (gmt/matrix)))
-                                (gpt/transform (:resize-transform-inverse parent-modifiers (gmt/matrix)))
-                                (gmt/translate-matrix))
-        parent-origin       (-> (:resize-origin parent-modifiers)
-                                ((d/nilf transform-point-center)
-                                 (gco/center-shape parent)
-                                 (:resize-transform-inverse parent-modifiers (gmt/matrix))))
-        parent-origin-2     (-> (:resize-origin-2 parent-modifiers)
-                                ((d/nilf transform-point-center)
-                                 (gco/center-shape parent)
-                                 (:resize-transform-inverse parent-modifiers (gmt/matrix))))
-        parent-vector       (get parent-modifiers :resize-vector (gpt/point 1 1))
-        parent-vector-2     (get parent-modifiers :resize-vector-2 (gpt/point 1 1))
+       :else
+       (let [shape     (apply-displacement shape)
+             modifiers (:modifiers shape)]
+         (cond-> shape
+           (not (empty-modifiers? modifiers))
+           (-> (set-flip modifiers)
+               (apply-modifiers modifiers round-coords?)
+               (apply-text-resize modifiers))
 
-        transformed-parent-rect (-> parent-rect
-                                    (gpr/rect->points)
-                                    (gco/transform-points parent-displacement)
-                                    (gco/transform-points parent-origin (gmt/scale-matrix parent-vector))
-                                    (gco/transform-points parent-origin-2 (gmt/scale-matrix parent-vector-2))
-                                    (gpr/points->selrect))
+           :always
+           (dissoc :modifiers)))))))
 
-        ;; Calculate the modifiers in the horizontal and vertical directions
-        ;; depending on the child constraints.
-        constraints-h (if-not ignore-constraints
-                        (get child :constraints-h (spec/default-constraints-h child))
-                        :scale)
-        constraints-v (if-not ignore-constraints
-                        (get child :constraints-v (spec/default-constraints-v child))
-                        :scale)
+(defn transform-selrect
+  [selrect {:keys [displacement resize-transform-inverse resize-vector resize-origin resize-vector-2 resize-origin-2]}]
+ 
+  ;; FIXME: Improve Performance
+  (let [resize-transform-inverse (or resize-transform-inverse (gmt/matrix))
 
-        modifiers-h (case constraints-h
-                      :left
-                      (let [delta-left (- (:x1 transformed-parent-rect) (:x1 parent-rect))]
+        displacement
+        (when (some? displacement)
+          (gmt/multiply resize-transform-inverse displacement)
+          #_(-> (gpt/point 0 0)
+              (gpt/transform displacement)
+              (gpt/transform resize-transform-inverse)
+              (gmt/translate-matrix)))
 
-                        (if-not (mth/almost-zero? delta-left)
-                          {:displacement (gpt/point delta-left 0)} ;; we convert to matrix below
-                          {}))
+        resize-origin
+        (when (some? resize-origin)
+          (transform-point-center resize-origin (gco/center-selrect selrect) resize-transform-inverse))
 
-                      :right
-                      (let [delta-right (- (:x2 transformed-parent-rect) (:x2 parent-rect))]
-                        (if-not (mth/almost-zero? delta-right)
-                          {:displacement (gpt/point delta-right 0)}
-                          {}))
+        resize-origin-2
+        (when (some? resize-origin-2)
+          (transform-point-center resize-origin-2 (gco/center-selrect selrect) resize-transform-inverse))]
 
-                      :leftright
-                      (let [delta-left (- (:x1 transformed-parent-rect) (:x1 parent-rect))
-                            delta-width (- (:width transformed-parent-rect) (:width parent-rect))]
-                        (if (or (not (mth/almost-zero? delta-left))
-                                (not (mth/almost-zero? delta-width)))
-                          {:displacement (gpt/point delta-left 0)
-                           :resize-origin (-> (gpt/point (+ (:x1 child-rect) delta-left)
-                                                         (:y1 child-rect))
-                                              (transform-point-center
-                                                (gco/center-rect child-rect)
-                                                (:transform child (gmt/matrix))))
-                           :resize-vector (gpt/point (/ (+ (:width child-rect) delta-width)
-                                                        (:width child-rect)) 1)}
-                          {}))
+    (if (and (nil? displacement) (nil? resize-origin) (nil? resize-origin-2))
+      selrect
 
-                      :center
-                      (let [parent-center (gco/center-rect parent-rect)
-                            transformed-parent-center (gco/center-rect transformed-parent-rect)
-                            delta-center (- (:x transformed-parent-center) (:x parent-center))]
-                        (if-not (mth/almost-zero? delta-center)
-                          {:displacement (gpt/point delta-center 0)}
-                          {}))
+      (cond-> selrect
+        :always
+        (gpr/rect->points)
 
-                      :scale
-                      (cond-> {}
-                        (and (:resize-vector parent-modifiers)
-                             (not (mth/close? (:x (:resize-vector parent-modifiers)) 1)))
-                        (assoc :resize-origin (:resize-origin parent-modifiers)
-                               :resize-vector (gpt/point (:x (:resize-vector parent-modifiers)) 1))
+        (some? displacement)
+        (gco/transform-points displacement)
 
-                        ;; resize-vector-2 is always for vertical modifiers, so no need to
-                        ;; check it here.
+        (some? resize-origin)
+        (gco/transform-points resize-origin (gmt/scale-matrix resize-vector))
 
-                        (:displacement parent-modifiers)
-                        (assoc :displacement
-                               (gpt/point (-> (gpt/point 0 0)
-                                              (gpt/transform (:displacement parent-modifiers))
-                                              (gpt/transform (:resize-transform-inverse parent-modifiers (gmt/matrix)))
-                                              (:x))
-                                          0)))
-                      {})
+        (some? resize-origin-2)
+        (gco/transform-points resize-origin-2 (gmt/scale-matrix resize-vector-2))
 
-        modifiers-v (case constraints-v
-                      :top
-                      (let [delta-top (- (:y1 transformed-parent-rect) (:y1 parent-rect))]
-                        (if-not (mth/almost-zero? delta-top)
-                          {:displacement (gpt/point 0 delta-top)} ;; we convert to matrix below
-                          {}))
-
-                      :bottom
-                      (let [delta-bottom (- (:y2 transformed-parent-rect) (:y2 parent-rect))]
-                        (if-not (mth/almost-zero? delta-bottom)
-                          {:displacement (gpt/point 0 delta-bottom)}
-                          {}))
-
-                      :topbottom
-                      (let [delta-top (- (:y1 transformed-parent-rect) (:y1 parent-rect))
-                            delta-height (- (:height transformed-parent-rect) (:height parent-rect))]
-                        (if (or (not (mth/almost-zero? delta-top))
-                                (not (mth/almost-zero? delta-height)))
-                          {:displacement (gpt/point 0 delta-top)
-                           :resize-origin (-> (gpt/point (:x1 child-rect)
-                                                         (+ (:y1 child-rect) delta-top))
-                                              (transform-point-center
-                                                (gco/center-rect child-rect)
-                                                (:transform child (gmt/matrix))))
-                           :resize-vector (gpt/point 1 (/ (+ (:height child-rect) delta-height)
-                                                          (:height child-rect)))}
-                          {}))
-
-                      :center
-                      (let [parent-center (gco/center-rect parent-rect)
-                            transformed-parent-center (gco/center-rect transformed-parent-rect)
-                            delta-center (- (:y transformed-parent-center) (:y parent-center))]
-                        (if-not (mth/almost-zero? delta-center)
-                          {:displacement (gpt/point 0 delta-center)}
-                          {}))
-
-                      :scale
-                      (cond-> {}
-                        (and (:resize-vector parent-modifiers)
-                             (not (mth/close? (:y (:resize-vector parent-modifiers)) 1)))
-                        (assoc :resize-origin (:resize-origin parent-modifiers)
-                               :resize-vector (gpt/point 1 (:y (:resize-vector parent-modifiers))))
-
-                        ;; If there is a resize-vector-2, this means that we come from a recursive
-                        ;; call, and the resize-vector has no vertical data, so we may override it.
-                        (and (:resize-vector-2 parent-modifiers)
-                             (not (mth/close? (:y (:resize-vector-2 parent-modifiers)) 1)))
-                        (assoc :resize-origin (:resize-origin-2 parent-modifiers)
-                               :resize-vector (gpt/point 1 (:y (:resize-vector-2 parent-modifiers))))
-
-                        (:displacement parent-modifiers)
-                        (assoc :displacement
-                               (gpt/point 0 (-> (gpt/point 0 0)
-                                                (gpt/transform (:displacement parent-modifiers))
-                                                (gpt/transform (:resize-transform-inverse parent-modifiers (gmt/matrix)))
-                                                (:y)))))
-                      {})]
-
-    ;; Build final child modifiers. Apply transform again to the result, to get the
-    ;; real modifiers that need to be applied to the child, including rotation as needed.
-    (cond-> {}
-      (or (:displacement modifiers-h) (:displacement modifiers-v))
-      (assoc :displacement (gmt/translate-matrix
-                             (-> (gpt/point (get (:displacement modifiers-h) :x 0)
-                                            (get (:displacement modifiers-v) :y 0))
-                                 (gpt/transform
-                                   (:resize-transform parent-modifiers (gmt/matrix))))))
-
-      (:resize-vector modifiers-h)
-      (assoc :resize-origin (:resize-origin modifiers-h)
-             :resize-vector (gpt/point (get (:resize-vector modifiers-h) :x 1)
-                                       (get (:resize-vector modifiers-h) :y 1)))
-
-      (:resize-vector modifiers-v)
-      (assoc :resize-origin-2 (:resize-origin modifiers-v)
-             :resize-vector-2 (gpt/point (get (:resize-vector modifiers-v) :x 1)
-                                         (get (:resize-vector modifiers-v) :y 1)))
-
-      (:resize-transform parent-modifiers)
-      (assoc :resize-transform (:resize-transform parent-modifiers)
-             :resize-transform-inverse (:resize-transform-inverse parent-modifiers)))))
+        :always
+        (gpr/points->selrect)))))
 
 
 (defn selection-rect
@@ -691,6 +593,5 @@
   rotation of each shape. Mainly used for multiple selection."
   [shapes]
   (->> shapes
-       (transform-shape)
-       (map (comp gpr/points->selrect :points))
+       (map (comp gpr/points->selrect :points transform-shape))
        (gpr/join-selrects)))

common/src/app/common/logging.cljc

@@ -9,16 +9,23 @@
    [app.common.exceptions :as ex]
    [clojure.pprint :refer [pprint]]
    [cuerdas.core :as str]
+   #?(:clj [io.aviso.exception :as ie])
    #?(:cljs [goog.log :as glog]))
-  #?(:cljs (:require-macros [app.common.logging]))
-  #?(:clj
-     (:import
-      org.apache.logging.log4j.Level
-      org.apache.logging.log4j.LogManager
-      org.apache.logging.log4j.Logger
-      org.apache.logging.log4j.ThreadContext
-      org.apache.logging.log4j.message.MapMessage
-      org.apache.logging.log4j.spi.LoggerContext)))
+  #?(:cljs (:require-macros [app.common.logging])
+     :clj  (:import
+            org.apache.logging.log4j.Level
+            org.apache.logging.log4j.LogManager
+            org.apache.logging.log4j.Logger
+            org.apache.logging.log4j.ThreadContext
+            org.apache.logging.log4j.CloseableThreadContext
+            org.apache.logging.log4j.message.MapMessage
+            org.apache.logging.log4j.spi.LoggerContext)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; CLJ Specific
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+#?(:clj (set! *warn-on-reflection* true))
 
 #?(:clj
    (defn build-map-message
@@ -34,17 +41,75 @@
   (def logging-agent
     (agent nil :error-mode :continue)))
 
+(defn- simple-prune
+  ([s] (simple-prune s (* 1024 1024)))
+  ([s max-length]
+   (if (> (count s) max-length)
+     (str (subs s 0 max-length) " [...]")
+     s)))
+
+#?(:clj
+   (defn stringify-data
+     [val]
+     (cond
+       (instance? clojure.lang.Named val)
+       (name val)
+
+       (instance? Throwable val)
+       (binding [ie/*app-frame-names* [#"app.*"]
+                 ie/*fonts* nil
+                 ie/*traditional* true]
+         (ie/format-exception val nil))
+
+       (string? val)
+       val
+
+       (coll? val)
+       (binding [clojure.pprint/*print-right-margin* 200]
+         (-> (with-out-str (pprint val))
+             (simple-prune (* 1024 1024 3))))
+
+       :else
+       (str val))))
+
+#?(:clj
+   (defn data->context-map
+     ^java.util.Map
+     [data]
+     (into {}
+           (comp (filter second)
+                 (map (fn [[key val]]
+                        [(stringify-data key)
+                         (stringify-data val)])))
+           data)))
+
+#?(:clj
+   (defn set-context!
+     [data]
+     (ThreadContext/putAll (data->context-map data))
+     nil))
+
+#?(:clj
+   (defmacro with-context
+     [data & body]
+     `(let [data# (data->context-map ~data)]
+        (with-open [closeable# (CloseableThreadContext/putAll data#)]
+          ~@body))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Common
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (defn get-logger
   [lname]
   #?(:clj  (.getLogger ^LoggerContext logger-context ^String lname)
-     :cljs
-      (glog/getLogger
-       (cond
-         (string? lname) lname
-         (= lname :root) ""
-         (simple-ident? lname) (name lname)
-         (qualified-ident? lname) (str (namespace lname) "." (name lname))
-         :else (str lname)))))
+     :cljs (glog/getLogger
+            (cond
+              (string? lname) lname
+              (= lname :root) ""
+              (simple-ident? lname) (name lname)
+              (qualified-ident? lname) (str (namespace lname) "." (name lname))
+              :else (str lname)))))
 
 (defn get-level
   [level]
@@ -87,7 +152,7 @@
      :cljs
      (when glog/ENABLED
        (when-let [l (get-logger logger)]
-         (let [level  (get-level level)
+         (let [level (get-level level)
                record (glog/LogRecord. level message (.getName ^js l))]
            (when exception (.setException record exception))
            (glog/publishLogRecord l record))))))
@@ -98,7 +163,7 @@
      (.isEnabled ^Logger logger ^Level level)))
 
 (defmacro log
-  [& {:keys [level cause ::logger ::async ::raw] :as props}]
+  [& {:keys [level cause ::logger ::async ::raw] :or {async true} :as props}]
   (if (:ns &env) ; CLJS
     `(write-log! ~(or logger (str *ns*))
                  ~level
@@ -112,10 +177,12 @@
              ~level-sym  (get-level ~level)]
          (if (enabled? ~logger-sym ~level-sym)
            ~(if async
-              `(send-off logging-agent
-                         (fn [_#]
-                           (let [message# (or ~raw (build-map-message ~props))]
-                             (write-log! ~logger-sym ~level-sym ~cause message#))))
+              `(let [cdata# (ThreadContext/getImmutableContext)]
+                 (send-off logging-agent
+                           (fn [_#]
+                             (with-context (into {:cause ~cause} cdata#)
+                               (->> (or ~raw (build-map-message ~props))
+                                    (write-log! ~logger-sym ~level-sym ~cause))))))
               `(let [message# (or ~raw (build-map-message ~props))]
                  (write-log! ~logger-sym ~level-sym ~cause message#))))))))
 
@@ -147,24 +214,6 @@
    (when (:ns &env)
      `(set-level* ~n ~level))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; CLJ Specific
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-#?(:clj
-   (defn update-thread-context!
-     [data]
-     (run! (fn [[key val]]
-             (ThreadContext/put
-              (name key)
-              (cond
-                (coll? val)
-                (binding [clojure.pprint/*print-right-margin* 120]
-                  (with-out-str (pprint val)))
-                (instance? clojure.lang.Named val) (name val)
-                :else (str val))))
-           data)))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; CLJS Specific
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -213,7 +262,6 @@
      (some-> (get-logger name)
              (glog/setLevel (get-level lvl)))))
 
-
 #?(:cljs
    (defn set-levels!
      [lvls]

common/src/app/common/media.cljc

@@ -78,7 +78,7 @@
     (re-seq #"(?i)(?:extra\s*bold|ultra\s*bold)" variant)   800
     (re-seq #"(?i)(?:bold)" variant)                        700
     (re-seq #"(?i)(?:extra\s*black|ultra\s*black)" variant) 950
-    (re-seq #"(?i)(?:black|heavy)" variant)                 900
+    (re-seq #"(?i)(?:black|heavy|solid)" variant)           900
     :else                                                   400))
 
 (defn parse-font-style

common/src/app/common/namedtuple.cljc

@@ -0,0 +1,111 @@
+(ns app.common.namedtuple
+  "General purpose small immutable colections backed by native arrays."
+  (:require
+   #?(:cljs [cljs.core :as c]
+      :clj  [clojure.core :as c])
+   [clojure.string :as str]))
+
+(defmacro deftuple
+  [nsym fields]
+  (let [sbuff   (symbol "buff")
+        sfields (symbol "fields")
+        smeta   (symbol "meta")
+        params  (into [] (comp (map name)
+                               (map gensym))
+                      fields)
+        tmpbuf  (gensym "buff")
+        f1name  (symbol (str "make-" (str/lower-case (name nsym))))]
+    `(do
+       (deftype ~nsym [~sbuff ~smeta]
+         ;; Object
+         ;; (toString [_#] (pr-str ~sbuff))
+         ;; (equiv [_# other#] false)
+
+         c/ICloneable
+         (~'-clone [_#] (new ~nsym (aclone ~sbuff) ~smeta))
+
+         c/IWithMeta
+         (~'-with-meta [this# new-meta#]
+          (if (identical? new-meta# ~smeta)
+            this#
+            (new ~nsym ~sbuff new-meta#)))
+
+         c/IMeta
+         (~'-meta [_#] ~smeta)
+
+         c/ICollection
+         (~'-conj [_# entry#]
+          (conj (vec ~sbuff) entry#))
+
+         c/IEmptyableCollection
+         (~'-empty [_#]
+          (let [len#  (alength ~sbuff)
+                buff# (make-array len#)]
+            (dotimes [i# len#]
+              (aset buff# i# nil))
+            (new ~nsym buff# ~smeta)))
+
+         c/ISeqable
+         (~'-seq [_#] (seq ~sbuff))
+
+         c/IAssociative
+         (~'-assoc [this# k# v#]
+          (let [index# (case k#
+                         ~@(mapcat (fn [i n] [i n])
+                                   fields
+                                   (range (count fields)))
+                         (throw (ex-info "invalid key" {})))
+                buff#  (aclone ~sbuff)]
+            (aset buff# index# v#)
+            (new ~nsym buff# ~smeta)))
+
+         (~'-contains-key? [_# k#]
+          (case k#
+            ~@(mapcat (fn [n] [n true]) fields)
+            false))
+
+         c/ICounted
+         (~'-count [_#]
+          (alength ~sbuff))
+
+         c/ILookup
+         (~'-lookup [_# k#]
+          (case k#
+            ~@(mapcat (fn [n i] [n `(aget ~sbuff ~i)])
+                      fields
+                      (range (count fields)))
+            nil))
+
+         (~'-lookup [this# k# not-found#]
+          (or (case k#
+                ~@(mapcat (fn [n i] [n `(aget ~sbuff ~i)])
+                          fields
+                          (range (count fields)))
+                nil)
+              not-found#))
+
+         c/IPrintWithWriter
+         (~'-pr-writer [this# writer# _#]
+          (c/-write writer# (str "#penpot/namedtuple"
+                                 (pr-str (into {} [~@(map (fn [k i]
+                                                            [k `(aget ~sbuff ~i)])
+                                                          fields
+                                                          (range (count fields)))])))))
+
+
+         c/IFn
+         (~'-invoke [this# k#]
+          (c/-lookup this# k#))
+
+         (~'-invoke [this# k# not-found#]
+          (c/-lookup this# k# not-found#)))
+
+       (defn ~f1name ~params
+         (let [~tmpbuf (js/Float64Array. 6)]
+           ~@(map-indexed (fn [i x] `(aset ~tmpbuf ~i ~x)) params)
+           ;; (js/console.log buff#)
+           (new ~nsym ~tmpbuf nil)))
+
+       )))
+
+