✨ Add unique id (uuid) on each log entry

The prev approach uses clojure.pprint without any limit extensivelly
for format error context data and all this is done on the calling
thread. The clojure.pprint seems very inneficient in cpu and memory
usage on pprinting large data structures.

This is improved in the following way:

- All formatting and pretty printing is moved to logging thread,
  reducing unnecesary blocking and load on jetty http threads.
- Replace the clojure.pprint with fipp.edn that looks considerably
  faster than the first one.
- Add some safe limits on pretty printer for strip printing some
  data when the data structure is very large, very deep or both.

.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

@@ -10,7 +10,6 @@
  {: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
    }}
 

.gitignore

@@ -1,45 +1,50 @@
-figwheel_server.log
-*jar
 *-init.clj
+*.jar
+*.penpot
+.calva
+.clj-kondo
+.cpcache
 .lein-deps-sum
 .lein-failures
-.lein-repl-history
 .lein-plugins/
-.repl
+.lein-repl-history
+.lsp
 .nrepl-port
-.cpcache
+.nyc_output
 .rebel_readline_history
-/vendor/**/target
-/cd.md
-node_modules
-/backend/target/
-/backend/resources/public/media
-/backend/resources/public/assets
+.repl
+/.clj-kondo/.cache
+/_dump
+/backend/-
 /backend/assets/
 /backend/dist/
 /backend/logs/
-/backend/-
-/telemetry/
-/frontend/npm-debug.log
-/frontend/target/
-/frontend/dist/
-/frontend/out/
-/frontend/.shadow-cljs
-/frontend/resources/public/*
-/frontend/resources/fonts/experiments
-/exporter/target
-/exporter/.shadow-cljs
-/docker/images/bundle*
-/common/.shadow-cljs
-/common/target
-/.clj-kondo/.cache
+/backend/resources/public/assets
+/backend/resources/public/media
+/backend/target/
 /bundle*
-/media
+/cd.md
+/clj-profiler/
+/common/.shadow-cljs
+/common/coverage
+/common/target
 /deploy
-/web
-/_dump
+/docker/images/bundle*
+/exporter/.shadow-cljs
+/exporter/target
+/frontend/.shadow-cljs
+/frontend/cypress/videos/*/
+/frontend/dist/
+/frontend/npm-debug.log
+/frontend/out/
+/frontend/resources/fonts/experiments
+/frontend/resources/public/*
+/frontend/target/
+/media
+/telemetry/
+/vendor/**/target
 /vendor/svgclean/bundle*.js
-
-.calva
-.clj-kondo
-.lsp
+/web
+clj-profiler/
+figwheel_server.log
+node_modules

CHANGES.md

@@ -1,15 +1,126 @@
 # CHANGELOG
 
-## :rocket: Next
+## 1.11.2-beta
+
+### :bug: Bugs fixed
+
+- Fix issue on handling empty content on boolean shapes
+- Fix race condition issue on component renaming
+- Handle EOF errors on writting streamed response
+- Handle EOF errors on websocket send/ping methods
+- Disable parallel upload of file media on import (causes too much
+  contention on the rlimit subsistem that does not works as expected
+  on high load).
+
+### :sparkles: New features
+
+- Add health check endpoint on API
+- Increase default max connection pool size to 60
+- Reduce resource usage of the error reporter.
+
+
+## 1.11.1-beta
+
+### :bug: Bugs fixed
+
+- Fix issue related to default http host config value.
+- Fix issue on rendering frames on firefox.
+
+### :arrow_up: Deps updates
+
+- Update nodejs version to 16.13.1 on docker images.
+
+
+## 1.11.0-beta
 
 ### :boom: Breaking changes
+
 ### :sparkles: New features
