📎 Increment version number.

🐛 Fix problem with auto-width/auto-height + lock-proportions

.circleci/config.yml

@@ -79,16 +79,16 @@ jobs:
           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 (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"

.clj-kondo/config.edn

@@ -2,8 +2,8 @@
  {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

CHANGES.md

@@ -1,9 +1,97 @@
 # CHANGELOG
 
+## 1.16.2-beta
+- Fix strage cursor behaviour after clicking viewport with text pool [Github #2447](https://github.com/penpot/penpot/issues/2447)
+
+## 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
+  technicaly 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)
+
+## 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 +110,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)
@@ -126,8 +216,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!)
 

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,88 @@
+# 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)

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,55 @@
   ;; 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.0.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.9"
+   :git/sha "f0a455d"
+   :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.828"}
   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"}
 
   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
@@ -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,20 @@
 ;; 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.transit :as t]
    [app.config :as cfg]
    [app.main :as main]
+   [app.srepl.main :as srepl]
    [app.util.blob :as blob]
    [app.util.fressian :as fres]
    [app.util.json :as json]
@@ -35,6 +38,24 @@
 
 (defonce system nil)
 
+;; --- Benchmarking Tools
+
+(defmacro run-quick-bench
+  [& exprs]
+  `(with-progress-reporting (quick-bench (do ~@exprs) :verbose)))
+
+(defmacro run-quick-bench'
+  [& exprs]
+  `(quick-bench (do ~@exprs)))
+
+(defmacro run-bench
+  [& exprs]
+  `(with-progress-reporting (bench (do ~@exprs) :verbose)))
+
+(defmacro run-bench'
+  [& exprs]
+  `(bench (do ~@exprs)))
+
 ;; --- Development Stuff
 
 (defn- run-tests
@@ -55,7 +76,7 @@
   []
   (alter-var-root #'system (fn [sys]
                              (when sys (ig/halt! sys))
-                             (-> main/system-config
+                             (-> (merge main/system-config main/worker-config)
                                  (ig/prep)
                                  (ig/init))))
   :started)

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

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

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/log4j2-devenv.xml

@@ -25,11 +25,13 @@
     <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.cli" level="debug" additivity="false">
       <AppenderRef ref="console"/>

backend/resources/rlimit.edn

@@ -0,0 +1,6 @@
+^{:refresh "30s"}
+{:default
+ [[:default :window "200000/h"]]
+
+ #{: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/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-rpc-rate-limit enable-warn-rpc-rate-limits enable-smtp"
 
 # export PENPOT_DATABASE_URI="postgresql://172.17.0.1:5432/penpot"
 # export PENPOT_DATABASE_USERNAME="penpot"
@@ -16,6 +16,8 @@ export PENPOT_FLAGS="$PENPOT_FLAGS enable-backend-asserts enable-audit-log enabl
 # export PENPOT_LOGGERS_LOKI_URI="http://172.17.0.1:3100/loki/api/v1/push"
 # export PENPOT_AUDIT_LOG_ARCHIVE_URI="http://localhost:6070/api/audit"
 
+export PENPOT_DEFAULT_RATE_LIMIT="default,window,10000/h"
+
 # Initialize MINIO config
 mc alias set penpot-s3/ http://minio:9000 minioadmin minioadmin
 mc admin user add penpot-s3 penpot-devenv penpot-devenv

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,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.oidc
   "OIDC client implementation."
@@ -15,9 +15,11 @@
    [app.common.uri :as u]
    [app.config :as cf]
    [app.db :as db]
+   [app.http.client :as http]
    [app.http.middleware :as hmw]
    [app.loggers.audit :as audit]
    [app.rpc.queries.profile :as profile]
+   [app.tokens :as tokens]
    [app.util.json :as json]
    [app.util.time :as dt]
    [app.worker :as wrk]
@@ -47,7 +49,7 @@
 (defn- discover-oidc-config
   [{:keys [http-client]} {: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! http-client {:method :get :uri (str discovery-uri)} {:sync? true}))]
     (cond
       (ex/exception? response)
       (do
@@ -158,10 +160,10 @@
 (defn- retrieve-github-email
   [{:keys [http-client]} 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})
+      (-> (http/req! 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}]
                     (when-not (s/int-in-range? 200 300 status)
                       (ex/raise :type :internal
@@ -278,7 +280,7 @@
                 :uri (:token-uri provider)
                 :body (u/map->query-string params)}]
     (p/then
-     (http-client req)
+     (http/req! http-client req)
      (fn [{:keys [status body] :as res}]
        (if (= status 200)
          (let [data (json/read body)]
@@ -292,11 +294,10 @@
 (defn- retrieve-user-info
   [{:keys [provider http-client] :as cfg} tdata]
   (letfn [(retrieve []
-            (http-client {:uri (:user-uri provider)
-                          :headers {"Authorization" (str (:type tdata) " " (:token tdata))}
-                          :timeout 6000
-                          :method :get}))
-
+            (http/req! http-client {: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
@@ -353,7 +354,7 @@
                    ::props]))
 
 (defn retrieve-info
-  [{:keys [tokens provider] :as cfg} {:keys [params] :as request}]
+  [{:keys [sprops 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 +393,7 @@
 
     (let [state  (get params :state)
           code   (get params :code)
-          state  (tokens :verify {:token state :iss :oauth})]
+          state  (tokens/verify sprops {:token state :iss :oauth})]
       (-> (p/resolved code)
           (p/then #(retrieve-access-token cfg %))
           (p/then #(retrieve-user-info cfg %))
@@ -420,22 +421,26 @@
     (redirect-response uri)))
 
 (defn- generate-redirect
-  [{:keys [tokens session audit] :as cfg} request info profile]
+  [{:keys [sprops session audit] :as cfg} request info profile]
   (if profile
     (let [sxf    ((:create session) (:id profile))
           token  (or (:invitation-token info)
-                     (tokens :generate {:iss :auth
-                                        :exp (dt/in-future "15m")
-                                        :profile-id (:id profile)}))
+                     (tokens/generate sprops {:iss :auth
+                                              :exp (dt/in-future "15m")
+                                              :profile-id (:id profile)}))
           params {:token token}
 
           uri    (-> (u/uri (:public-uri cfg))
                      (assoc :path "/#/auth/verify-token")
                      (assoc :query (u/map->query-string params)))]
 
+      (when (:is-blocked profile)
+        (ex/raise :type :restriction
+                  :code :profile-blocked))
+
       (when (fn? audit)
         (audit :cmd :submit
-               :type "mutation"
+               :type "command"
                :name "login"
                :profile-id (:id profile)
                :ip-addr (audit/parse-client-ip request)
@@ -448,7 +453,7 @@
                         :iss :prepared-register
                         :is-active true
                         :exp (dt/in-future {:hours 48}))
-          token  (tokens :generate info)
+          token  (tokens/generate sprops info)
           params (d/without-nils
                   {:token token
                    :fullname (:fullname info)})
@@ -458,13 +463,13 @@
       (redirect-response uri))))
 
 (defn- auth-handler
-  [{:keys [tokens] :as cfg} {:keys [params] :as request}]
+  [{:keys [sprops] :as 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 sprops
+                               {: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})))
 
@@ -496,16 +501,16 @@
                        :hint "provider not configured"))))))})
 
 (s/def ::public-uri ::us/not-empty-string)
-(s/def ::http-client fn?)
+(s/def ::http-client ::http/client)
 (s/def ::session map?)
-(s/def ::tokens fn?)
+(s/def ::sprops map?)
 (s/def ::providers map?)
 
 (defmethod ig/pre-init-spec ::routes
   [_]
   (s/keys :req-un [::public-uri
                    ::session
-                   ::tokens
+                   ::sprops
                    ::http-client
                    ::providers
                    ::db/pool

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."

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]))
 
@@ -48,6 +48,7 @@
 
    :default-blob-version 4
    :loggers-zmq-uri "tcp://localhost:45556"
+   :rpc-rlimit-config (fs/path "resources/rlimit.edn")
 
    :file-change-snapshot-every 5
    :file-change-snapshot-timeout "3h"
@@ -83,21 +84,21 @@
    ;; 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 ::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 ::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 ::authenticated-cookie-domain ::us/string)
@@ -131,8 +132,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)
@@ -165,11 +166,13 @@
 (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 ::semaphore-process-font ::us/integer)
+(s/def ::semaphore-process-image ::us/integer)
+(s/def ::semaphore-update-file ::us/integer)
+(s/def ::semaphore-auth ::us/integer)
+
 (s/def ::smtp-default-from ::us/string)
 (s/def ::smtp-default-reply-to ::us/string)
 (s/def ::smtp-host ::us/string)
@@ -194,18 +197,12 @@
 (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
                    ::auth-token-cookie-name
                    ::auth-token-cookie-max-age
                    ::authenticated-cookie-name
@@ -217,9 +214,9 @@
                    ::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
                    ::file-change-snapshot-every
                    ::file-change-snapshot-timeout
@@ -272,14 +269,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 +284,10 @@
                    ::smtp-ssl
                    ::smtp-tls
                    ::smtp-username
+
                    ::srepl-host
                    ::srepl-port
+
                    ::assets-storage-backend
                    ::storage-assets-fs-directory
                    ::storage-assets-s3-bucket
@@ -309,7 +307,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]
@@ -350,11 +349,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,55 @@
               (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-by-params
+(defn get*
+  "Internal function for retrieve a single row from database that
+  matches a simple filters."
   ([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)))
+   (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
                  :table table
                  :hint "database object not found"))
-     res)))
+     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 [row (get* ds table params (assoc opts :check-deleted? check-not-found))]
+     (when (and (not row) check-not-found)
+       (ex/raise :type :not-found
+                 :table table
+                 :hint "database object not found"))
+     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]
@@ -369,23 +397,23 @@
    (.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]

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
@@ -114,18 +114,18 @@
 ;; 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 map?)
+(s/def ::storage map?)
+(s/def ::ws fn?)
 
 (defmethod ig/pre-init-spec ::router [_]
   (s/keys :req-un [::mtx/metrics
@@ -151,7 +151,9 @@
                       [mw/errors errors/handle]
                       [mw/restrict-methods]]}
 
-     ["/metrics" {:handler (:handler metrics)}]
+     ["/metrics" {:handler (::mtx/handler metrics)
+                  :allowed-methods #{:get}}]
+
      ["/assets" {:middleware [(:middleware session)]}
       ["/by-id/:id" {:handler (:objects-handler assets)}]
       ["/by-file-media-id/:id" {:handler (:file-objects-handler assets)}]

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,8 @@
    [app.common.logging :as l]
    [app.db :as db]
    [app.db.sql :as sql]
+   [app.http.client :as http]
+   [app.tokens :as tokens]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig]
@@ -24,10 +26,11 @@
 (declare parse-notification)
 (declare process-report)
 
-(s/def ::http-client fn?)
+(s/def ::http-client ::http/client)
+(s/def ::sprops map?)
 
 (defmethod ig/pre-init-spec ::handler [_]
-  (s/keys :req-un [::db/pool ::http-client]))
+  (s/keys :req-un [::db/pool ::http-client ::sprops]))
 
 (defmethod ig/init-key ::handler
   [_ {:keys [executor] :as cfg}]
@@ -46,7 +49,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! http-client {:uri surl :method :post :timeout 10000} {:sync? true}))
 
         (= mtype "Notification")
         (when-let [message (parse-json (get body "Message"))]
@@ -97,10 +100,10 @@
           (get mail "headers")))
 
 (defn- extract-identity
-  [{:keys [tokens] :as cfg} headers]
+  [{:keys [sprops]} headers]
   (let [tdata (get headers "x-penpot-data")]
     (when-not (str/empty? tdata)
-      (let [result (tokens :verify {:token tdata :iss :profile-identity})]
+      (let [result (tokens/verify sprops {:token tdata :iss :profile-identity})]
         (:profile-id result)))))
 
 (defn- parse-notification

backend/src/app/http/client.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.client
   "Http client abstraction layer."
@@ -12,6 +12,8 @@
    [integrant.core :as ig]
    [java-http-clj.core :as http]))
 
+(s/def ::client fn?)
+
 (defmethod ig/pre-init-spec :app.http/client [_]
   (s/keys :req-un [::wrk/executor]))
 
@@ -28,3 +30,11 @@
            (http/send req {:client client :as response-type})
            (http/send-async req {:client client :as response-type}))))
       {::client client})))
+
+(defn req!
+  "A convencience toplevel function for gradual migration to a new API
+  convention."
+  ([client request]
+   (client request))
+  ([client request options]
+   (client request options)))

backend/src/app/http/debug.clj

@@ -2,12 +2,13 @@
 ;; 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]
@@ -17,13 +18,12 @@
    [app.rpc.mutations.files :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 +66,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 +126,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 +214,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 +225,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)
@@ -253,7 +253,7 @@
   (let [items (db/exec! pool [sql:error-reports])
         items (map #(update % :created-at dt/format-instant :rfc1123) items)]
     (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 +280,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 +342,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
   [_ _]

backend/src/app/http/errors.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.errors
   "A errors handling for the http server."
@@ -10,6 +10,7 @@
    [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]
@@ -50,6 +51,11 @@
   [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)]

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

backend/src/app/http/session.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.session
   (:require
@@ -11,6 +11,7 @@
    [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]
@@ -39,7 +40,7 @@
   (delete-session [store key]))
 
 (defn- make-database-store
-  [{:keys [pool tokens executor]}]
+  [{:keys [pool sprops executor]}]
   (reify ISessionStore
     (read-session [_ token]
       (px/with-dispatch executor
@@ -50,9 +51,9 @@
         (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})
+              token      (tokens/generate sprops {:iss "authentication"
+                                                  :iat created-at
+                                                  :uid profile-id})
               params     {:user-agent user-agent
                           :profile-id profile-id
                           :created-at created-at
@@ -68,14 +69,13 @@
                       {:id (:id data)})
           (assoc data :updated-at updated-at))))
 
-
     (delete-session [_ token]
       (px/with-dispatch executor
         (db/delete! pool :http-session {:id token})
         nil))))
 
 (defn make-inmemory-store
-  [{:keys [tokens]}]
+  [{:keys [sprops]}]
   (let [cache (atom {})]
     (reify ISessionStore
       (read-session [_ token]
@@ -86,9 +86,9 @@
           (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})
+                token      (tokens/generate sprops {:iss "authentication"
+                                                    :iat created-at
+                                                    :uid profile-id})
                 params     {:user-agent user-agent
                             :created-at created-at
                             :updated-at created-at
@@ -108,9 +108,9 @@
           (swap! cache dissoc token)
           nil)))))
 
