more wip

🎉 Add webhooks processing & errors UI integration

.circleci/config.yml

@@ -3,19 +3,19 @@ jobs:
   build:
     docker:
       - image: penpotapp/devenv:latest
-      - image: cimg/postgres:13.5
+      - image: cimg/postgres:14.5
         environment:
           POSTGRES_USER: penpot_test
           POSTGRES_PASSWORD: penpot_test
           POSTGRES_DB: penpot_test
-      - image: cimg/redis:6.2.6
+      - image: cimg/redis:7.0.5
 
     working_directory: ~/repo
     resource_class: large
 
     environment:
       # Customize the JVM maximum heap limit
-      JVM_OPTS: -Xmx1g
+      JVM_OPTS: -Xmx4g
 
     steps:
       - checkout
@@ -29,6 +29,13 @@ jobs:
 
       - run: cd .clj-kondo && cat config.edn
 
+      - run:
+          name: frontend styles prettier
+          working_directory: "./frontend"
+          command: |
+            yarn install
+            yarn run lint-scss
+
       - run:
           name: common lint
           working_directory: "./common"
@@ -43,13 +50,6 @@ 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"
@@ -57,47 +57,42 @@ jobs:
             clj-kondo --version
             clj-kondo --parallel --lint src/
 
-      # run backend test
+      - run:
+          working_directory: "./common"
+          name: common tests
+          command: |
+            yarn install
+            yarn test
+            clojure -X:dev:test :patterns '["common-tests.*-test"]'
+
+          environment:
+            PATH: /usr/local/nodejs/bin/:/usr/local/bin:/bin:/usr/bin
+            JVM_OPTS: -Xmx4g
+            NODE_OPTIONS: --max-old-space-size=4096
+
       - run:
           name: backend test
           working_directory: "./backend"
-          command: "clojure -X:dev:test"
+          command: |
+            clojure -X:dev:test :patterns '["backend-tests.*-test"]'
+
           environment:
             PENPOT_TEST_DATABASE_URI: "postgresql://localhost/penpot_test"
             PENPOT_TEST_DATABASE_USERNAME: penpot_test
             PENPOT_TEST_DATABASE_PASSWORD: penpot_test
             PENPOT_TEST_REDIS_URI: "redis://localhost/1"
+            JVM_OPTS: -Xmx4g
 
       - run:
           name: frontend tests
           working_directory: "./frontend"
           command: |
             yarn install
-            clojure -M:dev:shadow-cljs compile test
-            node target/tests.js
-
-          environment:
-            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 (clj)
-          command: |
-            clojure -X:dev:test
+            yarn test
 
           environment:
             PATH: /usr/local/nodejs/bin/:/usr/local/bin:/bin:/usr/bin
+            NODE_OPTIONS: --max-old-space-size=4096
 
       - save_cache:
          paths:

.clj-kondo/config.edn

@@ -2,11 +2,12 @@
  {promesa.core/let clojure.core/let
   promesa.core/->> clojure.core/->>
   promesa.core/-> clojure.core/->
-  rumext.alpha/defc clojure.core/defn
-  rumext.alpha/fnc clojure.core/fn
+  rumext.v2/defc clojure.core/defn
+  rumext.v2/fnc clojure.core/fn
   app.common.data/export clojure.core/def
   app.db/with-atomic clojure.core/with-open
   app.common.data.macros/get-in clojure.core/get-in
+  app.common.data.macros/with-open clojure.core/with-open
   app.common.data.macros/select-keys clojure.core/select-keys
   app.common.logging/with-context clojure.core/do}
 

.github/ISSUE_TEMPLATE/bug-report.yml

@@ -0,0 +1,89 @@
+description: Create a report to help us improve
+labels: ["bug"]
+name: Bug report
+title: "bug: "
+body:
+  - type: markdown
+    attributes:
+      value: |
+        ## Before you start
+
+        Please search our [existing issues](https://github.com/penpot/penpot/issues) and open [pull requests](https://github.com/penpot/penpot/pulls) to lessen the change of filing duplicate issues or feature requests. Thank you.
+
+        ---
+  - type: textarea
+    attributes:
+      label: Steps To Reproduce
+      description: Steps to reproduce the behavior.
+      placeholder: |
+        Steps to reproduce the behavior:
+        1.  Go to '...'
+        2.  Click on '....'
+        3.  Scroll down to '....'
+    validations:
+      required: true
+  - type: textarea
+    id: expected
+    attributes:
+      description: A clear and concise description of what you expected to happen.
+      label: Expected behavior
+    validations:
+      required: true
+  - type: textarea
+    id: actual
+    attributes:
+      description: A clear and concise description of what happens instead; what the bug is.
+      label: Actual behavior
+    validations:
+      required: true
+  - type: textarea
+    id: screenshots
+    attributes:
+      description: If applicable, add screenshots to help explain your problem.
+      label: Screenshots or video
+  - type: textarea
+    id: desktop
+    attributes:
+      label: Desktop (please complete the following information)
+      placeholder: |
+        - OS (e.g. iOS):
+        - Browser & version (e.g. Chrome 89.0):
+  - type: textarea
+    id: mobile
+    attributes:
+      label: Smartphone (please complete the following information)
+      placeholder: |
+        - Device & model (e.g. iPhone 6):
+        - OS & version (e.g. iOS 8.1):
+        - Browser & version (e.g. stock browser 22):
+  - type: textarea
+    id: environment
+    attributes:
+      label: Environment (please complete the following information)
+      placeholder: |
+        - Host (e.g. https://design.penpot.app, local instance):
+
+        *If self-hosted:*
+        - OS Version (e.g. Ubuntu 16.04):
+        - Docker / Docker-compose version (e.g. Docker version 18.03.0-ce, build 0520e24):
+        - Image version (e.g. Alpine):
+
+        Docker commands or docker-compose file (if possible and if proceed.x):
+        ```
+
+        ```
+  - type: textarea
+    id: frontend-trace
+    attributes:
+      label: Frontend Stack Trace
+      render: console
+  - type: textarea
+    id: backend-trace
+    attributes:
+      label: Backend Stack Trace
+      render: console
+  - type: textarea
+    id: additional-context
+    attributes:
+      label: Additional context
+      description: Any other context about the problem.

.github/ISSUE_TEMPLATE/bug_report.md

@@ -1,72 +0,0 @@
----
-
-name: Bug report
-about: Create a report to help us improve
-title: ''
-labels: bug
-assignees: ''
-
----
-
-**To Reproduce**
-
-Steps to reproduce the behavior:
-1.  Go to '...'
-2.  Click on '....'
-3.  Scroll down to '....'
-
-**Expected behavior**
-
-A clear and concise description of what you expected to happen.
-
-**Actual behavior**
-
-A clear and concise description of what happens instead; what the bug is.
- 
-**Screenshots**
-
-If applicable, add screenshots to help explain your problem.
-
-**Desktop (please complete the following information):**
-- OS (e.g. iOS):
-- Browser & version (e.g. Chrome 89.0):
-
-**Smartphone (please complete the following information):**
-- Device & model (e.g. iPhone 6):
-- OS & version (e.g. iOS 8.1):
-- Browser & version (e.g. stock browser 22):
-
-**Environment (please complete the following information):**
-- Host (e.g. https://design.penpot.app, local instance):
-
-*If self-hosted:*
-- OS Version (e.g. Ubuntu 16.04):
-- Docker / Docker-compose version (e.g. Docker version 18.03.0-ce, build 0520e24):
-- Image version (e.g. Alpine):
-
-Docker commands or docker-compose file (if possible and if proceed.x):
-```
-
-```
-
-Frontend Stack Trace:
-<details>
-
-```
-
-```
-
-</details>
-
-Backend Stack Trace:
-<details>
-
-```
-
-```
-
-</details>
-
-**Additional context:**
-
-Any other context about the problem.

.github/ISSUE_TEMPLATE/feature-request.yml

@@ -0,0 +1,37 @@
+description: Suggest an idea for this project.
+labels: ["needs triage", "enhancement"]
+name: "Feature request"
+title: "feature: "
+body:
+  - type: markdown
+    attributes:
+      value: |
+        ## Before you start
+
+        Please search our [existing issues](https://github.com/penpot/penpot/issues) and open [pull requests](https://github.com/penpot/penpot/pulls) to lessen the change of filing duplicate issues or feature requests. Thank you.
+
+        ---
+  - type: textarea
+    id: problem
+    attributes:
+      description: A clear and concise description of what the problem is. Ex. I'm always frustrated when (...)
+      label: Is your feature request related to a problem? Please describe.
+    validations:
+      required: true
+  - type: textarea
+    id: solution
+    attributes:
+      description: A clear and concise description of what you want to happen.
+      label: Describe the solution you'd like.
+    validations:
+      required: true
+  - type: textarea
+    id: alternatives
+    attributes:
+      label: Describe alternatives you've considered.
+      description: A clear and concise description of any alternative solutions or features you've considered.
+  - type: textarea
+    id: additional-context
+    attributes:
+      label: Additional context
+      description: Add any other context or screenshots about the feature request here.

.github/ISSUE_TEMPLATE/feature_request.md

@@ -1,21 +0,0 @@
----
-
-name: Feature request
-about: Suggest an idea for this project
-title: ''
-labels: enhancement
-assignees: ''
-
----
-
-**Is your feature request related to a problem? Please describe.**
-A clear and concise description of what the problem is. Ex. I'm always frustrated when (...)
-
-**Describe the solution you'd like**
-A clear and concise description of what you want to happen.
-
-**Describe alternatives you've considered**
-A clear and concise description of any alternative solutions or features you've considered.
-
-**Additional context**
-Add any other context or screenshots about the feature request here.

.gitignore

@@ -1,55 +1,59 @@
 *-init.clj
 *.jar
-*.penpot
 *.orig
+*.penpot
 .calva
 .clj-kondo
 .cpcache
-.lein-deps-sum
-.lein-failures
-.lein-plugins/
-.lein-repl-history
 .lsp
 .nrepl-port
 .nyc_output
 .rebel_readline_history
 .repl
+.shadow-cljs
+/*.jpg
+/*.md
+/*.png
+/*.sql
+/*.txt
+/*.yml
+/*.zip
 /.clj-kondo/.cache
 /_dump
-/backend/-
+/backend/*.md
+/backend/*.sql
+/backend/*.txt
 /backend/assets/
+/backend/builtin-templates
 /backend/dist/
 /backend/logs/
 /backend/resources/public/assets
 /backend/resources/public/media
 /backend/target/
-/backend/builtin-templates
 /bundle*
 /cd.md
 /clj-profiler/
-/common/.shadow-cljs
 /common/coverage
 /common/target
 /deploy
 /docker/images/bundle*
-/exporter/.shadow-cljs
 /exporter/target
-/frontend/.shadow-cljs
-/frontend/package-lock.json
-/frontend/cypress/videos/*/
 /frontend/cypress/fixtures/validuser.json
+/frontend/cypress/videos/*/
+/frontend/cypress/videos/*/
 /frontend/dist/
 /frontend/npm-debug.log
 /frontend/out/
+/frontend/package-lock.json
 /frontend/resources/fonts/experiments
 /frontend/resources/public/*
 /frontend/target/
-/frontend/cypress/videos/*/
-/media
+/other/
+/scripts/
 /telemetry/
+/tmp/
 /vendor/**/target
 /vendor/svgclean/bundle*.js
 /web
 clj-profiler/
-figwheel_server.log
 node_modules

CHANGES.md

@@ -1,9 +1,119 @@
 # CHANGELOG
 
+## :rocket: Next (1.17)
+
+### :boom: Breaking changes & Deprecations
+### :sparkles: New features
+
+- Adds layout flex functionality for boards
+- Better overlays interactions on boards inside boards [Taiga #4386](https://tree.taiga.io/project/penpot/us/4386)
+- Show board miniature in manual overlay setting [Taiga #4475](https://tree.taiga.io/project/penpot/issue/4475)
+- Handoff visual improvements [Taiga #3124](https://tree.taiga.io/project/penpot/us/3124)
+
+### :bug: Bugs fixed
+
+- Add title to color bullets [Taiga #4218](https://tree.taiga.io/project/penpot/task/4218)
+- Fix color bullets in library color modal [Taiga #4186](https://tree.taiga.io/project/penpot/issue/4186)
+- Fix shortcut texts alignment [Taiga #4275](https://tree.taiga.io/project/penpot/issue/4275)
+- Fix some texts and a typo [Taiga #4215](https://tree.taiga.io/project/penpot/issue/4215)
+- Fix twitter support account link [Taiga #4279](https://tree.taiga.io/project/penpot/issue/4279)
+- Fix lang autodetect issue [Taiga #4277](https://tree.taiga.io/project/penpot/issue/4277)
+- Fix adding an extra page on import [Taiga #4543](https://tree.taiga.io/project/penpot/task/4543)
+
+### :arrow_up: Deps updates
+### :heart: Community contributions by (Thank you!)
+## 1.16.2-beta
+
+## 1.16.1-beta
+
+### :bug: Bugs fixed
+
+- Fix unexpected exception related to default nudge value
+- Fix firefox changing layer color type is not applied [Taiga #4292](https://tree.taiga.io/project/penpot/issue/4292)
+- Fix justify alignes text left [Taiga #4322](https://tree.taiga.io/project/penpot/issue/4322)
+- Fix text out of borders with "auto width" and center align [Taiga #4308](https://tree.taiga.io/project/penpot/issue/4308)
+- Fix wrong validation text after interaction with 2 and more files [Taiga #4276](https://tree.taiga.io/project/penpot/issue/4276)
+- Fix auto-width for texts can make text appear stretched [Github #2482](https://github.com/penpot/penpot/issues/2482)
+- Fix boards name do not disappear in focus mode [#4272](https://tree.taiga.io/project/penpot/issue/4272)
+- Fix wrong email in the info message at change email [Taiga #4274](https://tree.taiga.io/project/penpot/issue/4274)
+- Fix transform to path RMB menu item is not relevant if shape is already path [Taiga #4302](https://tree.taiga.io/project/penpot/issue/4302)
+- Fix join nodes icon is active when 2 already joined nodes are selected [Taiga #4370](https://tree.taiga.io/project/penpot/issue/4370)
+- Fix path nodes panel. "To curve" and "To corner" icons are active if node is already curved/cornered [Taiga #4371](https://tree.taiga.io/project/penpot/issue/4371)
+- Fix displaying comments settings are not applied via "Comments" menu drop-down on the top navbar on view mode [Taiga #4389](https://tree.taiga.io/project/penpot/issue/4389)
+- Fix bad behaviour on hovering and click nested artboards [Taiga #4018](https://tree.taiga.io/project/penpot/issue/4018) and [Taiga #4269](https://tree.taiga.io/project/penpot/us/4269)
+- Fix lang autodetect issue [Taiga #4277](https://tree.taiga.io/project/penpot/issue/4277)
+- Fix colorpicker does not close upon switching to Dashboard [Taiga #4408](https://tree.taiga.io/project/penpot/issue/4408)
+- Fix problem with auto-width/auto-height + lock-proportions
+
+## 1.16.0-beta
+
+### :boom: Breaking changes & Deprecations
+
+- Removed the support for v2 internal file data blob format.  This
+  version has never been documented nor set as default value so
+  technically this is not a breaking change because we are removing
+  a "private API".
+
+### :sparkles: New features
+
+- Improve interactions with nested boards [Taiga #4054](https://tree.taiga.io/project/penpot/us/4054)
+- Add team hero in projects dashboard [Taiga #3863](https://tree.taiga.io/project/penpot/us/3863)
+- Add zoom style to shared link [Taiga #3874](https://tree.taiga.io/project/penpot/us/3874)
+- Add dashboard creation button as placeholder [Taiga #3861](https://tree.taiga.io/project/penpot/us/3861)
+- Improve invitation flow on onboarding [Taiga #3241](https://tree.taiga.io/project/penpot/us/3241)
+- Add new text to initial modals [Taiga #3458](https://tree.taiga.io/project/penpot/us/3458)
+- Add new questions to onboarding [Taiga #3462](https://tree.taiga.io/project/penpot/us/3462)
+- Add cosmetic changes in viewer mode [Taiga #3688](https://tree.taiga.io/project/penpot/us/3688)
+- Outline highlights on layer hovering [Taiga #2645](https://tree.taiga.io/project/penpot/us/2645) by @andrewzhurov
+- Add zoom to shape on double click up on its icon [Taiga #3929](https://tree.taiga.io/project/penpot/us/3929) by @andrewzhurov
+- Add Libraries & Templates carousel [Taiga #3860](https://tree.taiga.io/project/penpot/us/3860)
+- Ungroup frames [Taiga #4012](https://tree.taiga.io/project/penpot/us/4012)
+- Newsletter Opt-in options for subscription categories [Taiga #3242](https://tree.taiga.io/project/penpot/us/3242)
+- Print emails to console by default if smtp is disabled
+- Add `email-verification` flag for enable/disable email verification
+- Make graphics thumbnails load lazy [Taiga #4252](https://tree.taiga.io/project/penpot/issue/4252)
+
+### :bug: Bugs fixed
+
+- Fix unexpected removal of guides on copy&paste frames [Taiga #3887](https://tree.taiga.io/project/penpot/issue/3887) by @andrewzhurov
+- Fix props preserving on copy&paste texts [Taiga #3629](https://tree.taiga.io/project/penpot/issue/3629) by @andrewzhurov
+- Fix unexpected layers ungrouping on moving it [Taiga #3932](https://tree.taiga.io/project/penpot/issue/3932) by @andrewzhurov
+- Fix artboards moving with comment tool selected [Taiga #3938](https://tree.taiga.io/project/penpot/issue/3938)
+- Fix undo on delete page does not preserve its order [Taiga #3375](https://tree.taiga.io/project/penpot/issue/3375)
+- Fix unexpected 404 on deleting library that is used by deleted files
+- Fix inconsistent message on deleting library when a library is linked from deleted files
+- Fix change multiple colors with SVG [Taiga #3889](https://tree.taiga.io/project/penpot/issue/3889)
+- Fix ungroup does not work for typographies [Taiga #4195](https://tree.taiga.io/project/penpot/issue/4195)
+- Fix inviting to non existing users can fail [Taiga #4108](https://tree.taiga.io/project/penpot/issue/4108)
+- Fix components marked as touched when moved [Taiga #4061](https://tree.taiga.io/project/penpot/task/4061)
+- Fix boards grouped shouldn't show the title [Taiga #4251](https://tree.taiga.io/project/penpot/issue/4251)
+- Fix gradient handlers are under resize handlers[Taiga #4298](https://tree.taiga.io/project/penpot/issue/4298)
+- Fix grid not syncing immediately in multiuser [Taiga #4339](https://tree.taiga.io/project/penpot/issue/4339)
+- Fix custom font upload fails silently for unsupported formats [Taiga #4279](https://tree.taiga.io/project/penpot/issue/4280)
+
+### :arrow_up: Deps updates
+### :heart: Community contributions by (Thank you!)
+
+- To @andrewzhurov for many code contributions on this release.
+- UI improvements in Project section (by @Waishnav) [#2285](https://github.com/penpot/penpot/pull/2285)
+- Fix fronted comments (by @lol768) [#2368](https://github.com/penpot/penpot/pull/2368)
+
+## 1.15.5-beta
+
+### :bug: Bugs fixed
+
+- Fix artboard border radius [Taiga #4291](https://tree.taiga.io/project/penpot/issue/4291)
+- Fix copied & pasted layer is not visible [Taiga #4283](https://tree.taiga.io/project/penpot/issue/4283)
+- Fix notification to newsletter is shown in all cases [Taiga #4367](https://tree.taiga.io/project/penpot/issue/4367)
+- Fix comments section is not scrolling by mouse wheel [Taiga #4305](https://tree.taiga.io/project/penpot/issue/4305)
+- Fix justify alignes text left [Taiga #4322](https://tree.taiga.io/project/penpot/issue/4322)
+- Fix text out of borders with "auto width" and center align [Taiga #4308](https://tree.taiga.io/project/penpot/issue/4308)
+
 ## 1.15.4-beta
 
 ### :bug: Bugs fixed
 
+- Fix social buttons in register form [Taiga #4320](https://tree.taiga.io/project/penpot/issue/4320)
 - Remove gitter information from feedback page [Taiga #4157](https://tree.taiga.io/project/penpot/issue/4157)
 - Fix overlay remains open on frame change [Taiga #4066](https://tree.taiga.io/project/penpot/issue/4066)
 - Fix toggle overlay position [Taiga #4091](https://tree.taiga.io/project/penpot/issue/4091)
@@ -22,6 +132,8 @@
 - Fix error after user drags any layer in search functionality [Taiga #4161](https://tree.taiga.io/project/penpot/issue/4161)
 - Fix font search works only with lowercase letters [Taiga #4140](https://tree.taiga.io/project/penpot/issue/4140)
 - Fix Terms and Privacy links overlapping [Taiga #4137](https://tree.taiga.io/project/penpot/issue/4137)
+- Fix Export bounding box mask [Taiga #950](https://tree.taiga.io/project/penpot/issue/950)
+- Fix delete layers in bulk [Taiga #4160](https://tree.taiga.io/project/penpot/issue/4160)
 - Fix Cannot take out an element from a group at layers panel by drag [Taiga #4209](https://tree.taiga.io/project/penpot/issue/4209)
 - Fix Internal error when resending invitation email [Taiga #4212](https://tree.taiga.io/project/penpot/issue/4212)
 - Fix PDF exportation order [Taiga #4216](https://tree.taiga.io/project/penpot/issue/4216)
@@ -76,7 +188,7 @@
 - The `PENPOT_LDAP_ATTRS_PHOTO` finally removed, it was unused for many
   versions.
 - If you are using social login (google, github, gitlab or generic OIDC) you
-  will need to ensure to add the following flags respectivelly to let them
+  will need to ensure to add the following flags respectively to let them
   enabled: `enable-login-with-google`, `enable-login-with-github`,
   `enable-login-with-gitlab` and `enable-login-with-oidc`. If not, they will
   remain disabled after application start independently if you set the client-id
@@ -126,8 +238,6 @@
 - Fix drag and drop graphic assets in groups [Taiga #4002](https://tree.taiga.io/project/penpot/issue/4002)
 - Fix bringing complete file data when launching the export dialog [Taiga #4006](https://tree.taiga.io/project/penpot/issue/4006)
 
-
-
 ### :arrow_up: Deps updates
 ### :heart: Community contributions by (Thank you!)
 
@@ -183,7 +293,7 @@
 - Fix undo when drawing curves [Taiga #3523](https://tree.taiga.io/project/penpot/issue/3523)
 - Fix issue with text edition and certain fonts (WorkSans, Raleway, ...) and foreign objects [Taiga #3521](https://tree.taiga.io/project/penpot/issue/3521)
 - Fix thumbnail generation when concurrent edition [Taiga #3522](https://tree.taiga.io/project/penpot/issue/3522)
-- Fix environment imporot for exporter in Docker
+- Fix environment import for exporter in Docker
 - Fix auto scroll layers in Firefox [Taiga #3531](https://tree.taiga.io/project/penpot/issue/3531)
 - Fix base background not visible for imported SVG
 
@@ -267,7 +377,7 @@
 - Fix mouse leave in handoff close overlay animation breaks [Taiga #3173](https://tree.taiga.io/project/penpot/issue/3173)
 - Fix different behaviour during image drag [Taiga #2279](https://tree.taiga.io/project/penpot/issue/2279)
 - Fix hidden file name on import [Taiga #3172](https://tree.taiga.io/project/penpot/issue/3172)
-- Fix unneccessary scrollbars at the color list [Taiga #3211](https://tree.taiga.io/project/penpot/issue/3211)
+- Fix unnecessary scrollbars at the color list [Taiga #3211](https://tree.taiga.io/project/penpot/issue/3211)
 - "Show in exports" is showing in multiselections [Taiga #3194](https://tree.taiga.io/project/penpot/issue/3194)
 - Edit file name navigates to the file workspace [Taiga #3183](https://tree.taiga.io/project/penpot/issue/3183)
 - Fix scroll into view behind fixed element [Taiga #3170](https://tree.taiga.io/project/penpot/issue/3170)
@@ -276,7 +386,7 @@
 - Fix duplicate multi selected elements [Taiga #3155](https://tree.taiga.io/project/penpot/issue/3155)
 - Fix add fills to artboard modify children [Taiga #3151](https://tree.taiga.io/project/penpot/issue/3151)
 - Avoid numeric inputs to allow big numbers [Taiga #2858](https://tree.taiga.io/project/penpot/issue/2858)
-- Fix component contex menu size [Taiga #2480](https://tree.taiga.io/project/penpot/issue/2480)
+- Fix component context menu size [Taiga #2480](https://tree.taiga.io/project/penpot/issue/2480)
 - Add shadow to artboard make it lose the fill [Taiga #3139](https://tree.taiga.io/project/penpot/issue/3139)
 - Avoid numeric inputs to change its value without focusing them [Taiga #3140](https://tree.taiga.io/project/penpot/issue/3140)
 - Fix comments modal when changing pages [Taiga #2597](https://tree.taiga.io/project/penpot/issue/2508)
@@ -405,7 +515,7 @@
 
 - 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 writing 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
@@ -517,7 +627,7 @@
 
 ## 1.10.4-beta
 
-### :sparkles: Enhacements
+### :sparkles: Enhancements
 
 - Allow parametrice file snapshoting interval
 
@@ -529,7 +639,7 @@
 
 ## 1.10.3-beta
 
-### :sparkles: Enhacements
+### :sparkles: Enhancements
 
 - Make all logging asynchronous, this avoid some overhead on jetty threads at cost of logging latency.
 - Increase default session time to 15 days.
@@ -865,7 +975,7 @@
 
 - Add better auth module logging.
 - Add missing `email` scope to OIDC backend.
-- Add missing cause prop on error loging.
+- Add missing cause prop on error logging.
 - Fix empty font-family handling on custom fonts page.
 - Fix incorrect unicode code points handling on draft-to-penpot conversion.
 - Fix some problems with paths.

CONTRIBUTING.md

@@ -99,7 +99,7 @@ Each commit should have:
 - An entry on the CHANGES.md file if applicable, referencing the
   github or taiga issue/user-story using the these same rules.
 
-Examples of good commit messags:
+Examples of good commit messages:
 
 - :bug: Fix unexpected error on launching modal
 - :bug: Set proper error message on generic error

README.md

@@ -12,76 +12,122 @@
 <a href="https://tree.taiga.io/project/penpot/" title="Managed with Taiga.io" rel="nofollow"><img src="https://camo.githubusercontent.com/4a1d1112f0272e3393b1e8da312ff4435418e9e2eb4c0964881e3680f90a653c/68747470733a2f2f696d672e736869656c64732e696f2f62616467652f6d616e61676564253230776974682d54414947412e696f2d3730396631342e737667" alt="Managed with Taiga.io" data-canonical-src="https://img.shields.io/badge/managed%20with-TAIGA.io-709f14.svg" style="max-width:100%;"></a>
 <a href="https://gitpod.io/#https://github.com/penpot/penpot" rel="nofollow"><img src="https://camo.githubusercontent.com/daadb4894128d1e19b72d80236f5959f1f2b47f9fe081373f3246131f0189f6c/68747470733a2f2f696d672e736869656c64732e696f2f62616467652f476974706f642d72656164792d2d746f2d2d636f64652d626c75653f6c6f676f3d676974706f64" alt="Gitpod ready-to-code" data-canonical-src="https://img.shields.io/badge/Gitpod-ready--to--code-blue?logo=gitpod" style="max-width:100%;"></a></p>
 
-![PENPOT](https://penpot.app/images/readme/home-ui.jpg)
+<p align="center">
+    <a href="https://penpot.app/"><b>Website</b></a> •
+    <a href="https://help.penpot.app/technical-guide/getting-started/"><b>Getting Started</b></a> •
+    <a href="https://help.penpot.app/user-guide/"><b>User Guide</b></a> •
+    <a href="https://help.penpot.app/user-guide/introduction/info/"><b>Tutorials & Info</b></a> •
+    <a href="https://community.penpot.app/"><b>Community</b></a> •
+    <a href="https://twitter.com/penpotapp"><b>Twitter</b></a> •
+    <a href="https://instagram.com/penpot.app"><b>Instagram</b></a> •
+    <a href="https://fosstodon.org/@penpot/"><b>Mastodon</b></a> •
+    <a href="https://www.youtube.com/channel/UCAqS8G72uv9P5HG1IfgnQ9g"><b>Youtube</b></a>
+</p>
 
+![feature-readme](https://user-images.githubusercontent.com/1045247/189871786-0b44f7cf-3a0a-4445-a87b-9919ec398bf7.gif)
 
-## What is Penpot? ##
+Penpot is the first **Open Source** design and prototyping platform meant for cross-domain teams. Non dependent on operating systems, Penpot is web based and works with open standards (SVG). Penpot invites designers all over the world to fall in love with open source while getting developers excited about the design process in return.
 
-Penpot is the first **Open Source design** and prototyping platform meant for cross-domain teams. Non dependent on operating systems, Penpot is web based and works with open web standards (SVG). For all and empowered by the community.
+## Table of contents ##
 
-- [How to use](#how-to-use)
-- [Help center](#help-center)
-- [Contributing](#contributing)
-- [Give feedback](#give-feedback)
-- [Tutorials](#tutorials)
+- [Why Penpot](#why-penpot)
+- [Getting Started](#getting-started)
+- [Community](#community)
+- [Resources](#resources)
 - [License](#license)
 
-## How to use ##
+## Why Penpot ##
 
-Login or Register on our Penpot cloud app. Create a team to work together on projects and share design assets or jump right away into Penpot and **start designing** by your own.
+Penpot makes design and prototyping accessible to every team in the world.
 
-✏️ [Start using Penpot](https://design.penpot.app)
+### For cross-domain teams ###
+We have a clear focus on design and code teams and our capabilities reflect exactly that. The less hand-off mindset, the more fun for everyone.
 
-You can also install Penpot in a local environment. This section details everything you need to know to get Penpot up and running in production environments. Although it can be installed in many ways, the recommended approach is using **docker** and **docker-compose**.
+### Multiplatform ###
+Being web based, Penpot is not dependent on operating systems or local installations, you will only need to run a modern browser.
 
-🐳 [Install docker](https://help.penpot.app/technical-guide/getting-started/)
-
-## Help center ##
-
-In this documentation you will find (almost) everything you need to know about how to work with Penpot. From the interface basics to advanced functionality.
-
-📖 [User guide](https://help.penpot.app/user-guide/)
-
-❓ [FAQs](https://help.penpot.app/faqs/)
-
-🖥️ [Technical guide](https://help.penpot.app/technical-guide/)
-
-❤️ [Contributing guide](https://help.penpot.app/contributing-guide/)
-
-![User guide](https://penpot.app/images/readme/help-center.jpg)
-
-## Contributing ##
+### Open Standards ###
+Using SVG as no other design and prototyping tool does, Penpot files sport compatibility with most of the vectorial tools, are tech friendly and extremely easy to use on the web. We make sure you will always own your work.
 
 <p align="center">
   <img src="https://penpot.app/images/open-source.png" alt="Open Source">
 </p>
 
-**Open to you!**
 
-We love the open source software community. Contributing is our
-passion and because of this, we'll be glad if you want to participate
-and improve Penpot. All your awesome ideas and code are welcome!
+## Getting started ##
 
-Please refer to the [Contributing Guide](./CONTRIBUTING.md)
+### Install with Elestio ###
+[Elestio](https://elest.io/) offers a fully managed service for on-premise instances of a selection of open-source software! This means you can deploy a dedicated instance of Penpot in just 3 minutes with no technical knowledge needed.
 
-## Give feedback ##
+You don’t need to worry about DNS configuration, SMTP, backups, SSL certificates, OS & Penpot upgrades, and much more.
+
+[Get started with Elestio.](https://help.penpot.app/technical-guide/getting-started/#install-with-elestio)
+
+### Install with Docker ###
+
+You can also get started with Penpot locally or self-host it with **docker** and **docker-compose**.
+
+Here’s a step-by-step guide on [getting started with Docker.](https://help.penpot.app/technical-guide/getting-started/#install-with-docker)
+
+### Penpot cloud app ###
+
+If you prefer not to install Penpot in a local environment, [login or register on our Penpot cloud app](https://design.penpot.app). Create a team to work together on projects and share design assets or jump right away into Penpot and **start designing** on your own.
+
+<p align="center">
+  <img src="https://help.penpot.app/img/home-techguide.png" alt="Getting started">
+</p>
+
+## Community ##
+
+We love the open source software community. Contributing is our passion and if it’s yours too, [participate](https://community.penpot.app/) and [improve](https://community.penpot.app/c/help-us-improve-penpot/7) Penpot. All your ideas and code are welcome!
+
+If you need help or have any questions; if you’d like to share your experience using Penpot or get inspired; if you’d rather meet our community of developers and designers, [join our Community](https://community.penpot.app/)!
+
+You will find the following categories:
+- [Ask the Community](https://community.penpot.app/c/ask-for-help-using-penpot/6)
+- [Troubleshooting](https://community.penpot.app/c/technical/8)
+- [Help us Improve Penpot](https://community.penpot.app/c/help-us-improve-penpot/7)
+- [#MadeWithPenpot](https://community.penpot.app/c/madewithpenpot/9)
+- [Events and Announcements](https://community.penpot.app/c/announcements/5)
+- [Inside Penpot](https://community.penpot.app/c/inside-penpot/21)
+- [Penpot in your language](https://community.penpot.app/c/penpot-in-your-language/12)
+
+<p align="center">
+  <img src="https://penpot.app/images/cross-teams.webp" alt="Community">
+</p>
+
+## Contributing ##
+
+Every sort of contribution will be very helpful to enhance Penpot. How you’ll participate? All your ideas, designs and code are welcome:
+
+- Invite your [team to join](https://design.penpot.app/#/auth/register)
+- Star this repo and follow us on Social Media:  [Twitter](https://twitter.com/penpotapp), [Instagram](https://instagram.com/penpot.app), [Youtube](https://www.youtube.com/c/Penpot) or [Mastodon](https://fosstodon.org/@penpot/).
+- Participate in the [Community](https://community.penpot.app/) asking and answering questions, reacting to others’ articles or opening your own conversations.
+- Report bugs with our easy [guide for bugs hunting](https://help.penpot.app/contributing-guide/reporting-bugs/) or [GitHub issues](https://github.com/penpot/penpot/issues)
+- Create and [share Libraries & templates](https://penpot.app/libraries-templates.html) that will be helpful for the community
+- Become a [translator](https://help.penpot.app/contributing-guide/translations)
+- Give feedback: [Mail us](mailto:support@penpot.app)
+
+To find (almost) everything you need to know on how to contribute to Penpot, refer to the [contributing-guide](https://help.penpot.app/contributing-guide/).
+
+<p align="center">
+  <img src="https://help.penpot.app/img/home-contributing.png" alt="Contributing">
+</p>
+
+## Resources ##
 
 You can ask and answer questions, have open-ended conversations, and follow along on decisions affecting the project.
 
-✉️ [Mail us](mailto:info@penpot.app)
+💾 [Documentation](https://help.penpot.app/technical-guide/)
 
-💬 [GitHub discussions](https://github.com/penpot/penpot/discussions)
+🚀 [Getting Started](https://help.penpot.app/technical-guide/getting-started/)
 
-🐞 [GitHub issues](https://github.com/penpot/penpot/issues)
+✏️ [Tutorials](https://www.youtube.com/playlist?list=PLgcCPfOv5v54WpXhHmNO7T-YC7AE-SRsr)
 
-✍️️ [Gitter](https://gitter.im/penpot/community)
+🏘️ [Architecture](https://help.penpot.app/technical-guide/architecture/)
 
-## Tutorials ##
+📚 [Dev Diaries](https://penpot.app/dev-diaries.html)
 
-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)
 
 ## License ##
 
@@ -90,5 +136,6 @@ 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
+Copyright (c) KALEIDOS INC
 ```
+Penpot is a Kaleidos’ [open source project](https://kaleidos.net/products)

THANKYOU.md

@@ -0,0 +1,97 @@
+# THANK YOU
+
+We want to thank to the amazing people that help us! Thank you! You're the best!
+
+## Security
+* Husnain Iqbal (CEO OF ALPHA INFERNO PVT LTD)
+* [Shiraz Ali Khan](https://www.linkedin.com/in/shiraz-ali-khan-1ba508180/)
+
+## Internationalization
+* [00ff88](https://hosted.weblate.org/user/00ff88)
+* [AhmadHB](https://hosted.weblate.org/user/AhmadHB)
+* [Aimee](https://hosted.weblate.org/user/Aimee)
+* [alejandro.alonso](alejandro.https://hosted.weblate.org/user/alonso)
+* [alexpawlak](https://hosted.weblate.org/user/alexpawlak)
+* [allytiago](https://hosted.weblate.org/user/allytiago)
+* [alonso.torres](alonso.https://hosted.weblate.org/user/torres)
+* [andres.moya](andres.https://hosted.weblate.org/user/moya)
+* [antoniofsm](https://hosted.weblate.org/user/antoniofsm)
+* [ascarida](https://hosted.weblate.org/user/ascarida)
+* [Bechii](https://hosted.weblate.org/user/Bechii)
+* [Beeby](https://hosted.weblate.org/user/Beeby)
+* [bingling-sama](bingling-https://hosted.weblate.org/user/sama)
+* [devadarta](https://hosted.weblate.org/user/devadarta)
+* [diacritica](https://hosted.weblate.org/user/diacritica)
+* [dundzys.vincas](dundzys.https://hosted.weblate.org/user/vincas)
+* [Eranot](https://hosted.weblate.org/user/Eranot)
+* [erral](https://hosted.weblate.org/user/erral)
+* [ersen](https://hosted.weblate.org/user/ersen)
+* [filipepessanha](https://hosted.weblate.org/user/filipepessanha)
+* [fortx](https://hosted.weblate.org/user/fortx)
+* [foxbit](https://hosted.weblate.org/user/foxbit)
+* [georgelemon](https://hosted.weblate.org/user/georgelemon)
+* [girafic](https://hosted.weblate.org/user/girafic)
+* [gizemb](https://hosted.weblate.org/user/gizemb)
+* [greench](https://hosted.weblate.org/user/greench)
+* [guidimas](https://hosted.weblate.org/user/guidimas)
+* [hfigueira_1](https://hosted.weblate.org/user/hfigueira_1)
+* [hifiaz](https://hosted.weblate.org/user/hifiaz)
+* [httpsterio](https://hosted.weblate.org/user/httpsterio)
+* [humteus](https://hosted.weblate.org/user/humteus)
+* [iblueer](https://hosted.weblate.org/user/iblueer)
+* [insan](https://hosted.weblate.org/user/insan)
+* [Iphi](https://hosted.weblate.org/user/Iphi)
+* [iWangJiaxiang](https://hosted.weblate.org/user/iWangJiaxiang)
+* [jancborchardt](https://hosted.weblate.org/user/jancborchardt)
+* [jazz](https://hosted.weblate.org/user/jazz)
+* [johnterroa](https://hosted.weblate.org/user/johnterroa)
+* [jponsa](https://hosted.weblate.org/user/jponsa)
+* [kapler](https://hosted.weblate.org/user/kapler)
+* [kingu](https://hosted.weblate.org/user/kingu)
+* [KnahkAmath](https://hosted.weblate.org/user/KnahkAmath)
+* [laminne](https://hosted.weblate.org/user/laminne)
+* [lenildoleite](https://hosted.weblate.org/user/lenildoleite)
+* [liimee](https://hosted.weblate.org/user/liimee)
+* [lixeix](https://hosted.weblate.org/user/lixeix)
+* [locness3](https://hosted.weblate.org/user/locness3)
+* [maiwann](https://hosted.weblate.org/user/maiwann)
+* [MidooDj](https://hosted.weblate.org/user/MidooDj)
+* [Mohamed_amine_gdoura](https://hosted.weblate.org/user/Mohamed_amine_gdoura)
+* [myfunnyandy](https://hosted.weblate.org/user/myfunnyandy)
+* [NampoinaRal](https://hosted.weblate.org/user/NampoinaRal)
+* [nautilusx](https://hosted.weblate.org/user/nautilusx)
+* [niwinz](https://hosted.weblate.org/user/niwinz)
+* [pablo.alba](pablo.https://hosted.weblate.org/user/alba)
+* [PhilippeAccorsi](https://hosted.weblate.org/user/PhilippeAccorsi)
+* [rnarius](https://hosted.weblate.org/user/rnarius)
+* [rnd](https://hosted.weblate.org/user/rnd)
+* [RuanAragao](https://hosted.weblate.org/user/RuanAragao)
+* [ruben](https://hosted.weblate.org/user/ruben)
+* [semonxue](https://hosted.weblate.org/user/semonxue)
+* [shahab](https://hosted.weblate.org/user/shahab)
+* [shuaib85](https://hosted.weblate.org/user/shuaib85)
+* [SiderealArt](https://hosted.weblate.org/user/SiderealArt)
+* [swapnil.cx](swapnil.https://hosted.weblate.org/user/cx)
+* [syuza](https://hosted.weblate.org/user/syuza)
+* [th3ph4nt0m](https://hosted.weblate.org/user/th3ph4nt0m)
+* [tiwb](https://hosted.weblate.org/user/tiwb)
+* [tommi](https://hosted.weblate.org/user/tommi)
+* [val](https://hosted.weblate.org/user/val)
+* [vikt](https://hosted.weblate.org/user/vikt)
+* [VinLin](https://hosted.weblate.org/user/VinLin)
+* [vintprox](https://hosted.weblate.org/user/vintprox)
+* [Voxybuns](https://hosted.weblate.org/user/Voxybuns)
+* [winie](https://hosted.weblate.org/user/winie)
+* [Yaron](https://hosted.weblate.org/user/Yaron)
+* [yrd](https://hosted.weblate.org/user/yrd)
+* [YukiYuigishi](https://hosted.weblate.org/user/YukiYuigishi)
+* [zcraber](https://hosted.weblate.org/user/zcraber)
+
+## Libraries & templates
+* systxema
+* plumilla
+* victor crespo
+* xtech
+* candidexmedia
+* merih güz
+* klarr agency

backend/build.clj

@@ -33,4 +33,4 @@
    {:src-dirs ["dev/java"]
     :class-dir class-dir
     :basis basis
-    :javac-opts ["-source" "11" "-target" "11"]}))
+    :javac-opts ["-source" "17" "-target" "17"]}))

backend/deps.edn

@@ -6,52 +6,56 @@
   ;; Logging
   org.zeromq/jeromq {:mvn/version "0.5.2"}
 
-  com.taoensso/nippy {:mvn/version "3.1.1"}
-  com.github.luben/zstd-jni {:mvn/version "1.5.2-3"}
+  com.github.luben/zstd-jni {:mvn/version "1.5.2-4"}
   org.clojure/data.fressian {:mvn/version "1.0.0"}
 
-  io.prometheus/simpleclient {:mvn/version "0.15.0"}
-  io.prometheus/simpleclient_hotspot {:mvn/version "0.15.0"}
-  io.prometheus/simpleclient_jetty {:mvn/version "0.15.0"
-                                    :exclusions [org.eclipse.jetty/jetty-server
-                                                 org.eclipse.jetty/jetty-servlet]}
-  io.prometheus/simpleclient_httpserver {:mvn/version "0.15.0"}
+  io.prometheus/simpleclient {:mvn/version "0.16.0"}
+  io.prometheus/simpleclient_hotspot {:mvn/version "0.16.0"}
+  io.prometheus/simpleclient_jetty
+  {:mvn/version "0.16.0"
+   :exclusions [org.eclipse.jetty/jetty-server
+                org.eclipse.jetty/jetty-servlet]}
 
-  io.lettuce/lettuce-core {:mvn/version "6.1.8.RELEASE"}
+  io.prometheus/simpleclient_httpserver {:mvn/version "0.16.0"}
+
+  io.lettuce/lettuce-core {:mvn/version "6.2.1.RELEASE"}
   java-http-clj/java-http-clj {:mvn/version "0.4.3"}
 
-  funcool/yetti {:git/tag "v9.8" :git/sha "fbe1d7d"
-                 :git/url "https://github.com/funcool/yetti.git"
-                 :exclusions [org.slf4j/slf4j-api]}
+  funcool/yetti
+  {:git/tag "v9.11"
+   :git/sha "6f9197a"
+   :git/url "https://github.com/funcool/yetti.git"
+   :exclusions [org.slf4j/slf4j-api]}
 
-  com.github.seancorfield/next.jdbc {:mvn/version "1.2.780"}
+  com.github.seancorfield/next.jdbc {:mvn/version "1.3.834"}
   metosin/reitit-core {:mvn/version "0.5.18"}
-  org.postgresql/postgresql {:mvn/version "42.4.0"}
+  org.postgresql/postgresql {:mvn/version "42.5.0"}
   com.zaxxer/HikariCP {:mvn/version "5.0.1"}
 
-  funcool/datoteka {:mvn/version "3.0.64"}
   io.whitfin/siphash {:mvn/version "2.0.0"}
 
   buddy/buddy-hashers {:mvn/version "1.8.158"}
   buddy/buddy-sign {:mvn/version "3.4.333"}
 
+  com.github.ben-manes.caffeine/caffeine {:mvn/version "3.1.1"}
+
   org.jsoup/jsoup {:mvn/version "1.15.1"}
-  org.im4java/im4java {:git/tag "1.4.0-penpot-2" :git/sha "e2b3e16"
-                       :git/url "https://github.com/penpot/im4java"}
+  org.im4java/im4java
+  {:git/tag "1.4.0-penpot-2"
+   :git/sha "e2b3e16"
+   :git/url "https://github.com/penpot/im4java"}
 
   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.6.1"}
-
   dawran6/emoji {:mvn/version "0.1.5"}
-  markdown-clj/markdown-clj {:mvn/version "1.11.1"}
+  markdown-clj/markdown-clj {:mvn/version "1.11.3"}
 
   ;; Pretty Print specs
   pretty-spec/pretty-spec {:mvn/version "0.1.4"}
-  software.amazon.awssdk/s3 {:mvn/version "2.17.272"}}
+  software.amazon.awssdk/s3 {:mvn/version "2.17.278"}}
 
  :paths ["src" "resources" "target/classes"]
  :aliases
@@ -59,7 +63,6 @@
   {:extra-deps
    {com.bhauman/rebel-readline {:mvn/version "RELEASE"}
     org.clojure/tools.namespace {:mvn/version "RELEASE"}
-    org.clojure/test.check {: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"}
@@ -67,15 +70,15 @@
    :extra-paths ["test" "dev"]}
 
   :build
-  {:extra-deps
-   {io.github.clojure/tools.build {:git/tag "v0.8.2" :git/sha "ba1a2bf"}}
+  {:extra-deps {io.github.clojure/tools.build {:git/tag "v0.8.3" :git/sha "0d20256"}}
    :ns-default build}
 
   :test
   {:extra-paths ["test"]
    :extra-deps
    {io.github.cognitect-labs/test-runner
-    {:git/tag "v0.5.0" :git/sha "b3fd0d2"}}
+    {:git/tag "v0.5.1" :git/sha "dfb30dd"}}
+   :main-opts ["-m" "cognitect.test-runner"]
    :exec-fn cognitect.test-runner.api/test}
 
   :outdated

backend/dev/script-fix-sobjects.clj

@@ -2,7 +2,7 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 ;; This is an example on how it can be executed:
 ;; clojure -Scp $(cat classpath) -M dev/script-fix-sobjects.clj

backend/dev/user.clj

@@ -2,17 +2,23 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns user
   (:require
    [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.geom.matrix :as gmt]
+   [app.common.logging :as l]
    [app.common.perf :as perf]
+   [app.common.pprint :as pp]
+   [app.common.spec :as us]
    [app.common.transit :as t]
+   [app.common.uuid :as uuid]
    [app.config :as cfg]
    [app.main :as main]
+   [app.srepl.helpers]
+   [app.srepl.main :as srepl]
    [app.util.blob :as blob]
    [app.util.fressian :as fres]
    [app.util.json :as json]
@@ -23,10 +29,13 @@
    [clojure.pprint :refer [pprint print-table]]
    [clojure.repl :refer :all]
    [clojure.spec.alpha :as s]
-   [clojure.spec.gen.alpha :as sgen]
+   [clojure.stacktrace :as trace]
    [clojure.test :as test]
+   [clojure.test.check.generators :as gen]
    [clojure.tools.namespace.repl :as repl]
    [clojure.walk :refer [macroexpand-all]]
+   [criterium.core  :as crit]
+   [cuerdas.core :as str]
    [datoteka.core]
    [integrant.core :as ig]))
 
@@ -35,10 +44,28 @@
 
 (defonce system nil)
 
+;; --- Benchmarking Tools
+
+(defmacro run-quick-bench
+  [& exprs]
+  `(crit/with-progress-reporting (crit/quick-bench (do ~@exprs) :verbose)))
+
+(defmacro run-quick-bench'
+  [& exprs]
+  `(crit/quick-bench (do ~@exprs)))
+
+(defmacro run-bench
+  [& exprs]
+  `(crit/with-progress-reporting (crit/bench (do ~@exprs) :verbose)))
+
+(defmacro run-bench'
+  [& exprs]
+  `(crit/bench (do ~@exprs)))
+
 ;; --- Development Stuff
 
 (defn- run-tests
-  ([] (run-tests #"^app.*-test$"))
+  ([] (run-tests #"^backend-tests.*-test$"))
   ([o]
    (repl/refresh)
    (cond
@@ -53,19 +80,22 @@
 
 (defn- start
   []
-  (alter-var-root #'system (fn [sys]
-                             (when sys (ig/halt! sys))
-                             (-> main/system-config
-                                 (ig/prep)
-                                 (ig/init))))
-  :started)
+  (try
+    (alter-var-root #'system (fn [sys]
+                               (when sys (ig/halt! sys))
+                               (-> (merge main/system-config main/worker-config)
+                                   (ig/prep)
+                                   (ig/init))))
+    :started
+    (catch Throwable cause
+      (ex/print-throwable cause))))
 
 (defn- stop
   []
   (alter-var-root #'system (fn [sys]
                              (when sys (ig/halt! sys))
                              nil))
-  :stoped)
+  :stopped)
 
 (defn restart
   []
@@ -79,12 +109,20 @@
 
 (defn compression-bench
   [data]
-  (let [humanize (fn [v] (hum/filesize v :binary true :format " %.4f "))]
+  (let [humanize (fn [v] (hum/filesize v :binary true :format " %.4f "))
+        v1 (time (humanize (alength (blob/encode data {:version 1}))))
+        v3 (time (humanize (alength (blob/encode data {:version 3}))))
+        v4 (time (humanize (alength (blob/encode data {:version 4}))))
+        v5 (time (humanize (alength (blob/encode data {:version 5}))))
+        v6 (time (humanize (alength (blob/encode data {:version 6}))))
+        ]
     (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})))
+     [{
+       :v1 v1
+       :v3 v3
+       :v4 v4
+       :v5 v5
+       :v6 v6
        }])))
 
 (defonce debug-tap

backend/resources/app/onboarding.edn

@@ -0,0 +1,36 @@
+[{:id "tutorial-for-beginners"
+  :name "Tutorial for beginners"
+  :thumbnail-uri "https://penpot.app/images/libraries/tutorial-for-beginners.jpg"
+  :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/tutorial-for-beginners.penpot"}
+ {:id "penpot-design-system"
+  :name "Penpot Design System"
+  :thumbnail-uri "https://penpot.app/images/libraries/cover-ds-penpot.jpg"
+  :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/Penpot-Design-system.penpot"}
+ {:id "wireframing-kit"
+  :name "Wireframing Kit"
+  :thumbnail-uri "https://penpot.app/images/libraries/cover-wireframes.jpg"
+  :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/wireframing-kit.penpot"}
+ {:id "ant-design"
+  :name "Ant Design UI Kit (lite)"
+  :thumbnail-uri "https://penpot.app/images/libraries/cover-ant-design.jpg"
+  :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/Ant-Design-UI-Kit-Lite.penpot"}
+ {:id "cocomaterial"
+  :name "Cocomaterial"
+  :thumbnail-uri "https://penpot.app/images/libraries/cover-cocomaterial.jpg"
+  :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/Cocomaterial.penpot"}
+ {:id "circum-icons"
+  :name "Circum Icons pack"
+  :thumbnail-uri "https://penpot.app/images/libraries/cover-circum.jpg"
+  :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/CircumIcons.penpot"}
+ {:id "coreui"
+  :name "CoreUI"
+  :thumbnail-uri "https://penpot.app/images/libraries/cover-coreui.jpg"
+  :file-uri "https://github.com/penpot/penpot-files/raw/main/CoreUI%20DesignSystem%20(DEMO).penpot"}
+ {:id "whiteboarding-kit"
+  :name "Whiteboarding Kit"
+  :thumbnail-uri "https://penpot.app/images/libraries/cover-whiteboards.jpg"
+  :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/Whiteboarding-mapping-kit.penpot"}
+ {:id "material-design-baseline"
+  :name "Material Design (baseline)"
+  :thumbnail-uri "https://penpot.app/images/libraries/cover-material.jpg"
+  :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/Material-Design-Kit.penpot"}]

backend/resources/app/templates/api-doc.tmpl

@@ -10,10 +10,10 @@
     <link rel="preconnect" href="https://fonts.gstatic.com" crossorigin>
     <link href="https://fonts.googleapis.com/css2?family=JetBrains+Mono:wght@200;300;400;500;700&display=swap" rel="stylesheet">
     <style>
-      {% include "api-doc.css" %}
+      {% include "app/templates/api-doc.css" %}
     </style>
     <script>
-      {% include "api-doc.js" %}
+      {% include "app/templates/api-doc.js" %}
     </script>
   </head>
   <body>
@@ -26,21 +26,21 @@
         <h2>RPC COMMAND METHODS:</h2>
         <ul class="rpc-items">
           {% for item in command-methods %}
-            {% include "api-doc-entry.tmpl" with item=item %}
+            {% include "app/templates/api-doc-entry.tmpl" with item=item %}
           {% endfor %}
         </ul>
 
         <h2>RPC QUERY METHODS:</h2>
         <ul class="rpc-items">
           {% for item in query-methods %}
-            {% include "api-doc-entry.tmpl" with item=item %}
+            {% include "app/templates/api-doc-entry.tmpl" with item=item %}
           {% endfor %}
         </ul>
 
         <h2>RPC MUTATION METHODS:</h2>
         <ul class="rpc-items">
           {% for item in mutation-methods %}
-            {% include "api-doc-entry.tmpl" with item=item %}
+            {% include "app/templates/api-doc-entry.tmpl" with item=item %}
           {% endfor %}
         </ul>
       </section>

backend/resources/app/templates/base.tmpl

@@ -7,7 +7,7 @@
     <title>{% block title %}{% endblock %}</title>
     <link rel="stylesheet" href="https://fonts.googleapis.com/css2?family=JetBrains+Mono">
     <style>
-      {% include "templates/styles.css"  %}
+      {% include "app/templates/styles.css"  %}
     </style>
   </head>
   <body>

backend/resources/app/templates/debug.tmpl

@@ -1,4 +1,4 @@
-{% extends "templates/base.tmpl" %}
+{% extends "app/templates/base.tmpl" %}
 
 {% block title %}
 Debug Main Page
@@ -77,7 +77,7 @@ Debug Main Page
       <legend>Import binfile:</legend>
       <desc>Import penpot file in binary
       format. If <strong>overwrite</strong> is checked, all files will
-      be overwriten using the same ids found in the file instead of
+      be overwritten using the same ids found in the file instead of
       generating a new ones.</desc>
 
       <form method="post" enctype="multipart/form-data" action="/dbg/file/import">
@@ -90,7 +90,7 @@ Debug Main Page
           <input type="checkbox" name="overwrite" />
           <br />
           <small>
-            Instead of creating a new file with all relations remaped,
+            Instead of creating a new file with all relations remapped,
             reuses all ids and updates/overwrites the objects that are
             already exists on the database.
             <strong>Warning, this operation should be used with caution.</strong>
@@ -111,7 +111,7 @@ Debug Main Page
           <input type="checkbox" name="ignore-index-errors" checked/>
           <br />
           <small>
-            Do not break on index lookup erros (remap operation).
+            Do not break on index lookup errors (remap operation).
             Useful when importing a broken file that has broken
             relations or missing pieces.
           </small>

backend/resources/app/templates/error-list.tmpl

@@ -1,4 +1,4 @@
-{% extends "templates/base.tmpl" %}
+{% extends "app/templates/base.tmpl" %}
 
 {% block title %}
 penpot - error list
@@ -11,7 +11,8 @@ penpot - error list
 <main class="horizontal-list">
   <ul>
     {% for item in items %}
-    <li><a href="/dbg/error/{{item.id}}">{{item.created-at}}</a></li>
+    <li><a class="date" href="/dbg/error/{{item.id}}">{{item.created-at}}</a> 
+        <span class="title">{{item.hint|abbreviate:150}}</span></li>
     {% endfor %}
   </ul>
 </main>

backend/resources/app/templates/error-report.tmpl

@@ -1,4 +1,4 @@
-{% extends "templates/base.tmpl" %}
+{% extends "app/templates/base.tmpl" %}
 
 {% block title %}
 penpot - error report {{id}}

backend/resources/app/templates/styles.css

@@ -137,8 +137,6 @@ nav > div:not(:last-child) {
   margin: 0px;
   padding: 0px;
   flex-direction: column;
-  flex-wrap: wrap;
-  height: calc(100vh - 75px);
   justify-content: flex-start;
 }
 
@@ -151,19 +149,31 @@ nav > div:not(:last-child) {
   margin: 0px 20px;
   cursor: pointer;
   display: flex;
-  justify-content: center;
   border-radius: 3px;
 }
 
+
+
 .horizontal-list li:hover {
   background-color: #e9e9e9;
 }
 
+.horizontal-list li > *:not(:last-child) {
+  margin-right: 10px;
+}
+
 .horizontal-list li > a {
   text-decoration: none;
   color: inherit;
 }
 
+.horizontal-list li > .date {
+  font-weight: 200;
+  color: #686868;
+  min-width: 210px;
+}
+
+
 form .row {
   padding: 5px 0;
 }

backend/resources/climit.edn

@@ -0,0 +1,9 @@
+;; Example climit.edn file
+;; Required: concurrency
+;; Optional: queue-size, ommited means Integer/MAX_VALUE
+{:update-file   {:concurrency 1 :queue-size 3}
+ :auth          {:concurrency 128}
+ :process-font  {:concurrency 4 :queue-size 32}
+ :process-image {:concurrency 8 :queue-size 32}
+ :push-audit-events
+ {:concurrency 1 :queue-size 3}}

backend/resources/log4j2-devenv.xml

@@ -2,11 +2,13 @@
 <Configuration status="info" monitorInterval="30">
   <Appenders>
     <Console name="console" target="SYSTEM_OUT">
-      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"/>
+      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"
+                     alwaysWriteExceptions="false" />
     </Console>
 
     <RollingFile name="main" fileName="logs/main.log" filePattern="logs/main-%i.log">
-      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"/>
+      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"
+                     alwaysWriteExceptions="false" />
       <Policies>
         <SizeBasedTriggeringPolicy size="50M"/>
       </Policies>
@@ -25,11 +27,15 @@
     <Logger name="org.postgresql" level="error" />
 
     <Logger name="app.rpc.commands.binfile" level="debug" />
-    <Logger name="app.storage.tmp" level="info" />
+    <Logger name="app.storage.tmp" level="debug" />
     <Logger name="app.worker" level="info" />
     <Logger name="app.msgbus" level="info" />
     <Logger name="app.http.websocket" level="info" />
     <Logger name="app.util.websocket" level="info" />
+    <Logger name="app.redis" level="info" />
+    <Logger name="app.rpc.rlimit" level="info" />
+    <Logger name="app.rpc.climit" level="info" />
+    <Logger name="app.rpc.mutations.files" level="info" />
 
     <Logger name="app.cli" level="debug" additivity="false">
       <AppenderRef ref="console"/>

backend/resources/log4j2.xml

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

backend/resources/rlimit.edn

@@ -0,0 +1,10 @@
+;; Example rlimit.edn file
+^{:refresh "30s"}
+{:default
+ [[:default :window "200000/h"]]
+
+ #{:query/teams}
+ [[:burst :bucket "5/1/5s"]]
+
+ #{:query/profile}
+ [[:burst :bucket "100/60/1m"]]}

backend/scripts/build

@@ -17,5 +17,6 @@ cp scripts/manage.template.sh target/dist/manage.sh;
 chmod +x target/dist/run.sh;
 chmod +x target/dist/manage.sh;
 
-
-
+# Prefetch
+bb ./scripts/prefetch-templates.clj resources/app/onboarding.edn builtin-templates/
+cp -r builtin-templates target/dist/

backend/scripts/kill-repl.sh

@@ -0,0 +1,4 @@
+#!/usr/bin/env bash
+set -x
+
+jcmd |grep "rebel" |sed -nE 's/^([0-9]+).*$/\1/p' | xargs kill -9

backend/scripts/prefetch-templates.clj

@@ -0,0 +1,40 @@
+#!/usr/bin/env bb
+
+(require '[babashka.curl :as curl]
+         '[babashka.fs :as fs])
+
+(defn download-if-needed!
+  [dest data]
+  (doseq [{:keys [id file-uri] :as item} data]
+    (let [file (fs/file dest id)
+          rsp  (curl/get file-uri {:as :stream})]
+
+      (when (not= 200 (:status rsp))
+        (println (format "unable to download %s (uri: %s)" id file-uri))
+        (System/exit -1))
+
+      (when-not (fs/exists? (str file))
+        (println (format "=> downloading %s" id))
+        (with-open [output (io/output-stream file)]
+          (io/copy (:body rsp) output))))))
+
+(defn read-defs-file
+  [path]
+  (with-open [content (io/reader path)]
+    (edn/read-string (slurp content))))
+
+(let [[path dest] *command-line-args*]
+  (when (or (nil? path)
+            (nil? dest))
+    (println "invalid arguments")
+    (System/exit -1))
+
+  (when-not (fs/exists? path)
+    (println (format "file %s does not exists" path))
+    (System/exit -1))
+
+  (when-not (fs/exists? dest)
+    (fs/create-dirs dest))
+
+  (let [data (read-defs-file path)]
+    (download-if-needed! dest data)))

backend/scripts/repl

@@ -2,7 +2,7 @@
 
 export PENPOT_HOST=devenv
 export PENPOT_TENANT=dev
-export PENPOT_FLAGS="$PENPOT_FLAGS enable-backend-asserts enable-audit-log enable-transit-readable-response enable-demo-users disable-secure-session-cookies"
+export PENPOT_FLAGS="$PENPOT_FLAGS enable-backend-asserts enable-audit-log enable-transit-readable-response enable-demo-users disable-secure-session-cookies enable-smtp"
 
 # export PENPOT_DATABASE_URI="postgresql://172.17.0.1:5432/penpot"
 # export PENPOT_DATABASE_USERNAME="penpot"
@@ -29,7 +29,7 @@ export PENPOT_STORAGE_ASSETS_S3_ENDPOINT=http://minio:9000
 export PENPOT_STORAGE_ASSETS_S3_BUCKET=penpot
 
 export OPTIONS="
-       -A:dev:jmx-remote \
+       -A:jmx-remote -A:dev \
        -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
        -J-Dlog4j2.configurationFile=log4j2-devenv.xml \
        -J-XX:+UseG1GC \

backend/scripts/run.template.sh

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

backend/scripts/start-dev

@@ -2,7 +2,7 @@
 
 export PENPOT_HOST=devenv
 export PENPOT_TENANT=dev
-export PENPOT_FLAGS="$PENPOT_FLAGS enable-backend-asserts enable-audit-log enable-transit-readable-response enable-demo-users disable-secure-session-cookies"
+export PENPOT_FLAGS="$PENPOT_FLAGS enable-backend-asserts enable-audit-log enable-transit-readable-response enable-demo-users disable-secure-session-cookies enable-smtp"
 
 set -ex
 

backend/src/app/auth/ldap.clj

@@ -2,7 +2,7 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.auth.ldap
   (:require

backend/src/app/auth/oidc.clj

@@ -2,11 +2,12 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.auth.oidc
   "OIDC client implementation."
   (:require
+   [app.auth.oidc.providers :as-alias providers]
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
@@ -15,9 +16,13 @@
    [app.common.uri :as u]
    [app.config :as cf]
    [app.db :as db]
+   [app.http.client :as http]
    [app.http.middleware :as hmw]
+   [app.http.session :as session]
    [app.loggers.audit :as audit]
+   [app.main :as-alias main]
    [app.rpc.queries.profile :as profile]
+   [app.tokens :as tokens]
    [app.util.json :as json]
    [app.util.time :as dt]
    [app.worker :as wrk]
@@ -45,9 +50,11 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn- discover-oidc-config
-  [{:keys [http-client]} {:keys [base-uri] :as opts}]
+  [cfg {:keys [::base-uri] :as opts}]
   (let [discovery-uri (u/join base-uri ".well-known/openid-configuration")
-        response      (ex/try (http-client {:method :get :uri (str discovery-uri)} {:sync? true}))]
+        response      (ex/try! (http/req! cfg
+                                          {:method :get :uri (str discovery-uri)}
+                                          {:sync? true}))]
     (cond
       (ex/exception? response)
       (do
@@ -57,7 +64,7 @@
         nil)
 
       (= 200 (:status response))
-      (let [data (json/read (:body response))]
+      (let [data (json/decode (:body response))]
         {:token-uri (get data :token_endpoint)
          :auth-uri  (get data :authorization_endpoint)
          :user-uri  (get data :userinfo_endpoint)})
@@ -71,15 +78,15 @@
 
 (defn- prepare-oidc-opts
   [cfg]
-  (let [opts {:base-uri      (:base-uri cfg)
-              :client-id     (:client-id cfg)
-              :client-secret (:client-secret cfg)
-              :token-uri     (:token-uri cfg)
-              :auth-uri      (:auth-uri cfg)
-              :user-uri      (:user-uri cfg)
-              :scopes        (:scopes cfg #{"openid" "profile" "email"})
-              :roles-attr    (:roles-attr cfg)
-              :roles         (:roles cfg)
+  (let [opts {:base-uri      (cf/get :oidc-base-uri)
+              :client-id     (cf/get :oidc-client-id)
+              :client-secret (cf/get :oidc-client-secret)
+              :token-uri     (cf/get :oidc-token-uri)
+              :auth-uri      (cf/get :oidc-auth-uri)
+              :user-uri      (cf/get :oidc-user-uri)
+              :scopes        (cf/get :oidc-scopes #{"openid" "profile" "email"})
+              :roles-attr    (cf/get :oidc-roles-attr)
+              :roles         (cf/get :oidc-roles)
               :name          "oidc"}
 
         opts (d/without-nils opts)]
@@ -94,13 +101,12 @@
         (some-> (discover-oidc-config cfg opts)
                 (merge opts {:discover? true}))))))
 
-(defmethod ig/prep-key ::generic-provider
-  [_ cfg]
-  (d/without-nils cfg))
+(defmethod ig/pre-init-spec ::providers/generic [_]
+  (s/keys :req [::http/client]))
 
-(defmethod ig/init-key ::generic-provider
+(defmethod ig/init-key ::providers/generic
   [_ cfg]
-  (when (:enabled? cfg)
+  (when (contains? cf/flags :login-with-oidc)
     (if-let [opts (prepare-oidc-opts cfg)]
       (do
         (l/info :hint "provider initialized"
@@ -108,10 +114,10 @@
                 :method (if (:discover? opts) "discover" "manual")
                 :client-id (:client-id opts)
                 :client-secret (obfuscate-string (:client-secret opts))
-                :scopes (str/join "," (:scopes opts))
-                :auth-uri (:auth-uri opts)
-                :user-uri (:user-uri opts)
-                :token-uri (:token-uri opts)
+                :scopes     (str/join "," (:scopes opts))
+                :auth-uri   (:auth-uri opts)
+                :user-uri   (:user-uri opts)
+                :token-uri  (:token-uri opts)
                 :roles-attr (:roles-attr opts)
                 :roles      (:roles opts))
         opts)
@@ -123,21 +129,17 @@
 ;; GOOGLE AUTH PROVIDER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defmethod ig/prep-key ::google-provider
-  [_ cfg]
-  (d/without-nils cfg))
-
-(defmethod ig/init-key ::google-provider
-  [_ cfg]
-  (let [opts {:client-id     (:client-id cfg)
-              :client-secret (:client-secret cfg)
+(defmethod ig/init-key ::providers/google
+  [_ _]
+  (let [opts {:client-id     (cf/get :google-client-id)
+              :client-secret (cf/get :google-client-secret)
               :scopes        #{"openid" "email" "profile"}
               :auth-uri      "https://accounts.google.com/o/oauth2/v2/auth"
               :token-uri     "https://oauth2.googleapis.com/token"
               :user-uri      "https://openidconnect.googleapis.com/v1/userinfo"
               :name          "google"}]
 
-    (when (:enabled? cfg)
+    (when (contains? cf/flags :login-with-google)
       (if (and (string? (:client-id opts))
                (string? (:client-secret opts)))
         (do
@@ -156,29 +158,29 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn- retrieve-github-email
-  [{:keys [http-client]} tdata info]
+  [cfg tdata info]
   (or (some-> info :email p/resolved)
-      (-> (http-client {:uri "https://api.github.com/user/emails"
-                        :headers {"Authorization" (dm/str (:type tdata) " " (:token tdata))}
-                        :timeout 6000
-                        :method :get})
-          (p/then (fn [{:keys [status body] :as response}]
+      (->> (http/req! cfg
+                      {:uri "https://api.github.com/user/emails"
+                       :headers {"Authorization" (dm/str (:type tdata) " " (:token tdata))}
+                       :timeout 6000
+                       :method :get})
+           (p/map (fn [{:keys [status body] :as response}]
                     (when-not (s/int-in-range? 200 300 status)
                       (ex/raise :type :internal
                                 :code :unable-to-retrieve-github-emails
                                 :hint "unable to retrieve github emails"
                                 :http-status status
                                 :http-body body))
-                    (->> response :body json/read (filter :primary) first :email))))))
+                    (->> response :body json/decode (filter :primary) first :email))))))
 
-(defmethod ig/prep-key ::github-provider
-  [_ cfg]
-  (d/without-nils cfg))
+(defmethod ig/pre-init-spec ::providers/github [_]
+  (s/keys :req [::http/client]))
 
-(defmethod ig/init-key ::github-provider
+(defmethod ig/init-key ::providers/github
   [_ cfg]
-  (let [opts {:client-id     (:client-id cfg)
-              :client-secret (:client-secret cfg)
+  (let [opts {:client-id     (cf/get :github-client-id)
+              :client-secret (cf/get :github-client-secret)
               :scopes        #{"read:user" "user:email"}
               :auth-uri      "https://github.com/login/oauth/authorize"
               :token-uri     "https://github.com/login/oauth/access_token"
@@ -189,7 +191,7 @@
               ;; retrieve emails.
               :get-email-fn           (partial retrieve-github-email cfg)}]
 
-    (when (:enabled? cfg)
+    (when (contains? cf/flags :login-with-github)
       (if (and (string? (:client-id opts))
                (string? (:client-secret opts)))
         (do
@@ -207,22 +209,18 @@
 ;; GITLAB AUTH PROVIDER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defmethod ig/prep-key ::gitlab-provider
-  [_ cfg]
-  (d/without-nils cfg))
-
-(defmethod ig/init-key ::gitlab-provider
-  [_ cfg]
-  (let [base (:base-uri cfg "https://gitlab.com")
+(defmethod ig/init-key ::providers/gitlab
+  [_ _]
+  (let [base (cf/get :gitlab-base-uri "https://gitlab.com")
         opts {:base-uri      base
-              :client-id     (:client-id cfg)
-              :client-secret (:client-secret cfg)
+              :client-id     (cf/get :gitlab-client-id)
+              :client-secret (cf/get :gitlab-client-secret)
               :scopes        #{"openid" "profile" "email"}
               :auth-uri      (str base "/oauth/authorize")
               :token-uri     (str base "/oauth/token")
               :user-uri      (str base "/oauth/userinfo")
               :name          "gitlab"}]
-    (when (:enabled? cfg)
+    (when (contains? cf/flags :login-with-gitlab)
       (if (and (string? (:client-id opts))
                (string? (:client-secret opts)))
         (do
@@ -243,7 +241,7 @@
 
 (defn- build-redirect-uri
   [{:keys [provider] :as cfg}]
-  (let [public (u/uri (:public-uri cfg))]
+  (let [public (u/uri (cf/get :public-uri))]
     (str (assoc public :path (str "/api/auth/oauth/" (:name provider) "/callback")))))
 
 (defn- build-auth-uri
@@ -266,7 +264,7 @@
              props))
 
 (defn retrieve-access-token
-  [{:keys [provider http-client] :as cfg} code]
+  [{:keys [provider] :as cfg} code]
   (let [params {:client_id (:client-id provider)
                 :client_secret (:client-secret provider)
                 :code code
@@ -277,26 +275,25 @@
                           "accept" "application/json"}
                 :uri (:token-uri provider)
                 :body (u/map->query-string params)}]
-    (p/then
-     (http-client req)
-     (fn [{:keys [status body] :as res}]
-       (if (= status 200)
-         (let [data (json/read body)]
-           {:token (get data :access_token)
-            :type (get data :token_type)})
-         (ex/raise :type :internal
-                   :code :unable-to-retrieve-token
-                   :http-status status
-                   :http-body body))))))
+    (->> (http/req! cfg req)
+         (p/map (fn [{:keys [status body] :as res}]
+                  (if (= status 200)
+                    (let [data (json/decode body)]
+                      {:token (get data :access_token)
+                       :type (get data :token_type)})
+                    (ex/raise :type :internal
+                              :code :unable-to-retrieve-token
+                              :http-status status
+                              :http-body body)))))))
 
 (defn- retrieve-user-info
-  [{:keys [provider http-client] :as cfg} tdata]
+  [{:keys [provider] :as cfg} tdata]
   (letfn [(retrieve []
-            (http-client {:uri (:user-uri provider)
-                          :headers {"Authorization" (str (:type tdata) " " (:token tdata))}
-                          :timeout 6000
-                          :method :get}))
-
+            (http/req! cfg
+                       {:uri (:user-uri provider)
+                        :headers {"Authorization" (str (:type tdata) " " (:token tdata))}
+                        :timeout 6000
+                        :method :get}))
           (validate-response [response]
             (when-not (s/int-in-range? 200 300 (:status response))
               (ex/raise :type :internal
@@ -319,7 +316,7 @@
               (get info attr-kw)))
 
           (process-response [response]
-            (p/let [info  (-> response :body json/read)
+            (p/let [info  (-> response :body json/decode)
                     email (get-email info)]
               {:backend  (:name provider)
                :email    email
@@ -353,7 +350,7 @@
                    ::props]))
 
 (defn retrieve-info
-  [{:keys [tokens provider] :as cfg} {:keys [params] :as request}]
+  [{:keys [provider] :as cfg} {:keys [params] :as request}]
   (letfn [(validate-oidc [info]
             ;; If the provider is OIDC, we can proceed to check
             ;; roles if they are defined.
@@ -392,7 +389,7 @@
 
     (let [state  (get params :state)
           code   (get params :code)
-          state  (tokens :verify {:token state :iss :oauth})]
+          state  (tokens/verify (::main/props cfg) {:token state :iss :oauth})]
       (-> (p/resolved code)
           (p/then #(retrieve-access-token cfg %))
           (p/then #(retrieve-user-info cfg %))
@@ -400,7 +397,7 @@
           (p/then' (partial post-process state))))))
 
 (defn- retrieve-profile
-  [{:keys [pool executor] :as cfg} info]
+  [{:keys [::db/pool ::wrk/executor] :as cfg} info]
   (px/with-dispatch executor
     (with-open [conn (db/open pool)]
       (some->> (:email info)
@@ -413,33 +410,36 @@
   (yrs/response :status 302 :headers {"location" (str uri)}))
 
 (defn- generate-error-redirect
-  [cfg error]
-  (let [uri (-> (u/uri (:public-uri cfg))
+  [_ error]
+  (let [uri (-> (u/uri (cf/get :public-uri))
                 (assoc :path "/#/auth/login")
                 (assoc :query (u/map->query-string {:error "unable-to-auth" :hint (ex-message error)})))]
     (redirect-response uri)))
 
 (defn- generate-redirect
-  [{:keys [tokens session audit] :as cfg} request info profile]
+  [{:keys [::session/session] :as cfg} request info profile]
   (if profile
-    (let [sxf    ((:create session) (:id profile))
+    (let [sxf    (session/create-fn session (:id profile))
           token  (or (:invitation-token info)
-                     (tokens :generate {:iss :auth
-                                        :exp (dt/in-future "15m")
-                                        :profile-id (:id profile)}))
+                     (tokens/generate (::main/props cfg)
+                                      {:iss :auth
+                                       :exp (dt/in-future "15m")
+                                       :profile-id (:id profile)}))
           params {:token token}
-
-          uri    (-> (u/uri (:public-uri cfg))
+          uri    (-> (u/uri (cf/get :public-uri))
                      (assoc :path "/#/auth/verify-token")
                      (assoc :query (u/map->query-string params)))]
 
-      (when (fn? audit)
-        (audit :cmd :submit
-               :type "mutation"
-               :name "login"
-               :profile-id (:id profile)
-               :ip-addr (audit/parse-client-ip request)
-               :props (audit/profile->props profile)))
+      (when (:is-blocked profile)
+        (ex/raise :type :restriction
+                  :code :profile-blocked))
+
+      (when-let [collector (::audit/collector cfg)]
+        (audit/submit! collector {:type "command"
+                                  :name "login"
+                                  :profile-id (:id profile)
+                                  :ip-addr (audit/parse-client-ip request)
+                                  :props (audit/profile->props profile)}))
 
       (->> (redirect-response uri)
            (sxf request)))
@@ -448,23 +448,23 @@
                         :iss :prepared-register
                         :is-active true
                         :exp (dt/in-future {:hours 48}))
-          token  (tokens :generate info)
+          token  (tokens/generate (::main/props cfg) info)
           params (d/without-nils
                   {:token token
                    :fullname (:fullname info)})
-          uri    (-> (u/uri (:public-uri cfg))
+          uri    (-> (u/uri (cf/get :public-uri))
                      (assoc :path "/#/auth/register/validate")
                      (assoc :query (u/map->query-string params)))]
       (redirect-response uri))))
 
 (defn- auth-handler
-  [{:keys [tokens] :as cfg} {:keys [params] :as request}]
+  [cfg {:keys [params] :as request}]
   (let [props (audit/extract-utm-params params)
-        state (tokens :generate
-                      {:iss :oauth
-                       :invitation-token (:invitation-token params)
-                       :props props
-                       :exp (dt/in-future "15m")})
+        state (tokens/generate (::main/props cfg)
+                               {:iss :oauth
+                                :invitation-token (:invitation-token params)
+                                :props props
+                                :exp (dt/in-future "4h")})
         uri   (build-auth-uri cfg state)]
     (yrs/response 200 {:redirect-uri uri})))
 
@@ -486,7 +486,7 @@
   {:compile
    (fn [& _]
      (fn [handler]
-       (fn [{:keys [providers] :as cfg} request]
+       (fn [{:keys [::providers] :as cfg} request]
          (let [provider (some-> request :path-params :provider keyword)]
            (if-let [provider (get providers provider)]
              (handler (assoc cfg :provider provider) request)
@@ -495,44 +495,57 @@
                        :provider provider
                        :hint "provider not configured"))))))})
 
-(s/def ::public-uri ::us/not-empty-string)
-(s/def ::http-client fn?)
-(s/def ::session map?)
-(s/def ::tokens fn?)
-(s/def ::providers map?)
+
+(s/def ::client-id ::cf/oidc-client-id)
+(s/def ::client-secret ::cf/oidc-client-secret)
+(s/def ::base-uri ::cf/oidc-base-uri)
+(s/def ::token-uri ::cf/oidc-token-uri)
+(s/def ::auth-uri ::cf/oidc-auth-uri)
+(s/def ::user-uri ::cf/oidc-user-uri)
+(s/def ::scopes ::cf/oidc-scopes)
+(s/def ::roles ::cf/oidc-roles)
+(s/def ::roles-attr ::cf/oidc-roles-attr)
+(s/def ::email-attr ::cf/oidc-email-attr)
+(s/def ::name-attr ::cf/oidc-name-attr)
+
+;; FIXME: migrate to qualified-keywords
+(s/def ::provider
+  (s/keys :req-un [::client-id
+                   ::client-secret]
+          :opt-un [::base-uri
+                   ::token-uri
+                   ::auth-uri
+                   ::user-uri
+                   ::scopes
+                   ::roles
+                   ::roles-attr
+                   ::email-attr
+                   ::name-attr]))
+
+(s/def ::providers (s/map-of ::us/keyword (s/nilable ::provider)))
 
 (defmethod ig/pre-init-spec ::routes
   [_]
-  (s/keys :req-un [::public-uri
-                   ::session
-                   ::tokens
-                   ::http-client
-                   ::providers
-                   ::db/pool
-                   ::wrk/executor]))
+  (s/keys :req [::http/client
+                ::wrk/executor
+                ::main/props
+                ::db/pool
+                ::providers
+                ::session/session]))
 
 (defmethod ig/init-key ::routes
-  [_ {:keys [executor session] :as cfg}]
+  [_ {:keys [::wrk/executor ::session/session] :as cfg}]
   (let [cfg (update cfg :provider d/without-nils)]
     ["" {:middleware [[(:middleware session)]
                       [hmw/with-dispatch executor]
                       [hmw/with-config cfg]
                       [provider-lookup]
                       ]}
-     ;; We maintain the both URI prefixes for backward compatibility.
-
      ["/auth/oauth"
-      ["/:provider"
-       {:handler auth-handler
-        :allowed-methods #{:post}}]
-      ["/:provider/callback"
-       {:handler callback-handler
-        :allowed-methods #{:get}}]]
-
-     ["/auth/oidc"
       ["/:provider"
        {:handler auth-handler
         :allowed-methods #{:post}}]
       ["/:provider/callback"
        {:handler callback-handler
         :allowed-methods #{:get}}]]]))
+

backend/src/app/cli/manage.clj

@@ -2,7 +2,7 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.cli.manage
   "A manage cli api."
@@ -111,7 +111,7 @@
     :id :verbosity
     :default 1
     :update-fn inc]
-   ["-q" nil "Dont' print to console"
+   ["-q" nil "Don't print to console"
     :id :verbosity
     :update-fn (constantly 0)]
    ["-h" "--help"]])

backend/src/app/config.clj

@@ -2,7 +2,7 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.config
   "A configuration management."
@@ -11,7 +11,6 @@
    [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.flags :as flags]
-   [app.common.logging :as l]
    [app.common.spec :as us]
    [app.common.version :as v]
    [app.util.time :as dt]
@@ -20,6 +19,7 @@
    [clojure.pprint :as pprint]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
+   [datoteka.fs :as fs]
    [environ.core :refer [env]]
    [integrant.core :as ig]))
 
@@ -27,6 +27,10 @@
                clojure.lang.IRecord
                clojure.lang.IDeref)
 
+(prefer-method print-method
+               clojure.lang.IPersistentMap
+               clojure.lang.IDeref)
+
 (prefer-method pprint/simple-dispatch
                clojure.lang.IPersistentMap
                clojure.lang.IDeref)
@@ -46,9 +50,12 @@
    :database-username "penpot"
    :database-password "penpot"
 
-   :default-blob-version 4
+   :default-blob-version 5
    :loggers-zmq-uri "tcp://localhost:45556"
 
+   :rpc-rlimit-config (fs/path "resources/rlimit.edn")
+   :rpc-climit-config (fs/path "resources/climit.edn")
+
    :file-change-snapshot-every 5
    :file-change-snapshot-timeout "3h"
 
@@ -83,22 +90,27 @@
    ;; a server prop key where initial project is stored.
    :initial-project-skey "initial-project"})
 
+(s/def ::default-rpc-rlimit ::us/vector-of-strings)
+(s/def ::rpc-rlimit-config ::fs/path)
+(s/def ::rpc-climit-config ::fs/path)
 
 (s/def ::media-max-file-size ::us/integer)
 
-(s/def ::flags ::us/vec-of-valid-keywords)
+(s/def ::flags ::us/vector-of-keywords)
 (s/def ::telemetry-enabled ::us/boolean)
 
 (s/def ::audit-log-archive-uri ::us/string)
-(s/def ::audit-log-gc-max-age ::dt/duration)
+(s/def ::audit-log-http-handler-concurrency ::us/integer)
 
-(s/def ::admins ::us/set-of-non-empty-strings)
+(s/def ::admins ::us/set-of-strings)
 (s/def ::file-change-snapshot-every ::us/integer)
 (s/def ::file-change-snapshot-timeout ::dt/duration)
 
 (s/def ::default-executor-parallelism ::us/integer)
-(s/def ::blocking-executor-parallelism ::us/integer)
-(s/def ::worker-executor-parallelism ::us/integer)
+(s/def ::scheduled-executor-parallelism ::us/integer)
+
+(s/def ::worker-default-parallelism ::us/integer)
+(s/def ::worker-webhook-parallelism ::us/integer)
 
 (s/def ::authenticated-cookie-domain ::us/string)
 (s/def ::authenticated-cookie-name ::us/string)
@@ -131,8 +143,8 @@
 (s/def ::oidc-token-uri ::us/string)
 (s/def ::oidc-auth-uri ::us/string)
 (s/def ::oidc-user-uri ::us/string)
-(s/def ::oidc-scopes ::us/set-of-non-empty-strings)
-(s/def ::oidc-roles ::us/set-of-non-empty-strings)
+(s/def ::oidc-scopes ::us/set-of-strings)
+(s/def ::oidc-roles ::us/set-of-strings)
 (s/def ::oidc-roles-attr ::us/keyword)
 (s/def ::oidc-email-attr ::us/keyword)
 (s/def ::oidc-name-attr ::us/keyword)
@@ -143,7 +155,6 @@
 (s/def ::http-server-max-multipart-body-size ::us/integer)
 (s/def ::http-server-io-threads ::us/integer)
 (s/def ::http-server-worker-threads ::us/integer)
-(s/def ::initial-project-skey ::us/string)
 (s/def ::ldap-attrs-email ::us/string)
 (s/def ::ldap-attrs-fullname ::us/string)
 (s/def ::ldap-attrs-username ::us/string)
@@ -165,11 +176,8 @@
 (s/def ::profile-complaint-threshold ::us/integer)
 (s/def ::public-uri ::us/string)
 (s/def ::redis-uri ::us/string)
-(s/def ::registration-domain-whitelist ::us/set-of-non-empty-strings)
-(s/def ::rlimit-font ::us/integer)
-(s/def ::rlimit-file-update ::us/integer)
-(s/def ::rlimit-image ::us/integer)
-(s/def ::rlimit-password ::us/integer)
+(s/def ::registration-domain-whitelist ::us/set-of-strings)
+
 (s/def ::smtp-default-from ::us/string)
 (s/def ::smtp-default-reply-to ::us/string)
 (s/def ::smtp-host ::us/string)
@@ -194,18 +202,13 @@
 (s/def ::telemetry-with-taiga ::us/boolean)
 (s/def ::tenant ::us/string)
 
-(s/def ::sentry-trace-sample-rate ::us/number)
-(s/def ::sentry-attach-stack-trace ::us/boolean)
-(s/def ::sentry-debug ::us/boolean)
-(s/def ::sentry-dsn ::us/string)
-
 (s/def ::config
   (s/keys :opt-un [::secret-key
                    ::flags
                    ::admins
                    ::allow-demo-users
                    ::audit-log-archive-uri
-                   ::audit-log-gc-max-age
+                   ::audit-log-http-handler-concurrency
                    ::auth-token-cookie-name
                    ::auth-token-cookie-max-age
                    ::authenticated-cookie-name
@@ -217,10 +220,12 @@
                    ::database-min-pool-size
                    ::database-max-pool-size
                    ::default-blob-version
+                   ::default-rpc-rlimit
                    ::error-report-webhook
                    ::default-executor-parallelism
-                   ::blocking-executor-parallelism
-                   ::worker-executor-parallelism
+                   ::scheduled-executor-parallelism
+                   ::worker-default-parallelism
+                   ::worker-webhook-parallelism
                    ::file-change-snapshot-every
                    ::file-change-snapshot-timeout
                    ::user-feedback-destination
@@ -249,7 +254,6 @@
                    ::http-server-max-multipart-body-size
                    ::http-server-io-threads
                    ::http-server-worker-threads
-                   ::initial-project-skey
                    ::ldap-attrs-email
                    ::ldap-attrs-fullname
                    ::ldap-attrs-username
@@ -272,14 +276,13 @@
                    ::public-uri
                    ::redis-uri
                    ::registration-domain-whitelist
-                   ::rlimit-font
-                   ::rlimit-file-update
-                   ::rlimit-image
-                   ::rlimit-password
-                   ::sentry-dsn
-                   ::sentry-debug
-                   ::sentry-attach-stack-trace
-                   ::sentry-trace-sample-rate
+                   ::rpc-rlimit-config
+
+                   ::semaphore-process-font
+                   ::semaphore-process-image
+                   ::semaphore-update-file
+                   ::semaphore-auth
+
                    ::smtp-default-from
                    ::smtp-default-reply-to
                    ::smtp-host
@@ -288,8 +291,10 @@
                    ::smtp-ssl
                    ::smtp-tls
                    ::smtp-username
+
                    ::srepl-host
                    ::srepl-port
+
                    ::assets-storage-backend
                    ::storage-assets-fs-directory
                    ::storage-assets-s3-bucket
@@ -309,7 +314,8 @@
 (def default-flags
   [:enable-backend-api-doc
    :enable-backend-worker
-   :enable-secure-session-cookies])
+   :enable-secure-session-cookies
+   :enable-email-verification])
 
 (defn- parse-flags
   [config]
@@ -339,7 +345,8 @@
       (when (ex/ex-info? e)
         (println ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")
         (println "Error on validating configuration:")
-        (println (us/pretty-explain (ex-data e)))
+        (println (some-> e ex-data ex/explain))
+        (println (ex/explain (ex-data e)))
         (println ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;"))
       (throw e))))
 
@@ -350,11 +357,7 @@
                "%version%")))
 
 (defonce ^:dynamic config (read-config))
-
-(defonce ^:dynamic flags
-  (let [flags (parse-flags config)]
-    (l/info :hint "flags initialized" :flags (str/join "," (map name flags)))
-    flags))
+(defonce ^:dynamic flags (parse-flags config))
 
 (def deletion-delay
   (dt/duration {:days 7}))

backend/src/app/db.clj

@@ -2,9 +2,10 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.db
+  (:refer-clojure :exclude [get])
   (:require
    [app.common.data :as d]
    [app.common.exceptions :as ex]
@@ -77,7 +78,7 @@
 (def defaults
   {:name :main
    :min-size 0
-   :max-size 30
+   :max-size 60
    :connection-timeout 10000
    :validation-timeout 10000
    :idle-timeout 120000 ; 2min
@@ -152,7 +153,7 @@
 
     ;; When metrics namespace is provided
     (when metrics
-      (->> (:registry metrics)
+      (->> (::mtx/registry metrics)
            (PrometheusMetricsTrackerFactory.)
            (.setMetricsTrackerFactory config)))
 
@@ -270,28 +271,57 @@
               (sql/delete table params opts)
               (assoc opts :return-keys true))))
 
-(defn- is-deleted?
+(defn is-row-deleted?
   [{:keys [deleted-at]}]
   (and (dt/instant? deleted-at)
        (< (inst-ms deleted-at)
           (inst-ms (dt/now)))))
 
+(defn get*
+  "Internal function for retrieve a single row from database that
+  matches a simple filters."
+  ([ds table params]
+   (get* ds table params nil))
+  ([ds table params {:keys [check-deleted?] :or {check-deleted? true} :as opts}]
+   (let [rows (exec! ds (sql/select table params opts))
+         rows (cond->> rows
+                check-deleted?
+                (remove is-row-deleted?))]
+     (first rows))))
+
+(defn get
+  ([ds table params]
+   (get ds table params nil))
+  ([ds table params {:keys [check-deleted?] :or {check-deleted? true} :as opts}]
+   (let [row (get* ds table params opts)]
+     (when (and (not row) check-deleted?)
+       (ex/raise :type :not-found
+                 :code :object-not-found
+                 :table table
+                 :hint "database object not found"))
+     row)))
+
 (defn get-by-params
+  "DEPRECATED"
   ([ds table params]
    (get-by-params ds table params nil))
   ([ds table params {:keys [check-not-found] :or {check-not-found true} :as opts}]
-   (let [res (exec-one! ds (sql/select table params opts))]
-     (when (and check-not-found (or (not res) (is-deleted? res)))
+   (let [row (get* ds table params (assoc opts :check-deleted? check-not-found))]
+     (when (and (not row) check-not-found)
        (ex/raise :type :not-found
+                 :code :object-not-found
                  :table table
                  :hint "database object not found"))
-     res)))
+     row)))
 
 (defn get-by-id
   ([ds table id]
-   (get-by-params ds table {:id id} nil))
+   (get ds table {:id id} nil))
   ([ds table id opts]
-   (get-by-params ds table {:id id} opts)))
+   (let [opts (cond-> opts
+                (contains? opts :check-not-found)
+                (assoc :check-deleted? (:check-not-found opts)))]
+     (get ds table {:id id} opts))))
 
 (defn query
   ([ds table params]
@@ -324,10 +354,13 @@
   [v]
   (and (pgarray? v) (= "uuid" (.getBaseTypeName ^PgArray v))))
 
+;; TODO rename to decode-pgarray-into
 (defn decode-pgarray
-  ([v] (some->> ^PgArray v .getArray vec))
-  ([v in] (some->> ^PgArray v .getArray (into in)))
-  ([v in xf]  (some->> ^PgArray v .getArray (into in xf))))
+  ([v] (decode-pgarray v []))
+  ([v in]
+   (into in (some-> ^PgArray v .getArray)))
+  ([v in xf]
+   (into in xf (some-> ^PgArray v .getArray))))
 
 (defn pgarray->set
   [v]
@@ -369,67 +402,73 @@
    (.rollback conn sp)))
 
 (defn interval
-  [data]
+  [o]
   (cond
-    (integer? data)
-    (->> (/ data 1000.0)
+    (or (integer? o)
+        (float? o))
+    (->> (/ o 1000.0)
          (format "%s seconds")
          (pginterval))
 
-    (string? data)
-    (pginterval data)
+    (string? o)
+    (pginterval o)
 
-    (dt/duration? data)
-    (->> (/ (.toMillis ^java.time.Duration data) 1000.0)
-         (format "%s seconds")
-         (pginterval))
+    (dt/duration? o)
+    (interval (inst-ms o))
 
     :else
-    (ex/raise :type :not-implemented)))
+    (ex/raise :type :not-implemented
+              :hint (format "no implementation found for value %s" (pr-str o)))))
 
 (defn decode-json-pgobject
   [^PGobject o]
-  (let [typ (.getType o)
-        val (.getValue o)]
-    (if (or (= typ "json")
-            (= typ "jsonb"))
-      (json/read val)
-      val)))
+  (when o
+    (let [typ (.getType o)
+          val (.getValue o)]
+      (if (or (= typ "json")
+              (= typ "jsonb"))
+        (json/decode val)
+        val))))
 
 (defn decode-transit-pgobject
   [^PGobject o]
-  (let [typ (.getType o)
-        val (.getValue o)]
-    (if (or (= typ "json")
-            (= typ "jsonb"))
-      (t/decode-str val)
-      val)))
+  (when o
+    (let [typ (.getType o)
+          val (.getValue o)]
+      (if (or (= typ "json")
+              (= typ "jsonb"))
+        (t/decode-str val)
+        val))))
 
 (defn inet
   [ip-addr]
-  (doto (org.postgresql.util.PGobject.)
-    (.setType "inet")
-    (.setValue (str ip-addr))))
+  (when ip-addr
+    (doto (org.postgresql.util.PGobject.)
+      (.setType "inet")
+      (.setValue (str ip-addr)))))
 
 (defn decode-inet
   [^PGobject o]
-  (if (= "inet" (.getType o))
-    (.getValue o)
-    nil))
+  (when o
+    (if (= "inet" (.getType o))
+      (.getValue o)
+      nil)))
 
 (defn tjson
   "Encode as transit json."
   [data]
-  (doto (org.postgresql.util.PGobject.)
-    (.setType "jsonb")
-    (.setValue (t/encode-str data {:type :json-verbose}))))
+  (when data
+    (doto (org.postgresql.util.PGobject.)
+      (.setType "jsonb")
+      (.setValue (t/encode-str data {:type :json-verbose})))))
 
 (defn json
   "Encode as plain json."
   [data]
-  (doto (org.postgresql.util.PGobject.)
-    (.setType "jsonb")
-    (.setValue (json/write-str data))))
+  (when data
+    (doto (org.postgresql.util.PGobject.)
+      (.setType "jsonb")
+      (.setValue (json/encode-str data)))))
 
 ;; --- Locks
 
@@ -460,3 +499,18 @@
   (let [n   (xact-check-param n)
         row (exec-one! conn ["select pg_try_advisory_xact_lock(?::bigint) as lock" n])]
     (:lock row)))
+
+(defn sql-exception?
+  [cause]
+  (instance? java.sql.SQLException cause))
+
+(defn connection-error?
+  [cause]
+  (and (sql-exception? cause)
+       (contains? #{"08003" "08006" "08001" "08004"}
+                  (.getSQLState ^java.sql.SQLException cause))))
+
+(defn serialization-error?
+  [cause]
+  (and (sql-exception? cause)
+       (= "40001" (.getSQLState ^java.sql.SQLException cause))))

backend/src/app/db/sql.clj

@@ -2,7 +2,7 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.db.sql
   (:refer-clojure :exclude [update])

backend/src/app/emails.clj

@@ -2,30 +2,260 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.emails
   "Main api for send emails."
   (:require
+   [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [app.common.pprint :as pp]
    [app.common.spec :as us]
    [app.config :as cf]
    [app.db :as db]
    [app.db.sql :as sql]
-   [app.util.emails :as emails]
+   [app.emails.invite-to-team :as-alias emails.invite-to-team]
+   [app.metrics :as mtx]
+   [app.util.template :as tmpl]
    [app.worker :as wrk]
+   [clojure.java.io :as io]
    [clojure.spec.alpha :as s]
-   [integrant.core :as ig]))
+   [cuerdas.core :as str]
+   [integrant.core :as ig])
+  (:import
+   jakarta.mail.Message$RecipientType
+   jakarta.mail.Session
+   jakarta.mail.Transport
+   jakarta.mail.internet.InternetAddress
+   jakarta.mail.internet.MimeBodyPart
+   jakarta.mail.internet.MimeMessage
+   jakarta.mail.internet.MimeMultipart
+   java.util.Properties))
 
-;; --- PUBLIC API
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; EMAIL IMPL
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- parse-address
+  [v]
+  (InternetAddress/parse ^String v))
+
+(defn- resolve-recipient-type
+  ^Message$RecipientType
+  [type]
+  (case type
+    :to  Message$RecipientType/TO
+    :cc  Message$RecipientType/CC
+    :bcc Message$RecipientType/BCC))
+
+(defn- assign-recipient
+  [^MimeMessage mmsg type address]
+  (if (sequential? address)
+    (reduce #(assign-recipient %1 type %2) mmsg address)
+    (let [address (parse-address address)
+          type    (resolve-recipient-type type)]
+      (.addRecipients mmsg type address)
+      mmsg)))
+(defn- assign-recipients
+  [mmsg {:keys [to cc bcc] :as params}]
+  (cond-> mmsg
+    (some? to)  (assign-recipient :to to)
+    (some? cc)  (assign-recipient :cc cc)
+    (some? bcc) (assign-recipient :bcc bcc)))
+
+(defn- assign-from
+  [mmsg {:keys [default-from]} {:keys [from] :as props}]
+  (let [from (or from default-from)]
+    (when from
+      (let [from (parse-address from)]
+        (.addFrom ^MimeMessage mmsg from)))))
+
+(defn- assign-reply-to
+  [mmsg {:keys [default-reply-to] :as cfg} {:keys [reply-to] :as params}]
+  (let [reply-to (or reply-to default-reply-to)]
+    (when reply-to
+      (let [reply-to (parse-address reply-to)]
+        (.setReplyTo ^MimeMessage mmsg reply-to)))))
+
+(defn- assign-subject
+  [mmsg {:keys [subject charset] :or {charset "utf-8"} :as params}]
+  (assert (string? subject) "subject is mandatory")
+  (.setSubject ^MimeMessage mmsg
+               ^String subject
+               ^String charset))
+
+(defn- assign-extra-headers
+  [^MimeMessage mmsg {:keys [headers extra-data] :as params}]
+  (let [headers (assoc headers "X-Penpot-Data" extra-data)]
+    (reduce-kv (fn [^MimeMessage mmsg k v]
+                 (doto mmsg
+                   (.addHeader (name k) (str v))))
+               mmsg
+               headers)))
+
+(defn- assign-body
+  [^MimeMessage mmsg {:keys [body charset] :or {charset "utf-8"}}]
+  (let [mpart (MimeMultipart. "mixed")]
+    (cond
+      (string? body)
+      (let [bpart (MimeBodyPart.)]
+        (.setContent bpart ^String body (str "text/plain; charset=" charset))
+        (.addBodyPart mpart bpart))
+
+      (vector? body)
+      (let [mmp (MimeMultipart. "alternative")
+            mbp (MimeBodyPart.)]
+        (.addBodyPart mpart mbp)
+        (.setContent mbp mmp)
+        (doseq [item body]
+          (let [mbp (MimeBodyPart.)]
+            (.setContent mbp
+                         ^String (:content item)
+                         ^String (str (:type item "text/plain") "; charset=" charset))
+            (.addBodyPart mmp mbp))))
+
+      (map? body)
+      (let [bpart (MimeBodyPart.)]
+        (.setContent bpart
+                     ^String (:content body)
+                     ^String (str (:type body "text/plain") "; charset=" charset))
+        (.addBodyPart mpart bpart))
+
+      :else
+      (throw (ex-info "Unsupported type" {:body body})))
+    (.setContent mmsg mpart)
+    mmsg))
+
+(defn- opts->props
+  [{:keys [username tls host port timeout default-from]
+    :or {timeout 30000}
+    :as opts}]
+  (reduce-kv
+   (fn [^Properties props k v]
+     (if (nil? v)
+       props
+       (doto props (.put ^String k  ^String (str v)))))
+   (Properties.)
+   {"mail.user" username
+    "mail.host" host
+    "mail.debug" (contains? cf/flags :smtp-debug)
+    "mail.from" default-from
+    "mail.smtp.auth" (boolean username)
+    "mail.smtp.starttls.enable" tls
+    "mail.smtp.starttls.required" tls
+    "mail.smtp.host" host
+    "mail.smtp.port" port
+    "mail.smtp.user" username
+    "mail.smtp.timeout" timeout
+    "mail.smtp.connectiontimeout" timeout}))
+
+(defn- create-smtp-session
+  [opts]
+  (let [props (opts->props opts)]
+    (Session/getInstance props)))
+
+(defn- create-smtp-message
+  ^MimeMessage
+  [cfg session params]
+  (let [mmsg (MimeMessage. ^Session session)]
+    (assign-recipients mmsg params)
+    (assign-from mmsg cfg params)
+    (assign-reply-to mmsg cfg params)
+    (assign-subject mmsg params)
+    (assign-extra-headers mmsg params)
+    (assign-body mmsg params)
+    (.saveChanges ^MimeMessage mmsg)
+    mmsg))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; TEMPLATE EMAIL IMPL
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def ^:private email-path "app/emails/%(id)s/%(lang)s.%(type)s")
+
+(defn- render-email-template-part
+  [type id context]
+  (let [lang (:lang context :en)
+        path (str/format email-path {:id (name id)
+                                     :lang (name lang)
+                                     :type (name type)})]
+    (some-> (io/resource path)
+            (tmpl/render context))))
+
+(defn- build-email-template
+  [id context]
+  (let [subj (render-email-template-part :subj id context)
+        text (render-email-template-part :txt id context)
+        html (render-email-template-part :html id context)]
+    (when (or (not subj)
+              (and (not text)
+                   (not html)))
+      (ex/raise :type :internal
+                :code :missing-email-templates))
+    {:subject subj
+     :body (into
+            [{:type "text/plain"
+              :content text}]
+            (when html
+              [{:type "text/html"
+                :content html}]))}))
+
+(s/def ::priority #{:high :low})
+(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)
+(s/def ::lang string?)
+(s/def ::extra-data ::us/string)
+
+(s/def ::context
+  (s/keys :req-un [::to]
+          :opt-un [::reply-to ::from ::lang ::priority ::extra-data]))
+
+(defn template-factory
+  ([id] (template-factory id {}))
+  ([id extra-context]
+   (s/assert keyword? id)
+   (fn [context]
+     (us/verify ::context context)
+     (when-let [spec (s/get-spec id)]
+       (s/assert spec context))
+
+     (let [context (merge (if (fn? extra-context)
+                            (extra-context)
+                            extra-context)
+                          context)
+           email   (build-email-template id context)]
+       (when-not email
+         (ex/raise :type :internal
+                   :code :email-template-does-not-exists
+                   :hint "seems like the template is wrong or does not exists."
+                   :context {:id id}))
+       (cond-> (assoc email :id (name id))
+         (:extra-data context)
+         (assoc :extra-data (:extra-data context))
+
+         (:from context)
+         (assoc :from (:from context))
+
+         (:reply-to context)
+         (assoc :reply-to (:reply-to context))
+
+         (:to context)
+         (assoc :to (:to context)))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; PUBLIC HIGH-LEVEL API
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn render
   [email-factory context]
   (email-factory context))
 
 (defn send!
-  "Schedule the email for sending."
+  "Schedule an already defined email to be sent using asynchronously
+  using worker task."
   [{:keys [::conn ::factory] :as context}]
   (us/verify fn? factory)
   (us/verify some? conn)
@@ -33,12 +263,137 @@
     (wrk/submit! (assoc email
                         ::wrk/task :sendmail
                         ::wrk/delay 0
-                        ::wrk/max-retries 1
+                        ::wrk/max-retries 4
                         ::wrk/priority 200
                         ::wrk/conn conn))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; SENDMAIL FN / TASK HANDLER
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-;; --- BOUNCE/COMPLAINS HANDLING
+(s/def ::username ::cf/smtp-username)
+(s/def ::password ::cf/smtp-password)
+(s/def ::tls ::cf/smtp-tls)
+(s/def ::ssl ::cf/smtp-ssl)
+(s/def ::host ::cf/smtp-host)
+(s/def ::port ::cf/smtp-port)
+(s/def ::default-reply-to ::cf/smtp-default-reply-to)
+(s/def ::default-from ::cf/smtp-default-from)
+
+(s/def ::smtp-config
+  (s/keys :opt-un [::username
+                   ::password
+                   ::tls
+                   ::ssl
+                   ::host
+                   ::port
+                   ::default-from
+                   ::default-reply-to]))
+
+(declare send-to-logger!)
+
+(s/def ::sendmail fn?)
+
+(defmethod ig/pre-init-spec ::sendmail [_]
+  (s/spec ::smtp-config))
+
+(defmethod ig/init-key ::sendmail
+  [_ cfg]
+  (fn [params]
+    (when (contains? cf/flags :smtp)
+      (let [session (create-smtp-session cfg)]
+        (with-open [transport (.getTransport session (if (:ssl cfg) "smtps" "smtp"))]
+          (.connect ^Transport transport
+                    ^String (:username cfg)
+                    ^String (:password cfg))
+
+          (let [^MimeMessage message (create-smtp-message cfg session params)]
+            (.sendMessage ^Transport transport
+                          ^MimeMessage message
+                          (.getAllRecipients message))))))
+
+    (when (or (contains? cf/flags :log-emails)
+              (not (contains? cf/flags :smtp)))
+      (send-to-logger! cfg params))))
+
+(defmethod ig/pre-init-spec ::handler [_]
+  (s/keys :req-un [::sendmail ::mtx/metrics]))
+
+(defmethod ig/init-key ::handler
+  [_ {:keys [sendmail]}]
+  (fn [{:keys [props] :as task}]
+    (sendmail props)))
+
+(defn- send-to-logger!
+  [_ email]
+  (let [body (:body email)
+        out  (with-out-str
+               (println "email console dump:")
+               (println "******** start email" (:id email) "**********")
+               (pp/pprint (dissoc email :body))
+               (if (string? body)
+                 (println body)
+                 (println (->> body
+                               (filter #(= "text/plain" (:type %)))
+                               (map :content)
+                               first)))
+               (println "******** end email" (:id email) "**********"))]
+    (l/info ::l/raw out)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; EMAIL FACTORIES
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(s/def ::subject ::us/string)
+(s/def ::content ::us/string)
+
+(s/def ::feedback
+  (s/keys :req-un [::subject ::content]))
+
+(def feedback
+  "A profile feedback email."
+  (template-factory ::feedback))
+
+(s/def ::name ::us/string)
+(s/def ::register
+  (s/keys :req-un [::name]))
+
+(def register
+  "A new profile registration welcome email."
+  (template-factory ::register))
+
+(s/def ::token ::us/string)
+(s/def ::password-recovery
+  (s/keys :req-un [::name ::token]))
+
+(def password-recovery
+  "A password recovery notification email."
+  (template-factory ::password-recovery))
+
+(s/def ::pending-email ::us/email)
+(s/def ::change-email
+  (s/keys :req-un [::name ::pending-email ::token]))
+
+(def change-email
+  "Password change confirmation email"
+  (template-factory ::change-email))
+
+(s/def ::emails.invite-to-team/invited-by ::us/string)
+(s/def ::emails.invite-to-team/team ::us/string)
+(s/def ::emails.invite-to-team/token ::us/string)
+
+(s/def ::invite-to-team
+  (s/keys :req-un [::emails.invite-to-team/invited-by
+                   ::emails.invite-to-team/token
+                   ::emails.invite-to-team/team]))
+
+(def invite-to-team
+  "Teams member invitation email."
+  (template-factory ::invite-to-team))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BOUNCE/COMPLAINS HELPERS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (def sql:profile-complaint-report
   "select (select count(*)
@@ -85,106 +440,3 @@
                                             {:email email :type "bounce"}
                                             {:limit 10}))]
      (>= (count reports) threshold))))
-
-
-;; --- EMAIL FACTORIES
-
-(s/def ::subject ::us/string)
-(s/def ::content ::us/string)
-
-(s/def ::feedback
-  (s/keys :req-un [::subject ::content]))
-
-(def feedback
-  "A profile feedback email."
-  (emails/template-factory ::feedback))
-
-(s/def ::name ::us/string)
-(s/def ::register
-  (s/keys :req-un [::name]))
-
-(def register
-  "A new profile registration welcome email."
-  (emails/template-factory ::register))
-
-(s/def ::token ::us/string)
-(s/def ::password-recovery
-  (s/keys :req-un [::name ::token]))
-
-(def password-recovery
-  "A password recovery notification email."
-  (emails/template-factory ::password-recovery))
-
-(s/def ::pending-email ::us/email)
-(s/def ::change-email
-  (s/keys :req-un [::name ::pending-email ::token]))
-
-(def change-email
-  "Password change confirmation email"
-  (emails/template-factory ::change-email))
-
-(s/def :internal.emails.invite-to-team/invited-by ::us/string)
-(s/def :internal.emails.invite-to-team/team ::us/string)
-(s/def :internal.emails.invite-to-team/token ::us/string)
-
-(s/def ::invite-to-team
-  (s/keys :req-un [:internal.emails.invite-to-team/invited-by
-                   :internal.emails.invite-to-team/token
-                   :internal.emails.invite-to-team/team]))
-
-(def invite-to-team
-  "Teams member invitation email."
-  (emails/template-factory ::invite-to-team))
-
-
-;; --- SENDMAIL TASK
-
-(declare send-console!)
-
-(s/def ::username ::cf/smtp-username)
-(s/def ::password ::cf/smtp-password)
-(s/def ::tls ::cf/smtp-tls)
-(s/def ::ssl ::cf/smtp-ssl)
-(s/def ::host ::cf/smtp-host)
-(s/def ::port ::cf/smtp-port)
-(s/def ::default-reply-to ::cf/smtp-default-reply-to)
-(s/def ::default-from ::cf/smtp-default-from)
-
-(defmethod ig/pre-init-spec ::sendmail-handler [_]
-  (s/keys :opt-un [::username
-                   ::password
-                   ::tls
-                   ::ssl
-                   ::host
-                   ::port
-                   ::default-from
-                   ::default-reply-to]))
-
-(defmethod ig/init-key ::sendmail-handler
-  [_ cfg]
-  (fn [{:keys [props] :as task}]
-    (let [enabled? (or (contains? cf/flags :smtp)
-                       (cf/get :smtp-enabled)
-                       (:enabled task))]
-      (when enabled?
-        (emails/send! cfg props))
-
-      (when (contains? cf/flags :log-emails)
-        (send-console! cfg props)))))
-
-(defn- send-console!
-  [_ email]
-  (let [body (:body email)
-        out  (with-out-str
-               (println "email console dump:")
-               (println "******** start email" (:id email) "**********")
-               (pp/pprint (dissoc email :body))
-               (if (string? body)
-                 (println body)
-                 (println (->> body
-                               (filter #(= "text/plain" (:type %)))
-                               (map :content)
-                               first)))
-               (println "******** end email" (:id email) "**********"))]
-    (l/info ::l/raw out)))
-

backend/src/app/http.clj

@@ -2,7 +2,7 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http
   (:require
@@ -11,6 +11,7 @@
    [app.common.transit :as t]
    [app.http.errors :as errors]
    [app.http.middleware :as mw]
+   [app.http.session :as session]
    [app.metrics :as mtx]
    [app.worker :as wrk]
    [clojure.spec.alpha :as s]
@@ -76,7 +77,7 @@
 
 (defmethod ig/halt-key! ::server
   [_ {:keys [server name port] :as cfg}]
-  (l/info :msg "stoping http server" :name name :port port)
+  (l/info :msg "stopping http server" :name name :port port)
   (yt/stop! server))
 
 (defn- not-found-handler
@@ -114,18 +115,17 @@
 ;; HTTP ROUTER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(s/def ::oauth map?)
-(s/def ::storage map?)
 (s/def ::assets map?)
-(s/def ::feedback fn?)
-(s/def ::ws fn?)
-(s/def ::audit-handler fn?)
 (s/def ::awsns-handler fn?)
-(s/def ::session map?)
-(s/def ::rpc-routes (s/nilable vector?))
 (s/def ::debug-routes (s/nilable vector?))
-(s/def ::oidc-routes (s/nilable vector?))
 (s/def ::doc-routes (s/nilable vector?))
+(s/def ::feedback fn?)
+(s/def ::oauth map?)
+(s/def ::oidc-routes (s/nilable vector?))
+(s/def ::rpc-routes (s/nilable vector?))
+(s/def ::session ::session/session)
+(s/def ::storage map?)
+(s/def ::ws fn?)
 
 (defmethod ig/pre-init-spec ::router [_]
   (s/keys :req-un [::mtx/metrics
@@ -137,7 +137,6 @@
                    ::awsns-handler
                    ::debug-routes
                    ::oidc-routes
-                   ::audit-handler
                    ::rpc-routes
                    ::doc-routes]))
 
@@ -148,11 +147,14 @@
                       [mw/format-response]
                       [mw/params]
                       [mw/parse-request]
+                      [session/middleware-1 session]
                       [mw/errors errors/handle]
                       [mw/restrict-methods]]}
 
-     ["/metrics" {:handler (:handler metrics)}]
-     ["/assets" {:middleware [(:middleware session)]}
+     ["/metrics" {:handler (::mtx/handler metrics)
+                  :allowed-methods #{:get}}]
+
+     ["/assets" {:middleware [[session/middleware-2 session]]}
       ["/by-id/:id" {:handler (:objects-handler assets)}]
       ["/by-file-media-id/:id" {:handler (:file-objects-handler assets)}]
       ["/by-file-media-id/:id/thumbnail" {:handler (:file-thumbnails-handler assets)}]]
@@ -163,14 +165,12 @@
       ["/sns" {:handler (:awsns-handler cfg)
                :allowed-methods #{:post}}]]
 
-     ["/ws/notifications" {:middleware [(:middleware session)]
+     ["/ws/notifications" {:middleware [[session/middleware-2 session]]
                            :handler ws
                            :allowed-methods #{:get}}]
 
      ["/api" {:middleware [[mw/cors]
-                           [(:middleware session)]]}
-      ["/audit/events" {:handler (:audit-handler cfg)
-                        :allowed-methods #{:post}}]
+                           [session/middleware-2 session]]}
       ["/feedback" {:handler feedback
                     :allowed-methods #{:post}}]
       (:doc-routes cfg)

backend/src/app/http/assets.clj

@@ -2,7 +2,7 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.assets
   "Assets related handlers."
@@ -52,13 +52,6 @@
   (let [mdata   (meta obj)
         backend (sto/resolve-backend storage (:backend obj))]
     (case (:type backend)
-      :db
-      (p/let [body (sto/get-object-bytes storage obj)]
-        (yrs/response :status  200
-                      :body    body
-                      :headers {"content-type" (:content-type mdata)
-                                "cache-control" (str "max-age=" (inst-ms cache-max-age))}))
-
       :s3
       (p/let [{:keys [host port] :as url} (sto/get-object-url storage obj {:max-age signature-max-age})]
         (yrs/response :status  307

backend/src/app/http/awsns.clj

@@ -2,7 +2,7 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.awsns
   "AWS SNS webhook handler for bounces."
@@ -11,6 +11,10 @@
    [app.common.logging :as l]
    [app.db :as db]
    [app.db.sql :as sql]
+   [app.http.client :as http]
+   [app.main :as-alias main]
+   [app.tokens :as tokens]
+   [app.worker :as-alias wrk]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig]
@@ -24,20 +28,21 @@
 (declare parse-notification)
 (declare process-report)
 
-(s/def ::http-client fn?)
-
 (defmethod ig/pre-init-spec ::handler [_]
-  (s/keys :req-un [::db/pool ::http-client]))
+  (s/keys :req [::http/client
+                ::main/props
+                ::db/pool
+                ::wrk/executor]))
 
 (defmethod ig/init-key ::handler
-  [_ {:keys [executor] :as cfg}]
+  [_ {:keys [::wrk/executor] :as cfg}]
   (fn [request respond _]
     (let [data (-> request yrq/body slurp)]
       (px/run! executor #(handle-request cfg data)))
     (respond (yrs/response 200))))
 
 (defn handle-request
-  [{:keys [http-client] :as cfg} data]
+  [cfg data]
   (try
     (let [body  (parse-json data)
           mtype (get body "Type")]
@@ -46,7 +51,7 @@
         (let [surl   (get body "SubscribeURL")
               stopic (get body "TopicArn")]
           (l/info :action "subscription received" :topic stopic :url surl)
-          (http-client {:uri surl :method :post :timeout 10000} {:sync? true}))
+          (http/req! cfg {:uri surl :method :post :timeout 10000} {:sync? true}))
 
         (= mtype "Notification")
         (when-let [message (parse-json (get body "Message"))]
@@ -97,10 +102,11 @@
           (get mail "headers")))
 
 (defn- extract-identity
-  [{:keys [tokens] :as cfg} headers]
+  [cfg headers]
   (let [tdata (get headers "x-penpot-data")]
     (when-not (str/empty? tdata)
-      (let [result (tokens :verify {:token tdata :iss :profile-identity})]
+      (let [sprops (::main/props cfg)
+            result (tokens/verify sprops {:token tdata :iss :profile-identity})]
         (:profile-id result)))))
 
 (defn- parse-notification
@@ -133,7 +139,7 @@
    (j/read-value v)))
 
 (defn- register-bounce-for-profile
-  [{:keys [pool]} {:keys [type kind profile-id] :as report}]
+  [{:keys [::db/pool]} {:keys [type kind profile-id] :as report}]
   (when (= kind "permanent")
     (db/with-atomic [conn pool]
       (db/insert! conn :profile-complaint-report
@@ -162,7 +168,7 @@
                       {:id profile-id}))))))
 
 (defn- register-complaint-for-profile
-  [{:keys [pool]} {:keys [type profile-id] :as report}]
+  [{:keys [::db/pool]} {:keys [type profile-id] :as report}]
   (db/with-atomic [conn pool]
     (db/insert! conn :profile-complaint-report
                 {:profile-id profile-id

backend/src/app/http/client.clj

@@ -2,29 +2,46 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.client
   "Http client abstraction layer."
   (:require
+   [app.common.spec :as us]
    [app.worker :as wrk]
    [clojure.spec.alpha :as s]
    [integrant.core :as ig]
-   [java-http-clj.core :as http]))
+   [java-http-clj.core :as http])
+  (:import
+   java.net.http.HttpClient))
 
-(defmethod ig/pre-init-spec :app.http/client [_]
-  (s/keys :req-un [::wrk/executor]))
+(s/def ::client #(instance? HttpClient %))
+(s/def ::client-holder
+  (s/keys :req [::client]))
 
-(defmethod ig/init-key :app.http/client
-  [_ {:keys [executor] :as cfg}]
-  (let [client (http/build-client {:executor executor
-                                   :connect-timeout 30000 ;; 10s
-                                   :follow-redirects :always})]
-    (with-meta
-      (fn send
-        ([req] (send req {}))
-        ([req {:keys [response-type sync?] :or {response-type :string sync? false}}]
-         (if sync?
-           (http/send req {:client client :as response-type})
-           (http/send-async req {:client client :as response-type}))))
-      {::client client})))
+(defmethod ig/pre-init-spec ::client [_]
+  (s/keys :req [::wrk/executor]))
+
+(defmethod ig/init-key ::client
+  [_ {:keys [::wrk/executor] :as cfg}]
+  (http/build-client {:executor executor
+                      :connect-timeout 30000 ;; 10s
+                      :follow-redirects :always}))
+
+(defn send!
+  ([client req] (send! client req {}))
+  ([client req {:keys [response-type sync?] :or {response-type :string sync? false}}]
+   (us/assert! ::client client)
+   (if sync?
+     (http/send req {:client client :as response-type})
+     (http/send-async req {:client client :as response-type}))))
+
+(defn req!
+  "A convencience toplevel function for gradual migration to a new API
+  convention."
+  ([{:keys [::client] :as holder} request]
+   (us/assert! ::client-holder holder)
+   (send! client request {}))
+  ([{:keys [::client] :as holder} request options]
+   (us/assert! ::client-holder holder)
+   (send! client request options)))

backend/src/app/http/debug.clj

@@ -2,28 +2,29 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.debug
   (:refer-clojure :exclude [error-handler])
   (:require
    [app.common.exceptions :as ex]
+   [app.common.logging :as l]
    [app.common.pprint :as pp]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
    [app.http.middleware :as mw]
+   [app.http.session :as session]
    [app.rpc.commands.binfile :as binf]
-   [app.rpc.mutations.files :refer [create-file]]
+   [app.rpc.commands.files.create :refer [create-file]]
    [app.rpc.queries.profile :as profile]
    [app.util.blob :as blob]
-   [app.util.bytes :as bs]
    [app.util.template :as tmpl]
    [app.util.time :as dt]
    [app.worker :as wrk]
-   [clojure.java.io :as io]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
+   [datoteka.io :as io]
    [emoji.core :as emj]
    [integrant.core :as ig]
    [markdown.core :as md]
@@ -66,7 +67,7 @@
               :code :only-admins-allowed))
   (yrs/response :status  200
                 :headers {"content-type" "text/html"}
-                :body    (-> (io/resource "templates/debug.tmpl")
+                :body    (-> (io/resource "app/templates/debug.tmpl")
                              (tmpl/render {}))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -126,7 +127,7 @@
 (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 :path bs/read-as-bytes blob/decode)]
+        data       (some-> params :file :path io/read-as-bytes blob/decode)]
 
     (if (and data project-id)
       (let [fname      (str "Imported file *: " (dt/now))
@@ -214,7 +215,7 @@
 
           (render-template [report]
             (let [context (dissoc report
-                                  :trace :cause :params :data :spec-problems
+                                  :trace :cause :params :data :spec-problems :message
                                   :spec-explain :spec-value :error :explain :hint)
                   params  {:context       (pp/pprint-str context :width 200)
                            :hint          (:hint report)
@@ -225,7 +226,7 @@
                            :trace         (or (:trace report)
                                               (some-> report :error :trace))
                            :params        (:params report)}]
-              (-> (io/resource "templates/error-report.tmpl")
+              (-> (io/resource "app/templates/error-report.tmpl")
                   (tmpl/render params))))]
 
     (when-not (authorized? pool request)
@@ -243,17 +244,21 @@
         (yrs/response 404 "not found")))))
 
 (def sql:error-reports
-  "select id, created_at from server_error_report order by created_at desc limit 100")
+  "SELECT id, created_at,
+          content->>'~:hint' AS hint
+     FROM server_error_report
+    ORDER BY created_at DESC
+    LIMIT 100")
 
 (defn error-list-handler
   [{:keys [pool]} request]
   (when-not (authorized? pool request)
     (ex/raise :type :authentication
               :code :only-admins-allowed))
-  (let [items (db/exec! pool [sql:error-reports])
-        items (map #(update % :created-at dt/format-instant :rfc1123) items)]
+  (let [items (->> (db/exec! pool [sql:error-reports])
+                   (map #(update % :created-at dt/format-instant :rfc1123)))]
     (yrs/response :status 200
-                  :body (-> (io/resource "templates/error-list.tmpl")
+                  :body (-> (io/resource "app/templates/error-list.tmpl")
                             (tmpl/render {:items items}))
                   :headers {"content-type" "text/html; charset=utf-8"
                             "x-robots-tag" "noindex"})))
@@ -280,7 +285,7 @@
                    (assoc ::binf/file-ids file-ids)
                    (assoc ::binf/embed-assets? embed?)
                    (assoc ::binf/include-libraries? libs?)
-                   (binf/export!))]
+                   (binf/export-to-tmpfile!))]
       (if clone?
         (let [project-id (some-> (profile/retrieve-additional-data pool profile-id) :default-project-id)]
           (binf/import!
@@ -342,8 +347,13 @@
   "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;"])
-    (yrs/response 200 "OK")))
+    (try
+      (db/exec-one! conn ["select count(*) as count from server_prop;"])
+      (yrs/response 200 "OK")
+      (catch Throwable cause
+        (l/warn :hint "unable to execute query on health handler"
+                :cause cause)
+        (yrs/response 503 "KO")))))
 
 (defn changelog-handler
   [_ _]
@@ -372,17 +382,15 @@
                             :code :only-admins-allowed))))))})
 
 
-(s/def ::session map?)
-
 (defmethod ig/pre-init-spec ::routes [_]
-  (s/keys :req-un [::db/pool ::wrk/executor ::session]))
+  (s/keys :req-un [::db/pool ::wrk/executor ::session/session]))
 
 (defmethod ig/init-key ::routes
   [_ {:keys [session pool executor] :as cfg}]
   [["/readyz" {:middleware [[mw/with-dispatch executor]
                             [mw/with-config cfg]]
                :handler health-handler}]
-   ["/dbg" {:middleware [[(:middleware session)]
+   ["/dbg" {:middleware [[session/middleware-2 session]
                          [with-authorization pool]
                          [mw/with-dispatch executor]
                          [mw/with-config cfg]]}

backend/src/app/http/errors.clj

@@ -2,14 +2,15 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.errors
   "A errors handling for the http server."
   (:require
+   [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
-   [app.common.spec :as us]
+   [app.http :as-alias http]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [yetti.request :as yrq]
@@ -25,16 +26,18 @@
 
 (defn get-context
   [request]
-  (merge
-   *context*
-   {:path          (:path request)
-    :method        (:method request)
-    :params        (:params request)
-    :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")})))
+  (let [claims (:session-token-claims request)]
+    (merge
+     *context*
+     {:path          (:path request)
+      :method        (:method request)
+      :params        (:params request)
+      :ip-addr       (parse-client-ip request)}
+     (d/without-nils
+      {:user-agent (yrq/get-header request "user-agent")
+       :frontend-version (or (yrq/get-header request "x-frontend-version")
+                             "unknown")
+       :profile-id   (:uid claims)}))))
 
 (defmulti handle-exception
   (fn [err & _rest]
@@ -50,12 +53,17 @@
   [err _]
   (yrs/response 400 (ex-data err)))
 
+(defmethod handle-exception :rate-limit
+  [err _]
+  (let [headers (-> err ex-data ::http/headers)]
+    (yrs/response :status 429 :body "" :headers headers)))
+
 (defmethod handle-exception :validation
   [err _]
   (let [{:keys [code] :as data} (ex-data err)]
     (cond
       (= code :spec-validation)
-      (let [explain (us/pretty-explain data)]
+      (let [explain (ex/explain data)]
         (yrs/response :status 400
                       :body   (-> data
                                   (dissoc ::s/problems ::s/value)
@@ -69,11 +77,11 @@
 
 (defmethod handle-exception :assertion
   [error request]
-  (let [edata (ex-data error)
-        explain (us/pretty-explain edata)]
-    (l/error ::l/raw (str (ex-message error) "\n" explain)
-             ::l/context (get-context request)
-             :cause error)
+  (let [edata   (ex-data error)
+        explain (ex/explain edata)]
+    (l/error :hint (ex-message error)
+             :cause error
+             ::l/context (get-context request))
     (yrs/response :status 500
                   :body   {:type :server-error
                            :code :assertion
@@ -85,12 +93,29 @@
   [err _]
   (yrs/response 404 (ex-data err)))
 
+(defmethod handle-exception :internal
+  [error request]
+  (let [{:keys [code] :as edata} (ex-data error)]
+    (cond
+      (= :concurrency-limit-reached code)
+      (yrs/response 429)
+
+      :else
+      (do
+        (l/error :hint (ex-message error)
+                 :cause error
+                 ::l/context (get-context request))
+        (yrs/response 500 {:type :server-error
+                           :code :unhandled
+                           :hint (ex-message error)
+                           :data edata})))))
+
 (defmethod handle-exception org.postgresql.util.PSQLException
   [error request]
   (let [state (.getSQLState ^java.sql.SQLException error)]
-    (l/error ::l/raw (ex-message error)
-             ::l/context (get-context request)
-             :cause error)
+    (l/error :hint (ex-message error)
+             :cause error
+             ::l/context (get-context request))
     (cond
       (= state "57014")
       (yrs/response 504 {:type :server-error
@@ -115,9 +140,9 @@
       ;; This means that exception is not a controlled exception.
       (nil? edata)
       (do
-        (l/error ::l/raw (ex-message error)
-                 ::l/context (get-context request)
-                 :cause error)
+        (l/error :hint (ex-message error)
+                 :cause error
+                 ::l/context (get-context request))
         (yrs/response 500 {:type :server-error
                            :code :unexpected
                            :hint (ex-message error)}))
@@ -133,9 +158,9 @@
 
       :else
       (do
-        (l/error ::l/raw (ex-message error)
-                 ::l/context (get-context request)
-                 :cause error)
+        (l/error :hint (ex-message error)
+                 :cause error
+                 ::l/context (get-context request))
         (yrs/response 500 {:type :server-error
                            :code :unhandled
                            :hint (ex-message error)

backend/src/app/http/feedback.clj

@@ -2,7 +2,7 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.feedback
   "A general purpose feedback module."

backend/src/app/http/middleware.clj

@@ -2,7 +2,7 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.middleware
   (:require
@@ -19,6 +19,7 @@
    [yetti.request :as yrq]
    [yetti.response :as yrs])
   (:import
+   com.fasterxml.jackson.core.JsonParseException
    com.fasterxml.jackson.core.io.JsonEOFException
    io.undertow.server.RequestTooBigException
    java.io.OutputStream))
@@ -31,6 +32,12 @@
   {:name ::params
    :compile (constantly ymw/wrap-params)})
 
+(def ^:private json-mapper
+  (json/mapper
+   {:encode-key-fn str/camel
+    :decode-key-fn (comp keyword str/kebab)
+    :pretty true}))
+
 (defn wrap-parse-request
   [handler]
   (letfn [(process-request [request]
@@ -45,7 +52,7 @@
 
                 (str/starts-with? header "application/json")
                 (with-open [is (yrq/body request)]
-                  (let [params (json/read is)]
+                  (let [params (json/decode is json-mapper)]
                     (-> request
                         (assoc :body-params params)
                         (update :params merge params))))
@@ -60,10 +67,13 @@
                                :code :request-body-too-large
                                :hint (ex-message cause)))
 
-              (instance? JsonEOFException cause)
+
+              (or (instance? JsonEOFException cause)
+                  (instance? JsonParseException cause))
               (raise (ex/error :type :validation
                                :code :malformed-json
-                               :hint (ex-message cause)))
+                               :hint (ex-message cause)
+                               :cause cause))
               :else
               (raise cause)))]
 
@@ -113,7 +123,32 @@
                   (finally
                     (.close ^OutputStream output-stream))))))
 
-          (format-response [response request]
+          (json-streamable-body [data]
+            (reify yrs/StreamableResponseBody
+              (-write-body-to-stream [_ _ output-stream]
+                (try
+
+                  (with-open [bos (buffered-output-stream output-stream buffer-size)]
+                    (json/write! bos data json-mapper))
+
+                  (catch java.io.IOException _cause
+                    ;; Do nothing, EOF means client closes connection abruptly
+                    nil)
+                  (catch Throwable cause
+                    (l/warn :hint "unexpected error on encoding response"
+                            :cause cause))
+                  (finally
+                    (.close ^OutputStream output-stream))))))
+
+          (format-response-with-json [response _]
+            (let [body (yrs/body response)]
+              (if (or (boolean? body) (coll? body))
+                (-> response
+                    (update :headers assoc "content-type" "application/json")
+                    (assoc :body (json-streamable-body body)))
+                response)))
+
+          (format-response-with-transit [response request]
             (let [body (yrs/body response)]
               (if (or (boolean? body) (coll? body))
                 (let [qs   (yrq/query request)
@@ -126,6 +161,20 @@
                       (assoc :body (transit-streamable-body body opts))))
                 response)))
 
+          (format-response [response request]
+            (let [accept (yrq/get-header request "accept")]
+              (cond
+                (or (= accept "application/transit+json")
+                    (str/includes? accept "application/transit+json"))
+                (format-response-with-transit response request)
+
+                (or (= accept "application/json")
+                    (str/includes? accept "application/json"))
+                (format-response-with-json response request)
+
+                :else
+                (format-response-with-transit response request))))
+
           (process-response [response request]
             (cond-> response
               (map? response) (format-response request)))]

backend/src/app/http/session.clj

@@ -2,15 +2,17 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.session
+  (:refer-clojure :exclude [read])
   (:require
    [app.common.data :as d]
    [app.common.logging :as l]
    [app.config :as cf]
    [app.db :as db]
    [app.db.sql :as sql]
+   [app.tokens :as tokens]
    [app.util.time :as dt]
    [app.worker :as wrk]
    [clojure.spec.alpha :as s]
@@ -19,6 +21,10 @@
    [promesa.exec :as px]
    [yetti.request :as yrq]))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; DEFAULTS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 ;; A default cookie name for storing the session.
 (def default-auth-token-cookie-name "auth-token")
 
@@ -32,35 +38,55 @@
 ;; Default age for automatic session renewal
 (def default-renewal-max-age (dt/duration {:hours 6}))
 
-(defprotocol ISessionStore
-  (read-session [store key])
-  (write-session [store key data])
-  (update-session [store data])
-  (delete-session [store key]))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; PROTOCOLS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defn- make-database-store
-  [{:keys [pool tokens executor]}]
-  (reify ISessionStore
-    (read-session [_ token]
+(defprotocol ISessionManager
+  (read [_ key])
+  (decode [_ key])
+  (write! [_ key data])
+  (update! [_ data])
+  (delete! [_ key]))
+
+(s/def ::session #(satisfies? ISessionManager %))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; STORAGE IMPL
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- prepare-session-params
+  [sprops data]
+  (let [profile-id (:profile-id data)
+        user-agent (:user-agent data)
+        created-at (or (:created-at data) (dt/now))
+        token      (tokens/generate sprops {:iss "authentication"
+                                            :iat created-at
+                                            :uid profile-id})]
+    {:user-agent user-agent
+     :profile-id profile-id
+     :created-at created-at
+     :updated-at created-at
+     :id token}))
+
+(defn- database-manager
+  [{:keys [pool sprops executor]}]
+  (reify ISessionManager
+    (read [_ token]
       (px/with-dispatch executor
         (db/exec-one! pool (sql/select :http-session {:id token}))))
 
-    (write-session [_ _ data]
+    (decode [_ token]
       (px/with-dispatch executor
-        (let [profile-id (:profile-id data)
-              user-agent (:user-agent data)
-              created-at (or (:created-at data) (dt/now))
-              token      (tokens :generate {:iss "authentication"
-                                            :iat created-at
-                                            :uid profile-id})
-              params     {:user-agent user-agent
-                          :profile-id profile-id
-                          :created-at created-at
-                          :updated-at created-at
-                          :id token}]
-          (db/insert! pool :http-session params))))
+        (tokens/verify sprops {:token token :iss "authentication"})))
 
-    (update-session [_ data]
+    (write! [_ _ data]
+      (px/with-dispatch executor
+        (let [params (prepare-session-params sprops data)]
+          (db/insert! pool :http-session params)
+          params)))
+
+    (update! [_ data]
       (let [updated-at (dt/now)]
         (px/with-dispatch executor
           (db/update! pool :http-session
@@ -68,84 +94,154 @@
                       {:id (:id data)})
           (assoc data :updated-at updated-at))))
 
-
-    (delete-session [_ token]
+    (delete! [_ token]
       (px/with-dispatch executor
         (db/delete! pool :http-session {:id token})
         nil))))
 
-(defn make-inmemory-store
-  [{:keys [tokens]}]
+(defn inmemory-manager
+  [{:keys [sprops executor]}]
   (let [cache (atom {})]
-    (reify ISessionStore
-      (read-session [_ token]
+    (reify ISessionManager
+      (read [_ token]
         (p/do (get @cache token)))
 
-      (write-session [_ _ data]
-        (p/do
-          (let [profile-id (:profile-id data)
-                user-agent (:user-agent data)
-                created-at (or (:created-at data) (dt/now))
-                token      (tokens :generate {:iss "authentication"
-                                              :iat created-at
-                                              :uid profile-id})
-                params     {:user-agent user-agent
-                            :created-at created-at
-                            :updated-at created-at
-                            :profile-id profile-id
-                            :id token}]
+      (decode [_ token]
+        (px/with-dispatch executor
+          (tokens/verify sprops {:token token :iss "authentication"})))
 
+      (write! [_ _ data]
+        (p/do
+          (let [{:keys [token] :as params} (prepare-session-params sprops data)]
             (swap! cache assoc token params)
             params)))
 
-      (update-session [_ data]
-        (let [updated-at (dt/now)]
-          (swap! cache update (:id data) assoc :updated-at updated-at)
-          (assoc data :updated-at updated-at)))
+      (update! [_ data]
+        (p/do
+          (let [updated-at (dt/now)]
+            (swap! cache update (:id data) assoc :updated-at updated-at)
+            (assoc data :updated-at updated-at))))
 
-      (delete-session [_ token]
+      (delete! [_ token]
         (p/do
           (swap! cache dissoc token)
           nil)))))
 
-(s/def ::tokens fn?)
-(defmethod ig/pre-init-spec ::store [_]
-  (s/keys :req-un [::db/pool ::wrk/executor ::tokens]))
+(s/def ::sprops map?)
+(defmethod ig/pre-init-spec ::manager [_]
+  (s/keys :req-un [::db/pool ::wrk/executor ::sprops]))
 
-(defmethod ig/init-key ::store
+(defmethod ig/init-key ::manager
   [_ {:keys [pool] :as cfg}]
   (if (db/read-only? pool)
-    (make-inmemory-store cfg)
-    (make-database-store cfg)))
+    (inmemory-manager cfg)
+    (database-manager cfg)))
 
-(defmethod ig/halt-key! ::store
+(defmethod ig/halt-key! ::manager
   [_ _])
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; MANAGER IMPL
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare assign-auth-token-cookie)
+(declare assign-authenticated-cookie)
+(declare clear-auth-token-cookie)
+(declare clear-authenticated-cookie)
+
+(defn create-fn
+  [manager profile-id]
+  (fn [request response]
+    (let [uagent  (yrq/get-header request "user-agent")
+          params  {:profile-id profile-id
+                   :user-agent uagent}]
+      (-> (write! manager nil params)
+          (p/then (fn [session]
+                    (l/trace :hint "create" :profile-id profile-id)
+                    (-> response
+                        (assign-auth-token-cookie session)
+                        (assign-authenticated-cookie session))))))))
+(defn delete-fn
+  [manager]
+  (letfn [(delete [{:keys [profile-id] :as request}]
+            (let [cname   (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
+                  cookie  (yrq/get-cookie request cname)]
+              (l/trace :hint "delete" :profile-id profile-id)
+              (some->> (:value cookie) (delete! manager))))]
+    (fn [request response]
+      (p/do
+        (delete request)
+        (-> response
+            (assoc :status 204)
+            (assoc :body nil)
+            (clear-auth-token-cookie)
+            (clear-authenticated-cookie))))))
+
+(def middleware-1
+  (letfn [(wrap-handler [manager handler request respond raise]
+            (try
+              (let [claims  (some->> (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
+                                     (yrq/get-cookie request)
+                                     (decode manager))
+                    request (cond-> request
+                              (some? claims)
+                              (assoc :session-token-claims claims))]
+                (handler request respond raise))
+              (catch Throwable _
+                (handler request respond raise))))]
+
+    {:name :session-1
+     :compile (fn [& _]
+                (fn [handler manager]
+                  (partial wrap-handler manager handler)))}))
+
+(def middleware-2
+  (letfn [(wrap-handler [manager handler request respond raise]
+            (-> (retrieve-session manager request)
+                (p/finally (fn [session cause]
+                             (cond
+                               (some? cause)
+                               (raise cause)
+
+                               (nil? session)
+                               (handler request respond raise)
+
+                               :else
+                               (let [request (-> request
+                                                 (assoc :profile-id (:profile-id session))
+                                                 (assoc :session-id (:id session)))
+                                     respond (cond-> respond
+                                               (renew-session? session)
+                                               (wrap-respond manager session))]
+                                 (handler request respond raise)))))))
+
+          (retrieve-session [manager request]
+            (let [cname  (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
+                  cookie (yrq/get-cookie request cname)]
+              (some->> (:value cookie) (read manager))))
+
+          (renew-session? [{:keys [updated-at] :as session}]
+            (and (dt/instant? updated-at)
+                 (let [elapsed (dt/diff updated-at (dt/now))]
+                   (neg? (compare default-renewal-max-age elapsed)))))
+
+          ;; Wrap respond with session renewal code
+          (wrap-respond [respond manager session]
+            (fn [response]
+              (p/let [session (update! manager session)]
+                (-> response
+                    (assign-auth-token-cookie session)
+                    (assign-authenticated-cookie session)
+                    (respond)))))]
+
+    {:name :session-2
+     :compile (fn [& _]
+                (fn [handler manager]
+                  (partial wrap-handler manager handler)))}))
+
 ;; --- IMPL
 
-(defn- create-session!
-  [store profile-id user-agent]
-  (let [params {:user-agent user-agent
-                :profile-id profile-id}]
-    (write-session store nil params)))
-
-(defn- update-session!
-  [store session]
-  (update-session store session))
-
-(defn- delete-session!
-  [store {:keys [cookies] :as request}]
-  (let [name (cf/get :auth-token-cookie-name default-auth-token-cookie-name)]
-    (when-let [token (get-in cookies [name :value])]
-      (delete-session store token))))
-
-(defn- retrieve-session
-  [store request]
-  (let [cookie-name (cf/get :auth-token-cookie-name default-auth-token-cookie-name)]
-    (when-let [cookie (yrq/get-cookie request cookie-name)]
-      (read-session store (:value cookie)))))
-
-(defn assign-auth-token-cookie
+(defn- assign-auth-token-cookie
   [response {token :id updated-at :updated-at}]
   (let [max-age    (cf/get :auth-token-cookie-max-age default-cookie-max-age)
         created-at (or updated-at (dt/now))
@@ -164,7 +260,7 @@
                     :secure secure?}]
     (update response :cookies assoc name cookie)))
 
-(defn assign-authenticated-cookie
+(defn- assign-authenticated-cookie
   [response {updated-at :updated-at}]
   (let [max-age    (cf/get :auth-token-cookie-max-age default-cookie-max-age)
         created-at (or updated-at (dt/now))
@@ -185,96 +281,23 @@
       (string? domain)
       (update :cookies assoc name cookie))))
 
-(defn clear-auth-token-cookie
+(defn- clear-auth-token-cookie
   [response]
-  (let [name (cf/get :auth-token-cookie-name default-auth-token-cookie-name)]
-    (update response :cookies assoc name {:path "/" :value "" :max-age -1})))
+  (let [cname (cf/get :auth-token-cookie-name default-auth-token-cookie-name)]
+    (update response :cookies assoc cname {:path "/" :value "" :max-age -1})))
 
 (defn- clear-authenticated-cookie
   [response]
-  (let [name   (cf/get :authenticated-cookie-name default-authenticated-cookie-name)
+  (let [cname   (cf/get :authenticated-cookie-name default-authenticated-cookie-name)
         domain (cf/get :authenticated-cookie-domain)]
     (cond-> response
       (string? domain)
-      (update :cookies assoc name {:domain domain :path "/" :value "" :max-age -1}))))
-
-(defn- make-middleware
-  [{:keys [store] :as cfg}]
-  (letfn [;; Check if time reached for automatic session renewal
-          (renew-session? [{:keys [updated-at] :as session}]
-            (and (dt/instant? updated-at)
-                 (let [elapsed (dt/diff updated-at (dt/now))]
-                   (neg? (compare default-renewal-max-age elapsed)))))
-
-          ;; Wrap respond with session renewal code
-          (wrap-respond [respond session]
-            (fn [response]
-              (p/let [session (update-session! store session)]
-                (-> response
-                    (assign-auth-token-cookie session)
-                    (assign-authenticated-cookie session)
-                    (respond)))))]
-
-    {:name :session
-     :compile (fn [& _]
-                (fn [handler]
-                  (fn [request respond raise]
-                    (try
-                      (-> (retrieve-session store request)
-                          (p/finally (fn [session cause]
-                                       (cond
-                                         (some? cause)
-                                         (raise cause)
-
-                                         (nil? session)
-                                         (handler request respond raise)
-
-                                         :else
-                                         (let [request (-> request
-                                                           (assoc :profile-id (:profile-id session))
-                                                           (assoc :session-id (:id session)))
-                                               respond (cond-> respond
-                                                         (renew-session? session)
-                                                         (wrap-respond session))]
-                                           (handler request respond raise))))))
-
-                      (catch Throwable cause
-                        (raise cause))))))}))
+      (update :cookies assoc cname {:domain domain :path "/" :value "" :max-age -1}))))
 
 
-;; --- STATE INIT: SESSION
-
-(s/def ::store #(satisfies? ISessionStore %))
-
-(defmethod ig/pre-init-spec :app.http/session [_]
-  (s/keys :req-un [::store]))
-
-(defmethod ig/prep-key :app.http/session
-  [_ cfg]
-  (d/merge {:buffer-size 128}
-           (d/without-nils cfg)))
-
-(defmethod ig/init-key :app.http/session
-  [_ {:keys [store] :as cfg}]
-  (-> cfg
-      (assoc :middleware (make-middleware cfg))
-      (assoc :create (fn [profile-id]
-                       (fn [request response]
-                         (p/let [uagent  (yrq/get-header request "user-agent")
-                                 session (create-session! store profile-id uagent)]
-                           (-> response
-                               (assign-auth-token-cookie session)
-                               (assign-authenticated-cookie session))))))
-      (assoc :delete (fn [request response]
-                       (p/do
-                         (delete-session! store request)
-                         (-> response
-                             (assoc :status 204)
-                             (assoc :body nil)
-                             (clear-auth-token-cookie)
-                             (clear-authenticated-cookie)))))))
-
-;; --- STATE INIT: SESSION GC
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; TASK: SESSION GC
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (declare sql:delete-expired)
 

backend/src/app/http/websocket.clj

@@ -2,7 +2,7 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.websocket
   "A penpot notification service for file cooperative edition."
@@ -13,6 +13,7 @@
    [app.common.spec :as us]
    [app.db :as db]
    [app.metrics :as mtx]
+   [app.msgbus :as mbus]
    [app.util.time :as dt]
    [app.util.websocket :as ws]
    [clojure.core.async :as a]
@@ -20,6 +21,12 @@
    [integrant.core :as ig]
    [yetti.websocket :as yws]))
 
+(def recv-labels
+  (into-array String ["recv"]))
+
+(def send-labels
+  (into-array String ["send"]))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; WEBSOCKET HOOKS
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -30,21 +37,30 @@
   [{:keys [metrics]} wsp]
   (let [created-at (dt/now)]
     (swap! state assoc (::ws/id @wsp) wsp)
-    (mtx/run! metrics {:id :websocket-active-connections :inc 1})
+    (mtx/run! metrics
+              :id :websocket-active-connections
+              :inc 1)
     (fn []
       (swap! state dissoc (::ws/id @wsp))
-      (mtx/run! metrics {:id :websocket-active-connections :dec 1})
-      (mtx/run! metrics {:id :websocket-session-timing
-                         :val (/ (inst-ms (dt/diff created-at (dt/now))) 1000.0)}))))
+      (mtx/run! metrics :id :websocket-active-connections :dec 1)
+      (mtx/run! metrics
+                :id :websocket-session-timing
+                :val (/ (inst-ms (dt/diff created-at (dt/now))) 1000.0)))))
 
 (defn- on-rcv-message
   [{:keys [metrics]} _ message]
-  (mtx/run! metrics {:id :websocket-messages-total :labels ["recv"] :inc 1})
+  (mtx/run! metrics
+            :id :websocket-messages-total
+            :labels recv-labels
+            :inc 1)
   message)
 
 (defn- on-snd-message
   [{:keys [metrics]} _ message]
-  (mtx/run! metrics {:id :websocket-messages-total :labels ["send"] :inc 1})
+  (mtx/run! metrics
+            :id :websocket-messages-total
+            :labels send-labels
+            :inc 1)
   message)
 
 ;; REPL HELPERS
@@ -72,12 +88,12 @@
 (defn repl-get-connection-info
   [id]
   (when-let [wsp (get @state id)]
-    {:id id
-     :created-at (dt/instant id)
-     :profile-id (::profile-id @wsp)
-     :session-id (::session-id @wsp)
-     :user-agent (::ws/user-agent @wsp)
-     :ip-addr    (::ws/remote-addr @wsp)
+    {:id               id
+     :created-at       (::created-at @wsp)
+     :profile-id       (::profile-id @wsp)
+     :session-id       (::session-id @wsp)
+     :user-agent       (::ws/user-agent @wsp)
+     :ip-addr          (::ws/remote-addr @wsp)
      :last-activity-at (::ws/last-activity-at @wsp)
      :http-session-id  (::ws/http-session-id @wsp)
      :subscribed-file  (-> wsp deref ::file-subscription :file-id)
@@ -104,7 +120,7 @@
 (defmethod handle-message :connect
   [cfg wsp _]
 
-  (let [msgbus-fn  (:msgbus cfg)
+  (let [msgbus     (:msgbus cfg)
         conn-id    (::ws/id @wsp)
         profile-id (::profile-id @wsp)
         session-id (::session-id @wsp)
@@ -113,17 +129,17 @@
         xform      (remove #(= (:session-id %) session-id))
         channel    (a/chan (a/dropping-buffer 16) xform)]
 
-    (l/trace :fn "handle-message" :event :connect :conn-id conn-id)
+    (l/trace :fn "handle-message" :event "connect" :conn-id conn-id)
 
     ;; Subscribe to the profile channel and forward all messages to
     ;; websocket output channel (send them to the client).
     (swap! wsp assoc ::profile-subscription channel)
     (a/pipe channel output-ch false)
-    (msgbus-fn :cmd :sub :topic profile-id :chan channel)))
+    (mbus/sub! msgbus :topic profile-id :chan channel)))
 
 (defmethod handle-message :disconnect
   [cfg wsp _]
-  (let [msgbus-fn  (:msgbus cfg)
+  (let [msgbus     (:msgbus cfg)
         conn-id    (::ws/id @wsp)
         profile-id (::profile-id @wsp)
         session-id (::session-id @wsp)
@@ -143,21 +159,21 @@
     (a/go
       ;; Close the main profile subscription
       (a/close! profile-ch)
-      (a/<! (msgbus-fn :cmd :purge :chans [profile-ch]))
+      (a/<! (mbus/purge! msgbus [profile-ch]))
 
       ;; Close tram subscription if exists
       (when-let [channel (:channel tsub)]
         (a/close! channel)
-        (a/<! (msgbus-fn :cmd :purge :chans [channel])))
+        (a/<! (mbus/purge! msgbus channel)))
 
       (when-let [{:keys [topic channel]} fsub]
         (a/close! channel)
-        (a/<! (msgbus-fn :cmd :purge :chans [channel]))
-        (a/<! (msgbus-fn :cmd :pub :topic topic :message message))))))
+        (a/<! (mbus/purge! msgbus channel))
+        (a/<! (mbus/pub! msgbus :topic topic :message message))))))
 
 (defmethod handle-message :subscribe-team
   [cfg wsp {:keys [team-id] :as params}]
-  (let [msgbus-fn  (:msgbus cfg)
+  (let [msgbus     (:msgbus cfg)
         conn-id    (::ws/id @wsp)
         session-id (::session-id @wsp)
         output-ch  (::ws/output-ch @wsp)
@@ -182,14 +198,14 @@
       ;; Close previous subscription if exists
       (when-let [channel (:channel prev-subs)]
         (a/close! channel)
-        (a/<! (msgbus-fn :cmd :purge :chans [channel]))))
+        (a/<! (mbus/purge! msgbus channel))))
 
     (a/go
-      (a/<! (msgbus-fn :cmd :sub :topic team-id :chan channel)))))
+      (a/<! (mbus/sub! msgbus :topic team-id :chan channel)))))
 
 (defmethod handle-message :subscribe-file
   [cfg wsp {:keys [file-id] :as params}]
-  (let [msgbus-fn  (:msgbus cfg)
+  (let [msgbus     (:msgbus cfg)
         conn-id    (::ws/id @wsp)
         profile-id (::profile-id @wsp)
         session-id (::session-id @wsp)
@@ -211,7 +227,7 @@
       ;; Close previous subscription if exists
       (when-let [channel (:channel prev-subs)]
         (a/close! channel)
-        (a/<! (msgbus-fn :cmd :purge :chans [channel]))))
+        (a/<! (mbus/purge! msgbus channel))))
 
     ;; Message forwarding
     (a/go
@@ -224,15 +240,13 @@
                            :file-id file-id
                            :session-id session-id
                            :profile-id profile-id}]
-              (a/<! (msgbus-fn :cmd :pub
-                               :topic file-id
-                               :message message))))
+              (a/<! (mbus/pub! msgbus :topic file-id :message message))))
           (a/>! output-ch message)
           (recur))))
 
     (a/go
       ;; Subscribe to file topic
-      (a/<! (msgbus-fn :cmd :sub :topic file-id :chan channel))
+      (a/<! (mbus/sub! msgbus :topic file-id :chan channel))
 
       ;; Notifify the rest of participants of the new connection.
       (let [message {:type :join-file
@@ -240,13 +254,11 @@
                      :subs-id file-id
                      :session-id session-id
                      :profile-id profile-id}]
-        (a/<! (msgbus-fn :cmd :pub
-                         :topic file-id
-                         :message message))))))
+        (a/<! (mbus/pub! msgbus :topic file-id :message message))))))
 
 (defmethod handle-message :unsubscribe-file
   [cfg wsp {:keys [file-id] :as params}]
-  (let [msgbus-fn  (:msgbus cfg)
+  (let [msgbus     (:msgbus cfg)
         conn-id    (::ws/id @wsp)
         session-id (::session-id @wsp)
         profile-id (::profile-id @wsp)
@@ -266,8 +278,8 @@
       (when (= (:file-id subs) file-id)
         (let [channel (:channel subs)]
           (a/close! channel)
-          (a/<! (msgbus-fn :cmd :purge :chans [channel]))
-          (a/<! (msgbus-fn :cmd :pub :topic file-id :message message)))))))
+          (a/<! (mbus/purge! msgbus channel))
+          (a/<! (mbus/pub! msgbus :topic file-id :message message)))))))
 
 (defmethod handle-message :keepalive
   [_ _ _]
@@ -276,7 +288,7 @@
 
 (defmethod handle-message :pointer-update
   [cfg wsp {:keys [file-id] :as message}]
-  (let [msgbus-fn  (:msgbus cfg)
+  (let [msgbus     (:msgbus cfg)
         profile-id (::profile-id @wsp)
         session-id (::session-id @wsp)
         subs       (::file-subscription @wsp)
@@ -287,9 +299,7 @@
     (a/go
       ;; Only allow receive pointer updates when active subscription
       (when subs
-        (a/<! (msgbus-fn :cmd :pub
-                         :topic file-id
-                         :message message))))))
+        (a/<! (mbus/pub! msgbus :topic file-id :message message))))))
 
 (defmethod handle-message :default
   [_ wsp message]
@@ -303,7 +313,7 @@
 ;; HTTP HANDLER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(s/def ::msgbus fn?)
+(s/def ::msgbus ::mbus/msgbus)
 (s/def ::session-id ::us/uuid)
 
 (s/def ::handler-params

backend/src/app/loggers/audit.clj

@@ -2,7 +2,7 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.loggers.audit
   "Services related to the user activity (audit log)."
@@ -15,18 +15,25 @@
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
-   [app.util.async :as aa]
+   [app.http.client :as http]
+   [app.loggers.audit.tasks :as-alias tasks]
+   [app.loggers.webhooks :as-alias webhooks]
+   [app.main :as-alias main]
+   [app.metrics :as mtx]
+   [app.tokens :as tokens]
    [app.util.time :as dt]
    [app.worker :as wrk]
-   [clojure.core.async :as a]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig]
    [lambdaisland.uri :as u]
    [promesa.core :as p]
    [promesa.exec :as px]
-   [yetti.request :as yrq]
-   [yetti.response :as yrs]))
+   [yetti.request :as yrq]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; HELPERS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn parse-client-ip
   [request]
@@ -48,10 +55,22 @@
                 (assoc (->> sk str/kebab (keyword "penpot")) v))))]
     (reduce-kv process-param {} params)))
 
+(def ^:private
+  profile-props
+  [:id
+   :is-active
+   :is-muted
+   :auth-backend
+   :email
+   :default-team-id
+   :default-project-id
+   :fullname
+   :lang])
+
 (defn profile->props
   [profile]
   (-> profile
-      (select-keys [:id :is-active :is-muted :auth-backend :email :default-team-id :default-project-id :fullname :lang])
+      (select-keys profile-props)
       (merge (:props profile))
       (d/without-nils)))
 
@@ -78,180 +97,119 @@
 
     (update event :props #(into {} xform %))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; HTTP Handler
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(declare persist-http-events)
+;; --- SPECS
 
 (s/def ::profile-id ::us/uuid)
 (s/def ::name ::us/string)
 (s/def ::type ::us/string)
 (s/def ::props (s/map-of ::us/keyword any?))
-(s/def ::timestamp dt/instant?)
-(s/def ::context (s/map-of ::us/keyword any?))
+(s/def ::ip-addr ::us/string)
 
-(s/def ::frontend-event
-  (s/keys :req-un [::type ::name ::props ::timestamp ::profile-id]
-          :opt-un [::context]))
+(s/def ::webhooks/event? ::us/boolean)
+(s/def ::webhooks/batch-timeout ::dt/duration)
+(s/def ::webhooks/batch-key
+  (s/or :fn fn? :str string? :kw keyword?))
 
-(s/def ::frontend-events (s/every ::frontend-event))
-
-(defmethod ig/init-key ::http-handler
-  [_  {:keys [executor pool] :as cfg}]
-  (if (or (db/read-only? pool) (not (contains? cf/flags :audit-log)))
-    (do
-      (l/warn :hint "audit log http handler disabled or db is read-only")
-      (fn [_ respond _]
-        (respond (yrs/response 204))))
-
-    (letfn [(handler [{:keys [profile-id] :as request}]
-              (let [events  (->> (:events (:params request))
-                                 (remove #(not= profile-id (:profile-id %)))
-                                 (us/conform ::frontend-events))
-
-                    ip-addr (parse-client-ip request)
-                    cfg     (-> cfg
-                                (assoc :source "frontend")
-                                (assoc :events events)
-                                (assoc :ip-addr ip-addr))]
-                (persist-http-events cfg)))
-
-            (handle-error [cause]
-              (let [xdata (ex-data cause)]
-                (if (= :spec-validation (:code xdata))
-                  (l/error ::l/raw (str "spec validation on persist-events:\n" (us/pretty-explain xdata)))
-                  (l/error :hint "error on persist-events" :cause cause))))]
-
-      (fn [request respond _]
-        ;; Fire and forget, log error in case of errro
-        (-> (px/submit! executor #(handler request))
-            (p/catch handle-error))
-
-        (respond (yrs/response 204))))))
-
-(defn- persist-http-events
-  [{:keys [pool events ip-addr source] :as cfg}]
-  (let [columns    [:id :name :source :type :tracked-at :profile-id :ip-addr :props :context]
-        prepare-xf (map (fn [event]
-                          [(uuid/next)
-                           (:name event)
-                           source
-                           (:type event)
-                           (:timestamp event)
-                           (:profile-id event)
-                           (db/inet ip-addr)
-                           (db/tjson (:props event))
-                           (db/tjson (d/without-nils (:context event)))]))]
-    (when (seq events)
-      (->> (into [] prepare-xf events)
-           (db/insert-multi! pool :audit-log columns)))))
+(s/def ::event
+  (s/keys :req-un [::type ::name ::profile-id]
+          :opt-un [::ip-addr ::props]
+          :opt [::webhooks/event?
+                ::webhooks/batch-timeout
+                ::webhooks/batch-key]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Collector
+;; COLLECTOR
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;; Defines a service that collects the audit/activity log using
 ;; internal database. Later this audit log can be transferred to
 ;; an external storage and data cleared.
 
-(declare persist-events)
+(s/def ::collector
+  (s/keys :req [::wrk/executor ::db/pool]))
 
 (defmethod ig/pre-init-spec ::collector [_]
-  (s/keys :req-un [::db/pool ::wrk/executor]))
-
-(s/def ::ip-addr string?)
-(s/def ::backend-event
-  (s/keys :req-un [::type ::name ::profile-id]
-          :opt-un [::ip-addr ::props]))
-
-(def ^:private backend-event-xform
-  (comp
-   (filter #(us/valid? ::backend-event %))
-   (map clean-props)))
+  (s/keys :req [::db/pool ::wrk/executor ::mtx/metrics]))
 
 (defmethod ig/init-key ::collector
-  [_ {:keys [pool] :as cfg}]
+  [_ {:keys [::db/pool] :as cfg}]
   (cond
-    (not (contains? cf/flags :audit-log))
-    (do
-      (l/info :hint "audit log collection disabled")
-      (constantly nil))
-
     (db/read-only? pool)
-    (do
-      (l/warn :hint "audit log collection disabled, db is read-only")
-      (constantly nil))
+    (l/warn :hint "audit: disabled (db is read-only)")
 
     :else
-    (let [input  (a/chan 512 backend-event-xform)
-          buffer (aa/batch input {:max-batch-size 100
-                                  :max-batch-age (* 10 1000) ; 10s
-                                  :init []})]
-      (l/info :hint "audit log collector initialized")
-      (a/go-loop []
-        (when-let [[_type events] (a/<! buffer)]
-          (let [res (a/<! (persist-events cfg events))]
-            (when (ex/exception? res)
-              (l/error :hint "error on persisting events" :cause res))
-            (recur))))
+    cfg))
 
-      (fn [& {:keys [cmd] :as params}]
-        (case cmd
-          :stop
-          (a/close! input)
+(defn- persist-event!
+  [pool event]
+  (us/verify! ::event event)
+  (let [params {:id (uuid/next)
+                :name (:name event)
+                :type (:type event)
+                :profile-id (:profile-id event)
+                :tracked-at (dt/now)
+                :ip-addr (:ip-addr event)
+                :props (:props event)}]
 
-          :submit
-          (let [params (-> params
-                           (dissoc :cmd)
-                           (assoc :tracked-at (dt/now)))]
-            (when-not (a/offer! input params)
-              (l/warn :hint "activity channel is full"))))))))
+    (when (contains? cf/flags :audit-log)
+      (db/insert! pool :audit-log
+                  (-> params
+                      (update :props db/tjson)
+                      (update :ip-addr db/inet)
+                      (assoc :source "backend"))))
 
-(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"])]
-    (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 (keep event->row) events)))))))
+    (when (and (contains? cf/flags :webhooks)
+               (::webhooks/event? event))
+      (let [batch-key     (::webhooks/batch-key event)
+            batch-timeout (::webhooks/batch-timeout event)]
+        (wrk/submit! ::wrk/conn pool
+                     ::wrk/task :process-webhook-event
+                     ::wrk/queue :webhooks
+                     ::wrk/max-retries 0
+                     ::wrk/delay (or batch-timeout 0)
+                     ::wrk/label (cond
+                                   (fn? batch-key)        (batch-key (:props event))
+                                   (keyword? batch-key)   (name batch-key)
+                                   (string? batch-key)    batch-key
+                                   :else                  "default")
+                     ::wrk/dedupe true
+                     ::webhooks/event (-> params
+                                          (dissoc :ip-addr)
+                                          (dissoc :type)))))))
+
+(defn submit!
+  "Submit audit event to the collector."
+  [{:keys [::wrk/executor ::db/pool] :as collector} params]
+  (us/assert! ::collector collector)
+  (->> (px/submit! executor (partial persist-event! pool (d/without-nils params)))
+       (p/merr (fn [cause]
+                 (l/error :hint "audit: unexpected error processing event" :cause cause)
+                 (p/resolved nil)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Archive Task
+;; TASK: ARCHIVE
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-;; This is a task responsible to send the accumulated events to an
+;; This is a task responsible to send the accumulated events to
 ;; external service for archival.
 
 (declare archive-events)
 
-(s/def ::http-client fn?)
-(s/def ::uri ::us/string)
-(s/def ::tokens fn?)
+(s/def ::tasks/uri ::us/string)
 
-(defmethod ig/pre-init-spec ::archive-task [_]
-  (s/keys :req-un [::db/pool ::tokens ::http-client]
-          :opt-un [::uri]))
+(defmethod ig/pre-init-spec ::tasks/archive-task [_]
+  (s/keys :req [::db/pool ::main/props ::http/client]))
 
-(defmethod ig/init-key ::archive-task
-  [_ {:keys [uri] :as cfg}]
-  (fn [props]
+(defmethod ig/init-key ::tasks/archive
+  [_ cfg]
+  (fn [params]
     ;; NOTE: this let allows overwrite default configured values from
     ;; the repl, when manually invoking the task.
     (let [enabled (or (contains? cf/flags :audit-log-archive)
-                      (:enabled props false))
-          uri     (or uri (:uri props))
-          cfg     (assoc cfg :uri uri)]
+                      (:enabled params false))
+          uri     (cf/get :audit-log-archive-uri)
+          uri     (or uri (:uri params))
+          cfg     (assoc cfg ::uri uri)]
 
       (when (and enabled (not uri))
         (ex/raise :type :internal
@@ -263,20 +221,21 @@
           (let [n (archive-events cfg)]
             (if n
               (do
-                (aa/thread-sleep 200)
+                (px/sleep 100)
                 (recur (+ total n)))
               (when (pos? total)
-                (l/trace :hint "events chunk archived" :num total)))))))))
+                (l/debug :hint "events archived" :total total)))))))))
 
-(def sql:retrieve-batch-of-audit-log
-  "select * from audit_log
+(def ^:private sql:retrieve-batch-of-audit-log
+  "select *
+     from audit_log
     where archived_at is null
     order by created_at asc
     limit 256
       for update skip locked;")
 
 (defn archive-events
-  [{:keys [pool uri tokens http-client] :as cfg}]
+  [{:keys [::db/pool ::uri] :as cfg}]
   (letfn [(decode-row [{:keys [props ip-addr context] :as row}]
             (cond-> row
               (db/pgobject? props)
@@ -300,9 +259,10 @@
                               :context]))
 
           (send [events]
-            (let [token   (tokens :generate {:iss "authentication"
-                                             :iat (dt/now)
-                                             :uid uuid/zero})
+            (let [token   (tokens/generate (::main/props cfg)
+                                           {:iss "authentication"
+                                            :iat (dt/now)
+                                            :uid uuid/zero})
                   body    (t/encode {:events events})
                   headers {"content-type" "application/transit+json"
                            "origin" (cf/get :public-uri)
@@ -312,7 +272,7 @@
                            :method :post
                            :headers headers
                            :body body}
-                  resp    (http-client params {:sync? true})]
+                  resp    (http/req! cfg params {:sync? true})]
               (if (= (:status resp) 204)
                 true
                 (do
@@ -333,7 +293,7 @@
                          (map row->event))
             events (into [] xform rows)]
         (when-not (empty? events)
-          (l/debug :action "archive-events" :uri uri :events (count events))
+          (l/trace :hint "archive events chunk" :uri uri :events (count events))
           (when (send events)
             (mark-as-archived conn rows)
             (count events)))))))
@@ -342,25 +302,21 @@
 ;; GC Task
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(def sql:clean-archived
+(def ^:private sql:clean-archived
   "delete from audit_log
-    where archived_at is not null
-      and archived_at < now() - ?::interval")
+    where archived_at is not null")
 
 (defn- clean-archived
-  [{:keys [pool max-age]}]
-  (let [interval (db/interval max-age)
-        result   (db/exec-one! pool [sql:clean-archived interval])
-        result   (:next.jdbc/update-count result)]
-    (l/debug :action "clean archived audit log" :removed result)
+  [{:keys [pool]}]
+  (let [result (db/exec-one! pool [sql:clean-archived])
+        result (:next.jdbc/update-count result)]
+    (l/debug :hint "delete archived audit log entries" :deleted result)
     result))
 
-(s/def ::max-age ::cf/audit-log-gc-max-age)
+(defmethod ig/pre-init-spec ::tasks/gc [_]
+  (s/keys :req [::db/pool]))
 
-(defmethod ig/pre-init-spec ::gc-task [_]
-  (s/keys :req-un [::db/pool ::max-age]))
-
-(defmethod ig/init-key ::gc-task
+(defmethod ig/init-key ::tasks/gc
   [_ cfg]
   (fn [_]
     (clean-archived cfg)))

backend/src/app/loggers/database.clj

@@ -2,7 +2,7 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.loggers.database
   "A specific logger impl that persists errors on the database."
@@ -46,6 +46,7 @@
 (defn parse-event
   [event]
   (-> (parse-event-data event)
+      (assoc :hint (or (:hint event) (:message event)))
       (assoc :tenant (cf/get :tenant))
       (assoc :host (cf/get :host))
       (assoc :public-uri (cf/get :public-uri))
@@ -81,7 +82,7 @@
     (a/go-loop []
       (let [msg (a/<! output)]
         (if (nil? msg)
-          (l/info :msg "stoping error reporting loop")
+          (l/info :msg "stopping error reporting loop")
           (do
             (a/<! (handle-event cfg msg))
             (recur)))))

backend/src/app/loggers/loki.clj

@@ -2,64 +2,61 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.loggers.loki
   "A Loki integration."
   (:require
    [app.common.logging :as l]
-   [app.common.spec :as us]
-   [app.config :as cfg]
+   [app.config :as cf]
+   [app.http.client :as http]
+   [app.loggers.zmq :as lzmq]
    [app.util.json :as json]
    [clojure.core.async :as a]
    [clojure.spec.alpha :as s]
-   [integrant.core :as ig]))
+   [integrant.core :as ig]
+   [promesa.exec :as px]))
 
 (declare ^:private handle-event)
-(declare ^:private start-rcv-loop)
-
-(s/def ::uri ::us/string)
-(s/def ::receiver fn?)
-(s/def ::http-client fn?)
 
 (defmethod ig/pre-init-spec ::reporter [_]
-  (s/keys :req-un [ ::receiver ::http-client]
-          :opt-un [::uri]))
+  (s/keys :req [::http/client
+                ::lzmq/receiver]))
 
 (defmethod ig/init-key ::reporter
-  [_ {:keys [receiver uri] :as cfg}]
-  (when uri
-    (l/info :msg "initializing loki reporter" :uri uri)
-    (let [input (a/chan (a/dropping-buffer 2048))]
-      (receiver :sub input)
+  [_ cfg]
+  (when-let [uri (cf/get :loggers-loki-uri)]
+    (px/thread
+      {:name "penpot/loki-reporter"}
+      (l/info :hint "reporter started" :uri uri)
+      (let [input (a/chan (a/dropping-buffer 2048))
+            cfg   (assoc cfg ::uri uri)]
 
-      (doto (Thread. #(start-rcv-loop cfg input))
-        (.setDaemon true)
-        (.setName "penpot/loki-sender")
-        (.start))
+        (try
+          (lzmq/sub! (::lzmq/receiver cfg) input)
+          (loop []
+            (when-let [msg (a/<!! input)]
+              (handle-event cfg msg)
+              (recur)))
 
-      input)))
+          (catch InterruptedException _
+            (l/debug :hint "reporter interrupted"))
+          (catch Throwable cause
+            (l/error :hint "unexpected exception"
+                     :cause cause))
+          (finally
+            (a/close! input)
+            (l/info :hint "reporter terminated")))))))
 
 (defmethod ig/halt-key! ::reporter
-  [_ output]
-  (when output
-    (a/close! output)))
-
-(defn- start-rcv-loop
-  [cfg input]
-  (loop []
-    (let [msg (a/<!! input)]
-      (when-not (nil? msg)
-        (handle-event cfg msg)
-        (recur))))
-
-  (l/info :msg "stoping error reporting loop"))
+  [_ thread]
+  (some-> thread px/interrupt!))
 
 (defn- prepare-payload
   [event]
-  (let [labels {:host    (cfg/get :host)
-                :tenant  (cfg/get :tenant)
-                :version (:full cfg/version)
+  (let [labels {:host    (cf/get :host)
+                :tenant  (cf/get :tenant)
+                :version (:full cf/version)
                 :logger  (:logger/name event)
                 :level   (:logger/level event)}]
     {:streams
@@ -69,15 +66,15 @@
                       (when-let [error (:trace event)]
                         (str "\n" error)))]]}]}))
 
-
 (defn- make-request
-  [{:keys [http-client uri] :as cfg} payload]
-  (http-client {:uri uri
-                :timeout 3000
-                :method :post
-                :headers {"content-type" "application/json"}
-                :body (json/write payload)}
-               {:sync? true}))
+  [{:keys [::uri] :as cfg} payload]
+  (http/req! cfg
+             {:uri uri
+              :timeout 3000
+              :method :post
+              :headers {"content-type" "application/json"}
+              :body (json/encode payload)}
+             {:sync? true}))
 
 (defn- handle-event
   [cfg event]
@@ -85,7 +82,6 @@
     (let [payload  (prepare-payload event)
           response (make-request cfg payload)]
       (when-not (= 204 (:status response))
-        (map? response)
         (l/error :hint "error on sending log to loki (unexpected response)"
                  :response (pr-str response))))
     (catch Throwable cause

backend/src/app/loggers/mattermost.clj

@@ -2,74 +2,76 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.loggers.mattermost
   "A mattermost integration for error reporting."
   (:require
    [app.common.logging :as l]
    [app.config :as cf]
+   [app.http.client :as http]
    [app.loggers.database :as ldb]
+   [app.loggers.zmq :as lzmq]
    [app.util.json :as json]
    [clojure.core.async :as a]
    [clojure.spec.alpha :as s]
    [integrant.core :as ig]
-   [promesa.core :as p]))
+   [promesa.exec :as px]))
 
 (defonce enabled (atom true))
 
 (defn- send-mattermost-notification!
-  [{:keys [http-client] :as cfg} {:keys [host id public-uri] :as event}]
-  (let [uri  (:uri cfg)
-        text (str "Exception on (host: " host ", url: " public-uri "/dbg/error/" id ")\n"
-                  (when-let [pid (:profile-id event)]
-                    (str "- profile-id: #uuid-" pid "\n")))]
-    (p/then
-     (http-client {:uri uri
-                   :method :post
-                   :headers {"content-type" "application/json"}
-                   :body (json/write-str {:text text})})
-     (fn [{:keys [status] :as rsp}]
-       (when (not= status 200)
-         (l/warn :hint "error on sending data to mattermost"
-                 :response (pr-str rsp)))))))
+  [cfg {:keys [host id public-uri] :as event}]
+  (let [text (str "Exception on (host: " host ", url: " public-uri "/dbg/error/" id ")\n"
+             (when-let [pid (:profile-id event)]
+               (str "- profile-id: #uuid-" pid "\n")))
+        resp (http/req! cfg
+                        {:uri (cf/get :error-report-webhook)
+                         :method :post
+                         :headers {"content-type" "application/json"}
+                         :body (json/encode-str {:text text})}
+                        {:sync? true})]
+
+    (when (not= 200 (:status resp))
+      (l/warn :hint "error on sending data"
+              :response (pr-str resp)))))
 
 (defn handle-event
   [cfg event]
-  (let [ch (a/chan)]
-    (-> (p/let [event (ldb/parse-event event)]
-          (send-mattermost-notification! cfg event))
-        (p/finally (fn [_ cause]
-                     (when cause
-                       (l/warn :hint "unexpected exception on error reporter" :cause cause))
-                     (a/close! ch))))
-    ch))
-
-(s/def ::http-client fn?)
-(s/def ::uri ::cf/error-report-webhook)
+  (try
+    (let [event (ldb/parse-event event)]
+      (when @enabled
+        (send-mattermost-notification! cfg event)))
+    (catch Throwable cause
+      (l/warn :hint "unhandled error"
+              :cause cause))))
 
 (defmethod ig/pre-init-spec ::reporter [_]
-  (s/keys :req-un [::http-client ::receiver]
-          :opt-un [::uri]))
+  (s/keys :req [::http/client
+                ::lzmq/receiver]))
 
 (defmethod ig/init-key ::reporter
-  [_ {:keys [receiver uri] :as cfg}]
-  (when uri
-    (l/info :msg "initializing mattermost error reporter" :uri uri)
-    (let [output (a/chan (a/sliding-buffer 128)
-                         (filter (fn [event]
-                                   (= (:logger/level event) "error"))))]
-      (receiver :sub output)
-      (a/go-loop []
-        (let [msg (a/<! output)]
-          (if (nil? msg)
-            (l/info :msg "stoping error reporting loop")
-            (do
-              (a/<! (handle-event cfg msg))
-              (recur)))))
-      output)))
+  [_ cfg]
+  (when-let [uri (cf/get :error-report-webhook)]
+    (px/thread
+      {:name "penpot/mattermost-reporter"}
+      (l/info :msg "initializing error reporter" :uri uri)
+      (let [input (a/chan (a/sliding-buffer 128)
+                          (filter #(= (:logger/level %) "error")))]
+        (try
+          (lzmq/sub! (::lzmq/receiver cfg) input)
+          (loop []
+            (when-let [msg (a/<!! input)]
+              (handle-event cfg msg)
+              (recur)))
+          (catch InterruptedException _
+            (l/debug :hint "reporter interrupted"))
+          (catch Throwable cause
+            (l/error :hint "unexpected error" :cause cause))
+          (finally
+            (a/close! input)
+            (l/info :hint "reporter terminated")))))))
 
 (defmethod ig/halt-key! ::reporter
-  [_ output]
-  (when output
-    (a/close! output)))
+  [_ thread]
+  (some-> thread px/interrupt!))

backend/src/app/loggers/sentry.clj

@@ -1,170 +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.loggers.sentry
-  "A mattermost integration for error reporting."
-  (:require
-   [app.common.logging :as l]
-   [app.common.uuid :as uuid]
-   [app.config :as cf]
-   [app.db :as db]
-   [app.util.async :as aa]
-   [app.worker :as wrk]
-   [clojure.core.async :as a]
-   [clojure.spec.alpha :as s]
-   [cuerdas.core :as str]
-   [integrant.core :as ig])
-  (:import
-   io.sentry.Scope
-   io.sentry.IHub
-   io.sentry.Hub
-   io.sentry.NoOpHub
-   io.sentry.protocol.User
-   io.sentry.SentryOptions
-   io.sentry.SentryLevel
-   io.sentry.ScopeCallback))
-
-(defonce enabled (atom true))
-
-(defn- parse-context
-  [event]
-  (reduce-kv
-   (fn [acc k v]
-     (cond
-       (= k :id)         (assoc acc k (uuid/uuid v))
-       (= k :profile-id) (assoc acc k (uuid/uuid v))
-       (str/blank? v)    acc
-       :else             (assoc acc k v)))
-   {}
-   (:context event)))
-
-(defn- parse-event
-  [event]
-  (assoc event :context (parse-context event)))
-
-(defn- build-sentry-options
-  [cfg]
-  (let [version (:base cf/version)]
-    (doto (SentryOptions.)
-      (.setDebug (:debug cfg false))
-      (.setTracesSampleRate (:traces-sample-rate cfg 1.0))
-      (.setDsn (:dsn cfg))
-      (.setServerName (cf/get :host))
-      (.setEnvironment (cf/get :tenant))
-      (.setAttachServerName true)
-      (.setAttachStacktrace (:attach-stack-trace cfg false))
-      (.setRelease (str "backend@" (if (= version "0.0.0") "develop" version))))))
-
-(defn handle-event
-  [^IHub shub event]
-  (letfn [(set-user! [^Scope scope {:keys [context] :as event}]
-            (let [user (User.)]
-              (.setIpAddress ^User user ^String (:ip-addr context))
-              (when-let [pid (:profile-id context)]
-                (.setId ^User user ^String (str pid)))
-              (.setUser scope ^User user)))
-
-          (set-level! [^Scope scope]
-            (.setLevel scope SentryLevel/ERROR))
-
-          (set-context! [^Scope scope {:keys [context] :as event}]
-            (let [uri (str (cf/get :public-uri) "/dbg/error-by-id/" (:id context))]
-              (.setContexts scope "detailed_error_uri" ^String uri))
-            (when-let [vers (:frontend-version event)]
-              (.setContexts scope "frontend_version" ^String vers))
-            (when-let [puri (:public-uri event)]
-              (.setContexts scope "public_uri" ^String (str puri)))
-            (when-let [uagent (:user-agent context)]
-              (.setContexts scope "user_agent" ^String uagent))
-            (when-let [tenant (:tenant event)]
-              (.setTag scope "tenant" ^String tenant))
-            (when-let [type (:error-type context)]
-              (.setTag scope "error_type" ^String  (str type)))
-            (when-let [code (:error-code context)]
-              (.setTag scope "error_code" ^String (str code)))
-            )
-
-          (capture [^Scope scope {:keys [context error] :as event}]
-            (let [msg   (str (:message error) "\n\n"
-
-                             "======================================================\n"
-                             "=================== Params ===========================\n"
-                             "======================================================\n"
-
-                             (:params context) "\n"
-
-                             (when (:explain context)
-                               (str "======================================================\n"
-                                    "=================== Explain ==========================\n"
-                                    "======================================================\n"
-                                    (:explain context) "\n"))
-
-                             (when (:data context)
-                               (str "======================================================\n"
-                                    "=================== Error Data =======================\n"
-                                    "======================================================\n"
-                                    (:data context) "\n"))
-
-                             (str "======================================================\n"
-                                  "=================== Stack Trace ======================\n"
-                                  "======================================================\n"
-                                  (:trace error))
-
-                             "\n")]
-              (set-user! scope event)
-              (set-level! scope)
-              (set-context! scope event)
-              (.captureMessage ^IHub shub msg)
-              ))
-          ]
-    (when @enabled
-      (.withScope ^IHub shub (reify ScopeCallback
-                               (run [_ scope]
-                                 (->> event
-                                      (parse-event)
-                                      (capture scope))))))
-
-    ))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Error Listener
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(s/def ::receiver any?)
-(s/def ::dsn ::cf/sentry-dsn)
-(s/def ::trace-sample-rate ::cf/sentry-trace-sample-rate)
-(s/def ::attach-stack-trace ::cf/sentry-attach-stack-trace)
-(s/def ::debug ::cf/sentry-debug)
-
-(defmethod ig/pre-init-spec ::reporter [_]
-  (s/keys :req-un [::wrk/executor ::db/pool ::receiver]
-          :opt-un [::dsn ::trace-sample-rate ::attach-stack-trace]))
-
-(defmethod ig/init-key ::reporter
-  [_ {:keys [receiver dsn executor] :as cfg}]
-  (l/info :msg "initializing sentry reporter" :dsn dsn)
-  (let [opts   (build-sentry-options cfg)
-        shub   (if dsn
-                 (Hub. ^SentryOptions opts)
-                 (NoOpHub/getInstance))
-        output (a/chan (a/sliding-buffer 128)
-                       (filter #(= (:level %) "error")))]
-    (receiver :sub output)
-    (a/go-loop []
-      (let [event (a/<! output)]
-        (if (nil? event)
-          (do
-            (l/info :msg "stoping error reporting loop")
-            (.close ^IHub shub))
-          (do
-            (a/<! (aa/with-thread executor (handle-event shub event)))
-            (recur)))))
-    output))
-
-(defmethod ig/halt-key! ::reporter
-  [_ output]
-  (when output
-    (a/close! output)))

backend/src/app/loggers/webhooks.clj

@@ -0,0 +1,174 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.loggers.webhooks
+  "A mattermost integration for error reporting."
+  (:require
+   [app.common.data :as d]
+   [app.common.logging :as l]
+   [app.common.transit :as t]
+   [app.common.uri :as uri]
+   [app.config :as cf]
+   [app.db :as db]
+   [app.http.client :as http]
+   [app.util.json :as json]
+   [app.util.time :as dt]
+   [app.worker :as wrk]
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [integrant.core :as ig]))
+
+;; --- PROC
+
+(defn- lookup-webhooks-by-team
+  [pool team-id]
+  (db/exec! pool ["select * from webhook where team_id=? and is_active=true" team-id]))
+
+(defn- lookup-webhooks-by-project
+  [pool project-id]
+  (let [sql [(str "select * from webhook as w"
+                  "  join project as p on (p.team_id = w.team_id)"
+                  " where p.id = ? and w.is_active = true")
+             project-id]]
+    (db/exec! pool sql)))
+
+(defn- lookup-webhooks-by-file
+  [pool file-id]
+  (let [sql [(str "select * from webhook as w"
+                  "  join project as p on (p.team_id = w.team_id)"
+                  "  join file as f on (f.project_id = p.id)"
+                  " where f.id = ? and w.is_active = true")
+             file-id]]
+    (db/exec! pool sql)))
+
+(defn- lookup-webhooks
+  [{:keys [::db/pool]} {:keys [props] :as event}]
+  (or (some->> (:team-id props) (lookup-webhooks-by-team pool))
+      (some->> (:project-id props) (lookup-webhooks-by-project pool))
+      (some->> (:file-id props) (lookup-webhooks-by-file pool))))
+
+(defmethod ig/pre-init-spec ::process-event-handler [_]
+  (s/keys :req [::db/pool]))
+
+(defmethod ig/init-key ::process-event-handler
+  [_ {:keys [::db/pool] :as cfg}]
+  (fn [{:keys [props] :as task}]
+    (let [event (::event props)]
+
+      (l/debug :hint "process webhook event"
+               :name (:name event))
+
+      (when-let [items (lookup-webhooks cfg event)]
+        ;; (app.common.pprint/pprint items)
+        (l/trace :hint "webhooks found for event" :total (count items))
+
+        (db/with-atomic [conn pool]
+          (doseq [item items]
+            (wrk/submit! ::wrk/conn conn
+                         ::wrk/task :run-webhook
+                         ::wrk/queue :webhooks
+                         ::wrk/max-retries 3
+                         ::event event
+                         ::config item)))))))
+
+;; --- RUN
+
+(declare interpret-exception)
+(declare interpret-response)
+
+(def ^:private json-mapper
+  (json/mapper
+   {:encode-key-fn str/camel
+    :decode-key-fn (comp keyword str/kebab)
+    :pretty true}))
+
+(defmethod ig/pre-init-spec ::run-webhook-handler [_]
+  (s/keys :req [::http/client ::db/pool]))
+
+(defmethod ig/prep-key ::run-webhook-handler
+  [_ cfg]
+  (merge {::max-errors 3} (d/without-nils cfg)))
+
+(defmethod ig/init-key ::run-webhook-handler
+  [_ {:keys [::db/pool ::max-errors] :as cfg}]
+  (letfn [(update-webhook! [whook err]
+            (if err
+              (let [sql [(str "update webhook "
+                              "   set error_code=?, "
+                              "       error_count=error_count+1 "
+                              " where id=?")
+                         err
+                         (:id whook)]
+                    res (db/exec-one! pool sql {:return-keys true})]
+                (when (>= (:error-count res) max-errors)
+                  (db/update! pool :webhook {:is-active false} {:id (:id whook)})))
+
+              (db/update! pool :webhook
+                          {:updated-at (dt/now)
+                           :error-code nil
+                           :error-count 0}
+                          {:id (:id whook)})))
+
+          (report-delivery! [whook req rsp err]
+            (db/insert! pool :webhook-delivery
+                        {:webhook-id (:id whook)
+                         :created-at (dt/now)
+                         :error-code err
+                         :req-data (db/tjson req)
+                         :rsp-data (db/tjson rsp)}))]
+
+    (fn [{:keys [props] :as task}]
+      (let [event (::event props)
+            whook (::config props)
+
+            body  (case (:mtype whook)
+                    "application/json" (json/encode-str event json-mapper)
+                    "application/transit+json" (t/encode-str event)
+                    "application/x-www-form-urlencoded" (uri/map->query-string event))]
+
+        (l/debug :hint "run webhook"
+                 :event-name (:name event)
+                 :webhook-id (:id whook)
+                 :webhook-uri (:uri whook)
+                 :webhook-mtype (:mtype whook))
+
+        (let [req {:uri (:uri whook)
+                   :headers {"content-type" (:mtype whook)
+                             "user-agent" (str/ffmt "penpot/%" (:main cf/version))}
+                   :timeout (dt/duration "4s")
+                   :method :post
+                   :body body}]
+          (try
+            (let [rsp (http/req! cfg req {:response-type :input-stream :sync? true})
+                  err (interpret-response rsp)]
+              (report-delivery! whook req rsp err)
+              (update-webhook! whook err))
+            (catch Throwable cause
+              (let [err (interpret-exception cause)]
+                (report-delivery! whook req nil err)
+                (update-webhook! whook err)
+                (when (= err "unknown")
+                  (l/error :hint "unknown error on webhook request"
+                           :cause cause))))))))))
+
+(defn interpret-response
+  [{:keys [status] :as response}]
+  (when-not (or (= 200 status)
+                (= 204 status))
+    (str/ffmt "unexpected-status:%" status)))
+
+(defn interpret-exception
+  [cause]
+  (cond
+    (instance? javax.net.ssl.SSLHandshakeException cause)
+    "ssl-validation-error"
+
+    (instance? java.net.ConnectException cause)
+    "connection-error"
+
+    (instance? java.net.http.HttpConnectTimeoutException cause)
+    "timeout"
+    ))

backend/src/app/loggers/zmq.clj

@@ -2,20 +2,22 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.loggers.zmq
   "A generic ZMQ listener."
   (:require
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
-   [app.common.spec :as us]
+   [app.config :as cf]
+   [app.loggers.zmq.receiver :as-alias receiver]
    [app.util.json :as json]
    [app.util.time :as dt]
    [clojure.core.async :as a]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
-   [integrant.core :as ig])
+   [integrant.core :as ig]
+   [promesa.exec :as px])
   (:import
    org.zeromq.SocketType
    org.zeromq.ZMQ$Socket
@@ -24,38 +26,56 @@
 (declare prepare)
 (declare start-rcv-loop)
 
-(s/def ::endpoint ::us/string)
-
-(defmethod ig/pre-init-spec ::receiver [_]
-  (s/keys :opt-un [::endpoint]))
-
 (defmethod ig/init-key ::receiver
-  [_ {:keys [endpoint] :as cfg}]
-  (l/info :msg "initializing ZMQ receiver" :bind endpoint)
-  (let [buffer (a/chan 1)
+  [_ cfg]
+  (let [uri    (cf/get :loggers-zmq-uri)
+        buffer (a/chan 1)
         output (a/chan 1 (comp (filter map?)
                                (keep prepare)))
-        mult   (a/mult output)]
-    (when endpoint
-      (let [thread (Thread. #(start-rcv-loop {:out buffer :endpoint endpoint}))]
-        (.setDaemon thread false)
-        (.setName thread "penpot/zmq-logger-receiver")
-        (.start thread)))
+        mult   (a/mult output)
+        thread (when uri
+                 (px/thread
+                   {:name "penpot/zmq-receiver"
+                    :daemon false}
+                   (l/info :hint "receiver started")
+                   (try
+                     (start-rcv-loop buffer uri)
+                     (catch InterruptedException _
+                       (l/debug :hint "receiver interrupted"))
+                     (catch java.lang.IllegalStateException cause
+                       (if (= "errno 4" (ex-message cause))
+                         (l/debug :hint "receiver interrupted")
+                         (l/error :hint "unhandled error" :cause cause)))
+                     (catch Throwable cause
+                       (l/error :hint "unhandled error" :cause cause))
+                     (finally
+                       (l/info :hint "receiver terminated")))))]
 
     (a/pipe buffer output)
-    (with-meta
-      (fn [cmd ch]
-        (case cmd
-          :sub (a/tap mult ch)
-          :unsub (a/untap mult ch))
-        ch)
-      {::output output
-       ::buffer buffer
-       ::mult mult})))
+    (-> cfg
+        (assoc ::receiver/mult mult)
+        (assoc ::receiver/thread thread)
+        (assoc ::receiver/output output)
+        (assoc ::receiver/buffer buffer))))
+
+(s/def ::receiver/mult some?)
+(s/def ::receiver/thread #(instance? Thread %))
+(s/def ::receiver/output some?)
+(s/def ::receiver/buffer some?)
+(s/def ::receiver
+  (s/keys :req [::receiver/mult
+                ::receiver/thread
+                ::receiver/output
+                ::receiver/buffer]))
+
+(defn sub!
+  [{:keys [::receiver/mult]} ch]
+  (a/tap mult ch))
 
 (defmethod ig/halt-key! ::receiver
-  [_ f]
-  (a/close! (::buffer (meta f))))
+  [_ {:keys [::receiver/buffer ::receiver/thread]}]
+  (some-> thread px/interrupt!)
+  (some-> buffer a/close!))
 
 (def ^:private json-mapper
   (json/mapper
@@ -63,23 +83,23 @@
     :decode-key-fn (comp keyword str/kebab)}))
 
 (defn- start-rcv-loop
-  ([] (start-rcv-loop nil))
-  ([{:keys [out endpoint] :or {endpoint "tcp://localhost:5556"}}]
-   (let [out    (or out (a/chan 1))
-         zctx   (ZContext. 1)
-         socket (.. zctx (createSocket SocketType/SUB))]
-     (.. socket (connect ^String endpoint))
-     (.. socket (subscribe ""))
-     (.. socket (setReceiveTimeOut 5000))
-     (loop []
-       (let [msg (.recv ^ZMQ$Socket socket)
-             msg (ex/ignoring (json/read msg json-mapper))
-             msg (if (nil? msg) :empty msg)]
-         (if (a/>!! out msg)
-           (recur)
-           (do
-             (.close ^java.lang.AutoCloseable socket)
-             (.destroy ^ZContext zctx))))))))
+  [output endpoint]
+  (let [zctx   (ZContext. 1)
+        socket (.. zctx (createSocket SocketType/SUB))]
+    (try
+      (.. socket (connect ^String endpoint))
+      (.. socket (subscribe ""))
+      (.. socket (setReceiveTimeOut 5000))
+      (loop []
+        (let [msg (.recv ^ZMQ$Socket socket)
+              msg (ex/ignoring (json/decode msg json-mapper))
+              msg (if (nil? msg) :empty msg)]
+          (when (a/>!! output msg)
+            (recur))))
+
+      (finally
+        (.close ^java.lang.AutoCloseable socket)
+        (.destroy ^ZContext zctx)))))
 
 (s/def ::logger-name string?)
 (s/def ::level string?)

backend/src/app/main.clj

@@ -2,115 +2,231 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.main
   (:require
-   [app.auth.oidc]
+   [app.auth.oidc :as-alias oidc]
+   [app.auth.oidc.providers :as-alias oidc.providers]
    [app.common.logging :as l]
    [app.config :as cf]
+   [app.db :as-alias db]
+   [app.http.client :as-alias http.client]
+   [app.http.session :as-alias http.session]
+   [app.loggers.audit :as-alias audit]
+   [app.loggers.audit.tasks :as-alias audit.tasks]
+   [app.loggers.webhooks :as-alias webhooks]
+   [app.loggers.zmq :as-alias lzmq]
+   [app.metrics :as-alias mtx]
+   [app.metrics.definition :as-alias mdef]
+   [app.redis :as-alias rds]
+   [app.storage :as-alias sto]
    [app.util.time :as dt]
+   [app.worker :as-alias wrk]
+   [cuerdas.core :as str]
    [integrant.core :as ig])
   (:gen-class))
 
+(def default-metrics
+  {:update-file-changes
+   {::mdef/name "penpot_rpc_update_file_changes_total"
+    ::mdef/help "A total number of changes submitted to update-file."
+    ::mdef/type :counter}
+
+   :update-file-bytes-processed
+   {::mdef/name "penpot_rpc_update_file_bytes_processed_total"
+    ::mdef/help "A total number of bytes processed by update-file."
+    ::mdef/type :counter}
+
+   :rpc-mutation-timing
+   {::mdef/name "penpot_rpc_mutation_timing"
+    ::mdef/help "RPC mutation method call timing."
+    ::mdef/labels ["name"]
+    ::mdef/type :histogram}
+
+   :rpc-command-timing
+   {::mdef/name "penpot_rpc_command_timing"
+    ::mdef/help "RPC command method call timing."
+    ::mdef/labels ["name"]
+    ::mdef/type :histogram}
+
+   :rpc-query-timing
+   {::mdef/name "penpot_rpc_query_timing"
+    ::mdef/help "RPC query method call timing."
+    ::mdef/labels ["name"]
+    ::mdef/type :histogram}
+
+   :websocket-active-connections
+   {::mdef/name "penpot_websocket_active_connections"
+    ::mdef/help "Active websocket connections gauge"
+    ::mdef/type :gauge}
+
+   :websocket-messages-total
+   {::mdef/name "penpot_websocket_message_total"
+    ::mdef/help "Counter of processed messages."
+    ::mdef/labels ["op"]
+    ::mdef/type :counter}
+
+   :websocket-session-timing
+   {::mdef/name "penpot_websocket_session_timing"
+    ::mdef/help "Websocket session timing (seconds)."
+    ::mdef/type :summary}
+
+   :session-update-total
+   {::mdef/name "penpot_http_session_update_total"
+    ::mdef/help "A counter of session update batch events."
+    ::mdef/type :counter}
+
+   :tasks-timing
+   {::mdef/name "penpot_tasks_timing"
+    ::mdef/help "Background tasks timing (milliseconds)."
+    ::mdef/labels ["name"]
+    ::mdef/type :summary}
+
+   :redis-eval-timing
+   {::mdef/name "penpot_redis_eval_timing"
+    ::mdef/help "Redis EVAL commands execution timings (ms)"
+    ::mdef/labels ["name"]
+    ::mdef/type :summary}
+
+   :rpc-climit-queue-size
+   {::mdef/name "penpot_rpc_climit_queue_size"
+    ::mdef/help "Current number of queued submissions on the CLIMIT."
+    ::mdef/labels ["name"]
+    ::mdef/type :gauge}
+
+   :rpc-climit-concurrency
+   {::mdef/name "penpot_rpc_climit_concurrency"
+    ::mdef/help "Current number of used concurrency capacity on the CLIMIT"
+    ::mdef/labels ["name"]
+    ::mdef/type :gauge}
+
+   :rpc-climit-timing
+   {::mdef/name "penpot_rpc_climit_timing"
+    ::mdef/help "Summary of the time between queuing and executing on the CLIMIT"
+    ::mdef/labels ["name"]
+    ::mdef/type :summary}
+
+   :audit-http-handler-queue-size
+   {::mdef/name "penpot_audit_http_handler_queue_size"
+    ::mdef/help "Current number of queued submissions on the audit log http handler"
+    ::mdef/labels []
+    ::mdef/type :gauge}
+
+   :audit-http-handler-concurrency
+   {::mdef/name "penpot_audit_http_handler_concurrency"
+    ::mdef/help "Current number of used concurrency capacity on the audit log http handler"
+    ::mdef/labels []
+    ::mdef/type :gauge}
+
+   :audit-http-handler-timing
+   {::mdef/name "penpot_audit_http_handler_timing"
+    ::mdef/help "Summary of the time between queuing and executing on the audit log http handler"
+    ::mdef/labels []
+    ::mdef/type :summary}
+
+   :executors-active-threads
+   {::mdef/name "penpot_executors_active_threads"
+    ::mdef/help "Current number of threads available in the executor service."
+    ::mdef/labels ["name"]
+    ::mdef/type :gauge}
+
+   :executors-completed-tasks
+   {::mdef/name "penpot_executors_completed_tasks_total"
+    ::mdef/help "Approximate number of completed tasks by the executor."
+    ::mdef/labels ["name"]
+    ::mdef/type :counter}
+
+   :executors-running-threads
+   {::mdef/name "penpot_executors_running_threads"
+    ::mdef/help "Current number of threads with state RUNNING."
+    ::mdef/labels ["name"]
+    ::mdef/type :gauge}
+
+   :executors-queued-submissions
+   {::mdef/name "penpot_executors_queued_submissions"
+    ::mdef/help "Current number of queued submissions."
+    ::mdef/labels ["name"]
+    ::mdef/type :gauge}})
+
 (def system-config
-  {:app.db/pool
+  {::db/pool
    {:uri        (cf/get :database-uri)
     :username   (cf/get :database-username)
     :password   (cf/get :database-password)
     :read-only  (cf/get :database-readonly false)
-    :metrics    (ig/ref :app.metrics/metrics)
+    :metrics    (ig/ref ::mtx/metrics)
     :migrations (ig/ref :app.migrations/all)
     :name       :main
     :min-size   (cf/get :database-min-pool-size 0)
-    :max-size   (cf/get :database-max-pool-size 30)}
+    :max-size   (cf/get :database-max-pool-size 60)}
 
    ;; Default thread pool for IO operations
-   [::default :app.worker/executor]
-   {:parallelism (cf/get :default-executor-parallelism 60)
-    :prefix :default}
+   ::wrk/executor
+   {::wrk/parallelism (cf/get :default-executor-parallelism 100)}
 
-   ;; Constrained thread pool. Should only be used from high resources
-   ;; demanding operations.
-   [::blocking :app.worker/executor]
-   {:parallelism (cf/get :blocking-executor-parallelism 10)
-    :prefix :blocking}
+   ::wrk/scheduled-executor
+   {::wrk/parallelism (cf/get :scheduled-executor-parallelism 20)}
 
-   ;; Dedicated thread pool for backround tasks execution.
-   [::worker :app.worker/executor]
-   {:parallelism (cf/get :worker-executor-parallelism 10)
-    :prefix :worker}
-
-   :app.worker/scheduler
-   {:parallelism 1
-    :prefix :scheduler}
-
-   :app.worker/executors
-   {:default  (ig/ref [::default :app.worker/executor])
-    :worker   (ig/ref [::worker :app.worker/executor])
-    :blocking (ig/ref [::blocking :app.worker/executor])}
-
-   :app.worker/executors-monitor
-   {:metrics   (ig/ref :app.metrics/metrics)
-    :scheduler (ig/ref :app.worker/scheduler)
-    :executors (ig/ref :app.worker/executors)}
+   ::wrk/monitor
+   {::mtx/metrics  (ig/ref ::mtx/metrics)
+    ::wrk/name     "default"
+    ::wrk/executor (ig/ref ::wrk/executor)}
 
    :app.migrations/migrations
    {}
 
-   :app.metrics/metrics
-   {}
+   ::mtx/metrics
+   {:default default-metrics}
 
    :app.migrations/all
    {:main (ig/ref :app.migrations/migrations)}
 
+   ::rds/redis
+   {::rds/uri     (cf/get :redis-uri)
+    ::mtx/metrics (ig/ref ::mtx/metrics)}
+
    :app.msgbus/msgbus
    {:backend   (cf/get :msgbus-backend :redis)
-    :executor  (ig/ref [::default :app.worker/executor])
-    :redis-uri (cf/get :redis-uri)}
-
-   :app.tokens/tokens
-   {:keys (ig/ref :app.setup/keys)}
+    :executor  (ig/ref ::wrk/executor)
+    :redis     (ig/ref ::rds/redis)}
 
    :app.storage.tmp/cleaner
-   {:executor (ig/ref [::worker :app.worker/executor])
-    :scheduler (ig/ref :app.worker/scheduler)}
+   {::wrk/executor (ig/ref ::wrk/executor)
+    ::wrk/scheduled-executor (ig/ref ::wrk/scheduled-executor)}
 
-   :app.storage/gc-deleted-task
-   {:pool     (ig/ref :app.db/pool)
-    :storage  (ig/ref :app.storage/storage)
-    :executor (ig/ref [::worker :app.worker/executor])}
+   ::sto/gc-deleted-task
+   {:pool     (ig/ref ::db/pool)
+    :storage  (ig/ref ::sto/storage)
+    :executor (ig/ref ::wrk/executor)}
 
-   :app.storage/gc-touched-task
-   {:pool (ig/ref :app.db/pool)}
+   ::sto/gc-touched-task
+   {:pool (ig/ref ::db/pool)}
 
-   :app.http/client
-   {:executor (ig/ref [::default :app.worker/executor])}
+   ::http.client/client
+   {::wrk/executor (ig/ref ::wrk/executor)}
 
-   :app.http/session
-   {:store (ig/ref :app.http.session/store)}
-
-   :app.http.session/store
-   {:pool     (ig/ref :app.db/pool)
-    :tokens   (ig/ref :app.tokens/tokens)
-    :executor (ig/ref [::default :app.worker/executor])}
+   :app.http.session/manager
+   {:pool     (ig/ref ::db/pool)
+    :sprops   (ig/ref :app.setup/props)
+    :executor (ig/ref ::wrk/executor)}
 
    :app.http.session/gc-task
-   {:pool        (ig/ref :app.db/pool)
+   {:pool        (ig/ref ::db/pool)
     :max-age     (cf/get :auth-token-cookie-max-age)}
 
    :app.http.awsns/handler
-   {:tokens      (ig/ref :app.tokens/tokens)
-    :pool        (ig/ref :app.db/pool)
-    :http-client (ig/ref :app.http/client)
-    :executor    (ig/ref [::worker :app.worker/executor])}
+   {::props              (ig/ref :app.setup/props)
+    ::db/pool            (ig/ref ::db/pool)
+    ::http.client/client (ig/ref ::http.client/client)
+    ::wrk/executor       (ig/ref ::wrk/executor)}
 
    :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)
-    :executor    (ig/ref [::default :app.worker/executor])
+    :metrics     (ig/ref ::mtx/metrics)
+    :executor    (ig/ref ::wrk/executor)
     :io-threads  (cf/get :http-server-io-threads)
     :max-body-size           (cf/get :http-server-max-body-size)
     :max-multipart-body-size (cf/get :http-server-max-multipart-body-size)}
@@ -129,104 +245,99 @@
     :bind-password  (cf/get :ldap-bind-password)
     :enabled?       (contains? cf/flags :login-with-ldap)}
 
-   :app.auth.oidc/google-provider
-   {:enabled?      (contains? cf/flags :login-with-google)
-    :client-id     (cf/get :google-client-id)
-    :client-secret (cf/get :google-client-secret)}
+   ::oidc.providers/google
+   {}
 
-   :app.auth.oidc/github-provider
-   {:enabled?      (contains? cf/flags :login-with-github)
-    :http-client   (ig/ref :app.http/client)
-    :client-id     (cf/get :github-client-id)
-    :client-secret (cf/get :github-client-secret)}
+   ::oidc.providers/github
+   {::http.client/client (ig/ref ::http.client/client)}
 
-   :app.auth.oidc/gitlab-provider
-   {:enabled?      (contains? cf/flags :login-with-gitlab)
-    :base-uri      (cf/get :gitlab-base-uri "https://gitlab.com")
-    :client-id     (cf/get :gitlab-client-id)
-    :client-secret (cf/get :gitlab-client-secret)}
+   ::oidc.providers/gitlab
+   {}
 
-   :app.auth.oidc/generic-provider
-   {:enabled?      (contains? cf/flags :login-with-oidc)
-    :http-client   (ig/ref :app.http/client)
+   ::oidc.providers/generic
+   {::http.client/client (ig/ref ::http.client/client)}
 
-    :client-id     (cf/get :oidc-client-id)
-    :client-secret (cf/get :oidc-client-secret)
+   ::oidc/routes
+   {::http.client/client   (ig/ref ::http.client/client)
+    ::db/pool              (ig/ref ::db/pool)
+    ::props                (ig/ref :app.setup/props)
+    ::wrk/executor         (ig/ref ::wrk/executor)
+    ::oidc/providers       {:google (ig/ref ::oidc.providers/google)
+                            :github (ig/ref ::oidc.providers/github)
+                            :gitlab (ig/ref ::oidc.providers/gitlab)
+                            :oidc   (ig/ref ::oidc.providers/generic)}
+    ::audit/collector      (ig/ref ::audit/collector)
+    ::http.session/session (ig/ref :app.http.session/manager)}
 
-    :base-uri      (cf/get :oidc-base-uri)
-
-    :token-uri     (cf/get :oidc-token-uri)
-    :auth-uri      (cf/get :oidc-auth-uri)
-    :user-uri      (cf/get :oidc-user-uri)
-
-    :scopes        (cf/get :oidc-scopes)
-    :roles-attr    (cf/get :oidc-roles-attr)
-    :roles         (cf/get :oidc-roles)}
-
-   :app.auth.oidc/routes
-   {:providers   {:google (ig/ref :app.auth.oidc/google-provider)
-                  :github (ig/ref :app.auth.oidc/github-provider)
-                  :gitlab (ig/ref :app.auth.oidc/gitlab-provider)
-                  :oidc   (ig/ref :app.auth.oidc/generic-provider)}
-    :tokens      (ig/ref :app.tokens/tokens)
-    :http-client (ig/ref :app.http/client)
-    :pool        (ig/ref :app.db/pool)
-    :session     (ig/ref :app.http/session)
-    :public-uri  (cf/get :public-uri)
-    :executor    (ig/ref [::default :app.worker/executor])}
 
+   ;; TODO: revisit the dependencies of this service, looks they are too much unused of them
    :app.http/router
    {:assets        (ig/ref :app.http.assets/handlers)
     :feedback      (ig/ref :app.http.feedback/handler)
-    :session       (ig/ref :app.http/session)
+    :session       (ig/ref :app.http.session/manager)
     :awsns-handler (ig/ref :app.http.awsns/handler)
     :debug-routes  (ig/ref :app.http.debug/routes)
-    :oidc-routes   (ig/ref :app.auth.oidc/routes)
+    :oidc-routes   (ig/ref ::oidc/routes)
     :ws            (ig/ref :app.http.websocket/handler)
-    :metrics       (ig/ref :app.metrics/metrics)
+    :metrics       (ig/ref ::mtx/metrics)
     :public-uri    (cf/get :public-uri)
-    :storage       (ig/ref :app.storage/storage)
-    :tokens        (ig/ref :app.tokens/tokens)
-    :audit-handler (ig/ref :app.loggers.audit/http-handler)
+    :storage       (ig/ref ::sto/storage)
     :rpc-routes    (ig/ref :app.rpc/routes)
     :doc-routes    (ig/ref :app.rpc.doc/routes)
-    :executor      (ig/ref [::default :app.worker/executor])}
+    :executor      (ig/ref ::wrk/executor)}
 
    :app.http.debug/routes
-   {:pool     (ig/ref :app.db/pool)
-    :executor (ig/ref [::worker :app.worker/executor])
-    :storage  (ig/ref :app.storage/storage)
-    :session  (ig/ref :app.http/session)}
+   {:pool     (ig/ref ::db/pool)
+    :executor (ig/ref ::wrk/executor)
+    :storage  (ig/ref ::sto/storage)
+    :session  (ig/ref :app.http.session/manager)}
 
    :app.http.websocket/handler
-   {:pool     (ig/ref :app.db/pool)
-    :metrics  (ig/ref :app.metrics/metrics)
+   {:pool     (ig/ref ::db/pool)
+    :metrics  (ig/ref ::mtx/metrics)
     :msgbus   (ig/ref :app.msgbus/msgbus)}
 
    :app.http.assets/handlers
-   {:metrics           (ig/ref :app.metrics/metrics)
+   {:metrics           (ig/ref ::mtx/metrics)
     :assets-path       (cf/get :assets-path)
-    :storage           (ig/ref :app.storage/storage)
-    :executor          (ig/ref [::default :app.worker/executor])
+    :storage           (ig/ref ::sto/storage)
+    :executor          (ig/ref ::wrk/executor)
     :cache-max-age     (dt/duration {:hours 24})
     :signature-max-age (dt/duration {:hours 24 :minutes 5})}
 
    :app.http.feedback/handler
-   {:pool     (ig/ref :app.db/pool)
-    :executor (ig/ref [::default :app.worker/executor])}
+   {:pool     (ig/ref ::db/pool)
+    :executor (ig/ref ::wrk/executor)}
+
+   :app.rpc/climit
+   {:metrics  (ig/ref ::mtx/metrics)
+    :executor (ig/ref ::wrk/executor)}
+
+   :app.rpc/rlimit
+   {:executor  (ig/ref ::wrk/executor)
+    :scheduled-executor (ig/ref ::wrk/scheduled-executor)}
 
    :app.rpc/methods
-   {:pool        (ig/ref :app.db/pool)
-    :session     (ig/ref :app.http/session)
-    :tokens      (ig/ref :app.tokens/tokens)
-    :metrics     (ig/ref :app.metrics/metrics)
-    :storage     (ig/ref :app.storage/storage)
-    :msgbus      (ig/ref :app.msgbus/msgbus)
-    :public-uri  (cf/get :public-uri)
-    :audit       (ig/ref :app.loggers.audit/collector)
-    :ldap        (ig/ref :app.auth.ldap/provider)
-    :http-client (ig/ref :app.http/client)
-    :executors   (ig/ref :app.worker/executors)}
+   {::audit/collector    (ig/ref ::audit/collector)
+    ::http.client/client (ig/ref ::http.client/client)
+    ::db/pool            (ig/ref ::db/pool)
+    ::wrk/executor       (ig/ref ::wrk/executor)
+
+    :pool                (ig/ref ::db/pool)
+    :session             (ig/ref :app.http.session/manager)
+    :sprops              (ig/ref :app.setup/props)
+    :metrics             (ig/ref ::mtx/metrics)
+    :storage             (ig/ref ::sto/storage)
+    :msgbus              (ig/ref :app.msgbus/msgbus)
+    :public-uri          (cf/get :public-uri)
+    :redis               (ig/ref ::rds/redis)
+    :ldap                (ig/ref :app.auth.ldap/provider)
+    :http-client         (ig/ref ::http.client/client)
+    :climit              (ig/ref :app.rpc/climit)
+    :rlimit              (ig/ref :app.rpc/rlimit)
+    :executor            (ig/ref ::wrk/executor)
+    :templates           (ig/ref :app.setup/builtin-templates)
+    }
 
    :app.rpc.doc/routes
    {:methods (ig/ref :app.rpc/methods)}
@@ -234,103 +345,111 @@
    :app.rpc/routes
    {:methods (ig/ref :app.rpc/methods)}
 
-   :app.worker/registry
-   {:metrics (ig/ref :app.metrics/metrics)
+   ::wrk/registry
+   {:metrics (ig/ref ::mtx/metrics)
     :tasks
-    {:sendmail           (ig/ref :app.emails/sendmail-handler)
+    {:sendmail           (ig/ref :app.emails/handler)
      :objects-gc         (ig/ref :app.tasks.objects-gc/handler)
      :file-gc            (ig/ref :app.tasks.file-gc/handler)
      :file-xlog-gc       (ig/ref :app.tasks.file-xlog-gc/handler)
-     :storage-gc-deleted (ig/ref :app.storage/gc-deleted-task)
-     :storage-gc-touched (ig/ref :app.storage/gc-touched-task)
+     :storage-gc-deleted (ig/ref ::sto/gc-deleted-task)
+     :storage-gc-touched (ig/ref ::sto/gc-touched-task)
      :tasks-gc           (ig/ref :app.tasks.tasks-gc/handler)
      :telemetry          (ig/ref :app.tasks.telemetry/handler)
      :session-gc         (ig/ref :app.http.session/gc-task)
-     :audit-log-archive  (ig/ref :app.loggers.audit/archive-task)
-     :audit-log-gc       (ig/ref :app.loggers.audit/gc-task)}}
+     :audit-log-archive  (ig/ref ::audit.tasks/archive)
+     :audit-log-gc       (ig/ref ::audit.tasks/gc)
 
-   :app.emails/sendmail-handler
+     :process-webhook-event
+     (ig/ref ::webhooks/process-event-handler)
+     :run-webhook
+     (ig/ref ::webhooks/run-webhook-handler)}}
+
+
+   :app.emails/sendmail
    {:host             (cf/get :smtp-host)
     :port             (cf/get :smtp-port)
     :ssl              (cf/get :smtp-ssl)
     :tls              (cf/get :smtp-tls)
     :username         (cf/get :smtp-username)
     :password         (cf/get :smtp-password)
-    :metrics          (ig/ref :app.metrics/metrics)
     :default-reply-to (cf/get :smtp-default-reply-to)
     :default-from     (cf/get :smtp-default-from)}
 
+   :app.emails/handler
+   {:sendmail (ig/ref :app.emails/sendmail)
+    :metrics  (ig/ref ::mtx/metrics)}
+
    :app.tasks.tasks-gc/handler
-   {:pool    (ig/ref :app.db/pool)
+   {:pool    (ig/ref ::db/pool)
     :max-age cf/deletion-delay}
 
    :app.tasks.objects-gc/handler
-   {:pool    (ig/ref :app.db/pool)
-    :storage (ig/ref :app.storage/storage)}
+   {:pool    (ig/ref ::db/pool)
+    :storage (ig/ref ::sto/storage)}
 
    :app.tasks.file-gc/handler
-   {:pool (ig/ref :app.db/pool)}
+   {:pool (ig/ref ::db/pool)}
 
    :app.tasks.file-xlog-gc/handler
-   {:pool (ig/ref :app.db/pool)}
+   {:pool (ig/ref ::db/pool)}
 
    :app.tasks.telemetry/handler
-   {:pool        (ig/ref :app.db/pool)
-    :version     (:full cf/version)
-    :uri         (cf/get :telemetry-uri)
-    :sprops      (ig/ref :app.setup/props)
-    :http-client (ig/ref :app.http/client)}
+   {::db/pool            (ig/ref ::db/pool)
+    ::http.client/client (ig/ref ::http.client/client)
+    ::props              (ig/ref :app.setup/props)}
 
    :app.srepl/server
    {:port (cf/get :srepl-port)
     :host (cf/get :srepl-host)}
 
+   :app.setup/builtin-templates
+   {::http.client/client (ig/ref ::http.client/client)}
+
    :app.setup/props
-   {:pool (ig/ref :app.db/pool)
+   {:pool (ig/ref ::db/pool)
     :key  (cf/get :secret-key)}
 
-   :app.setup/keys
-   {:props (ig/ref :app.setup/props)}
+   ::lzmq/receiver
+   {}
 
-   :app.loggers.zmq/receiver
-   {:endpoint (cf/get :loggers-zmq-uri)}
+   ::audit/collector
+   {::db/pool           (ig/ref ::db/pool)
+    ::wrk/executor      (ig/ref ::wrk/executor)
+    ::mtx/metrics       (ig/ref ::mtx/metrics)}
 
-   :app.loggers.audit/http-handler
-   {:pool     (ig/ref :app.db/pool)
-    :executor (ig/ref [::default :app.worker/executor])}
+   ::audit.tasks/archive
+   {::props              (ig/ref :app.setup/props)
+    ::db/pool            (ig/ref ::db/pool)
+    ::http.client/client (ig/ref ::http.client/client)}
 
-   :app.loggers.audit/collector
-   {:pool     (ig/ref :app.db/pool)
-    :executor (ig/ref [::worker :app.worker/executor])}
+   ::audit.tasks/gc
+   {::db/pool (ig/ref ::db/pool)}
 
-   :app.loggers.audit/archive-task
-   {:uri         (cf/get :audit-log-archive-uri)
-    :tokens      (ig/ref :app.tokens/tokens)
-    :pool        (ig/ref :app.db/pool)
-    :http-client (ig/ref :app.http/client)}
+   ::webhooks/process-event-handler
+   {::db/pool            (ig/ref ::db/pool)
+    ::http.client/client (ig/ref ::http.client/client)}
 
-   :app.loggers.audit/gc-task
-   {:max-age  (cf/get :audit-log-gc-max-age cf/deletion-delay)
-    :pool     (ig/ref :app.db/pool)}
+   ::webhooks/run-webhook-handler
+   {::db/pool            (ig/ref ::db/pool)
+    ::http.client/client (ig/ref ::http.client/client)}
 
    :app.loggers.loki/reporter
-   {:uri         (cf/get :loggers-loki-uri)
-    :receiver    (ig/ref :app.loggers.zmq/receiver)
-    :http-client (ig/ref :app.http/client)}
+   {::lzmq/receiver      (ig/ref ::lzmq/receiver)
+    ::http.client/client (ig/ref ::http.client/client)}
 
    :app.loggers.mattermost/reporter
-   {:uri         (cf/get :error-report-webhook)
-    :receiver    (ig/ref :app.loggers.zmq/receiver)
-    :http-client (ig/ref :app.http/client)}
+   {::lzmq/receiver      (ig/ref ::lzmq/receiver)
+    ::http.client/client (ig/ref ::http.client/client)}
 
    :app.loggers.database/reporter
    {:receiver (ig/ref :app.loggers.zmq/receiver)
-    :pool     (ig/ref :app.db/pool)
-    :executor (ig/ref [::worker :app.worker/executor])}
+    :pool     (ig/ref ::db/pool)
+    :executor (ig/ref ::wrk/executor)}
 
-   :app.storage/storage
-   {:pool     (ig/ref :app.db/pool)
-    :executor (ig/ref [::default :app.worker/executor])
+   ::sto/storage
+   {:pool     (ig/ref ::db/pool)
+    :executor (ig/ref ::wrk/executor)
 
     :backends
     {:assets-s3 (ig/ref [::assets :app.storage.s3/backend])
@@ -344,7 +463,7 @@
    {:region   (cf/get :storage-assets-s3-region)
     :endpoint (cf/get :storage-assets-s3-endpoint)
     :bucket   (cf/get :storage-assets-s3-bucket)
-    :executor (ig/ref [::default :app.worker/executor])}
+    :executor (ig/ref ::wrk/executor)}
 
    [::assets :app.storage.fs/backend]
    {:directory (cf/get :storage-assets-fs-directory)}
@@ -352,12 +471,11 @@
 
 
 (def worker-config
-  {   :app.worker/cron
-   {:executor   (ig/ref [::worker :app.worker/executor])
-    :scheduler  (ig/ref :app.worker/scheduler)
-    :tasks      (ig/ref :app.worker/registry)
-    :pool       (ig/ref :app.db/pool)
-    :entries
+  {::wrk/cron
+   {::wrk/scheduled-executor  (ig/ref ::wrk/scheduled-executor)
+    ::wrk/registry            (ig/ref ::wrk/registry)
+    ::db/pool                 (ig/ref ::db/pool)
+    ::wrk/entries
     [{:cron #app/cron "0 0 * * * ?" ;; hourly
       :task :file-xlog-gc}
 
@@ -387,14 +505,30 @@
         :task :audit-log-archive})
 
      (when (contains? cf/flags :audit-log-gc)
-       {:cron #app/cron "0 0 0 * * ?" ;; daily
+       {:cron #app/cron "30 */5 * * * ?" ;; every 5m
         :task :audit-log-gc})]}
 
-   :app.worker/worker
-   {:executor (ig/ref [::worker :app.worker/executor])
-    :tasks    (ig/ref :app.worker/registry)
-    :metrics  (ig/ref :app.metrics/metrics)
-    :pool     (ig/ref :app.db/pool)}})
+   ::wrk/dispatcher
+   {::rds/redis   (ig/ref ::rds/redis)
+    ::mtx/metrics (ig/ref ::mtx/metrics)
+    ::db/pool     (ig/ref ::db/pool)}
+
+   [::default ::wrk/worker]
+   {::wrk/parallelism (cf/get ::worker-default-parallelism 1)
+    ::wrk/queue       :default
+    ::rds/redis       (ig/ref ::rds/redis)
+    ::wrk/registry    (ig/ref ::wrk/registry)
+    ::mtx/metrics     (ig/ref ::mtx/metrics)
+    ::db/pool         (ig/ref ::db/pool)}
+
+   [::webhook ::wrk/worker]
+   {::wrk/parallelism (cf/get ::worker-webhook-parallelism 1)
+    ::wrk/queue       :webhooks
+    ::rds/redis       (ig/ref ::rds/redis)
+    ::wrk/registry    (ig/ref ::wrk/registry)
+    ::mtx/metrics     (ig/ref ::mtx/metrics)
+    ::db/pool         (ig/ref ::db/pool)}})
+
 
 (def system nil)
 
@@ -408,7 +542,9 @@
                                    (merge worker-config))
                                  (ig/prep)
                                  (ig/init))))
-  (l/info :msg "welcome to penpot"
+  (l/info :hint "welcome to penpot"
+          :flags (str/join "," (map name cf/flags))
+          :worker? (contains? cf/flags :backend-worker)
           :version (:full cf/version)))
 
 (defn stop
@@ -419,4 +555,9 @@
 
 (defn -main
   [& _args]
-  (start))
+  (try
+    (start)
+    (catch Throwable cause
+      (l/error :hint (ex-message cause)
+               :cause cause)
+      (System/exit -1))))

backend/src/app/media.clj

@@ -2,7 +2,7 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.media
   "Media & Font postprocessing."
@@ -13,14 +13,14 @@
    [app.common.spec :as us]
    [app.config :as cf]
    [app.storage.tmp :as tmp]
-   [app.util.bytes :as bs]
    [app.util.svg :as svg]
    [buddy.core.bytes :as bb]
    [buddy.core.codecs :as bc]
    [clojure.java.shell :as sh]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
-   [datoteka.core :as fs])
+   [datoteka.fs :as fs]
+   [datoteka.io :as io])
   (:import
    org.im4java.core.ConvertCmd
    org.im4java.core.IMOperation
@@ -199,7 +199,7 @@
   (letfn [(ttf->otf [data]
             (let [finput  (tmp/tempfile :prefix "penpot.font." :suffix "")
                   foutput (fs/path (str finput ".otf"))
-                  _       (bs/write-to-file! data finput)
+                  _       (io/write-to-file! data finput)
                   res     (sh/sh "fontforge" "-lang=ff" "-c"
                                  (str/fmt "Open('%s'); Generate('%s')"
                                           (str finput)
@@ -210,7 +210,7 @@
           (otf->ttf [data]
             (let [finput  (tmp/tempfile :prefix "penpot.font." :suffix "")
                   foutput (fs/path (str finput ".ttf"))
-                  _       (bs/write-to-file! data finput)
+                  _       (io/write-to-file! data finput)
                   res     (sh/sh "fontforge" "-lang=ff" "-c"
                                  (str/fmt "Open('%s'); Generate('%s')"
                                           (str finput)
@@ -220,18 +220,18 @@
 
           (ttf-or-otf->woff [data]
             ;; NOTE: foutput is not used directly, it represents the
-            ;; default output of the exection of the underlying
+            ;; default output of the execution of the underlying
             ;; command.
             (let [finput  (tmp/tempfile :prefix "penpot.font." :suffix "")
                   foutput (fs/path (str finput ".woff"))
-                  _       (bs/write-to-file! data finput)
+                  _       (io/write-to-file! data finput)
                   res     (sh/sh "sfnt2woff" (str finput))]
               (when (zero? (:exit res))
                 foutput)))
 
           (woff->sfnt [data]
             (let [finput  (tmp/tempfile :prefix "penpot" :suffix "")
-                  _       (bs/write-to-file! data finput)
+                  _       (io/write-to-file! data finput)
                   res     (sh/sh "woff2sfnt" (str finput)
                                  :out-enc :bytes)]
               (when (zero? (:exit res))

backend/src/app/metrics.clj

@@ -2,12 +2,14 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.metrics
   (:refer-clojure :exclude [run!])
   (:require
    [app.common.logging :as l]
+   [app.common.spec :as us]
+   [app.metrics.definition :as-alias mdef]
    [clojure.spec.alpha :as s]
    [integrant.core :as ig])
   (:import
@@ -16,11 +18,12 @@
    io.prometheus.client.Counter$Child
    io.prometheus.client.Gauge
    io.prometheus.client.Gauge$Child
-   io.prometheus.client.Summary
-   io.prometheus.client.Summary$Child
-   io.prometheus.client.Summary$Builder
    io.prometheus.client.Histogram
    io.prometheus.client.Histogram$Child
+   io.prometheus.client.SimpleCollector
+   io.prometheus.client.Summary
+   io.prometheus.client.Summary$Builder
+   io.prometheus.client.Summary$Child
    io.prometheus.client.exporter.common.TextFormat
    io.prometheus.client.hotspot.DefaultExports
    java.io.StringWriter))
@@ -28,129 +31,61 @@
 (set! *warn-on-reflection* true)
 
 (declare create-registry)
-(declare create)
+(declare create-collector)
 (declare handler)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; METRICS SERVICE PROVIDER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(def default-metrics
-  {:update-file-changes
-   {:name "rpc_update_file_changes_total"
-    :help "A total number of changes submitted to update-file."
-    :type :counter}
+(s/def ::mdef/name string?)
+(s/def ::mdef/help string?)
+(s/def ::mdef/labels (s/every string? :kind vector?))
+(s/def ::mdef/type #{:gauge :counter :summary :histogram})
 
-   :update-file-bytes-processed
-   {:name "rpc_update_file_bytes_processed_total"
-    :help "A total number of bytes processed by update-file."
-    :type :counter}
+(s/def ::mdef/instance
+  #(instance? SimpleCollector %))
 
-   :rpc-mutation-timing
-   {:name "rpc_mutation_timing"
-    :help "RPC mutation method call timming."
-    :labels ["name"]
-    :type :histogram}
+(s/def ::mdef/definition
+  (s/keys :req [::mdef/name
+                ::mdef/help
+                ::mdef/type]
+          :opt [::mdef/labels
+                ::mdef/instance]))
 
-   :rpc-command-timing
-   {:name "rpc_command_timing"
-    :help "RPC command method call timming."
-    :labels ["name"]
-    :type :histogram}
+(s/def ::definitions
+  (s/map-of keyword? ::mdef/definition))
 
-   :rpc-query-timing
-   {:name "rpc_query_timing"
-    :help "RPC query method call timing."
-    :labels ["name"]
-    :type :histogram}
+(s/def ::registry
+  #(instance? CollectorRegistry %))
 
-   :websocket-active-connections
-   {:name "websocket_active_connections"
-    :help "Active websocket connections gauge"
-    :type :gauge}
+(s/def ::handler fn?)
+(s/def ::metrics
+  (s/keys :req [::registry
+                ::handler
+                ::definitions]))
 
-   :websocket-messages-total
-   {:name "websocket_message_total"
-    :help "Counter of processed messages."
-    :labels ["op"]
-    :type :counter}
+(s/def ::default ::definitions)
 
-   :websocket-session-timing
-   {:name "websocket_session_timing"
-    :help "Websocket session timing (seconds)."
-    :type :summary}
-
-   :session-update-total
-   {:name "http_session_update_total"
-    :help "A counter of session update batch events."
-    :type :counter}
-
-   :tasks-timing
-   {:name "penpot_tasks_timing"
-    :help "Background tasks timing (milliseconds)."
-    :labels ["name"]
-    :type :summary}
-
-   :rlimit-queued-submissions
-   {:name "penpot_rlimit_queued_submissions"
-    :help "Current number of queued submissions on RLIMIT."
-    :labels ["name"]
-    :type :gauge}
-
-   :rlimit-used-permits
-   {:name "penpot_rlimit_used_permits"
-    :help "Current number of used permits on RLIMIT."
-    :labels ["name"]
-    :type :gauge}
-
-   :rlimit-acquires-total
-   {:name "penpot_rlimit_acquires_total"
-    :help "Total number of acquire operations on RLIMIT."
-    :labels ["name"]
-    :type :counter}
-
-   :executors-active-threads
-   {:name "penpot_executors_active_threads"
-    :help "Current number of threads available in the executor service."
-    :labels ["name"]
-    :type :gauge}
-
-   :executors-completed-tasks
-   {:name "penpot_executors_completed_tasks_total"
-    :help "Aproximate number of completed tasks by the executor."
-    :labels ["name"]
-    :type :counter}
-
-   :executors-running-threads
-   {:name "penpot_executors_running_threads"
-    :help "Current number of threads with state RUNNING."
-    :labels ["name"]
-    :type :gauge}
-
-   :executors-queued-submissions
-   {:name "penpot_executors_queued_submissions"
-    :help "Current number of queued submissions."
-    :labels ["name"]
-    :type :gauge}})
+(defmethod ig/pre-init-spec ::metrics [_]
+  (s/keys :req-un [::default]))
 
 (defmethod ig/init-key ::metrics
-  [_ _]
+  [_ cfg]
   (l/info :action "initialize metrics")
   (let [registry    (create-registry)
         definitions (reduce-kv (fn [res k v]
-                                 (->> (assoc v :registry registry)
-                                      (create)
+                                 (->> (assoc v ::registry registry)
+                                      (create-collector)
                                       (assoc res k)))
                                {}
-                               default-metrics)]
-    {:handler (partial handler registry)
-     :definitions definitions
-     :registry registry}))
+                               (:default cfg))]
 
-(s/def ::handler fn?)
-(s/def ::registry #(instance? CollectorRegistry %))
-(s/def ::metrics
-  (s/keys :req-un [::registry ::handler]))
+    (us/verify! ::definitions definitions)
+
+    {::handler (partial handler registry)
+     ::definitions definitions
+     ::registry registry}))
 
 (defn- handler
   [registry _ respond _]
@@ -174,13 +109,16 @@
 (def default-histogram-buckets
   [1 5 10 25 50 75 100 250 500 750 1000 2500 5000 7500])
 
+(defmulti run-collector! (fn [mdef _] (::mdef/type mdef)))
+(defmulti create-collector ::mdef/type)
+
 (defn run!
-  [{:keys [definitions]} {:keys [id] :as params}]
+  [{:keys [::definitions]} & {:keys [id] :as params}]
   (when-let [mobj (get definitions id)]
-    ((::fn mobj) params)
+    (run-collector! mobj params)
     true))
 
-(defn create-registry
+(defn- create-registry
   []
   (let [registry (CollectorRegistry.)]
     (DefaultExports/register registry)
@@ -192,79 +130,89 @@
     (and (.isArray ^Class oc)
          (= (.getComponentType oc) String))))
 
-(defn make-counter
-  [{:keys [name help registry reg labels] :as props}]
+(defmethod run-collector! :counter
+  [{:keys [::mdef/instance]} {:keys [inc labels] :or {inc 1 labels default-empty-labels}}]
+  (let [instance (.labels instance (if (is-array? labels) labels (into-array String labels)))]
+    (.inc ^Counter$Child instance (double inc))))
+
+(defmethod run-collector! :gauge
+  [{:keys [::mdef/instance]} {:keys [inc dec labels val] :or {labels default-empty-labels}}]
+  (let [instance (.labels ^Gauge instance (if (is-array? labels) labels (into-array String labels)))]
+    (cond (number? inc) (.inc ^Gauge$Child instance (double inc))
+          (number? dec) (.dec ^Gauge$Child instance (double dec))
+          (number? val) (.set ^Gauge$Child instance (double val)))))
+
+(defmethod run-collector! :summary
+  [{:keys [::mdef/instance]} {:keys [val labels] :or {labels default-empty-labels}}]
+  (let [instance (.labels ^Summary instance (if (is-array? labels) labels (into-array String labels)))]
+    (.observe ^Summary$Child instance val)))
+
+(defmethod run-collector! :histogram
+  [{:keys [::mdef/instance]} {:keys [val labels] :or {labels default-empty-labels}}]
+  (let [instance (.labels ^Histogram instance (if (is-array? labels) labels (into-array String labels)))]
+    (.observe ^Histogram$Child instance val)))
+
+(defmethod create-collector :counter
+  [{::mdef/keys [name help reg labels]
+    ::keys [registry]
+    :as props}]
+
   (let [registry (or registry reg)
         instance (.. (Counter/build)
                      (name name)
-                     (help help))
-        _        (when (seq labels)
-                   (.labelNames instance (into-array String labels)))
-        instance (.register instance registry)]
+                     (help help))]
+    (when (seq labels)
+      (.labelNames instance (into-array String labels)))
 
-    {::instance instance
-     ::fn (fn [{:keys [inc labels] :or {inc 1 labels default-empty-labels}}]
-            (let [instance (.labels instance (if (is-array? labels) labels (into-array String labels)))]
-              (.inc ^Counter$Child instance (double inc))))}))
+    (assoc props ::mdef/instance (.register instance registry))))
 
-(defn make-gauge
-  [{:keys [name help registry reg labels] :as props}]
+(defmethod create-collector :gauge
+  [{::mdef/keys [name help reg labels]
+    ::keys [registry]
+    :as props}]
   (let [registry (or registry reg)
         instance (.. (Gauge/build)
                      (name name)
-                     (help help))
-        _        (when (seq labels)
-                   (.labelNames instance (into-array String labels)))
-        instance (.register instance registry)]
-    {::instance instance
-     ::fn (fn [{:keys [inc dec labels val] :or {labels default-empty-labels}}]
-            (let [instance (.labels ^Gauge instance (if (is-array? labels) labels (into-array String labels)))]
-              (cond (number? inc) (.inc ^Gauge$Child instance (double inc))
-                    (number? dec) (.dec ^Gauge$Child instance (double dec))
-                    (number? val) (.set ^Gauge$Child instance (double val)))))}))
+                     (help help))]
+    (when (seq labels)
+      (.labelNames instance (into-array String labels)))
 
-(defn make-summary
-  [{:keys [name help registry reg labels max-age quantiles buckets]
-    :or {max-age 3600 buckets 12 quantiles default-quantiles} :as props}]
+    (assoc props ::mdef/instance (.register instance registry))))
+
+(defmethod create-collector :summary
+  [{::mdef/keys [name help reg labels max-age quantiles buckets]
+    ::keys [registry]
+    :or {max-age 3600 buckets 12 quantiles default-quantiles}
+    :as props}]
   (let [registry (or registry reg)
         builder  (doto (Summary/build)
                    (.name name)
-                   (.help help))
-        _        (when (seq quantiles)
-                   (.maxAgeSeconds ^Summary$Builder builder ^long max-age)
-                   (.ageBuckets ^Summary$Builder builder buckets))
-        _        (doseq [[q e] quantiles]
-                   (.quantile ^Summary$Builder builder q e))
-        _        (when (seq labels)
-                   (.labelNames ^Summary$Builder builder (into-array String labels)))
-        instance (.register ^Summary$Builder builder registry)]
+                   (.help help))]
 
-    {::instance instance
-     ::fn (fn [{:keys [val labels] :or {labels default-empty-labels}}]
-            (let [instance (.labels ^Summary instance (if (is-array? labels) labels (into-array String labels)))]
-              (.observe ^Summary$Child instance val)))}))
+    (when (seq quantiles)
+      (.maxAgeSeconds ^Summary$Builder builder ^long max-age)
+      (.ageBuckets ^Summary$Builder builder buckets))
 
-(defn make-histogram
-  [{:keys [name help registry reg labels buckets]
-    :or {buckets default-histogram-buckets}}]
+    (doseq [[q e] quantiles]
+      (.quantile ^Summary$Builder builder q e))
+
+    (when (seq labels)
+      (.labelNames ^Summary$Builder builder (into-array String labels)))
+
+    (assoc props ::mdef/instance (.register ^Summary$Builder builder registry))))
+
+(defmethod create-collector :histogram
+  [{::mdef/keys [name help reg labels buckets]
+    ::keys [registry]
+    :or {buckets default-histogram-buckets}
+    :as props}]
   (let [registry (or registry reg)
         instance (doto (Histogram/build)
                    (.name name)
                    (.help help)
-                   (.buckets (into-array Double/TYPE buckets)))
-        _        (when (seq labels)
-                   (.labelNames instance (into-array String labels)))
-        instance (.register instance registry)]
+                   (.buckets (into-array Double/TYPE buckets)))]
 
-    {::instance instance
-     ::fn (fn [{:keys [val labels] :or {labels default-empty-labels}}]
-            (let [instance (.labels ^Histogram instance (if (is-array? labels) labels (into-array String labels)))]
-              (.observe ^Histogram$Child instance val)))}))
+    (when (seq labels)
+      (.labelNames instance (into-array String labels)))
 
-(defn create
-  [{:keys [type] :as props}]
-  (case type
-    :counter (make-counter props)
-    :gauge   (make-gauge props)
-    :summary (make-summary props)
-    :histogram (make-histogram props)))
+    (assoc props ::mdef/instance (.register instance registry))))

backend/src/app/migrations.clj

@@ -2,7 +2,7 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.migrations
   (:require
@@ -244,6 +244,33 @@
 
    {:name "0078-mod-file-media-object-table-drop-cascade"
     :fn (mg/resource "app/migrations/sql/0078-mod-file-media-object-table-drop-cascade.sql")}
+
+   {:name "0079-mod-profile-table"
+    :fn (mg/resource "app/migrations/sql/0079-mod-profile-table.sql")}
+
+   {:name "0080-mod-index-names"
+    :fn (mg/resource "app/migrations/sql/0080-mod-index-names.sql")}
+
+   {:name "0081-add-deleted-at-index-to-file-table"
+    :fn (mg/resource "app/migrations/sql/0081-add-deleted-at-index-to-file-table.sql")}
+
+   {:name "0082-add-features-column-to-file-table"
+    :fn (mg/resource "app/migrations/sql/0082-add-features-column-to-file-table.sql")}
+
+   {:name "0083-add-file-data-fragment-table"
+    :fn (mg/resource "app/migrations/sql/0083-add-file-data-fragment-table.sql")}
+
+   {:name "0084-add-features-column-to-file-change-table"
+    :fn (mg/resource "app/migrations/sql/0084-add-features-column-to-file-change-table.sql")}
+
+   {:name "0085-add-webhook-table"
+    :fn (mg/resource "app/migrations/sql/0085-add-webhook-table.sql")}
+
+   {:name "0086-add-webhook-delivery-table"
+    :fn (mg/resource "app/migrations/sql/0086-add-webhook-delivery-table.sql")}
+
+   {:name "0087-mod-task-table"
+    :fn (mg/resource "app/migrations/sql/0087-mod-task-table.sql")}
    ])
 
 

backend/src/app/migrations/clj/migration_0023.clj

@@ -2,7 +2,7 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.migrations.clj.migration-0023
   (:require

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

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

backend/src/app/migrations/sql/0080-mod-index-names.sql

@@ -0,0 +1,11 @@
+ALTER INDEX team_font_variant_deleted_at_idx
+RENAME TO team_font_variant__deleted_at__idx;
+
+ALTER INDEX team_deleted_at_idx
+RENAME TO team__deleted_at__idx;
+
+ALTER INDEX profile_deleted_at_idx
+RENAME TO profile__deleted_at__idx;
+
+ALTER INDEX project_deleted_at_idx
+RENAME TO project__deleted_at__idx;

backend/src/app/migrations/sql/0081-add-deleted-at-index-to-file-table.sql

@@ -0,0 +1,3 @@
+CREATE INDEX file__deleted_at__idx
+    ON file (deleted_at, id)
+ WHERE deleted_at IS NOT NULL;

backend/src/app/migrations/sql/0082-add-features-column-to-file-table.sql

@@ -0,0 +1,2 @@
+ALTER TABLE file
+  ADD COLUMN features text[] DEFAULT NULL;

backend/src/app/migrations/sql/0083-add-file-data-fragment-table.sql

@@ -0,0 +1,15 @@
+CREATE TABLE file_data_fragment (
+  id uuid NOT NULL,
+  file_id uuid NOT NULL REFERENCES file(id) ON DELETE CASCADE DEFERRABLE,
+
+  created_at timestamptz NOT NULL DEFAULT now(),
+
+  metadata jsonb NULL,
+  content bytea NOT NULL,
+
+  PRIMARY KEY (file_id, id)
+);
+
+ALTER TABLE file_data_fragment
+  ALTER COLUMN metadata SET STORAGE external,
+  ALTER COLUMN content SET STORAGE external;

backend/src/app/migrations/sql/0084-add-features-column-to-file-change-table.sql

@@ -0,0 +1,8 @@
+ALTER TABLE file_change
+  ADD COLUMN features text[] DEFAULT NULL;
+
+ALTER TABLE file_change
+  ALTER COLUMN features SET STORAGE external;
+
+ALTER TABLE file
+  ALTER COLUMN features SET STORAGE external;

backend/src/app/migrations/sql/0085-add-webhook-table.sql

@@ -0,0 +1,25 @@
+CREATE TABLE webhook (
+  id uuid PRIMARY KEY,
+  team_id uuid NOT NULL REFERENCES team(id) ON DELETE CASCADE DEFERRABLE,
+
+  created_at timestamptz NOT NULL DEFAULT now(),
+  updated_at timestamptz NOT NULL DEFAULT now(),
+
+  uri text NOT NULL,
+  mtype text NOT NULL,
+
+  error_code text NULL,
+  error_count smallint DEFAULT 0,
+
+  is_active boolean DEFAULT true,
+  secret_key text NULL
+);
+
+ALTER TABLE webhook
+  ALTER COLUMN uri SET STORAGE external,
+  ALTER COLUMN mtype SET STORAGE external,
+  ALTER COLUMN error_code SET STORAGE external,
+  ALTER COLUMN secret_key SET STORAGE external;
+
+
+CREATE INDEX webhook__team_id__idx ON webhook (team_id);

backend/src/app/migrations/sql/0086-add-webhook-delivery-table.sql

@@ -0,0 +1,16 @@
+CREATE TABLE webhook_delivery (
+  webhook_id uuid NOT NULL REFERENCES webhook(id) ON DELETE CASCADE DEFERRABLE,
+  created_at timestamptz NOT NULL DEFAULT now(),
+
+  error_code text NULL,
+
+  req_data jsonb NULL,
+  rsp_data jsonb NULL,
+
+  PRIMARY KEY (webhook_id, created_at)
+);
+
+ALTER TABLE webhook_delivery
+  ALTER COLUMN error_code SET STORAGE external,
+  ALTER COLUMN req_data SET STORAGE external,
+  ALTER COLUMN rsp_data SET STORAGE external;

backend/src/app/migrations/sql/0087-mod-task-table.sql

@@ -0,0 +1,9 @@
+ALTER TABLE task
+  ADD COLUMN label text NULL;
+
+ALTER TABLE task
+  ALTER COLUMN label SET STORAGE external;
+
+CREATE INDEX task__label__idx
+    ON task (label, name, queue)
+ WHERE status = 'new';

backend/src/app/msgbus.clj

@@ -2,7 +2,7 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.msgbus
   "The msgbus abstraction implemented using redis as underlying backend."
@@ -13,28 +13,15 @@
    [app.common.spec :as us]
    [app.common.transit :as t]
    [app.config :as cfg]
+   [app.redis :as redis]
    [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]
-   [promesa.core :as p])
-  (:import
-   io.lettuce.core.RedisClient
-   io.lettuce.core.RedisURI
-   io.lettuce.core.api.StatefulConnection
-   io.lettuce.core.api.StatefulRedisConnection
-   io.lettuce.core.api.async.RedisAsyncCommands
-   io.lettuce.core.codec.ByteArrayCodec
-   io.lettuce.core.codec.RedisCodec
-   io.lettuce.core.codec.StringCodec
-   io.lettuce.core.pubsub.RedisPubSubListener
-   io.lettuce.core.pubsub.StatefulRedisPubSubConnection
-   io.lettuce.core.pubsub.api.sync.RedisPubSubCommands
-   io.lettuce.core.resource.ClientResources
-   io.lettuce.core.resource.DefaultClientResources
-   java.time.Duration))
+   [promesa.core :as p]
+   [promesa.exec :as px]))
 
 (set! *warn-on-reflection* true)
 
@@ -49,12 +36,12 @@
 
 (declare ^:private redis-connect)
 (declare ^:private redis-disconnect)
-(declare ^:private start-io-loop)
-(declare ^:private subscribe)
-(declare ^:private purge)
 (declare ^:private redis-pub)
 (declare ^:private redis-sub)
 (declare ^:private redis-unsub)
+(declare ^:private start-io-loop!)
+(declare ^:private subscribe-to-topics)
+(declare ^:private unsubscribe-channels)
 
 (defmethod ig/prep-key ::msgbus
   [_ cfg]
@@ -62,77 +49,82 @@
           :timeout (dt/duration {:seconds 30})}
          (d/without-nils cfg)))
 
-(s/def ::timeout ::dt/duration)
-(s/def ::redis-uri ::us/string)
+(s/def ::cmd-ch ::aa/channel)
+(s/def ::rcv-ch ::aa/channel)
+(s/def ::pub-ch ::aa/channel)
+(s/def ::state ::us/agent)
+(s/def ::pconn ::redis/connection-holder)
+(s/def ::sconn ::redis/connection-holder)
+(s/def ::msgbus
+  (s/keys :req [::cmd-ch ::rcv-ch ::pub-ch ::state ::pconn ::sconn ::wrk/executor]))
+
 (s/def ::buffer-size ::us/integer)
 
 (defmethod ig/pre-init-spec ::msgbus [_]
-  (s/keys :req-un [::buffer-size ::redis-uri ::timeout ::wrk/executor]))
+  (s/keys :req-un [::buffer-size ::redis/timeout ::redis/redis ::wrk/executor]))
 
 (defmethod ig/init-key ::msgbus
-  [_ {:keys [buffer-size redis-uri] :as cfg}]
-  (l/info :hint "initialize msgbus"
-          :buffer-size buffer-size
-          :redis-uri redis-uri)
+  [_ {:keys [buffer-size executor] :as cfg}]
+  (l/info :hint "initialize msgbus" :buffer-size buffer-size)
   (let [cmd-ch (a/chan buffer-size)
         rcv-ch (a/chan (a/dropping-buffer buffer-size))
         pub-ch (a/chan (a/dropping-buffer buffer-size) xform-prefix-topic)
-        state  (agent {} :error-handler #(l/error :cause % :hint "unexpected error on agent" ::l/async false))
-        cfg    (-> (redis-connect cfg)
+        state  (agent {})
+        msgbus (-> (redis-connect cfg)
                    (assoc ::cmd-ch cmd-ch)
                    (assoc ::rcv-ch rcv-ch)
                    (assoc ::pub-ch pub-ch)
-                   (assoc ::state state))]
+                   (assoc ::state state)
+                   (assoc ::wrk/executor executor))]
 
-    (start-io-loop cfg)
+    (us/verify! ::msgbus msgbus)
 
-    (with-meta
-      (fn [& {:keys [cmd] :as params}]
-        (a/go
-          (case cmd
-            :pub   (a/>! pub-ch params)
-            :sub   (a/<! (subscribe cfg params))
-            :purge (a/<! (purge cfg params))
-            (l/error :hint "unexpeced error on msgbus command processing" :params params))))
-      cfg)))
+    (set-error-handler! state #(l/error :cause % :hint "unexpected error on agent" ::l/async false))
+    (set-error-mode! state :continue)
+    (start-io-loop! msgbus)
+
+    msgbus))
+
+(defn sub!
+  [{:keys [::state ::wrk/executor] :as cfg} & {:keys [topic topics chan]}]
+  (let [done-ch (a/chan)
+        topics  (into [] (map prefix-topic) (if topic [topic] topics))]
+    (l/debug :hint "subscribe" :topics topics)
+    (send-via executor state subscribe-to-topics cfg topics chan done-ch)
+    done-ch))
+
+(defn pub!
+  [{::keys [pub-ch]} & {:as params}]
+  (a/go
+    (a/>! pub-ch params)))
+
+(defn purge!
+  [{:keys [::state ::wrk/executor] :as msgbus} chans]
+  (l/trace :hint "purge" :chans (count chans))
+  (let [done-ch (a/chan)]
+    (send-via executor state unsubscribe-channels msgbus chans done-ch)
+    done-ch))
 
 (defmethod ig/halt-key! ::msgbus
-  [_ f]
-  (let [mdata (meta f)]
-    (redis-disconnect mdata)
-    (a/close! (::cmd-ch mdata))
-    (a/close! (::rcv-ch mdata))))
+  [_ msgbus]
+  (redis-disconnect msgbus)
+  (a/close! (::cmd-ch msgbus))
+  (a/close! (::rcv-ch msgbus))
+  (a/close! (::pub-ch msgbus)))
 
 ;; --- IMPL
 
 (defn- redis-connect
-  [{:keys [redis-uri timeout] :as cfg}]
-  (let [codec     (RedisCodec/of StringCodec/UTF8 ByteArrayCodec/INSTANCE)
-
-        resources (.. (DefaultClientResources/builder)
-                      (ioThreadPoolSize 4)
-                      (computationThreadPoolSize 4)
-                      (build))
-
-        uri       (RedisURI/create redis-uri)
-        rclient   (RedisClient/create ^ClientResources resources ^RedisURI uri)
-
-        pconn     (.connect ^RedisClient rclient ^RedisCodec codec)
-        sconn     (.connectPubSub ^RedisClient rclient ^RedisCodec codec)]
-
-    (.setTimeout ^StatefulRedisConnection pconn ^Duration timeout)
-    (.setTimeout ^StatefulRedisPubSubConnection sconn ^Duration timeout)
-
-    (-> cfg
-        (assoc ::resources resources)
-        (assoc ::pconn pconn)
-        (assoc ::sconn sconn))))
+  [{:keys [timeout redis] :as cfg}]
+  (let [pconn (redis/connect redis :timeout timeout)
+        sconn (redis/connect redis :type :pubsub :timeout timeout)]
+    {::pconn pconn
+     ::sconn sconn}))
 
 (defn- redis-disconnect
-  [{:keys [::pconn ::sconn ::resources] :as cfg}]
-  (.. ^StatefulConnection pconn close)
-  (.. ^StatefulConnection sconn close)
-  (.shutdown ^ClientResources resources))
+  [{:keys [::pconn ::sconn] :as cfg}]
+  (d/close! pconn)
+  (d/close! sconn))
 
 (defn- conj-subscription
   "A low level function that is responsible to create on-demand
@@ -147,7 +139,7 @@
 
 (defn- disj-subscription
   "A low level function responsible on removing subscriptions. The
-  subscription is trully removed from redis once no single local
+  subscription is truly removed from redis once no single local
   subscription is look for it. Intended to be executed in agent."
   [nsubs cfg topic chan]
   (let [nsubs (disj nsubs chan)]
@@ -168,7 +160,7 @@
               topics))))
 
 (defn- unsubscribe-single-channel
-  "Auxiliar function responsible on removing a single local
+  "Auxiliary function responsible on removing a single local
   subscription from the state."
   [state cfg chan]
   (let [topics (get-in state [:chans chan])
@@ -186,45 +178,20 @@
   (aa/with-closing done-ch
     (reduce #(unsubscribe-single-channel %1 cfg %2) state channels)))
 
-
-(defn- subscribe
-  [{:keys [::state executor] :as cfg} {:keys [topic topics chan]}]
-  (let [done-ch (a/chan)
-        topics  (into [] (map prefix-topic) (if topic [topic] topics))]
-    (l/debug :hint "subscribe" :topics topics)
-    (send-via executor state subscribe-to-topics cfg topics chan done-ch)
-    done-ch))
-
-(defn- purge
-  [{:keys [::state executor] :as cfg} {:keys [chans]}]
-  (l/trace :hint "purge" :chans (count chans))
-  (let [done-ch (a/chan)]
-    (send-via executor state unsubscribe-channels cfg chans done-ch)
-    done-ch))
-
 (defn- create-listener
   [rcv-ch]
-  (reify RedisPubSubListener
-    (message [_ _pattern _topic _message])
-    (message [_ topic message]
-      ;; There are no back pressure, so we use a slidding
-      ;; buffer for cases when the pubsub broker sends
-      ;; more messages that we can process.
-      (let [val {:topic topic :message (t/decode message)}]
-        (when-not (a/offer! rcv-ch val)
-          (l/warn :msg "dropping message on subscription loop"))))
-    (psubscribed [_ _pattern _count])
-    (punsubscribed [_ _pattern _count])
-    (subscribed [_ _topic _count])
-    (unsubscribed [_ _topic _count])))
-
-(defn start-io-loop
-  [{:keys [::sconn ::rcv-ch ::pub-ch ::state executor] :as cfg}]
-
-  ;; Add a single listener to the pubsub connection
-  (.addListener ^StatefulRedisPubSubConnection sconn
-                ^RedisPubSubListener (create-listener rcv-ch))
+  (redis/pubsub-listener
+   :on-message (fn [_ topic message]
+                 ;; There are no back pressure, so we use a slidding
+                 ;; buffer for cases when the pubsub broker sends
+                 ;; more messages that we can process.
+                 (let [val {:topic topic :message (t/decode message)}]
+                   (when-not (a/offer! rcv-ch val)
+                     (l/warn :msg "dropping message on subscription loop"))))))
 
+(defn start-io-loop!
+  [{:keys [::sconn ::rcv-ch ::pub-ch ::state ::wrk/executor] :as cfg}]
+  (redis/add-listener! sconn (create-listener rcv-ch))
   (letfn [(send-to-topic [topic message]
             (a/go-loop [chans  (seq (get-in @state [:topics topic]))
                         closed #{}]
@@ -239,42 +206,43 @@
               (when-let [closed (a/<! (send-to-topic topic message))]
                 (send-via executor state unsubscribe-channels cfg closed nil))))
           ]
+    (px/thread
+      {:name "penpot/msgbus-io-loop"}
+      (loop []
+        (let [[val port] (a/alts!! [pub-ch rcv-ch])]
+          (cond
+            (nil? val)
+            (do
+              (l/trace :hint "stopping io-loop, nil received")
+              (send-via executor state (fn [state]
+                                         (->> (vals state)
+                                              (mapcat identity)
+                                              (filter some?)
+                                              (run! a/close!))
+                                         nil)))
 
-  (a/go-loop []
-    (let [[val port] (a/alts! [pub-ch rcv-ch])]
-      (cond
-        (nil? val)
-        (do
-          (l/trace :hint "stoping io-loop, nil received")
-          (send-via executor state (fn [state]
-                                     (->> (vals state)
-                                          (mapcat identity)
-                                          (filter some?)
-                                          (run! a/close!))
-                                     nil)))
+            (= port rcv-ch)
+            (do
+              (a/<!! (process-incoming val))
+              (recur))
 
-        (= port rcv-ch)
-        (do
-          (a/<! (process-incoming val))
-          (recur))
-
-        (= port pub-ch)
-        (let [result (a/<! (redis-pub cfg val))]
-          (when (ex/exception? result)
-            (l/error :hint "unexpected error on publishing" :message val
-                     :cause result))
-          (recur)))))))
+            (= port pub-ch)
+            (let [result (a/<!! (redis-pub cfg val))]
+              (when (ex/exception? result)
+                (l/error :hint "unexpected error on publishing"
+                         :message val
+                         :cause result))
+              (recur))))))))
 
 (defn- redis-pub
   "Publish a message to the redis server. Asynchronous operation,
   intended to be used in core.async go blocks."
   [{:keys [::pconn] :as cfg} {:keys [topic message]}]
   (let [message (t/encode message)
-        res     (a/chan 1)
-        pcomm   (.async ^StatefulRedisConnection pconn)]
-    (-> (.publish ^RedisAsyncCommands pcomm ^String topic ^bytes message)
+        res     (a/chan 1)]
+    (-> (redis/publish! pconn topic message)
         (p/finally (fn [_ cause]
-                     (when (and cause (.isOpen ^StatefulConnection pconn))
+                     (when (and cause (redis/open? pconn))
                        (a/offer! res cause))
                      (a/close! res))))
     res))
@@ -283,14 +251,10 @@
   "Create redis subscription. Blocking operation, intended to be used
   inside an agent."
   [{:keys [::sconn] :as cfg} topic]
-  (let [topic (into-array String [topic])
-        scomm (.sync ^StatefulRedisPubSubConnection sconn)]
-    (.subscribe ^RedisPubSubCommands scomm topic)))
+  (redis/subscribe! sconn topic))
 
 (defn redis-unsub
   "Removes redis subscription. Blocking operation, intended to be used
   inside an agent."
   [{:keys [::sconn] :as cfg} topic]
-  (let [topic (into-array String [topic])
-        scomm (.sync ^StatefulRedisPubSubConnection sconn)]
-    (.unsubscribe ^RedisPubSubCommands scomm topic)))
+  (redis/unsubscribe! sconn topic))

backend/src/app/redis.clj

@@ -0,0 +1,398 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.redis
+  "The msgbus abstraction implemented using redis as underlying backend."
+  (:require
+   [app.common.data :as d]
+   [app.common.logging :as l]
+   [app.common.spec :as us]
+   [app.metrics :as mtx]
+   [app.redis.script :as-alias rscript]
+   [app.util.time :as dt]
+   [clojure.core :as c]
+   [clojure.java.io :as io]
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [integrant.core :as ig]
+   [promesa.core :as p])
+  (:import
+   clojure.lang.IDeref
+   clojure.lang.MapEntry
+   io.lettuce.core.KeyValue
+   io.lettuce.core.RedisClient
+   io.lettuce.core.RedisCommandInterruptedException
+   io.lettuce.core.RedisCommandTimeoutException
+   io.lettuce.core.RedisException
+   io.lettuce.core.RedisURI
+   io.lettuce.core.ScriptOutputType
+   io.lettuce.core.api.StatefulConnection
+   io.lettuce.core.api.StatefulRedisConnection
+   io.lettuce.core.api.async.RedisAsyncCommands
+   io.lettuce.core.api.async.RedisScriptingAsyncCommands
+   io.lettuce.core.api.sync.RedisCommands
+   io.lettuce.core.codec.ByteArrayCodec
+   io.lettuce.core.codec.RedisCodec
+   io.lettuce.core.codec.StringCodec
+   io.lettuce.core.pubsub.RedisPubSubListener
+   io.lettuce.core.pubsub.StatefulRedisPubSubConnection
+   io.lettuce.core.pubsub.api.sync.RedisPubSubCommands
+   io.lettuce.core.resource.ClientResources
+   io.lettuce.core.resource.DefaultClientResources
+   io.netty.util.HashedWheelTimer
+   io.netty.util.Timer
+   java.lang.AutoCloseable
+   java.time.Duration))
+
+(set! *warn-on-reflection* true)
+
+(declare initialize-resources)
+(declare shutdown-resources)
+(declare connect*)
+
+(s/def ::timer
+  #(instance? Timer %))
+
+(s/def ::default-connection
+  #(or (instance? StatefulRedisConnection %)
+       (and (instance? IDeref %)
+            (instance? StatefulRedisConnection (deref %)))))
+
+(s/def ::pubsub-connection
+  #(or (instance? StatefulRedisPubSubConnection %)
+       (and (instance? IDeref %)
+            (instance? StatefulRedisPubSubConnection (deref %)))))
+
+(s/def ::connection
+  (s/or :default ::default-connection
+        :pubsub  ::pubsub-connection))
+
+(s/def ::connection-holder
+  (s/keys :req [::connection]))
+
+(s/def ::redis-uri
+  #(instance? RedisURI %))
+
+(s/def ::resources
+  #(instance? ClientResources %))
+
+(s/def ::pubsub-listener
+  #(instance? RedisPubSubListener %))
+
+(s/def ::uri ::us/not-empty-string)
+(s/def ::timeout ::dt/duration)
+(s/def ::connect? ::us/boolean)
+(s/def ::io-threads ::us/integer)
+(s/def ::worker-threads ::us/integer)
+(s/def ::cache #(instance? clojure.lang.Atom %))
+
+(s/def ::redis
+  (s/keys :req [::resources
+                ::redis-uri
+                ::timer
+                ::mtx/metrics]
+          :opt [::connection
+                ::cache]))
+
+(defmethod ig/prep-key ::redis
+  [_ cfg]
+  (let [runtime (Runtime/getRuntime)
+        cpus    (.availableProcessors ^Runtime runtime)]
+    (merge {::timeout (dt/duration "10s")
+            ::io-threads (max 3 cpus)
+            ::worker-threads (max 3 cpus)}
+           (d/without-nils cfg))))
+
+(defmethod ig/pre-init-spec ::redis [_]
+  (s/keys :req [::uri ::mtx/metrics]
+          :opt [::timeout
+                ::connect?
+                ::io-threads
+                ::worker-threads]))
+
+(defmethod ig/init-key ::redis
+  [_ {:keys [::connect?] :as cfg}]
+  (let [state (initialize-resources cfg)]
+    (cond-> state
+      connect? (assoc ::connection (connect* cfg {})))))
+
+(defmethod ig/halt-key! ::redis
+  [_ state]
+  (shutdown-resources state))
+
+(def default-codec
+  (RedisCodec/of StringCodec/UTF8 ByteArrayCodec/INSTANCE))
+
+(def string-codec
+  (RedisCodec/of StringCodec/UTF8 StringCodec/UTF8))
+
+(defn- initialize-resources
+  "Initialize redis connection resources"
+  [{:keys [::uri ::io-threads ::worker-threads ::connect?] :as cfg}]
+  (l/info :hint "initialize redis resources"
+          :uri uri
+          :io-threads io-threads
+          :worker-threads worker-threads
+          :connect? connect?)
+
+  (let [timer     (HashedWheelTimer.)
+        resources (.. (DefaultClientResources/builder)
+                      (ioThreadPoolSize ^long io-threads)
+                      (computationThreadPoolSize ^long worker-threads)
+                      (timer ^Timer timer)
+                      (build))
+
+        redis-uri (RedisURI/create ^String uri)]
+
+    (-> cfg
+        (assoc ::resources resources)
+        (assoc ::timer timer)
+        (assoc ::cache (atom {}))
+        (assoc ::redis-uri redis-uri))))
+
+(defn- shutdown-resources
+  [{:keys [::resources ::cache ::timer]}]
+  (run! d/close! (vals @cache))
+  (when resources
+    (.shutdown ^ClientResources resources))
+  (when timer
+    (.stop ^Timer timer)))
+
+(defn connect*
+  [{:keys [::resources ::redis-uri] :as state}
+   {:keys [timeout codec type]
+    :or {codec default-codec type :default}}]
+
+  (us/assert! ::resources resources)
+  (let [client  (RedisClient/create ^ClientResources resources ^RedisURI redis-uri)
+        timeout (or timeout (::timeout state))
+        conn    (case type
+                  :default (.connect ^RedisClient client ^RedisCodec codec)
+                  :pubsub  (.connectPubSub ^RedisClient client ^RedisCodec codec))]
+
+    (.setTimeout ^StatefulConnection conn ^Duration timeout)
+    (reify
+      IDeref
+      (deref [_] conn)
+
+      AutoCloseable
+      (close [_]
+        (.close ^StatefulConnection conn)
+        (.shutdown ^RedisClient client)))))
+
+(defn connect
+  [state & {:as opts}]
+  (let [connection (connect* state opts)]
+    (-> state
+        (assoc ::connection connection)
+        (dissoc ::cache)
+        (vary-meta assoc `d/close! (fn [_] (d/close! connection))))))
+
+(defn get-or-connect
+  [{:keys [::cache] :as state} key options]
+  (-> state
+      (assoc ::connection
+             (or (get @cache key)
+                 (-> (swap! cache (fn [cache]
+                                    (when-let [prev (get cache key)]
+                                      (d/close! prev))
+                                    (assoc cache key (connect* state options))))
+                     (get key))))
+      (dissoc ::cache)))
+
+(defn add-listener!
+  [{:keys [::connection] :as conn} listener]
+  (us/assert! ::connection-holder conn)
+  (us/assert! ::pubsub-connection connection)
+  (us/assert! ::pubsub-listener listener)
+  (.addListener ^StatefulRedisPubSubConnection @connection
+                ^RedisPubSubListener listener)
+  conn)
+
+(defn publish!
+  [{:keys [::connection] :as conn} topic message]
+  (us/assert! ::us/string topic)
+  (us/assert! ::us/bytes message)
+  (us/assert! ::connection-holder conn)
+  (us/assert! ::default-connection connection)
+
+  (let [pcomm (.async ^StatefulRedisConnection @connection)]
+    (.publish ^RedisAsyncCommands pcomm ^String topic ^bytes message)))
+
+(defn subscribe!
+  "Blocking operation, intended to be used on a thread/agent thread."
+  [{:keys [::connection] :as conn} & topics]
+  (us/assert! ::connection-holder conn)
+  (us/assert! ::pubsub-connection connection)
+  (try
+    (let [topics (into-array String (map str topics))
+          cmd    (.sync ^StatefulRedisPubSubConnection @connection)]
+      (.subscribe ^RedisPubSubCommands cmd topics))
+    (catch RedisCommandInterruptedException cause
+      (throw (InterruptedException. (ex-message cause))))))
+
+(defn unsubscribe!
+  "Blocking operation, intended to be used on a thread/agent thread."
+  [{:keys [::connection] :as conn} & topics]
+  (us/assert! ::connection-holder conn)
+  (us/assert! ::pubsub-connection connection)
+  (try
+    (let [topics (into-array String (map str topics))
+          cmd    (.sync ^StatefulRedisPubSubConnection @connection)]
+      (.unsubscribe ^RedisPubSubCommands cmd topics))
+    (catch RedisCommandInterruptedException cause
+      (throw (InterruptedException. (ex-message cause))))))
+
+(defn rpush!
+  [{:keys [::connection] :as conn} key payload]
+  (us/assert! ::connection-holder conn)
+  (us/assert! (or (and (vector? payload)
+                       (every? bytes? payload))
+                  (bytes? payload)))
+  (try
+    (let [cmd  (.sync ^StatefulRedisConnection @connection)
+          data (if (vector? payload) payload [payload])
+          vals (make-array (. Class (forName "[B")) (count data))]
+
+      (loop [i 0 xs (seq data)]
+        (when xs
+          (aset ^"[[B" vals i ^bytes (first xs))
+          (recur (inc i) (next xs))))
+
+      (.rpush ^RedisCommands cmd
+              ^String key
+              ^"[[B" vals))
+
+    (catch RedisCommandInterruptedException cause
+      (throw (InterruptedException. (ex-message cause))))))
+
+(defn blpop!
+  [{:keys [::connection] :as conn} timeout & keys]
+  (us/assert! ::connection-holder conn)
+  (try
+    (let [keys    (into-array Object (map str keys))
+          cmd     (.sync ^StatefulRedisConnection @connection)
+          timeout (/ (double (inst-ms timeout)) 1000.0)]
+      (when-let [res (.blpop ^RedisCommands cmd
+                             ^double timeout
+                             ^"[Ljava.lang.String;" keys)]
+        (MapEntry/create
+         (.getKey ^KeyValue res)
+         (.getValue ^KeyValue res))))
+    (catch RedisCommandInterruptedException cause
+      (throw (InterruptedException. (ex-message cause))))))
+
+(defn open?
+  [{:keys [::connection] :as conn}]
+  (us/assert! ::connection-holder conn)
+  (us/assert! ::pubsub-connection connection)
+  (.isOpen ^StatefulConnection @connection))
+
+(defn pubsub-listener
+  [& {:keys [on-message on-subscribe on-unsubscribe]}]
+  (reify RedisPubSubListener
+    (message [_ pattern topic message]
+      (when on-message
+        (on-message pattern topic message)))
+
+    (message [_ topic message]
+      (when on-message
+        (on-message nil topic message)))
+
+    (psubscribed [_ pattern count]
+      (when on-subscribe
+        (on-subscribe pattern nil count)))
+
+    (punsubscribed [_ pattern count]
+      (when on-unsubscribe
+        (on-unsubscribe pattern nil count)))
+
+    (subscribed [_ topic count]
+      (when on-subscribe
+        (on-subscribe nil topic count)))
+
+    (unsubscribed [_ topic count]
+      (when on-unsubscribe
+        (on-unsubscribe nil topic count)))))
+
+(def ^:private scripts-cache (atom {}))
+(def noop-fn (constantly nil))
+
+(s/def ::rscript/name qualified-keyword?)
+(s/def ::rscript/path ::us/not-empty-string)
+(s/def ::rscript/keys (s/every any? :kind vector?))
+(s/def ::rscript/vals (s/every any? :kind vector?))
+
+(s/def ::rscript/script
+  (s/keys :req [::rscript/name
+                ::rscript/path]
+          :opt [::rscript/keys
+                ::rscript/vals]))
+
+(defn eval!
+  [{:keys [::mtx/metrics ::connection] :as state} script]
+  (us/assert! ::redis state)
+  (us/assert! ::connection-holder state)
+  (us/assert! ::rscript/script script)
+
+  (let [cmd   (.async ^StatefulRedisConnection @connection)
+        keys  (into-array String (map str (::rscript/keys script)))
+        vals  (into-array String (map str (::rscript/vals script)))
+        sname (::rscript/name script)]
+
+    (letfn [(on-error [cause]
+              (if (instance? io.lettuce.core.RedisNoScriptException cause)
+                (do
+                  (l/error :hint "no script found" :name sname :cause cause)
+                  (->> (load-script)
+                       (p/mapcat eval-script)))
+                (if-let [on-error (::rscript/on-error script)]
+                  (on-error cause)
+                  (p/rejected cause))))
+
+            (eval-script [sha]
+              (let [tpoint (dt/tpoint)]
+                (->> (.evalsha ^RedisScriptingAsyncCommands cmd
+                               ^String sha
+                               ^ScriptOutputType ScriptOutputType/MULTI
+                               ^"[Ljava.lang.String;" keys
+                               ^"[Ljava.lang.String;" vals)
+                     (p/fmap (fn [result]
+                               (let [elapsed (tpoint)]
+                                 (mtx/run! metrics {:id :redis-eval-timing
+                                                    :labels [(name sname)]
+                                                    :val (inst-ms elapsed)})
+                                 (l/trace :hint "eval script"
+                                          :name (name sname)
+                                          :sha sha
+                                          :params (str/join "," (::rscript/vals script))
+                                          :elapsed (dt/format-duration elapsed))
+                                 result)))
+                     (p/merr on-error))))
+
+            (read-script []
+              (-> script ::rscript/path io/resource slurp))
+
+            (load-script []
+              (l/trace :hint "load script" :name sname)
+              (->> (.scriptLoad ^RedisScriptingAsyncCommands cmd
+                               ^String (read-script))
+                   (p/map (fn [sha]
+                            (swap! scripts-cache assoc sname sha)
+                            sha))))]
+
+      (if-let [sha (get @scripts-cache sname)]
+        (eval-script sha)
+        (->> (load-script)
+             (p/mapcat eval-script))))))
+
+(defn timeout-exception?
+  [cause]
+  (instance? RedisCommandTimeoutException cause))
+
+(defn exception?
+  [cause]
+  (instance? RedisException cause))

backend/src/app/rpc.clj

@@ -2,25 +2,37 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc
   (:require
+   [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [app.common.spec :as us]
+   [app.common.uuid :as uuid]
    [app.db :as db]
+   [app.http :as-alias http]
+   [app.http.client :as-alias http.client]
+   [app.http.session :as-alias http.session]
    [app.loggers.audit :as audit]
+   [app.loggers.webhooks :as-alias webhooks]
    [app.metrics :as mtx]
+   [app.msgbus :as-alias mbus]
+   [app.rpc.climit :as climit]
+   [app.rpc.cond :as cond]
+   [app.rpc.helpers :as rph]
    [app.rpc.retry :as retry]
    [app.rpc.rlimit :as rlimit]
-   [app.util.async :as async]
+   [app.storage :as-alias sto]
    [app.util.services :as sv]
-   [app.worker :as wrk]
+   [app.util.time :as ts]
+   [app.worker :as-alias wrk]
    [clojure.spec.alpha :as s]
    [integrant.core :as ig]
    [promesa.core :as p]
    [promesa.exec :as px]
+   [yetti.request :as yrq]
    [yetti.response :as yrs]))
 
 (defn- default-handler
@@ -29,82 +41,81 @@
 
 (defn- handle-response-transformation
   [response request mdata]
-  (if-let [transform-fn (:transform-response mdata)]
-    (p/do (transform-fn request response))
-    (p/resolved response)))
+  (let [transform-fn (reduce (fn [res-fn transform-fn]
+                               (fn [request response]
+                                 (p/then (res-fn request response) #(transform-fn request %))))
+                             (constantly response)
+                             (::response-transform-fns mdata))]
+    (transform-fn request response)))
 
 (defn- handle-before-comple-hook
   [response mdata]
-  (when-let [hook-fn (:before-complete mdata)]
+  (doseq [hook-fn (::before-complete-fns mdata)]
     (ex/ignoring (hook-fn)))
   response)
 
+(defn- handle-response
+  [request result]
+  (if (fn? result)
+    (p/wrap (result request))
+    (let [mdata (meta result)]
+      (p/-> (yrs/response {:status  (::http/status mdata 200)
+                           :headers (::http/headers mdata {})
+                           :body    (rph/unwrap result)})
+            (handle-response-transformation request mdata)
+            (handle-before-comple-hook mdata)))))
+
 (defn- rpc-query-handler
   "Ring handler that dispatches query requests and convert between
   internal async flow into ring async flow."
   [methods {:keys [profile-id session-id params] :as request} respond raise]
-  (letfn [(handle-response [result]
-            (let [mdata (meta result)]
-              (-> (yrs/response 200 result)
-                  (handle-response-transformation request mdata))))]
+  (let [type   (keyword (:type params))
+        data   (into {::http/request request} params)
+        data   (if profile-id
+                 (assoc data :profile-id profile-id ::session-id session-id)
+                 (dissoc data :profile-id))
+        method (get methods type default-handler)]
 
-    (let [type   (keyword (:type params))
-          data   (into {::request request} params)
-          data   (if profile-id
-                   (assoc data :profile-id profile-id ::session-id session-id)
-                   (dissoc data :profile-id))
-          method (get methods type default-handler)]
-
-      (-> (method data)
-          (p/then handle-response)
-          (p/then respond)
-          (p/catch (fn [cause]
-                     (let [context {:profile-id profile-id}]
-                       (raise (ex/wrap-with-context cause context)))))))))
+    (-> (method data)
+        (p/then (partial handle-response request))
+        (p/then respond)
+        (p/catch (fn [cause]
+                   (let [context {:profile-id profile-id}]
+                     (raise (ex/wrap-with-context cause context))))))))
 
 (defn- rpc-mutation-handler
   "Ring handler that dispatches mutation requests and convert between
   internal async flow into ring async flow."
   [methods {:keys [profile-id session-id params] :as request} respond raise]
-  (letfn [(handle-response [result]
-            (let [mdata (meta result)]
-              (p/-> (yrs/response 200 result)
-                    (handle-response-transformation request mdata)
-                    (handle-before-comple-hook mdata))))]
+  (let [type   (keyword (:type params))
+        data   (into {::http/request request} params)
+        data   (if profile-id
+                 (assoc data :profile-id profile-id ::session-id session-id)
+                 (dissoc data :profile-id))
 
-    (let [type   (keyword (:type params))
-          data   (into {::request request} params)
-          data   (if profile-id
-                   (assoc data :profile-id profile-id ::session-id session-id)
-                   (dissoc data :profile-id))
-
-          method (get methods type default-handler)]
-      (-> (method data)
-          (p/then handle-response)
-          (p/then respond)
-          (p/catch (fn [cause]
-                     (let [context {:profile-id profile-id}]
-                       (raise (ex/wrap-with-context cause context)))))))))
+        method (get methods type default-handler)]
+    (-> (method data)
+        (p/then (partial handle-response request))
+        (p/then respond)
+        (p/catch (fn [cause]
+                   (let [context {:profile-id profile-id}]
+                     (raise (ex/wrap-with-context cause context))))))))
 
 (defn- rpc-command-handler
   "Ring handler that dispatches cmd requests and convert between
   internal async flow into ring async flow."
   [methods {:keys [profile-id session-id params] :as request} respond raise]
-  (letfn [(handle-response [result]
-            (let [mdata (meta result)]
-              (p/-> (yrs/response 200 result)
-                    (handle-response-transformation request mdata)
-                    (handle-before-comple-hook mdata))))]
+  (let [cmd    (keyword (:command params))
+        etag   (yrq/get-header request "if-none-match")
+        data   (into {::http/request request ::cond/key etag} params)
+        data   (if profile-id
+                 (assoc data :profile-id profile-id ::session-id session-id)
+                 (dissoc data :profile-id))
 
-    (let [cmd    (keyword (:command params))
-          data   (into {::request request} params)
-          data   (if profile-id
-                   (assoc data :profile-id profile-id ::session-id session-id)
-                   (dissoc data :profile-id))
-
-          method (get methods cmd default-handler)]
+        method (get methods cmd default-handler)]
+    (binding [cond/*enabled* true]
       (-> (method data)
-          (p/then handle-response)
+          (p/then (partial handle-response request))
           (p/then respond)
           (p/catch (fn [cause]
                      (let [context {:profile-id profile-id}]
@@ -115,73 +126,86 @@
   [{:keys [metrics ::metrics-id]} f mdata]
   (let [labels (into-array String [(::sv/name mdata)])]
     (fn [cfg params]
-      (let [start (System/nanoTime)]
+      (let [tp (ts/tpoint)]
         (p/finally
           (f cfg params)
           (fn [_ _]
             (mtx/run! metrics
-                      {:id metrics-id
-                       :val (/ (- (System/nanoTime) start) 1000000)
-                       :labels labels})))))))
+                      :id metrics-id
+                      :val (inst-ms (tp))
+                      :labels labels)))))))
 
 (defn- wrap-dispatch
   "Wraps service method into async flow, with the ability to dispatching
   it to a preconfigured executor service."
-  [{:keys [executors] :as cfg} f mdata]
-  (let [dname (::async/dispatch mdata :default)]
-    (if (= :none dname)
-      (with-meta
-        (fn [cfg params]
-          (p/do (f cfg params)))
-        mdata)
-
-      (let [executor (get executors dname)]
-        (when-not executor
-          (ex/raise :type :internal
-                    :code :executor-not-configured
-                    :hint (format "executor %s not configured" dname)))
-        (with-meta
-          (fn [cfg params]
-            (-> (px/submit! executor #(f cfg params))
-                (p/bind p/wrap)))
-          mdata)))))
+  [{:keys [executor] :as cfg} f mdata]
+  (with-meta
+    (fn [cfg params]
+      (->> (px/submit! executor (px/wrap-bindings #(f cfg params)))
+           (p/mapcat p/wrap)
+           (p/map rph/wrap)))
+    mdata))
 
 (defn- wrap-audit
-  [{:keys [audit] :as cfg} f mdata]
-  (if audit
-    (with-meta
-      (fn [cfg {:keys [::request] :as params}]
-        (p/finally (f cfg params)
-                   (fn [result _]
-                     (when result
-                       (let [resultm    (meta result)
-                             profile-id (or (::audit/profile-id resultm)
-                                            (:profile-id result)
-                                            (:profile-id params))
-                             props      (or (::audit/replace-props resultm)
-                                            (-> params
-                                                (merge (::audit/props resultm))
-                                                (dissoc :type)))]
-                         (audit :cmd :submit
-                                :type (or (::audit/type resultm)
+  [cfg f mdata]
+  (if-let [collector (::audit/collector cfg)]
+    (letfn [(handle-audit [params result]
+              (let [resultm    (meta result)
+                    request    (::http/request params)
+                    profile-id (or (::audit/profile-id resultm)
+                                   (:profile-id result)
+                                   (:profile-id params)
+                                   uuid/zero)
+
+                    props      (or (::audit/replace-props resultm)
+                                   (-> params
+                                       (d/without-qualified)
+                                       (merge (::audit/props resultm))
+                                       (dissoc :profile-id)
+                                       (dissoc :type)))
+
+                    event      {:type (or (::audit/type resultm)
                                           (::type cfg))
                                 :name (or (::audit/name resultm)
                                           (::sv/name mdata))
                                 :profile-id profile-id
                                 :ip-addr (some-> request audit/parse-client-ip)
-                                :props (dissoc props ::request)))))))
-      mdata)
+                                :props props
+                                ::webhooks/batch-key
+                                (or (::webhooks/batch-key mdata)
+                                    (::webhooks/batch-key resultm))
+
+                                ::webhooks/batch-timeout
+                                (or (::webhooks/batch-timeout mdata)
+                                    (::webhooks/batch-timeout resultm))
+
+                                ::webhooks/event?
+                                (or (::webhooks/event? mdata)
+                                    (::webhooks/event? resultm)
+                                    false)}]
+
+                (audit/submit! collector event)))
+
+            (handle-request [cfg params]
+              (->> (f cfg params)
+                   (p/mcat (fn [result]
+                             (->> (handle-audit params result)
+                                  (p/map (constantly result)))))))]
+      (if-not (::audit/skip mdata)
+        (with-meta handle-request mdata)
+        f))
     f))
 
 (defn- wrap
   [cfg f mdata]
   (let [f     (as-> f $
                 (wrap-dispatch cfg $ mdata)
-                (rlimit/wrap-rlimit cfg $ mdata)
+                (cond/wrap cfg $ mdata)
                 (retry/wrap-retry cfg $ mdata)
-                (wrap-audit cfg $ mdata)
                 (wrap-metrics cfg $ mdata)
-                )
+                (climit/wrap cfg $ mdata)
+                (rlimit/wrap cfg $ mdata)
+                (wrap-audit cfg $ mdata))
 
         spec  (or (::sv/spec mdata) (s/spec any?))
         auth? (:auth mdata true)]
@@ -191,6 +215,7 @@
       (fn [{:keys [::request] :as params}]
         ;; Raise authentication error when rpc method requires auth but
         ;; no profile-id is found in the request.
+
         (p/do!
          (if (and auth? (not (uuid? (:profile-id params))))
            (ex/raise :type :authentication
@@ -198,7 +223,6 @@
                      :hint "authentication required for this endpoint")
            (let [params (us/conform spec (dissoc params ::request))]
              (f cfg (assoc params ::request request))))))
-
       mdata)))
 
 (defn- process-method
@@ -241,33 +265,42 @@
   (let [cfg (assoc cfg ::type "command" ::metrics-id :rpc-command-timing)]
     (->> (sv/scan-ns 'app.rpc.commands.binfile
                      'app.rpc.commands.comments
+                     'app.rpc.commands.management
+                     'app.rpc.commands.verify-token
+                     'app.rpc.commands.search
                      'app.rpc.commands.auth
                      'app.rpc.commands.ldap
                      'app.rpc.commands.demo
-                     'app.rpc.commands.files)
+                     'app.rpc.commands.webhooks
+                     'app.rpc.commands.audit
+                     'app.rpc.commands.files
+                     'app.rpc.commands.files.update
+                     'app.rpc.commands.files.create
+                     'app.rpc.commands.files.temp)
          (map (partial process-method cfg))
          (into {}))))
 
-(s/def ::audit (s/nilable fn?))
-(s/def ::executors (s/map-of keyword? ::wrk/executor))
-(s/def ::executors map?)
-(s/def ::http-client fn?)
 (s/def ::ldap (s/nilable map?))
-(s/def ::msgbus fn?)
+(s/def ::msgbus ::mbus/msgbus)
+(s/def ::climit (s/nilable ::climit/climit))
+(s/def ::rlimit (s/nilable ::rlimit/rlimit))
+
 (s/def ::public-uri ::us/not-empty-string)
-(s/def ::session map?)
-(s/def ::storage some?)
-(s/def ::tokens fn?)
+(s/def ::sprops map?)
 
 (defmethod ig/pre-init-spec ::methods [_]
-  (s/keys :req-un [::storage
-                   ::session
-                   ::tokens
-                   ::audit
-                   ::executors
+  (s/keys :req [::audit/collector
+                ::http.client/client
+                ::db/pool
+                ::wrk/executor]
+          :req-un [::sto/storage
+                   ::http.session/session
+                   ::sprops
                    ::public-uri
                    ::msgbus
-                   ::http-client
+                   ::rlimit
+                   ::climit
+                   ::wrk/executor
                    ::mtx/metrics
                    ::db/pool
                    ::ldap]))

backend/src/app/rpc/climit.clj

@@ -0,0 +1,204 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.rpc.climit
+  "Concurrencly limiter for RPC."
+  (:require
+   [app.common.data :as d]
+   [app.common.exceptions :as ex]
+   [app.common.logging :as l]
+   [app.common.spec :as us]
+   [app.config :as cf]
+   [app.metrics :as mtx]
+   [app.rpc :as-alias rpc]
+   [app.util.services :as-alias sv]
+   [app.util.time :as dt]
+   [app.worker :as-alias wrk]
+   [clojure.edn :as edn]
+   [clojure.spec.alpha :as s]
+   [datoteka.fs :as fs]
+   [integrant.core :as ig]
+   [promesa.core :as p]
+   [promesa.exec :as px]
+   [promesa.exec.bulkhead :as pxb])
+  (:import
+   com.github.benmanes.caffeine.cache.Cache
+   com.github.benmanes.caffeine.cache.CacheLoader
+   com.github.benmanes.caffeine.cache.Caffeine
+   com.github.benmanes.caffeine.cache.RemovalListener))
+
+(defn- capacity-exception?
+  [o]
+  (and (ex/ex-info? o)
+       (let [data (ex-data o)]
+         (and (= :bulkhead-error (:type data))
+              (= :capacity-limit-reached (:code data))))))
+
+(defn invoke!
+  [limiter f]
+  (->> (px/submit! limiter f)
+       (p/hcat (fn [result cause]
+                 (cond
+                   (capacity-exception? cause)
+                   (p/rejected
+                    (ex/error :type :internal
+                              :code :concurrency-limit-reached
+                              :queue (-> limiter meta :bkey name)
+                              :cause cause))
+
+                   (some? cause)
+                   (p/rejected cause)
+
+                   :else
+                   (p/resolved result))))))
+
+(defn- create-limiter
+  [{:keys [executor metrics concurrency queue-size bkey skey]}]
+  (let [labels   (into-array String [(name bkey)])
+        on-queue (fn [instance]
+                   (l/trace :hint "enqueued"
+                            :key (name bkey)
+                            :skey (str skey)
+                            :queue-size (get instance ::pxb/current-queue-size)
+                            :concurrency (get instance ::pxb/current-concurrency))
+                   (mtx/run! metrics
+                             :id :rpc-climit-queue-size
+                             :val (get instance ::pxb/current-queue-size)
+                             :labels labels)
+                   (mtx/run! metrics
+                             :id :rpc-climit-concurrency
+                             :val (get instance ::pxb/current-concurrency)
+                             :labels labels))
+
+        on-run   (fn [instance task]
+                   (let [elapsed (- (inst-ms (dt/now))
+                                    (inst-ms task))]
+                     (l/trace :hint "execute"
+                              :key (name bkey)
+                              :skey (str skey)
+                              :elapsed (str elapsed "ms"))
+                     (mtx/run! metrics
+                               :id :rpc-climit-timing
+                               :val elapsed
+                               :labels labels)
+                     (mtx/run! metrics
+                               :id :rpc-climit-queue-size
+                               :val (get instance ::pxb/current-queue-size)
+                               :labels labels)
+                     (mtx/run! metrics
+                               :id :rpc-climit-concurrency
+                               :val (get instance ::pxb/current-concurrency)
+                               :labels labels)))
+
+        options  {:executor executor
+                  :concurrency concurrency
+                  :queue-size (or queue-size Integer/MAX_VALUE)
+                  :on-queue on-queue
+                  :on-run on-run}]
+
+    (-> (pxb/create options)
+        (vary-meta assoc :bkey bkey :skey skey))))
+
+(defn- create-cache
+  [{:keys [executor] :as params} config]
+  (let [listener (reify RemovalListener
+                   (onRemoval [_ key _val cause]
+                     (l/trace :hint "cache: remove" :key key :reason (str cause))))
+
+        loader   (reify CacheLoader
+                   (load [_ key]
+                     (let [[bkey skey] key]
+                       (when-let [config (get config bkey)]
+                         (-> (merge params config)
+                             (assoc :bkey bkey)
+                             (assoc :skey skey)
+                             (create-limiter))))))]
+
+  (.. (Caffeine/newBuilder)
+      (weakValues)
+      (executor executor)
+      (removalListener listener)
+      (build loader))))
+
+(defprotocol IConcurrencyManager)
+
+(s/def ::concurrency ::us/integer)
+(s/def ::queue-size ::us/integer)
+(s/def ::config
+  (s/map-of keyword?
+            (s/keys :req-un [::concurrency]
+                    :opt-un [::queue-size])))
+
+(defmethod ig/prep-key ::rpc/climit
+  [_ cfg]
+  (merge {:path (cf/get :rpc-climit-config)}
+         (d/without-nils cfg)))
+
+(defmethod ig/pre-init-spec ::rpc/climit [_]
+  (s/keys :req-un [::wrk/executor ::mtx/metrics ::fs/path]))
+
+(defmethod ig/init-key ::rpc/climit
+  [_ {:keys [path] :as params}]
+  (when (contains? cf/flags :rpc-climit)
+    (if-let [config (some->> path slurp edn/read-string)]
+      (do
+        (l/info :hint "initializing concurrency limit" :config (str path))
+        (us/verify! ::config config)
+
+        (let [cache (create-cache params config)]
+          ^{::cache cache}
+          (reify
+            IConcurrencyManager
+            clojure.lang.IDeref
+            (deref [_] config)
+
+            clojure.lang.ILookup
+            (valAt [_ key]
+              (let [key (if (vector? key) key [key])]
+                (.get ^Cache cache key))))))
+
+      (l/warn :hint "unable to load configuration" :config (str path)))))
+
+
+(s/def ::climit #(satisfies? IConcurrencyManager %))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; PUBLIC API
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmacro with-dispatch
+  [lim & body]
+  `(if ~lim
+     (invoke! ~lim (^:once fn [] (p/wrap (do ~@body))))
+     (p/wrap (do ~@body))))
+
+(defn wrap
+  [{:keys [climit]} f {:keys [::queue ::key-fn] :as mdata}]
+  (if (and (some? climit)
+           (some? queue))
+    (if-let [config (get @climit queue)]
+      (do
+        (l/debug :hint "wrap: instrumenting method"
+                 :limit-name (name queue)
+                 :service-name (::sv/name mdata)
+                 :queue-size (or (:queue-size config) Integer/MAX_VALUE)
+                 :concurrency (:concurrency config)
+                 :keyed? (some? key-fn))
+        (if (some? key-fn)
+          (fn [cfg params]
+            (let [key [queue (key-fn params)]
+                  lim (get climit key)]
+              (invoke! lim (partial f cfg params))))
+
+          (let [lim (get climit queue)]
+            (fn [cfg params]
+              (invoke! lim (partial f cfg params))))))
+      (do
+        (l/warn :hint "wrap: no config found"
+                :queue (name queue)
+                :service (::sv/name mdata))
+        f))
+    f))

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

@@ -0,0 +1,86 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.rpc.commands.audit
+  "Audit Log related RPC methods"
+  (:require
+   [app.common.data :as d]
+   [app.common.logging :as l]
+   [app.common.spec :as us]
+   [app.common.uuid :as uuid]
+   [app.config :as cf]
+   [app.db :as db]
+   [app.http :as-alias http]
+   [app.loggers.audit :as audit]
+   [app.rpc.climit :as-alias climit]
+   [app.rpc.doc :as-alias doc]
+   [app.rpc.helpers :as rph]
+   [app.util.services :as sv]
+   [app.util.time :as dt]
+   [app.worker :as wrk]
+   [clojure.spec.alpha :as s]
+   [promesa.core :as p]
+   [promesa.exec :as px]))
+
+(defn- event->row [event]
+  [(uuid/next)
+   (:name event)
+   (:source event)
+   (:type event)
+   (:timestamp event)
+   (:profile-id event)
+   (db/inet (:ip-addr event))
+   (db/tjson (:props event))
+   (db/tjson (d/without-nils (:context event)))])
+
+(def ^:private event-columns
+  [:id :name :source :type :tracked-at
+   :profile-id :ip-addr :props :context])
+
+(defn- handle-events
+  [{:keys [::db/pool]} {:keys [profile-id events ::http/request] :as params}]
+  (let [ip-addr (audit/parse-client-ip request)
+        xform   (comp
+                 (map #(assoc % :profile-id profile-id))
+                 (map #(assoc % :ip-addr ip-addr))
+                 (map #(assoc % :source "frontend"))
+                 (filter :profile-id)
+                 (map event->row))
+        events  (sequence xform events)]
+    (when (seq events)
+      (db/insert-multi! pool :audit-log event-columns events))))
+
+(s/def ::profile-id ::us/uuid)
+(s/def ::name ::us/string)
+(s/def ::type ::us/string)
+(s/def ::props (s/map-of ::us/keyword any?))
+(s/def ::timestamp dt/instant?)
+(s/def ::context (s/map-of ::us/keyword any?))
+
+(s/def ::event
+  (s/keys :req-un [::type ::name ::props ::timestamp]
+          :opt-un [::context]))
+
+(s/def ::events (s/every ::event))
+
+(s/def ::push-audit-events
+  (s/keys :req-un [::events ::profile-id]))
+
+(sv/defmethod ::push-audit-events
+  {::climit/queue :push-audit-events
+   ::climit/key-fn :profile-id
+   ::audit/skip true
+   ::doc/added "1.17"}
+  [{:keys [::db/pool ::wrk/executor] :as cfg} params]
+  (if (or (db/read-only? pool)
+          (not (contains? cf/flags :audit-log)))
+    (do
+      (l/warn :hint "audit: http handler disabled or db is read-only")
+      (rph/wrap nil))
+
+    (->> (px/submit! executor #(handle-events cfg params))
+         (p/fmap (constantly nil)))))
+

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

@@ -2,21 +2,25 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.commands.auth
   (:require
+   [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
    [app.emails :as eml]
+   [app.http.session :as session]
    [app.loggers.audit :as audit]
+   [app.rpc.climit :as climit]
    [app.rpc.doc :as-alias doc]
+   [app.rpc.helpers :as rph]
    [app.rpc.mutations.teams :as teams]
    [app.rpc.queries.profile :as profile]
-   [app.rpc.rlimit :as rlimit]
+   [app.tokens :as tokens]
    [app.util.services :as sv]
    [app.util.time :as dt]
    [buddy.hashers :as hashers]
@@ -80,7 +84,7 @@
 ;; ---- COMMAND: login with password
 
 (defn login-with-password
-  [{:keys [pool session tokens] :as cfg} {:keys [email password] :as params}]
+  [{:keys [pool session sprops] :as cfg} {:keys [email password] :as params}]
 
   (when-not (contains? cf/flags :login)
     (ex/raise :type :restriction
@@ -95,15 +99,23 @@
             (:valid (verify-password password (:password profile))))
 
           (validate-profile [profile]
-            (when-not (:is-active profile)
-              (ex/raise :type :validation
-                        :code :wrong-credentials))
             (when-not profile
               (ex/raise :type :validation
                         :code :wrong-credentials))
+            (when-not (:is-active profile)
+              (ex/raise :type :validation
+                        :code :wrong-credentials))
+            (when (:is-blocked profile)
+              (ex/raise :type :restriction
+                        :code :profile-blocked))
             (when-not (check-password profile password)
               (ex/raise :type :validation
                         :code :wrong-credentials))
+            (when-let [deleted-at (:deleted-at profile)]
+              (when (dt/is-after? (dt/now) deleted-at)
+                (ex/raise :type :validation
+                          :code :wrong-credentials)))
+
             profile)]
 
     (db/with-atomic [conn pool]
@@ -114,19 +126,19 @@
                             (profile/decode-profile-row))
 
             invitation (when-let [token (:invitation-token params)]
-                         (tokens :verify {:token token :iss :team-invitation}))
+                         (tokens/verify sprops {:token token :iss :team-invitation}))
 
             ;; If invitation member-id does not matches the profile-id, we just proceed to ignore the
-            ;; invitation because invitations matches exactly; and user can't loging with other email and
+            ;; invitation because invitations matches exactly; and user can't login with other email and
             ;; accept invitation with other email
             response   (if (and (some? invitation) (= (:id profile) (:member-id invitation)))
                          {:invitation-token (:invitation-token params)}
                          profile)]
 
-        (with-meta response
-          {:transform-response ((:create session) (:id profile))
-           ::audit/props (audit/profile->props profile)
-           ::audit/profile-id (:id profile)})))))
+        (-> response
+            (rph/with-transform (session/create-fn session (:id profile)))
+            (rph/with-meta {::audit/props (audit/profile->props profile)
+                            ::audit/profile-id (:id profile)}))))))
 
 (s/def ::login-with-password
   (s/keys :req-un [::email ::password]
@@ -135,7 +147,7 @@
 (sv/defmethod ::login-with-password
   "Performs authentication using penpot password."
   {:auth false
-   ::rlimit/permits (cf/get :rlimit-password)
+   ::climit/queue :auth
    ::doc/added "1.15"}
   [cfg params]
   (login-with-password cfg params))
@@ -150,15 +162,14 @@
   {:auth false
    ::doc/added "1.15"}
   [{:keys [session] :as cfg} _]
-  (with-meta {}
-    {:transform-response (:delete session)}))
+  (rph/with-transform {} (session/delete-fn session)))
 
 ;; ---- COMMAND: Recover Profile
 
 (defn recover-profile
-  [{:keys [pool tokens] :as cfg} {:keys [token password]}]
+  [{:keys [pool sprops] :as cfg} {:keys [token password]}]
   (letfn [(validate-token [token]
-            (let [tdata (tokens :verify {:token token :iss :password-recovery})]
+            (let [tdata (tokens/verify sprops {:token token :iss :password-recovery})]
               (:profile-id tdata)))
 
           (update-password [conn profile-id]
@@ -176,20 +187,21 @@
 
 (sv/defmethod ::recover-profile
   {:auth false
-   ::rlimit/permits (cf/get :rlimit-password)
+   ::climit/queue :auth
    ::doc/added "1.15"}
   [cfg params]
   (recover-profile cfg params))
 
 ;; ---- COMMAND: Prepare Register
 
-(defn prepare-register
-  [{:keys [pool tokens] :as cfg} params]
+(defn validate-register-attempt!
+  [{:keys [pool sprops]} params]
+
   (when-not (contains? cf/flags :registration)
     (if-not (contains? params :invitation-token)
       (ex/raise :type :restriction
                 :code :registration-disabled)
-      (let [invitation (tokens :verify {:token (:invitation-token params) :iss :team-invitation})]
+      (let [invitation (tokens/verify sprops {:token (:invitation-token params) :iss :team-invitation})]
         (when-not (= (:email params) (:member-email invitation))
           (ex/raise :type :restriction
                     :code :email-does-not-match-invitation
@@ -207,22 +219,52 @@
               :code :email-has-permanent-bounces
               :hint "looks like the email has one or many bounces reported"))
 
-  (check-profile-existence! pool params)
-
+  ;; Perform a basic validation of email & password
   (when (= (str/lower (:email params))
            (str/lower (:password params)))
     (ex/raise :type :validation
               :code :email-as-password
-              :hint "you can't use your email as password"))
+              :hint "you can't use your email as password")))
 
-  (let [params {:email (:email params)
-                :password (:password params)
-                :invitation-token (:invitation-token params)
-                :backend "penpot"
-                :iss :prepared-register
-                :exp (dt/in-future "48h")}
+(def register-retry-threshold
+  (dt/duration "15m"))
 
-        token  (tokens :generate params)]
+(defn- elapsed-register-retry-threshold?
+  [profile]
+  (let [elapsed (dt/diff (:modified-at profile) (dt/now))]
+    (pos? (compare elapsed register-retry-threshold))))
+
+(defn prepare-register
+  [{:keys [pool sprops] :as cfg} params]
+
+  (validate-register-attempt! cfg params)
+
+  (let [profile (when-let [profile (profile/retrieve-profile-data-by-email pool (:email params))]
+                  (cond
+                    (:is-blocked profile)
+                    (ex/raise :type :restriction
+                              :code :profile-blocked)
+
+                    (and (not (:is-active profile))
+                         (elapsed-register-retry-threshold? profile))
+                    profile
+
+                    :else
+                    (ex/raise :type :validation
+                              :code :email-already-exists
+                              :hint "profile already exists")))
+
+        params  {:email (:email params)
+                 :password (:password params)
+                 :invitation-token (:invitation-token params)
+                 :backend "penpot"
+                 :iss :prepared-register
+                 :profile-id (:id profile)
+                 :exp (dt/in-future {:days 7})}
+
+        params (d/without-nils params)
+
+        token  (tokens/generate sprops params)]
     (with-meta {:token token}
       {::audit/profile-id uuid/zero})))
 
@@ -239,13 +281,15 @@
 ;; ---- COMMAND: Register Profile
 
 (defn create-profile
-  "Create the profile entry on the database with limited input filling
-  all the other fields with defaults."
+  "Create the profile entry on the database with limited set of input
+  attrs (all the other attrs are filled with default values)."
   [conn params]
   (let [id        (or (:id params) (uuid/next))
-
         props     (-> (audit/extract-utm-params params)
                       (merge (:props params))
+                      (merge {:viewed-tutorial? false
+                              :viewed-walkthrough? false
+                              :nudge {:big 10 :small 1}})
                       (db/tjson))
 
         password  (if-let [password (:password params)]
@@ -294,77 +338,105 @@
         (assoc :default-team-id (:id team))
         (assoc :default-project-id (:default-project-id team)))))
 
+(defn send-email-verification!
+  [conn sprops profile]
+  (let [vtoken (tokens/generate sprops
+                                {:iss :verify-email
+                                 :exp (dt/in-future "72h")
+                                 :profile-id (:id profile)
+                                 :email (:email profile)})
+        ;; NOTE: this token is mainly used for possible complains
+        ;; identification on the sns webhook
+        ptoken (tokens/generate sprops
+                                {:iss :profile-identity
+                                 :profile-id (:id profile)
+                                 :exp (dt/in-future {:days 30})})]
+    (eml/send! {::eml/conn conn
+                ::eml/factory eml/register
+                :public-uri (cf/get :public-uri)
+                :to (:email profile)
+                :name (:fullname profile)
+                :token vtoken
+                :extra-data ptoken})))
+
 (defn register-profile
-  [{:keys [conn tokens session] :as cfg} {:keys [token] :as params}]
-  (let [claims    (tokens :verify {:token token :iss :prepared-register})
-        params    (merge params claims)]
-    (check-profile-existence! conn params)
-    (let [is-active  (or (:is-active params)
-                         (contains? cf/flags :insecure-register))
-          profile    (->> (assoc params :is-active is-active)
+  [{:keys [conn sprops session] :as cfg} {:keys [token] :as params}]
+  (let [claims     (tokens/verify sprops {:token token :iss :prepared-register})
+        params     (merge params claims)
+
+        is-active  (or (:is-active params)
+                       (not (contains? cf/flags :email-verification))
+
+                       ;; DEPRECATED: v1.15
+                       (contains? cf/flags :insecure-register))
+
+        profile    (if-let [profile-id (:profile-id claims)]
+                     (profile/retrieve-profile conn profile-id)
+                     (->> (assoc params :is-active is-active)
                           (create-profile conn)
                           (create-profile-relations conn)
-                          (profile/decode-profile-row))
-          invitation (when-let [token (:invitation-token params)]
-                       (tokens :verify {:token token :iss :team-invitation}))]
-      (cond
-        ;; If invitation token comes in params, this is because the user comes from team-invitation process;
-        ;; in this case, regenerate token and send back to the user a new invitation token (and mark current
-        ;; session as logged). This happens only if the invitation email matches with the register email.
-        (and (some? invitation) (= (:email profile) (:member-email invitation)))
-        (let [claims (assoc invitation :member-id  (:id profile))
-              token  (tokens :generate claims)
-              resp   {:invitation-token token}]
-          (with-meta resp
-            {:transform-response ((:create session) (:id profile))
-             ::audit/replace-props (audit/profile->props profile)
-             ::audit/profile-id (:id profile)}))
+                          (profile/decode-profile-row)))
+        invitation (when-let [token (:invitation-token params)]
+                     (tokens/verify sprops {:token token :iss :team-invitation}))]
 
-        ;; If auth backend is different from "penpot" means user is
-        ;; 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)
-          {:transform-response ((:create session) (:id profile))
-           ::audit/replace-props (audit/profile->props profile)
-           ::audit/profile-id (:id profile)})
+    ;; If profile is filled in claims, means it tries to register
+    ;; again, so we proceed to update the modified-at attr
+    ;; accordingly.
+    (when-let [id (:profile-id claims)]
+      (db/update! conn :profile {:modified-at (dt/now)} {:id id})
+      (when-let [collector (::audit/collector cfg)]
+        (audit/submit! collector
+                       {:type "fact"
+                        :name "register-profile-retry"
+                        :profile-id id})))
 
-        ;; If the `:enable-insecure-register` flag is set, we proceed
-        ;; to sign in the user directly, without email verification.
-        (true? is-active)
-        (with-meta (profile/strip-private-attrs profile)
-          {:transform-response ((:create session) (:id profile))
-           ::audit/replace-props (audit/profile->props profile)
-           ::audit/profile-id (:id profile)})
+    (cond
+      ;; If invitation token comes in params, this is because the
+      ;; user comes from team-invitation process; in this case,
+      ;; regenerate token and send back to the user a new invitation
+      ;; token (and mark current session as logged). This happens
+      ;; only if the invitation email matches with the register
+      ;; email.
+      (and (some? invitation) (= (:email profile) (:member-email invitation)))
+      (let [claims (assoc invitation :member-id  (:id profile))
+            token  (tokens/generate sprops claims)
+            resp   {:invitation-token token}]
+        (-> resp
+            (rph/with-transform (session/create-fn session (:id profile)))
+            (rph/with-meta {::audit/replace-props (audit/profile->props profile)
+                            ::audit/profile-id (:id profile)})))
 
-        ;; In all other cases, send a verification email.
-        :else
-        (let [vtoken (tokens :generate
-                             {:iss :verify-email
-                              :exp (dt/in-future "48h")
-                              :profile-id (:id profile)
-                              :email (:email profile)})
-              ptoken (tokens :generate-predefined
-                             {:iss :profile-identity
-                              :profile-id (:id profile)})]
-          (eml/send! {::eml/conn conn
-                      ::eml/factory eml/register
-                      :public-uri (:public-uri cfg)
-                      :to (:email profile)
-                      :name (:fullname profile)
-                      :token vtoken
-                      :extra-data ptoken})
+      ;; If auth backend is different from "penpot" means user is
+      ;; registering using third party auth mechanism; in this case
+      ;; we need to mark this session as logged.
+      (not= "penpot" (:auth-backend profile))
+      (-> (profile/strip-private-attrs profile)
+          (rph/with-transform (session/create-fn session (:id profile)))
+          (rph/with-meta {::audit/replace-props (audit/profile->props profile)
+                          ::audit/profile-id (:id profile)}))
 
-          (with-meta profile
-            {::audit/replace-props (audit/profile->props profile)
-             ::audit/profile-id (:id profile)}))))))
+      ;; If the `:enable-insecure-register` flag is set, we proceed
+      ;; to sign in the user directly, without email verification.
+      (true? is-active)
+      (-> (profile/strip-private-attrs profile)
+          (rph/with-transform (session/create-fn session (:id profile)))
+          (rph/with-meta {::audit/replace-props (audit/profile->props profile)
+                          ::audit/profile-id (:id profile)}))
+
+      ;; In all other cases, send a verification email.
+      :else
+      (do
+        (send-email-verification! conn sprops profile)
+        (rph/with-meta profile
+          {::audit/replace-props (audit/profile->props profile)
+           ::audit/profile-id (:id profile)})))))
 
 (s/def ::register-profile
   (s/keys :req-un [::token ::fullname]))
 
 (sv/defmethod ::register-profile
   {:auth false
-   ::rlimit/permits (cf/get :rlimit-password)
+   ::climit/queue :auth
    ::doc/added "1.15"}
   [{:keys [pool] :as cfg} params]
   (db/with-atomic [conn pool]
@@ -374,18 +446,19 @@
 ;; ---- COMMAND: Request Profile Recovery
 
 (defn request-profile-recovery
-  [{:keys [pool tokens] :as cfg} {:keys [email] :as params}]
+  [{:keys [pool sprops] :as cfg} {:keys [email] :as params}]
   (letfn [(create-recovery-token [{:keys [id] :as profile}]
-            (let [token (tokens :generate
-                                {:iss :password-recovery
-                                 :exp (dt/in-future "15m")
-                                 :profile-id id})]
+            (let [token (tokens/generate sprops
+                                         {:iss :password-recovery
+                                          :exp (dt/in-future "15m")
+                                          :profile-id id})]
               (assoc profile :token token)))
 
           (send-email-notification [conn profile]
-            (let [ptoken (tokens :generate-predefined
-                                 {:iss :profile-identity
-                                  :profile-id (:id profile)})]
+            (let [ptoken (tokens/generate sprops
+                                          {:iss :profile-identity
+                                           :profile-id (:id profile)
+                                           :exp (dt/in-future {:days 30})})]
               (eml/send! {::eml/conn conn
                           ::eml/factory eml/password-recovery
                           :public-uri (:public-uri cfg)

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

@@ -2,7 +2,7 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.commands.binfile
   (:refer-clojure :exclude [assert])
@@ -16,23 +16,26 @@
    [app.config :as cf]
    [app.db :as db]
    [app.media :as media]
+   [app.rpc.commands.files :as files]
    [app.rpc.doc :as-alias doc]
-   [app.rpc.queries.files :as files]
    [app.rpc.queries.projects :as projects]
    [app.storage :as sto]
    [app.storage.tmp :as tmp]
    [app.tasks.file-gc]
    [app.util.blob :as blob]
-   [app.util.bytes :as bs]
    [app.util.fressian :as fres]
+   [app.util.pointer-map :as pmap]
    [app.util.services :as sv]
    [app.util.time :as dt]
-   [clojure.java.io :as io]
    [clojure.spec.alpha :as s]
    [clojure.walk :as walk]
    [cuerdas.core :as str]
-   [yetti.adapter :as yt])
+   [datoteka.io :as io]
+   [yetti.adapter :as yt]
+   [yetti.response :as yrs])
   (:import
+   com.github.luben.zstd.ZstdInputStream
+   com.github.luben.zstd.ZstdOutputStream
    java.io.DataInputStream
    java.io.DataOutputStream
    java.io.InputStream
@@ -201,7 +204,7 @@
            :position @*position*
            ::l/async false)
   (let [vers   (-> version name (subs 1) parse-long)
-        output (bs/data-output-stream output)]
+        output (io/data-output-stream output)]
     (doto output
       (write-byte! (get-mark :header))
       (write-long! penpot-magic-number)
@@ -210,7 +213,7 @@
 (defn read-header!
   [^InputStream input]
   (l/trace :fn "read-header!" :position @*position* ::l/async false)
-  (let [input (bs/data-input-stream input)
+  (let [input (io/data-input-stream input)
         mark  (read-byte! input)
         mnum  (read-long! input)
         vers  (read-long! input)]
@@ -225,7 +228,7 @@
 
 (defn copy-stream!
   [^OutputStream output ^InputStream input ^long size]
-  (let [written (bs/copy! input output :size size)]
+  (let [written (io/copy! input output :size size)]
     (l/trace :fn "copy-stream!" :position @*position* :size size :written written ::l/async false)
     (swap! *position* + written)
     written))
@@ -254,11 +257,11 @@
 
     (if (> s temp-file-threshold)
       (with-open [^OutputStream output (io/output-stream p)]
-        (let [readed (bs/copy! input output :offset 0 :size s)]
+        (let [readed (io/copy! input output :offset 0 :size s)]
           (l/trace :fn "read-stream*!" :expected s :readed readed :position @*position* ::l/async false)
           (swap! *position* + readed)
           [s p]))
-      [s (bs/read-as-bytes input :size s)])))
+      [s (io/read-as-bytes input :size s)])))
 
 (defmacro assert-read-label!
   [input expected-label]
@@ -267,7 +270,7 @@
      (when (not= readed# expected#)
        (ex/raise :type :validation
                  :code :unexpected-label
-                 :hint (format "unxpected label found: %s, expected: %s" readed# expected#)))))
+                 :hint (format "unexpected label found: %s, expected: %s" readed# expected#)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; API
@@ -275,11 +278,23 @@
 
 ;; --- HELPERS
 
+(defn zstd-input-stream
+  ^InputStream
+  [input]
+  (ZstdInputStream. ^InputStream input))
+
+(defn zstd-output-stream
+  ^OutputStream
+  [output & {:keys [level] :or {level 0}}]
+  (ZstdOutputStream. ^OutputStream output (int level)))
+
 (defn- retrieve-file
   [pool file-id]
-  (->> (db/query pool :file {:id file-id})
-       (map files/decode-row)
-       (first)))
+  (with-open [conn (db/open pool)]
+    (binding [pmap/*load-fn* (partial files/load-pointer conn file-id)]
+      (some-> (db/get* conn :file {:id file-id})
+              (files/decode-row)
+              (update :data files/process-pointers deref)))))
 
 (def ^:private sql:file-media-objects
   "SELECT * FROM file_media_object WHERE id = ANY(?)")
@@ -355,7 +370,7 @@
 (def ^:dynamic *state*)
 (def ^:dynamic *options*)
 
-;; --- EXPORT WRITTER
+;; --- EXPORT WRITER
 
 (defn- embed-file-assets
   [data conn file-id]
@@ -385,8 +400,8 @@
               form))
 
           (process-group-of-assets [data [lib-id items]]
-            ;; NOTE: there are a posibility that shape refers to a not
-            ;; existing file because the file was removed. In this
+            ;; NOTE: there is a possibility that shape refers to an
+            ;; non-existant file because the file was removed. In this
             ;; case we just ignore the asset.
             (if-let [lib (retrieve-file conn lib-id)]
               (reduce (partial process-asset lib) data items)
@@ -411,7 +426,7 @@
 (defmulti write-export ::version)
 (defmulti write-section ::section)
 
-(s/def ::output bs/output-stream?)
+(s/def ::output io/output-stream?)
 (s/def ::file-ids (s/every ::us/uuid :kind vector? :min-count 1))
 (s/def ::include-libraries? (s/nilable ::us/boolean))
 (s/def ::embed-assets? (s/nilable ::us/boolean))
@@ -422,14 +437,14 @@
           :opt    [::include-libraries? ::embed-assets?]))
 
 (defn write-export!
-  "Do the exportation of a speficied file in custom penpot binary
+  "Do the exportation of a specified file in custom penpot binary
   format. There are some options available for customize the output:
 
-  `::include-libraries?`: additionaly to the specified file, all the
+  `::include-libraries?`: additionally to the specified file, all the
   linked libraries also will be included (including transitive
   dependencies).
 
-  `::embed-assets?`: instead of including the libraryes, embedd in the
+  `::embed-assets?`: instead of including the libraries, embed in the
   same file library all assets used from external libraries."
   [{:keys [::include-libraries? ::embed-assets?] :as options}]
   (us/assert! ::write-export-options options)
@@ -441,8 +456,8 @@
 (defmethod write-export :default
   [{:keys [::output] :as options}]
   (write-header! output :v1)
-  (with-open [output (bs/zstd-output-stream output :level 12)]
-    (with-open [output (bs/data-output-stream output)]
+  (with-open [output (zstd-output-stream output :level 12)]
+    (with-open [output (io/data-output-stream output)]
       (binding [*state* (volatile! {})]
         (run! (fn [section]
                 (l/debug :hint "write section" :section section ::l/async false)
@@ -530,7 +545,7 @@
 (defmulti read-section ::section)
 
 (s/def ::project-id ::us/uuid)
-(s/def ::input bs/input-stream?)
+(s/def ::input io/input-stream?)
 (s/def ::overwrite? (s/nilable ::us/boolean))
 (s/def ::migrate? (s/nilable ::us/boolean))
 (s/def ::ignore-index-errors? (s/nilable ::us/boolean))
@@ -545,7 +560,7 @@
   format. There are some options for customize the importation
   behavior:
 
-  `::overwrite?`: if true, instead of creating new files and remaping id references,
+  `::overwrite?`: if true, instead of creating new files and remapping id references,
   it reuses all ids and updates existing objects; defaults to `false`.
 
   `::migrate?`: if true, applies the migration before persisting the
@@ -562,8 +577,8 @@
 
 (defmethod read-import :v1
   [{:keys [pool ::input] :as options}]
-  (with-open [input (bs/zstd-input-stream input)]
-    (with-open [input (bs/data-input-stream input)]
+  (with-open [input (zstd-input-stream input)]
+    (with-open [input (io/data-input-stream input)]
       (db/with-atomic [conn pool]
         (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED;"])
         (binding [*state* (volatile! {:media [] :index {}})]
@@ -610,7 +625,7 @@
       (l/debug :hint "update media references" ::l/async false)
       (vswap! *state* update :media into (map #(update % :id lookup-index)) media')
 
-      (l/debug :hint "procesing file" :file-id file-id ::l/async false)
+      (l/debug :hint "processing file" :file-id file-id ::l/async false)
 
       (let [file-id' (lookup-index file-id)
             data     (-> (:data file)
@@ -622,7 +637,7 @@
 
             params  {:id file-id'
                      :project-id project-id
-                     :name (str "Imported: " (:name file))
+                     :name (:name file)
                      :revn (:revn file)
                      :is-shared (:is-shared file)
                      :data (blob/encode data)
@@ -750,6 +765,10 @@
               (uuid? (:typography-ref-file form))
               (update :typography-ref-file lookup-index)
 
+              ;; This covers the component instance links
+              (uuid? (:component-file form))
+              (update :component-file lookup-index)
+
               ;; This covers the shadows and grids (they have directly
               ;; the :file-id prop)
               (uuid? (:file-id form))
@@ -784,27 +803,40 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn export!
-  [cfg]
-  (let [path (tmp/tempfile :prefix "penpot.export.")
-        id   (uuid/next)
-        ts   (dt/now)
-        cs   (volatile! nil)]
+  [cfg output]
+  (let [id (uuid/next)
+        tp (dt/tpoint)
+        ab (volatile! false)
+        cs (volatile! nil)]
     (try
       (l/info :hint "start exportation" :export-id id)
-      (with-open [output (io/output-stream path)]
+      (with-open [^AutoCloseable output (io/output-stream output)]
         (binding [*position* (atom 0)]
-          (write-export! (assoc cfg ::output output))
-          path))
+          (write-export! (assoc cfg ::output output))))
+
+      (catch java.io.IOException _cause
+        ;; Do nothing, EOF means client closes connection abruptly
+        (vreset! ab true)
+        nil)
 
       (catch Throwable cause
         (vreset! cs cause)
+        (vreset! ab true)
         (throw cause))
 
       (finally
         (l/info :hint "exportation finished" :export-id id
-                :elapsed (str (inst-ms (dt/diff ts (dt/now))) "ms")
+                :elapsed (str (inst-ms (tp)) "ms")
+                :aborted @ab
                 :cause @cs)))))
 
+(defn export-to-tmpfile!
+  [cfg]
+  (let [path (tmp/tempfile :prefix "penpot.export.")]
+    (with-open [^AutoCloseable output (io/output-stream path)]
+      (export! cfg output)
+      path)))
+
 (defn import!
   [{:keys [::input] :as cfg}]
   (let [id (uuid/next)
@@ -813,7 +845,7 @@
     (try
       (l/info :hint "start importation" :import-id id)
       (binding [*position* (atom 0)]
-        (with-open [input (io/input-stream input)]
+        (with-open [^AutoCloseable input (io/input-stream input)]
           (read-import! (assoc cfg ::input input))))
 
       (catch Throwable cause
@@ -840,17 +872,17 @@
   "Export a penpot file in a binary format."
   {::doc/added "1.15"}
   [{:keys [pool] :as cfg} {:keys [profile-id file-id include-libraries? embed-assets?] :as params}]
-  (db/with-atomic [conn pool]
-    (files/check-read-permissions! conn profile-id file-id)
-    (let [path (export! (assoc cfg
-                               ::file-ids [file-id]
-                               ::embed-assets? embed-assets?
-                               ::include-libraries? include-libraries?))]
-      (with-meta {}
-        {:transform-response (fn [_ response]
-                               (assoc response
-                                      :body (io/input-stream path)
-                                      :headers {"content-type" "application/octet-stream"}))}))))
+  (files/check-read-permissions! pool profile-id file-id)
+  (let [body (reify yrs/StreamableResponseBody
+               (-write-body-to-stream [_ _ output-stream]
+                 (-> cfg
+                     (assoc ::file-ids [file-id])
+                     (assoc ::embed-assets? embed-assets?)
+                     (assoc ::include-libraries? include-libraries?)
+                     (export! output-stream))))]
+
+    (fn [_]
+      (yrs/response 200 body {"content-type" "application/octet-stream"}))))
 
 (s/def ::file ::media/upload)
 (s/def ::import-binfile

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

@@ -2,7 +2,7 @@
 ;; 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
+;; Copyright (c) KALEIDOS INC
 
 (ns app.rpc.commands.comments
   (:require
@@ -10,8 +10,9 @@
    [app.common.geom.point :as gpt]
    [app.common.spec :as us]
    [app.db :as db]
+   [app.loggers.webhooks :as-alias webhooks]
+   [app.rpc.commands.files :as files]
    [app.rpc.doc :as-alias doc]
-   [app.rpc.queries.files :as files]
    [app.rpc.queries.teams :as teams]
    [app.rpc.retry :as retry]
    [app.util.blob :as blob]
@@ -43,6 +44,7 @@
          #(or (:file-id %) (:team-id %))))
 
 (sv/defmethod ::get-comment-threads
+  {::doc/added "1.15"}
   [{:keys [pool] :as cfg} params]
   (with-open [conn (db/open pool)]
     (retrieve-comment-threads conn params)))
@@ -245,7 +247,8 @@
 (sv/defmethod ::create-comment-thread
   {::retry/max-retries 3
    ::retry/matches retry/conflict-db-insert?
-   ::doc/added "1.15"}
+   ::doc/added "1.15"
+   ::webhooks/event? true}
   [{:keys [pool] :as cfg} {:keys [profile-id file-id share-id] :as params}]
   (db/with-atomic [conn pool]
     (files/check-comment-permissions! conn profile-id file-id share-id)
@@ -364,7 +367,8 @@
           :opt-un [::share-id]))
 
 (sv/defmethod ::create-comment
-  {::doc/added "1.15"}
+  {::doc/added "1.15"
+   ::webhooks/event? true}
   [{:keys [pool] :as cfg} params]
   (db/with-atomic [conn pool]
     (create-comment conn params)))
@@ -483,7 +487,8 @@
   (s/keys :req-un [::profile-id ::id]))
 
 (sv/defmethod ::delete-comment
-  {::doc/added "1.15"}
+  {::doc/added "1.15"
+   ::webhooks/event? true}
   [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
   (db/with-atomic [conn pool]
     (let [comment (db/get-by-id conn :comment id {:for-update true})]
@@ -529,4 +534,3 @@
                    :frame-id frame-id}
                   {:id (:id thread)})
       nil)))
-