+
+- Add an option to hide artboards names on the viewport [Taiga #2034](https://tree.taiga.io/project/penpot/issue/2034)
+- Limit pasted object position to container boundaries [Taiga #2449](https://tree.taiga.io/project/penpot/us/2449)
+- Add new options for zoom widget in workspace and viewer mode [Taiga #896](https://tree.taiga.io/project/penpot/us/896)
+- Allow decimals on stroke width and positions [Taiga #2035](https://tree.taiga.io/project/penpot/issue/2035)
+- Ability to ignore background when exporting an artboard [Taiga #1395](https://tree.taiga.io/project/penpot/us/1395)
+- Show color hex or name on hover [Taiga #2413](https://tree.taiga.io/project/penpot/us/2413)
+- 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)
+- Add performance improvements on .penpot file import process [Taiga #2497](https://tree.taiga.io/project/penpot/us/2497)
+- On team settings set color of members count to black [Taiga #2607](https://tree.taiga.io/project/penpot/us/2607)
+
 ### :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)
+- Fix problem with imported svgs with filters [Taiga #2478](https://tree.taiga.io/project/penpot/issue/2478)
+- Fix issues when updating selrect in paths [Taiga #2366](https://tree.taiga.io/project/penpot/issue/2366)
+- Fix scroll jumps in handoff mode [Taiga #2383](https://tree.taiga.io/project/penpot/issue/2383)
+- Fix handoff text with opacity [Taiga #2384](https://tree.taiga.io/project/penpot/issue/2384)
+- Restored rules color [Taiga #2460](https://tree.taiga.io/project/penpot/issue/2460)
+- Fix thumbnail not taking frame blending mode [Taiga #2301](https://tree.taiga.io/project/penpot/issue/2301)
+- Fix import/export with SVG edge cases [Taiga #2389](https://tree.taiga.io/project/penpot/issue/2389)
+- Avoid modifying component when moving into a group [Taiga #2534](https://tree.taiga.io/project/penpot/issue/2534)
+- Show correctly group types label in handoff [Taiga #2482](https://tree.taiga.io/project/penpot/issue/2482)
+- Display view mode buttons always centered in viewer [#Taiga 2466](https://tree.taiga.io/project/penpot/issue/2466)
+- Fix default profile image generation issue [Taiga #2601](https://tree.taiga.io/project/penpot/issue/2601)
+- Fix edit blur attributes for multiselection [Taiga #2625](https://tree.taiga.io/project/penpot/issue/2625)
+- Fix auto hide header in viewer full screen [Taiga #2632](https://tree.taiga.io/project/penpot/issue/2632)
+- Fix zoom in/out after fit or fill [Taiga #2630](https://tree.taiga.io/project/penpot/issue/2630)
+- Normalize zoom levels in workspace and viewer [Taiga #2631](https://tree.taiga.io/project/penpot/issue/2631)
+- Avoid empty names in projects, files and pages [Taiga #2594](https://tree.taiga.io/project/penpot/issue/2594)
+- Fix "move to" menu when duplicated team or project names [Taiga #2655](https://tree.taiga.io/project/penpot/issue/2655)
+- Fix ungroup a component leaves an asterisk in layers [Taiga #2694](https://tree.taiga.io/project/penpot/issue/2694)
+
 ### :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
+## 1.10.4-beta
 
 ### :sparkles: Enhacements
 
@@ -21,8 +132,7 @@
 - Minor fix on how file changes log is persisted.
 - Fix many issues on error reporting.
 
-
-# 1.10.3-beta
+## 1.10.3-beta
 
 ### :sparkles: Enhacements
 
@@ -33,7 +143,7 @@
 
 - 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).
+- 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.
@@ -44,8 +154,7 @@
 
 - Update log4j2 dependency.
 
-
-# 1.10.2-beta
+## 1.10.2-beta
 
 ### :bug: Bugs fixed
 
@@ -57,14 +166,12 @@
 
 - Update log4j2 dependency.
 
-
-# 1.10.1-beta
+## 1.10.1-beta
 
 ### :bug: Bugs fixed
 
 - Fix problems with team management [#1353](https://github.com/penpot/penpot/issues/1353)
 
-
 ## 1.10.0-beta
 
 ### :boom: Breaking changes
@@ -76,18 +183,19 @@
 
 ### :sparkles: New features
 
-- 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).
+- 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.
 
 ### :bug: Bugs fixed
 
-- Fix problem with exporting before the document is saved [Taiga #2189](https://tree.taiga.io/project/penpot/issue/2189).
-- Fix undo stacking when changing color from color-picker [Taiga #2191](https://tree.taiga.io/project/penpot/issue/2191).
-- Fix pages dropdown in viewer [Taiga #2087](https://tree.taiga.io/project/penpot/issue/2087).
-- Fix problem when exporting texts with gradients or opacity [Taiga #2200](https://tree.taiga.io/project/penpot/issue/2200).
-- Fix problem with view mode comments [Taiga #2226](https://tree.taiga.io/project/penpot/issue/2226).
-- Disallow to create a component when already has one [Taiga #2237](https://tree.taiga.io/project/penpot/issue/2237).
+- Fix problem with exporting before the document is saved [Taiga #2189](https://tree.taiga.io/project/penpot/issue/2189)
+- Fix undo stacking when changing color from color-picker [Taiga #2191](https://tree.taiga.io/project/penpot/issue/2191)
+- Fix pages dropdown in viewer [Taiga #2087](https://tree.taiga.io/project/penpot/issue/2087)
+- Fix problem when exporting texts with gradients or opacity [Taiga #2200](https://tree.taiga.io/project/penpot/issue/2200)
+- Fix problem with view mode comments [Taiga #2226](https://tree.taiga.io/project/penpot/issue/2226)
+- Disallow to create a component when already has one [Taiga #2237](https://tree.taiga.io/project/penpot/issue/2237)
 - Add ellipsis in long labels for input fields [Taiga #2224](https://tree.taiga.io/project/penpot/issue/2224)
 - Fix problem with text rendering on export [Taiga #2223](https://tree.taiga.io/project/penpot/issue/2223)
 - Fix problem when flattening booleans losing styles [Taiga #2217](https://tree.taiga.io/project/penpot/issue/2217)
@@ -100,61 +208,66 @@
 - 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
 
-- Add boolean shapes: intersections, unions, difference and exclusions[Taiga #748](https://tree.taiga.io/project/penpot/us/748).
-- Add advanced prototyping [Taiga #244](https://tree.taiga.io/project/penpot/us/244).
-- Add multiple flows [Taiga #2091](https://tree.taiga.io/project/penpot/us/2091).
+- Add boolean shapes: intersections, unions, difference and exclusions[Taiga #748](https://tree.taiga.io/project/penpot/us/748)
+- Add advanced prototyping [Taiga #244](https://tree.taiga.io/project/penpot/us/244)
+- Add multiple flows [Taiga #2091](https://tree.taiga.io/project/penpot/us/2091)
 - Change order of the teams menu so it's in the joined time order.
 
 ### :bug: Bugs fixed
 
-- Enhance duplicating prototype connections behaviour [Taiga #2093](https://tree.taiga.io/project/penpot/us/2093).
-- Ignore constraints in horizontal or vertical flip [Taiga #2038](https://tree.taiga.io/project/penpot/issue/2038).
-- Fix color and typographies refs lost when duplicated file [Taiga #2165](https://tree.taiga.io/project/penpot/issue/2165).
-- Fix problem with overflow dropdown on stroke-cap [#1216](https://github.com/penpot/penpot/issues/1216).
-- Fix menu context for single element nested in components [#1186](https://github.com/penpot/penpot/issues/1186).
-- Fix error screen when operations over comments fail [#1219](https://github.com/penpot/penpot/issues/1219).
-- Fix undo problem when changing typography/color from library [#1230](https://github.com/penpot/penpot/issues/1230).
-- Fix problem with text margin while rendering [#1231](https://github.com/penpot/penpot/issues/1231).
-- Fix problem with masked texts on exporting [Taiga #2116](https://tree.taiga.io/project/penpot/issue/2116).
-- Fix text editor enter behaviour with centered texts [Taiga #2126](https://tree.taiga.io/project/penpot/issue/2126).
-- Fix residual stroke on imported svg [Taiga #2125](https://tree.taiga.io/project/penpot/issue/2125).
-- Add links for terms of service and privacy policy in register checkbox [Taiga #2020](https://tree.taiga.io/project/penpot/issue/2020).
-- Allow three character hex and web colors in color picker hex input [#1184](https://github.com/penpot/penpot/issues/1184).
-- Allow lowercase search for fonts [#1180](https://github.com/penpot/penpot/issues/1180).
-- Fix group renaming problem [Taiga #1969](https://tree.taiga.io/project/penpot/issue/1969).
-- Fix export group with shadows on children [Taiga #2036](https://tree.taiga.io/project/penpot/issue/2036).
-- Fix zoom context menu in viewer [Taiga #2041](https://tree.taiga.io/project/penpot/issue/2041).
-- Fix stroke caps adjustments in relation with stroke size [Taiga #2123](https://tree.taiga.io/project/penpot/issue/2123).
-- Fix problem duplicating paths [Taiga #2147](https://tree.taiga.io/project/penpot/issue/2147).
-- Fix problem inheriting attributes from SVG root when importing [Taiga #2124](https://tree.taiga.io/project/penpot/issue/2124).
-- Fix problem with lines and inside/outside stroke [Taiga #2146](https://tree.taiga.io/project/penpot/issue/2146).
-- Add stroke width in selection calculation [Taiga #2146](https://tree.taiga.io/project/penpot/issue/2146).
-- Fix shift+wheel to horizontal scrolling in MacOS [#1217](https://github.com/penpot/penpot/issues/1217).
-- Fix path stroke is not working properly with high thickness [Taiga #2154](https://tree.taiga.io/project/penpot/issue/2154).
-- Fix bug with transformation operations [Taiga #2155](https://tree.taiga.io/project/penpot/issue/2155).
-- Fix bug in firefox when a text box is inside a mask [Taiga #2152](https://tree.taiga.io/project/penpot/issue/2152).
+- Enhance duplicating prototype connections behaviour [Taiga #2093](https://tree.taiga.io/project/penpot/us/2093)
+- Ignore constraints in horizontal or vertical flip [Taiga #2038](https://tree.taiga.io/project/penpot/issue/2038)
+- Fix color and typographies refs lost when duplicated file [Taiga #2165](https://tree.taiga.io/project/penpot/issue/2165)
+- Fix problem with overflow dropdown on stroke-cap [#1216](https://github.com/penpot/penpot/issues/1216)
+- Fix menu context for single element nested in components [#1186](https://github.com/penpot/penpot/issues/1186)
+- Fix error screen when operations over comments fail [#1219](https://github.com/penpot/penpot/issues/1219)
+- Fix undo problem when changing typography/color from library [#1230](https://github.com/penpot/penpot/issues/1230)
+- Fix problem with text margin while rendering [#1231](https://github.com/penpot/penpot/issues/1231)
+- Fix problem with masked texts on exporting [Taiga #2116](https://tree.taiga.io/project/penpot/issue/2116)
+- Fix text editor enter behaviour with centered texts [Taiga #2126](https://tree.taiga.io/project/penpot/issue/2126)
+- Fix residual stroke on imported svg [Taiga #2125](https://tree.taiga.io/project/penpot/issue/2125)
+- Add links for terms of service and privacy policy in register checkbox [Taiga #2020](https://tree.taiga.io/project/penpot/issue/2020)
+- Allow three character hex and web colors in color picker hex input [#1184](https://github.com/penpot/penpot/issues/1184)
+- Allow lowercase search for fonts [#1180](https://github.com/penpot/penpot/issues/1180)
+- Fix group renaming problem [Taiga #1969](https://tree.taiga.io/project/penpot/issue/1969)
+- Fix export group with shadows on children [Taiga #2036](https://tree.taiga.io/project/penpot/issue/2036)
+- Fix zoom context menu in viewer [Taiga #2041](https://tree.taiga.io/project/penpot/issue/2041)
+- Fix stroke caps adjustments in relation with stroke size [Taiga #2123](https://tree.taiga.io/project/penpot/issue/2123)
+- Fix problem duplicating paths [Taiga #2147](https://tree.taiga.io/project/penpot/issue/2147)
+- Fix problem inheriting attributes from SVG root when importing [Taiga #2124](https://tree.taiga.io/project/penpot/issue/2124)
+- Fix problem with lines and inside/outside stroke [Taiga #2146](https://tree.taiga.io/project/penpot/issue/2146)
+- Add stroke width in selection calculation [Taiga #2146](https://tree.taiga.io/project/penpot/issue/2146)
+- Fix shift+wheel to horizontal scrolling in MacOS [#1217](https://github.com/penpot/penpot/issues/1217)
+- Fix path stroke is not working properly with high thickness [Taiga #2154](https://tree.taiga.io/project/penpot/issue/2154)
+- Fix bug with transformation operations [Taiga #2155](https://tree.taiga.io/project/penpot/issue/2155)
+- 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)
-- Fix unlink color styles at strokes [Taiga #2206](https://tree.taiga.io/project/penpot/issue/2206).
+- Fix unlink color styles at strokes [Taiga #2206](https://tree.taiga.io/project/penpot/issue/2206)
 
 ### :arrow_up: Deps updates
 
@@ -163,13 +276,11 @@
 - To the translation community for the hard work on making penpot
   available on so many languages.
 
-
-
 ## 1.8.4-alpha
 
 ### :bug: Bugs fixed
 
-- Fix problem importing components [Taiga #2151](https://tree.taiga.io/project/penpot/issue/2151).
+- Fix problem importing components [Taiga #2151](https://tree.taiga.io/project/penpot/issue/2151)
 
 ## 1.8.3-alpha
 
@@ -181,18 +292,17 @@
 
 ### :bug: Bugs fixed
 
-- Fix problem with masking images in viewer [#1238](https://github.com/penpot/penpot/issues/1238).
+- Fix problem with masking images in viewer [#1238](https://github.com/penpot/penpot/issues/1238)
 
 ## 1.8.1-alpha
 
 ### :bug: Bugs fixed
 
-- Fix project renaming issue (and some other related to the same underlying bug).
+- Fix project renaming issue (and some other related to the same underlying bug)
 - Fix internal exception on audit log persistence layer.
 - Set proper environment variable on docker images for chrome executable.
 - Fix internal metrics on websocket connections.
 
-
 ## 1.8.0-alpha
 
 ### :boom: Breaking changes
@@ -203,25 +313,25 @@
 
 ### :sparkles: New features
 
-- Add tooltips to color picker tabs [Taiga #1814](https://tree.taiga.io/project/penpot/us/1814).
-- Add styling to the end point of any open paths [Taiga #1107](https://tree.taiga.io/project/penpot/us/1107).
-- Allow to zoom with ctrl + middle button [Taiga #1428](https://tree.taiga.io/project/penpot/us/1428).
-- Auto placement of duplicated objects [Taiga #1386](https://tree.taiga.io/project/penpot/us/1386).
-- Enable penpot SVG metadata only when exporting complete files [Taiga #1914](https://tree.taiga.io/project/penpot/us/1914?milestone=295883).
-- Export to PDF all artboards of one page [Taiga #1895](https://tree.taiga.io/project/penpot/us/1895).
-- Go to a undo step clicking on a history element of the list [Taiga #1374](https://tree.taiga.io/project/penpot/us/1374).
-- Increment font size by 10 with shift+arrows [1047](https://github.com/penpot/penpot/issues/1047).
-- New shortcut to detach components Ctrl+Shift+K [Taiga #1799](https://tree.taiga.io/project/penpot/us/1799).
-- Set email inputs to type "email", to aid keyboard entry [Taiga #1921](https://tree.taiga.io/project/penpot/issue/1921).
-- Use shift+move to move element orthogonally [#823](https://github.com/penpot/penpot/issues/823).
-- Use space + mouse drag to pan, instead of only space [Taiga #1800](https://tree.taiga.io/project/penpot/us/1800).
-- Allow navigate through pages on the viewer [Taiga #1550](https://tree.taiga.io/project/penpot/us/1550).
-- Allow create share links with specific pages [Taiga #1844](https://tree.taiga.io/project/penpot/us/1844).
+- Add tooltips to color picker tabs [Taiga #1814](https://tree.taiga.io/project/penpot/us/1814)
+- Add styling to the end point of any open paths [Taiga #1107](https://tree.taiga.io/project/penpot/us/1107)
+- Allow to zoom with ctrl + middle button [Taiga #1428](https://tree.taiga.io/project/penpot/us/1428)
+- Auto placement of duplicated objects [Taiga #1386](https://tree.taiga.io/project/penpot/us/1386)
+- Enable penpot SVG metadata only when exporting complete files [Taiga #1914](https://tree.taiga.io/project/penpot/us/1914?milestone=295883)
+- Export to PDF all artboards of one page [Taiga #1895](https://tree.taiga.io/project/penpot/us/1895)
+- Go to a undo step clicking on a history element of the list [Taiga #1374](https://tree.taiga.io/project/penpot/us/1374)
+- Increment font size by 10 with shift+arrows [1047](https://github.com/penpot/penpot/issues/1047)
+- New shortcut to detach components Ctrl+Shift+K [Taiga #1799](https://tree.taiga.io/project/penpot/us/1799)
+- Set email inputs to type "email", to aid keyboard entry [Taiga #1921](https://tree.taiga.io/project/penpot/issue/1921)
+- Use shift+move to move element orthogonally [#823](https://github.com/penpot/penpot/issues/823)
+- Use space + mouse drag to pan, instead of only space [Taiga #1800](https://tree.taiga.io/project/penpot/us/1800)
+- Allow navigate through pages on the viewer [Taiga #1550](https://tree.taiga.io/project/penpot/us/1550)
+- Allow create share links with specific pages [Taiga #1844](https://tree.taiga.io/project/penpot/us/1844)
 
 ### :bug: Bugs fixed
 
-- Prevent adding numeric suffix to layer names when not needed [Taiga #1929](https://tree.taiga.io/project/penpot/us/1929).
-- Prevent deleting or moving the drafts project [Taiga #1935](https://tree.taiga.io/project/penpot/issue/1935).
+- Prevent adding numeric suffix to layer names when not needed [Taiga #1929](https://tree.taiga.io/project/penpot/us/1929)
+- Prevent deleting or moving the drafts project [Taiga #1935](https://tree.taiga.io/project/penpot/issue/1935)
 - Fix problem with zoom and selection [Taiga #1919](https://tree.taiga.io/project/penpot/issue/1919)
 - Fix problem with borders on shape export [#1092](https://github.com/penpot/penpot/issues/1092)
 - Fix thumbnail cropping issue [Taiga #1964](https://tree.taiga.io/project/penpot/issue/1964)
@@ -234,11 +344,12 @@
 - Fix problem while moving imported SVG's [#1199](https://github.com/penpot/penpot/issues/1199)
 
 ### :arrow_up: Deps updates
+
 ### :boom: Breaking changes
+
 ### :heart: Community contributions by (Thank you!)
 
-- eduayme [#1129](https://github.com/penpot/penpot/pull/1129).
-
+- eduayme [#1129](https://github.com/penpot/penpot/pull/1129)
 
 ## 1.7.4-alpha
 
@@ -247,14 +358,12 @@
 - Fix demo user creation (self-hosted only)
 - Add better ldap response validation and reporting (self-hosted only)
 
-
 ## 1.7.3-alpha
 
 ### :bug: Bugs fixed
 
 - Fix font uploading issue on Windows.
 
-
 ## 1.7.2-alpha
 
 ### :sparkles: New features
@@ -263,8 +372,8 @@
 
 ### :bug: Bugs fixed
 
-- Add scroll bar to Teams menu [Taiga #1894](https://tree.taiga.io/project/penpot/issue/1894).
-- Fix repeated names when duplicating artboards or groups [Taiga #1892](https://tree.taiga.io/project/penpot/issue/1892).
+- Add scroll bar to Teams menu [Taiga #1894](https://tree.taiga.io/project/penpot/issue/1894)
+- Fix repeated names when duplicating artboards or groups [Taiga #1892](https://tree.taiga.io/project/penpot/issue/1892)
 - Fix properly messages lifecycle on navigate.
 - Fix handling repeated names on duplicate object trees.
 - Fix group naming on group creation.
@@ -278,7 +387,6 @@
 
 - soultipsy [#1100](https://github.com/penpot/penpot/pull/1100)
 
-
 ## 1.7.1-alpha
 
 ### :bug: Bugs fixed
@@ -288,19 +396,18 @@
 - Fix issue on undo page deletion.
 - Fix some issues related to constraints.
 
-
 ## 1.7.0-alpha
 
 ### :sparkles: New features
 
-- Allow nested asset groups [Taiga #1716](https://tree.taiga.io/project/penpot/us/1716).
-- Allow to ungroup assets [Taiga #1719](https://tree.taiga.io/project/penpot/us/1719).
-- Allow to rename assets groups [Taiga #1721](https://tree.taiga.io/project/penpot/us/1721).
-- Component constraints (left, right, left and right, center, scale...) [Taiga #1125](https://tree.taiga.io/project/penpot/us/1125).
-- Export elements to PDF [Taiga #519](https://tree.taiga.io/project/penpot/us/519).
-- Memorize collapse state of assets in panel [Taiga #1718](https://tree.taiga.io/project/penpot/us/1718).
-- Headers button sets and menus review [Taiga #1663](https://tree.taiga.io/project/penpot/us/1663).
-- Preserve components if possible, when pasted into a different file [Taiga #1063](https://tree.taiga.io/project/penpot/issue/1063).
+- Allow nested asset groups [Taiga #1716](https://tree.taiga.io/project/penpot/us/1716)
+- Allow to ungroup assets [Taiga #1719](https://tree.taiga.io/project/penpot/us/1719)
+- Allow to rename assets groups [Taiga #1721](https://tree.taiga.io/project/penpot/us/1721)
+- Component constraints (left, right, left and right, center, scale...) [Taiga #1125](https://tree.taiga.io/project/penpot/us/1125)
+- Export elements to PDF [Taiga #519](https://tree.taiga.io/project/penpot/us/519)
+- Memorize collapse state of assets in panel [Taiga #1718](https://tree.taiga.io/project/penpot/us/1718)
+- Headers button sets and menus review [Taiga #1663](https://tree.taiga.io/project/penpot/us/1663)
+- Preserve components if possible, when pasted into a different file [Taiga #1063](https://tree.taiga.io/project/penpot/issue/1063)
 - Add the ability to offload file data to a cheaper storage when file becomes inactive.
 - Import/Export Penpot files from dashboard.
 - Double click won't make a shape a path until you change a node [Taiga #1796](https://tree.taiga.io/project/penpot/us/1796)
@@ -309,21 +416,20 @@
 ### :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).
-- 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).
-- Fix workspace header presence styles and invalid link [Taiga #1813](https://tree.taiga.io/project/penpot/issue/1813).
-- Fix color-input wrong behavior (on workspace page color) [Taiga #1795](https://tree.taiga.io/project/penpot/issue/1795).
-- Fix file contextual menu in shared libraries at dashboard [Taiga #1865](https://tree.taiga.io/project/penpot/issue/1865).
+- 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)
+- Fix workspace header presence styles and invalid link [Taiga #1813](https://tree.taiga.io/project/penpot/issue/1813)
+- Fix color-input wrong behavior (on workspace page color) [Taiga #1795](https://tree.taiga.io/project/penpot/issue/1795)
+- Fix file contextual menu in shared libraries at dashboard [Taiga #1865](https://tree.taiga.io/project/penpot/issue/1865)
 - Fix problem with color picker and fonts [#1049](https://github.com/penpot/penpot/issues/1049)
 - 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)
 
-
 ## 1.6.5-alpha
 
 ### :bug: Bugs fixed
@@ -334,8 +440,8 @@
 
 ### :sparkles: Minor improvements
 
--  Decrease default bulk buffers on storage tasks.
--  Reduce file_change preserve interval to 24h.
+- Decrease default bulk buffers on storage tasks.
+- Reduce file_change preserve interval to 24h.
 
 ### :bug: Bugs fixed
 
@@ -348,7 +454,6 @@
 - Properly handle nil values on `update-shapes` function.
 - Replace frame term usage by artboard on viewer app.
 
-
 ## 1.6.3-alpha
 
 ### :bug: Bugs fixed
@@ -375,42 +480,39 @@
 - Minor fix on previous commit.
 - Minor improvements on svg uploading on libraries.
 
-
 ## 1.6.1-alpha
 
 ### :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.
 
-
 ## 1.6.0-alpha
 
 ### :sparkles: New features
 
-- Add improved workspace font selector [Taiga US #292](https://tree.taiga.io/project/penpot/us/292).
+- Add improved workspace font selector [Taiga US #292](https://tree.taiga.io/project/penpot/us/292)
 - Add option to interactively scale text [Taiga #1527](https://tree.taiga.io/project/penpot/us/1527)
 - Add performance improvements on dashboard data loading.
 - Add performance improvements to indexes handling on workspace.
-- Add the ability to upload/use custom fonts (and automatically generate all needed webfonts) [Taiga US #292](https://tree.taiga.io/project/penpot/us/292).
+- Add the ability to upload/use custom fonts (and automatically generate all needed webfonts) [Taiga US #292](https://tree.taiga.io/project/penpot/us/292)
 - 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. 
-
+- 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.
 
 ### :bug: Bugs fixed
 
-- Remove interactions when the destination artboard is deleted [Taiga #1656](https://tree.taiga.io/project/penpot/issue/1656).
-- Fix problem with fonts that ends with numbers [#940](https://github.com/penpot/penpot/issues/940).
+- Remove interactions when the destination artboard is deleted [Taiga #1656](https://tree.taiga.io/project/penpot/issue/1656)
+- Fix problem with fonts that ends with numbers [#940](https://github.com/penpot/penpot/issues/940)
 - Fix problem with imported SVG on editing paths [#971](https://github.com/penpot/penpot/issues/971)
 - Fix problem with color picker positioning
 - Fix order on color palette [#961](https://github.com/penpot/penpot/issues/961)
@@ -424,7 +526,6 @@
 - Update exporter dependencies (puppeteer), that fixes some unexpected exceptions.
 - Update string manipulation library.
 
-
 ### :boom: Breaking changes
 
 - The OIDC setting `PENPOT_OIDC_SCOPES` has changed the default semantics. Before this
@@ -435,7 +536,6 @@
 
 - Translations: Portuguese (Brazil) and Romanias.
 
-
 ## 1.5.4-alpha
 
 ### :bug: Bugs fixed
@@ -443,7 +543,6 @@
 - Fix issues on group rendering.
 - Fix problem with text editing auto-height [Taiga #1683](https://tree.taiga.io/project/penpot/issue/1683)
 
-
 ## 1.5.3-alpha
 
 ### :bug: Bugs fixed
@@ -467,7 +566,6 @@
 - Increase default team invitation token expiration to 48h.
 - Fix wrong error message when an expired token is used.
 
-
 ## 1.5.0-alpha
 
 ### :sparkles: New features
@@ -513,7 +611,6 @@
 - madmath03 (by [Monogramm](https://github.com/Monogramm)) [#807](https://github.com/penpot/penpot/pull/807)
 - zzkt [#814](https://github.com/penpot/penpot/pull/814)
 
-
 ## 1.4.1-alpha
 
 ### :bug: Bugs fixed
@@ -525,7 +622,6 @@
 - Fix incorrect state management of user lang selection.
 - Fix email validation usability issue on team invitation lightbox.
 
-
 ## 1.4.0-alpha
 
 ### :sparkles: New features
@@ -534,7 +630,7 @@
 - Add http caching layer on top of Query RPC.
 - Add layer opacity and blend mode to shapes [Taiga #937](https://tree.taiga.io/project/penpot/us/937)
 - Add more chinese translations [#726](https://github.com/penpot/penpot/pull/726)
-- Add native support for text-direction (RTL, LTR & auto).
+- Add native support for text-direction (RTL, LTR & auto)
 - Add several enhancements in shape selection [Taiga #1195](https://tree.taiga.io/project/penpot/us/1195)
 - Add thumbnail in memory caching mechanism.
 - Add turkish translation strings [#759](https://github.com/penpot/penpot/pull/759), [#794](https://github.com/penpot/penpot/pull/794)
@@ -542,13 +638,12 @@
 - Hide viewer navbar on fullscreen [Taiga 1375](https://tree.taiga.io/project/penpot/us/1375)
 - Import SVG will create Penpot's shapes [Taiga #1006](https://tree.taiga.io/project/penpot/us/1066)
 - Improve french translations [#731](https://github.com/penpot/penpot/pull/731)
-- Reimplement workspace presence (remove database state).
+- Reimplement workspace presence (remove database state)
 - Remember last visited team when you re-enter the application [Taiga #1376](https://tree.taiga.io/project/penpot/us/1376)
 - Rename artboard with double click on the title [Taiga #1392](https://tree.taiga.io/project/penpot/us/1392)
 - Replace Slate-Editor with DraftJS [Taiga #1346](https://tree.taiga.io/project/penpot/us/1346)
 - Set proper page title [Taiga #1377](https://tree.taiga.io/project/penpot/us/1377)
 
-
 ### :bug: Bugs fixed
 
 - Disable buttons in view mode for users without permissions [Taiga #1328](https://tree.taiga.io/project/penpot/issue/1328)
@@ -589,15 +684,13 @@
 
 - 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
 
 - Update backend to JDK16.
 - Update exporter nodejs to v14.16.0
 
-
 ### :heart: Community contributions by (Thank you!)
 
 - iblueer [#726](https://github.com/penpot/penpot/pull/726)
@@ -605,27 +698,25 @@
 - girafic [#748](https://github.com/penpot/penpot/pull/748)
 - mbrksntrk [#794](https://github.com/penpot/penpot/pull/794)
 
-
 ## 1.3.0-alpha
 
 ### :sparkles: New features
 
 - 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
 
 - Add more improvements to french translation strings [#591](https://github.com/penpot/penpot/pull/591)
-- Add some missing database indexes (mainly improves performance on large databases on file-update rpc method, and some background tasks).
+- Add some missing database indexes (mainly improves performance on large databases on file-update rpc method, and some background tasks)
 - Disables filters in masking elements (issue with Firefox rendering)
 - Drawing tool will have priority over resize/rotate handlers [Taiga #1225](https://tree.taiga.io/project/penpot/issue/1225)
 - Fix broken bounding box on editing paths [Taiga #1254](https://tree.taiga.io/project/penpot/issue/1254)
@@ -639,16 +730,14 @@
 - Have language change notification written in the new language [Taiga #1205](https://tree.taiga.io/project/penpot/issue/1205)
 - Hide register screen when registration is disabled [#598](https://github.com/penpot/penpot/issues/598)
 - Properly handle errors on github, gitlab and ldap auth backends.
-- Properly mark profile auth backend (on first register/ auth with 3rd party auth provider).
+- Properly mark profile auth backend (on first register/ auth with 3rd party auth provider)
 - Refactor LDAP auth backend.
 
-
 ### :heart: Community contributions by (Thank you!)
 
 - girafic [#538](https://github.com/penpot/penpot/pull/654)
 - arkhi [#591](https://github.com/penpot/penpot/pull/591)
 
-
 ## 1.2.0-alpha
 
 ### :sparkles: New features
@@ -663,7 +752,6 @@
 - Show a pixel grid when zoom greater than 800% [#519](https://github.com/penpot/penpot/discussions/519)
 - Fix behavior of select all command when there are objects outside frames [Taiga #1209](https://tree.taiga.io/project/penpot/issue/1209)
 
-
 ### :bug: Bugs fixed
 
 - Fix 404 when access shared link [#615](https://github.com/penpot/penpot/issues/615)
@@ -699,7 +787,6 @@
 - Improved MacOS shortcuts and helpers
 - Small changes to shape creation
 
-
 ## 1.0.0-alpha
 
 Initial release

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
@@ -54,7 +54,7 @@ We will use the `easy fix` mark for tag for indicate issues that are
 easy for beginners.
 
 
-## Commit Message Guidelines ##
+## Commit Guidelines ##
 
 We have very precise rules over how our git commit messages can be formatted.
 
@@ -78,7 +78,6 @@ Where type is:
 - :ambulance: `:ambulance:` a commit that fixes critical bug
 - :books: `:books:` a commit that improves or adds documentation
 - :construction: `:construction:`: a wip commit
-- :construction_worker: `:construction_worker:` a commit with CI related stuff
 - :boom: `:boom:` a commit with breaking changes
 - :wrench: `:wrench:` a commit for config updates
 - :zap: `:zap:` a commit with performance improvements
@@ -91,13 +90,14 @@ More info:
  - https://gist.github.com/parmentf/035de27d6ed1dce0b36a
  - https://gist.github.com/rxaviers/7360908
 
-The subject should be:
-
-- Use the imperative mood.
-- Capitalize the first letter.
-- Don't put a period at the end of the subject line.
-- Put a blank line between the subject line and the body.
+Each commit should have:
 
+- A concise subject using imperative mood.
+- The subject should have capitalized the first letter and without
+  period at the end.
+- A blank line between the subject line and the body.
+- An entry on the CHANGES.md file if applicable, referencing the
+  github or taiga issue/user-story using the these same rules.
 
 ## Code of conduct ##
 

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

@@ -6,67 +6,71 @@
   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"}
+  io.lettuce/lettuce-core {:mvn/version "6.1.6.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"}
+  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.2.23"}
-  com.zaxxer/HikariCP {:mvn/version "5.0.0"}
+  org.postgresql/postgresql {:mvn/version "42.3.1"}
+  com.zaxxer/HikariCP {:mvn/version "5.0.1"}
   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"}
+  buddy/buddy-hashers {:mvn/version "1.8.158"}
+  buddy/buddy-sign {:mvn/version "3.4.333"}
 
-  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
   pretty-spec/pretty-spec {:mvn/version "0.1.4"}
-  software.amazon.awssdk/s3 {:mvn/version "2.17.40"}}
+  software.amazon.awssdk/s3 {:mvn/version "2.17.111"}}
 
- :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
-                {:git/url "https://github.com/cognitect-labs/test-runner.git"
-                 :git/sha "dd6da11611eeb87f08780a30ac8ea6012d4c05ce"}}
+  {:extra-paths ["test"]
+   :extra-deps
+   {io.github.cognitect-labs/test-runner
+    {:git/tag "v0.5.0" :git/sha "b3fd0d2"}}
    :exec-fn cognitect.test-runner.api/test}
 
   :outdated

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,11 +79,13 @@
 
 (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

backend/resources/error-list.tmpl

@@ -1,94 +0,0 @@
-<!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

@@ -1,154 +0,0 @@
-<!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>
-      body {
-        margin: 0px;
-        padding: 0px;
-      }
-      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;
-      }
-
-      .table-row {
-        display: flex;
-        /* width: 100%; */
-        /* border: 1px solid red; */
-      }
-
-      .table-key {
-        font-weight: 600;
-        width: 60px;
-        padding: 4px;
-
-        padding-top: 40px;
-        margin-top: -40px;
-      }
-
-      .table-val {
-        font-weight: 200;
-        color: #333;
-        padding: 4px;
-      }
-
-      .multiline {
-        margin-top: 15px;
-        flex-direction: column;
-      }
-
-      .multiline .table-key {
-        margin-bottom: 10px;
-        border-bottom: 1px dashed #dddddd;
-        /* padding: 4px; */
-        width: unset;
-      }
-
-    </style>
-  </head>
-  <body>
-
-    <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>[<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 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>
-    </main>
-  </body>
-</html>
-

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/resources/templates/base.tmpl

@@ -0,0 +1,18 @@
+<!DOCTYPE html>
+<html>
+  <head>
+    <meta charset="utf-8" />
+    <meta name="robots" content="noindex,nofollow">
+    <meta http-equiv="x-ua-compatible" content="ie=edge" />
+    <title>{% block title %}{% endblock %}</title>
+    <link rel="stylesheet" href="https://fonts.googleapis.com/css2?family=JetBrains+Mono">
+    <style>
+      {% include "templates/styles.css"  %}
+    </style>
+  </head>
+  <body>
+    {% block content %}
+    {% endblock %}
+  </body>
+</html>
+

backend/resources/templates/debug.tmpl

@@ -0,0 +1,32 @@
+{% extends "templates/base.tmpl" %}
+
+{% block title %}
+Debug Main Page
+{% endblock %}
+
+{% block content %}
+<nav>
+  <h1>Debug INDEX:</h1>
+  <div>[<a href="/dbg/error">ERRORS</a>]</div>
+</nav>
+<main class="index">
+  <section>
+    <h2>Download file data:</h2>
+    <desc>Given an FILE-ID, downloads the file data as file. The file data is encoded using transit.</desc>
+    <form method="get" action="/dbg/file/data">
+      <input type="text" style="width:300px" name="file-id" placeholder="file-id" />
+      <input type="hidden" name="download" value="1" />
+      <input type="submit" value="Download" />
+    </form>
+  </section>
+
+  <section>
+    <h2>Upload File Data:</h2>
+    <desc>Create a new file on your draft projects using the file downloaded from the previous section.</desc>
+    <form method="post" enctype="multipart/form-data" action="/dbg/file/data">
+      <input type="file" name="file" value="" />
+      <input type="submit" value="Upload" />
+    </form>
+  </section>
+</main>
+{% endblock %}

backend/resources/templates/error-list.tmpl

@@ -0,0 +1,18 @@
+{% extends "templates/base.tmpl" %}
+
+{% block title %}
+penpot - error list
+{% endblock %}
+
+{% block content %}
+<nav>
+  <h1>Latest error reports:</h1>
+</nav>
+<main class="horizontal-list">
+  <ul>
+    {% for item in items %}
+    <li><a href="/dbg/error/{{item.id}}">{{item.created-at}}</a></li>
+    {% endfor %}
+  </ul>
+</main>
+{% endblock %}

backend/resources/templates/error-report.tmpl

@@ -0,0 +1,98 @@
+{% extends "templates/base.tmpl" %}
+
+{% block title %}
+penpot - error report {{id}}
+{% endblock %}
+
+{% block content %}
+<nav>
+  <div>[<a href="/dbg/error">⮜</a>]</div>
+  <div>[<a href="#context">context</a>]</div>
+  <div>[<a href="#params">request params</a>]</div>
+  {% if data %}
+  <div>[<a href="#edata">error data</a>]</div>
+  {% endif %}
+  {% if spec-explain %}
+  <div>[<a href="#spec-explain">spec explain</a>]</div>
+  {% endif %}
+  {% if spec-problems %}
+  <div>[<a href="#spec-problems">spec problems</a>]</div>
+  {% endif %}
+  {% if spec-value %}
+  <div>[<a href="#spec-value">spec value</a>]</div>
+  {% endif %}
+
+  {% if trace %}
+  <div>[<a href="#trace">error 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">
+        <h1>{{hint}}</h1>
+      </div>
+
+      <div class="table-val">
+        <pre>{{context}}</pre>
+      </div>
+    </div>
+
+    {% if params %}
+    <div class="table-row multiline">
+      <div id="params" class="table-key">REQUEST PARAMS: </div>
+      <div class="table-val">
+        <pre>{{params}}</pre>
+      </div>
+    </div>
+    {% endif %}
+
+    {% 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-explain %}
+    <div class="table-row multiline">
+      <div id="spec-explain" class="table-key">SPEC EXPLAIN: </div>
+      <div class="table-val">
+        <pre>{{spec-explain}}</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 spec-value %}
+    <div class="table-row multiline">
+      <div id="spec-value" class="table-key">SPEC VALUE: </div>
+      <div class="table-val">
+        <pre>{{spec-value}}</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>
+</main>
+{% endblock %}

backend/resources/templates/styles.css

@@ -0,0 +1,150 @@
+* {
+  font-family: "JetBrains Mono", monospace;
+  font-size: 12px;
+}
+
+body {
+  margin: 0px;
+  padding: 0px;
+}
+
+pre {
+  margin: 0px;
+  line-height: 16px;
+}
+
+desc {
+  display: flex;
+  margin-bottom: 10px;
+  font-size: 10px;
+  color: #666;
+}
+
+input[type=text], input[type=submit] {
+  padding: 3px;
+}
+
+main {
+  margin: 20px;
+}
+
+nav {
+  position: fixed;
+  width: 100vw;
+  top: 0;
+  left: 0;
+  padding: 5px 20px;
+  display: flex;
+  background: #e3e3e3;
+}
+
+nav > h1 {
+  padding: 0px;
+  margin: 0px;
+  font-size: 11px;
+}
+
+nav > div {
+  text-transform: uppercase;
+  font-weight: bold;
+}
+
+nav > div:not(:last-child) {
+  margin-right: 10px;
+}
+
+.table {
+  margin-top: 25px;
+  display: flex;
+  flex-direction: column;
+}
+
+.table-row {
+  display: flex;
+  padding-bottom: 15px;
+  /* width: 100%; */
+  /* border: 1px solid red; */
+}
+
+.table-key {
+  font-weight: 600;
+  width: 60px;
+  padding: 4px;
+
+  padding-top: 40px;
+  margin-top: -40px;
+}
+
+.table-val {
+  font-weight: 200;
+  color: #333;
+  padding: 4px;
+}
+
+.multiline {
+  margin-top: 15px;
+  flex-direction: column;
+}
+
+.multiline .table-key {
+  margin-bottom: 10px;
+  border-bottom: 1px dashed #dddddd;
+  /* padding: 4px; */
+  width: unset;
+}
+
+.index {
+  margin-top: 40px;
+}
+
+.index > section {
+  padding: 10px;
+  background-color: #e3e3e3;
+}
+
+.index > section:not(:last-child) {
+  margin-bottom: 10px;
+}
+
+
+.index > section > h2 {
+  margin-top: 0px;
+}
+
+.horizontal-list {
+  margin: 20px;
+  margin-top: 40px;
+}
+
+.horizontal-list ul {
+  display: flex;
+  margin: 0px;
+  padding: 0px;
+  flex-direction: column;
+  flex-wrap: wrap;
+  height: calc(100vh - 75px);
+  justify-content: flex-start;
+}
+
+.horizontal-list 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;
+}
+
+.horizontal-list li:hover {
+  background-color: #e9e9e9;
+}
+
+.horizontal-list li > a {
+  text-decoration: none;
+  color: inherit;
+}
+

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

@@ -1,19 +1,25 @@
 #!/usr/bin/env bash
 
-export PENPOT_FLAGS="enable-asserts enable-audit-log $PENPOT_FLAGS"
+# export PENPOT_DATABASE_URI="postgresql://172.17.0.1:5432/penpot"
+# export PENPOT_DATABASE_USERNAME="penpot"
+# export PENPOT_DATABASE_PASSWORD="penpot"
+# export PENPOT_DATABASE_READONLY=true
 
+# export PENPOT_DATABASE_URI="postgresql://172.17.0.1:5432/penpot_pre"
+# export PENPOT_DATABASE_USERNAME="penpot_pre"
+# export PENPOT_DATABASE_PASSWORD="penpot_pre"
+# export PENPOT_FLAGS="enable-asserts enable-audit-log $PENPOT_FLAGS"
 
 export OPTIONS="
-       -A:jmx-remote:dev \
+       -A:dev \
        -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
-       -J-Dclojure.tools.logging.factory=clojure.tools.logging.impl/log4j2-factory \
        -J-Dlog4j2.configurationFile=log4j2-devenv.xml \
-       -J-XX:+UseShenandoahGC \
+       -J-XX:+UseZGC \
        -J-XX:-OmitStackTraceInFastThrow \
-       -J-Xms50m -J-Xmx512m";
-
-# export OPTIONS="$OPTIONS -J-XX:+UnlockDiagnosticVMOptions";
-# export OPTIONS="$OPTIONS -J-XX:-TieredCompilation -J-XX:CompileThreshold=10000";
+       -J-Xms50m -J-Xmx1024m \
+       -J-Djdk.attach.allowAttachSelf \
+       -J-XX:+UnlockDiagnosticVMOptions \
+       -J-XX:+DebugNonSafepoints";
 
 export OPTIONS_EVAL="nil"
 # export OPTIONS_EVAL="(set! *warn-on-reflection* true)"

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/cli/manage.clj

@@ -140,7 +140,6 @@
   indicating the action the program should take and the options provided."
   [args]
   (let [{:keys [options arguments errors summary] :as opts} (parse-opts args cli-options)]
-    ;; (pp/pprint opts)
     (cond
       (:help options) ; help => exit OK with usage summary
       {:exit-message (usage summary) :ok? true}

backend/src/app/config.clj

@@ -42,6 +42,7 @@
 
 (def defaults
   {:http-server-port 6060
+   :http-server-host "0.0.0.0"
    :host "devenv"
    :tenant "dev"
    :database-uri "postgresql://postgres/penpot"
@@ -132,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)
@@ -221,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

@@ -50,16 +50,26 @@
 (declare instrument-jdbc!)
 (declare apply-migrations!)
 
-(s/def ::name keyword?)
-(s/def ::uri ::us/not-empty-string)
-(s/def ::min-pool-size ::us/integer)
+(s/def ::connection-timeout ::us/integer)
 (s/def ::max-pool-size ::us/integer)
 (s/def ::migrations map?)
+(s/def ::min-pool-size ::us/integer)
+(s/def ::name keyword?)
+(s/def ::password ::us/string)
 (s/def ::read-only ::us/boolean)
+(s/def ::uri ::us/not-empty-string)
+(s/def ::username ::us/string)
+(s/def ::validation-timeout ::us/integer)
 
 (defmethod ig/pre-init-spec ::pool [_]
-  (s/keys :req-un [::uri ::name ::min-pool-size ::max-pool-size]
-          :opt-un [::migrations ::mtx/metrics ::read-only]))
+  (s/keys :req-un [::uri ::name ::username ::password]
+          :opt-un [::min-pool-size
+                   ::max-pool-size
+                   ::connection-timeout
+                   ::validation-timeout
+                   ::migrations
+                   ::mtx/metrics
+                   ::read-only]))
 
 (defmethod ig/init-key ::pool
   [_ {:keys [migrations metrics name] :as cfg}]
@@ -96,8 +106,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}]
@@ -110,11 +120,11 @@
       (.setPoolName (d/name (:name cfg)))
       (.setAutoCommit true)
       (.setReadOnly read-only)
-      (.setConnectionTimeout 10000)  ;; 10seg
-      (.setValidationTimeout 10000)  ;; 10seg
+      (.setConnectionTimeout (:connection-timeout cfg 10000))  ;; 10seg
+      (.setValidationTimeout (:validation-timeout cfg 10000))  ;; 10seg
       (.setIdleTimeout 120000)       ;; 2min
       (.setMaxLifetime 1800000)      ;; 30min
-      (.setMinimumIdle (:min-pool-size cfg 0))
+      (.setMinimumIdle     (:min-pool-size cfg 0))
       (.setMaximumPoolSize (:max-pool-size cfg 50))
       (.setConnectionInitSql initsql)
       (.setInitializationFailTimeout -1))

backend/src/app/http.clj

@@ -12,91 +12,78 @@
    [app.common.spec :as us]
    [app.http.doc :as doc]
    [app.http.errors :as errors]
-   [app.http.debug :as debug]
    [app.http.middleware :as middleware]
    [app.metrics :as mtx]
    [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
-          (l/with-context (errors/get-error-context request e)
-            (l/error :hint (ex-message e) :cause e)
-            {:status 500 :body "internal server error"}))))))
+          (l/error :hint "unexpected error processing request"
+                   ::l/context (errors/get-error-context request e)
+                   :query-string (:query-string request)
+                   :cause e)
+          {:status 500 :body "internal server error"})))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Http Main Handler (Router)
+;; Http Router
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (s/def ::rpc map?)
@@ -105,16 +92,17 @@
 (s/def ::storage map?)
 (s/def ::assets map?)
 (s/def ::feedback 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
                    ::debug ::audit-http-handler]))
 
 (defmethod ig/init-key ::router
-  [_ {:keys [session rpc oauth metrics assets feedback debug] :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]
@@ -125,33 +113,45 @@
      ["/by-file-media-id/:id" {:get (:file-objects-handler assets)}]
      ["/by-file-media-id/:id/thumbnail" {:get (:file-thumbnails-handler assets)}]]
 
-    ["/dbg" {:middleware [[middleware/params]
+    ["/dbg" {:middleware [[middleware/multipart-params]
+                          [middleware/params]
                           [middleware/keyword-params]
                           [middleware/format-response-body]
                           [middleware/errors errors/handle]
                           [middleware/cookies]
                           [(:middleware session)]]}
+     ["" {:get (:index debug)}]
      ["/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)}]]
+     ["/file/data" {:get (:retrieve-file-data debug)
+                    :post (:upload-file-data debug)}]
+     ["/file/changes" {: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/etag]
                           [middleware/parse-request-body]
                           [middleware/errors errors/handle]
                           [middleware/cookies]]}
 
+     ["/health" {:get (:health-check debug)}]
      ["/_doc" {:get (doc/handler rpc)}]
-
      ["/feedback" {:middleware [(:middleware session)]
                    :post feedback}]
      ["/auth/oauth/:provider" {:post (:handler oauth)}]

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

@@ -9,26 +9,21 @@
    [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
-   [app.common.transit :as t]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
+   [app.rpc.mutations.files :as m.files]
    [app.rpc.queries.profile :as profile]
    [app.util.blob :as blob]
-   [app.util.json :as json]
    [app.util.template :as tmpl]
    [app.util.time :as dt]
    [clojure.java.io :as io]
-   [clojure.pprint :as ppr]
-   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
+   [datoteka.core :as fs]
+   [fipp.edn :as fpp]
    [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 = ?")
+;; (selmer.parser/cache-off!)
 
 (defn authorized?
   [pool {:keys [profile-id]}]
@@ -37,66 +32,104 @@
             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
+(defn index
   [{: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))
+  {:status 200
+   :headers {"content-type" "text/html"}
+   :body (-> (io/resource "templates/debug.tmpl")
+             (tmpl/render {}))})
 
-    (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))))))
+(def sql:retrieve-range-of-changes
+  "select revn, changes from file_change where file_id=? and revn >= ? and revn <= ? order by revn")
 
-(defn retrieve-file-changes
-  [{:keys [pool]} {:keys [params path-params profile-id] :as request}]
+(def sql:retrieve-single-change
+  "select revn, changes, data from file_change where file_id=? and revn = ?")
+
+(defn prepare-response
+  [{:keys [params] :as request} body]
+  (when-not body
+    (ex/raise :type :not-found
+              :code :enpty-data
+              :hint "empty response"))
+
+  (cond-> {:status 200
+           :headers {"content-type" "application/transit+json"}
+           :body body}
+    (contains? params :download)
+    (update :headers assoc "content-disposition" "attachment")))
+
+(defn retrieve-file-data
+  [{:keys [pool]} {:keys [params] :as 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")]
+  (let [file-id (some-> (get-in request [:params :file-id]) uuid/uuid)
+        revn    (some-> (get-in request [:params :revn]) d/parse-integer)]
+    (when-not file-id
+      (ex/raise :type :validation
+                :code :missing-arguments))
 
-    (when (or (not id) (not revn))
+    (let [data (if (integer? revn)
+                 (some-> (db/exec-one! pool [sql:retrieve-single-change file-id revn]) :data)
+                 (some-> (db/get-by-id pool :file file-id) :data))]
+      (if (contains? params :download)
+        (-> (prepare-response request data)
+            (update :headers assoc "content-type" "application/octet-stream"))
+        (prepare-response request (some-> data blob/decode))))))
+
+(defn upload-file-data
+  [{:keys [pool]} {:keys [profile-id params] :as request}]
+  (let [project-id (some-> (profile/retrieve-additional-data pool profile-id) :default-project-id)
+        data       (some-> params :file :tempfile fs/slurp-bytes blob/decode)]
+
+    (if (and data project-id)
+      (let [fname (str "imported-file-" (dt/now))]
+        (m.files/create-file pool {:id (uuid/next)
+                                   :name fname
+                                   :project-id project-id
+                                   :profile-id profile-id
+                                   :data data})
+        {:status 200
+         :body "OK"})
+      {:status 500
+       :body "error"})))
+
+(defn retrieve-file-changes
+  [{:keys [pool]} request]
+  (when-not (authorized? pool request)
+    (ex/raise :type :authentication
+              :code :only-admins-allowed))
+
+  (let [file-id (some-> (get-in request [:params :id]) uuid/uuid)
+        revn    (or (get-in request [:params :revn]) "latest")]
+
+    (when (or (not file-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)))
+      (let [item (db/exec-one! pool [sql:retrieve-single-change file-id (d/parse-integer revn)])]
+        (prepare-response request (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))))
-
+            items       (db/exec! pool [sql:retrieve-range-of-changes file-id start end])]
+        (prepare-response request
+                          (some->> items
+                                   (map :changes)
+                                   (map blob/decode)
+                                   (mapcat identity)
+                                   (vec))))
       :else
       (ex/raise :type :validation :code :invalid-arguments))))
 
@@ -114,16 +147,20 @@
              (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)))))
+            (let [context (dissoc report
+                                  :trace :cause :params :data :spec-problems
+                                  :spec-explain :spec-value :error :explain :hint)
+                  params  {:context (with-out-str (fpp/pprint context {:width 300}))
+                           :hint    (:hint report)
+                           :spec-explain  (:spec-explain report)
+                           :spec-problems (:spec-problems report)
+                           :spec-value    (:spec-value report)
+                           :data          (:data report)
+                           :trace         (or (:trace report)
+                                              (some-> report :error :trace))
+                           :params        (:params report)}]
+              (-> (io/resource "templates/error-report.tmpl")
+                  (tmpl/render params))))
           ]
 
     (when-not (authorized? pool request)
@@ -154,12 +191,22 @@
     {:status 200
      :headers {"content-type" "text/html; charset=utf-8"
                "x-robots-tag" "noindex"}
-     :body (-> (io/resource "error-list.tmpl")
+     :body (-> (io/resource "templates/error-list.tmpl")
                (tmpl/render {:items items}))}))
 
+(defn health-check
+  "Mainly a task that performs a health check."
+  [{:keys [pool]} _]
+  (db/with-atomic [conn pool]
+    (db/exec-one! conn ["select count(*) as count from server_prop;"])
+    {:status 200 :body "Ok"}))
+
 (defmethod ig/init-key ::handlers
-  [_ {:keys [pool] :as cfg}]
-  {:retrieve-file-data (partial retrieve-file-data cfg)
+  [_ cfg]
+  {:index (partial index cfg)
+   :health-check (partial health-check 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)})
+   :retrieve-error-list (partial retrieve-error-list cfg)
+   :upload-file-data (partial upload-file-data cfg)})

backend/src/app/http/errors.clj

@@ -9,8 +9,7 @@
   (:require
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
-   [app.common.uuid :as uuid]
-   [clojure.pprint]
+   [app.common.spec :as us]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]))
 
@@ -24,19 +23,23 @@
   [request error]
   (let [data (ex-data error)]
     (merge
-     {:id            (uuid/next)
-      :path          (:uri request)
+     {: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))
+      :hint          (ex-message error)
+      :params        (:params request)
+
+      :spec-problems (some->> data ::s/problems (take 10) seq vec)
+      :spec-value    (some->> data ::s/value)
+      :data          (some-> data (dissoc ::s/problems ::s/value ::s/spec))
       :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")}))))
+        :frontend-version (get headers "x-frontend-version" "unknown")})
+
+     (when (and data (::s/problems data))
+       {:spec-explain (us/pretty-explain data)}))))
 
 (defmulti handle-exception
   (fn [err & _rest]
@@ -54,18 +57,25 @@
 
 (defmethod handle-exception :validation
   [err _]
-  (let [edata (ex-data err)]
-    {:status 400 :body (dissoc edata ::s/problems)}))
+  (let [data    (ex-data err)
+        explain (us/pretty-explain data)]
+    {:status 400
+     :body (-> data
+               (dissoc ::s/problems)
+               (dissoc ::s/value)
+               (cond-> explain (assoc :explain explain)))}))
 
 (defmethod handle-exception :assertion
   [error request]
   (let [edata (ex-data error)]
-    (l/with-context (get-error-context request error)
-      (l/error :hint (ex-message error) :cause error))
+    (l/error ::l/raw (ex-message error)
+             ::l/context (get-error-context request error)
+             :cause error)
+
     {:status 500
      :body {:type :server-error
             :code :assertion
-            :data (dissoc edata ::s/problems)}}))
+            :data (dissoc edata ::s/problems ::s/value ::s/spec)}}))
 
 (defmethod handle-exception :not-found
   [err _]
@@ -83,9 +93,9 @@
              (ex/exception? (:handling edata)))
       (handle-exception (:handling edata) request)
       (do
-        (l/with-context (get-error-context request error)
-          (l/error :hint (ex-message error) :cause error))
-
+        (l/error ::l/raw (ex-message error)
+                 ::l/context (get-error-context request error)
+                 :cause error)
         {:status 500
          :body {:type :server-error
                 :code :unexpected
@@ -95,13 +105,9 @@
 (defmethod handle-exception org.postgresql.util.PSQLException
   [error request]
   (let [state (.getSQLState ^java.sql.SQLException error)]
-
-    (l/with-context (get-error-context request error)
-      (l/error :hint "psql exception"
-               :error-message (ex-message error)
-               :state state
-               :cause error))
-
+    (l/error ::l/raw (ex-message error)
+             ::l/context (get-error-context request error)
+             :cause error)
     (cond
       (= state "57014")
       {:status 504

backend/src/app/http/middleware.clj

@@ -9,14 +9,15 @@
    [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]
+   [ring.core.protocols :as rp]
    [ring.middleware.cookies :refer [wrap-cookies]]
    [ring.middleware.keyword-params :refer [wrap-keyword-params]]
    [ring.middleware.multipart-params :refer [wrap-multipart-params]]
-   [ring.middleware.params :refer [wrap-params]]))
+   [ring.middleware.params :refer [wrap-params]]
+   [yetti.adapter :as yt]))
 
 (defn wrap-server-timing
   [handler]
@@ -35,52 +36,80 @@
               (t/read! reader)))
 
           (parse-json [body]
-            (json/read body))
-
-          (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 buffered-output-stream
+  "Returns a buffered output stream that ignores flush calls. This is
+  needed because transit-java calls flush very aggresivelly on each
+  object write."
+  [^java.io.OutputStream os ^long chunk-size]
+  (proxy [java.io.BufferedOutputStream] [os (int chunk-size)]
+    ;; Explicitly do not forward flush
+    (flush [])
+    (close []
+      (proxy-super flush)
+      (proxy-super close))))
+
+(def ^:const buffer-size (:http/output-buffer-size yt/base-defaults))
+
+(defn- transit-streamable-body
+  [data opts]
+  (reify rp/StreamableResponseBody
+    (write-body-to-stream [_ _ output-stream]
+      ;; Use the same buffer as jetty output buffer size
+      (try
+        (with-open [bos (buffered-output-stream output-stream buffer-size)]
+          (let [tw (t/writer bos opts)]
+            (t/write! tw data)))
+        (catch org.eclipse.jetty.io.EofException _cause
+          ;; Do nothing, EOF means client closes connection abruptly
+          nil)
+        (catch Throwable cause
+          (l/warn :hint "unexpected error on encoding response"
+                  :cause cause))))))
+
 (defn- impl-format-response-body
-  [response _request]
-  (let [body (:body response)
-        opts {:type :json}]
+  [response {:keys [query-params] :as request}]
+  (let [body   (:body response)
+        opts   {:type (if (contains? query-params "transit_verbose") :json-verbose :json)}]
+
     (cond
+      (:ws response)
+      response
+
       (coll? body)
       (-> response
           (update :headers assoc "content-type" "application/transit+json")
-          (assoc :body (t/encode body opts)))
+          (assoc :body (transit-streamable-body body opts)))
 
       (nil? body)
       (assoc response :status 204 :body "")
@@ -111,11 +140,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)})
@@ -138,24 +162,18 @@
 
 (defn wrap-etag
   [handler]
-  (letfn [(generate-etag [{:keys [body] :as response}]
-            (str "W/\"" (-> body bh/blake2b-128 bc/bytes->hex) "\""))
-          (get-match [{:keys [headers] :as request}]
-            (get headers "if-none-match"))]
-    (fn [request]
-      (let [response (handler request)]
-        (if (= :get (:request-method request))
-          (let [etag     (generate-etag response)
-                match    (get-match request)
-                response (update response :headers #(assoc % "ETag" etag))]
-            (cond-> response
-              (and (string? match)
-                   (= :get (:request-method request))
-                   (= etag match))
-              (-> response
-                  (assoc :body "")
-                  (assoc :status 304))))
-          response)))))
+  (letfn [(encode [data]
+            (when (string? data)
+              (str "W/\"" (-> data bh/blake2b-128 bc/bytes->hex) "\"")))]
+    (fn [{method :request-method headers :headers :as request}]
+      (cond-> (handler request)
+        (= :get method)
+        (as-> $ (if-let [etag (-> $ :body meta :etag encode)]
+                  (cond-> (update $ :headers assoc "etag" etag)
+                    (= etag (get headers "if-none-match"))
+                    (-> (assoc :body "")
+                        (assoc :status 304)))
+                  $))))))
 
 (def etag
   {:name ::etag

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

@@ -30,8 +30,11 @@
   (let [token  (tokens :generate {:iss "authentication"
                                   :iat (dt/now)
                                   :uid profile-id})
+        now    (dt/now)
         params {:user-agent (get headers "user-agent")
                 :profile-id profile-id
+                :created-at now
+                :updated-at now
                 :id token}]
     (db/insert! conn :http-session params)))
 
@@ -58,9 +61,7 @@
     (assoc response :cookies {cookie-name {:path "/"
                                            :http-only true
                                            :value id
-                                           :same-site (cond (not secure?) :lax
-                                                            cors?         :none
-                                                            :else         :strict)
+                                           :same-site (if cors? :none :lax)
                                            :secure secure?}})))
 
 (defn- clear-cookies
@@ -74,7 +75,7 @@
       (do
         (a/>!! (::events-ch cfg) id)
         (l/set-context! {:profile-id profile-id})
-        (handler (assoc request :profile-id profile-id)))
+        (handler (assoc request :profile-id profile-id :session-id id)))
       (handler request))))
 
 ;; --- STATE INIT: SESSION
@@ -84,8 +85,7 @@
 
 (defmethod ig/prep-key ::session
   [_ cfg]
-  (d/merge {:buffer-size 64}
-           (d/without-nils cfg)))
+  (d/merge {:buffer-size 128} (d/without-nils cfg)))
 
 (defmethod ig/init-key ::session
   [_ {:keys [pool] :as cfg}]
@@ -156,7 +156,7 @@
 
             (= :size reason)
             (l/debug :task "updater"
-                     :action "update sessions"
+                     :hint "update sessions"
                      :reason (name reason)
                      :count result))
           (recur))))))
@@ -185,17 +185,20 @@
 
 (defmethod ig/init-key ::gc-task
   [_ {:keys [pool max-age] :as cfg}]
+  (l/debug :hint "initializing session gc task" :max-age max-age)
   (fn [_]
     (db/with-atomic [conn pool]
       (let [interval (db/interval max-age)
-            result   (db/exec-one! conn [sql:delete-expired interval])
+            result   (db/exec-one! conn [sql:delete-expired interval interval])
             result   (:next.jdbc/update-count result)]
         (l/debug :task "gc"
-                 :action "clean http sessions"
-                 :count result)
+                 :hint "clean http sessions"
+                 :deleted result)
         result))))
 
 (def ^:private
   sql:delete-expired
   "delete from http_session
-    where updated_at < now() - ?::interval")
+    where updated_at < now() - ?::interval
+       or (updated_at is null and
+           created_at < now() - ?::interval)")

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)))
 
@@ -176,26 +176,27 @@
 (defn- persist-events
   [{:keys [pool executor] :as cfg} events]
   (letfn [(event->row [event]
-            [(uuid/next)
-             (:name event)
-             (:type event)
-             (:profile-id event)
-             (:tracked-at event)
-             (some-> (:ip-addr event) db/inet)
-             (db/tjson (:props event))
-             "backend"])]
+            (when (:profile-id event)
+              [(uuid/next)
+               (:name event)
+               (:type event)
+               (:profile-id event)
+               (:tracked-at event)
+               (some-> (:ip-addr event) db/inet)
+               (db/tjson (:props event))
+               "backend"]))]
     (aa/with-thread executor
       (when (seq events)
         (db/with-atomic [conn pool]
           (db/insert-multi! conn :audit-log
                             [:id :name :type :profile-id :tracked-at :ip-addr :props :source]
-                            (sequence (map event->row) events)))))))
+                            (sequence (keep event->row) events)))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; 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,9 +7,7 @@
 (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]
@@ -29,10 +27,8 @@
 (defonce enabled (atom true))
 
 (defn- persist-on-database!
-  [{:keys [pool] :as cfg} {:keys [id] :as event}]
-  (db/with-atomic [conn pool]
-    (db/insert! conn :server-error-report
-                {:id id :content (db/tjson event)})))
+  [{:keys [pool]} {:keys [id] :as event}]
+  (db/insert! pool :server-error-report {:id id :content (db/tjson event)}))
 
 (defn- parse-event-data
   [event]
@@ -52,7 +48,8 @@
       (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 #(or % (uuid/next)))))
 
 (defn handle-event
   [{:keys [executor] :as cfg} event]
@@ -60,22 +57,25 @@
     (try
       (let [event (parse-event event)
             uri   (cf/get :public-uri)]
+
         (l/debug :hint "registering error on database" :id (:id event)
                  :uri (str uri "/dbg/error/" (:id event)))
+
         (persist-on-database! cfg event))
-      (catch Exception e
-        (l/warn :hint "unexpected exception on database error logger"
-                :cause e)))))
+      (catch Exception cause
+        (l/warn :hint "unexpected exception on database error logger" :cause cause)))))
 
 (defmethod ig/pre-init-spec ::reporter [_]
   (s/keys :req-un [::wrk/executor ::db/pool ::receiver]))
 
+(defn error-event?
+  [event]
+  (= "error" (:logger/level event)))
+
 (defmethod ig/init-key ::reporter
   [_ {:keys [receiver] :as cfg}]
   (l/info :msg "initializing database error persistence")
-  (let [output (a/chan (a/sliding-buffer 128)
-                       (filter (fn [event]
-                                 (= (:logger/level event) "error"))))]
+  (let [output (a/chan (a/sliding-buffer 5) (filter error-event?))]
     (receiver :sub output)
     (a/go-loop []
       (let [msg (a/<! output)]

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 []

backend/src/app/loggers/sentry.clj

@@ -120,8 +120,6 @@
               (.captureMessage ^IHub shub msg)
               ))
           ]
-    ;; (clojure.pprint/pprint event)
-
     (when @enabled
       (.withScope ^IHub shub (reify ScopeCallback
                                (run [_ scope]

backend/src/app/loggers/zmq.clj

@@ -31,7 +31,7 @@
 
 (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?)
                                (keep prepare)))

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
@@ -20,35 +21,17 @@
     :migrations (ig/ref :app.migrations/all)
     :name :main
     :min-pool-size 0
-    :max-pool-size 30}
+    :max-pool-size 60}
+
+   :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,27 +74,34 @@
 
    :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)
-    :audit-http-handler   (ig/ref :app.loggers.audit/http-handler)}
+    :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)
+    :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)
     :assets-path       (cf/get :assets-path)
@@ -123,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)
@@ -140,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
@@ -193,7 +176,7 @@
         :task :file-offload})
 
      (when (contains? cf/flags :audit-log-archive)
-       {:cron #app/cron "0 */3 * * * ?" ;; every 3m
+       {:cron #app/cron "0 */5 * * * ?" ;; every 5m
         :task :audit-log-archive})
 
      (when (contains? cf/flags :audit-log-gc)
@@ -202,7 +185,7 @@
 
      (when (or (contains? cf/flags :telemetry)
                (cf/get :telemetry-enabled))
-       {:cron #app/cron "0 0 */6 * * ?" ;; every 6h
+       {:cron #app/cron "0 30 */3,23 * * ?"
         :task :telemetry})]}
 
    :app.worker/registry

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

@@ -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/files.clj

@@ -182,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)
 
@@ -414,8 +414,9 @@
   [conn project-id]
   (:team-id (db/get-by-id conn :project project-id {:columns [:team-id]})))
 
-
-;; TEMPORARY FILE CREATION
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; TEMPORARY FILES (behaves differently)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (s/def ::create-temp-file ::create-file)
 
@@ -425,6 +426,23 @@
     (proj/check-edition-permissions! conn profile-id project-id)
     (create-file conn (assoc params :deleted-at (dt/in-future {:days 1})))))
 
+(s/def ::update-temp-file
+  (s/keys :req-un [::changes ::revn ::session-id ::id]))
+
+(sv/defmethod ::update-temp-file
+  [{:keys [pool] :as cfg} {:keys [profile-id session-id id revn changes] :as params}]
+  (db/with-atomic [conn pool]
+    (db/insert! conn :file-change
+                {:id (uuid/next)
+                 :session-id session-id
+                 :profile-id profile-id
+                 :created-at (dt/now)
+                 :file-id id
+                 :revn revn
+                 :data nil
+                 :changes (blob/encode changes)})
+    nil))
+
 (s/def ::persist-temp-file
   (s/keys :req-un [::id ::profile-id]))
 
@@ -432,6 +450,25 @@
   [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
   (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id id)
-    (db/update! conn :file
-                {:deleted-at nil}
-                {:id id})))
+    (let [file (db/get-by-id conn :file id)
+          revs (db/query conn :file-change
+                         {:file-id id}
+                         {:order-by [[:revn :asc]]})
+          revn (count revs)]
+
+      (when (nil? (:deleted-at file))
+        (ex/raise :type :validation
+                  :code :cant-persist-already-persisted-file))
+
+      (loop [revs (seq revs)
+             data (blob/decode (:data file))]
+        (if-let [rev (first revs)]
+          (recur (rest revs)
+                 (->> rev :changes blob/decode (cp/process-changes data)))
+          (db/update! conn :file
+                      {:deleted-at nil
+                       :revn revn
+                       :data (blob/encode data)}
+                      {:id id})))
+
+      nil)))

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)
@@ -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,10 +379,18 @@
   {::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- 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]))))
+
 (defn- validate-password!
   [conn {:keys [profile-id old-password] :as params}]
   (let [profile (db/get-by-id conn :profile profile-id)]
@@ -396,7 +405,6 @@
               {:password (derive-password password)}
               {:id id}))
 
-
 ;; --- MUTATION: Update Photo
 
 (declare update-profile-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

@@ -164,7 +164,7 @@
   (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
@@ -201,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

@@ -6,6 +6,8 @@
 
 (ns app.rpc.queries.files
   (:require
+   [app.common.data :as d]
+   [app.common.pages :as cp]
    [app.common.pages.migrations :as pmg]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
@@ -84,8 +86,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
@@ -165,6 +167,7 @@
           f.created_at,
           f.modified_at,
           f.name,
+          f.revn,
           f.is_shared
      from file as f
     where f.project_id = ?
@@ -214,11 +217,66 @@
       (some-> (retrieve-file cfg id)
               (assoc :permissions perms)))))
 
-(s/def ::page
-  (s/keys :req-un [::profile-id ::file-id]))
+(declare trim-file-data)
 
-(defn remove-thumbnails-frames
-  "Removes from data the children for frames that have a thumbnail set up"
+(s/def ::page-id ::us/uuid)
+(s/def ::object-id ::us/uuid)
+
+(s/def ::trimmed-file
+  (s/keys :req-un [::profile-id ::id ::object-id ::page-id]))
+
+(sv/defmethod ::trimmed-file
+  "Retrieve a file by its ID and trims all unnecesary content from
+  it. It is mainly used for rendering a concrete object, so we don't
+  need force download all shapes when only a small subset is
+  necesseary."
+  [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
+  (db/with-atomic [conn pool]
+    (let [cfg   (assoc cfg :conn conn)
+          perms (get-permissions conn profile-id id)]
+      (check-read-permissions! perms)
+      (some-> (retrieve-file cfg id)
+              (trim-file-data params)
+              (assoc :permissions perms)))))
+
+(defn- trim-file-data
+  [file {:keys [page-id object-id]}]
+  (let [page    (get-in file [:data :pages-index page-id])
+        objects (->> (:objects page)
+                     (cp/get-object-with-children object-id)
+                     (map #(dissoc % :thumbnail)))
+
+        objects (d/index-by :id objects)
+        page    (assoc page :objects objects)]
+
+    (-> file
+        (update :data assoc :pages-index {page-id page})
+        (update :data assoc :pages [page-id]))))
+
+(declare strip-frames-with-thumbnails)
+
+(s/def ::strip-frames-with-thumbnails ::us/boolean)
+
+(s/def ::page
+  (s/keys :req-un [::profile-id ::file-id]
+          :opt-un [::strip-frames-with-thumbnails]))
+
+(sv/defmethod ::page
+  "Retrieves the first page of the file. Used mainly for render
+  thumbnails on dashboard."
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as props}]
+  (db/with-atomic [conn pool]
+    (check-read-permissions! conn profile-id file-id)
+
+    (let [cfg     (assoc cfg :conn conn)
+          file    (retrieve-file cfg file-id)
+          page-id (get-in file [:data :pages 0])]
+      (cond-> (get-in file [:data :pages-index page-id])
+        (true? (:strip-frames-with-thumbnails props))
+        (strip-frames-with-thumbnails)))))
+
+(defn strip-frames-with-thumbnails
+  "Remove unnecesary shapes from frames that have thumbnail."
   [data]
   (let [filter-shape?
         (fn [objects [id shape]]
@@ -227,7 +285,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]]
@@ -244,22 +302,12 @@
 
     (update data :objects update-objects)))
 
-(sv/defmethod ::page
-  [{:keys [pool] :as cfg} {:keys [profile-id file-id strip-thumbnails]}]
-  (db/with-atomic [conn pool]
-    (check-read-permissions! conn profile-id file-id)
-
-    (let [cfg     (assoc cfg :conn conn)
-          file    (retrieve-file cfg file-id)
-          page-id (get-in file [:data :pages 0])]
-      (cond-> (get-in file [:data :pages-index page-id])
-        strip-thumbnails
-        (remove-thumbnails-frames)))))
 
 ;; --- Query: Shared Library Files
 
 (def ^:private sql:team-shared-files
   "select f.id,
+          f.revn,
           f.project_id,
           f.created_at,
           f.modified_at,
@@ -330,6 +378,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,7 +37,6 @@
 
 (sv/defmethod ::profile {:auth false}
   [{:keys [pool] :as cfg} {:keys [profile-id] :as params}]
-
   ;; 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.
@@ -111,6 +110,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/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

@@ -2,9 +2,13 @@
   "A  main namespace for server repl."
   #_:clj-kondo/ignore
   (:require
+   [app.common.data :as d]
+   [app.common.exceptions :as ex]
+   [app.common.logging :as l]
    [app.common.pages :as cp]
-   [app.common.uuid :as uuid]
    [app.common.pages.migrations :as pmg]
+   [app.common.pages.spec :as spec]
+   [app.common.uuid :as uuid]
    [app.config :as cfg]
    [app.db :as db]
    [app.db.sql :as sql]
@@ -12,12 +16,15 @@
    [app.rpc.queries.profile :as prof]
    [app.srepl.dev :as dev]
    [app.util.blob :as blob]
+   [app.util.time :as dt]
+   [fipp.edn :refer [pprint]]
+   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
-   [clojure.pprint :refer [pprint]]))
+   [expound.alpha :as expound]))
 
 (defn update-file
-  ([id f] (update-file id f false))
-  ([id f save?]
+  ([system id f] (update-file system id f false))
+  ([system id f save?]
    (db/with-atomic [conn (:app.db/pool system)]
      (let [file (db/get-by-id conn :file id {:for-update true})
            file (-> file
@@ -32,8 +39,8 @@
                      {:id (:id file)}))
        (update file :data blob/decode)))))
 
-(defn update-file-raw
-  [id data]
+(defn reset-file-data
+  [system id data]
   (db/with-atomic [conn (:app.db/pool system)]
     (db/update! conn :file
                 {:data data}
@@ -41,36 +48,13 @@
 
 (defn get-file
   [system id]
-  (with-open [conn (db/open (:app.db/pool system))]
-    (let [file (db/get-by-id conn :file id)]
-      (-> file
-          (update :data app.util.blob/decode)
-          (update :data pmg/migrate-data)))))
-
-
-;; Examples:
-;; (def backup (update-file  #uuid "1586e1f0-3e02-11eb-b1d2-556a2f641513" identity))
-;; (def x (update-file
-;;         #uuid "1586e1f0-3e02-11eb-b1d2-556a2f641513"
-;;         (fn [{:keys [data] :as file}]
-;;           (update-in data [:pages-index #uuid "878278c0-3ef0-11eb-9d67-8551e7624f43" :objects] dissoc nil))))
-
-;; Migrate
-
-(defn update-file-data-blob-format
-  [system]
-  (db/with-atomic [conn (:app.db/pool system)]
-    (doseq [id (->> (db/exec! conn ["select id from file;"]) (map :id))]
-      (let [{:keys [data]} (db/get-by-id conn :file id {:columns [:id :data]})]
-        (prn "Updating file:" id)
-        (db/update! conn :file
-                    {:data (-> (blob/decode data)
-                               (blob/encode {:version 2}))}
-                    {:id id})))))
-
+  (-> (:app.db/pool system)
+      (db/get-by-id :file id)
+      (update :data app.util.blob/decode)
+      (update :data pmg/migrate-data)))
 
 (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))
@@ -81,3 +65,87 @@
                             :project-id (:default-project-id profile))]
           (db/insert! conn :file params)
           (:id file))))))
+
+(defn verify-files
+  [system {:keys [age sleep chunk-size max-chunks stop-on-error? verbose?]
+           :or {sleep 1000
+                age "72h"
+                chunk-size 10
+                verbose? false
+                stop-on-error? true
+                max-chunks ##Inf}}]
+
+  (letfn [(retrieve-chunk [conn cursor]
+            (let [sql (str "select id, name, modified_at, data from file "
+                           " where modified_at > ? and deleted_at is null "
+                           " order by modified_at asc limit ?")
+                  age (if cursor
+                        cursor
+                        (-> (dt/now) (dt/minus age)))]
+              (seq (db/exec! conn [sql age chunk-size]))))
+
+          (validate-item [{:keys [id data modified-at] :as file}]
+            (let [data   (blob/decode data)
+                  valid? (s/valid? ::spec/data data)]
+
+              (l/debug :hint "validated file"
+                       :file-id id
+                       :age (-> (dt/diff modified-at (dt/now))
+                                (dt/truncate :minutes)
+                                (str)
+                                (subs 2)
+                                (str/lower))
+                       :valid valid?)
+
+              (when (and (not valid?) verbose?)
+                (let [edata (-> (s/explain-data ::spec/data data)
+                                (update ::s/problems #(take 5 %)))]
+                  (binding [s/*explain-out* expound/printer]
+                    (l/warn ::l/raw (with-out-str (s/explain-out edata))))))
+
+              (when (and (not valid?) stop-on-error?)
+                (throw (ex-info "penpot/abort" {})))
+
+              valid?))
+
+          (validate-chunk [chunk]
+            (loop [items   chunk
+                   success 0
+                   errored 0]
+
+              (if-let [item (first items)]
+                (if (validate-item item)
+                  (recur (rest items) (inc success) errored)
+                  (recur (rest items) success (inc errored)))
+                [(:modified-at (last chunk))
+                 success
+                 errored])))
+
+          (fmt-result [ns ne]
+            {:total (+ ns ne)
+             :errors ne
+             :success ns})
+
+          ]
+
+    (try
+      (db/with-atomic [conn (:app.db/pool system)]
+        (loop [cursor  nil
+               chunks  0
+               success 0
+               errors 0]
+          (if (< chunks max-chunks)
+            (if-let [chunk (retrieve-chunk conn cursor)]
+              (let [[cursor success' errors'] (validate-chunk chunk)]
+                (Thread/sleep (inst-ms (dt/duration sleep)))
+                (recur cursor
+                       (inc chunks)
+                       (+ success success')
+                       (+ errors errors')))
+              (fmt-result success errors))
+            (fmt-result success errors))))
+      (catch Throwable cause
+        (when (not= "penpot/abort" (ex-message cause))
+          (throw cause))
+        :error))))
+

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)
@@ -305,7 +305,7 @@
               (recur (+ n ^long total)))
             (do
               (l/info :task "gc-deleted"
-                      :action "permanently delete items"
+                      :hint "permanently delete items"
                       :count n)
               {:deleted n})))))))
 
@@ -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).
@@ -379,10 +379,10 @@
                      (+ cntd (count to-delete))))
             (do
               (l/info :task "gc-touched"
-                      :action "mark freeze"
+                      :hint "mark freeze"
                       :count cntf)
               (l/info :task "gc-touched"
-                      :action "mark for deletion"
+                      :hint "mark for deletion"
                       :count cntd)
               {:freeze cntf :delete cntd})))))))
 
@@ -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}))
@@ -461,9 +461,9 @@
                      (+ d (count to-delete))))
             (do
               (l/info :task "recheck"
-                      :action "recheck items"
+                      :hint "recheck items"
                       :processed n
-                      :deleted n)
+                      :deleted d)
               {:processed n :deleted d})))))))
 
 (def sql:retrieve-pending-to-recheck

backend/src/app/storage/s3.clj

@@ -33,6 +33,7 @@
    software.amazon.awssdk.services.s3.model.GetObjectRequest
    software.amazon.awssdk.services.s3.model.ObjectIdentifier
    software.amazon.awssdk.services.s3.model.PutObjectRequest
+   software.amazon.awssdk.services.s3.model.S3Error
    ;; software.amazon.awssdk.services.s3.model.GetObjectResponse
    software.amazon.awssdk.services.s3.presigner.S3Presigner
    software.amazon.awssdk.services.s3.presigner.model.GetObjectPresignRequest
@@ -231,6 +232,9 @@
                              ^DeleteObjectsRequest dor)]
     (when (.hasErrors ^DeleteObjectsResponse dres)
       (let [errors (seq (.errors ^DeleteObjectsResponse dres))]
-        (ex/raise :type :s3-error
-                  :code :error-on-bulk-delete
-                  :context errors)))))
+        (ex/raise :type :internal
+                  :code :error-on-s3-bulk-delete
+                  :s3-errors (mapv (fn [^S3Error error]
+                                     {:key (.key error)
+                                      :msg (.message error)})
+                                   errors))))))

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]
@@ -90,7 +90,7 @@
         unused (->> (db/query conn :file-media-object {:file-id id})
                     (remove #(contains? used (:id %))))]
 
-    (l/debug :action "processing file"
+    (l/debug :hint "processing file"
              :id id
              :age age
              :to-delete (count unused))
@@ -101,13 +101,13 @@
                 {:id id})
 
     (doseq [mobj unused]
-      (l/debug :action "deleting media object"
+      (l/debug :hint "deleting media object"
                :id (:id mobj)
                :media-id (:media-id mobj)
                :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/file_offload.clj

@@ -29,7 +29,7 @@
 
 (defn- offload-candidate
   [{:keys [storage conn backend] :as cfg} {:keys [id data] :as file}]
-  (l/debug :action "offload file data" :id id)
+  (l/debug :hint "offload file data" :id id)
   (let [backend (simpl/resolve-backend storage backend)]
     (->> (simpl/content data)
          (simpl/put-object backend file))

backend/src/app/tasks/file_xlog_gc.clj

@@ -28,7 +28,8 @@
       (let [interval (db/interval max-age)
             result   (db/exec-one! conn [sql:delete-files-xlog interval])
             result   (:next.jdbc/update-count result)]
-        (l/debug :removed result :hint "remove old file changes")
+        (l/info :hint "remove old file changes"
+                :removed result)
         result))))
 
 (def ^:private

backend/src/app/tasks/objects_gc.clj

@@ -48,7 +48,7 @@
         result  (db/exec! conn [sql max-age])]
 
     (doseq [{:keys [id] :as item} result]
-      (l/trace :action "delete object" :table table :id id))
+      (l/trace :hint "delete object" :table table :id id))
 
     (count result)))
 
@@ -63,7 +63,7 @@
         backend (simpl/resolve-backend storage (cf/get :fdata-storage-backend))]
 
     (doseq [{:keys [id] :as item} result]
-      (l/trace :action "delete object" :table table :id id)
+      (l/trace :hint "delete object" :table table :id id)
       (when backend
         (simpl/del-object backend item)))
 
@@ -78,7 +78,7 @@
         fonts   (db/exec! conn [sql max-age])
         storage (assoc storage :conn conn)]
     (doseq [{:keys [id] :as font} fonts]
-      (l/trace :action "delete object" :table table :id id)
+      (l/trace :hint "delete object" :table table :id id)
       (some->> (:woff1-file-id font) (sto/del-object storage))
       (some->> (:woff2-file-id font) (sto/del-object storage))
       (some->> (:otf-file-id font)   (sto/del-object storage))
@@ -95,7 +95,7 @@
         storage (assoc storage :conn conn)]
 
     (doseq [{:keys [id] :as team} teams]
-      (l/trace :action "delete object" :table table :id id)
+      (l/trace :hint "delete object" :table table :id id)
       (some->> (:photo-id team) (sto/del-object storage)))
 
     (count teams)))
@@ -127,9 +127,9 @@
         storage  (assoc storage :conn conn)]
 
     (doseq [{:keys [id] :as profile} profiles]
-      (l/trace :action "delete object" :table table :id id)
+      (l/trace :hint "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/tasks_gc.clj

@@ -28,7 +28,7 @@
       (let [interval (db/interval max-age)
             result   (db/exec-one! conn [sql:delete-completed-tasks interval])
             result   (:next.jdbc/update-count result)]
-        (l/debug :action "trim completed tasks table" :removed result)
+        (l/debug :hint "trim completed tasks table" :removed result)
         result))))
 
 (def ^:private

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
@@ -14,15 +14,18 @@
    [app.common.spec :as us]
    [app.config :as cfg]
    [app.db :as db]
+   [app.util.async :refer [thread-sleep]]
    [app.util.http :as http]
    [app.util.json :as json]
    [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
-(declare handler)
-(declare acquire-lock)
-(declare release-all-locks)
-(declare retrieve-stats)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; TASK ENTRY POINT
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare get-stats)
+(declare send!)
 
 (s/def ::version ::us/string)
 (s/def ::uri ::us/string)
@@ -34,49 +37,69 @@
   (s/keys :req-un [::db/pool ::version ::uri ::sprops]))
 
 (defmethod ig/init-key ::handler
-  [_ {:keys [pool] :as cfg}]
+  [_ {:keys [pool sprops version] :as cfg}]
   (fn [_]
-    (db/with-atomic [conn pool]
-      (try
-        (acquire-lock conn)
-        (handler (assoc cfg :conn conn))
-        (finally
-          (release-all-locks conn))))))
+    ;; Sleep randomly between 0 to 10s
+    (thread-sleep (rand-int 10000))
 
-(defn- acquire-lock
-  [conn]
-  (db/exec-one! conn ["select pg_advisory_lock(87562985867332);"]))
+    (let [instance-id (:instance-id sprops)]
+      (-> (get-stats pool version)
+          (assoc :instance-id instance-id)
+          (send! cfg)))))
 
-(defn- release-all-locks
-  [conn]
-  (db/exec-one! conn ["select pg_advisory_unlock_all();"]))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; IMPL
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defn- handler
-  [{:keys [sprops] :as cfg}]
-  (let [instance-id (:instance-id sprops)
-        data        (retrieve-stats cfg)
-        data        (assoc data :instance-id instance-id)
-        response    (http/send! {:method :post
-                                 :uri (:uri cfg)
-                                 :headers {"content-type" "application/json"}
-                                 :body (json/write-str data)})]
+(defn- send!
+  [data cfg]
+  (let [response (http/send! {:method :post
+                              :uri (:uri cfg)
+                              :headers {"content-type" "application/json"}
+                              :body (json/write-str data)})]
     (when (> (:status response) 206)
       (ex/raise :type :internal
                 :code :invalid-response
-                :context {:status (:status response)
-                          :body (:body response)}))))
+                :response-status (:status response)
+                :response-body (:body response)))))
 
-(defn retrieve-num-teams
+(defn- retrieve-num-teams
   [conn]
   (-> (db/exec-one! conn ["select count(*) as count from team;"]) :count))
 
-(defn retrieve-num-projects
+(defn- retrieve-num-projects
   [conn]
   (-> (db/exec-one! conn ["select count(*) as count from project;"]) :count))
 
-(defn retrieve-num-files
+(defn- retrieve-num-files
   [conn]
-  (-> (db/exec-one! conn ["select count(*) as count from project;"]) :count))
+  (-> (db/exec-one! conn ["select count(*) as count from file;"]) :count))
+
+(defn- retrieve-num-file-changes
+  [conn]
+  (let [sql (str "select count(*) as count "
+                 "  from file_change "
+                 " where date_trunc('day', created_at) = date_trunc('day', now())")]
+    (-> (db/exec-one! conn [sql]) :count)))
+
+(defn- retrieve-num-touched-files
+  [conn]
+  (let [sql (str "select count(distinct file_id) as count "
+                 "  from file_change "
+                 " where date_trunc('day', created_at) = date_trunc('day', now())")]
+    (-> (db/exec-one! conn [sql]) :count)))
+
+(defn- retrieve-num-users
+  [conn]
+  (-> (db/exec-one! conn ["select count(*) as count from profile;"]) :count))
+
+(defn- retrieve-num-fonts
+  [conn]
+  (-> (db/exec-one! conn ["select count(*) as count from team_font_variant;"]) :count))
+
+(defn- retrieve-num-comments
+  [conn]
+  (-> (db/exec-one! conn ["select count(*) as count from comment;"]) :count))
 
 (def sql:team-averages
   "with projects_by_team as (
@@ -98,7 +121,6 @@
      select t.id, count(tp.profile_id) as num_users
        from team as t
        left join team_profile_rel as tp on(tp.team_id = t.id)
-      where t.is_default = false
       group by 1
    )
    select (select avg(num_projects)::integer from projects_by_team) as avg_projects_on_team,
@@ -110,20 +132,20 @@
           (select avg(num_users)::integer from users_by_team) as avg_users_on_team,
           (select max(num_users)::integer from users_by_team) as max_users_on_team;")
 
-(defn retrieve-team-averages
+(defn- retrieve-team-averages
   [conn]
   (->> [sql:team-averages]
        (db/exec-one! conn)))
 
-(defn retrieve-jvm-stats
+(defn- retrieve-jvm-stats
   []
   (let [^Runtime runtime (Runtime/getRuntime)]
     {:jvm-heap-current (.totalMemory runtime)
      :jvm-heap-max     (.maxMemory runtime)
      :jvm-cpus         (.availableProcessors runtime)}))
 
-(defn- retrieve-stats
-  [{:keys [conn version]}]
+(defn get-stats
+  [conn version]
   (let [referer (if (cfg/get :telemetry-with-taiga)
                   "taiga"
                   (cfg/get :telemetry-referer))]
@@ -131,7 +153,12 @@
          :referer        referer
          :total-teams    (retrieve-num-teams conn)
          :total-projects (retrieve-num-projects conn)
-         :total-files    (retrieve-num-files conn)}
+         :total-files    (retrieve-num-files conn)
+         :total-users    (retrieve-num-users conn)
+         :total-fonts    (retrieve-num-fonts conn)
+         :total-comments (retrieve-num-comments conn)
+         :total-file-changes  (retrieve-num-file-changes conn)
+         :total-touched-files (retrieve-num-touched-files conn)}
         (d/merge
          (retrieve-team-averages conn)
          (retrieve-jvm-stats))

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,281 @@
+;; 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
+   app.common.geom.matrix.Matrix
+   app.common.geom.point.Point
+   clojure.lang.Ratio
+   java.io.ByteArrayInputStream
+   java.io.ByteArrayOutputStream
+   java.time.Instant
+   java.time.OffsetDateTime
+   org.fressian.Reader
+   org.fressian.StreamingWriter
+   org.fressian.Writer
+   org.fressian.handlers.ReadHandler
+   org.fressian.handlers.WriteHandler))
+
+;; --- 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)))))}
+
+   Instant
+   {"java/instant"
+    (reify WriteHandler
+      (write [_ w ch]
+        (.writeTag w "java/instant" 1)
+        (.writeInt w (.toEpochMilli ^Instant ch))))}
+
+   OffsetDateTime
+   {"java/instant"
+    (reify WriteHandler
+      (write [_ w ch]
+        (.writeTag w "java/instant" 1)
+        (.writeInt w (.toEpochMilli ^Instant (.toInstant ^OffsetDateTime ch)))))}
+
+   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))))
+
+   "java/instant"
+   (reify ReadHandler
+     (read [_ rdr _ _]
+       (Instant/ofEpochMilli (.readInt 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/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/time.clj

@@ -8,7 +8,8 @@
   (:require
    [app.common.exceptions :as ex]
    [clojure.spec.alpha :as s]
-   [cuerdas.core :as str])
+   [cuerdas.core :as str]
+   [fipp.ednize :as fez])
   (:import
    java.time.Duration
    java.time.Instant
@@ -17,6 +18,8 @@
    java.time.ZonedDateTime
    java.time.format.DateTimeFormatter
    java.time.temporal.TemporalAmount
+   java.time.temporal.TemporalUnit
+   java.time.temporal.ChronoUnit
    java.util.Date
    org.apache.logging.log4j.core.util.CronExpression))
 
@@ -54,15 +57,30 @@
     :else
     (obj->duration ms-or-obj)))
 
-(defn duration-between
-  {:deprecated true}
-  [t1 t2]
-  (Duration/between t1 t2))
-
 (defn diff
   [t1 t2]
   (Duration/between t1 t2))
 
+(defn truncate
+  [o unit]
+  (let [unit (if (instance? TemporalUnit unit)
+               unit
+               (case unit
+                 :nanos ChronoUnit/NANOS
+                 :millis ChronoUnit/MILLIS
+                 :micros ChronoUnit/MICROS
+                 :seconds ChronoUnit/SECONDS
+                 :minutes ChronoUnit/MINUTES))]
+    (cond
+      (instance? Instant o)
+      (.truncatedTo ^Instant o ^TemporalUnit unit)
+
+      (instance? Duration o)
+      (.truncatedTo ^Duration o ^TemporalUnit unit)
+
+      :else
+      (throw (IllegalArgumentException. "only instant and duration allowed")))))
+
 (s/def ::duration
   (s/conformer
    (fn [v]
@@ -94,6 +112,11 @@
 (defmethod print-dup Duration [o w]
   (print-method o w))
 
+(extend-protocol fez/IEdn
+  Duration
+  (-edn [o] (pr-str o)))
+
+
 ;; --- INSTANT
 
 (defn instant
@@ -158,6 +181,10 @@
 (defmethod print-dup Instant [o w]
   (print-method o w))
 
+(extend-protocol fez/IEdn
+  Instant
+  (-edn [o] (pr-str o)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Cron Expression
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -268,6 +295,11 @@
   (s/assert cron? cron)
   (.toInstant (.getNextValidTimeAfter cron (Date/from now))))
 
+(defn get-next
+  [cron tnow]
+  (let [nt (next-valid-instant-from cron tnow)]
+    (cons nt (lazy-seq (get-next cron nt)))))
+
 (defmethod print-method CronExpression
   [mv ^java.io.Writer writer]
   (.write writer (str "#app/cron \"" (.toString ^CronExpression mv) "\"")))
@@ -275,3 +307,8 @@
 (defmethod print-dup CronExpression
   [o w]
   (print-ctor o (fn [o w] (print-dup (.toString ^CronExpression o) w)) w))
+
+(extend-protocol fez/IEdn
+  CronExpression
+  (-edn [o] (pr-str o)))
+

backend/src/app/util/websocket.clj

@@ -0,0 +1,212 @@
+;; 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
+   org.eclipse.jetty.io.EofException))
+
+
+(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)]
+    (try
+      (yws/send! conn s (fn [e]
+                          (when e (a/offer! ch e))
+                          (a/close! ch)))
+      (catch EofException cause
+        (a/offer! ch cause)
+        (a/close! ch)))
+    ch))
+
+(defn- ws-ping!
+  [conn s]
+  (let [ch (a/chan 1)]
+    (try
+      (yws/ping! conn s (fn [e]
+                          (when e (a/offer! ch e))
+                          (a/close! ch)))
+      (catch EofException cause
+        (a/offer! ch cause)
+        (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

@@ -108,7 +108,7 @@
           (and (instance? java.sql.SQLException val)
                (contains? #{"08003" "08006" "08001" "08004"} (.getSQLState ^java.sql.SQLException val)))
           (do
-            (l/error :hint "connection error, trying resume in some instants")
+            (l/warn :hint "connection error, trying resume in some instants")
             (a/<! (a/timeout poll-interval))
             (recur))
 
@@ -121,8 +121,8 @@
 
           (instance? Exception val)
           (do
-            (l/error :cause val
-                     :hint "unexpected error ocurried on polling the database (will resume in some instants)")
+            (l/warn :cause val
+                    :hint "unexpected error ocurried on polling the database (will resume in some instants)")
             (a/<! (a/timeout poll-ms))
             (recur))
 
@@ -249,10 +249,15 @@
 
 (defn get-error-context
   [error item]
-  (let [edata (ex-data error)]
-    {:id      (uuid/next)
-     :data    edata
-     :params  item}))
+  (let [data (ex-data error)]
+    (merge
+     {:hint          (ex-message error)
+      :spec-problems (some->> data ::s/problems (take 10) seq vec)
+      :spec-value    (some->> data ::s/value)
+      :data          (some-> data (dissoc ::s/problems ::s/value ::s/spec))
+      :params        item}
+     (when (and data (::s/problems data))
+       {:spec-explain (us/pretty-explain data)}))))
 
 (defn- handle-exception
   [error item]
@@ -266,8 +271,10 @@
 
         (= ::noop (:strategy edata))
         (assoc :inc-by 0))
-      (l/with-context (get-error-context error item)
-        (l/error :cause error :hint "unhandled exception on task")
+      (do
+        (l/error :hint "unhandled exception on task"
+                 ::l/context (get-error-context error item)
+                 :cause error)
         (if (>= (:retry-num item) (:max-retries item))
           {:status :failed :task item :error error}
           {:status :retry :task item :error error})))))
@@ -406,21 +413,19 @@
 (defn- execute-scheduled-task
   [{:keys [executor pool] :as cfg} {:keys [id] :as task}]
   (letfn [(run-task [conn]
-            (try
-              (when (db/exec-one! conn [sql:lock-scheduled-task (d/name id)])
-                (l/debug :action "execute scheduled task" :id id)
-                ((:fn task) task))
-              (catch Throwable e
-                e)))
+            (when (db/exec-one! conn [sql:lock-scheduled-task (d/name id)])
+              (l/debug :action "execute scheduled task" :id id)
+              ((:fn task) task)))
 
           (handle-task []
-            (db/with-atomic [conn pool]
-              (let [result (run-task conn)]
-                (when (ex/exception? result)
-                  (l/error :cause result
-                           :hint "unhandled exception on scheduled task"
-                           :id id)))))]
-
+            (try
+              (db/with-atomic [conn pool]
+                (run-task conn))
+              (catch Throwable cause
+                (l/error :hint "unhandled exception on scheduled task"
+                         ::l/context (get-error-context cause task)
+                         :task-id id
+                         :cause cause))))]
     (try
       (px/run! executor handle-task)
       (finally
@@ -465,7 +470,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/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/tasks_telemetry_test.clj

@@ -0,0 +1,46 @@
+;; 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.tasks-telemetry-test
+  (:require
+   [app.db :as db]
+   [app.emails :as emails]
+   [app.test-helpers :as th]
+   [app.util.time :as dt]
+   [clojure.pprint :refer [pprint]]
+   [clojure.test :as t]
+   [mockery.core :refer [with-mocks]]))
+
+(t/use-fixtures :once th/state-init)
+(t/use-fixtures :each th/database-reset)
+
+(t/deftest test-base-report-data-structure
+  (with-mocks [mock {:target 'app.tasks.telemetry/send!
+                     :return nil}]
+    (let [task-fn (-> th/*system* :app.worker/registry :telemetry)
+          prof    (th/create-profile* 1 {:is-active true})]
+
+      ;; run the task
+      (task-fn nil)
+
+      (t/is (:called? @mock))
+      (let [[data] (-> @mock :call-args)]
+        (t/is (contains? data :total-fonts))
+        (t/is (contains? data :total-users))
+        (t/is (contains? data :total-projects))
+        (t/is (contains? data :total-files))
+        (t/is (contains? data :total-teams))
+        (t/is (contains? data :total-comments))
+        (t/is (contains? data :instance-id))
+        (t/is (contains? data :jvm-cpus))
+        (t/is (contains? data :jvm-heap-max))
+        (t/is (contains? data :max-users-on-team))
+        (t/is (contains? data :avg-users-on-team))
+        (t/is (contains? data :max-files-on-project))
+        (t/is (contains? data :avg-files-on-project))
+        (t/is (contains? data :max-projects-on-team))
+        (t/is (contains? data :avg-files-on-project))
+        (t/is (contains? data :version))))))

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,38 +1,39 @@
 {:deps
  {org.clojure/clojure {:mvn/version "1.10.3"}
-  org.clojure/data.json {:mvn/version "2.3.1"}
+  org.clojure/data.json {:mvn/version "2.4.0"}
   org.clojure/tools.cli {:mvn/version "1.0.206"}
-  metosin/jsonista {:mvn/version "0.3.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.2.3"}
-  org.apache.logging.log4j/log4j-api {:mvn/version "2.17.0"}
-  org.apache.logging.log4j/log4j-core {:mvn/version "2.17.0"}
-  org.apache.logging.log4j/log4j-web {:mvn/version "2.17.0"}
-  org.apache.logging.log4j/log4j-jul {:mvn/version "2.17.0"}
-  org.apache.logging.log4j/log4j-slf4j18-impl {:mvn/version "2.17.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"}
 
-  selmer/selmer {:mvn/version "1.12.40"}
-  expound/expound {:mvn/version "0.8.9"}
+  selmer/selmer {:mvn/version "1.12.49"}
+  criterium/criterium {:mvn/version "0.4.6"}
+
+  expound/expound {:mvn/version "0.9.0"}
   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/cuerdas {:mvn/version "2021.05.29-0"}
+  funcool/promesa {:mvn/version "6.0.2"}
+  funcool/cuerdas {:mvn/version "2022.01.14-391"}
 
-  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
-  fipp/fipp {:mvn/version "0.6.24"}
+  fipp/fipp {:mvn/version "0.6.25"}
   io.aviso/pretty {:mvn/version "1.1.1"}
   environ/environ {:mvn/version "1.2.0"}}
  :paths ["src"]
@@ -42,25 +43,17 @@
    {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.12"}
     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"]}
-
   :test
   {:extra-paths ["test"]
-   :extra-deps {io.github.cognitect-labs/test-runner
-                {:git/url "https://github.com/cognitect-labs/test-runner.git"
-                 :sha "705ad25bbf0228b1c38d0244a36001c2987d7337"}}
+   :extra-deps
+   {io.github.cognitect-labs/test-runner
+    {:git/tag "v0.5.0" :git/sha "b3fd0d2"}}
    :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.12",
     "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,18 @@
+;; 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 gray-30 "#7B7D85")
+(def info "#59B9E2")
+(def test "#fabada")
+(def white "#FFFFFF")
+

common/src/app/common/data.cljc

@@ -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
 
@@ -497,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,26 +12,23 @@
 
 (s/def ::type keyword?)
 (s/def ::code keyword?)
-(s/def ::mesage string?)
 (s/def ::hint string?)
 (s/def ::cause #?(:clj #(instance? Throwable %)
                   :cljs #(instance? js/Error %)))
+
 (s/def ::error-params
   (s/keys :req-un [::type]
           :opt-un [::code
                    ::hint
-                   ::mesage
                    ::cause]))
 
 (defn error
-  [& {:keys [message hint cause] :as params}]
+  [& {:keys [hint cause ::data] :as params}]
   (s/assert ::error-params params)
-  (let [message (or message hint "")
-        payload (-> params
-                    (dissoc :cause)
-                    (dissoc :message)
-                    (assoc :hint message))]
-    (ex-info message payload cause)))
+  (let [payload (-> params
+                    (dissoc :cause ::data)
+                    (merge data))]
+    (ex-info hint payload cause)))
 
 (defmacro raise
   [& args]

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

@@ -6,7 +6,9 @@
 
 (ns app.common.geom.align
   (:require
+   [app.common.data :as d]
    [app.common.geom.shapes :as gsh]
+   [app.common.pages.helpers :refer [get-children]]
    [clojure.spec.alpha :as s]))
 
 ;; --- Alignment
@@ -15,23 +17,13 @@
 
 (declare calc-align-pos)
 
-;; TODO: revisit on how to reuse code and dont have this function
-;; duplicated because the implementation right now differs from the
-;; original function.
-
-;; Duplicated from pages/helpers to remove cyclic dependencies
-(defn- get-children [id objects]
-  (let [shapes (vec (get-in objects [id :shapes]))]
-    (if shapes
-      (into shapes (mapcat #(get-children % objects)) shapes)
-      [])))
-
 (defn- recursive-move
   "Move the shape and all its recursive children."
   [shape dpoint objects]
-  (let [children-ids (get-children (:id shape) objects)
-        children (map #(get objects %) children-ids)]
-    (map #(gsh/move % dpoint) (cons shape children))))
+  (->> (get-children (:id shape) objects)
+       (map (d/getf objects))
+       (cons shape)
+       (map #(gsh/move % dpoint))))
 
 (defn align-to-rect
   "Move the shape so that it is aligned with the given rectangle
@@ -81,7 +73,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 +111,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/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,25 @@
         (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]
+          (-> params
+              (update px + dx)
+              (update py + dy)))
 
         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)))]
 
-    (->> content
-         (mapv (fn [cmd]
-                 (cond-> cmd
-                   (map? cmd)
-                   (update :params transform-params)))))))
+    (into []
+          (map #(update % :params transform-params))
+          content)))
 
 (defn transform-content
   [content transform]
@@ -393,11 +403,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 +687,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 +717,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 +825,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,31 +14,37 @@
    [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)
-        dy (d/check-num dy)
+  [{:keys [type] :as shape} {dx :x dy :y}]
+  (let [dx       (d/check-num dx)
+        dy       (d/check-num dy)
         move-vec (gpt/point dx dy)]
 
     (-> shape
@@ -46,9 +52,8 @@
         (update :points move-points move-vec)
         (d/update-when :x + dx)
         (d/update-when :y + dy)
-        (cond-> (= :path (:type shape))
-          (update :content gpa/move-content move-vec)))))
-
+        (cond-> (= :bool type) (update :bool-content gpa/move-content move-vec))
+        (cond-> (= :path type) (update :content gpa/move-content move-vec)))))
 
 ;; --- Absolute Movement
 
@@ -71,7 +76,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 +88,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 +159,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 +176,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 +218,78 @@
          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)))
+        (cond-> (not transform)
+          (dissoc :transform :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 +322,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 +365,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)
@@ -395,53 +421,54 @@
     (->> 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))
+(defn modifiers->transform
+  ([modifiers]
+   (modifiers->transform nil 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)
+  ([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))
 
-        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)
+         ;; 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))))
 
-        origin (:resize-origin modifiers (gpt/point 0 0))
-        origin-2 (:resize-origin-2 modifiers (gpt/point 0 0))
+         resize-2 (when (some? resize-v2)
+                    (gpt/point (normalize-scale (:x resize-v2))
+                               (normalize-scale (:y resize-v2))))
 
-        resize-transform (:resize-transform modifiers (gmt/matrix))
-        resize-transform-inverse (:resize-transform-inverse modifiers (gmt/matrix))
-        rt-modif (or (:rotation modifiers) 0)
 
-        center (gpt/transform center ds-modifier)
+         resize-transform (:resize-transform modifiers (gmt/matrix))
+         resize-transform-inverse (:resize-transform-inverse modifiers (gmt/matrix))
 
-        transform (-> (gmt/matrix)
+         rt-modif (:rotation modifiers)]
 
-                      ;; 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))
+     (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)))
 
-                      (gmt/translate origin-2)
-                      (gmt/multiply resize-transform)
-                      (gmt/scale resize-2)
-                      (gmt/multiply resize-transform-inverse)
-                      (gmt/translate (gpt/negate origin-2))
+       (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)))
 
-                      ;; Applies the stacked transformations
-                      (gmt/translate center)
-                      (gmt/multiply (gmt/rotate-matrix rt-modif))
-                      (gmt/translate (gpt/negate center))
+       (some? displacement)
+       (gmt/multiply displacement)
 
-                      ;; Displacement
-                      (gmt/multiply ds-modifier))]
-    transform))
+       (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 +490,7 @@
             modifiers (dissoc modifiers :displacement)]
         (-> shape
             (assoc :modifiers modifiers)
-            (cond-> (empty? modifiers)
+            (cond-> (empty-modifiers? modifiers)
               (dissoc :modifiers))))
       shape)))
 
@@ -485,205 +512,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 +590,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

@@ -7,8 +7,10 @@
 (ns app.common.logging
   (:require
    [app.common.exceptions :as ex]
+   [app.common.uuid :as uuid]
    [clojure.pprint :refer [pprint]]
    [cuerdas.core :as str]
+   [fipp.edn :as fpp]
    #?(:clj [io.aviso.exception :as ie])
    #?(:cljs [goog.log :as glog]))
   #?(:cljs (:require-macros [app.common.logging])
@@ -34,12 +36,12 @@
        (reduce-kv #(.with ^MapMessage %1 (name %2) %3) message m))))
 
 #?(:clj
-  (def logger-context
-    (LogManager/getContext false)))
+   (def logger-context
+     (LogManager/getContext false)))
 
 #?(:clj
-  (def logging-agent
-    (agent nil :error-mode :continue)))
+   (def logging-agent
+     (agent nil :error-mode :continue)))
 
 (defn- simple-prune
   ([s] (simple-prune s (* 1024 1024)))
@@ -52,22 +54,16 @@
    (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
 
+       (instance? clojure.lang.Named val)
+       (name val)
+
        (coll? val)
-       (binding [clojure.pprint/*print-right-margin* 200]
-         (-> (with-out-str (pprint val))
-             (simple-prune (* 1024 1024 3))))
+       (binding [*print-level* 8
+                 *print-length* 25]
+         (with-out-str (fpp/pprint val {:width 200})))
 
        :else
        (str val))))
@@ -163,26 +159,27 @@
      (.isEnabled ^Logger logger ^Level level)))
 
 (defmacro log
-  [& {:keys [level cause ::logger ::async ::raw] :or {async true} :as props}]
+  [& {:keys [level cause ::logger ::async ::raw ::context] :or {async true} :as props}]
   (if (:ns &env) ; CLJS
     `(write-log! ~(or logger (str *ns*))
                  ~level
                  ~cause
-                 ~(dissoc props :level :cause ::logger ::raw))
-    (let [props      (dissoc props :level :cause ::logger ::async ::raw)
+                 (or ~raw ~(dissoc props :level :cause ::logger ::raw ::context)))
+    (let [props      (dissoc props :level :cause ::logger ::async ::raw ::context)
           logger     (or logger (str *ns*))
           logger-sym (gensym "log")
           level-sym  (gensym "log")]
       `(let [~logger-sym (get-logger ~logger)
              ~level-sym  (get-level ~level)]
-         (if (enabled? ~logger-sym ~level-sym)
+         (when (enabled? ~logger-sym ~level-sym)
            ~(if async
-              `(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))))))
+              `(->> (ThreadContext/getImmutableContext)
+                    (send-off logging-agent
+                              (fn [_# cdata#]
+                                (with-context (-> {:id (uuid/next)} (into cdata#) (into ~context))
+                                  (->> (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#))))))))
 
@@ -297,7 +294,7 @@
 
 #?(:cljs
    (defn default-handler
-     [{:keys [message level logger-name]}]
+     [{:keys [message level logger-name exception] :as params}]
      (let [header-styles (str "font-weight: 600; color: " (level->color level))
            normal-styles (str "font-weight: 300; color: " (get colors :gray6))
            level-name    (level->short-name level)
@@ -318,7 +315,13 @@
                             (js/console.error v))))
                (js/console.groupEnd message))
              (let [message (str header "%c" (pr-str message))]
-               (js/console.log message header-styles normal-styles))))))))
+               (js/console.log message header-styles normal-styles)))))
+
+       (when exception
+         (when-let [data (ex-data exception)]
+           (js/console.error "cause data:" (pr-str data)))
+         (js/console.error (.-stack exception))))))
+
 
 #?(:cljs
    (defn record->map

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