-(s/def ::tokens fn?)
+(s/def ::sprops map?)
 (defmethod ig/pre-init-spec ::store [_]
-  (s/keys :req-un [::db/pool ::wrk/executor ::tokens]))
+  (s/keys :req-un [::db/pool ::wrk/executor ::sprops]))
 
 (defmethod ig/init-key ::store
   [_ {:keys [pool] :as cfg}]

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,6 +15,7 @@
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
+   [app.tokens :as tokens]
    [app.util.async :as aa]
    [app.util.time :as dt]
    [app.worker :as wrk]
@@ -237,10 +238,10 @@
 
 (s/def ::http-client fn?)
 (s/def ::uri ::us/string)
-(s/def ::tokens fn?)
+(s/def ::sprops map?)
 
 (defmethod ig/pre-init-spec ::archive-task [_]
-  (s/keys :req-un [::db/pool ::tokens ::http-client]
+  (s/keys :req-un [::db/pool ::sprops ::http-client]
           :opt-un [::uri]))
 
 (defmethod ig/init-key ::archive-task
@@ -263,7 +264,7 @@
           (let [n (archive-events cfg)]
             (if n
               (do
-                (aa/thread-sleep 200)
+                (aa/thread-sleep 100)
                 (recur (+ total n)))
               (when (pos? total)
                 (l/trace :hint "events chunk archived" :num total)))))))))
@@ -276,7 +277,7 @@
       for update skip locked;")
 
 (defn archive-events
-  [{:keys [pool uri tokens http-client] :as cfg}]
+  [{:keys [pool uri sprops http-client] :as cfg}]
   (letfn [(decode-row [{:keys [props ip-addr context] :as row}]
             (cond-> row
               (db/pgobject? props)
@@ -300,9 +301,9 @@
                               :context]))
 
           (send [events]
-            (let [token   (tokens :generate {:iss "authentication"
-                                             :iat (dt/now)
-                                             :uid uuid/zero})
+            (let [token   (tokens/generate sprops {:iss "authentication"
+                                                   :iat (dt/now)
+                                                   :uid uuid/zero})
                   body    (t/encode {:events events})
                   headers {"content-type" "application/transit+json"
                            "origin" (cf/get :public-uri)
@@ -344,21 +345,17 @@
 
 (def 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 ::gc-task [_]
-  (s/keys :req-un [::db/pool ::max-age]))
+  (s/keys :req-un [::db/pool]))
 
 (defmethod ig/init-key ::gc-task
   [_ 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))

backend/src/app/loggers/loki.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.loki
   "A Loki integration."
@@ -85,7 +85,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,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.mattermost
   "A mattermost integration for error reporting."

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/zmq.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.zmq
   "A generic ZMQ listener."

backend/src/app/main.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.main
   (:require
@@ -10,6 +10,7 @@
    [app.common.logging :as l]
    [app.config :as cf]
    [app.util.time :as dt]
+   [cuerdas.core :as str]
    [integrant.core :as ig])
   (:gen-class))
 
@@ -23,36 +24,26 @@
     :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}
-
-   ;; 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}
+   {:parallelism (cf/get :default-executor-parallelism 70)}
 
    ;; Dedicated thread pool for backround tasks execution.
    [::worker :app.worker/executor]
-   {:parallelism (cf/get :worker-executor-parallelism 10)
-    :prefix :worker}
+   {:parallelism (cf/get :worker-executor-parallelism 20)}
 
    :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])}
+   {:default (ig/ref [::default :app.worker/executor])
+    :worker  (ig/ref [::worker :app.worker/executor])}
 
-   :app.worker/executors-monitor
+   :app.worker/executor-monitor
    {:metrics   (ig/ref :app.metrics/metrics)
-    :scheduler (ig/ref :app.worker/scheduler)
     :executors (ig/ref :app.worker/executors)}
 
    :app.migrations/migrations
@@ -64,13 +55,14 @@
    :app.migrations/all
    {:main (ig/ref :app.migrations/migrations)}
 
+   :app.redis/redis
+   {:uri     (cf/get :redis-uri)
+    :metrics (ig/ref :app.metrics/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)}
+    :redis     (ig/ref :app.redis/redis)}
 
    :app.storage.tmp/cleaner
    {:executor (ig/ref [::worker :app.worker/executor])
@@ -92,7 +84,7 @@
 
    :app.http.session/store
    {:pool     (ig/ref :app.db/pool)
-    :tokens   (ig/ref :app.tokens/tokens)
+    :sprops   (ig/ref :app.setup/props)
     :executor (ig/ref [::default :app.worker/executor])}
 
    :app.http.session/gc-task
@@ -100,7 +92,7 @@
     :max-age     (cf/get :auth-token-cookie-max-age)}
 
    :app.http.awsns/handler
-   {:tokens      (ig/ref :app.tokens/tokens)
+   {:sprops      (ig/ref :app.setup/props)
     :pool        (ig/ref :app.db/pool)
     :http-client (ig/ref :app.http/client)
     :executor    (ig/ref [::worker :app.worker/executor])}
@@ -168,13 +160,14 @@
                   :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)
+    :sprops      (ig/ref :app.setup/props)
     :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)
@@ -186,7 +179,6 @@
     :metrics       (ig/ref :app.metrics/metrics)
     :public-uri    (cf/get :public-uri)
     :storage       (ig/ref :app.storage/storage)
-    :tokens        (ig/ref :app.tokens/tokens)
     :audit-handler (ig/ref :app.loggers.audit/http-handler)
     :rpc-routes    (ig/ref :app.rpc/routes)
     :doc-routes    (ig/ref :app.rpc.doc/routes)
@@ -215,18 +207,32 @@
    {:pool     (ig/ref :app.db/pool)
     :executor (ig/ref [::default :app.worker/executor])}
 
+   :app.rpc/semaphores
+   {:metrics (ig/ref :app.metrics/metrics)
+    :executor (ig/ref [::default :app.worker/executor])}
+
+   :app.rpc/rlimit
+   {:executor  (ig/ref [::worker :app.worker/executor])
+    :scheduler (ig/ref :app.worker/scheduler)}
+
    :app.rpc/methods
    {:pool        (ig/ref :app.db/pool)
     :session     (ig/ref :app.http/session)
-    :tokens      (ig/ref :app.tokens/tokens)
+    :sprops      (ig/ref :app.setup/props)
     :metrics     (ig/ref :app.metrics/metrics)
     :storage     (ig/ref :app.storage/storage)
     :msgbus      (ig/ref :app.msgbus/msgbus)
     :public-uri  (cf/get :public-uri)
+    :redis       (ig/ref :app.redis/redis)
     :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)}
+    :rlimit      (ig/ref :app.rpc/rlimit)
+    :executors   (ig/ref :app.worker/executors)
+    :executor    (ig/ref [::default :app.worker/executor])
+    :templates   (ig/ref :app.setup/builtin-templates)
+    :semaphores  (ig/ref :app.rpc/semaphores)
+    }
 
    :app.rpc.doc/routes
    {:methods (ig/ref :app.rpc/methods)}
@@ -237,7 +243,7 @@
    :app.worker/registry
    {:metrics (ig/ref :app.metrics/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)
@@ -249,17 +255,21 @@
      :audit-log-archive  (ig/ref :app.loggers.audit/archive-task)
      :audit-log-gc       (ig/ref :app.loggers.audit/gc-task)}}
 
-   :app.emails/sendmail-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 :app.metrics/metrics)}
+
    :app.tasks.tasks-gc/handler
    {:pool    (ig/ref :app.db/pool)
     :max-age cf/deletion-delay}
@@ -285,13 +295,13 @@
    {:port (cf/get :srepl-port)
     :host (cf/get :srepl-host)}
 
+   :app.setup/builtin-templates
+   {:http-client (ig/ref :app.http/client)}
+
    :app.setup/props
    {:pool (ig/ref :app.db/pool)
     :key  (cf/get :secret-key)}
 
-   :app.setup/keys
-   {:props (ig/ref :app.setup/props)}
-
    :app.loggers.zmq/receiver
    {:endpoint (cf/get :loggers-zmq-uri)}
 
@@ -305,13 +315,12 @@
 
    :app.loggers.audit/archive-task
    {:uri         (cf/get :audit-log-archive-uri)
-    :tokens      (ig/ref :app.tokens/tokens)
+    :sprops      (ig/ref :app.setup/props)
     :pool        (ig/ref :app.db/pool)
     :http-client (ig/ref :app.http/client)}
 
    :app.loggers.audit/gc-task
-   {:max-age  (cf/get :audit-log-gc-max-age cf/deletion-delay)
-    :pool     (ig/ref :app.db/pool)}
+   {:pool (ig/ref :app.db/pool)}
 
    :app.loggers.loki/reporter
    {:uri         (cf/get :loggers-loki-uri)
@@ -352,7 +361,7 @@
 
 
 (def worker-config
-  {   :app.worker/cron
+  {:app.worker/cron
    {:executor   (ig/ref [::worker :app.worker/executor])
     :scheduler  (ig/ref :app.worker/scheduler)
     :tasks      (ig/ref :app.worker/registry)
@@ -387,7 +396,7 @@
         :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
@@ -409,6 +418,8 @@
                                  (ig/prep)
                                  (ig/init))))
   (l/info :msg "welcome to penpot"
+          :flags (str/join "," (map name cf/flags))
+          :worker? (contains? cf/flags :backend-worker)
           :version (:full cf/version)))
 
 (defn stop

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)
@@ -224,14 +224,14 @@
             ;; 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,7 +31,7 @@
 (set! *warn-on-reflection* true)
 
 (declare create-registry)
-(declare create)
+(declare create-collector)
 (declare handler)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -37,120 +40,151 @@
 
 (def default-metrics
   {:update-file-changes
-   {:name "rpc_update_file_changes_total"
-    :help "A total number of changes submitted to update-file."
-    :type :counter}
+   {::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
-   {:name "rpc_update_file_bytes_processed_total"
-    :help "A total number of bytes processed by update-file."
-    :type :counter}
+   {::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
-   {:name "rpc_mutation_timing"
-    :help "RPC mutation method call timming."
-    :labels ["name"]
-    :type :histogram}
+   {::mdef/name "penpot_rpc_mutation_timing"
+    ::mdef/help "RPC mutation method call timming."
+    ::mdef/labels ["name"]
+    ::mdef/type :histogram}
 
    :rpc-command-timing
-   {:name "rpc_command_timing"
-    :help "RPC command method call timming."
-    :labels ["name"]
-    :type :histogram}
+   {::mdef/name "penpot_rpc_command_timing"
+    ::mdef/help "RPC command method call timming."
+    ::mdef/labels ["name"]
+    ::mdef/type :histogram}
 
    :rpc-query-timing
-   {:name "rpc_query_timing"
-    :help "RPC query method call timing."
-    :labels ["name"]
-    :type :histogram}
+   {::mdef/name "penpot_rpc_query_timing"
+    ::mdef/help "RPC query method call timing."
+    ::mdef/labels ["name"]
+    ::mdef/type :histogram}
 
    :websocket-active-connections
-   {:name "websocket_active_connections"
-    :help "Active websocket connections gauge"
-    :type :gauge}
+   {::mdef/name "penpot_websocket_active_connections"
+    ::mdef/help "Active websocket connections gauge"
+    ::mdef/type :gauge}
 
    :websocket-messages-total
-   {:name "websocket_message_total"
-    :help "Counter of processed messages."
-    :labels ["op"]
-    :type :counter}
+   {::mdef/name "penpot_websocket_message_total"
+    ::mdef/help "Counter of processed messages."
+    ::mdef/labels ["op"]
+    ::mdef/type :counter}
 
    :websocket-session-timing
-   {:name "websocket_session_timing"
-    :help "Websocket session timing (seconds)."
-    :type :summary}
+   {::mdef/name "penpot_websocket_session_timing"
+    ::mdef/help "Websocket session timing (seconds)."
+    ::mdef/type :summary}
 
    :session-update-total
-   {:name "http_session_update_total"
-    :help "A counter of session update batch events."
-    :type :counter}
+   {::mdef/name "penpot_http_session_update_total"
+    ::mdef/help "A counter of session update batch events."
+    ::mdef/type :counter}
 
    :tasks-timing
-   {:name "penpot_tasks_timing"
-    :help "Background tasks timing (milliseconds)."
-    :labels ["name"]
-    :type :summary}
+   {::mdef/name "penpot_tasks_timing"
+    ::mdef/help "Background tasks timing (milliseconds)."
+    ::mdef/labels ["name"]
+    ::mdef/type :summary}
 
-   :rlimit-queued-submissions
-   {:name "penpot_rlimit_queued_submissions"
-    :help "Current number of queued submissions on RLIMIT."
-    :labels ["name"]
-    :type :gauge}
+   :redis-eval-timing
+   {::mdef/name "penpot_redis_eval_timing"
+    ::mdef/help "Redis EVAL commands execution timings (ms)"
+    ::mdef/labels ["name"]
+    ::mdef/type :summary}
 
-   :rlimit-used-permits
-   {:name "penpot_rlimit_used_permits"
-    :help "Current number of used permits on RLIMIT."
-    :labels ["name"]
-    :type :gauge}
+   :semaphore-queued-submissions
+   {::mdef/name "penpot_semaphore_queued_submissions"
+    ::mdef/help "Current number of queued submissions on SEMAPHORE."
+    ::mdef/labels ["name"]
+    ::mdef/type :gauge}
 
-   :rlimit-acquires-total
-   {:name "penpot_rlimit_acquires_total"
-    :help "Total number of acquire operations on RLIMIT."
-    :labels ["name"]
-    :type :counter}
+   :semaphore-used-permits
+   {::mdef/name "penpot_semaphore_used_permits"
+    ::mdef/help "Current number of used permits on SEMAPHORE."
+    ::mdef/labels ["name"]
+    ::mdef/type :gauge}
+
+   :semaphore-timing
+   {::mdef/name "penpot_semaphore_timing"
+    ::mdef/help "Total timing of SEMAPHORE."
+    ::mdef/labels ["name"]
+    ::mdef/type :summary}
 
    :executors-active-threads
-   {:name "penpot_executors_active_threads"
-    :help "Current number of threads available in the executor service."
-    :labels ["name"]
-    :type :gauge}
+   {::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
-   {:name "penpot_executors_completed_tasks_total"
-    :help "Aproximate number of completed tasks by the executor."
-    :labels ["name"]
-    :type :counter}
+   {::mdef/name "penpot_executors_completed_tasks_total"
+    ::mdef/help "Aproximate number of completed tasks by the executor."
+    ::mdef/labels ["name"]
+    ::mdef/type :counter}
 
    :executors-running-threads
-   {:name "penpot_executors_running_threads"
-    :help "Current number of threads with state RUNNING."
-    :labels ["name"]
-    :type :gauge}
+   {::mdef/name "penpot_executors_running_threads"
+    ::mdef/help "Current number of threads with state RUNNING."
+    ::mdef/labels ["name"]
+    ::mdef/type :gauge}
 
    :executors-queued-submissions
-   {:name "penpot_executors_queued_submissions"
-    :help "Current number of queued submissions."
-    :labels ["name"]
-    :type :gauge}})
+   {::mdef/name "penpot_executors_queued_submissions"
+    ::mdef/help "Current number of queued submissions."
+    ::mdef/labels ["name"]
+    ::mdef/type :gauge}})
+
+(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})
+
+(s/def ::mdef/instance
+  #(instance? SimpleCollector %))
+
+(s/def ::mdef/definition
+  (s/keys :req [::mdef/name
+                ::mdef/help
+                ::mdef/type]
+          :opt [::mdef/labels
+                ::mdef/instance]))
+
+(s/def ::definitions
+  (s/map-of keyword? ::mdef/definition))
+
+(s/def ::registry
+  #(instance? CollectorRegistry %))
+
+(s/def ::handler fn?)
+(s/def ::metrics
+  (s/keys :req [::registry
+                ::handler
+                ::definitions]))
 
 (defmethod ig/init-key ::metrics
   [_ _]
   (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}))
 
-(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 +208,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 +229,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,9 @@
 
    {: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")}
    ])
 
 

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/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,14 @@
    [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]))
 
 (set! *warn-on-reflection* true)
 
@@ -49,12 +35,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 +48,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)
+(s/def ::sconn ::redis/connection)
+(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}]
+  (redis/close! pconn)
+  (redis/close! sconn))
 
 (defn- conj-subscription
   "A low level function that is responsible to create on-demand
@@ -186,45 +177,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 #{}]
@@ -270,11 +236,10 @@
   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 +248,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,319 @@
+;; 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
+   io.lettuce.core.RedisClient
+   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.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)
+(declare close!)
+
+(s/def ::timer
+  #(instance? Timer %))
+
+(s/def ::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 ::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 ::redis
+  (s/keys :req [::resources ::redis-uri ::timer ::mtx/metrics]
+          :opt [::connection]))
+
+(defmethod ig/pre-init-spec ::redis [_]
+  (s/keys :req-un [::uri ::mtx/metrics]
+          :opt-un [::timeout
+                   ::connect?
+                   ::io-threads
+                   ::worker-threads]))
+
+(defmethod ig/prep-key ::redis
+  [_ cfg]
+  (let [runtime (Runtime/getRuntime)
+        cpus    (.availableProcessors ^Runtime runtime)]
+    (merge {:timeout (dt/duration 5000)
+            :io-threads (max 3 cpus)
+            :worker-threads (max 3 cpus)}
+         (d/without-nils cfg))))
+
+(defmethod ig/init-key ::redis
+  [_ {:keys [connect?] :as cfg}]
+  (let [cfg (initialize-resources cfg)]
+    (cond-> cfg
+      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? metrics] :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 ::mtx/metrics metrics)
+        (assoc ::cache (atom {}))
+        (assoc ::timer timer)
+        (assoc ::redis-uri redis-uri)
+        (assoc ::resources resources))))
+
+(defn- shutdown-resources
+  [{:keys [::resources ::cache ::timer]}]
+  (run! close! (vals @cache))
+  (when resources
+    (.shutdown ^ClientResources resources))
+  (when timer
+    (.stop ^Timer timer)))
+
+(defn connect
+  [{:keys [::resources ::redis-uri] :as cfg}
+   & {: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 cfg))
+        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 get-or-connect
+  [{:keys [::cache] :as state} key options]
+  (assoc state ::connection
+         (or (get @cache key)
+             (-> (swap! cache (fn [cache]
+                                (when-let [prev (get cache key)]
+                                  (close! prev))
+                                (assoc cache key (connect state options))))
+                 (get key)))))
+
+(defn add-listener!
+  [conn listener]
+  (us/assert! ::pubsub-connection @conn)
+  (us/assert! ::pubsub-listener listener)
+
+  (.addListener ^StatefulRedisPubSubConnection @conn
+                ^RedisPubSubListener listener)
+  conn)
+
+(defn publish!
+  [conn topic message]
+  (us/assert! ::us/string topic)
+  (us/assert! ::us/bytes message)
+  (us/assert! ::connection @conn)
+
+  (let [pcomm (.async ^StatefulRedisConnection @conn)]
+    (.publish ^RedisAsyncCommands pcomm ^String topic ^bytes message)))
+
+(defn subscribe!
+  "Blocking operation, intended to be used on a worker/agent thread."
+  [conn & topics]
+  (us/assert! ::pubsub-connection @conn)
+  (let [topics (into-array String (map str topics))
+        cmd    (.sync ^StatefulRedisPubSubConnection @conn)]
+    (.subscribe ^RedisPubSubCommands cmd topics)))
+
+(defn unsubscribe!
+  "Blocking operation, intended to be used on a worker/agent thread."
+  [conn & topics]
+  (us/assert! ::pubsub-connection @conn)
+  (let [topics (into-array String (map str topics))
+        cmd    (.sync ^StatefulRedisPubSubConnection @conn)]
+    (.unsubscribe ^RedisPubSubCommands cmd topics)))
+
+(defn open?
+  [conn]
+  (.isOpen ^StatefulConnection @conn))
+
+(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)))))
+
+(defn close!
+  [o]
+  (.close ^AutoCloseable o))
+
+(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] :as state} script]
+  (us/assert! ::rscript/script script)
+  (us/assert! ::redis state)
+
+  (let [rconn (-> state ::connection deref)
+        cmd   (.async ^StatefulRedisConnection rconn)
+        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/then 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/then (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/catch 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/then (fn [sha]
+                            (swap! scripts-cache assoc sname sha)
+                            sha))))]
+
+      (if-let [sha (get @scripts-cache sname)]
+        (eval-script sha)
+        (-> (load-script)
+            (p/then eval-script))))))

backend/src/app/rpc.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
   (:require
@@ -10,13 +10,15 @@
    [app.common.logging :as l]
    [app.common.spec :as us]
    [app.db :as db]
+   [app.http :as-alias http]
    [app.loggers.audit :as audit]
    [app.metrics :as mtx]
+   [app.msgbus :as-alias mbus]
    [app.rpc.retry :as retry]
    [app.rpc.rlimit :as rlimit]
-   [app.util.async :as async]
+   [app.rpc.semaphore :as-alias rsem]
    [app.util.services :as sv]
-   [app.worker :as wrk]
+   [app.util.time :as ts]
    [clojure.spec.alpha :as s]
    [integrant.core :as ig]
    [promesa.core :as p]
@@ -29,9 +31,10 @@
 
 (defn- handle-response-transformation
   [response request mdata]
-  (if-let [transform-fn (:transform-response mdata)]
-    (p/do (transform-fn request response))
-    (p/resolved response)))
+  (let [response (if (sv/wrapped? response) @response response)]
+    (if-let [transform-fn (:transform-response mdata)]
+      (p/do (transform-fn request response))
+      (p/resolved response))))
 
 (defn- handle-before-comple-hook
   [response mdata]
@@ -39,112 +42,90 @@
     (ex/ignoring (hook-fn)))
   response)
 
+(defn- handle-response
+  [request result]
+  (let [mdata (meta result)]
+    (p/-> (yrs/response 200 result (::http/headers mdata {}))
+          (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 {::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))
+        data   (into {::request request} 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 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 cmd 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- wrap-metrics
   "Wrap service method with metrics measurement."
   [{: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 #(f cfg params))
+          (p/bind p/wrap)))
+    mdata))
 
 (defn- wrap-audit
   [{:keys [audit] :as cfg} f mdata]
@@ -177,11 +158,11 @@
   [cfg f mdata]
   (let [f     (as-> f $
                 (wrap-dispatch cfg $ mdata)
-                (rlimit/wrap-rlimit cfg $ mdata)
-                (retry/wrap-retry cfg $ mdata)
-                (wrap-audit cfg $ mdata)
                 (wrap-metrics cfg $ mdata)
-                )
+                (retry/wrap-retry cfg $ mdata)
+                (rsem/wrap cfg $ mdata)
+                (rlimit/wrap cfg $ mdata)
+                (wrap-audit cfg $ mdata))
 
         spec  (or (::sv/spec mdata) (s/spec any?))
         auth? (:auth mdata true)]
@@ -241,6 +222,8 @@
   (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.auth
                      'app.rpc.commands.ldap
                      'app.rpc.commands.demo
@@ -249,25 +232,24 @@
          (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 ::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
+                   ::sprops
                    ::audit
-                   ::executors
                    ::public-uri
                    ::msgbus
                    ::http-client
+                   ::rsem/semaphores
+                   ::rlimit/rlimit
                    ::mtx/metrics
                    ::db/pool
                    ::ldap]))

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

@@ -2,10 +2,11 @@
 ;; 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]
@@ -16,7 +17,8 @@
    [app.rpc.doc :as-alias doc]
    [app.rpc.mutations.teams :as teams]
    [app.rpc.queries.profile :as profile]
-   [app.rpc.rlimit :as rlimit]
+   [app.rpc.semaphore :as rsem]
+   [app.tokens :as tokens]
    [app.util.services :as sv]
    [app.util.time :as dt]
    [buddy.hashers :as hashers]
@@ -80,7 +82,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 +97,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,7 +124,7 @@
                             (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
@@ -135,7 +145,7 @@
 (sv/defmethod ::login-with-password
   "Performs authentication using penpot password."
   {:auth false
-   ::rlimit/permits (cf/get :rlimit-password)
+   ::rsem/queue :auth
    ::doc/added "1.15"}
   [cfg params]
   (login-with-password cfg params))
@@ -156,9 +166,9 @@
 ;; ---- 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 +186,21 @@
 
 (sv/defmethod ::recover-profile
   {:auth false
-   ::rlimit/permits (cf/get :rlimit-password)
+   ::rsem/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 +218,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 +280,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 +337,106 @@
         (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)))
+        audit-fn   (:audit cfg)
 
-        ;; 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)
+        invitation (when-let [token (:invitation-token params)]
+                     (tokens/verify sprops {:token token :iss :team-invitation}))]
+
+    ;; 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})
+      (audit-fn :cmd :submit
+                :type "fact"
+                :name "register-profile-retry"
+                :profile-id id))
+
+    (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}]
+        (with-meta resp
           {:transform-response ((:create session) (:id profile))
            ::audit/replace-props (audit/profile->props profile)
-           ::audit/profile-id (:id 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)
-        (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 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)})
 
-        ;; 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 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)})
 
-          (with-meta profile
-            {::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)
+        (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)
+   ::rsem/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])
@@ -23,16 +23,18 @@
    [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.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 +203,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 +212,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 +227,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 +256,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]
@@ -275,6 +277,16 @@
 
 ;; --- 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})
@@ -411,7 +423,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))
@@ -441,8 +453,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 +542,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))
@@ -562,8 +574,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 {}})]
@@ -622,7 +634,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 +762,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 +800,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 [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 [output (io/output-stream path)]
+      (export! cfg output)
+      path)))
+
 (defn import!
   [{:keys [::input] :as cfg}]
   (let [id (uuid/next)
@@ -840,17 +869,20 @@
   "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 [resp (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))))]
+
+    (with-meta (sv/wrap nil)
+      {:transform-response (fn [_ response]
+                             (-> response
+                                 (assoc :body resp)
+                                 (assoc :headers {"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

backend/src/app/rpc/commands/demo.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.demo
   "A demo specific mutations."

backend/src/app/rpc/commands/files.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.files
   (:require

backend/src/app/rpc/commands/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.rpc.commands.ldap
   (:require
@@ -46,6 +46,11 @@
                 :code :wrong-credentials))
 
     (let [profile (login-or-register cfg info)]
+
+      (when (:is-blocked profile)
+        (ex/raise :type :restriction
+                  :code :profile-blocked))
+
       (if-let [token (:invitation-token params)]
         ;; If invitation token comes in params, this is because the
         ;; user comes from team-invitation process; in this case,

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

@@ -0,0 +1,403 @@
+;; 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.management
+  "A collection of RPC methods for manage the files, projects and team organization."
+  (:require
+   [app.common.data :as d]
+   [app.common.exceptions :as ex]
+   [app.common.pages.migrations :as pmg]
+   [app.common.spec :as us]
+   [app.common.uuid :as uuid]
+   [app.db :as db]
+   [app.rpc.commands.binfile :as binfile]
+   [app.rpc.doc :as-alias doc]
+   [app.rpc.mutations.projects :refer [create-project-role create-project]]
+   [app.rpc.queries.projects :as proj]
+   [app.rpc.queries.teams :as teams]
+   [app.util.blob :as blob]
+   [app.util.services :as sv]
+   [app.util.time :as dt]
+   [clojure.spec.alpha :as s]
+   [clojure.walk :as walk]))
+
+;; --- COMMAND: Duplicate File
+
+(declare duplicate-file)
+
+(s/def ::id ::us/uuid)
+(s/def ::profile-id ::us/uuid)
+(s/def ::project-id ::us/uuid)
+(s/def ::file-id ::us/uuid)
+(s/def ::team-id ::us/uuid)
+(s/def ::name ::us/string)
+
+(s/def ::duplicate-file
+  (s/keys :req-un [::profile-id ::file-id]
+          :opt-un [::name]))
+
+(sv/defmethod ::duplicate-file
+  "Duplicate a single file in the same team."
+  {::doc/added "1.16"}
+  [{:keys [pool] :as cfg} params]
+  (db/with-atomic [conn pool]
+    (duplicate-file conn params)))
+
+(defn- remap-id
+  [item index key]
+  (cond-> item
+    (contains? item key)
+    (assoc key (get index (get item key) (get item key)))))
+
+(defn- process-file
+  [file index]
+  (letfn [(process-form [form]
+            (cond-> form
+              ;; Relink library items
+              (and (map? form)
+                   (uuid? (:component-file form)))
+              (update :component-file #(get index % %))
+
+              (and (map? form)
+                   (uuid? (:fill-color-ref-file form)))
+              (update :fill-color-ref-file #(get index % %))
+
+              (and (map? form)
+                   (uuid? (:stroke-color-ref-file form)))
+              (update :stroke-color-ref-file #(get index % %))
+
+              (and (map? form)
+                   (uuid? (:typography-ref-file form)))
+              (update :typography-ref-file #(get index % %))
+
+              ;; Relink Image Shapes
+              (and (map? form)
+                   (map? (:metadata form))
+                   (= :image (:type form)))
+              (update-in [:metadata :id] #(get index % %))))
+
+          ;; A function responsible to analyze all file data and
+          ;; replace the old :component-file reference with the new
+          ;; ones, using the provided file-index
+          (relink-shapes [data]
+            (walk/postwalk process-form data))
+
+          ;; A function responsible of process the :media attr of file
+          ;; data and remap the old ids with the new ones.
+          (relink-media [media]
+            (reduce-kv (fn [res k v]
+                         (let [id (get index k)]
+                           (if (uuid? id)
+                             (-> res
+                                 (assoc id (assoc v :id id))
+                                 (dissoc k))
+                             res)))
+                       media
+                       media))]
+
+    (update file :data
+            (fn [data]
+              (-> data
+                  (blob/decode)
+                  (assoc :id (:id file))
+                  (pmg/migrate-data)
+                  (update :pages-index relink-shapes)
+                  (update :components relink-shapes)
+                  (update :media relink-media)
+                  (d/without-nils)
+                  (blob/encode))))))
+
+(def sql:retrieve-used-libraries
+  "select flr.*
+     from file_library_rel as flr
+    inner join file as l on (flr.library_file_id = l.id)
+    where flr.file_id = ?
+      and l.deleted_at is null")
+
+(def sql:retrieve-used-media-objects
+  "select fmo.*
+     from file_media_object as fmo
+    inner join storage_object as so on (fmo.media_id = so.id)
+    where fmo.file_id = ?
+      and so.deleted_at is null")
+
+(defn duplicate-file*
+  [conn {:keys [profile-id file index project-id name flibs fmeds]} {:keys [reset-shared-flag] :as opts}]
+  (let [flibs    (or flibs (db/exec! conn [sql:retrieve-used-libraries (:id file)]))
+        fmeds    (or fmeds (db/exec! conn [sql:retrieve-used-media-objects (:id file)]))
+
+        ;; memo uniform creation/modification date
+        now      (dt/now)
+        ignore   (dt/plus now (dt/duration {:seconds 5}))
+
+        ;; add to the index all file media objects.
+        index    (reduce #(assoc %1 (:id %2) (uuid/next)) index fmeds)
+
+        flibs-xf (comp
+                  (map #(remap-id % index :file-id))
+                  (map #(remap-id % index :library-file-id))
+                  (map #(assoc % :synced-at now))
+                  (map #(assoc % :created-at now)))
+
+        ;; remap all file-library-rel row
+        flibs    (sequence flibs-xf flibs)
+
+        fmeds-xf (comp
+                  (map #(assoc % :id (get index (:id %))))
+                  (map #(assoc % :created-at now))
+                  (map #(remap-id % index :file-id)))
+
+        ;; remap all file-media-object rows
+        fmeds   (sequence fmeds-xf fmeds)
+
+        file    (cond-> file
+                  (some? project-id)
+                  (assoc :project-id project-id)
+
+                  (some? name)
+                  (assoc :name name)
+
+                  (true? reset-shared-flag)
+                  (assoc :is-shared false))
+
+        file    (-> file
+                    (assoc :created-at now)
+                    (assoc :modified-at now)
+                    (assoc :ignore-sync-until ignore)
+                    (update :id #(get index %))
+                    (process-file index))]
+
+    (db/insert! conn :file file)
+    (db/insert! conn :file-profile-rel
+                {:file-id (:id file)
+                 :profile-id profile-id
+                 :is-owner true
+                 :is-admin true
+                 :can-edit true})
+
+    (doseq [params flibs]
+      (db/insert! conn :file-library-rel params))
+
+    (doseq [params fmeds]
+      (db/insert! conn :file-media-object params))
+
+    file))
+
+(defn duplicate-file
+  [conn {:keys [profile-id file-id] :as params}]
+  (let [file   (db/get-by-id conn :file file-id)
+        index  {file-id (uuid/next)}
+        params (assoc params :index index :file file)]
+    (proj/check-edition-permissions! conn profile-id (:project-id file))
+    (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
+    (-> (duplicate-file* conn params {:reset-shared-flag true})
+        (update :data blob/decode))))
+
+;; --- COMMAND: Duplicate Project
+
+(declare duplicate-project)
+
+(s/def ::duplicate-project
+  (s/keys :req-un [::profile-id ::project-id]
+          :opt-un [::name]))
+
+(sv/defmethod ::duplicate-project
+  "Duplicate an entire project with all the files"
+  {::doc/added "1.16"}
+  [{:keys [pool] :as cfg} params]
+  (db/with-atomic [conn pool]
+    (duplicate-project conn params)))
+
+(defn duplicate-project
+  [conn {:keys [profile-id project-id name] :as params}]
+
+  ;; Defer all constraints
+  (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
+
+  (let [project (db/get-by-id conn :project project-id)
+
+        files   (db/query conn :file
+                          {:project-id (:id project)
+                           :deleted-at nil}
+                          {:columns [:id]})
+
+        project (cond-> project
+                  (string? name)
+                  (assoc :name name)
+
+                  :always
+                  (assoc :id (uuid/next)))]
+
+    ;; Check if the source team-id allow creating new project for current user
+    (teams/check-edition-permissions! conn profile-id (:team-id project))
+
+    ;; create the duplicated project and assign the current profile as
+    ;; a project owner
+    (create-project conn project)
+    (create-project-role conn {:project-id (:id project)
+                               :profile-id profile-id
+                               :role :owner})
+
+    ;; duplicate all files
+    (let [index  (reduce #(assoc %1 (:id %2) (uuid/next)) {} files)
+          params (-> params
+                     (dissoc :name)
+                     (assoc :project-id (:id project))
+                     (assoc :index index))]
+      (doseq [{:keys [id]} files]
+        (let [file   (db/get-by-id conn :file id)
+              params (assoc params :file file)
+              opts   {:reset-shared-flag false}]
+          (duplicate-file* conn params opts))))
+
+    ;; return the created project
+    project))
+
+;; --- COMMAND: Move file
+
+(def sql:retrieve-files
+  "select id, project_id from file where id = ANY(?)")
+
+(def sql:move-files
+  "update file set project_id = ? where id = ANY(?)")
+
+(def sql:delete-broken-relations
+  "with broken as (
+     (select * from file_library_rel as flr
+       inner join file as f on (flr.file_id = f.id)
+       inner join project as p on (f.project_id = p.id)
+       inner join file as lf on (flr.library_file_id = lf.id)
+       inner join project as lp on (lf.project_id = lp.id)
+       where p.id = ANY(?)
+         and lp.team_id != p.team_id)
+   )
+   delete from file_library_rel as rel
+    using broken as br
+    where rel.file_id = br.file_id
+      and rel.library_file_id = br.library_file_id")
+
+(defn move-files
+  [conn {:keys [profile-id ids project-id] :as params}]
+
+  (let [fids    (db/create-array conn "uuid" ids)
+        files   (db/exec! conn [sql:retrieve-files fids])
+        source  (into #{} (map :project-id) files)
+        pids    (->> (conj source project-id)
+                     (db/create-array conn "uuid"))]
+
+    ;; Check if we have permissions on the destination project
+    (proj/check-edition-permissions! conn profile-id project-id)
+
+    ;; Check if we have permissions on all source projects
+    (doseq [project-id source]
+      (proj/check-edition-permissions! conn profile-id project-id))
+
+    (when (contains? source project-id)
+      (ex/raise :type :validation
+                :code :cant-move-to-same-project
+                :hint "Unable to move a file to the same project"))
+
+    ;; move all files to the project
+    (db/exec-one! conn [sql:move-files project-id fids])
+
+    ;; delete possible broken relations on moved files
+    (db/exec-one! conn [sql:delete-broken-relations pids])
+
+    nil))
+
+(s/def ::ids (s/every ::us/uuid :kind set?))
+(s/def ::move-files
+  (s/keys :req-un [::profile-id ::ids ::project-id]))
+
+(sv/defmethod ::move-files
+  "Move a set of files from one project to other."
+  {::doc/added "1.16"}
+  [{:keys [pool] :as cfg} params]
+  (db/with-atomic [conn pool]
+    (move-files conn params)))
+
+
+;; --- COMMAND: Move project
+
+(defn move-project
+  [conn {:keys [profile-id team-id project-id] :as params}]
+  (let [project (db/get-by-id conn :project project-id {:columns [:id :team-id]})
+        pids    (->> (db/query conn :project {:team-id (:team-id project)} {:columns [:id]})
+                     (map :id)
+                     (db/create-array conn "uuid"))]
+
+    (teams/check-edition-permissions! conn profile-id (:team-id project))
+    (teams/check-edition-permissions! conn profile-id team-id)
+
+    (when (= team-id (:team-id project))
+      (ex/raise :type :validation
+                :code :cant-move-to-same-team
+                :hint "Unable to move a project to same team"))
+
+    ;; move project to the destination team
+    (db/update! conn :project
+                {:team-id team-id}
+                {:id project-id})
+
+    ;; delete possible broken relations on moved files
+    (db/exec-one! conn [sql:delete-broken-relations pids])
+
+    nil))
+
+
+(s/def ::move-project
+  (s/keys :req-un [::profile-id ::team-id ::project-id]))
+
+(sv/defmethod ::move-project
+  "Move projects between teams."
+  {::doc/added "1.16"}
+  [{:keys [pool] :as cfg} params]
+  (db/with-atomic [conn pool]
+    (move-project conn params)))
+
+;; --- COMMAND: Clone Template
+
+(declare clone-template)
+
+(s/def ::template-id ::us/not-empty-string)
+(s/def ::clone-template
+  (s/keys :req-un [::profile-id ::project-id ::template-id]))
+
+(sv/defmethod ::clone-template
+  "Clone into the specified project the template by its id."
+  {::doc/added "1.16"}
+  [{:keys [pool] :as cfg} params]
+  (db/with-atomic [conn pool]
+    (-> (assoc cfg :conn conn)
+        (clone-template params))))
+
+(defn- clone-template
+  [{:keys [conn templates] :as cfg} {:keys [profile-id template-id project-id]}]
+  (let [template (d/seek #(= (:id %) template-id) templates)
+        project  (db/get-by-id conn :project project-id {:columns [:id :team-id]})]
+
+    (teams/check-edition-permissions! conn profile-id (:team-id project))
+
+    (when-not template
+      (ex/raise :type :not-found
+                :code :template-not-found
+                :hint "template not found"))
+
+    (-> cfg
+        (assoc ::binfile/input (:path template))
+        (assoc ::binfile/project-id (:id project))
+        (assoc ::binfile/ignore-index-errors? true)
+        (assoc ::binfile/migrate? true)
+        (binfile/import!))))
+
+
+;; --- COMMAND: Retrieve list of builtin templates
+
+(s/def ::retrieve-list-of-builtin-templates any?)
+
+(sv/defmethod ::retrieve-list-of-builtin-templates
+  [cfg _params]
+  (mapv #(select-keys % [:id :name :thumbnail-uri]) (:templates cfg)))

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

@@ -0,0 +1,193 @@
+;; 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.verify-token
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.db :as db]
+   [app.loggers.audit :as audit]
+   [app.rpc.doc :as-alias doc]
+   [app.rpc.mutations.teams :as teams]
+   [app.rpc.queries.profile :as profile]
+   [app.tokens :as tokens]
+   [app.tokens.spec.team-invitation :as-alias spec.team-invitation]
+   [app.util.services :as sv]
+   [clojure.spec.alpha :as s]))
+
+(s/def ::iss keyword?)
+(s/def ::exp ::us/inst)
+
+(defmulti process-token (fn [_ _ claims] (:iss claims)))
+
+(s/def ::verify-token
+  (s/keys :req-un [::token]
+          :opt-un [::profile-id]))
+
+(sv/defmethod ::verify-token
+  {:auth false
+   ::doc/added "1.15"}
+  [{:keys [pool sprops] :as cfg} {:keys [token] :as params}]
+  (db/with-atomic [conn pool]
+    (let [claims (tokens/verify sprops {:token token})
+          cfg    (assoc cfg :conn conn)]
+      (process-token cfg params claims))))
+
+(defmethod process-token :change-email
+  [{:keys [conn] :as cfg} _params {:keys [profile-id email] :as claims}]
+  (when (profile/retrieve-profile-data-by-email conn email)
+    (ex/raise :type :validation
+              :code :email-already-exists))
+
+  (db/update! conn :profile
+              {:email email}
+              {:id profile-id})
+
+  (with-meta claims
+    {::audit/name "update-profile-email"
+     ::audit/props {:email email}
+     ::audit/profile-id profile-id}))
+
+(defmethod process-token :verify-email
+  [{:keys [conn session] :as cfg} _ {:keys [profile-id] :as claims}]
+  (let [profile (profile/retrieve-profile conn profile-id)
+        claims  (assoc claims :profile profile)]
+
+    (when-not (:is-active profile)
+      (when (not= (:email profile)
+                  (:email claims))
+        (ex/raise :type :validation
+                  :code :invalid-token))
+
+      (db/update! conn :profile
+                  {:is-active true}
+                  {:id (:id profile)}))
+
+    (with-meta claims
+      {:transform-response ((:create session) profile-id)
+       ::audit/name "verify-profile-email"
+       ::audit/props (audit/profile->props profile)
+       ::audit/profile-id (:id profile)})))
+
+(defmethod process-token :auth
+  [{:keys [conn] :as cfg} _params {:keys [profile-id] :as claims}]
+  (let [profile (profile/retrieve-profile conn profile-id)]
+    (assoc claims :profile profile)))
+
+;; --- Team Invitation
+
+(defn- accept-invitation
+  [{:keys [conn] :as cfg} {:keys [team-id role member-email] :as claims} invitation member]
+  (let [;; Update the role if there is an invitation
+        role   (or (some-> invitation :role keyword) role)
+        params (merge
+                {:team-id team-id
+                 :profile-id (:id member)}
+                (teams/role->params role))]
+
+    ;; Do not allow blocked users accept invitations.
+    (when (:is-blocked member)
+      (ex/raise :type :restriction
+                :code :profile-blocked))
+
+    ;; Insert the invited member to the team
+    (db/insert! conn :team-profile-rel params {:on-conflict-do-nothing true})
+
+    ;; If profile is not yet verified, mark it as verified because
+    ;; accepting an invitation link serves as verification.
+    (when-not (:is-active member)
+      (db/update! conn :profile
+                  {:is-active true}
+                  {:id (:id member)}))
+
+    ;; Delete the invitation
+    (db/delete! conn :team-invitation
+                {:team-id team-id :email-to member-email})
+
+    (assoc member :is-active true)))
+
+(s/def ::spec.team-invitation/profile-id ::us/uuid)
+(s/def ::spec.team-invitation/role ::us/keyword)
+(s/def ::spec.team-invitation/team-id ::us/uuid)
+(s/def ::spec.team-invitation/member-email ::us/email)
+(s/def ::spec.team-invitation/member-id (s/nilable ::us/uuid))
+
+(s/def ::team-invitation-claims
+  (s/keys :req-un [::iss ::exp
+                   ::spec.team-invitation/profile-id
+                   ::spec.team-invitation/role
+                   ::spec.team-invitation/team-id
+                   ::spec.team-invitation/member-email]
+          :opt-un [::spec.team-invitation/member-id]))
+
+(defmethod process-token :team-invitation
+  [{:keys [conn session] :as cfg} {:keys [profile-id token]}
+   {:keys [member-id team-id member-email] :as claims}]
+
+  (us/assert ::team-invitation-claims claims)
+
+  (let [invitation (db/get* conn :team-invitation
+                            {:team-id team-id :email-to member-email})
+        profile    (db/get* conn :profile
+                            {:id profile-id}
+                            {:columns [:id :email]})]
+    (when (nil? invitation)
+      (ex/raise :type :validation
+                :code :invalid-token
+                :hint "no invitation associated with the token"))
+
+    (if (some? profile)
+      (if (or (= member-id profile-id)
+              (= member-email (:email profile)))
+        ;; if we have logged-in user and it matches the invitation we
+        ;; proceed with accepting the invitation and joining the
+        ;; current profile to the invited team.
+        (let [profile (accept-invitation cfg claims invitation profile)]
+          (with-meta
+            (assoc claims :state :created)
+            {::audit/name "accept-team-invitation"
+             ::audit/props (merge
+                            (audit/profile->props profile)
+                            {:team-id (:team-id claims)
+                             :role (:role claims)})
+             ::audit/profile-id profile-id}))
+
+        (ex/raise :type :validation
+                  :code :invalid-token
+                  :hint "logged-in user does not matches the invitation"))
+
+      ;; If we have not logged-in user, we try find the invited
+      ;; profile by member-id or member-email props of the invitation
+      ;; token; If profile is found, we accept the invitation and
+      ;; leave the user logged-in.
+      (if-let [member (db/get* conn :profile
+                               (if member-id
+                                 {:id member-id}
+                                 {:email member-email})
+                               {:columns [:id :email]})]
+        (let [profile (accept-invitation cfg claims invitation member)]
+          (with-meta
+            (assoc claims :state :created)
+            {:transform-response ((:create session) (:id profile))
+             ::audit/name "accept-team-invitation"
+             ::audit/props (merge
+                            (audit/profile->props profile)
+                            {:team-id (:team-id claims)
+                             :role (:role claims)})
+             ::audit/profile-id member-id}))
+
+        {:invitation-token token
+         :iss :team-invitation
+         :redirect-to :auth-register
+         :state :pending}))))
+
+;; --- Default
+
+(defmethod process-token :default
+  [_ _ _]
+  (ex/raise :type :validation
+            :code :invalid-token))
+

backend/src/app/rpc/doc.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.doc
   "API autogenerated documentation."
@@ -61,7 +61,7 @@
   (if (contains? cf/flags :backend-api-doc)
     (let [context (prepare-context methods)]
       (fn [_ respond _]
-        (respond (yrs/response 200 (-> (io/resource "api-doc.tmpl")
+        (respond (yrs/response 200 (-> (io/resource "app/templates/api-doc.tmpl")
                                        (tmpl/render context))))))
     (fn [_ respond _]
       (respond (yrs/response 404)))))

backend/src/app/rpc/helpers.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.helpers
   "General purpose RPC helpers."

backend/src/app/rpc/mutations/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.mutations.comments
   (:require

backend/src/app/rpc/mutations/files.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.mutations.files
   (:require
@@ -11,15 +11,17 @@
    [app.common.pages :as cp]
    [app.common.pages.migrations :as pmg]
    [app.common.spec :as us]
+   [app.common.types.file :as ctf]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
    [app.loggers.audit :as audit]
    [app.metrics :as mtx]
+   [app.msgbus :as mbus]
    [app.rpc.permissions :as perms]
    [app.rpc.queries.files :as files]
    [app.rpc.queries.projects :as proj]
-   [app.rpc.rlimit :as rlimit]
+   [app.rpc.semaphore :as rsem]
    [app.storage.impl :as simpl]
    [app.util.blob :as blob]
    [app.util.services :as sv]
@@ -45,7 +47,7 @@
 (s/def ::is-shared ::us/boolean)
 (s/def ::create-file
   (s/keys :req-un [::profile-id ::name ::project-id]
-          :opt-un [::id ::is-shared]))
+          :opt-un [::id ::is-shared ::components-v2]))
 
 (sv/defmethod ::create-file
   [{:keys [pool] :as cfg} {:keys [profile-id project-id] :as params}]
@@ -65,11 +67,12 @@
 
 (defn create-file
   [conn {:keys [id name project-id is-shared data revn
-                modified-at deleted-at ignore-sync-until]
+                modified-at deleted-at ignore-sync-until
+                components-v2]
          :or {is-shared false revn 0}
          :as params}]
   (let [id   (or id (:id data) (uuid/next))
-        data (or data (cp/make-file-data id))
+        data (or data (ctf/make-file-data id components-v2))
         file (db/insert! conn :file
                          (d/without-nils
                           {:id id
@@ -110,16 +113,25 @@
 ;; --- Mutation: Set File shared
 
 (declare set-file-shared)
+(declare unlink-files)
+(declare absorb-library)
 
 (s/def ::set-file-shared
   (s/keys :req-un [::profile-id ::id ::is-shared]))
 
 (sv/defmethod ::set-file-shared
-  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [id profile-id is-shared] :as params}]
   (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id id)
+    (when-not is-shared
+      (absorb-library conn params)
+      (unlink-files conn params))
     (set-file-shared conn params)))
 
+(defn- unlink-files
+  [conn {:keys [id] :as params}]
+  (db/delete! conn :file-library-rel {:library-file-id id}))
+
 (defn- set-file-shared
   [conn {:keys [id is-shared] :as params}]
   (db/update! conn :file
@@ -137,6 +149,7 @@
   [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
   (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id id)
+    (absorb-library conn params)
     (mark-file-deleted conn params)))
 
 (defn mark-file-deleted
@@ -146,6 +159,25 @@
               {:id id})
   nil)
 
+(defn absorb-library
+  "Find all files using a shared library, and absorb all library assets
+  into the file local libraries"
+  [conn {:keys [id] :as params}]
+  (let [library (db/get-by-id conn :file id)]
+    (when (:is-shared library)
+      (let [ldata (-> library files/decode-row pmg/migrate-file :data)]
+        (->> (db/query conn :file-library-rel {:library-file-id id})
+             (keep (fn [{:keys [file-id]}]
+                    (some->> (db/get-by-id conn :file file-id {:check-not-found false})
+                             (files/decode-row)
+                             (pmg/migrate-file))))
+             (run! (fn [{:keys [id data revn] :as file}]
+                     (let [data (ctf/absorb-assets data ldata)]
+                       (db/update! conn :file
+                                   {:revn (inc revn)
+                                    :data (blob/encode data)
+                                    :modified-at (dt/now)}
+                                   {:id id})))))))))
 
 ;; --- Mutation: Link file to library
 
@@ -273,16 +305,17 @@
 
 (s/def ::session-id ::us/uuid)
 (s/def ::revn ::us/integer)
+(s/def ::components-v2 ::us/boolean)
 (s/def ::update-file
   (s/and
    (s/keys :req-un [::id ::session-id ::profile-id ::revn]
-           :opt-un [::changes ::changes-with-metadata])
+           :opt-un [::changes ::changes-with-metadata ::components-v2])
    (fn [o]
      (or (contains? o :changes)
          (contains? o :changes-with-metadata)))))
 
 (sv/defmethod ::update-file
-  {::rlimit/permits (cf/get :rlimit-file-update)}
+  {::rsem/queue :update-file}
   [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
   (db/with-atomic [conn pool]
     (db/xact-lock! conn id)
@@ -313,7 +346,8 @@
       (simpl/del-object backend file))))
 
 (defn- update-file
-  [{:keys [conn metrics] :as cfg} {:keys [file changes changes-with-metadata session-id profile-id] :as params}]
+  [{:keys [conn metrics] :as cfg}
+   {:keys [file changes changes-with-metadata session-id profile-id components-v2] :as params}]
   (when (> (:revn params)
            (:revn file))
 
@@ -338,12 +372,18 @@
                     (update :data (fn [data]
                                     ;; Trace the length of bytes of processed data
                                     (mtx/run! metrics {:id :update-file-bytes-processed :inc (alength data)})
-                                    (-> data
-                                        (blob/decode)
-                                        (assoc :id (:id file))
-                                        (pmg/migrate-data)
-                                        (cp/process-changes changes)
-                                        (blob/encode)))))]
+                                    (cond-> data
+                                      :always
+                                      (-> (blob/decode)
+                                          (assoc :id (:id file))
+                                          (pmg/migrate-data))
+
+                                      components-v2
+                                      (ctf/migrate-to-components-v2)
+
+                                      :always
+                                      (-> (cp/process-changes changes)
+                                          (blob/encode))))))]
     ;; Insert change to the xlog
     (db/insert! conn :file-change
                 {:id (uuid/next)
@@ -400,12 +440,12 @@
 
 (defn- send-notifications
   [{:keys [conn] :as cfg} {:keys [file changes session-id] :as params}]
-  (let [lchanges  (filter library-change? changes)
-        msgbus-fn (:msgbus cfg)]
+  (let [lchanges (filter library-change? changes)
+        msgbus   (:msgbus cfg)]
 
 
     ;; Asynchronously publish message to the msgbus
-    (msgbus-fn :cmd :pub
+    (mbus/pub! msgbus
                :topic (:id file)
                :message {:type :file-change
                          :profile-id (:profile-id params)
@@ -417,7 +457,7 @@
     (when (and (:is-shared file) (seq lchanges))
       (let [team-id (retrieve-team-id conn (:project-id file))]
         ;; Asynchronously publish message to the msgbus
-        (msgbus-fn :cmd :pub
+        (mbus/pub! msgbus
                    :topic team-id
                    :message {:type :library-change
                              :profile-id (:profile-id params)
@@ -525,6 +565,8 @@
   (s/keys :req-un [::profile-id ::file-id ::revn ::data ::props]))
 
 (sv/defmethod ::upsert-file-thumbnail
+  "Creates or updates the file thumbnail. Mainly used for paint the
+  grid thumbnals."
   [{:keys [pool] :as cfg} {:keys [profile-id file-id revn data props]}]
   (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id file-id)

backend/src/app/rpc/mutations/fonts.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.mutations.fonts
   (:require
@@ -10,18 +10,16 @@
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
-   [app.config :as cf]
    [app.db :as db]
    [app.media :as media]
    [app.rpc.doc :as-alias doc]
    [app.rpc.queries.teams :as teams]
-   [app.rpc.rlimit :as rlimit]
+   [app.rpc.semaphore :as rsem]
    [app.storage :as sto]
    [app.util.services :as sv]
    [app.util.time :as dt]
    [clojure.spec.alpha :as s]
-   [promesa.core :as p]
-   [promesa.exec :as px]))
+   [promesa.core :as p]))
 
 (declare create-font-variant)
 
@@ -42,24 +40,21 @@
                    ::font-id ::font-family ::font-weight ::font-style]))
 
 (sv/defmethod ::create-font-variant
-  {::rlimit/permits (cf/get :rlimit-font)}
   [{:keys [pool] :as cfg} {:keys [team-id profile-id] :as params}]
   (let [cfg (update cfg :storage media/configure-assets-storage)]
     (teams/check-edition-permissions! pool profile-id team-id)
     (create-font-variant cfg params)))
 
 (defn create-font-variant
-  [{:keys [storage pool executors] :as cfg} {:keys [data] :as params}]
+  [{:keys [storage pool executor semaphores] :as cfg} {:keys [data] :as params}]
   (letfn [(generate-fonts [data]
-            (px/with-dispatch (:blocking executors)
+            (rsem/with-dispatch (:process-font semaphores)
               (media/run {:cmd :generate-fonts :input data})))
 
           ;; Function responsible of calculating cryptographyc hash of
-          ;; the provided data. Even though it uses the hight
-          ;; performance BLAKE2b algorithm, we prefer to schedule it
-          ;; to be executed on the blocking executor.
+          ;; the provided data.
           (calculate-hash [data]
-            (px/with-dispatch (:blocking executors)
+            (rsem/with-dispatch (:process-font semaphores)
               (sto/calculate-hash data)))
 
           (validate-data [data]
@@ -110,8 +105,8 @@
 
     (-> (generate-fonts data)
         (p/then validate-data)
-        (p/then persist-fonts (:default executors))
-        (p/then insert-into-db (:default executors)))))
+        (p/then persist-fonts executor)
+        (p/then insert-into-db executor))))
 
 ;; --- UPDATE FONT FAMILY
 

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

@@ -2,334 +2,57 @@
 ;; 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.mutations.management
   "Move & Duplicate RPC methods for files and projects."
   (:require
-   [app.common.data :as d]
-   [app.common.exceptions :as ex]
-   [app.common.pages.migrations :as pmg]
-   [app.common.spec :as us]
-   [app.common.uuid :as uuid]
    [app.db :as db]
-   [app.rpc.mutations.projects :refer [create-project-role create-project]]
-   [app.rpc.queries.projects :as proj]
-   [app.rpc.queries.teams :as teams]
-   [app.util.blob :as blob]
+   [app.rpc.commands.management :as cmd.mgm]
+   [app.rpc.doc :as-alias doc]
    [app.util.services :as sv]
-   [app.util.time :as dt]
-   [clojure.spec.alpha :as s]
-   [clojure.walk :as walk]))
-
-(s/def ::id ::us/uuid)
-(s/def ::profile-id ::us/uuid)
-(s/def ::project-id ::us/uuid)
-(s/def ::file-id ::us/uuid)
-(s/def ::team-id ::us/uuid)
-(s/def ::name ::us/string)
-
-(defn- remap-id
-  [item index key]
-  (cond-> item
-    (contains? item key)
-    (assoc key (get index (get item key) (get item key)))))
-
-(defn- process-file
-  [file index]
-  (letfn [(process-form [form]
-            (cond-> form
-              ;; Relink library items
-              (and (map? form)
-                   (uuid? (:component-file form)))
-              (update :component-file #(get index % %))
-
-              (and (map? form)
-                   (uuid? (:fill-color-ref-file form)))
-              (update :fill-color-ref-file #(get index % %))
-
-              (and (map? form)
-                   (uuid? (:stroke-color-ref-file form)))
-              (update :stroke-color-ref-file #(get index % %))
-
-              (and (map? form)
-                   (uuid? (:typography-ref-file form)))
-              (update :typography-ref-file #(get index % %))
-
-              ;; Relink Image Shapes
-              (and (map? form)
-                   (map? (:metadata form))
-                   (= :image (:type form)))
-              (update-in [:metadata :id] #(get index % %))))
-
-          ;; A function responsible to analyze all file data and
-          ;; replace the old :component-file reference with the new
-          ;; ones, using the provided file-index
-          (relink-shapes [data]
-            (walk/postwalk process-form data))
-
-          ;; A function responsible of process the :media attr of file
-          ;; data and remap the old ids with the new ones.
-          (relink-media [media]
-            (reduce-kv (fn [res k v]
-                         (let [id (get index k)]
-                           (if (uuid? id)
-                             (-> res
-                                 (assoc id (assoc v :id id))
-                                 (dissoc k))
-                             res)))
-                       media
-                       media))]
-
-    (update file :data
-            (fn [data]
-              (-> data
-                  (blob/decode)
-                  (assoc :id (:id file))
-                  (pmg/migrate-data)
-                  (update :pages-index relink-shapes)
-                  (update :components relink-shapes)
-                  (update :media relink-media)
-                  (d/without-nils)
-                  (blob/encode))))))
-
-(def sql:retrieve-used-libraries
-  "select flr.*
-     from file_library_rel as flr
-    inner join file as l on (flr.library_file_id = l.id)
-    where flr.file_id = ?
-      and l.deleted_at is null")
-
-(def sql:retrieve-used-media-objects
-  "select fmo.*
-     from file_media_object as fmo
-    inner join storage_object as so on (fmo.media_id = so.id)
-    where fmo.file_id = ?
-      and so.deleted_at is null")
-
-(defn duplicate-file
-  [conn {:keys [profile-id file index project-id name flibs fmeds]} {:keys [reset-shared-flag] :as opts}]
-  (let [flibs    (or flibs (db/exec! conn [sql:retrieve-used-libraries (:id file)]))
-        fmeds    (or fmeds (db/exec! conn [sql:retrieve-used-media-objects (:id file)]))
-
-        ;; memo uniform creation/modification date
-        now      (dt/now)
-        ignore   (dt/plus now (dt/duration {:seconds 5}))
-
-        ;; add to the index all file media objects.
-        index    (reduce #(assoc %1 (:id %2) (uuid/next)) index fmeds)
-
-        flibs-xf (comp
-                  (map #(remap-id % index :file-id))
-                  (map #(remap-id % index :library-file-id))
-                  (map #(assoc % :synced-at now))
-                  (map #(assoc % :created-at now)))
-
-        ;; remap all file-library-rel row
-        flibs    (sequence flibs-xf flibs)
-
-        fmeds-xf (comp
-                  (map #(assoc % :id (get index (:id %))))
-                  (map #(assoc % :created-at now))
-                  (map #(remap-id % index :file-id)))
-
-        ;; remap all file-media-object rows
-        fmeds   (sequence fmeds-xf fmeds)
-
-        file    (cond-> file
-                  (some? project-id)
-                  (assoc :project-id project-id)
-
-                  (some? name)
-                  (assoc :name name)
-
-                  (true? reset-shared-flag)
-                  (assoc :is-shared false))
-
-        file    (-> file
-                    (assoc :created-at now)
-                    (assoc :modified-at now)
-                    (assoc :ignore-sync-until ignore)
-                    (update :id #(get index %))
-                    (process-file index))]
-
-    (db/insert! conn :file file)
-    (db/insert! conn :file-profile-rel
-                {:file-id (:id file)
-                 :profile-id profile-id
-                 :is-owner true
-                 :is-admin true
-                 :can-edit true})
-
-    (doseq [params flibs]
-      (db/insert! conn :file-library-rel params))
-
-    (doseq [params fmeds]
-      (db/insert! conn :file-media-object params))
-
-    file))
-
+   [clojure.spec.alpha :as s]))
 
 ;; --- MUTATION: Duplicate File
 
-(declare duplicate-file)
-
-(s/def ::duplicate-file
-  (s/keys :req-un [::profile-id ::file-id]
-          :opt-un [::name]))
+(s/def ::duplicate-file ::cmd.mgm/duplicate-file)
 
 (sv/defmethod ::duplicate-file
-  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
+  {::doc/added "1.2"
+   ::doc/deprecated "1.16"}
+  [{:keys [pool] :as cfg} params]
   (db/with-atomic [conn pool]
-    (let [file   (db/get-by-id conn :file file-id)
-          index  {file-id (uuid/next)}
-          params (assoc params :index index :file file)]
-      (proj/check-edition-permissions! conn profile-id (:project-id file))
-      (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
-      (-> (duplicate-file conn params {:reset-shared-flag true})
-          (update :data blob/decode)))))
-
+    (cmd.mgm/duplicate-file conn params)))
 
 ;; --- MUTATION: Duplicate Project
 
-(declare duplicate-project)
-
-(s/def ::duplicate-project
-  (s/keys :req-un [::profile-id ::project-id]
-          :opt-un [::name]))
+(s/def ::duplicate-project ::cmd.mgm/duplicate-project)
 
 (sv/defmethod ::duplicate-project
-  [{:keys [pool] :as cfg} {:keys [profile-id project-id] :as params}]
+  {::doc/added "1.2"
+   ::doc/deprecated "1.16"}
+  [{:keys [pool] :as cfg} params]
   (db/with-atomic [conn pool]
-    (let [project (db/get-by-id conn :project project-id)]
-      (teams/check-edition-permissions! conn profile-id (:team-id project))
-      (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
-      (duplicate-project conn (assoc params :project project)))))
-
-(defn duplicate-project
-  [conn {:keys [profile-id project name] :as params}]
-  (let [files   (db/query conn :file
-                          {:project-id (:id project)
-                           :deleted-at nil}
-                          {:columns [:id]})
-
-        project (cond-> project
-                  (string? name)
-                  (assoc :name name)
-
-                  :always
-                  (assoc :id (uuid/next)))]
-
-    ;; create the duplicated project and assign the current profile as
-    ;; a project owner
-    (create-project conn project)
-    (create-project-role conn {:project-id (:id project)
-                               :profile-id profile-id
-                               :role :owner})
-
-    ;; duplicate all files
-    (let [index  (reduce #(assoc %1 (:id %2) (uuid/next)) {} files)
-          params (-> params
-                     (dissoc :name)
-                     (assoc :project-id (:id project))
-                     (assoc :index index))]
-      (doseq [{:keys [id]} files]
-        (let [file   (db/get-by-id conn :file id)
-              params (assoc params :file file)
-              opts   {:reset-shared-flag false}]
-          (duplicate-file conn params opts))))
-
-    ;; return the created project
-    project))
-
+    (cmd.mgm/duplicate-project conn params)))
 
 ;; --- MUTATION: Move file
 
-(def sql:retrieve-files
-  "select id, project_id from file where id = ANY(?)")
-
-(def sql:move-files
-  "update file set project_id = ? where id = ANY(?)")
-
-(def sql:delete-broken-relations
-  "with broken as (
-     (select * from file_library_rel as flr
-       inner join file as f on (flr.file_id = f.id)
-       inner join project as p on (f.project_id = p.id)
-       inner join file as lf on (flr.library_file_id = lf.id)
-       inner join project as lp on (lf.project_id = lp.id)
-       where p.id = ANY(?)
-         and lp.team_id != p.team_id)
-   )
-   delete from file_library_rel as rel
-    using broken as br
-    where rel.file_id = br.file_id
-      and rel.library_file_id = br.library_file_id")
-
-(s/def ::ids (s/every ::us/uuid :kind set?))
-(s/def ::move-files
-  (s/keys :req-un [::profile-id ::ids ::project-id]))
+(s/def ::move-files ::cmd.mgm/move-files)
 
 (sv/defmethod ::move-files
-  [{:keys [pool] :as cfg} {:keys [profile-id ids project-id] :as params}]
+  {::doc/added "1.2"
+   ::doc/deprecated "1.16"}
+  [{:keys [pool] :as cfg} params]
   (db/with-atomic [conn pool]
-    (let [fids    (db/create-array conn "uuid" ids)
-          files   (db/exec! conn [sql:retrieve-files fids])
-          source  (into #{} (map :project-id) files)
-          pids    (->> (conj source project-id)
-                       (db/create-array conn "uuid"))]
-
-      ;; Check if we have permissions on the destination project
-      (proj/check-edition-permissions! conn profile-id project-id)
-
-      ;; Check if we have permissions on all source projects
-      (doseq [project-id source]
-        (proj/check-edition-permissions! conn profile-id project-id))
-
-      (when (contains? source project-id)
-        (ex/raise :type :validation
-                  :code :cant-move-to-same-project
-                  :hint "Unable to move a file to the same project"))
-
-      ;; move all files to the project
-      (db/exec-one! conn [sql:move-files project-id fids])
-
-      ;; delete possible broken relations on moved files
-      (db/exec-one! conn [sql:delete-broken-relations pids])
-
-      nil)))
-
+    (cmd.mgm/move-files conn params)))
 
 ;; --- MUTATION: Move project
 
-(declare move-project)
-
-(s/def ::move-project
-  (s/keys :req-un [::profile-id ::team-id ::project-id]))
+(s/def ::move-project ::cmd.mgm/move-project)
 
 (sv/defmethod ::move-project
-  [{:keys [pool] :as cfg} {:keys [profile-id team-id project-id] :as params}]
+  {::doc/added "1.2"
+   ::doc/deprecated "1.16"}
+  [{:keys [pool] :as cfg} params]
   (db/with-atomic [conn pool]
-    (let [project (db/get-by-id conn :project project-id {:columns [:id :team-id]})
-
-          pids    (->> (db/query conn :project {:team-id (:team-id project)} {:columns [:id]})
-                       (map :id)
-                       (db/create-array conn "uuid"))]
-
-      (teams/check-edition-permissions! conn profile-id (:team-id project))
-      (teams/check-edition-permissions! conn profile-id team-id)
-
-      (when (= team-id (:team-id project))
-        (ex/raise :type :validation
-                  :code :cant-move-to-same-team
-                  :hint "Unable to move a project to same team"))
-
-      ;; move project to the destination team
-      (db/update! conn :project
-                  {:team-id team-id}
-                  {:id project-id})
-
-      ;; delete possible broken relations on moved files
-      (db/exec-one! conn [sql:delete-broken-relations pids])
-
-      nil)))
+    (cmd.mgm/move-project conn params)))

backend/src/app/rpc/mutations/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.rpc.mutations.media
   (:require
@@ -15,16 +15,15 @@
    [app.db :as db]
    [app.media :as media]
    [app.rpc.queries.teams :as teams]
-   [app.rpc.rlimit :as rlimit]
+   [app.rpc.semaphore :as rsem]
    [app.storage :as sto]
    [app.storage.tmp :as tmp]
-   [app.util.bytes :as bs]
    [app.util.services :as sv]
    [app.util.time :as dt]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
-   [promesa.core :as p]
-   [promesa.exec :as px]))
+   [datoteka.io :as io]
+   [promesa.core :as p]))
 
 (def default-max-file-size (* 1024 1024 10)) ; 10 MiB
 
@@ -53,7 +52,6 @@
           :opt-un [::id]))
 
 (sv/defmethod ::upload-file-media-object
-  {::rlimit/permits (cf/get :rlimit-image)}
   [{:keys [pool] :as cfg} {:keys [profile-id file-id content] :as params}]
   (let [file (select-file pool file-id)
         cfg  (update cfg :storage media/configure-assets-storage)]
@@ -106,26 +104,25 @@
 ;; inverse, soft referential integrity).
 
 (defn create-file-media-object
-  [{:keys [storage pool executors] :as cfg} {:keys [id file-id is-local name content] :as params}]
+  [{:keys [storage pool semaphores] :as cfg}
+   {:keys [id file-id is-local name content] :as params}]
   (letfn [;; Function responsible to retrieve the file information, as
           ;; it is synchronous operation it should be wrapped into
           ;; with-dispatch macro.
           (get-info [content]
-            (px/with-dispatch (:blocking executors)
+            (rsem/with-dispatch (:process-image semaphores)
               (media/run {:cmd :info :input content})))
 
           ;; Function responsible of calculating cryptographyc hash of
-          ;; the provided data. Even though it uses the hight
-          ;; performance BLAKE2b algorithm, we prefer to schedule it
-          ;; to be executed on the blocking executor.
+          ;; the provided data.
           (calculate-hash [data]
-            (px/with-dispatch (:blocking executors)
+            (rsem/with-dispatch (:process-image semaphores)
               (sto/calculate-hash data)))
 
           ;; Function responsible of generating thumnail. As it is synchronous
           ;; opetation, it should be wrapped into with-dispatch macro
           (generate-thumbnail [info]
-            (px/with-dispatch (:blocking executors)
+            (rsem/with-dispatch (:process-image semaphores)
               (media/run (assoc thumbnail-options
                                 :cmd :generic-thumbnail
                                 :input info))))
@@ -157,15 +154,14 @@
                                 :bucket "file-media-object"})))
 
           (insert-into-database [info image thumb]
-            (px/with-dispatch (:default executors)
-              (db/exec-one! pool [sql:create-file-media-object
-                                  (or id (uuid/next))
-                                  file-id is-local name
-                                  (:id image)
-                                  (:id thumb)
-                                  (:width info)
-                                  (:height info)
-                                  (:mtype info)])))]
+            (db/exec-one! pool [sql:create-file-media-object
+                                (or id (uuid/next))
+                                file-id is-local name
+                                (:id image)
+                                (:id thumb)
+                                (:width info)
+                                (:height info)
+                                (:mtype info)]))]
 
     (p/let [info  (get-info content)
             thumb (create-thumbnail info)
@@ -181,7 +177,6 @@
           :opt-un [::id ::name]))
 
 (sv/defmethod ::create-file-media-object-from-url
-  {::rlimit/permits (cf/get :rlimit-image)}
   [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (let [file (select-file pool file-id)
         cfg  (update cfg :storage media/configure-assets-storage)]
@@ -224,7 +219,7 @@
           (process-response [{:keys [body headers] :as response}]
             (let [{:keys [size mtype]} (parse-and-validate-size headers)
                   path                 (tmp/tempfile :prefix "penpot.media.download.")
-                  written              (bs/write-to-file! body path :size size)]
+                  written              (io/write-to-file! body path :size size)]
 
               (when (not= written size)
                 (ex/raise :type :internal

backend/src/app/rpc/mutations/profile.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.mutations.profile
   (:require
@@ -15,10 +15,12 @@
    [app.loggers.audit :as audit]
    [app.media :as media]
    [app.rpc.commands.auth :as cmd.auth]
+   [app.rpc.doc :as-alias doc]
    [app.rpc.mutations.teams :as teams]
    [app.rpc.queries.profile :as profile]
-   [app.rpc.rlimit :as rlimit]
+   [app.rpc.semaphore :as rsem]
    [app.storage :as sto]
+   [app.tokens :as tokens]
    [app.util.services :as sv]
    [app.util.time :as dt]
    [clojure.spec.alpha :as s]
@@ -39,13 +41,12 @@
 
 ;; --- MUTATION: Update Profile (own)
 
-(s/def ::newsletter-subscribed ::us/boolean)
 (s/def ::update-profile
   (s/keys :req-un [::fullname ::profile-id]
-          :opt-un [::lang ::theme ::newsletter-subscribed]))
+          :opt-un [::lang ::theme]))
 
 (sv/defmethod ::update-profile
-  [{:keys [pool] :as cfg} {:keys [profile-id fullname lang theme newsletter-subscribed] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id fullname lang theme] :as params}]
   (db/with-atomic [conn pool]
     ;; NOTE: we need to retrieve the profile independently if we use
     ;; it or not for explicit locking and avoid concurrent updates of
@@ -58,13 +59,7 @@
                       (assoc :fullname fullname)
                       (assoc :lang lang)
                       (assoc :theme theme))
-
-          ;; Update profile props if the indirect prop is coming in
-          ;; the params map and update the profile props data
-          ;; acordingly.
-          profile (cond-> profile
-                    (some? newsletter-subscribed)
-                    (update :props assoc :newsletter-subscribed newsletter-subscribed))]
+          ]
 
       (db/update! conn :profile
                   {:fullname fullname
@@ -86,7 +81,7 @@
   (s/keys :req-un [::profile-id ::password ::old-password]))
 
 (sv/defmethod ::update-profile-password
-  {::rlimit/permits (cf/get :rlimit-password)}
+  {::rsem/queue :auth}
   [{:keys [pool] :as cfg} {:keys [password] :as params}]
   (db/with-atomic [conn pool]
     (let [profile    (validate-password! conn params)
@@ -129,7 +124,6 @@
   (s/keys :req-un [::profile-id ::file]))
 
 (sv/defmethod ::update-profile-photo
-  {::rlimit/permits (cf/get :rlimit-image)}
   [cfg {:keys [file] :as params}]
   ;; Validate incoming mime type
   (media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
@@ -137,8 +131,8 @@
     (update-profile-photo cfg params)))
 
 (defn update-profile-photo
-  [{:keys [pool storage executors] :as cfg} {:keys [profile-id] :as params}]
-  (p/let [profile (px/with-dispatch (:default executors)
+  [{:keys [pool storage executor] :as cfg} {:keys [profile-id] :as params}]
+  (p/let [profile (px/with-dispatch executor
                     (db/get-by-id pool :profile profile-id))
           photo   (teams/upload-photo cfg params)]
 
@@ -168,8 +162,7 @@
           params  (assoc params
                          :profile profile
                          :email (str/lower email))]
-      (if (or (cf/get :smtp-enabled)
-              (contains? cf/flags :smtp))
+      (if (contains? cf/flags :smtp)
         (request-email-change cfg params)
         (change-email-immediately cfg params)))))
 
@@ -183,15 +176,16 @@
   {:changed true})
 
 (defn- request-email-change
-  [{:keys [conn tokens] :as cfg} {:keys [profile email] :as params}]
-  (let [token   (tokens :generate
-                        {:iss :change-email
-                         :exp (dt/in-future "15m")
-                         :profile-id (:id profile)
-                         :email email})
-        ptoken  (tokens :generate-predefined
-                        {:iss :profile-identity
-                         :profile-id (:id profile)})]
+  [{:keys [conn sprops] :as cfg} {:keys [profile email] :as params}]
+  (let [token   (tokens/generate sprops
+                                 {:iss :change-email
+                                  :exp (dt/in-future "15m")
+                                  :profile-id (:id profile)
+                                  :email email})
+        ptoken  (tokens/generate sprops
+                                 {:iss :profile-identity
+                                  :profile-id (:id profile)
+                                  :exp (dt/in-future {:days 30})})]
 
     (when (not= email (:email profile))
       (cmd.auth/check-profile-existence! conn params))
@@ -251,6 +245,7 @@
 
 ;; --- MUTATION: Delete Profile
 
+(declare get-owned-teams-with-participants)
 (declare check-can-delete-profile!)
 (declare mark-profile-as-deleted!)
 
@@ -260,14 +255,29 @@
 (sv/defmethod ::delete-profile
   [{:keys [pool session] :as cfg} {:keys [profile-id] :as params}]
   (db/with-atomic [conn pool]
-    (check-can-delete-profile! conn profile-id)
+    (let [teams      (get-owned-teams-with-participants conn profile-id)
+          deleted-at (dt/now)]
 
-    (db/update! conn :profile
-                {:deleted-at (dt/now)}
-                {:id profile-id})
+      ;; If we found owned teams with participants, we don't allow
+      ;; delete profile until the user properly transfer ownership or
+      ;; explicitly removes all participants from the team
+      (when (some pos? (map :participants teams))
+        (ex/raise :type :validation
+                  :code :owner-teams-with-people
+                  :hint "The user need to transfer ownership of owned teams."
+                  :context {:teams (mapv :id teams)}))
 
-    (with-meta {}
-      {:transform-response (:delete session)})))
+      (doseq [{:keys [id]} teams]
+        (db/update! conn :team
+                    {:deleted-at deleted-at}
+                    {:id id}))
+
+      (db/update! conn :profile
+                  {:deleted-at deleted-at}
+                  {:id profile-id})
+
+      (with-meta {}
+        {:transform-response (:delete session)}))))
 
 (def sql:owned-teams
   "with owner_teams as (
@@ -276,23 +286,16 @@
        where tpr.is_owner is true
          and tpr.profile_id = ?
    )
-   select tpr.team_id,
-          count(tpr.profile_id) as num_profiles
+   select tpr.team_id as id,
+          count(tpr.profile_id) - 1 as participants
      from team_profile_rel as tpr
     where tpr.team_id in (select id from owner_teams)
+      and tpr.profile_id != ?
     group by 1")
 
-(defn- check-can-delete-profile!
+(defn- get-owned-teams-with-participants
   [conn profile-id]
-  (let [rows (db/exec! conn [sql:owned-teams profile-id])]
-    ;; If we found owned teams with more than one profile we don't
-    ;; allow delete profile until the user properly transfer ownership
-    ;; or explicitly removes all participants from the team.
-    (when (some #(> (:num-profiles %) 1) rows)
-      (ex/raise :type :validation
-                :code :owner-teams-with-people
-                :hint "The user need to transfer ownership of owned teams."
-                :context {:teams (mapv :team-id rows)}))))
+  (db/exec! conn [sql:owned-teams profile-id profile-id]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; DEPRECATED METHODS (TO BE REMOVED ON 1.16.x)
@@ -303,7 +306,10 @@
 (s/def ::login ::cmd.auth/login-with-password)
 
 (sv/defmethod ::login
-  {:auth false ::rlimit/permits (cf/get :rlimit-password)}
+  {:auth false
+   ::rsem/queue :auth
+   ::doc/added "1.0"
+   ::doc/deprecated "1.15"}
   [cfg params]
   (cmd.auth/login-with-password cfg params))
 
@@ -311,7 +317,10 @@
 
 (s/def ::logout ::cmd.auth/logout)
 
-(sv/defmethod ::logout {:auth false}
+(sv/defmethod ::logout
+  {:auth false
+   ::doc/added "1.0"
+   ::doc/deprecated "1.15"}
   [{:keys [session] :as cfg} _]
   (with-meta {}
     {:transform-response (:delete session)}))
@@ -321,7 +330,8 @@
 (s/def ::recover-profile ::cmd.auth/recover-profile)
 
 (sv/defmethod ::recover-profile
-  {:auth false ::rlimit/permits (cf/get :rlimit-password)}
+  {::doc/added "1.0"
+   ::doc/deprecated "1.15"}
   [cfg params]
   (cmd.auth/recover-profile cfg params))
 
@@ -329,7 +339,10 @@
 
 (s/def ::prepare-register-profile ::cmd.auth/prepare-register-profile)
 
-(sv/defmethod ::prepare-register-profile {:auth false}
+(sv/defmethod ::prepare-register-profile
+  {:auth false
+   ::doc/added "1.0"
+   ::doc/deprecated "1.15"}
   [cfg params]
   (cmd.auth/prepare-register cfg params))
 
@@ -338,7 +351,10 @@
 (s/def ::register-profile ::cmd.auth/register-profile)
 
 (sv/defmethod ::register-profile
-  {:auth false ::rlimit/permits (cf/get :rlimit-password)}
+  {:auth false
+   ::rsem/queue :auth
+   ::doc/added "1.0"
+   ::doc/deprecated "1.15"}
   [{:keys [pool] :as cfg} params]
   (db/with-atomic [conn pool]
     (-> (assoc cfg :conn conn)
@@ -348,6 +364,9 @@
 
 (s/def ::request-profile-recovery ::cmd.auth/request-profile-recovery)
 
-(sv/defmethod ::request-profile-recovery {:auth false}
+(sv/defmethod ::request-profile-recovery
+  {:auth false
+   ::doc/added "1.0"
+   ::doc/deprecated "1.15"}
   [cfg params]
   (cmd.auth/request-profile-recovery cfg params))

backend/src/app/rpc/mutations/projects.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.mutations.projects
   (:require

backend/src/app/rpc/mutations/share_link.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.mutations.share-link
   "Share link related rpc mutation methods."

backend/src/app/rpc/mutations/teams.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.mutations.teams
   (:require
@@ -20,8 +20,9 @@
    [app.rpc.permissions :as perms]
    [app.rpc.queries.profile :as profile]
    [app.rpc.queries.teams :as teams]
-   [app.rpc.rlimit :as rlimit]
+   [app.rpc.semaphore :as rsem]
    [app.storage :as sto]
+   [app.tokens :as tokens]
    [app.util.services :as sv]
    [app.util.time :as dt]
    [clojure.spec.alpha :as s]
@@ -289,7 +290,6 @@
   (s/keys :req-un [::profile-id ::team-id ::file]))
 
 (sv/defmethod ::update-team-photo
-  {::rlimit/permits (cf/get :rlimit-image)}
   [cfg {:keys [file] :as params}]
   ;; Validate incoming mime type
   (media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
@@ -297,8 +297,8 @@
     (update-team-photo cfg params)))
 
 (defn update-team-photo
-  [{:keys [pool storage executors] :as cfg} {:keys [profile-id team-id] :as params}]
-  (p/let [team  (px/with-dispatch (:default executors)
+  [{:keys [pool storage executor] :as cfg} {:keys [profile-id team-id] :as params}]
+  (p/let [team  (px/with-dispatch executor
                   (teams/retrieve-team pool profile-id team-id))
           photo (upload-photo cfg params)]
 
@@ -315,13 +315,13 @@
     (assoc team :photo-id (:id photo))))
 
 (defn upload-photo
-  [{:keys [storage executors] :as cfg} {:keys [file]}]
+  [{:keys [storage semaphores] :as cfg} {:keys [file]}]
   (letfn [(get-info [content]
-            (px/with-dispatch (:blocking executors)
+            (rsem/with-dispatch (:process-image semaphores)
               (media/run {:cmd :info :input content})))
 
           (generate-thumbnail [info]
-            (px/with-dispatch (:blocking executors)
+            (rsem/with-dispatch (:process-image semaphores)
               (media/run {:cmd :profile-thumbnail
                           :format :jpeg
                           :quality 85
@@ -330,11 +330,9 @@
                           :input info})))
 
           ;; Function responsible of calculating cryptographyc hash of
-          ;; the provided data. Even though it uses the hight
-          ;; performance BLAKE2b algorithm, we prefer to schedule it
-          ;; to be executed on the blocking executor.
+          ;; the provided data.
           (calculate-hash [data]
-            (px/with-dispatch (:blocking executors)
+            (rsem/with-dispatch (:process-image semaphores)
               (sto/calculate-hash data)))]
 
     (p/let [info    (get-info file)
@@ -342,11 +340,11 @@
             hash    (calculate-hash (:data thumb))
             content (-> (sto/content (:data thumb) (:size thumb))
                         (sto/wrap-with-hash hash))]
-      (sto/put-object! storage {::sto/content content
-                                ::sto/deduplicate? true
-                                :bucket "profile"
-                                :content-type (:mtype thumb)}))))
-
+      (rsem/with-dispatch (:process-image semaphores)
+        (sto/put-object! storage {::sto/content content
+                                  ::sto/deduplicate? true
+                                  :bucket "profile"
+                                  :content-type (:mtype thumb)})))))
 
 ;; --- Mutation: Invite Member
 
@@ -378,18 +376,17 @@
                   :code :profile-is-muted
                   :hint "looks like the profile has reported repeatedly as spam or has permanent bounces"))
 
-      (doseq [email emails]
-        (create-team-invitation
-         (assoc cfg
-                :email email
-                :conn conn
-                :team team
-                :profile profile
-                :role role))
-        )
-
-      (with-meta {}
-        {::audit/props {:invitations (count emails)}}))))
+      (let [invitations (->> emails
+                             (map (fn [email]
+                                    (assoc cfg
+                                           :email email
+                                           :conn conn
+                                           :team team
+                                           :profile profile
+                                           :role role)))
+                             (map create-team-invitation))]
+        (with-meta (vec invitations)
+          {::audit/props {:invitations (count invitations)}})))))
 
 (def sql:upsert-team-invitation
   "insert into team_invitation(team_id, email_to, role, valid_until)
@@ -398,48 +395,74 @@
           update set role = ?, valid_until = ?, updated_at = now();")
 
 (defn- create-team-invitation
-  [{:keys [conn tokens team profile role email] :as cfg}]
+  [{:keys [conn sprops team profile role email] :as cfg}]
   (let [member    (profile/retrieve-profile-data-by-email conn email)
         token-exp (dt/in-future "168h") ;; 7 days
-        itoken    (tokens :generate
-                          {:iss :team-invitation
-                           :exp token-exp
-                           :profile-id (:id profile)
-                           :role role
-                           :team-id (:id team)
-                           :member-email (:email member email)
-                           :member-id (:id member)})
-        ptoken    (tokens :generate-predefined
-                          {:iss :profile-identity
-                           :profile-id (:id profile)})]
-
-    (when (contains? cf/flags :log-invitation-tokens)
-      (l/trace :hint "invitation token" :token itoken))
+        email     (str/lower email)
+        itoken    (tokens/generate sprops
+                                   {:iss :team-invitation
+                                    :exp token-exp
+                                    :profile-id (:id profile)
+                                    :role role
+                                    :team-id (:id team)
+                                    :member-email (:email member email)
+                                    :member-id (:id member)})
+        ptoken    (tokens/generate sprops
+                                   {:iss :profile-identity
+                                    :profile-id (:id profile)
+                                    :exp (dt/in-future {:days 30})})]
 
     (when (and member (not (eml/allow-send-emails? conn member)))
       (ex/raise :type :validation
                 :code :member-is-muted
                 :email email
-                :hint "looks like the profile has reported repeatedly as spam or has permanent bounces"))
+                :hint "the profile has reported repeatedly as spam or has bounces"))
 
     ;; Secondly check if the invited member email is part of the global spam/bounce report.
     (when (eml/has-bounce-reports? conn email)
       (ex/raise :type :validation
                 :code :email-has-permanent-bounces
                 :email email
-                :hint "looks like the email you invite has been repeatedly reported as spam or permanent bounce"))
+                :hint "the email you invite has been repeatedly reported as spam or bounce"))
 
-    (db/exec-one! conn [sql:upsert-team-invitation
-                        (:id team) (str/lower email) (name role) token-exp (name role) token-exp])
+    (when (contains? cf/flags :log-invitation-tokens)
+      (l/trace :hint "invitation token" :token itoken))
 
-    (eml/send! {::eml/conn conn
-                ::eml/factory eml/invite-to-team
-                :public-uri (:public-uri cfg)
-                :to email
-                :invited-by (:fullname profile)
-                :team (:name team)
-                :token itoken
-                :extra-data ptoken})))
+    ;; When we have email verification disabled and invitation user is
+    ;; already present in the database, we proceed to add it to the
+    ;; team as-is, without email roundtrip.
+
+    ;; TODO: if member does not exists and email verification is
+    ;; disabled, we should proceed to create the profile (?)
+    (if (and (not (contains? cf/flags :email-verification))
+             (some? member))
+      (let [params (merge {:team-id (:id team)
+                           :profile-id (:id member)}
+                          (role->params role))]
+
+        ;; Insert the invited member to the team
+        (db/insert! conn :team-profile-rel params {:on-conflict-do-nothing true})
+
+        ;; If profile is not yet verified, mark it as verified because
+        ;; accepting an invitation link serves as verification.
+        (when-not (:is-active member)
+          (db/update! conn :profile
+                      {:is-active true}
+                      {:id (:id member)})))
+      (do
+        (db/exec-one! conn [sql:upsert-team-invitation
+                            (:id team) (str/lower email) (name role)
+                            token-exp (name role) token-exp])
+        (eml/send! {::eml/conn conn
+                    ::eml/factory eml/invite-to-team
+                    :public-uri (:public-uri cfg)
+                    :to email
+                    :invited-by (:fullname profile)
+                    :team (:name team)
+                    :token itoken
+                    :extra-data ptoken})))
+
+    itoken))
 
 ;; --- Mutation: Create Team & Invite Members
 

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

@@ -2,172 +2,27 @@
 ;; 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.mutations.verify-token
   (:require
-   [app.common.exceptions :as ex]
-   [app.common.spec :as us]
    [app.db :as db]
-   [app.loggers.audit :as audit]
-   [app.rpc.mutations.teams :as teams]
-   [app.rpc.queries.profile :as profile]
+   [app.rpc.commands.verify-token :refer [process-token]]
+   [app.rpc.doc :as-alias doc]
+   [app.tokens :as tokens]
    [app.util.services :as sv]
-   [clojure.spec.alpha :as s]
-   [cuerdas.core :as str]))
-
-(defmulti process-token (fn [_ _ claims] (:iss claims)))
+   [clojure.spec.alpha :as s]))
 
 (s/def ::verify-token
   (s/keys :req-un [::token]
           :opt-un [::profile-id]))
 
-(sv/defmethod ::verify-token {:auth false}
-  [{:keys [pool tokens] :as cfg} {:keys [token] :as params}]
+(sv/defmethod ::verify-token
+  {:auth false
+   ::doc/added "1.1"
+   ::doc/deprecated "1.15"}
+  [{:keys [pool sprops] :as cfg} {:keys [token] :as params}]
   (db/with-atomic [conn pool]
-    (let [claims (tokens :verify {:token token})
+    (let [claims (tokens/verify sprops {:token token})
           cfg    (assoc cfg :conn conn)]
       (process-token cfg params claims))))
-
-(defmethod process-token :change-email
-  [{:keys [conn] :as cfg} _params {:keys [profile-id email] :as claims}]
-  (when (profile/retrieve-profile-data-by-email conn email)
-    (ex/raise :type :validation
-              :code :email-already-exists))
-
-  (db/update! conn :profile
-              {:email email}
-              {:id profile-id})
-
-  (with-meta claims
-    {::audit/name "update-profile-email"
-     ::audit/props {:email email}
-     ::audit/profile-id profile-id}))
-
-(defmethod process-token :verify-email
-  [{:keys [conn session] :as cfg} _ {:keys [profile-id] :as claims}]
-  (let [profile (profile/retrieve-profile conn profile-id)
-        claims  (assoc claims :profile profile)]
-
-    (when-not (:is-active profile)
-      (when (not= (:email profile)
-                  (:email claims))
-        (ex/raise :type :validation
-                  :code :invalid-token))
-
-      (db/update! conn :profile
-                  {:is-active true}
-                  {:id (:id profile)}))
-
-    (with-meta claims
-      {:transform-response ((:create session) profile-id)
-       ::audit/name "verify-profile-email"
-       ::audit/props (audit/profile->props profile)
-       ::audit/profile-id (:id profile)})))
-
-(defmethod process-token :auth
-  [{:keys [conn] :as cfg} _params {:keys [profile-id] :as claims}]
-  (let [profile (profile/retrieve-profile conn profile-id)]
-    (assoc claims :profile profile)))
-
-
-;; --- Team Invitation
-
-(s/def ::iss keyword?)
-(s/def ::exp ::us/inst)
-
-(s/def :internal.tokens.team-invitation/profile-id ::us/uuid)
-(s/def :internal.tokens.team-invitation/role ::us/keyword)
-(s/def :internal.tokens.team-invitation/team-id ::us/uuid)
-(s/def :internal.tokens.team-invitation/member-email ::us/email)
-(s/def :internal.tokens.team-invitation/member-id (s/nilable ::us/uuid))
-
-(s/def ::team-invitation-claims
-  (s/keys :req-un [::iss ::exp
-                   :internal.tokens.team-invitation/profile-id
-                   :internal.tokens.team-invitation/role
-                   :internal.tokens.team-invitation/team-id
-                   :internal.tokens.team-invitation/member-email]
-          :opt-un [:internal.tokens.team-invitation/member-id]))
-
-(defn- accept-invitation
-  [{:keys [conn] :as cfg} {:keys [member-id team-id role member-email] :as claims}]
-  (let [
-        member (profile/retrieve-profile conn member-id)
-        invitation (db/get-by-params conn :team-invitation
-                                    {:team-id team-id :email-to (str/lower member-email)}
-                                    {:check-not-found false})
-        ;; Update the role if there is an invitation
-        role (or (some-> invitation :role keyword) role)
-        params (merge {:team-id team-id
-                       :profile-id member-id}
-                      (teams/role->params role))
-        ]
-
-    ;; Insert the invited member to the team
-    (db/insert! conn :team-profile-rel params {:on-conflict-do-nothing true})
-
-    ;; If profile is not yet verified, mark it as verified because
-    ;; accepting an invitation link serves as verification.
-    (when-not (:is-active member)
-      (db/update! conn :profile
-                  {:is-active true}
-                  {:id member-id}))
-    (assoc member :is-active true)
-
-    ;; Delete the invitation
-    (db/delete! conn :team-invitation
-                {:team-id team-id :email-to (str/lower member-email)})))
-
-
-(defmethod process-token :team-invitation
-  [cfg {:keys [profile-id token]} {:keys [member-id] :as claims}]
-  (us/assert ::team-invitation-claims claims)
-  (let [conn (:conn cfg)
-        team-id (:team-id claims)
-        member-email (:member-email claims)
-        invitation (db/get-by-params conn :team-invitation
-                                     {:team-id team-id :email-to (str/lower member-email)}
-                                     {:check-not-found false})]
-    (when (nil? invitation)
-      (ex/raise :type :validation
-                :code :invalid-token)))
-
-  (cond
-    ;; This happens when token is filled with member-id and current
-    ;; user is already logged in with exactly invited account.
-    (and (uuid? profile-id) (uuid? member-id) (= member-id profile-id))
-    (let [profile (accept-invitation cfg claims)]
-      (with-meta
-        (assoc claims :state :created)
-        {::audit/name "accept-team-invitation"
-         ::audit/props (merge
-                        (audit/profile->props profile)
-                        {:team-id (:team-id claims)
-                         :role (:role claims)})
-         ::audit/profile-id member-id}))
-
-    ;; This case means that invitation token does not match with
-    ;; registred user, so we need to indicate to frontend to redirect
-    ;; it to register page.
-    (nil? member-id)
-    {:invitation-token token
-     :iss :team-invitation
-     :redirect-to :auth-register
-     :state :pending}
-
-    ;; In all other cases, just tell to fontend to redirect the user
-    ;; to the login page.
-    :else
-    {:invitation-token token
-     :iss :team-invitation
-     :redirect-to :auth-login
-     :state :pending}))
-
-;; --- Default
-
-(defmethod process-token :default
-  [_ _ _]
-  (ex/raise :type :validation
-            :code :invalid-token))
-

backend/src/app/rpc/permissions.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.permissions
   "A permission checking helper factories."

backend/src/app/rpc/queries/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.queries.comments
   (:require

backend/src/app/rpc/queries/files.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.queries.files
   (:require
@@ -13,6 +13,8 @@
    [app.common.pages.helpers :as cph]
    [app.common.pages.migrations :as pmg]
    [app.common.spec :as us]
+   [app.common.types.file :as ctf]
+   [app.common.types.shape-tree :as ctt]
    [app.db :as db]
    [app.db.sql :as sql]
    [app.rpc.helpers :as rpch]
@@ -26,7 +28,6 @@
    [cuerdas.core :as str]))
 
 (declare decode-row)
-(declare decode-row-xf)
 
 ;; --- Helpers & Specs
 
@@ -38,6 +39,7 @@
 (s/def ::profile-id ::us/uuid)
 (s/def ::team-id ::us/uuid)
 (s/def ::search-term ::us/string)
+(s/def ::components-v2 ::us/boolean)
 
 ;; --- Query: File Permissions
 
@@ -122,8 +124,7 @@
 (defn check-comment-permissions!
   [conn profile-id file-id share-id]
    (let [can-read (has-read-permissions? conn profile-id file-id)
-         can-comment  (has-comment-permissions? conn profile-id file-id share-id)
-         ]
+         can-comment  (has-comment-permissions? conn profile-id file-id share-id)]
      (when-not (or can-read can-comment)
        (ex/raise :type :not-found
                  :code :object-not-found
@@ -226,20 +227,29 @@
             (d/index-by :object-id :data))))))
 
 (defn retrieve-file
-  [{:keys [pool] :as cfg} id]
-  (->> (db/get-by-id pool :file id)
-       (decode-row)
-       (pmg/migrate-file)))
+  [{:keys [pool] :as cfg} id components-v2]
+  (let [file (->> (db/get-by-id pool :file id)
+                  (decode-row)
+                  (pmg/migrate-file))]
+
+    (if components-v2
+      (update file :data ctf/migrate-to-components-v2)
+      (if (get-in file [:data :options :components-v2])
+        (ex/raise :type :restriction
+                  :code :feature-disabled
+                  :hint "tried to open a components-v2 file with feature disabled")
+        file))))
 
 (s/def ::file
-  (s/keys :req-un [::profile-id ::id]))
+  (s/keys :req-un [::profile-id ::id]
+          :opt-un [::components-v2]))
 
 (sv/defmethod ::file
   "Retrieve a file by its ID. Only authenticated users."
-  [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id id components-v2] :as params}]
   (let [perms (get-permissions pool profile-id id)]
     (check-read-permissions! perms)
-    (let [file   (retrieve-file cfg id)
+    (let [file   (retrieve-file cfg id components-v2)
           thumbs (retrieve-object-thumbnails cfg id)]
       (-> file
           (assoc :thumbnails thumbs)
@@ -268,7 +278,7 @@
 (s/def ::page
   (s/and
    (s/keys :req-un [::profile-id ::file-id]
-           :opt-un [::page-id ::object-id])
+           :opt-un [::page-id ::object-id ::components-v2])
    (fn [obj]
      (if (contains? obj :object-id)
        (contains? obj :page-id)
@@ -284,9 +294,9 @@
   mandatory.
 
   Mainly used for rendering purposes."
-  [{:keys [pool] :as cfg} {:keys [profile-id file-id page-id object-id] :as props}]
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id page-id object-id components-v2] :as props}]
   (check-read-permissions! pool profile-id file-id)
-  (let [file    (retrieve-file cfg file-id)
+  (let [file    (retrieve-file cfg file-id components-v2)
         page-id (or page-id (-> file :data :pages first))
         page    (get-in file [:data :pages-index page-id])]
 
@@ -304,7 +314,7 @@
           (get-thumbnail-frame [data]
             (d/seek :use-for-thumbnail?
                     (for [page  (-> data :pages-index vals)
-                          frame (-> page :objects cph/get-frames)]
+                          frame (-> page :objects ctt/get-frames)]
                       (assoc frame :page-id (:id page)))))
 
           ;; function responsible to filter objects data structure of
@@ -355,7 +365,7 @@
                         (-> data :pages first))
 
           page      (dm/get-in data [:pages-index page-id])
-          frame-ids (if (some? frame) (list frame-id) (map :id (cph/get-frames (:objects page))))
+          frame-ids (if (some? frame) (list frame-id) (map :id (ctt/get-frames (:objects page))))
 
           obj-ids   (map #(str page-id %) frame-ids)
           thumbs    (retrieve-object-thumbnails cfg id obj-ids)]
@@ -373,14 +383,15 @@
         (update :objects assoc-thumbnails page-id thumbs)))))
 
 (s/def ::file-data-for-thumbnail
-  (s/keys :req-un [::profile-id ::file-id]))
+  (s/keys :req-un [::profile-id ::file-id]
+          :opt-un [::components-v2]))
 
 (sv/defmethod ::file-data-for-thumbnail
   "Retrieves the data for generate the thumbnail of the file. Used
   mainly for render thumbnails on dashboard."
-  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as props}]
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id components-v2] :as props}]
   (check-read-permissions! pool profile-id file-id)
-  (let [file (retrieve-file cfg file-id)]
+  (let [file (retrieve-file cfg file-id components-v2)]
     {:file-id file-id
      :revn (:revn file)
      :page (get-file-thumbnail-data cfg file)}))
@@ -391,6 +402,7 @@
 (def ^:private sql:team-shared-files
   "select f.id,
           f.revn,
+          f.data,
           f.project_id,
           f.created_at,
           f.modified_at,
@@ -409,7 +421,26 @@
 
 (sv/defmethod ::team-shared-files
   [{:keys [pool] :as cfg} {:keys [team-id] :as params}]
-  (db/exec! pool [sql:team-shared-files team-id]))
+  (let [assets-sample
+        (fn [assets limit]
+          (let [sorted-assets (->> (vals assets)
+                                   (sort-by #(str/lower (:name %))))]
+
+          {:count (count sorted-assets)
+           :sample (into [] (take limit sorted-assets))}))
+
+        library-summary
+        (fn [data]
+          {:components (assets-sample (:components data) 4)
+           :colors (assets-sample (:colors data) 3)
+           :typographies (assets-sample (:typographies data) 3)})
+
+        xform (comp
+                (map decode-row)
+                (map #(assoc % :library-summary (library-summary (:data %))))
+                (map #(dissoc % :data)))]
+
+    (into #{} xform (db/exec! pool [sql:team-shared-files team-id]))))
 
 
 ;; --- Query: File Libraries used by a File
@@ -453,6 +484,25 @@
   (check-read-permissions! pool profile-id file-id)
   (retrieve-file-libraries cfg false file-id))
 
+
+;; --- Query: Files that use this File library
+
+(def ^:private sql:library-using-files
+  "SELECT f.id,
+          f.name
+     FROM file_library_rel AS flr
+     JOIN file AS f ON (f.id = flr.file_id)
+    WHERE flr.library_file_id = ?
+      AND (f.deleted_at IS NULL OR f.deleted_at > now())")
+
+(s/def ::library-using-files
+  (s/keys :req-un [::profile-id ::file-id]))
+
+(sv/defmethod ::library-using-files
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
+  (check-read-permissions! pool profile-id file-id)
+  (db/exec! pool [sql:library-using-files file-id]))
+
 ;; --- QUERY: team-recent-files
 
 (def sql:team-recent-files
@@ -517,12 +567,9 @@
 ;; --- Helpers
 
 (defn decode-row
-  [{:keys [data changes] :as row}]
+  [{:keys [data changes features] :as row}]
   (when row
     (cond-> row
-      changes (assoc :changes (blob/decode changes))
-      data    (assoc :data (blob/decode data)))))
-
-(def decode-row-xf
-  (comp (map decode-row)
-        (map pmg/migrate-file)))
+      features (assoc :features (db/decode-pgarray features #{}))
+      changes  (assoc :changes (blob/decode changes))
+      data     (assoc :data (blob/decode data)))))

backend/src/app/rpc/queries/fonts.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.queries.fonts
   (:require