📎 Set verstion to 1.5.4-alpha

Just a quality of life improvement.

.circleci/config.yml

@@ -13,7 +13,7 @@ jobs:
         environment:
           POSTGRES_USER: penpot_test
           POSTGRES_PASSWORD: penpot_test
-          POSTGRES_DB: penpot
+          POSTGRES_DB: penpot_test
 
       - image: circleci/redis:6.0.8
 
@@ -45,10 +45,10 @@ jobs:
           name: backend test
           command: "clojure -M:dev:tests"
           environment:
-            PENPOT_DATABASE_URI: "postgresql://localhost/penpot"
-            PENPOT_DATABASE_USERNAME: penpot_test
-            PENPOT_DATABASE_PASSWORD: penpot_test
-            PENPOT_REDIS_URI: "redis://localhost/1"
+            PENPOT_TEST_DATABASE_URI: "postgresql://localhost/penpot_test"
+            PENPOT_TEST_DATABASE_USERNAME: penpot_test
+            PENPOT_TEST_DATABASE_PASSWORD: penpot_test
+            PENPOT_TEST_REDIS_URI: "redis://localhost/1"
 
       - run:
           working_directory: "./frontend"
@@ -57,7 +57,8 @@ jobs:
             yarn install
             npx shadow-cljs compile tests
           environment:
-            PATH: /usr/local/nodejs/bin/:/usr/local/bin:/bin:/usr/bin
+            JAVA_HOME: /usr/lib/jvm/openjdk16
+            PATH: /usr/local/nodejs/bin/:/usr/local/bin:/bin:/usr/bin:/usr/lib/jvm/openjdk16/bin
 
       - save_cache:
          paths:

.github/ISSUE_TEMPLATE/bug_report.md

@@ -38,13 +38,13 @@ If applicable, add screenshots to help explain your problem.
 -   Version (e.g. 22)
 
 **Environment (please complete the following information):**
-Specify if using demo instance or self-hosted instance.
+Specify if using SAAS (https://design.penpot.app) or self-hosted instance.
 
 If self-hosted instance, add OS and runtime information to help explain your problem.
 
 -   OS Version: (e.g. Ubuntu 16.04)
 
-Also provide Docker commands or docker-compose file if possible.
+Also provide Docker commands or docker-compose file if possible and if proceed.x
 
 -   Docker / Docker-compose Version: (e.g. Docker version 18.03.0-ce, build 0520e24)
 -   Image (e.g. alpine)

.gitignore

@@ -15,9 +15,11 @@ node_modules
 /backend/target/
 /backend/resources/public/media
 /backend/resources/public/assets
+/backend/assets/
 /backend/dist/
 /backend/logs/
 /backend/-
+/telemetry/
 /frontend/npm-debug.log
 /frontend/target/
 /frontend/dist/
@@ -26,7 +28,7 @@ node_modules
 /frontend/resources/public/*
 /exporter/target
 /exporter/.shadow-cljs
-/docker/images/bundle
+/docker/images/bundle*
 /.clj-kondo/.cache
 /bundle*
 /media

.gitpod.yml

@@ -0,0 +1,105 @@
+image:
+  file: docker/gitpod/Dockerfile
+
+ports:
+  # nginx
+  - port: 3449
+    onOpen: open-preview
+
+  # frontend nREPL
+  - port: 3447
+    onOpen: ignore
+    visibility: private
+
+  # frontend shadow server
+  - port: 3448
+    onOpen: ignore
+    visibility: private
+
+  # backend
+  - port: 6060
+    onOpen: ignore
+
+  # exporter shadow server
+  - port: 9630
+    onOpen: ignore
+    visibility: private
+
+  # exporter http server
+  - port: 6061
+    onOpen: ignore
+
+  # mailhog web interface
+  - port: 8025
+    onOpen: ignore
+
+  # mailhog postfix
+  - port: 1025
+    onOpen: ignore
+
+  # postgres
+  - port: 5432
+    onOpen: ignore
+
+  # redis
+  - port: 6379
+    onOpen: ignore
+
+  # openldap
+  - port: 389
+    onOpen: ignore
+
+tasks:
+  # https://github.com/gitpod-io/gitpod/issues/666#issuecomment-534347856
+  - name: gulp
+    command: >
+      cd $GITPOD_REPO_ROOT/frontend/;
+      yarn && gp sync-done 'frontend-yarn';
+      npx gulp --theme=${PENPOT_THEME} watch
+
+  - name: frontend shadow watch
+    command: >
+      cd $GITPOD_REPO_ROOT/frontend/;
+      gp sync-await 'frontend-yarn';
+      npx shadow-cljs watch main
+
+  - init: gp await-port 5432 && psql -f $GITPOD_REPO_ROOT/docker/gitpod/files/postgresql_init.sql
+    name: backend
+    command: >
+      cd $GITPOD_REPO_ROOT/backend/;
+      ./scripts/start-dev
+
+  - name: exporter shadow watch
+    command:
+      cd $GITPOD_REPO_ROOT/exporter/;
+      gp sync-await 'frontend-yarn';
+      yarn && npx shadow-cljs watch main
+
+  - name: exporter web server
+    command: >
+      cd $GITPOD_REPO_ROOT/exporter/;
+      ./scripts/wait-and-start.sh
+
+  - name: signed terminal
+    before: >
+      [[ ! -z ${GNUGPG}  ]] &&
+      cd ~ &&
+      rm -rf .gnupg &&
+      echo ${GNUGPG} | base64 -d | tar --no-same-owner -xzvf -
+    init: >
+      [[ ! -z ${GNUGPG_KEY}  ]] &&
+      git config --global commit.gpgsign true &&
+      git config --global user.signingkey ${GNUGPG_KEY}
+    command: cd $GITPOD_REPO_ROOT
+
+  - name: redis
+    command: redis-server
+
+  - before: go get github.com/mailhog/MailHog
+    name: mailhog
+    command: MailHog
+
+  - name: Nginx
+    command: >
+      nginx &&
+      multitail /var/log/nginx/access.log -I /var/log/nginx/error.log

CHANGES.md

@@ -1,15 +1,229 @@
 # CHANGELOG #
 
-## Next
+## :rocket: Next
 
-### New features
+### :sparkles: New features
+### :bug: Bugs fixed
+### :arrow_up: Deps updates
+### :boom: Breaking changes
+### :heart: Community contributions by (Thank you!)
 
-### Bugs fixed
+
+## 1.5.4-alpha
+
+### :bug: Bugs fixed
+
+- Fix issues on group rendering.
+
+
+## 1.5.3-alpha
+
+### :bug: Bugs fixed
+
+- Fix problem undo/redo.
+
+## 1.5.2-alpha
+
+### :bug: Bugs fixed
+
+- Fix problem with `close-path` command [#917](https://github.com/penpot/penpot/issues/917)
+- Fix wrong query for obtain the profile default project-id
+- Fix problems with empty paths and shortcuts [#923](https://github.com/penpot/penpot/issues/923)
+
+## 1.5.1-alpha
+
+### :bug: Bugs fixed
+
+- Fix issue with bitmap image clipboard.
+- Fix issue when removing all path points.
+- Increase default team invitation token expiration to 48h.
+- Fix wrong error message when an expired token is used.
+
+
+## 1.5.0-alpha
+
+### :sparkles: New features
+
+- Add integration with gitpod.io (an online IDE) [#807](https://github.com/penpot/penpot/pull/807)
+- Allow basic math operations in inputs [Taiga 1383](https://tree.taiga.io/project/penpot/us/1383)
+- Autocomplete color names in hex inputs [Taiga 1596](https://tree.taiga.io/project/penpot/us/1596)
+- Allow to group assets (components and graphics) [Taiga #1289](https://tree.taiga.io/project/penpot/us/1289)
+- Change icon of pinned projects [Taiga 1298](https://tree.taiga.io/project/penpot/us/1298)
+- Internal: refactor of http client, replace internal xhr usage with more modern Fetch API.
+- New features for paths: snap points on edition, add/remove nodes, merge/join/split nodes. [Taiga #907](https://tree.taiga.io/project/penpot/us/907)
+- Add OpenID-Connect support.
+- Reimplement social auth providers on top of the generic openid impl.
+
+### :bug: Bugs fixed
+
+- Fix problem with pan and space [#811](https://github.com/penpot/penpot/issues/811)
+- Fix issue when parsing exponential numbers in paths
+- Remove legacy system user and team [#843](https://github.com/penpot/penpot/issues/843)
+- Fix ordering of copy pasted objects [Taiga #1618](https://tree.taiga.io/project/penpot/issue/1617)
+- Fix problems with blending modes [#837](https://github.com/penpot/penpot/issues/837)
+- Fix problem with zoom an selection rect [#845](https://github.com/penpot/penpot/issues/845)
+- Fix problem displaying team statistics [#859](https://github.com/penpot/penpot/issues/859)
+- Fix problems with text editor selection [Taiga #1546](https://tree.taiga.io/project/penpot/issue/1546)
+- Fix problem when opening the context menu in dashboard at the bottom [#856](https://github.com/penpot/penpot/issues/856)
+- Fix problem when clicking an interactive group in view mode [#863](https://github.com/penpot/penpot/issues/863)
+- Fix visibility of pages in sitemap when changing page [Taiga #1618](https://tree.taiga.io/project/penpot/issue/1618)
+- Fix visual problem with group invite [Taiga #1290](https://tree.taiga.io/project/penpot/issue/1290)
+- Fix issues with promote owner panel [Taiga #763](https://tree.taiga.io/project/penpot/issue/763)
+- Allow use library colors when defining gradients [Taiga #1614](https://tree.taiga.io/project/penpot/issue/1614)
+- Fix group selrect not updating after alignment [#895](https://github.com/penpot/penpot/issues/895)
+
+### :arrow_up: Deps updates
+
+### :boom: Breaking changes
+
+- Translations refactor: now penpot uses gettext instead of a custom
+  JSON, and each locale has its own separated file. All translations
+  should be contributed via the weblate.org service.
+
+### :heart: Community contributions by (Thank you!)
+
+- madmath03 (by [Monogramm](https://github.com/Monogramm)) [#807](https://github.com/penpot/penpot/pull/807)
+- zzkt [#814](https://github.com/penpot/penpot/pull/814)
+
+
+## 1.4.1-alpha
+
+### :bug: Bugs fixed
+
+- Fix typography unlinking.
+- Fix incorrect measures on shapes outside artboard.
+- Fix issues on svg parsing related to numbers with exponents.
+- Fix some race conditions on removing shape from workspace.
+- Fix incorrect state management of user lang selection.
+- Fix email validation usability issue on team invitation lightbox.
+
+
+## 1.4.0-alpha
+
+### :sparkles: New features
+
+- Add blob-encoding v3 (uses ZSTD+transit) [#738](https://github.com/penpot/penpot/pull/738)
+- Add http caching layer on top of Query RPC.
+- Add layer opacity and blend mode to shapes [Taiga #937](https://tree.taiga.io/project/penpot/us/937)
+- Add more chinese translations [#726](https://github.com/penpot/penpot/pull/726)
+- Add native support for text-direction (RTL, LTR & auto).
+- Add several enhancements in shape selection [Taiga #1195](https://tree.taiga.io/project/penpot/us/1195)
+- Add thumbnail in memory caching mechanism.
+- Add turkish translation strings [#759](https://github.com/penpot/penpot/pull/759), [#794](https://github.com/penpot/penpot/pull/794)
+- Duplicate and move files and projects [Taiga #267](https://tree.taiga.io/project/penpot/us/267)
+- Hide viewer navbar on fullscreen [Taiga 1375](https://tree.taiga.io/project/penpot/us/1375)
+- Import SVG will create Penpot's shapes [Taiga #1006](https://tree.taiga.io/project/penpot/us/1066)
+- Improve french translations [#731](https://github.com/penpot/penpot/pull/731)
+- Reimplement workspace presence (remove database state).
+- Remember last visited team when you re-enter the application [Taiga #1376](https://tree.taiga.io/project/penpot/us/1376)
+- Rename artboard with double click on the title [Taiga #1392](https://tree.taiga.io/project/penpot/us/1392)
+- Replace Slate-Editor with DraftJS [Taiga #1346](https://tree.taiga.io/project/penpot/us/1346)
+- Set proper page title [Taiga #1377](https://tree.taiga.io/project/penpot/us/1377)
+
+
+### :bug: Bugs fixed
+
+- Disable buttons in view mode for users without permissions [Taiga #1328](https://tree.taiga.io/project/penpot/issue/1328)
+- Fix broken profile and profile options form.
+- Fix calculate size of some animated gifs [Taiga #1487](https://tree.taiga.io/project/penpot/issue/1487)
+- Fix error with the "Navigate to" button on prototypes [Taiga #1268](https://tree.taiga.io/project/penpot/issue/1268)
+- Fix issue when undo after changing the artboard of a shape [Taiga #1304](https://tree.taiga.io/project/penpot/issue/1304)
+- Fix issue with Alt key in distance measurement [#672](https://github.com/penpot/penpot/issues/672)
+- Fix issue with blending modes in masks [Taiga #1476](https://tree.taiga.io/project/penpot/issue/1476)
+- Fix issue with blocked shapes [Taiga #1480](https://tree.taiga.io/project/penpot/issue/1480)
+- Fix issue with comments styles on dashboard [Taiga #1405](https://tree.taiga.io/project/penpot/issue/1405)
+- Fix issue with default square grid [Taiga #1344](https://tree.taiga.io/project/penpot/issue/1344)
+- Fix issue with enter key shortcut [#775](https://github.com/penpot/penpot/issues/775)
+- Fix issue with enter to edit paths [Taiga #1481](https://tree.taiga.io/project/penpot/issue/1481)
+- Fix issue with mask and flip [#715](https://github.com/penpot/penpot/issues/715)
+- Fix issue with masks interactions outside bounds [#718](https://github.com/penpot/penpot/issues/718)
+- Fix issue with middle mouse button press moving the canvas when not moving mouse [#717](https://github.com/penpot/penpot/issues/717)
+- Fix issue with resolved comments [Taiga #1406](https://tree.taiga.io/project/penpot/issue/1406)
+- Fix issue with rotated blur [Taiga #1370](https://tree.taiga.io/project/penpot/issue/1370)
+- Fix issue with rotation degree input [#741](https://github.com/penpot/penpot/issues/741)
+- Fix issue with system shortcuts and application [#737](https://github.com/penpot/penpot/issues/737)
+- Fix issue with team management in dashboard [Taiga #1475](https://tree.taiga.io/project/penpot/issue/1475)
+- Fix issue with typographies panel cannot be collapsed [#707](https://github.com/penpot/penpot/issues/707)
+- Fix text selection in comments [#745](https://github.com/penpot/penpot/issues/745)
+- Update Work-Sans font [#744](https://github.com/penpot/penpot/issues/744)
+- Fix issue with recent files not showing [Taiga #1493](https://tree.taiga.io/project/penpot/issue/1493)
+- Fix issue when promoting to owner [Taiga #1494](https://tree.taiga.io/project/penpot/issue/1494)
+- Fix cannot click on blocked elements in viewer [Taiga #1430](https://tree.taiga.io/project/penpot/issue/1430)
+- Fix SVG not showing properties at code [Taiga #1437](https://tree.taiga.io/project/penpot/issue/1437)
+- Fix shadows when exporting groups [Taiga #1495](https://tree.taiga.io/project/penpot/issue/1495)
+- Fix drag-select when renaming layer text [Taiga #1307](https://tree.taiga.io/project/penpot/issue/1307)
+- Fix layout problem for editable selects [Taiga #1488](https://tree.taiga.io/project/penpot/issue/1488)
+- Fix artboard title wasn't move when resizing [Taiga #1479](https://tree.taiga.io/project/penpot/issue/1479)
+- Fix titles in viewer thumbnails too long [Taiga #1474](https://tree.taiga.io/project/penpot/issue/1474)
+- Fix when right click on a selected text shows artboard contextual menu [Taiga #1226](https://tree.taiga.io/project/penpot/issue/1226)
+
+### :boom: Breaking changes
+
+- The LDAP configuration variables interpolation starts using `:`
+  (example `:username`) instead of `$`. The main reason is avoid
+  unnecesary conflict with bash interpolation.
+
+
+### :arrow_up: Deps updates
+
+- Update backend to JDK16.
+- Update exporter nodejs to v14.16.0
+
+
+### :heart: Community contributions by (Thank you!)
+
+- iblueer [#726](https://github.com/penpot/penpot/pull/726)
+- gizembln [#759](https://github.com/penpot/penpot/pull/759)
+- girafic [#748](https://github.com/penpot/penpot/pull/748)
+- mbrksntrk [#794](https://github.com/penpot/penpot/pull/794)
+
+
+## 1.3.0-alpha
+
+### :sparkles: New features
+
+- Add emailcatcher and ldap test containers to devenv. [#506](https://github.com/penpot/penpot/pull/506)
+- Add major refactor of internal pubsub/redis code; improves scalability and performance [#640](https://github.com/penpot/penpot/pull/640)
+- Add more chinese transtions [#687](https://github.com/penpot/penpot/pull/687)
+- Add more presets for artboard [#654](https://github.com/penpot/penpot/pull/654)
+- Add optional loki integration [#645](https://github.com/penpot/penpot/pull/645)
+- Add proper http session lifecycle handling.
+- Allow to set border radius of each rect corner individually
+- Bounce & Complaint handling [#635](https://github.com/penpot/penpot/pull/635)
+- Disable groups interactions when holding "Ctrl" key (deep selection)
+- New action in context menu to "edit" some shapes (binded to key "Enter")
+
+
+### :bug: Bugs fixed
+
+- Add more improvements to french translation strings [#591](https://github.com/penpot/penpot/pull/591)
+- Add some missing database indexes (mainly improves performance on large databases on file-update rpc method, and some background tasks).
+- Disables filters in masking elements (issue with Firefox rendering)
+- Drawing tool will have priority over resize/rotate handlers [Taiga #1225](https://tree.taiga.io/project/penpot/issue/1225)
+- Fix broken bounding box on editing paths [Taiga #1254](https://tree.taiga.io/project/penpot/issue/1254)
+- Fix corner cases on invitation/signup flows.
+- Fix errors on onboarding file [Taiga #1287](https://tree.taiga.io/project/penpot/issue/1287)
+- Fix infinite recursion on logout.
+- Fix issues with frame selection [Taiga #1300](https://tree.taiga.io/project/penpot/issue/1300), [Taiga #1255](https://tree.taiga.io/project/penpot/issue/1255)
+- Fix local fonts error [#691](https://github.com/penpot/penpot/issues/691)
+- Fix issue width handoff code generation [Taiga #1204](https://tree.taiga.io/project/penpot/issue/1204)
+- Fix issue with indices refreshing on page changes [#646](https://github.com/penpot/penpot/issues/646)
+- Have language change notification written in the new language [Taiga #1205](https://tree.taiga.io/project/penpot/issue/1205)
+- Hide register screen when registration is disabled [#598](https://github.com/penpot/penpot/issues/598)
+- Properly handle errors on github, gitlab and ldap auth backends.
+- Properly mark profile auth backend (on first register/ auth with 3rd party auth provider).
+- Refactor LDAP auth backend.
+
+
+### :heart: Community contributions by (Thank you!)
+
+- girafic [#538](https://github.com/penpot/penpot/pull/654)
+- arkhi [#591](https://github.com/penpot/penpot/pull/591)
 
 
 ## 1.2.0-alpha
 
-### New features
+### :sparkles: New features
 
 - Add horizontal/vertical flip
 - Add images lock proportions by default [#541](https://github.com/penpot/penpot/discussions/541), [#609](https://github.com/penpot/penpot/issues/609)
@@ -22,27 +236,27 @@
 - Fix behavior of select all command when there are objects outside frames [Taiga #1209](https://tree.taiga.io/project/penpot/issue/1209)
 
 
-### Bugs fixed
+### :bug: Bugs fixed
 
 - Fix 404 when access shared link [#615](https://github.com/penpot/penpot/issues/615)
 - Fix 500 when requestion password reset
-- Fix Problems when transforming path shapes [Taiga #1170](https://tree.taiga.io/project/penpot/issue/1170)
+- Fix issue when transforming path shapes [Taiga #1170](https://tree.taiga.io/project/penpot/issue/1170)
 - Fix apply a color to a text selection from color palette was not working [Taiga #1189](https://tree.taiga.io/project/penpot/issue/1189)
 - Fix issues when moving shapes outside groups [Taiga #1138](https://tree.taiga.io/project/penpot/issue/1138)
 - Fix ldap function called on login click
 - Fix logo icon in viewer should go to dashboard [Taiga #1149](https://tree.taiga.io/project/penpot/issue/1149)
 - Fix ordering when restoring deleted shapes in sync [Taiga #1163](https://tree.taiga.io/project/penpot/issue/1163)
-- Fix problem when editing text immediately after creating [Taiga #1207](https://tree.taiga.io/project/penpot/issue/1207)
-- Fix problem when pasting URL's copied from the browser url bar [Taiga #1187](https://tree.taiga.io/project/penpot/issue/1187)
-- Fix problem with multiple selection and groups [Taiga #1128](https://tree.taiga.io/project/penpot/issue/1128)
-- Fix problem with red handler indicator on resize [Taiga #1188](https://tree.taiga.io/project/penpot/issue/1188)
+- Fix issue when editing text immediately after creating [Taiga #1207](https://tree.taiga.io/project/penpot/issue/1207)
+- Fix issue when pasting URL's copied from the browser url bar [Taiga #1187](https://tree.taiga.io/project/penpot/issue/1187)
+- Fix issue with multiple selection and groups [Taiga #1128](https://tree.taiga.io/project/penpot/issue/1128)
+- Fix issue with red handler indicator on resize [Taiga #1188](https://tree.taiga.io/project/penpot/issue/1188)
 - Fix show correct error when google auth is disabled [Taiga #1119](https://tree.taiga.io/project/penpot/issue/1119)
 - Fix text alignment in preview [#594](https://github.com/penpot/penpot/issues/594)
 - Fix unexpected exception when uploading image [Taiga #1120](https://tree.taiga.io/project/penpot/issue/1120)
 - Fix updates on collaborative editing not updating selection rectangles [Taiga #1127](https://tree.taiga.io/project/penpot/issue/1127)
 - Make the team deletion deferred (in the same way other objects)
 
-### Community contributions by (Thank you! :heart:)
+### :heart: Community contributions by (Thank you!)
 
 - abtinmo [#538](https://github.com/penpot/penpot/pull/538)
 - kdrag0n [#585](https://github.com/penpot/penpot/pull/585)

README.md

@@ -5,31 +5,19 @@
 [![License: MPL-2.0][uri_license_image]][uri_license]
 [![Gitter](https://badges.gitter.im/sereno-xyz/community.svg)](https://gitter.im/penpot/community)
 [![Managed with Taiga.io](https://img.shields.io/badge/managed%20with-TAIGA.io-709f14.svg)](https://tree.taiga.io/project/penpot/ "Managed with Taiga.io")
+[![Gitpod ready-to-code](https://img.shields.io/badge/Gitpod-ready--to--code-blue?logo=gitpod)](https://gitpod.io/#https://github.com/penpot/penpot)
 
 
 # PENPOT #
 
-We’re excited to share that Uxbox is now Penpot! We’re changing the name, but keeping the same project essence. Stay in the loop for more news coming early 2021. Alpha release is close!
+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.
 
-![PENPOT](https://raw.githubusercontent.com/penpot/penpot/develop/docs/screenshot.png)
+![PENPOT](https://penpot.app/images/workspace-ui.jpg)
 
 
-## Introduction ##
-
-The open-source solution for design and prototyping. PENPOT is
-currently at an early development stage but we are working hard to
-bring you the beta version as soon as possible. Follow the project
-progress in Twitter or Github and stay tuned!
-
-
-## SVG based ##
-
-Penpot works with SVG, a standard format, for all your designs and
-prototypes . This means that all your stuff in Penpot is portable and
-editable in many other vector tools and easy to use on the web.
-
-[See SVG specification](https://www.w3.org/Graphics/SVG/)
-
 ## Contributing ##
 
 **Open to you!**
@@ -43,7 +31,7 @@ Please refer to the [Contributing Guide](./CONTRIBUTING.md)
 
 ## Documentation ##
 
-Please refer to [docs/ directory](./docs/).
+Please refer to the [help center](https://help.penpot.app).
 
 
 ## License ##
@@ -52,4 +40,6 @@ Please refer to [docs/ directory](./docs/).
 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
 ```

backend/deps.edn

@@ -3,24 +3,28 @@
   "clojars" {:url "https://clojars.org/repo"}
   "jcenter" {:url "https://jcenter.bintray.com/"}}
  :deps
- {org.clojure/clojure {:mvn/version "1.10.2"}
-  org.clojure/clojurescript {:mvn/version "1.10.773"}
-  org.clojure/data.json {:mvn/version "1.0.0"}
+ {org.clojure/clojure {:mvn/version "1.10.3"}
+  org.clojure/data.json {:mvn/version "2.2.1"}
   org.clojure/core.async {:mvn/version "1.3.610"}
+  org.clojure/tools.cli {:mvn/version "1.0.206"}
+  org.clojure/clojurescript {:mvn/version "1.10.844"}
 
   ;; Logging
   org.clojure/tools.logging {:mvn/version "1.1.0"}
-  org.apache.logging.log4j/log4j-api {:mvn/version "2.14.0"}
-  org.apache.logging.log4j/log4j-core {:mvn/version "2.14.0"}
-  org.apache.logging.log4j/log4j-web {:mvn/version "2.14.0"}
-  org.apache.logging.log4j/log4j-jul {:mvn/version "2.14.0"}
-  org.apache.logging.log4j/log4j-slf4j-impl {:mvn/version "2.14.0"}
-  org.slf4j/slf4j-api {:mvn/version "1.7.30"}
+  org.apache.logging.log4j/log4j-api {:mvn/version "2.14.1"}
+  org.apache.logging.log4j/log4j-core {:mvn/version "2.14.1"}
+  org.apache.logging.log4j/log4j-web {:mvn/version "2.14.1"}
+  org.apache.logging.log4j/log4j-jul {:mvn/version "2.14.1"}
+  org.apache.logging.log4j/log4j-slf4j18-impl {:mvn/version "2.14.1"}
+  org.slf4j/slf4j-api {:mvn/version "2.0.0-alpha1"}
+  org.zeromq/jeromq {:mvn/version "0.5.2"}
 
-  org.graalvm.js/js {:mvn/version "20.3.0"}
   com.taoensso/nippy {:mvn/version "3.1.1"}
-  com.github.luben/zstd-jni {:mvn/version "1.4.8-3"}
+  com.github.luben/zstd-jni {:mvn/version "1.4.9-5"}
 
+  ;; NOTE: don't upgrade to latest version, breaking change is
+  ;; introduced on 0.10.0 that suffixes counters with _total if they
+  ;; are not already has this suffix.
   io.prometheus/simpleclient {:mvn/version "0.9.0"}
   io.prometheus/simpleclient_hotspot {:mvn/version "0.9.0"}
   io.prometheus/simpleclient_jetty {:mvn/version "0.9.0"
@@ -29,21 +33,20 @@
   io.prometheus/simpleclient_httpserver {:mvn/version "0.9.0"}
 
   selmer/selmer {:mvn/version "1.12.33"}
-  expound/expound {:mvn/version "0.8.7"}
+  expound/expound {:mvn/version "0.8.9"}
   com.cognitect/transit-clj {:mvn/version "1.0.324"}
 
-  io.lettuce/lettuce-core {:mvn/version "5.2.2.RELEASE"}
-  java-http-clj/java-http-clj {:mvn/version "0.4.1"}
+  io.lettuce/lettuce-core {:mvn/version "6.1.1.RELEASE"}
+  java-http-clj/java-http-clj {:mvn/version "0.4.2"}
 
-  info.sunng/ring-jetty9-adapter {:mvn/version "0.14.2"}
-  seancorfield/next.jdbc {:mvn/version "1.1.613"}
-  metosin/reitit-ring {:mvn/version "0.5.11"}
+  info.sunng/ring-jetty9-adapter {:mvn/version "0.15.1"}
+  com.github.seancorfield/next.jdbc {:mvn/version "1.1.646"}
+  metosin/reitit-ring {:mvn/version "0.5.12"}
   metosin/jsonista {:mvn/version "0.3.1"}
 
-  org.postgresql/postgresql {:mvn/version "42.2.18"}
-  com.zaxxer/HikariCP {:mvn/version "3.4.5"}
+  org.postgresql/postgresql {:mvn/version "42.2.19"}
+  com.zaxxer/HikariCP {:mvn/version "4.0.3"}
 
-  funcool/log4j2-clojure {:mvn/version "2020.11.23-1"}
   funcool/datoteka {:mvn/version "1.2.0"}
   funcool/promesa {:mvn/version "6.0.0"}
   funcool/cuerdas {:mvn/version "2020.03.26-3"}
@@ -61,13 +64,12 @@
   org.im4java/im4java {:mvn/version "1.4.0"}
   org.lz4/lz4-java {:mvn/version "1.7.1"}
   commons-io/commons-io {:mvn/version "2.8.0"}
-  org.apache.commons/commons-pool2 {:mvn/version "2.9.0"}
-  com.sun.mail/jakarta.mail {:mvn/version "2.0.0"}
+  com.sun.mail/jakarta.mail {:mvn/version "2.0.1"}
 
-  puppetlabs/clj-ldap {:mvn/version"0.3.0"}
+  org.clojars.pntblnk/clj-ldap {:mvn/version "0.0.17"}
   integrant/integrant {:mvn/version "0.8.0"}
 
-  software.amazon.awssdk/s3 {:mvn/version "2.15.73"}
+  software.amazon.awssdk/s3 {:mvn/version "2.16.44"}
 
   ;; exception printing
   io.aviso/pretty {:mvn/version "0.1.37"}
@@ -90,11 +92,11 @@
    :args {}}
 
   :tests
-  {:extra-deps {lambdaisland/kaocha {:mvn/version "1.0.732"}}
+  {:extra-deps {lambdaisland/kaocha {:mvn/version "1.0.829"}}
    :main-opts ["-m" "kaocha.runner"]}
 
   :outdated
-  {:extra-deps {antq/antq {:mvn/version "RELEASE"}}
+  {:extra-deps {com.github.liquidz/antq {:mvn/version "RELEASE"}}
    :main-opts ["-m" "antq.core"]}
 
   :jmx-remote

backend/dev/user.clj

@@ -2,27 +2,24 @@
 ;; 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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2016-2020 Andrey Antukh <niwi@niwi.nz>
+;; Copyright (c) UXBOX Labs SL
 
 (ns user
   (:require
+   [app.common.exceptions :as ex]
    [app.config :as cfg]
    [app.main :as main]
+   [app.util.blob :as blob]
+   [app.util.json :as json]
    [app.util.time :as dt]
    [app.util.transit :as t]
-   [app.common.exceptions :as ex]
-   [taoensso.nippy :as nippy]
-   [clojure.data.json :as json]
    [clojure.java.io :as io]
-   [clojure.test :as test]
-   [clojure.pprint :refer [pprint]]
+   [clojure.pprint :refer [pprint print-table]]
    [clojure.repl :refer :all]
    [clojure.spec.alpha :as s]
    [clojure.spec.gen.alpha :as sgen]
    [clojure.test :as test]
+   [clojure.test :as test]
    [clojure.tools.namespace.repl :as repl]
    [clojure.walk :refer [macroexpand-all]]
    [criterium.core :refer [quick-bench bench with-progress-reporting]]
@@ -70,7 +67,7 @@
   []
   (alter-var-root #'system (fn [sys]
                              (when sys (ig/halt! sys))
-                             (-> (main/build-system-config cfg/config)
+                             (-> main/system-config
                                  (ig/prep)
                                  (ig/init))))
   :started)
@@ -91,3 +88,10 @@
   []
   (stop)
   (repl/refresh-all :after 'user/start))
+
+(defn compression-bench
+  [data]
+  (print-table
+   [{:v1 (alength (blob/encode data {:version 1}))
+     :v2 (alength (blob/encode data {:version 2}))
+     :v3 (alength (blob/encode data {:version 3}))}]))

backend/resources/builtin.edn

@@ -1,11 +0,0 @@
-{:icons
- [{:name "Material Design (Action)"
-   :path "./material/action/svg/production"
-   :regex #"^.*_48px\.svg$"}]
-
- :images
- [{:name "Generic Collection 1"
-   :path "./my-images/collection1/"
-   :regex #"^.*\.(png|jpg|webp)$"}]}
-
-

backend/resources/config/default.edn

@@ -1,44 +0,0 @@
-{;; A secret key used for create tokens
- ;; WARNING: this is a default secret key and
- ;; it should be overwritten in production env.
- :secret "5qjiAn-QUpawUNqGP10UZKklSqbLKcdGY3sJpq0UUACpVXGg2HOFJCBejDWVHskhRyp7iHb4rjOLXX2ZjF-5cw"
- 
- :registration
- {
-  :enabled true}
- 
- :smtp
- {:host "localhost" ;; Hostname of the desired SMTP server.
-  :port 25          ;; Port of SMTP server.
-  :user nil         ;; Username to authenticate with (if authenticating).
-  :pass nil         ;; Password to authenticate with (if authenticating).
-  :ssl false        ;; Enables SSL encryption if value is truthy.
-  :tls false        ;; Enables TLS encryption if value is truthy.
-  :enabled false    ;; Enables SMTP if value is truthy.
-  :noop true}
-
- :auth-options {:alg :a256kw :enc :a128cbc-hs256}
-
- :email {:reply-to "no-reply@uxbox.io"
-         :from "no-reply@uxbox.io"
-         :support "support@uxbox.io"}
-
- :http {:port 6060
-        :max-body-size 52428800
-        :debug true}
-
- :media
- {:directory "resources/public/media"
-  :uri "http://localhost:6060/media/"}
-
- :static
- {:directory "resources/public/static"
-  :uri "http://localhost:6060/static/"}
-
- :database
- {:adapter "postgresql"
-  :username nil
-  :password nil
-  :database-name "uxbox"
-  :server-name "localhost"
-  :port-number 5432}}

backend/resources/config/test.edn

@@ -1,18 +0,0 @@
-{:migrations
- {:verbose false}
-
- :media
- {:directory "/tmp/uxbox/media"
-  :uri "http://localhost:6060/media/"}
-
- :static
- {:directory "/tmp/uxbox/static"
-  :uri "http://localhost:6060/static/"}
-
- :database
- {:adapter "postgresql"
-  :username nil
-  :password nil
-  :database-name "test"
-  :server-name "localhost"
-  :port-number 5432}}

backend/resources/emails/feedback/en.html

@@ -0,0 +1,45 @@
+<!doctype html>
+<html xmlns="http://www.w3.org/1999/xhtml">
+  <head>
+    <title></title>
+    <meta http-equiv="X-UA-Compatible" content="IE=edge">
+    <meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
+  </head>
+  <body>
+    <p>
+      <strong>Feedback from:</strong><br />
+      {% if profile %}
+        <span>
+          <span>Name: </span>
+          <span><code>{{profile.fullname}}</code></span>
+        </span>
+        <br />
+
+        <span>
+          <span>Email: </span>
+          <span>{{profile.email}}</span>
+        </span>
+        <br />
+
+        <span>
+          <span>ID: </span>
+          <span><code>{{profile.id}}</code></span>
+        </span>
+      {% else %}
+        <span>
+          <span>Email: </span>
+          <span>{{profile.email}}</span>
+        </span>
+      {% endif %}
+    </p>
+    <p>
+      <strong>Subject:</strong><br />
+      <span>{{subject}}</span>
+    </p>
+
+    <p>
+      <strong>Message:</strong><br />
+      {{content|linebreaks-br|safe}}
+    </p>
+  </body>
+</html>

backend/resources/emails/feedback/en.subj

@@ -1 +1 @@
-[FEEDBACK]: From {{ profile.email }}
+[PENPOT FEEDBACK]: {{subject|abbreviate:19}} (from {{email}})

backend/resources/emails/feedback/en.txt

@@ -1,6 +1,8 @@
-Feedback from: {{profile.fullname}} <{{profile.email}}>
-
-Profile ID: {{profile.id}}
+{% if profile %}
+Feedback profile: {{profile.fullname}} <{{profile.email}}> / {{profile.id}}
+{% else %}
+Feedback from: {{email}}
+{% endif %}
 
 Subject: {{subject}}
 

backend/resources/emails/invite-to-team/en.subj

@@ -1 +1 @@
-Inviation to join {{team}}
+Invitation to join {{team}}

backend/resources/error-report.tmpl

@@ -31,7 +31,7 @@
 
       .table-key {
         font-weight: 600;
-        width: 70px;
+        width: 60px;
         padding: 4px;
       }
 
@@ -70,27 +70,43 @@
 
       {% if user-agent %}
       <div class="table-row">
-        <div class="table-key">UAGENT: </div>
+        <div class="table-key">UAGT: </div>
         <div class="table-val">{{user-agent}}</div>
       </div>
       {% endif %}
 
       {% if frontend-version %}
       <div class="table-row">
-        <div class="table-key">FVERS: </div>
+        <div class="table-key">FVER: </div>
         <div class="table-val">{{frontend-version}}</div>
       </div>
       {% endif %}
 
       <div class="table-row">
-        <div class="table-key">BVERS: </div>
+        <div class="table-key">BVER: </div>
         <div class="table-val">{{version}}</div>
       </div>
 
+      {% if host %}
       <div class="table-row">
         <div class="table-key">HOST: </div>
         <div class="table-val">{{host}}</div>
       </div>
+      {% endif %}
+
+      {% if tenant %}
+      <div class="table-row">
+        <div class="table-key">ENV: </div>
+        <div class="table-val">{{tenant}}</div>
+      </div>
+      {% endif %}
+
+      {% if public-uri %}
+      <div class="table-row">
+        <div class="table-key">PURI: </div>
+        <div class="table-val">{{public-uri}}</div>
+      </div>
+      {% endif %}
 
       {% if type %}
       <div class="table-row">
@@ -106,15 +122,19 @@
       </div>
       {% endif %}
 
+      {% if error %}
       <div class="table-row">
-        <div class="table-key">CLASS: </div>
-        <div class="table-val">{{class}}</div>
+        <div class="table-key">CLSS: </div>
+        <div class="table-val">{{error.class}}</div>
       </div>
+      {% endif %}
 
+      {% if error %}
       <div class="table-row">
         <div class="table-key">HINT: </div>
-        <div class="table-val">{{hint}}</div>
+        <div class="table-val">{{error.message}}</div>
       </div>
+      {% endif %}
 
       {% if method %}
       <div class="table-row">
@@ -123,8 +143,18 @@
       </div>
       {% endif %}
 
+      {% if explain %}
+        <div>(<a href="#explain">go to explain</a>)</div>
+      {% endif %}
+      {% if data %}
+        <div>(<a href="#edata">go to edata</a>)</div>
+      {% endif %}
+      {% if error %}
+        <div>(<a href="#trace">go to trace</a>)</div>
+      {% endif %}
+
       {% if params %}
-      <div class="table-row multiline">
+      <div id="params" class="table-row multiline">
         <div class="table-key">PARAMS: </div>
         <div class="table-val">
           <pre>{{params}}</pre>
@@ -133,7 +163,7 @@
       {% endif %}
 
       {% if explain %}
-      <div class="table-row multiline">
+      <div id="explain" class="table-row multiline">
         <div class="table-key">EXPLAIN: </div>
         <div class="table-val">
           <pre>{{explain}}</pre>
@@ -142,7 +172,7 @@
       {% endif %}
 
       {% if data %}
-      <div class="table-row multiline">
+      <div id="edata" class="table-row multiline">
         <div class="table-key">EDATA: </div>
         <div class="table-val">
           <pre>{{data}}</pre>
@@ -150,12 +180,14 @@
       </div>
       {% endif %}
 
-      <div class="table-row multiline">
+      {% if error %}
+      <div id="trace" class="table-row multiline">
         <div class="table-key">TRACE:</div>
         <div class="table-val">
-          <pre>{{message}}</pre>
+          <pre>{{error.trace}}</pre>
         </div>
       </div>
+      {% endif %}
     </div>
   </body>
 </html>

backend/resources/log4j2-bundle.xml

@@ -1,26 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<Configuration status="info" monitorInterval="60">
-  <Appenders>
-    <Console name="console" target="SYSTEM_OUT">
-      <PatternLayout pattern="[%t] %level{length=1} %logger{36} - %msg%n"/>
-    </Console>
-  </Appenders>
-
-  <Loggers>
-    <Logger name="com.zaxxer.hikari" level="error" additivity="false">
-      <AppenderRef ref="console"/>
-    </Logger>
-
-    <Logger name="org.eclipse.jetty" level="info" additivity="false">
-      <AppenderRef ref="console"/>
-    </Logger>
-
-    <Logger name="app" level="debug" additivity="false">
-      <AppenderRef ref="console"/>
-    </Logger>
-
-    <Root level="info">
-      <AppenderRef ref="console"/>
-    </Root>
-  </Loggers>
-</Configuration>

backend/resources/log4j2-devenv.xml

@@ -0,0 +1,47 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<Configuration status="info" monitorInterval="30">
+  <Appenders>
+    <Console name="console" target="SYSTEM_OUT">
+      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] [%t] %level{length=1} %logger{36} - %msg%n"/>
+    </Console>
+
+    <RollingFile name="main" fileName="logs/main.log" filePattern="logs/main-%i.log">
+      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"/>
+      <Policies>
+        <SizeBasedTriggeringPolicy size="50M"/>
+      </Policies>
+      <DefaultRolloverStrategy max="9"/>
+    </RollingFile>
+  </Appenders>
+
+  <Loggers>
+    <Logger name="com.zaxxer.hikari" level="error"/>
+    <Logger name="io.lettuce" level="error" />
+    <Logger name="org.eclipse.jetty" level="error" />
+    <Logger name="org.postgresql" level="error" />
+
+    <Logger name="app.cli" level="debug" additivity="false">
+      <AppenderRef ref="console"/>
+    </Logger>
+
+    <Logger name="app.loggers" level="debug" additivity="false">
+      <AppenderRef ref="main" level="debug" />
+    </Logger>
+
+    <Logger name="app" level="all" additivity="false">
+      <AppenderRef ref="main" level="trace" />
+    </Logger>
+
+    <Logger name="penpot" level="fatal" additivity="false">
+      <AppenderRef ref="main" level="fatal" />
+    </Logger>
+
+    <Logger name="user" level="trace" additivity="false">
+      <AppenderRef ref="main" level="trace" />
+    </Logger>
+
+    <Root level="info">
+      <AppenderRef ref="main" />
+    </Root>
+  </Loggers>
+</Configuration>

backend/resources/log4j2.xml

@@ -1,43 +1,25 @@
 <?xml version="1.0" encoding="UTF-8"?>
-<Configuration status="info" monitorInterval="30">
+<Configuration status="info" monitorInterval="60">
   <Appenders>
     <Console name="console" target="SYSTEM_OUT">
       <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] [%t] %level{length=1} %logger{36} - %msg%n"/>
     </Console>
-
-    <RollingFile name="main" fileName="logs/main.log" filePattern="logs/main-%i.log">
-      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] [%t] %level{length=1} %logger{36} - %msg%n"/>
-      <Policies>
-        <SizeBasedTriggeringPolicy size="50M"/>
-      </Policies>
-      <DefaultRolloverStrategy max="9"/>
-    </RollingFile>
-
-    <CljFn name="error-reporter" ns="app.error-reporter" fn="queue-fn">
-      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] [%t] %level{length=1} %logger{36} - %msg%n"/>
-    </CljFn>
   </Appenders>
 
   <Loggers>
-    <Logger name="com.zaxxer.hikari" level="error" additivity="false" />
-    <Logger name="org.eclipse.jetty" level="error" additivity="false" />
-    <Logger name="io.lettuce" level="error" additivity="false" />
-
-    <Logger name="app.cli" level="debug" additivity="false">
-      <AppenderRef ref="console"/>
-    </Logger>
-
-    <Logger name="app.error-reporter" level="debug" additivity="false">
-      <AppenderRef ref="main" level="debug" />
-    </Logger>
+    <Logger name="com.zaxxer.hikari" level="error" />
+    <Logger name="org.eclipse.jetty" level="error" />
 
     <Logger name="app" level="debug" additivity="false">
-      <AppenderRef ref="main" level="debug" />
-      <AppenderRef ref="error-reporter" level="error" />
+      <AppenderRef ref="console" />
+    </Logger>
+
+    <Logger name="penpot" level="fatal" additivity="false">
+      <AppenderRef ref="console" />
     </Logger>
 
     <Root level="info">
-      <AppenderRef ref="main" />
+      <AppenderRef ref="console" />
     </Root>
   </Loggers>
 </Configuration>

backend/scripts/build

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

backend/scripts/build.sh

@@ -1,55 +0,0 @@
-#!/usr/bin/env bash
-
-CLASSPATH=`(clojure -Spath)`
-NEWCP="./main:./common"
-
-rm -rf ./target/dist
-mkdir -p ./target/dist/deps
-
-for item in $(echo $CLASSPATH | tr ":" "\n"); do
-    if [ "${item: -4}" == ".jar" ]; then
-        cp $item ./target/dist/deps/;
-        BN="$(basename -- $item)"
-        NEWCP+=":./deps/$BN"
-    fi
-done
-
-cp ./resources/log4j2-bundle.xml ./target/dist/log4j2.xml
-cp -r ./src ./target/dist/main
-cp -r ./resources/emails ./target/dist/main/
-cp -r ./resources/svgclean.js ./target/dist/main/
-cp -r ./resources/error-report.tmpl ./target/dist/main/
-cp -r ../common ./target/dist/common
-
-echo $NEWCP > ./target/dist/classpath;
-
-tee -a ./target/dist/run.sh  >> /dev/null <<EOF
-#!/usr/bin/env bash
-
-CP="$NEWCP"
-
-# Exports
-
-# Find java executable
-set +e
-JAVA_CMD=\$(type -p java)
-
-set -e
-if [[ ! -n "\$JAVA_CMD" ]]; then
-  if [[ -n "\$JAVA_HOME" ]] && [[ -x "\$JAVA_HOME/bin/java" ]]; then
-    JAVA_CMD="\$JAVA_HOME/bin/java"
-  else
-    >&2 echo "Couldn't find 'java'. Please set JAVA_HOME."
-    exit 1
-  fi
-fi
-
-if [ -f ./environ ]; then
-   source ./environ
-fi
-
-set -x
-exec \$JAVA_CMD \$JVM_OPTS -classpath \$CP -Dlog4j.configurationFile=./log4j2.xml "\$@" clojure.main -m app.main
-EOF
-
-chmod +x ./target/dist/run.sh

backend/scripts/import-generic-collections.sh

@@ -1,4 +0,0 @@
-#!/usr/bin/env bash
-
-clojure -Adev -m app.cli.collimp $@
-

backend/scripts/manage.template.sh

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

backend/scripts/prepare-release.sh

@@ -1,16 +0,0 @@
-#!/usr/bin/env bash
-
-if [ "$#" -e 0 ]; then
-    echo "Expecting parameters: 1=path to backend; 2=destination directory"
-    exit 1
-fi
-
-rm -rf $2 || exit 1;
-
-rsync -avr \
-      --exclude="/test" \
-      --exclude="/resources/public/media" \
-      --exclude="/target" \
-      --exclude="/scripts" \
-      --exclude="/.*" \
-      $1 $2;

backend/scripts/psql.sh

@@ -1,2 +0,0 @@
-#!/usr/bin/env bash
-PGPASSWORD=$PENPOT_DATABASE_PASSWORD psql $PENPOT_DATABASE_URI -U $PENPOT_DATABASE_USERNAME

backend/scripts/repl

@@ -2,6 +2,10 @@
 
 export PENPOT_ASSERTS_ENABLED=true
 
+export OPTIONS="-A:jmx-remote:dev -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager -J-Xms512m -J-Xmx512m -J-Dlog4j2.configurationFile=log4j2-devenv.xml"
+
+export OPTIONS_EVAL="nil"
+# export OPTIONS_EVAL="(set! *warn-on-reflection* true)"
+
 set -ex
-# clojure -Ojmx-remote -A:dev -e "(set! *warn-on-reflection* true)" -m rebel-readline.main
-clojure -A:jmx-remote:dev -J-Xms512m -J-Xmx512m -M -m rebel-readline.main
+exec clojure $OPTIONS -M -e "$OPTIONS_EVAL" -m rebel-readline.main

backend/scripts/run-tests-in-docker.sh

@@ -1,4 +0,0 @@
-#!/usr/bin/env bash
-
-set -xe
-clojure -Adev -m app.tests.main;

backend/scripts/run.template.sh

@@ -0,0 +1,20 @@
+#!/usr/bin/env bash
+set +e
+JAVA_CMD=$(type -p java)
+
+set -e
+if [[ ! -n "$JAVA_CMD" ]]; then
+  if [[ -n "$JAVA_HOME" ]] && [[ -x "$JAVA_HOME/bin/java" ]]; then
+    JAVA_CMD="$JAVA_HOME/bin/java"
+  else
+    >&2 echo "Couldn't find 'java'. Please set JAVA_HOME."
+    exit 1
+  fi
+fi
+
+if [ -f ./environ ]; then
+   source ./environ
+fi
+
+set -x
+exec $JAVA_CMD $JVM_OPTS -classpath "$(cat classpath)" -Dlog4j2.configurationFile=./log4j2.xml "$@" clojure.main -m app.main

backend/scripts/smtpd.sh

@@ -1,2 +0,0 @@
-#!/usr/bin/env bash
-python -m smtpd -n -c DebuggingServer localhost:25

backend/scripts/tests.sh

@@ -1,2 +0,0 @@
-#!/usr/bin/env sh
-exec clojure -M:dev:tests "$@"

backend/src/app/cli/fixtures.clj

@@ -2,23 +2,19 @@
 ;; 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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.cli.fixtures
   "A initial fixtures."
   (:require
    [app.common.pages :as cp]
    [app.common.uuid :as uuid]
-   [app.config :as cfg]
    [app.db :as db]
    [app.main :as main]
    [app.rpc.mutations.profile :as profile]
    [app.util.blob :as blob]
+   [app.util.logging :as l]
    [buddy.hashers :as hashers]
-   [clojure.tools.logging :as log]
    [integrant.core :as ig]))
 
 (defn- mk-uuid
@@ -75,13 +71,15 @@
   (let [rng (java.util.Random. 1)]
     (letfn [(create-profile [conn index]
               (let [id   (mk-uuid "profile" index)
-                    _    (log/info "create profile" index id)
+                    _    (l/info :action "create profile"
+                                 :index index
+                                 :id id)
 
                     prof (register-profile conn
                                            {:id id
                                             :fullname (str "Profile " index)
                                             :password "123123"
-                                            :demo? true
+                                            :is-demo true
                                             :email (str "profile" index "@example.com")})
                     team-id  (:default-team-id prof)
                     owner-id id]
@@ -91,20 +89,22 @@
                 prof))
 
             (create-profiles [conn]
-              (log/info "create profiles")
+              (l/info :action "create profiles")
               (collect (partial create-profile conn)
                        (range (:num-profiles opts))))
 
             (create-team [conn index]
               (let [id (mk-uuid "team" index)
                     name (str "Team" index)]
-                (log/info "create team" index id)
+                (l/info :action "create team"
+                        :index index
+                        :id id)
                 (db/insert! conn :team {:id id
                                         :name name})
                 id))
 
             (create-teams [conn]
-              (log/info "create teams")
+              (l/info :action "create teams")
               (collect (partial create-team conn)
                        (range (:num-teams opts))))
 
@@ -112,7 +112,9 @@
               (let [id (mk-uuid "file" project-id index)
                     name (str "file" index)
                     data (cp/make-file-data id)]
-                (log/info "create file" index id)
+                (l/info :action "create file"
+                        :index index
+                        :id id)
                 (db/insert! conn :file
                             {:id id
                              :data (blob/encode data)
@@ -127,17 +129,25 @@
                 id))
 
             (create-files [conn owner-id project-id]
-              (log/info "create files")
+              (l/info :action "create files")
               (run! (partial create-file conn owner-id project-id)
                     (range (:num-files-per-project opts))))
 
             (create-project [conn team-id owner-id index]
-              (let [id (mk-uuid "project" team-id index)
-                    name (str "project " index)]
-                (log/info "create project" index id)
+              (let [id        (if index
+                                (mk-uuid "project" team-id index)
+                                (mk-uuid "project" team-id))
+                    name      (if index
+                                (str "project " index)
+                                "Drafts")
+                    is-default (nil? index)]
+                (l/info :action "create project"
+                        :index index
+                        :id id)
                 (db/insert! conn :project
                             {:id id
                              :team-id team-id
+                             :is-default is-default
                              :name name})
                 (db/insert! conn :project-profile-rel
                             {:project-id id
@@ -148,10 +158,12 @@
                 id))
 
             (create-projects [conn team-id profile-ids]
-              (log/info "create projects")
+              (l/info :action "create projects")
               (let [owner-id (rng-nth rng profile-ids)
-                    project-ids (collect (partial create-project conn team-id owner-id)
-                                         (range (:num-projects-per-team opts)))]
+                    project-ids (conj
+                                  (collect (partial create-project conn team-id owner-id)
+                                         (range (:num-projects-per-team opts)))
+                                  (create-project conn team-id owner-id nil))]
                 (run! (partial create-files conn owner-id) project-ids)))
 
             (assign-profile-to-team [conn team-id owner? profile-id]
@@ -163,14 +175,16 @@
                            :can-edit true}))
 
             (setup-team [conn team-id profile-ids]
-              (log/info "setup team" team-id profile-ids)
+              (l/info :action "setup team"
+                      :team-id team-id
+                      :profile-ids (pr-str profile-ids))
               (assign-profile-to-team conn team-id true (first profile-ids))
               (run! (partial assign-profile-to-team conn team-id false)
                     (rest profile-ids))
               (create-projects conn team-id profile-ids))
 
             (assign-teams-and-profiles [conn teams profiles]
-              (log/info "assign teams and profiles")
+              (l/info :action "assign teams and profiles")
               (loop [team-id (first teams)
                      teams (rest teams)]
                 (when-not (nil? team-id)
@@ -187,7 +201,9 @@
                     project-id (:default-project-id owner)
                     data       (cp/make-file-data id)]
 
-                (log/info "create draft file" index id)
+                (l/info :action "create draft file"
+                        :index index
+                        :id id)
                 (db/insert! conn :file
                             {:id id
                              :data (blob/encode data)
@@ -225,7 +241,7 @@
 
 (defn run
   [{:keys [preset] :or {preset :small}}]
-  (let [config (select-keys (main/build-system-config cfg/config)
+  (let [config (select-keys main/system-config
                             [:app.db/pool
                              :app.telemetry/migrations
                              :app.migrations/migrations
@@ -237,6 +253,6 @@
     (try
       (run-in-system system preset)
       (catch Exception e
-        (log/errorf e "Unhandled exception."))
+        (l/error :hint "unhandled exception" :cause e))
       (finally
         (ig/halt! system)))))

backend/src/app/cli/manage.clj

@@ -0,0 +1,169 @@
+;; 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.cli.manage
+  "A manage cli api."
+  (:require
+   [app.db :as db]
+   [app.main :as main]
+   [app.rpc.mutations.profile :as profile]
+   [app.rpc.queries.profile :refer [retrieve-profile-data-by-email]]
+   [app.util.logging :as l]
+   [clojure.string :as str]
+   [clojure.tools.cli :refer [parse-opts]]
+   [integrant.core :as ig])
+  (:import
+   java.io.Console))
+
+;; --- IMPL
+
+(defn init-system
+  []
+  (let [data (-> main/system-config
+                 (select-keys [:app.db/pool :app.metrics/metrics])
+                 (assoc :app.migrations/all {}))]
+    (-> data ig/prep ig/init)))
+
+(defn- read-from-console
+  [{:keys [label type] :or {type :text}}]
+  (let [^Console console (System/console)]
+    (when-not console
+      (l/error :hint "no console found, can proceed")
+      (System/exit 1))
+
+    (binding [*out* (.writer console)]
+      (print label " ")
+      (.flush *out*))
+
+    (case type
+      :text (.readLine console)
+      :password (String. (.readPassword console)))))
+
+(defn create-profile
+  [options]
+  (let [system   (init-system)
+        email    (or (:email options)
+                     (read-from-console {:label "Email:"}))
+        fullname (or (:fullname options)
+                     (read-from-console {:label "Full Name:"}))
+        password (or (:password options)
+                     (read-from-console {:label "Password:"
+                                         :type :password}))]
+    (try
+      (db/with-atomic [conn (:app.db/pool system)]
+        (->> (profile/create-profile conn
+                                     {:fullname fullname
+                                      :email email
+                                      :password password
+                                      :is-active true
+                                      :is-demo false})
+             (profile/create-profile-relations conn)))
+
+      (when (pos? (:verbosity options))
+        (println "User created successfully."))
+      (System/exit 0)
+
+      (catch Exception _e
+        (when (pos? (:verbosity options))
+          (println "Unable to create user, already exists."))
+        (System/exit 1)))))
+
+(defn reset-password
+  [options]
+  (let [system (init-system)]
+    (try
+      (db/with-atomic [conn (:app.db/pool system)]
+        (let [email    (or (:email options)
+                           (read-from-console {:label "Email:"}))
+              profile  (retrieve-profile-data-by-email conn email)]
+          (when-not profile
+            (when (pos? (:verbosity options))
+              (println "Profile does not exists."))
+            (System/exit 1))
+
+          (let [password (or (:password options)
+                             (read-from-console {:label "Password:"
+                                                 :type :password}))]
+            (profile/update-profile-password! conn (assoc profile :password password))
+            (when (pos? (:verbosity options))
+              (println "Password changed successfully.")))))
+      (System/exit 0)
+      (catch Exception e
+        (when (pos? (:verbosity options))
+          (println "Unable to change password."))
+        (when (= 2 (:verbosity options))
+          (.printStackTrace e))
+        (System/exit 1)))))
+
+;; --- CLI PARSE
+
+(def cli-options
+  ;; An option with a required argument
+  [["-u" "--email EMAIL" "Email Address"]
+   ["-p" "--password PASSWORD" "Password"]
+   ["-n" "--name FULLNAME" "Full Name"
+    :id :fullname]
+   ["-v" nil "Verbosity level"
+    :id :verbosity
+    :default 1
+    :update-fn inc]
+   ["-q" nil "Dont' print to console"
+    :id :verbosity
+    :update-fn (constantly 0)]
+   ["-h" "--help"]])
+
+(defn usage
+  [options-summary]
+  (->> ["Penpot CLI management."
+        ""
+        "Usage: manage [options] action"
+        ""
+        "Options:"
+        options-summary
+        ""
+        "Actions:"
+        "  create-profile    Create new profile."
+        "  reset-password    Reset profile password."
+        ""]
+       (str/join \newline)))
+
+(defn error-msg [errors]
+  (str "The following errors occurred while parsing your command:\n\n"
+       (str/join \newline errors)))
+
+(defn validate-args
+  "Validate command line arguments. Either return a map indicating the program
+  should exit (with a error message, and optional ok status), or a map
+  indicating the action the program should take and the options provided."
+  [args]
+  (let [{:keys [options arguments errors summary] :as opts} (parse-opts args cli-options)]
+    ;; (pp/pprint opts)
+    (cond
+      (:help options) ; help => exit OK with usage summary
+      {:exit-message (usage summary) :ok? true}
+
+      errors ; errors => exit with description of errors
+      {:exit-message (error-msg errors)}
+
+      ;; custom validation on arguments
+      :else
+      (let [action (first arguments)]
+        (if (#{"create-profile" "reset-password"} action)
+          {:action (first arguments) :options options}
+          {:exit-message (usage summary)})))))
+
+(defn exit [status msg]
+  (println msg)
+  (System/exit status))
+
+(defn -main
+  [& args]
+  (let [{:keys [action options exit-message ok?]} (validate-args args)]
+    (if exit-message
+      (exit (if ok? 0 1) exit-message)
+      (case action
+        "create-profile" (create-profile options)
+        "reset-password" (reset-password options)))))

backend/src/app/cli/migrate_media.clj

@@ -2,19 +2,16 @@
 ;; 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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.cli.migrate-media
   (:require
    [app.common.media :as cm]
-   [app.config :as cfg]
+   [app.config :as cf]
    [app.db :as db]
    [app.main :as main]
    [app.storage :as sto]
-   [clojure.tools.logging :as log]
+   [app.util.logging :as l]
    [cuerdas.core :as str]
    [datoteka.core :as fs]
    [integrant.core :as ig]))
@@ -34,7 +31,7 @@
 
 (defn run
   []
-  (let [config (select-keys (main/build-system-config cfg/config)
+  (let [config (select-keys main/system-config
                             [:app.db/pool
                              :app.migrations/migrations
                              :app.metrics/metrics
@@ -49,7 +46,7 @@
           (run-in-system)
           (ig/halt!))
       (catch Exception e
-        (log/errorf e "Unhandled exception.")))))
+        (l/error :hint "unhandled exception" :cause e)))))
 
 
 ;; --- IMPL
@@ -60,7 +57,7 @@
             (->> (db/exec! conn ["select * from profile"])
                  (filter #(not (str/empty? (:photo %))))
                  (seq)))]
-    (let [base    (fs/path (:storage-fs-old-directory cfg/config))
+    (let [base    (fs/path (cf/get :storage-fs-old-directory))
           storage (-> (:app.storage/storage system)
                       (assoc :conn conn))]
       (doseq [profile (retrieve-profiles conn)]
@@ -81,7 +78,7 @@
             (->> (db/exec! conn ["select * from team"])
                  (filter #(not (str/empty? (:photo %))))
                  (seq)))]
-    (let [base    (fs/path (:storage-fs-old-directory cfg/config))
+    (let [base    (fs/path (cf/get :storage-fs-old-directory))
           storage (-> (:app.storage/storage system)
                       (assoc :conn conn))]
       (doseq [team (retrieve-teams conn)]
@@ -105,7 +102,7 @@
                                     from file_media_object as fmo
                                     join file_media_thumbnail as fth on (fth.media_object_id = fmo.id)"])
                  (seq)))]
-    (let [base    (fs/path (:storage-fs-old-directory cfg/config))
+    (let [base    (fs/path (cf/get :storage-fs-old-directory))
           storage (-> (:app.storage/storage system)
                       (assoc :conn conn))]
       (doseq [mobj (retrieve-media-objects conn)]

backend/src/app/config.clj

@@ -2,41 +2,53 @@
 ;; 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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.config
   "A configuration management."
+  (:refer-clojure :exclude [get])
   (:require
    [app.common.spec :as us]
    [app.common.version :as v]
    [app.util.time :as dt]
+   [clojure.core :as c]
+   [clojure.java.io :as io]
+   [clojure.pprint :as pprint]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [environ.core :refer [env]]))
 
+(prefer-method print-method
+               clojure.lang.IRecord
+               clojure.lang.IDeref)
+
+(prefer-method pprint/simple-dispatch
+               clojure.lang.IPersistentMap
+               clojure.lang.IDeref)
+
 (def defaults
   {:http-server-port 6060
-
-   :database-uri "postgresql://127.0.0.1/penpot"
+   :host "devenv"
+   :tenant "dev"
+   :database-uri "postgresql://postgres/penpot"
    :database-username "penpot"
    :database-password "penpot"
 
    :default-blob-version 1
 
+   :loggers-zmq-uri "tcp://localhost:45556"
+
    :asserts-enabled false
 
    :public-uri "http://localhost:3449"
-   :redis-uri "redis://localhost/0"
+   :redis-uri "redis://redis/0"
 
    :srepl-host "127.0.0.1"
    :srepl-port 6062
 
    :storage-backend :fs
 
-   :storage-fs-directory "resources/public/assets"
+   :storage-fs-directory "assets"
    :storage-s3-region :eu-central-1
    :storage-s3-bucket "penpot-devenv-assets-pre"
 
@@ -52,6 +64,12 @@
    :smtp-default-reply-to "Penpot <no-reply@example.com>"
    :smtp-default-from "Penpot <no-reply@example.com>"
 
+   :profile-complaint-max-age (dt/duration {:days 7})
+   :profile-complaint-threshold 2
+
+   :profile-bounce-max-age (dt/duration {:days 7})
+   :profile-bounce-threshold 10
+
    :allow-demo-users true
    :registration-enabled true
    :registration-domain-whitelist ""
@@ -59,100 +77,96 @@
    :telemetry-enabled false
    :telemetry-uri "https://telemetry.penpot.app/"
 
-   ;; LDAP auth disabled by default. Set ldap-auth-host to enable
-   ;:ldap-auth-host "ldap.mysupercompany.com"
-   ;:ldap-auth-port 389
-   ;:ldap-bind-dn "cn=admin,dc=ldap,dc=mysupercompany,dc=com"
-   ;:ldap-bind-password "verysecure"
-   ;:ldap-auth-ssl false
-   ;:ldap-auth-starttls false
-   ;:ldap-auth-base-dn "ou=People,dc=ldap,dc=mysupercompany,dc=com"
+   :ldap-user-query "(|(uid=:username)(mail=:username))"
+   :ldap-attrs-username "uid"
+   :ldap-attrs-email "mail"
+   :ldap-attrs-fullname "cn"
+   :ldap-attrs-photo "jpegPhoto"
 
-   :ldap-auth-user-query "(|(uid=$username)(mail=$username))"
-   :ldap-auth-username-attribute "uid"
-   :ldap-auth-email-attribute "mail"
-   :ldap-auth-fullname-attribute "displayName"
-   :ldap-auth-avatar-attribute "jpegPhoto"
-
-   ;; :initial-data-file "resources/initial-data.json"
-   ;; :initial-data-project-name "Penpot Oboarding"
+   ;; a server prop key where initial project is stored.
+   :initial-project-skey "initial-project"
    })
 
-(s/def ::http-server-port ::us/integer)
-(s/def ::database-username (s/nilable ::us/string))
+(s/def ::allow-demo-users ::us/boolean)
+(s/def ::asserts-enabled ::us/boolean)
+(s/def ::assets-path ::us/string)
 (s/def ::database-password (s/nilable ::us/string))
 (s/def ::database-uri ::us/string)
-(s/def ::redis-uri ::us/string)
-
-
-(s/def ::storage-backend ::us/keyword)
-(s/def ::storage-fs-directory ::us/string)
-(s/def ::assets-path ::us/string)
-(s/def ::storage-s3-region ::us/keyword)
-(s/def ::storage-s3-bucket ::us/string)
-
-(s/def ::media-uri ::us/string)
-(s/def ::media-directory ::us/string)
-(s/def ::asserts-enabled ::us/boolean)
-
-(s/def ::feedback-enabled ::us/boolean)
-(s/def ::feedback-destination ::us/string)
-
+(s/def ::database-username (s/nilable ::us/string))
+(s/def ::default-blob-version ::us/integer)
 (s/def ::error-report-webhook ::us/string)
-
-(s/def ::smtp-enabled ::us/boolean)
-(s/def ::smtp-default-reply-to ::us/string)
-(s/def ::smtp-default-from ::us/string)
-(s/def ::smtp-host ::us/string)
-(s/def ::smtp-port ::us/integer)
-(s/def ::smtp-username (s/nilable ::us/string))
-(s/def ::smtp-password (s/nilable ::us/string))
-(s/def ::smtp-tls ::us/boolean)
-(s/def ::smtp-ssl ::us/boolean)
-(s/def ::allow-demo-users ::us/boolean)
-(s/def ::registration-enabled ::us/boolean)
-(s/def ::registration-domain-whitelist ::us/string)
-(s/def ::public-uri ::us/string)
-
-(s/def ::srepl-host ::us/string)
-(s/def ::srepl-port ::us/integer)
-
-(s/def ::rlimits-password ::us/integer)
-(s/def ::rlimits-image ::us/integer)
-
-(s/def ::google-client-id ::us/string)
-(s/def ::google-client-secret ::us/string)
-
-(s/def ::gitlab-client-id ::us/string)
-(s/def ::gitlab-client-secret ::us/string)
-(s/def ::gitlab-base-uri ::us/string)
-
+(s/def ::feedback-destination ::us/string)
+(s/def ::feedback-enabled ::us/boolean)
+(s/def ::feedback-token ::us/string)
 (s/def ::github-client-id ::us/string)
 (s/def ::github-client-secret ::us/string)
-
-(s/def ::ldap-auth-host ::us/string)
-(s/def ::ldap-auth-port ::us/integer)
+(s/def ::gitlab-base-uri ::us/string)
+(s/def ::gitlab-client-id ::us/string)
+(s/def ::gitlab-client-secret ::us/string)
+(s/def ::google-client-id ::us/string)
+(s/def ::google-client-secret ::us/string)
+(s/def ::oidc-client-id ::us/string)
+(s/def ::oidc-client-secret ::us/string)
+(s/def ::oidc-base-uri ::us/string)
+(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-str)
+(s/def ::oidc-roles ::us/set-of-str)
+(s/def ::oidc-roles-attr ::us/keyword)
+(s/def ::host ::us/string)
+(s/def ::http-server-port ::us/integer)
+(s/def ::http-session-idle-max-age ::dt/duration)
+(s/def ::http-session-updater-batch-max-age ::dt/duration)
+(s/def ::http-session-updater-batch-max-size ::us/integer)
+(s/def ::initial-project-skey ::us/string)
+(s/def ::ldap-attrs-email ::us/string)
+(s/def ::ldap-attrs-fullname ::us/string)
+(s/def ::ldap-attrs-photo ::us/string)
+(s/def ::ldap-attrs-username ::us/string)
+(s/def ::ldap-base-dn ::us/string)
 (s/def ::ldap-bind-dn ::us/string)
 (s/def ::ldap-bind-password ::us/string)
-(s/def ::ldap-auth-ssl ::us/boolean)
-(s/def ::ldap-auth-starttls ::us/boolean)
-(s/def ::ldap-auth-base-dn ::us/string)
-(s/def ::ldap-auth-user-query ::us/string)
-(s/def ::ldap-auth-username-attribute ::us/string)
-(s/def ::ldap-auth-email-attribute ::us/string)
-(s/def ::ldap-auth-fullname-attribute ::us/string)
-(s/def ::ldap-auth-avatar-attribute ::us/string)
-
+(s/def ::ldap-host ::us/string)
+(s/def ::ldap-port ::us/integer)
+(s/def ::ldap-ssl ::us/boolean)
+(s/def ::ldap-starttls ::us/boolean)
+(s/def ::ldap-user-query ::us/string)
+(s/def ::loggers-loki-uri ::us/string)
+(s/def ::loggers-zmq-uri ::us/string)
+(s/def ::media-directory ::us/string)
+(s/def ::media-uri ::us/string)
+(s/def ::profile-bounce-max-age ::dt/duration)
+(s/def ::profile-bounce-threshold ::us/integer)
+(s/def ::profile-complaint-max-age ::dt/duration)
+(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/string)
+(s/def ::registration-enabled ::us/boolean)
+(s/def ::rlimits-image ::us/integer)
+(s/def ::rlimits-password ::us/integer)
+(s/def ::smtp-default-from ::us/string)
+(s/def ::smtp-default-reply-to ::us/string)
+(s/def ::smtp-enabled ::us/boolean)
+(s/def ::smtp-host ::us/string)
+(s/def ::smtp-password (s/nilable ::us/string))
+(s/def ::smtp-port ::us/integer)
+(s/def ::smtp-ssl ::us/boolean)
+(s/def ::smtp-tls ::us/boolean)
+(s/def ::smtp-username (s/nilable ::us/string))
+(s/def ::srepl-host ::us/string)
+(s/def ::srepl-port ::us/integer)
+(s/def ::storage-backend ::us/keyword)
+(s/def ::storage-fs-directory ::us/string)
+(s/def ::storage-s3-bucket ::us/string)
+(s/def ::storage-s3-region ::us/keyword)
 (s/def ::telemetry-enabled ::us/boolean)
-(s/def ::telemetry-with-taiga ::us/boolean)
-(s/def ::telemetry-uri ::us/string)
 (s/def ::telemetry-server-enabled ::us/boolean)
 (s/def ::telemetry-server-port ::us/integer)
-
-(s/def ::initial-data-file ::us/string)
-(s/def ::initial-data-project-name ::us/string)
-
-(s/def ::default-blob-version ::us/integer)
+(s/def ::telemetry-uri ::us/string)
+(s/def ::telemetry-with-taiga ::us/boolean)
+(s/def ::tenant ::us/string)
 
 (s/def ::config
   (s/keys :opt-un [::allow-demo-users
@@ -162,8 +176,9 @@
                    ::database-username
                    ::default-blob-version
                    ::error-report-webhook
-                   ::feedback-enabled
                    ::feedback-destination
+                   ::feedback-enabled
+                   ::feedback-token
                    ::github-client-id
                    ::github-client-secret
                    ::gitlab-base-uri
@@ -171,25 +186,46 @@
                    ::gitlab-client-secret
                    ::google-client-id
                    ::google-client-secret
+                   ::oidc-client-id
+                   ::oidc-client-secret
+                   ::oidc-base-uri
+                   ::oidc-token-uri
+                   ::oidc-auth-uri
+                   ::oidc-user-uri
+                   ::oidc-scopes
+                   ::oidc-roles-attr
+                   ::oidc-roles
+                   ::host
                    ::http-server-port
-                   ::ldap-auth-avatar-attribute
-                   ::ldap-auth-base-dn
-                   ::ldap-auth-email-attribute
-                   ::ldap-auth-fullname-attribute
-                   ::ldap-auth-host
-                   ::ldap-auth-port
-                   ::ldap-auth-ssl
-                   ::ldap-auth-starttls
-                   ::ldap-auth-user-query
-                   ::ldap-auth-username-attribute
+                   ::http-session-idle-max-age
+                   ::http-session-updater-batch-max-age
+                   ::http-session-updater-batch-max-size
+                   ::initial-project-skey
+                   ::ldap-attrs-email
+                   ::ldap-attrs-fullname
+                   ::ldap-attrs-photo
+                   ::ldap-attrs-username
+                   ::ldap-base-dn
                    ::ldap-bind-dn
                    ::ldap-bind-password
+                   ::ldap-host
+                   ::ldap-port
+                   ::ldap-ssl
+                   ::ldap-starttls
+                   ::ldap-user-query
+                   ::local-assets-uri
+                   ::loggers-loki-uri
+                   ::loggers-zmq-uri
+                   ::profile-bounce-max-age
+                   ::profile-bounce-threshold
+                   ::profile-complaint-max-age
+                   ::profile-complaint-threshold
                    ::public-uri
                    ::redis-uri
                    ::registration-domain-whitelist
                    ::registration-enabled
-                   ::rlimits-password
                    ::rlimits-image
+                   ::rlimits-password
                    ::smtp-default-from
                    ::smtp-default-reply-to
                    ::smtp-enabled
@@ -199,51 +235,53 @@
                    ::smtp-ssl
                    ::smtp-tls
                    ::smtp-username
-                   ::storage-backend
-                   ::storage-fs-directory
                    ::srepl-host
                    ::srepl-port
-                   ::local-assets-uri
+                   ::storage-backend
+                   ::storage-fs-directory
                    ::storage-s3-bucket
                    ::storage-s3-region
                    ::telemetry-enabled
-                   ::telemetry-with-taiga
                    ::telemetry-server-enabled
                    ::telemetry-server-port
                    ::telemetry-uri
-                   ::initial-data-file
-                   ::initial-data-project-name]))
+                   ::telemetry-referer
+                   ::telemetry-with-taiga
+                   ::tenant]))
 
-(defn- env->config
-  [env]
-  (reduce-kv
-   (fn [acc k v]
-     (cond-> acc
-       (str/starts-with? (name k) "penpot-")
-       (assoc (keyword (subs (name k) 7)) v)
-
-       (str/starts-with? (name k) "app-")
-       (assoc (keyword (subs (name k) 4)) v)))
-   {}
-   env))
+(defn read-env
+  [prefix]
+  (let [prefix (str prefix "-")
+        len    (count prefix)]
+    (reduce-kv
+     (fn [acc k v]
+       (cond-> acc
+         (str/starts-with? (name k) prefix)
+         (assoc (keyword (subs (name k) len)) v)))
+     {}
+     env)))
 
 (defn- read-config
-  [env]
-  (->> (env->config env)
+  []
+  (->> (read-env "penpot")
        (merge defaults)
        (us/conform ::config)))
 
-(defn- read-test-config
-  [env]
-  (merge {:redis-uri "redis://redis/1"
-          :database-uri "postgresql://postgres/penpot_test"
-          :storage-fs-directory "/tmp/app/storage"
-          :migrations-verbose false}
-         (read-config env)))
-
-(def version (v/parse "%version%"))
-(def config (read-config env))
-(def test-config (read-test-config env))
+(def version (v/parse (or (some-> (io/resource "version.txt")
+                                  (slurp)
+                                  (str/trim))
+                          "%version%")))
+(def config (atom (read-config)))
 
 (def deletion-delay
   (dt/duration {:days 7}))
+
+(defn get
+  "A configuration getter. Helps code be more testable."
+  ([key]
+   (c/get @config key))
+  ([key default]
+   (c/get @config key default)))
+
+;; Set value for all new threads bindings.
+(alter-var-root #'*assert* (constantly (get :asserts-enabled)))

backend/src/app/db.clj

@@ -2,18 +2,18 @@
 ;; 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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.db
   (:require
+   [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.geom.point :as gpt]
    [app.common.spec :as us]
    [app.db.sql :as sql]
+   [app.metrics :as mtx]
    [app.util.json :as json]
+   [app.util.logging :as l]
    [app.util.migrations :as mg]
    [app.util.time :as dt]
    [app.util.transit :as t]
@@ -26,6 +26,7 @@
    com.zaxxer.hikari.HikariConfig
    com.zaxxer.hikari.HikariDataSource
    com.zaxxer.hikari.metrics.prometheus.PrometheusMetricsTrackerFactory
+   java.lang.AutoCloseable
    java.sql.Connection
    java.sql.Savepoint
    org.postgresql.PGConnection
@@ -43,36 +44,51 @@
 ;; Initialization
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(declare instrument-jdbc!)
+
+(s/def ::name keyword?)
 (s/def ::uri ::us/not-empty-string)
-(s/def ::name ::us/not-empty-string)
 (s/def ::min-pool-size ::us/integer)
 (s/def ::max-pool-size ::us/integer)
 (s/def ::migrations map?)
-(s/def ::metrics map?)
 
 (defmethod ig/pre-init-spec ::pool [_]
-  (s/keys :req-un [::uri ::name ::min-pool-size ::max-pool-size ::migrations]))
+  (s/keys :req-un [::uri ::name ::min-pool-size ::max-pool-size ::migrations ::mtx/metrics]))
 
 (defmethod ig/init-key ::pool
-  [_ {:keys [migrations] :as cfg}]
+  [_ {:keys [migrations metrics] :as cfg}]
+  (l/info :action "initialize connection pool"
+          :name (d/name (:name cfg))
+          :uri (:uri cfg))
+  (instrument-jdbc! (:registry metrics))
   (let [pool (create-pool cfg)]
     (when (seq migrations)
-      (with-open [conn (open pool)]
+      (with-open [conn ^AutoCloseable (open pool)]
         (mg/setup! conn)
-        (doseq [[mname steps] migrations]
-          (mg/migrate! conn {:name (name mname) :steps steps}))))
+        (doseq [[name steps] migrations]
+          (mg/migrate! conn {:name (d/name name) :steps steps}))))
     pool))
 
 (defmethod ig/halt-key! ::pool
   [_ pool]
   (.close ^HikariDataSource pool))
 
+(defn- instrument-jdbc!
+  [registry]
+  (mtx/instrument-vars!
+   [#'next.jdbc/execute-one!
+    #'next.jdbc/execute!]
+   {:registry registry
+    :type :counter
+    :name "database_query_total"
+    :help "An absolute counter of database queries."}))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; API & Impl
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (def initsql
-  (str "SET statement_timeout = 60000;\n"
+  (str "SET statement_timeout = 120000;\n"
        "SET idle_in_transaction_session_timeout = 120000;"))
 
 (defn- create-datasource-config
@@ -84,7 +100,7 @@
         mtf      (PrometheusMetricsTrackerFactory. (:registry metrics))]
     (doto config
       (.setJdbcUrl (str "jdbc:" dburi))
-      (.setPoolName (:name cfg "default"))
+      (.setPoolName (d/name (:name cfg)))
       (.setAutoCommit true)
       (.setReadOnly false)
       (.setConnectionTimeout 8000)  ;; 8seg
@@ -162,7 +178,7 @@
   [& args]
   `(jdbc/with-transaction ~@args))
 
-(defn open
+(defn ^Connection open
   [pool]
   (jdbc/get-connection pool))
 
@@ -184,11 +200,6 @@
               (sql/insert table params opts)
               (assoc opts :return-keys true))))
 
-(defn insert-multi!
-  [ds table param-list]
-  (doseq [params param-list]
-    (insert! ds table params)))
-
 (defn update!
   ([ds table params where] (update! ds table params where nil))
   ([ds table params where opts]
@@ -206,9 +217,10 @@
 (defn get-by-params
   ([ds table params]
    (get-by-params ds table params nil))
-  ([ds table params opts]
+  ([ds table params {:keys [uncheked] :or {uncheked false} :as opts}]
    (let [res (exec-one! ds (sql/select table params opts))]
-     (when (or (:deleted-at res) (not res))
+     (when (and (not uncheked)
+                (or (:deleted-at res) (not res)))
        (ex/raise :type :not-found
                  :hint "database object not found"))
      res)))
@@ -250,9 +262,12 @@
   (PGpoint. (:x p) (:y p)))
 
 (defn create-array
-  [conn type aobjects]
+  [conn type objects]
   (let [^PGConnection conn (unwrap conn org.postgresql.PGConnection)]
-    (.createArrayOf conn ^String type aobjects)))
+    (if (coll? objects)
+      (.createArrayOf conn ^String type (into-array Object objects))
+      (.createArrayOf conn ^String type objects))))
+
 
 (defn decode-pgpoint
   [^PGpoint v]
@@ -286,7 +301,7 @@
     (pginterval data)
 
     (dt/duration? data)
-    (->> (/ (.toMillis data) 1000.0)
+    (->> (/ (.toMillis ^java.time.Duration data) 1000.0)
          (format "%s seconds")
          (pginterval))
 

backend/src/app/db/profile_initial_data.clj

@@ -1,117 +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/.
-;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020-2021 UXBOX Labs SL
-
-(ns app.db.profile-initial-data
-  (:require
-   [app.common.uuid :as uuid]
-   [app.config :as cfg]
-   [app.db :as db]
-   [app.rpc.mutations.projects :as projects]
-   [app.util.transit :as tr]
-   [clojure.java.io :as io]
-   [datoteka.core :as fs]))
-
-(def sql:file
-  "select * from file where project_id = ?")
-
-(def sql:file-library-rel
-  "with file_ids as (select id from file where project_id = ?)
-   select *
-     from file_library_rel
-     where file_id in (select id from file_ids)")
-
-(def sql:file-media-object
-  "with file_ids as (select id from file where project_id = ?)
-   select *
-     from file_media_object
-     where file_id in (select id from file_ids)")
-
-(defn change-ids
-  "Given a collection and a map from ID to ID. Changes all the `keys` properties
-  so they point to the new ID existing in `map-ids`"
-  [map-ids coll keys]
-  (let [generate-id
-        (fn [map-ids {:keys [id]}]
-          (assoc map-ids id (uuid/next)))
-
-        remap-key
-        (fn [obj map-ids key]
-          (cond-> obj
-            (contains? obj key)
-            (assoc key (get map-ids (get obj key) (get obj key)))))
-
-        change-id
-        (fn [map-ids obj]
-          (reduce #(remap-key %1 map-ids %2) obj keys))
-
-        new-map-ids (reduce generate-id map-ids coll)]
-
-    [new-map-ids (map (partial change-id new-map-ids) coll)]))
-
-(defn create-initial-data-dump
-  [conn project-id output-path]
-  (let [ ;; Retrieve data from templates
-        opath                (fs/path output-path)
-        file                 (db/exec! conn [sql:file, project-id])
-        file-library-rel     (db/exec! conn [sql:file-library-rel, project-id])
-        file-media-object    (db/exec! conn [sql:file-media-object, project-id])
-
-        data {:file file
-              :file-library-rel file-library-rel
-              :file-media-object file-media-object}]
-    (with-open [output (io/output-stream opath)]
-      (tr/encode-stream data output)
-      nil)))
-
-(defn read-initial-data
-  [path]
-  (when (fs/exists? path)
-    (with-open [input (io/input-stream (fs/path path))]
-      (tr/decode-stream input))))
-
-(defn create-profile-initial-data
-  ([conn profile]
-   (when-let [initial-data-path (:initial-data-file cfg/config)]
-     (create-profile-initial-data conn initial-data-path profile)))
-
-  ([conn file profile]
-   (when-let [{:keys [file file-library-rel file-media-object]} (read-initial-data file)]
-     (let [sample-project-name (:initial-data-project-name cfg/config "Penpot Onboarding")
-
-           proj (projects/create-project conn {:profile-id (:id profile)
-                                               :team-id (:default-team-id profile)
-                                               :name sample-project-name})
-
-           map-ids {}
-
-           ;; Create new ID's and change the references
-           [map-ids file]                 (change-ids map-ids file #{:id})
-           [map-ids file-library-rel]     (change-ids map-ids file-library-rel #{:file-id :library-file-id})
-           [_       file-media-object]    (change-ids map-ids file-media-object #{:id :file-id :media-id :thumbnail-id})
-
-           file             (map #(assoc % :project-id (:id proj)) file)
-           file-profile-rel (map #(array-map :file-id (:id %)
-                                             :profile-id (:id profile)
-                                             :is-owner true
-                                             :is-admin true
-                                             :can-edit true)
-                                 file)]
-
-       (projects/create-project-profile conn {:project-id (:id proj)
-                                              :profile-id (:id profile)})
-
-       (projects/create-team-project-profile conn {:team-id (:default-team-id profile)
-                                                   :project-id (:id proj)
-                                                   :profile-id (:id profile)})
-
-       ;; Re-insert into the database
-       (db/insert-multi! conn :file file)
-       (db/insert-multi! conn :file-profile-rel file-profile-rel)
-       (db/insert-multi! conn :file-library-rel file-library-rel)
-       (db/insert-multi! conn :file-media-object file-media-object)))))

backend/src/app/db/sql.clj

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.db.sql
   (:refer-clojure :exclude [update])
@@ -58,4 +55,3 @@
   ([table where-params opts]
    (let [opts (merge default-opts opts)]
      (sql/for-delete table where-params opts))))
-

backend/src/app/emails.clj

@@ -2,28 +2,22 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.emails
   "Main api for send emails."
   (:require
    [app.common.spec :as us]
    [app.config :as cfg]
-   [app.tasks :as tasks]
+   [app.db :as db]
+   [app.db.sql :as sql]
    [app.util.emails :as emails]
-   [clojure.spec.alpha :as s]))
+   [app.util.logging :as l]
+   [app.worker :as wrk]
+   [clojure.spec.alpha :as s]
+   [integrant.core :as ig]))
 
-;; --- Defaults
-
-(defn default-context
-  []
-  {:assets-uri (:assets-uri cfg/config)
-   :public-uri (:public-uri cfg/config)})
-
-;; --- Public API
+;; --- PUBLIC API
 
 (defn render
   [email-factory context]
@@ -31,17 +25,68 @@
 
 (defn send!
   "Schedule the email for sending."
-  [conn email-factory context]
-  (us/verify fn? email-factory)
-  (us/verify map? context)
-  (let [email (email-factory context)]
-    (tasks/submit! conn {:name "sendmail"
-                         :delay 0
-                         :max-retries 1
-                         :priority 200
-                         :props email})))
+  [{:keys [::conn ::factory] :as context}]
+  (us/verify fn? factory)
+  (us/verify some? conn)
+  (let [email (factory context)]
+    (wrk/submit! (assoc email
+                        ::wrk/task :sendmail
+                        ::wrk/delay 0
+                        ::wrk/max-retries 1
+                        ::wrk/priority 200
+                        ::wrk/conn conn))))
 
-;; --- Emails
+
+;; --- BOUNCE/COMPLAINS HANDLING
+
+(def sql:profile-complaint-report
+  "select (select count(*)
+             from profile_complaint_report
+            where type = 'complaint'
+              and profile_id = ?
+              and created_at > now() - ?::interval) as complaints,
+          (select count(*)
+             from profile_complaint_report
+            where type = 'bounce'
+              and profile_id = ?
+              and created_at > now() - ?::interval) as bounces;")
+
+(defn allow-send-emails?
+  [conn profile]
+  (when-not (:is-muted profile false)
+    (let [complaint-threshold (cfg/get :profile-complaint-threshold)
+          complaint-max-age   (cfg/get :profile-complaint-max-age)
+          bounce-threshold    (cfg/get :profile-bounce-threshold)
+          bounce-max-age      (cfg/get :profile-bounce-max-age)
+
+          {:keys [complaints bounces] :as result}
+          (db/exec-one! conn [sql:profile-complaint-report
+                              (:id profile)
+                              (db/interval complaint-max-age)
+                              (:id profile)
+                              (db/interval bounce-max-age)])]
+
+      (and (< complaints complaint-threshold)
+           (< bounces bounce-threshold)))))
+
+(defn has-complaint-reports?
+  ([conn email] (has-complaint-reports? conn email nil))
+  ([conn email {:keys [threshold] :or {threshold 1}}]
+   (let [reports (db/exec! conn (sql/select :global-complaint-report
+                                            {:email email :type "complaint"}
+                                            {:limit 10}))]
+     (>= (count reports) threshold))))
+
+(defn has-bounce-reports?
+  ([conn email] (has-bounce-reports? conn email nil))
+  ([conn email {:keys [threshold] :or {threshold 1}}]
+   (let [reports (db/exec! conn (sql/select :global-complaint-report
+                                            {:email email :type "bounce"}
+                                            {:limit 10}))]
+     (>= (count reports) threshold))))
+
+
+;; --- EMAIL FACTORIES
 
 (s/def ::subject ::us/string)
 (s/def ::content ::us/string)
@@ -51,7 +96,7 @@
 
 (def feedback
   "A profile feedback email."
-  (emails/template-factory ::feedback default-context))
+  (emails/template-factory ::feedback))
 
 (s/def ::name ::us/string)
 (s/def ::register
@@ -59,7 +104,7 @@
 
 (def register
   "A new profile registration welcome email."
-  (emails/template-factory ::register default-context))
+  (emails/template-factory ::register))
 
 (s/def ::token ::us/string)
 (s/def ::password-recovery
@@ -67,7 +112,7 @@
 
 (def password-recovery
   "A password recovery notification email."
-  (emails/template-factory ::password-recovery default-context))
+  (emails/template-factory ::password-recovery))
 
 (s/def ::pending-email ::us/email)
 (s/def ::change-email
@@ -75,7 +120,7 @@
 
 (def change-email
   "Password change confirmation email"
-  (emails/template-factory ::change-email default-context))
+  (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)
@@ -88,4 +133,50 @@
 
 (def invite-to-team
   "Teams member invitation email."
-  (emails/template-factory ::invite-to-team default-context))
+  (emails/template-factory ::invite-to-team))
+
+
+;; --- SENDMAIL TASK
+
+(declare send-console!)
+
+(s/def ::username ::cfg/smtp-username)
+(s/def ::password ::cfg/smtp-password)
+(s/def ::tls ::cfg/smtp-tls)
+(s/def ::ssl ::cfg/smtp-ssl)
+(s/def ::host ::cfg/smtp-host)
+(s/def ::port ::cfg/smtp-port)
+(s/def ::default-reply-to ::cfg/smtp-default-reply-to)
+(s/def ::default-from ::cfg/smtp-default-from)
+(s/def ::enabled ::cfg/smtp-enabled)
+
+(defmethod ig/pre-init-spec ::sendmail-handler [_]
+  (s/keys :req-un [::enabled]
+          :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}]
+    (if (:enabled cfg)
+      (emails/send! cfg props)
+      (send-console! cfg props))))
+
+(defn- send-console!
+  [cfg email]
+  (let [baos (java.io.ByteArrayOutputStream.)
+        mesg (emails/smtp-message cfg email)]
+    (.writeTo mesg baos)
+    (let [out (with-out-str
+                (println "email console dump:")
+                (println "******** start email" (:id email) "**********")
+                (println (.toString baos))
+                (println "******** end email "(:id email) "**********"))]
+      (l/info :email out))))
+

backend/src/app/http.clj

@@ -2,23 +2,18 @@
 ;; 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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020-2021 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.http
   (:require
    [app.common.data :as d]
+   [app.common.exceptions :as ex]
    [app.common.spec :as us]
-   [app.config :as cfg]
-   [app.http.auth :as auth]
    [app.http.errors :as errors]
    [app.http.middleware :as middleware]
    [app.metrics :as mtx]
-   [app.util.log4j :refer [update-thread-context!]]
+   [app.util.logging :as l]
    [clojure.spec.alpha :as s]
-   [clojure.tools.logging :as log]
    [integrant.core :as ig]
    [reitit.ring :as rr]
    [ring.adapter.jetty9 :as jetty])
@@ -27,30 +22,32 @@
    org.eclipse.jetty.server.handler.ErrorHandler
    org.eclipse.jetty.server.handler.StatisticsHandler))
 
+(declare router-handler)
+
 (s/def ::handler fn?)
+(s/def ::router some?)
 (s/def ::ws (s/map-of ::us/string fn?))
-(s/def ::port ::cfg/http-server-port)
+(s/def ::port ::us/integer)
 (s/def ::name ::us/string)
 
 (defmethod ig/pre-init-spec ::server [_]
-  (s/keys :req-un [::handler ::port]
-          :opt-un [::ws ::name ::mtx/metrics]))
+  (s/keys :req-un [::port]
+          :opt-un [::ws ::name ::mtx/metrics ::router ::handler]))
 
 (defmethod ig/prep-key ::server
   [_ cfg]
-  (merge {:name "http"}
-         (d/without-nils cfg)))
+  (merge {:name "http"} (d/without-nils cfg)))
 
 (defmethod ig/init-key ::server
-  [_ {:keys [handler ws port name metrics] :as opts}]
-  (log/infof "Starting %s server on port %s." name port)
+  [_ {:keys [handler router ws port name metrics] :as opts}]
+  (l/info :msg "starting http server" :port port :name name)
   (let [pre-start (fn [^Server server]
                     (let [handler (doto (ErrorHandler.)
                                     (.setShowStacks true)
                                     (.setServer server))]
                       (.setErrorHandler server ^ErrorHandler handler)
                       (when metrics
-                        (let [stats (new StatisticsHandler)]
+                        (let [stats (StatisticsHandler.)]
                           (.setHandler ^StatisticsHandler stats (.getHandler server))
                           (.setHandler server stats)
                           (mtx/instrument-jetty! (:registry metrics) stats)))))
@@ -64,62 +61,71 @@
                    (when (seq ws)
                      {:websockets ws}))
 
+        handler   (cond
+                    (fn? handler)  handler
+                    (some? router) (router-handler router)
+                    :else (ex/raise :type :internal
+                                    :code :invalid-argument
+                                    :hint "Missing `handler` or `router` option."))
+
         server    (jetty/run-jetty handler options)]
     (assoc opts :server server)))
 
 (defmethod ig/halt-key! ::server
   [_ {:keys [server name port] :as opts}]
-  (log/infof "Stoping %s server on port %s." name port)
+  (l/info :msg "stoping http server"
+          :name name
+          :port port)
   (jetty/stop-server server))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Http Main Handler (Router)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(declare create-router)
-
-(s/def ::rpc map?)
-(s/def ::session map?)
-(s/def ::metrics map?)
-(s/def ::google-auth map?)
-(s/def ::gitlab-auth map?)
-(s/def ::ldap-auth fn?)
-(s/def ::storage map?)
-(s/def ::assets map?)
-
-(defmethod ig/pre-init-spec ::router [_]
-  (s/keys :req-un [::rpc ::session ::metrics ::google-auth ::gitlab-auth ::storage ::assets]))
-
-(defmethod ig/init-key ::router
-  [_ cfg]
-  (let [handler (rr/ring-handler
-                 (create-router cfg)
-                 (rr/routes
-                  (rr/create-resource-handler {:path "/"})
-                  (rr/create-default-handler))
-                 {:middleware [middleware/server-timing]})]
+(defn- router-handler
+  [router]
+  (let [handler (rr/ring-handler router
+                                 (rr/routes
+                                  (rr/create-resource-handler {:path "/"})
+                                  (rr/create-default-handler))
+                                 {:middleware [middleware/server-timing]})]
     (fn [request]
       (try
         (handler request)
         (catch Throwable e
           (try
             (let [cdata (errors/get-error-context request e)]
-              (update-thread-context! cdata)
-              (log/errorf e "Unhandled exception: %s (id: %s)" (ex-message e) (str (:id cdata)))
-              {:status 500
-               :body "internal server error"})
+              (l/update-thread-context! cdata)
+              (l/error :hint "unhandled exception"
+                       :message (ex-message e)
+                       :error-id (str (:id cdata))
+                       :cause e))
+            {:status 500 :body "internal server error"}
             (catch Throwable e
-              (log/errorf e "Unhandled exception: %s" (ex-message e))
-              {:status 500
-               :body "internal server error"})))))))
+              (l/error :hint "unhandled exception"
+                       :message (ex-message e)
+                       :cause e)
+              {:status 500 :body "internal server error"})))))))
 
-(defn- create-router
-  [{:keys [session rpc google-auth gitlab-auth github-auth metrics ldap-auth svgparse assets] :as cfg}]
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Http Main Handler (Router)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(s/def ::rpc map?)
+(s/def ::session map?)
+(s/def ::oauth map?)
+(s/def ::storage map?)
+(s/def ::assets map?)
+(s/def ::feedback fn?)
+
+(defmethod ig/pre-init-spec ::router [_]
+  (s/keys :req-un [::rpc ::session ::mtx/metrics ::oauth ::storage ::assets ::feedback]))
+
+(defmethod ig/init-key ::router
+  [_ {:keys [session rpc oauth metrics assets feedback] :as cfg}]
   (rr/router
    [["/metrics" {:get (:handler metrics)}]
-
     ["/assets" {:middleware [[middleware/format-response-body]
-                             [middleware/errors errors/handle]]}
+                             [middleware/errors errors/handle]
+                             [middleware/cookies]
+                             (:middleware session)]}
      ["/by-id/:id" {:get (:objects-handler assets)}]
      ["/by-file-media-id/:id" {:get (:file-objects-handler assets)}]
      ["/by-file-media-id/:id/thumbnail" {:get (:file-thumbnails-handler assets)}]]
@@ -127,7 +133,11 @@
     ["/dbg"
      ["/error-by-id/:id" {:get (:error-report-handler cfg)}]]
 
-    ["/api" {:middleware [[middleware/format-response-body]
+    ["/webhooks"
+     ["/sns" {:post (:sns-webhook cfg)}]]
+
+    ["/api" {:middleware [[middleware/etag]
+                          [middleware/format-response-body]
                           [middleware/params]
                           [middleware/multipart-params]
                           [middleware/keyword-params]
@@ -135,23 +145,13 @@
                           [middleware/errors errors/handle]
                           [middleware/cookies]]}
 
-     ["/svg" {:post svgparse}]
+     ["/feedback" {:middleware [(:middleware session)]
+                   :post feedback}]
 
-     ["/oauth"
-      ["/google" {:post (:auth-handler google-auth)}]
-      ["/google/callback" {:get (:callback-handler google-auth)}]
-
-      ["/gitlab" {:post (:auth-handler gitlab-auth)}]
-      ["/gitlab/callback" {:get (:callback-handler gitlab-auth)}]
-
-      ["/github" {:post (:auth-handler github-auth)}]
-      ["/github/callback" {:get (:callback-handler github-auth)}]]
-
-     ["/login" {:post #(auth/login-handler cfg %)}]
-     ["/logout" {:post #(auth/logout-handler cfg %)}]
-
-     ["/login-ldap" {:post ldap-auth}]
+     ["/auth/oauth/:provider" {:post (:handler oauth)}]
+     ["/auth/oauth/:provider/callback" {:get (:callback-handler oauth)}]
 
      ["/rpc" {:middleware [(:middleware session)]}
-      ["/query/:type" {:get (:query-handler rpc)}]
+      ["/query/:type" {:get (:query-handler rpc)
+                       :post (:query-handler rpc)}]
       ["/mutation/:type" {:post (:mutation-handler rpc)}]]]]))

backend/src/app/http/assets.clj

@@ -2,23 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020-2021 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.http.assets
   "Assets related handlers."
   (:require
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
+   [app.common.uri :as u]
    [app.db :as db]
    [app.metrics :as mtx]
    [app.storage :as sto]
    [app.util.time :as dt]
    [clojure.spec.alpha :as s]
-   [integrant.core :as ig]
-   [lambdaisland.uri :as u]))
+   [integrant.core :as ig]))
 
 (def ^:private cache-max-age
   (dt/duration {:hours 24}))

backend/src/app/http/auth.clj

@@ -1,31 +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/.
-;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
-
-(ns app.http.auth
-  (:require
-   [app.http.session :as session]))
-
-(defn login-handler
-  [{:keys [session rpc] :as cfg} request]
-  (let [data    (:params request)
-        uagent  (get-in request [:headers "user-agent"])
-        method  (get-in rpc [:methods :mutation :login])
-        profile (method data)
-        id      (session/create! session {:profile-id (:id profile)
-                                          :user-agent uagent})]
-    {:status 200
-     :cookies (session/cookies session {:value id})
-     :body profile}))
-
-(defn logout-handler
-  [{:keys [session] :as cfg} request]
-  (session/delete! cfg request)
-  {:status 204
-   :cookies (session/cookies session {:value "" :max-age -1})
-   :body ""})

backend/src/app/http/auth/github.clj

@@ -1,171 +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/.
-;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020-2021 UXBOX Labs SL
-
-(ns app.http.auth.github
-  (:require
-   [app.common.exceptions :as ex]
-   [app.common.spec :as us]
-   [app.config :as cfg]
-   [app.http.session :as session]
-   [app.util.http :as http]
-   [app.util.time :as dt]
-   [clojure.data.json :as json]
-   [clojure.spec.alpha :as s]
-   [clojure.tools.logging :as log]
-   [integrant.core :as ig]
-   [lambdaisland.uri :as u]))
-
-(def base-github-uri
-  (u/uri "https://github.com"))
-
-(def base-api-github-uri
-  (u/uri "https://api.github.com"))
-
-(def authorize-uri
-  (assoc base-github-uri :path "/login/oauth/authorize"))
-
-(def token-url
-  (assoc base-github-uri :path "/login/oauth/access_token"))
-
-(def user-info-url
-  (assoc base-api-github-uri :path "/user"))
-
-(def scope "user:email")
-
-
-(defn- build-redirect-url
-  [cfg]
-  (let [public (u/uri (:public-uri cfg))]
-    (str (assoc public :path "/api/oauth/github/callback"))))
-
-(defn- get-access-token
-  [cfg state code]
-  (let [params {:client_id (:client-id cfg)
-                :client_secret (:client-secret cfg)
-                :code code
-                :state state
-                :redirect_uri (build-redirect-url cfg)}
-        req    {:method :post
-                :headers {"content-type" "application/x-www-form-urlencoded"
-                          "accept" "application/json"}
-                :uri  (str token-url)
-                :body (u/map->query-string params)}
-        res    (http/send! req)]
-
-    (when (not= 200 (:status res))
-      (ex/raise :type :internal
-                :code :invalid-response-from-github
-                :context {:status (:status res)
-                          :body (:body res)}))
-    (try
-      (let [data (json/read-str (:body res))]
-        (get data "access_token"))
-      (catch Throwable e
-        (log/error "unexpected error on parsing response body from github access token request" e)
-        nil))))
-
-(defn- get-user-info
-  [token]
-  (let [req {:uri (str user-info-url)
-             :headers {"authorization" (str "token " token)}
-             :method :get}
-        res (http/send! req)]
-
-    (when (not= 200 (:status res))
-      (ex/raise :type :internal
-                :code :invalid-response-from-github
-                :context {:status (:status res)
-                          :body (:body res)}))
-
-    (try
-      (let [data (json/read-str (:body res))]
-        {:email (get data "email")
-         :fullname (get data "name")})
-      (catch Throwable e
-        (log/error "unexpected error on parsing response body from github access token request" e)
-        nil))))
-
-(defn auth
-  [{:keys [tokens] :as cfg} _request]
-  (let [state  (tokens :generate
-                       {:iss :github-oauth
-                        :exp (dt/in-future "15m")})
-
-        params {:client_id (:client-id cfg/config)
-                :redirect_uri (build-redirect-url cfg)
-                :state state
-                :scope scope}
-        query (u/map->query-string params)
-        uri   (-> authorize-uri
-                  (assoc :query query))]
-    {:status 200
-     :body {:redirect-uri (str uri)}}))
-
-(defn callback
-  [{:keys [tokens rpc session] :as cfg} request]
-  (let [state (get-in request [:params :state])
-        _     (tokens :verify {:token state :iss :github-oauth})
-        info  (some->> (get-in request [:params :code])
-                       (get-access-token cfg state)
-                       (get-user-info))]
-
-    (when-not info
-      (ex/raise :type :authentication
-                :code :unable-to-authenticate-with-github))
-
-    (let [method-fn (get-in rpc [:methods :mutation :login-or-register])
-          profile   (method-fn {:email (:email info)
-                                :fullname (:fullname info)})
-          uagent    (get-in request [:headers "user-agent"])
-
-          token     (tokens :generate
-                            {:iss :auth
-                             :exp (dt/in-future "15m")
-                             :profile-id (:id profile)})
-
-          uri       (-> (u/uri (:public-uri cfg/config))
-                        (assoc :path "/#/auth/verify-token")
-                        (assoc :query (u/map->query-string {:token token})))
-
-          sid     (session/create! session {:profile-id (:id profile)
-                                            :user-agent uagent})]
-
-      {:status 302
-       :headers {"location" (str uri)}
-       :cookies (session/cookies session/cookies {:value sid})
-       :body ""})))
-
-;; --- ENTRY POINT
-
-(s/def ::client-id ::us/not-empty-string)
-(s/def ::client-secret ::us/not-empty-string)
-(s/def ::public-uri ::us/not-empty-string)
-(s/def ::session map?)
-(s/def ::tokens fn?)
-
-(defmethod ig/pre-init-spec :app.http.auth/github [_]
-  (s/keys :req-un [::public-uri
-                   ::session
-                   ::tokens]
-          :opt-un [::client-id
-                   ::client-secret]))
-
-(defn- default-handler
-  [_]
-  (ex/raise :type :not-found))
-
-(defmethod ig/init-key :app.http.auth/github
-  [_ cfg]
-  (if (and (:client-id cfg)
-           (:client-secret cfg))
-    {:auth-handler #(auth cfg %)
-     :callback-handler #(callback cfg %)}
-    {:auth-handler default-handler
-     :callback-handler default-handler}))
-

backend/src/app/http/auth/gitlab.clj

@@ -1,179 +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/.
-;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
-
-(ns app.http.auth.gitlab
-  (:require
-   [app.common.data :as d]
-   [app.common.exceptions :as ex]
-   [app.common.spec :as us]
-   [app.http.session :as session]
-   [app.util.http :as http]
-   [app.util.time :as dt]
-   [clojure.data.json :as json]
-   [clojure.spec.alpha :as s]
-   [clojure.tools.logging :as log]
-   [integrant.core :as ig]
-   [lambdaisland.uri :as uri]))
-
-(def scope "read_user")
-
-(defn- build-redirect-url
-  [cfg]
-  (let [public (uri/uri (:public-uri cfg))]
-    (str (assoc public :path "/api/oauth/gitlab/callback"))))
-
-
-(defn- build-oauth-uri
-  [cfg]
-  (let [base-uri (uri/uri (:base-uri cfg))]
-    (assoc base-uri :path "/oauth/authorize")))
-
-
-(defn- build-token-url
-  [cfg]
-  (let [base-uri (uri/uri (:base-uri cfg))]
-    (str (assoc base-uri :path "/oauth/token"))))
-
-
-(defn- build-user-info-url
-  [cfg]
-  (let [base-uri (uri/uri (:base-uri cfg))]
-    (str (assoc base-uri :path "/api/v4/user"))))
-
-(defn- get-access-token
-  [cfg code]
-  (let [params {:client_id (:client-id cfg)
-                :client_secret (:client-secret cfg)
-                :code code
-                :grant_type "authorization_code"
-                :redirect_uri (build-redirect-url cfg)}
-        req    {:method :post
-                :headers {"content-type" "application/x-www-form-urlencoded"}
-                :uri (build-token-url cfg)
-                :body (uri/map->query-string params)}
-        res    (http/send! req)]
-
-    (when (not= 200 (:status res))
-      (ex/raise :type :internal
-                :code :invalid-response-from-gitlab
-                :context {:status (:status res)
-                          :body (:body res)}))
-
-    (try
-      (let [data (json/read-str (:body res))]
-        (get data "access_token"))
-      (catch Throwable e
-        (log/error "unexpected error on parsing response body from gitlab access token request" e)
-        nil))))
-
-
-(defn- get-user-info
-  [cfg token]
-  (let [req {:uri (build-user-info-url cfg)
-             :headers {"Authorization" (str "Bearer " token)}
-             :method :get}
-        res (http/send! req)]
-
-    (when (not= 200 (:status res))
-      (ex/raise :type :internal
-                :code :invalid-response-from-gitlab
-                :context {:status (:status res)
-                          :body (:body res)}))
-
-    (try
-      (let [data (json/read-str (:body res))]
-        ;; (clojure.pprint/pprint data)
-        {:email (get data "email")
-         :fullname (get data "name")})
-      (catch Throwable e
-        (log/error "unexpected error on parsing response body from gitlab access token request" e)
-        nil))))
-
-(defn auth
-  [{:keys [tokens] :as cfg} _request]
-  (let [token  (tokens :generate {:iss :gitlab-oauth
-                                  :exp (dt/in-future "15m")})
-
-        params {:client_id (:client-id cfg)
-                :redirect_uri (build-redirect-url cfg)
-                :response_type "code"
-                :state token
-                :scope scope}
-        query  (uri/map->query-string params)
-        uri    (-> (build-oauth-uri cfg)
-                   (assoc :query query))]
-    {:status 200
-     :body {:redirect-uri (str uri)}}))
-
-(defn callback
-  [{:keys [tokens rpc session] :as cfg} request]
-  (let [token (get-in request [:params :state])
-        _     (tokens :verify {:token token :iss :gitlab-oauth})
-        info  (some->> (get-in request [:params :code])
-                       (get-access-token cfg)
-                       (get-user-info cfg))]
-
-    (when-not info
-      (ex/raise :type :authentication
-                :code :unable-to-authenticate-with-gitlab))
-
-    (let [method-fn (get-in rpc [:methods :mutation :login-or-register])
-          profile   (method-fn {:email (:email info)
-                                :fullname (:fullname info)})
-          uagent    (get-in request [:headers "user-agent"])
-
-          token     (tokens :generate {:iss :auth
-                                       :exp (dt/in-future "15m")
-                                       :profile-id (:id profile)})
-
-          uri       (-> (uri/uri (:public-uri cfg))
-                        (assoc :path "/#/auth/verify-token")
-                        (assoc :query (uri/map->query-string {:token token})))
-
-          sid       (session/create! session {:profile-id (:id profile)
-                                              :user-agent uagent})]
-      {:status 302
-       :headers {"location" (str uri)}
-       :cookies (session/cookies session {:value sid})
-       :body ""})))
-
-
-(s/def ::client-id ::us/not-empty-string)
-(s/def ::client-secret ::us/not-empty-string)
-(s/def ::base-uri ::us/not-empty-string)
-(s/def ::public-uri ::us/not-empty-string)
-(s/def ::session map?)
-(s/def ::tokens fn?)
-
-(defmethod ig/pre-init-spec :app.http.auth/gitlab [_]
-  (s/keys :req-un [::public-uri
-                   ::session
-                   ::tokens]
-          :opt-un [::base-uri
-                   ::client-id
-                   ::client-secret]))
-
-
-(defmethod ig/prep-key :app.http.auth/gitlab
-  [_ cfg]
-  (d/merge {:base-uri "https://gitlab.com"}
-           (d/without-nils cfg)))
-
-(defn- default-handler
-  [_]
-  (ex/raise :type :not-found))
-
-(defmethod ig/init-key :app.http.auth/gitlab
-  [_ cfg]
-  (if (and (:client-id cfg)
-           (:client-secret cfg))
-    {:auth-handler #(auth cfg %)
-     :callback-handler #(callback cfg %)}
-    {:auth-handler default-handler
-     :callback-handler default-handler}))

backend/src/app/http/auth/google.clj

@@ -1,149 +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/.
-;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
-
-(ns app.http.auth.google
-  (:require
-   [app.common.exceptions :as ex]
-   [app.common.spec :as us]
-   [app.http.session :as session]
-   [app.util.http :as http]
-   [app.util.time :as dt]
-   [clojure.data.json :as json]
-   [clojure.spec.alpha :as s]
-   [clojure.tools.logging :as log]
-   [integrant.core :as ig]
-   [lambdaisland.uri :as uri]))
-
-(def base-goauth-uri "https://accounts.google.com/o/oauth2/v2/auth")
-
-(def scope
-  (str "email profile "
-       "https://www.googleapis.com/auth/userinfo.email "
-       "https://www.googleapis.com/auth/userinfo.profile "
-       "openid"))
-
-(defn- build-redirect-url
-  [cfg]
-  (let [public (uri/uri (:public-uri cfg))]
-    (str (assoc public :path "/api/oauth/google/callback"))))
-
-(defn- get-access-token
-  [cfg code]
-  (try
-    (let [params {:code code
-                  :client_id (:client-id cfg)
-                  :client_secret (:client-secret cfg)
-                  :redirect_uri (build-redirect-url cfg)
-                  :grant_type "authorization_code"}
-          req    {:method :post
-                  :headers {"content-type" "application/x-www-form-urlencoded"}
-                  :uri "https://oauth2.googleapis.com/token"
-                  :body (uri/map->query-string params)}
-          res    (http/send! req)]
-
-      (when (= 200 (:status res))
-        (-> (json/read-str (:body res))
-            (get "access_token"))))
-
-    (catch Exception e
-      (log/error e "unexpected error on get-access-token")
-      nil)))
-
-(defn- get-user-info
-  [token]
-  (try
-    (let [req {:uri "https://openidconnect.googleapis.com/v1/userinfo"
-               :headers {"Authorization" (str "Bearer " token)}
-               :method :get}
-          res (http/send! req)]
-      (when (= 200 (:status res))
-        (let [data (json/read-str (:body res))]
-          {:email (get data "email")
-           :fullname (get data "name")})))
-    (catch Exception e
-      (log/error e "unexpected exception on get-user-info")
-      nil)))
-
-(defn- auth
-  [{:keys [tokens] :as cfg} _req]
-  (let [token  (tokens :generate {:iss :google-oauth :exp (dt/in-future "15m")})
-        params {:scope scope
-                :access_type "offline"
-                :include_granted_scopes true
-                :state token
-                :response_type "code"
-                :redirect_uri (build-redirect-url cfg)
-                :client_id (:client-id cfg)}
-        query  (uri/map->query-string params)
-        uri    (-> (uri/uri base-goauth-uri)
-                   (assoc :query query))]
-    {:status 200
-     :body {:redirect-uri (str uri)}}))
-
-(defn- callback
-  [{:keys [tokens rpc session] :as cfg} request]
-  (try
-    (let [token (get-in request [:params :state])
-          _     (tokens :verify {:token token :iss :google-oauth})
-          info  (some->> (get-in request [:params :code])
-                         (get-access-token cfg)
-                         (get-user-info))
-          _     (when-not info
-                  (ex/raise :type :internal
-                            :code :unable-to-auth))
-          method-fn (get-in rpc [:methods :mutation :login-or-register])
-          profile   (method-fn {:email (:email info)
-                                :fullname (:fullname info)})
-          uagent    (get-in request [:headers "user-agent"])
-          token     (tokens :generate {:iss :auth
-                                       :exp (dt/in-future "15m")
-                                       :profile-id (:id profile)})
-          uri       (-> (uri/uri (:public-uri cfg))
-                        (assoc :path "/#/auth/verify-token")
-                        (assoc :query (uri/map->query-string {:token token})))
-
-          sid       (session/create! session {:profile-id (:id profile)
-                                              :user-agent uagent})]
-      {:status 302
-       :headers {"location" (str uri)}
-       :cookies (session/cookies session {:value sid})
-       :body ""})
-    (catch Exception _e
-      (let [uri (-> (uri/uri (:public-uri cfg))
-                    (assoc :path "/#/auth/login")
-                    (assoc :query (uri/map->query-string {:error "unable-to-auth"})))]
-        {:status 302
-         :headers {"location" (str uri)}
-         :body ""}))))
-
-(s/def ::client-id ::us/not-empty-string)
-(s/def ::client-secret ::us/not-empty-string)
-(s/def ::public-uri ::us/not-empty-string)
-(s/def ::session map?)
-(s/def ::tokens fn?)
-
-(defmethod ig/pre-init-spec :app.http.auth/google [_]
-  (s/keys :req-un [::public-uri
-                   ::session
-                   ::tokens]
-          :opt-un [::client-id
-                   ::client-secret]))
-
-(defn- default-handler
-  [_]
-  (ex/raise :type :not-found))
-
-(defmethod ig/init-key :app.http.auth/google
-  [_ cfg]
-  (if (and (:client-id cfg)
-           (:client-secret cfg))
-    {:auth-handler #(auth cfg %)
-     :callback-handler #(callback cfg %)}
-    {:auth-handler default-handler
-     :callback-handler default-handler}))

backend/src/app/http/auth/ldap.clj

@@ -1,129 +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/.
-;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
-
-(ns app.http.auth.ldap
-  (:require
-   [app.common.exceptions :as ex]
-   [app.config :as cfg]
-   [app.http.session :as session]
-   [clj-ldap.client :as client]
-   [clojure.set :as set]
-   [clojure.spec.alpha :as s]
-   [clojure.string ]
-   [clojure.tools.logging :as log]
-   [integrant.core :as ig]))
-
-(declare authenticate)
-(declare create-connection)
-(declare replace-several)
-
-
-(s/def ::host ::cfg/ldap-auth-host)
-(s/def ::port ::cfg/ldap-auth-port)
-(s/def ::ssl ::cfg/ldap-auth-ssl)
-(s/def ::starttls ::cfg/ldap-auth-starttls)
-(s/def ::user-query ::cfg/ldap-auth-user-query)
-(s/def ::base-dn ::cfg/ldap-auth-base-dn)
-(s/def ::username-attribute ::cfg/ldap-auth-username-attribute)
-(s/def ::email-attribute ::cfg/ldap-auth-email-attribute)
-(s/def ::fullname-attribute ::cfg/ldap-auth-fullname-attribute)
-(s/def ::avatar-attribute ::cfg/ldap-auth-avatar-attribute)
-
-(s/def ::rpc map?)
-(s/def ::session map?)
-
-(defmethod ig/pre-init-spec :app.http.auth/ldap
-  [_]
-  (s/keys
-   :req-un [::rpc ::session]
-   :opt-un [::host
-            ::port
-            ::ssl
-            ::starttls
-            ::username-attribute
-            ::base-dn
-            ::username-attribute
-            ::email-attribute
-            ::fullname-attribute
-            ::avatar-attribute]))
-
-(defmethod ig/init-key :app.http.auth/ldap
-  [_ {:keys [session rpc] :as cfg}]
-  (let [conn (create-connection cfg)]
-    (with-meta
-      (fn [request]
-        (let [data   (:body-params request)]
-          (when-some [info (authenticate (assoc cfg
-                                                :conn conn
-                                                :username (:email data)
-                                                :password (:password data)))]
-            (let [method-fn (get-in rpc [:methods :mutation :login-or-register])
-                  profile   (method-fn {:email (:email info)
-                                        :fullname (:fullname info)})
-                  uagent    (get-in request [:headers "user-agent"])
-                  sid       (session/create! session {:profile-id (:id profile)
-                                                      :user-agent uagent})]
-              {:status 200
-               :cookies (session/cookies session {:value sid})
-               :body profile}))))
-      {::conn conn})))
-
-(defmethod ig/halt-key! ::client
-  [_ handler]
-  (let [{:keys [::conn]} (meta handler)]
-    (when (realized? conn)
-      (.close @conn))))
-
-(defn- replace-several [s & {:as replacements}]
-  (reduce-kv clojure.string/replace s replacements))
-
-(defn- create-connection
-  [cfg]
-  (let [params (merge {:host {:address (:host cfg)
-                              :port (:port cfg)}}
-                      (-> cfg
-                          (select-keys [:ssl
-                                        :starttls
-                                        :ldap-bind-dn
-                                        :ldap-bind-password])
-                          (set/rename-keys {:ssl :ssl?
-                                            :starttls :startTLS?
-                                            :ldap-bind-dn  :bind-dn
-                                            :ldap-bind-password :password})))]
-    (delay
-      (try
-        (client/connect params)
-        (catch Exception e
-          (log/errorf e "Cannot connect to LDAP %s:%s"
-                      (:host cfg) (:port cfg)))))))
-
-
-(defn- authenticate
-  [{:keys [conn username password] :as cfg}]
-  (when-some [conn (some-> conn deref)]
-    (let [user-search-query (replace-several (:user-query cfg) "$username" username)
-          user-attributes   (-> cfg
-                                (select-keys [:username-attribute
-                                              :email-attribute
-                                              :fullname-attribute
-                                              :avatar-attribute])
-                                vals)]
-      (when-some [user-entry (-> conn
-                                 (client/search (:base-dn cfg)
-                                                {:filter user-search-query
-                                                 :sizelimit 1
-                                                 :attributes user-attributes})
-                                 (first))]
-        (when-not (client/bind? conn (:dn user-entry) password)
-          (ex/raise :type :authentication
-                    :code :wrong-credentials))
-        (set/rename-keys user-entry {(keyword (:avatar-attribute cfg)) :photo
-                                     (keyword (:fullname-attribute cfg)) :fullname
-                                     (keyword (:email-attribute cfg)) :email})))))
-

backend/src/app/http/awsns.clj

@@ -0,0 +1,196 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) UXBOX Labs SL
+
+(ns app.http.awsns
+  "AWS SNS webhook handler for bounces."
+  (:require
+   [app.common.exceptions :as ex]
+   [app.db :as db]
+   [app.db.sql :as sql]
+   [app.util.http :as http]
+   [app.util.logging :as l]
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [integrant.core :as ig]
+   [jsonista.core :as j]))
+
+(declare parse-json)
+(declare parse-notification)
+(declare process-report)
+
+(defmethod ig/pre-init-spec ::handler [_]
+  (s/keys :req-un [::db/pool]))
+
+(defmethod ig/init-key ::handler
+  [_ cfg]
+  (fn [request]
+    (let [body  (parse-json (slurp (:body request)))
+          mtype (get body "Type")]
+      (cond
+        (= mtype "SubscriptionConfirmation")
+        (let [surl   (get body "SubscribeURL")
+              stopic (get body "TopicArn")]
+          (l/info :action "subscription received" :topic stopic :url surl)
+          (http/send! {:uri surl :method :post :timeout 10000}))
+
+        (= mtype "Notification")
+        (when-let [message (parse-json (get body "Message"))]
+          (let [notification (parse-notification cfg message)]
+            (process-report cfg notification)))
+
+        :else
+        (l/warn :hint "unexpected data received"
+                :report (pr-str body)))
+      {:status 200 :body ""})))
+
+(defn- parse-bounce
+  [data]
+  {:type        "bounce"
+   :kind        (str/lower (get data "bounceType"))
+   :category    (str/lower (get data "bounceSubType"))
+   :feedback-id (get data "feedbackId")
+   :timestamp   (get data "timestamp")
+   :recipients  (->> (get data "bouncedRecipients")
+                     (mapv (fn [item]
+                             {:email  (str/lower (get item "emailAddress"))
+                              :status (get item "status")
+                              :action (get item "action")
+                              :dcode  (get item "diagnosticCode")})))})
+
+(defn- parse-complaint
+  [data]
+  {:type          "complaint"
+   :user-agent    (get data "userAgent")
+   :kind          (get data "complaintFeedbackType")
+   :category      (get data "complaintSubType")
+   :timestamp     (get data "arrivalDate")
+   :feedback-id   (get data "feedbackId")
+   :recipients    (->> (get data "complainedRecipients")
+                       (mapv #(get % "emailAddress"))
+                       (mapv str/lower))})
+
+(defn- extract-headers
+  [mail]
+  (reduce (fn [acc item]
+            (let [key (get item "name")
+                  val (get item "value")]
+              (assoc acc (str/lower key) val)))
+          {}
+          (get mail "headers")))
+
+(defn- extract-identity
+  [{:keys [tokens] :as cfg} headers]
+  (let [tdata (get headers "x-penpot-data")]
+    (when-not (str/empty? tdata)
+      (let [result (tokens :verify {:token tdata :iss :profile-identity})]
+        (:profile-id result)))))
+
+(defn- parse-notification
+  [cfg message]
+  (let [type (get message "notificationType")
+        data (case type
+               "Bounce" (parse-bounce (get message "bounce"))
+               "Complaint" (parse-complaint (get message "complaint"))
+               {:type (keyword (str/lower type))
+                :message message})]
+    (when data
+      (let [mail (get message "mail")]
+        (when-not mail
+          (ex/raise :type :internal
+                    :code :incomplete-notification
+                    :hint "no email data received, please enable full headers report"))
+        (let [headers (extract-headers mail)
+              mail    {:destination (get mail "destination")
+                       :source      (get mail "source")
+                       :timestamp   (get mail "timestamp")
+                       :subject     (get-in mail ["commonHeaders" "subject"])
+                       :headers     headers}]
+          (assoc data
+                 :mail mail
+                 :profile-id (extract-identity cfg headers)))))))
+
+(defn- parse-json
+  [v]
+  (ex/ignoring
+   (j/read-value v)))
+
+(defn- register-bounce-for-profile
+  [{:keys [pool]} {:keys [type kind profile-id] :as report}]
+  (when (= kind "permanent")
+    (db/with-atomic [conn pool]
+      (db/insert! conn :profile-complaint-report
+                  {:profile-id profile-id
+                   :type (name type)
+                   :content (db/tjson report)})
+
+      ;; TODO: maybe also try to find profiles by mail and if exists
+      ;; register profile reports for them?
+      (doseq [recipient (:recipients report)]
+        (db/insert! conn :global-complaint-report
+                    {:email (:email recipient)
+                     :type (name type)
+                     :content (db/tjson report)}))
+
+      (let [profile (db/exec-one! conn (sql/select :profile {:id profile-id}))]
+        (when (some #(= (:email profile) (:email %)) (:recipients report))
+          ;; If the report matches the profile email, this means that
+          ;; the report is for itself, can be caused when a user
+          ;; registers with an invalid email or the user email is
+          ;; permanently rejecting receiving the email. In this case we
+          ;; have no option to mark the user as muted (and in this case
+          ;; the profile will be also inactive.
+          (db/update! conn :profile
+                      {:is-muted true}
+                      {:id profile-id}))))))
+
+(defn- register-complaint-for-profile
+  [{:keys [pool]} {:keys [type profile-id] :as report}]
+  (db/with-atomic [conn pool]
+    (db/insert! conn :profile-complaint-report
+                {:profile-id profile-id
+                 :type (name type)
+                 :content (db/tjson report)})
+
+    ;; TODO: maybe also try to find profiles by email and if exists
+    ;; register profile reports for them?
+    (doseq [email (:recipients report)]
+      (db/insert! conn :global-complaint-report
+                  {:email email
+                   :type (name type)
+                   :content (db/tjson report)}))
+
+    (let [profile (db/exec-one! conn (sql/select :profile {:id profile-id}))]
+      (when (some #(= % (:email profile)) (:recipients report))
+        ;; If the report matches the profile email, this means that
+        ;; the report is for itself, rare case but can happen; In this
+        ;; case just mark profile as muted (very rare case).
+        (db/update! conn :profile
+                    {:is-muted true}
+                    {:id profile-id})))))
+
+(defn- process-report
+  [cfg {:keys [type profile-id] :as report}]
+  (l/trace :action "procesing report" :report (pr-str report))
+  (cond
+    ;; In this case we receive a bounce/complaint notification without
+    ;; confirmed identity, we just emit a warning but do nothing about
+    ;; it because this is not a normal case. All notifications should
+    ;; come with profile identity.
+    (nil? profile-id)
+    (l/warn :msg "a notification without identity recevied from AWS"
+            :report (pr-str report))
+
+    (= "bounce" type)
+    (register-bounce-for-profile cfg report)
+
+    (= "complaint" type)
+    (register-complaint-for-profile cfg report)
+
+    :else
+    (l/warn :msg "unrecognized report received from AWS"
+            :report (pr-str report))))
+
+

backend/src/app/http/errors.clj

@@ -2,18 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.http.errors
   "A errors handling for the http server."
   (:require
+   [app.common.exceptions :as ex]
    [app.common.uuid :as uuid]
-   [app.config :as cfg]
-   [app.util.log4j :refer [update-thread-context!]]
-   [clojure.tools.logging :as log]
+   [app.util.logging :as l]
    [cuerdas.core :as str]
    [expound.alpha :as expound]))
 
@@ -30,16 +26,10 @@
       :path    (:uri request)
       :method  (:request-method request)
       :params  (:params request)
-      :version (:full cfg/version)
-      :host    (:public-uri cfg/config)
-      :class   (.getCanonicalName ^java.lang.Class (class error))
-      :hint    (ex-message error)
       :data    edata}
-
      (let [headers (:headers request)]
        {:user-agent (get headers "user-agent")
         :frontend-version (get headers "x-frontend-version" "unknown")})
-
      (when (and (map? edata) (:data edata))
        {:explain (explain-error edata)}))))
 
@@ -53,6 +43,11 @@
   [err _]
   {:status 401 :body (ex-data err)})
 
+
+(defmethod handle-exception :restriction
+  [err _]
+  {:status 400 :body (ex-data err)})
+
 (defmethod handle-exception :validation
   [err req]
   (let [header (get-in req [:headers "accept"])
@@ -74,8 +69,11 @@
   [error request]
   (let [edata (ex-data error)
         cdata (get-error-context request error)]
-    (update-thread-context! cdata)
-    (log/errorf error "Internal error: assertion (id: %s)" (str (:id cdata)))
+    (l/update-thread-context! cdata)
+    (l/error :hint "internal error: assertion"
+             :error-id (str (:id cdata))
+             :cause error)
+
     {:status 500
      :body {:type :server-error
             :data (-> edata
@@ -88,15 +86,55 @@
 
 (defmethod handle-exception :default
   [error request]
-  (let [cdata (get-error-context request error)]
-    (update-thread-context! cdata)
-    (log/errorf error "Internal error: %s (id: %s)"
-                (ex-message error)
-                (str (:id cdata)))
-    {:status 500
-     :body {:type :server-error
-            :hint (ex-message error)
-            :data (ex-data error)}}))
+  (let [edata (ex-data error)]
+    ;; NOTE: this is a special case for the idle-in-transaction error;
+    ;; when it happens, the connection is automatically closed and
+    ;; next-jdbc combines the two errors in a single ex-info. We only
+    ;; need the :handling error, because the :rollback error will be
+    ;; always "connection closed".
+    (if (and (ex/exception? (:rollback edata))
+             (ex/exception? (:handling edata)))
+      (handle-exception (:handling edata) request)
+      (let [cdata (get-error-context request error)]
+        (l/update-thread-context! cdata)
+        (l/error :hint "internal error"
+                 :error-message (ex-message error)
+                 :error-id (str (:id cdata))
+                 :cause error)
+        {:status 500
+         :body {:type :server-error
+                :hint (ex-message error)
+                :data edata}}))))
+
+(defmethod handle-exception org.postgresql.util.PSQLException
+  [error request]
+  (let [cdata (get-error-context request error)
+        state (.getSQLState ^java.sql.SQLException error)]
+
+    (l/update-thread-context! cdata)
+    (l/error :hint "psql exception"
+             :error-message (ex-message error)
+             :error-id (str (:id cdata))
+             :sql-state state)
+
+    (cond
+      (= state "57014")
+      {:status 504
+       :body {:type :server-timeout
+              :code :statement-timeout
+              :hint (ex-message error)}}
+
+      (= state "25P03")
+      {:status 504
+       :body {:type :server-timeout
+              :code :idle-in-transaction-timeout
+              :hint (ex-message error)}}
+
+      :else
+      {:status 500
+       :body {:type :server-timeout
+              :hint (ex-message error)
+              :state state}})))
 
 (defn handle
   [error req]

backend/src/app/http/feedback.clj

@@ -0,0 +1,70 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) UXBOX Labs SL
+
+(ns app.http.feedback
+  "A general purpose feedback module."
+  (:require
+   [app.common.data :as d]
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.config :as cfg]
+   [app.db :as db]
+   [app.emails :as eml]
+   [app.rpc.queries.profile :as profile]
+   [clojure.spec.alpha :as s]
+   [integrant.core :as ig]))
+
+(declare send-feedback)
+
+(defmethod ig/pre-init-spec ::handler [_]
+  (s/keys :req-un [::db/pool]))
+
+(defmethod ig/init-key ::handler
+  [_ {:keys [pool] :as scfg}]
+  (let [ftoken   (cfg/get :feedback-token ::no-token)
+        enabled  (cfg/get :feedback-enabled)]
+    (fn [{:keys [profile-id] :as request}]
+      (let [token  (get-in request [:headers "x-feedback-token"])
+            params (d/merge (:params request)
+                            (:body-params request))]
+
+        (when-not enabled
+          (ex/raise :type :validation
+                    :code :feedback-disabled
+                    :hint "feedback module is disabled"))
+
+        (cond
+          (uuid? profile-id)
+          (let [profile (profile/retrieve-profile-data pool profile-id)
+                params  (assoc params :from (:email profile))]
+            (when-not (:is-muted profile)
+              (send-feedback pool profile params)))
+
+          (= token ftoken)
+          (send-feedback scfg nil params))
+
+        {:status 204 :body ""}))))
+
+(s/def ::content ::us/string)
+(s/def ::from    ::us/email)
+(s/def ::subject ::us/string)
+
+(s/def ::feedback
+  (s/keys :req-un [::from ::subject ::content]))
+
+(defn send-feedback
+  [pool profile params]
+  (let [params      (us/conform ::feedback params)
+        destination (cfg/get :feedback-destination)]
+    (eml/send! {::eml/conn pool
+                ::eml/factory eml/feedback
+                :to       destination
+                :profile  profile
+                :reply-to (:from params)
+                :email    (:from params)
+                :subject  (:subject params)
+                :content  (:content params)})
+    nil))

backend/src/app/http/middleware.clj

@@ -2,16 +2,16 @@
 ;; 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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020-2021 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.http.middleware
   (:require
    [app.metrics :as mtx]
    [app.util.json :as json]
+   [app.util.logging :as l]
    [app.util.transit :as t]
+   [buddy.core.codecs :as bc]
+   [buddy.core.hash :as bh]
    [clojure.java.io :as io]
    [ring.middleware.cookies :refer [wrap-cookies]]
    [ring.middleware.keyword-params :refer [wrap-keyword-params]]
@@ -119,8 +119,6 @@
    :wrap (fn [handler]
            (mtx/wrap-counter handler {:id "http__requests_counter"
                                       :help "Absolute http requests counter."}))})
-
-
 (def cookies
   {:name ::cookies
    :compile (constantly wrap-cookies)})
@@ -140,3 +138,43 @@
 (def server-timing
   {:name ::server-timing
    :compile (constantly wrap-server-timing)})
+
+(defn wrap-etag
+  [handler]
+  (letfn [(generate-etag [{:keys [body] :as response}]
+            (str "W/\"" (-> body bh/blake2b-128 bc/bytes->hex) "\""))
+          (get-match [{:keys [headers] :as request}]
+            (get headers "if-none-match"))]
+    (fn [request]
+      (let [response (handler request)]
+        (if (= :get (:request-method request))
+          (let [etag     (generate-etag response)
+                match    (get-match request)
+                response (update response :headers #(assoc % "ETag" etag))]
+            (cond-> response
+              (and (string? match)
+                   (= :get (:request-method request))
+                   (= etag match))
+              (-> response
+                  (assoc :body "")
+                  (assoc :status 304))))
+          response)))))
+
+(def etag
+  {:name ::etag
+   :compile (constantly wrap-etag)})
+
+(defn activity-logger
+  [handler]
+  (let [logger "penpot.profile-activity"]
+    (fn [{:keys [headers] :as request}]
+      (let [ip-addr    (get headers "x-forwarded-for")
+            profile-id (:profile-id request)
+            qstring    (:query-string request)]
+        (l/info ::l/async true
+                ::l/logger logger
+                :ip-addr ip-addr
+                :profile-id profile-id
+                :uri (str (:uri request) (when qstring (str "?" qstring)))
+                :method (name (:request-method request)))
+        (handler request)))))

backend/src/app/http/oauth.clj

@@ -0,0 +1,298 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) UXBOX Labs SL
+
+(ns app.http.oauth
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.common.uri :as u]
+   [app.config :as cf]
+   [app.util.http :as http]
+   [app.util.logging :as l]
+   [app.util.time :as dt]
+   [clojure.data.json :as json]
+   [clojure.set :as set]
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [integrant.core :as ig]))
+
+(defn redirect-response
+  [uri]
+  {:status 302
+   :headers {"location" (str uri)}
+   :body ""})
+
+(defn generate-error-redirect-uri
+  [cfg]
+  (-> (u/uri (:public-uri cfg))
+      (assoc :path "/#/auth/login")
+      (assoc :query (u/map->query-string {:error "unable-to-auth"}))))
+
+(defn register-profile
+  [{:keys [rpc] :as cfg} info]
+  (let [method-fn (get-in rpc [:methods :mutation :login-or-register])
+        profile   (method-fn info)]
+    (cond-> profile
+      (some? (:invitation-token info))
+      (assoc :invitation-token (:invitation-token info)))))
+
+(defn generate-redirect-uri
+  [{:keys [tokens] :as cfg} profile]
+  (let [token (or (:invitation-token profile)
+                  (tokens :generate {:iss :auth
+                                     :exp (dt/in-future "15m")
+                                     :profile-id (:id profile)}))]
+    (-> (u/uri (:public-uri cfg))
+        (assoc :path "/#/auth/verify-token")
+        (assoc :query (u/map->query-string {:token token})))))
+
+(defn- build-redirect-uri
+  [{:keys [provider] :as cfg}]
+  (let [public (u/uri (:public-uri cfg))]
+    (str (assoc public :path (str "/api/auth/oauth/" (:name provider) "/callback")))))
+
+(defn- build-auth-uri
+  [{:keys [provider] :as cfg} state]
+  (let [params {:client_id (:client-id provider)
+                :redirect_uri (build-redirect-uri cfg)
+                :response_type "code"
+                :state state
+                :scope (str/join " " (:scopes provider []))}
+        query  (u/map->query-string params)]
+    (-> (u/uri (:auth-uri provider))
+        (assoc :query query)
+        (str))))
+
+(defn retrieve-access-token
+  [{:keys [provider] :as cfg} code]
+  (try
+    (let [params {:client_id (:client-id provider)
+                  :client_secret (:client-secret provider)
+                  :code code
+                  :grant_type "authorization_code"
+                  :redirect_uri (build-redirect-uri cfg)}
+          req    {:method :post
+                  :headers {"content-type" "application/x-www-form-urlencoded"}
+                  :uri (:token-uri provider)
+                  :body (u/map->query-string params)}
+          res    (http/send! req)]
+      (when (= 200 (:status res))
+        (let [data (json/read-str (:body res))]
+          {:token (get data "access_token")
+           :type  (get data "token_type")})))
+    (catch Exception e
+      (l/error :hint "unexpected error on retrieve-access-token"
+               :cause e)
+      nil)))
+
+(defn- retrieve-user-info
+  [{:keys [provider] :as cfg} tdata]
+  (try
+    (let [req {:uri (:user-uri provider)
+               :headers {"Authorization" (str (:type tdata) " " (:token tdata))}
+               :timeout 6000
+               :method :get}
+          res (http/send! req)]
+
+      (when (= 200 (:status res))
+        (let [{:keys [name] :as data} (json/read-str (:body res) :key-fn keyword)]
+          (-> data
+              (assoc :backend (:name provider))
+              (assoc :fullname name)))))
+
+    (catch Exception e
+      (l/error :hint "unexpected exception on retrieve-user-info"
+               :cause e)
+      nil)))
+
+(defn retrieve-info
+  [{:keys [tokens provider] :as cfg} request]
+  (let [state  (get-in request [:params :state])
+        state  (tokens :verify {:token state :iss :oauth})
+        info   (some->> (get-in request [:params :code])
+                        (retrieve-access-token cfg)
+                        (retrieve-user-info cfg))]
+    (when-not info
+      (ex/raise :type :internal
+                :code :unable-to-auth))
+
+    ;; If the provider is OIDC, we can proceed to check
+    ;; roles if they are defined.
+    (when (and (= "oidc" (:name provider))
+               (seq (:roles provider)))
+      (let [provider-roles (into #{} (:roles provider))
+            profile-roles  (let [attr  (cf/get :oidc-roles-attr :roles)
+                                 roles (get info attr)]
+                             (cond
+                               (string? roles) (into #{} (str/words roles))
+                               (vector? roles) (into #{} roles)
+                               :else #{}))]
+        ;; check if profile has a configured set of roles
+        (when-not (set/subset? provider-roles profile-roles)
+          (ex/raise :type :internal
+                    :code :unable-to-auth
+                    :hint "not enought permissions"))))
+
+    (cond-> info
+      (some? (:invitation-token state))
+      (assoc :invitation-token (:invitation-token state)))))
+
+;; --- HTTP HANDLERS
+
+(defn- auth-handler
+  [{:keys [tokens] :as cfg} request]
+  (let [invitation (get-in request [:params :invitation-token])
+        state      (tokens :generate
+                           {:iss :oauth
+                            :invitation-token invitation
+                            :exp (dt/in-future "15m")})
+        uri        (build-auth-uri cfg state)]
+    {:status 200
+     :body {:redirect-uri uri}}))
+
+(defn- callback-handler
+  [{:keys [session] :as cfg} request]
+  (try
+    (let [info    (retrieve-info cfg request)
+          profile (register-profile cfg info)
+          uri     (generate-redirect-uri cfg profile)
+          sxf     ((:create session) (:id profile))]
+      (->> (redirect-response uri)
+           (sxf request)))
+    (catch Exception _e
+      (-> (generate-error-redirect-uri cfg)
+          (redirect-response)))))
+
+;; --- INIT
+
+(declare initialize)
+
+(s/def ::public-uri ::us/not-empty-string)
+(s/def ::session map?)
+(s/def ::tokens fn?)
+(s/def ::rpc map?)
+
+(defmethod ig/pre-init-spec :app.http.oauth/handlers [_]
+  (s/keys :req-un [::public-uri ::session ::tokens ::rpc]))
+
+(defn wrap-handler
+  [cfg handler]
+  (fn [request]
+    (let [provider (get-in request [:path-params :provider])
+          provider (get-in @cfg [:providers provider])]
+      (when-not provider
+        (ex/raise :type :not-found
+                  :context {:provider provider}
+                  :hint "provider not configured"))
+      (-> (assoc @cfg :provider provider)
+          (handler request)))))
+
+(defmethod ig/init-key :app.http.oauth/handlers
+  [_ cfg]
+  (let [cfg (initialize cfg)]
+    {:handler (wrap-handler cfg auth-handler)
+     :callback-handler (wrap-handler cfg callback-handler)}))
+
+(defn- discover-oidc-config
+  [{:keys [base-uri] :as opts}]
+  (let [discovery-uri (u/join base-uri ".well-known/openid-configuration")
+        response      (http/send! {:method :get :uri (str discovery-uri)})]
+    (when (= 200 (:status response))
+      (let [data (json/read-str (:body response))]
+        (assoc opts
+               :token-uri (get data "token_endpoint")
+               :auth-uri (get data "authorization_endpoint")
+               :user-uri (get data "userinfo_endpoint"))))))
+
+(defn- initialize-oidc-provider
+  [cfg]
+  (let [opts {:base-uri      (cf/get :oidc-base-uri)
+              :client-id     (cf/get :oidc-client-id)
+              :client-secret (cf/get :oidc-client-secret)
+              :token-uri     (cf/get :oidc-token-uri)
+              :auth-uri      (cf/get :oidc-auth-uri)
+              :user-uri      (cf/get :oidc-user-uri)
+              :scopes        (into #{"openid" "profile" "email" "name"}
+                                   (cf/get :oidc-scopes #{}))
+              :roles-attr    (cf/get :oidc-roles-attr)
+              :roles         (cf/get :oidc-roles)
+              :name          "oidc"}]
+    (if (and (string? (:base-uri opts))
+             (string? (:client-id opts))
+             (string? (:client-secret opts)))
+      (if (and (string? (:token-uri opts))
+               (string? (:user-uri opts))
+               (string? (:auth-uri opts)))
+        (do
+          (l/info :action "initialize" :provider "oid" :method "static")
+          (assoc-in cfg [:providers "oidc"] opts))
+        (let [opts (discover-oidc-config opts)]
+          (l/info :action "initialize" :provider "oid" :method "discover")
+          (assoc-in cfg [:providers "oidc"] opts)))
+      cfg)))
+
+(defn- initialize-google-provider
+  [cfg]
+  (let [opts {:client-id     (cf/get :google-client-id)
+              :client-secret (cf/get :google-client-secret)
+              :scopes        #{"email" "profile" "openid"
+                               "https://www.googleapis.com/auth/userinfo.email"
+                               "https://www.googleapis.com/auth/userinfo.profile"}
+              :auth-uri      "https://accounts.google.com/o/oauth2/v2/auth"
+              :token-uri     "https://oauth2.googleapis.com/token"
+              :user-uri      "https://openidconnect.googleapis.com/v1/userinfo"
+              :name          "google"}]
+    (if (and (string? (:client-id opts))
+             (string? (:client-secret opts)))
+      (do
+        (l/info :action "initialize" :provider "google")
+        (assoc-in cfg [:providers "google"] opts))
+      cfg)))
+
+(defn- initialize-github-provider
+  [cfg]
+  (let [opts {:client-id     (cf/get :github-client-id)
+              :client-secret (cf/get :github-client-secret)
+              :scopes        #{"read:user"
+                               "user:email"}
+              :auth-uri      "https://github.com/login/oauth/authorize"
+              :token-uri     "https://github.com/login/oauth/access_token"
+              :user-uri      "https://api.github.com/user"
+              :name          "github"}]
+    (if (and (string? (:client-id opts))
+             (string? (:client-secret opts)))
+      (do
+        (l/info :action "initialize" :provider "github")
+        (assoc-in cfg [:providers "github"] opts))
+      cfg)))
+
+
+(defn- initialize-gitlab-provider
+  [cfg]
+  (let [base (cf/get :gitlab-base-uri "https://gitlab.com")
+        opts {:base-uri      base
+              :client-id     (cf/get :gitlab-client-id)
+              :client-secret (cf/get :gitlab-client-secret)
+              :scopes        #{"read_user"}
+              :auth-uri      (str base "/oauth/authorize")
+              :token-uri     (str base "/oauth/token")
+              :user-uri      (str base "/api/v4/user")
+              :name          "gitlab"}]
+    (if (and (string? (:client-id opts))
+             (string? (:client-secret opts)))
+      (do
+        (l/info :action "initialize" :provider "gitlab")
+        (assoc-in cfg [:providers "gitlab"] opts))
+      cfg)))
+
+(defn- initialize
+  [cfg]
+  (let [cfg (agent cfg :error-mode :continue)]
+    (send-off cfg initialize-google-provider)
+    (send-off cfg initialize-gitlab-provider)
+    (send-off cfg initialize-github-provider)
+    (send-off cfg initialize-oidc-provider)
+    cfg))

backend/src/app/http/session.clj

@@ -2,73 +2,218 @@
 ;; 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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.http.session
   (:require
+   [app.common.data :as d]
+   [app.common.exceptions :as ex]
+   [app.config :as cfg]
    [app.db :as db]
-   [app.util.log4j :refer [update-thread-context!]]
-   [buddy.core.codecs :as bc]
-   [buddy.core.nonce :as bn]
+   [app.metrics :as mtx]
+   [app.util.async :as aa]
+   [app.util.logging :as l]
+   [app.util.time :as dt]
+   [app.worker :as wrk]
+   [clojure.core.async :as a]
    [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
-(defn next-session-id
-  ([] (next-session-id 96))
-  ([n]
-   (-> (bn/random-nonce n)
-       (bc/bytes->b64u)
-       (bc/bytes->str))))
+;; A default cookie name for storing the session. We don't allow
+;; configure it.
+(def cookie-name "auth-token")
 
-(defn create!
-  [{:keys [conn] :as cfg} {:keys [profile-id user-agent]}]
-  (let [id (next-session-id)]
-    (db/insert! conn :http-session {:id id
-                                    :profile-id profile-id
-                                    :user-agent user-agent})
-    id))
+;; --- IMPL
 
-(defn delete!
-  [{:keys [conn cookie-name] :as cfg} request]
-  (when-let [token (get-in request [:cookies cookie-name :value])]
+(defn- create-session
+  [{:keys [conn tokens] :as cfg} {:keys [profile-id headers] :as request}]
+  (let [token  (tokens :generate {:iss "authentication"
+                                  :iat (dt/now)
+                                  :uid profile-id})
+        params {:user-agent (get headers "user-agent")
+                :profile-id profile-id
+                :id token}]
+    (db/insert! conn :http-session params)))
+
+(defn- delete-session
+  [{:keys [conn] :as cfg} {:keys [cookies] :as request}]
+  (when-let [token (get-in cookies [cookie-name :value])]
     (db/delete! conn :http-session {:id token}))
   nil)
 
-(defn retrieve
-  [{:keys [conn] :as cfg} token]
-  (when token
-    (-> (db/exec-one! conn ["select profile_id from http_session where id = ?" token])
-        (:profile-id))))
+(defn- retrieve-session
+  [{:keys [conn] :as cfg} id]
+  (when id
+    (db/exec-one! conn ["select id, profile_id from http_session where id = ?" id])))
 
-(defn retrieve-from-request
-  [{:keys [cookie-name] :as cfg} request]
-  (->> (get-in request [:cookies cookie-name :value])
-       (retrieve cfg)))
+(defn- retrieve-from-request
+  [cfg {:keys [cookies] :as request}]
+  (->> (get-in cookies [cookie-name :value])
+       (retrieve-session cfg)))
 
-(defn cookies
-  [{:keys [cookie-name] :as cfg} vals]
-  {cookie-name (merge vals {:path "/" :http-only true})})
+(defn- add-cookies
+  [response {:keys [id] :as session}]
+  (assoc response :cookies {cookie-name {:path "/" :http-only true :value id}}))
 
-(defn middleware
+(defn- clear-cookies
+  [response]
+  (assoc response :cookies {cookie-name {:value "" :max-age -1}}))
+
+(defn- middleware
   [cfg handler]
   (fn [request]
-    (if-let [profile-id (retrieve-from-request cfg request)]
+    (if-let [{:keys [id profile-id] :as session} (retrieve-from-request cfg request)]
       (do
-        (update-thread-context! {:profile-id profile-id})
+        (a/>!! (::events-ch cfg) id)
+        (l/update-thread-context! {:profile-id profile-id})
         (handler (assoc request :profile-id profile-id)))
       (handler request))))
 
+;; --- STATE INIT: SESSION
+
 (defmethod ig/pre-init-spec ::session [_]
   (s/keys :req-un [::db/pool]))
 
 (defmethod ig/prep-key ::session
   [_ cfg]
-  (merge {:cookie-name "auth-token"} cfg))
+  (d/merge {:buffer-size 64}
+           (d/without-nils cfg)))
 
 (defmethod ig/init-key ::session
   [_ {:keys [pool] :as cfg}]
-  (let [cfg (assoc cfg :conn pool)]
-    (merge cfg {:middleware #(middleware cfg %)})))
+  (let [events (a/chan (a/dropping-buffer (:buffer-size cfg)))
+        cfg    (-> cfg
+                   (assoc :conn pool)
+                   (assoc ::events-ch events))]
+    (-> cfg
+        (assoc :middleware #(middleware cfg %))
+        (assoc :create (fn [profile-id]
+                         (fn [request response]
+                           (let [request (assoc request :profile-id profile-id)
+                                 session (create-session cfg request)]
+                             (add-cookies response session)))))
+        (assoc :delete (fn [request response]
+                         (delete-session cfg request)
+                         (-> response
+                             (assoc :status 204)
+                             (assoc :body "")
+                             (clear-cookies)))))))
+
+(defmethod ig/halt-key! ::session
+  [_ data]
+  (a/close! (::events-ch data)))
+
+
+;; --- STATE INIT: SESSION UPDATER
+
+(declare batch-events)
+(declare update-sessions)
+
+(s/def ::session map?)
+(s/def ::max-batch-age ::cfg/http-session-updater-batch-max-age)
+(s/def ::max-batch-size ::cfg/http-session-updater-batch-max-size)
+
+(defmethod ig/pre-init-spec ::updater [_]
+  (s/keys :req-un [::db/pool ::wrk/executor ::mtx/metrics ::session]
+          :opt-un [::max-batch-age
+                   ::max-batch-size]))
+
+(defmethod ig/prep-key ::updater
+  [_ cfg]
+  (merge {:max-batch-age (dt/duration {:minutes 5})
+          :max-batch-size 200}
+         (d/without-nils cfg)))
+
+(defmethod ig/init-key ::updater
+  [_ {:keys [session metrics] :as cfg}]
+  (l/info :action "initialize session updater"
+          :max-batch-age (str (:max-batch-age cfg))
+          :max-batch-size (str (:max-batch-size cfg)))
+  (let [input (batch-events cfg (::events-ch session))
+        mcnt  (mtx/create
+               {:name "http_session_update_total"
+                :help "A counter of session update batch events."
+                :registry (:registry metrics)
+                :type :counter})]
+    (a/go-loop []
+      (when-let [[reason batch] (a/<! input)]
+        (let [result (a/<! (update-sessions cfg batch))]
+          (mcnt :inc)
+          (if (ex/exception? result)
+            (l/error :task "updater"
+                     :hint "unexpected error on update sessions"
+                     :cause result)
+            (l/debug :task "updater"
+                     :action "update sessions"
+                     :reason (name reason)
+                     :count result))
+          (recur))))))
+
+(defn- timeout-chan
+  [cfg]
+  (a/timeout (inst-ms (:max-batch-age cfg))))
+
+(defn- batch-events
+  [cfg in]
+  (let [out (a/chan)]
+    (a/go-loop [tch (timeout-chan cfg)
+                buf #{}]
+      (let [[val port] (a/alts! [tch in])]
+        (cond
+          (identical? port tch)
+          (if (empty? buf)
+            (recur (timeout-chan cfg) buf)
+            (do
+              (a/>! out [:timeout buf])
+              (recur (timeout-chan cfg) #{})))
+
+          (nil? val)
+          (a/close! out)
+
+          (identical? port in)
+          (let [buf (conj buf val)]
+            (if (>= (count buf) (:max-batch-size cfg))
+              (do
+                (a/>! out [:size buf])
+                (recur (timeout-chan cfg) #{}))
+              (recur tch buf))))))
+    out))
+
+(defn- update-sessions
+  [{:keys [pool executor]} ids]
+  (aa/with-thread executor
+    (db/exec-one! pool ["update http_session set updated_at=now() where id = ANY(?)"
+                        (into-array String ids)])
+    (count ids)))
+
+;; --- STATE INIT: SESSION GC
+
+(declare sql:delete-expired)
+
+(s/def ::max-age ::dt/duration)
+
+(defmethod ig/pre-init-spec ::gc-task [_]
+  (s/keys :req-un [::db/pool]
+          :opt-un [::max-age]))
+
+(defmethod ig/prep-key ::gc-task
+  [_ cfg]
+  (merge {:max-age (dt/duration {:days 2})}
+         (d/without-nils cfg)))
+
+(defmethod ig/init-key ::gc-task
+  [_ {:keys [pool max-age] :as cfg}]
+  (fn [_]
+    (db/with-atomic [conn pool]
+      (let [interval (db/interval max-age)
+            result   (db/exec-one! conn [sql:delete-expired interval])
+            result   (:next.jdbc/update-count result)]
+        (l/debug :task "gc"
+                 :action "clean http sessions"
+                 :count result)
+        result))))
+
+(def ^:private
+  sql:delete-expired
+  "delete from http_session
+    where updated_at < now() - ?::interval")

backend/src/app/loggers/loki.clj

@@ -0,0 +1,93 @@
+;; 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.loki
+  "A Loki integration."
+  (:require
+   [app.common.spec :as us]
+   [app.config :as cfg]
+   [app.util.async :as aa]
+   [app.util.http :as http]
+   [app.util.json :as json]
+   [app.util.logging :as l]
+   [app.worker :as wrk]
+   [clojure.core.async :as a]
+   [clojure.spec.alpha :as s]
+   [integrant.core :as ig]))
+
+(declare handle-event)
+
+(s/def ::uri ::us/string)
+(s/def ::receiver fn?)
+
+(defmethod ig/pre-init-spec ::reporter [_]
+  (s/keys :req-un [::wrk/executor ::receiver]
+          :opt-un [::uri]))
+
+(defmethod ig/init-key ::reporter
+  [_ {:keys [receiver uri] :as cfg}]
+  (when uri
+    (l/info :msg "intializing loki reporter" :uri uri)
+    (let [output (a/chan (a/sliding-buffer 1024))]
+      (receiver :sub output)
+      (a/go-loop []
+        (let [msg (a/<! output)]
+          (if (nil? msg)
+            (l/info :msg "stoping error reporting loop")
+            (do
+              (a/<! (handle-event cfg msg))
+              (recur)))))
+      output)))
+
+(defmethod ig/halt-key! ::reporter
+  [_ output]
+  (when output
+    (a/close! output)))
+
+(defn- prepare-payload
+  [event]
+  (let [labels {:host    (cfg/get :host)
+                :tenant  (cfg/get :tenant)
+                :version (:full cfg/version)
+                :logger  (:logger event)
+                :level   (:level event)}]
+    {:streams
+     [{:stream labels
+       :values [[(str (* (inst-ms (:created-at event)) 1000000))
+                 (str (:message event)
+                      (when-let [error (:error event)]
+                        (str "\n" (:trace error))))]]}]}))
+
+(defn- send-log
+  [uri payload i]
+  (try
+    (let [response (http/send! {:uri uri
+                                :timeout 6000
+                                :method :post
+                                :headers {"content-type" "application/json"}
+                                :body (json/encode payload)})]
+      (if (= (:status response) 204)
+        true
+        (do
+          (l/error :hint "error on sending log to loki"
+                   :try i
+                   :rsp (pr-str response))
+          false)))
+    (catch Exception e
+      (l/error :hint "error on sending message to loki"
+               :cause e
+               :try i)
+      false)))
+
+(defn- handle-event
+  [{:keys [executor uri]} event]
+  (aa/with-thread executor
+    (let [payload (prepare-payload event)]
+      (loop [i 1]
+        (when (and (not (send-log uri payload i)) (< i 20))
+          (Thread/sleep (* i 2000))
+          (recur (inc i)))))))
+

backend/src/app/loggers/mattermost.clj

@@ -2,12 +2,9 @@
 ;; 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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 Andrey Antukh <niwi@niwi.nz>
+;; Copyright (c) UXBOX Labs SL
 
-(ns app.error-reporter
+(ns app.loggers.mattermost
   "A mattermost integration for error reporting."
   (:require
    [app.common.exceptions :as ex]
@@ -15,20 +12,17 @@
    [app.common.uuid :as uuid]
    [app.config :as cfg]
    [app.db :as db]
+   [app.util.async :as aa]
    [app.util.http :as http]
    [app.util.json :as json]
+   [app.util.logging :as l]
    [app.util.template :as tmpl]
    [app.worker :as wrk]
    [clojure.core.async :as a]
    [clojure.java.io :as io]
    [clojure.spec.alpha :as s]
-   [clojure.tools.logging :as log]
    [cuerdas.core :as str]
-   [integrant.core :as ig]
-   [promesa.exec :as px])
-  (:import
-   org.apache.logging.log4j.core.LogEvent
-   org.apache.logging.log4j.util.ReadOnlyStringMap))
+   [integrant.core :as ig]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Error Listener
@@ -37,76 +31,52 @@
 (declare handle-event)
 
 (defonce enabled-mattermost (atom true))
-(defonce queue (a/chan (a/sliding-buffer 64)))
-(defonce queue-fn (fn [event] (a/>!! queue event)))
 
 (s/def ::uri ::us/string)
 
 (defmethod ig/pre-init-spec ::reporter [_]
-  (s/keys :req-un [::wrk/executor ::db/pool]
+  (s/keys :req-un [::wrk/executor ::db/pool ::receiver]
           :opt-un [::uri]))
 
 (defmethod ig/init-key ::reporter
-  [_ {:keys [executor] :as cfg}]
-  (log/info "Intializing error reporter.")
-  (let [close-ch (a/chan 1)]
+  [_ {:keys [receiver uri] :as cfg}]
+  (l/info :msg "intializing mattermost error reporter" :uri uri)
+  (let [output (a/chan (a/sliding-buffer 128)
+                       (filter #(= (:level %) "error")))]
+    (receiver :sub output)
     (a/go-loop []
-      (let [[val port] (a/alts! [close-ch queue])]
-        (cond
-          (= port close-ch)
-          (log/info "Stoping error reporting loop.")
-
-          (nil? val)
-          (log/info "Stoping error reporting loop.")
-
-          :else
+      (let [msg (a/<! output)]
+        (if (nil? msg)
+          (l/info :msg "stoping error reporting loop")
           (do
-            (px/run! executor #(handle-event cfg val))
+            (a/<! (handle-event cfg msg))
             (recur)))))
-    close-ch))
+    output))
 
 (defmethod ig/halt-key! ::reporter
-  [_ close-ch]
-  (a/close! close-ch))
-
-(defn- get-context-data
-  [event]
-  (let [^LogEvent levent (deref event)
-        ^ReadOnlyStringMap rosm (.getContextData levent)]
-    (into {:message (str event)
-           :id      (uuid/next)} ; set default uuid for cases when it not comes.
-          (comp
-           (map (fn [[key val]]
-                  (cond
-                    (= "id" key)         [:id (uuid/uuid val)]
-                    (= "profile-id" key) [:profile-id (uuid/uuid val)]
-                    (str/blank? val)     nil
-                    (string? key)        [(keyword key) val]
-                    :else                [key val])))
-           (filter some?))
-
-          (.toMap rosm))))
+  [_ output]
+  (a/close! output))
 
 (defn- send-mattermost-notification!
-  [cfg {:keys [message host version id] :as cdata}]
+  [cfg {:keys [host version id error] :as cdata}]
   (try
-    (let [uri    (:uri cfg)
-          prefix (str "Unhandled exception (@channel):\n"
-                      "- detail: " (:public-uri cfg/config) "/dbg/error-by-id/" id "\n"
-                      "- host: `" host "`\n"
-                      "- version: `" version "`\n")
-          text   (str prefix "```\n" message "\n```")
+    (let [uri  (:uri cfg)
+          text (str "Unhandled exception (@channel):\n"
+                    "- detail: " (cfg/get :public-uri) "/dbg/error-by-id/" id "\n"
+                    "- profile-id: `" (:profile-id cdata) "`\n"
+                    "- host: `" host "`\n"
+                    "- version: `" version "`\n")
           rsp    (http/send! {:uri uri
                               :method :post
                               :headers {"content-type" "application/json"}
                               :body (json/encode-str {:text text})})]
       (when (not= (:status rsp) 200)
-        (log/warnf "Error reporting webhook replying with unexpected status: %s\n%s"
-                   (:status rsp)
-                   (pr-str rsp))))
+        (l/error :hint "error on sending data to mattermost"
+                 :response (pr-str rsp))))
 
     (catch Exception e
-      (log/warnf e "Unexpected exception on error reporter."))))
+      (l/error :hint "unexpected exception on error reporter"
+               :cause e))))
 
 (defn- persist-on-database!
   [{:keys [pool] :as cfg} {:keys [id] :as cdata}]
@@ -114,15 +84,38 @@
     (db/insert! conn :server-error-report
                 {:id id :content (db/tjson cdata)})))
 
+(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)))
+   {:id (uuid/next)}
+   (:context event)))
+
+(defn- parse-event
+  [event]
+  (-> (parse-context event)
+      (merge (dissoc event :context))
+      (assoc :tenant (cfg/get :tenant))
+      (assoc :host (cfg/get :host))
+      (assoc :public-uri (cfg/get :public-uri))
+      (assoc :version (:full cfg/version))))
+
 (defn handle-event
-  [cfg event]
-  (try
-    (let [cdata (get-context-data event)]
-      (when (and (:uri cfg) @enabled-mattermost)
-        (send-mattermost-notification! cfg cdata))
-      (persist-on-database! cfg cdata))
-    (catch Exception e
-      (log/warnf e "Unexpected exception on error reporter."))))
+  [{:keys [executor] :as cfg} event]
+  (aa/with-thread executor
+    (try
+      (let [cdata (parse-event event)]
+        (when (and (:uri cfg) @enabled-mattermost)
+          (send-mattermost-notification! cfg cdata))
+        (persist-on-database! cfg cdata))
+      (catch Exception e
+        (l/error :hint "unexpected exception on error reporter"
+                 :cause e)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Http Handler

backend/src/app/loggers/zmq.clj

@@ -0,0 +1,89 @@
+;; 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.zmq
+  "A generic ZMQ listener."
+  (:require
+   [app.common.data :as d]
+   [app.common.spec :as us]
+   [app.util.json :as json]
+   [app.util.logging :as l]
+   [app.util.time :as dt]
+   [clojure.core.async :as a]
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [integrant.core :as ig])
+  (:import
+   org.zeromq.SocketType
+   org.zeromq.ZMQ$Socket
+   org.zeromq.ZContext))
+
+(declare prepare)
+(declare start-rcv-loop)
+
+(s/def ::endpoint ::us/string)
+
+(defmethod ig/pre-init-spec ::receiver [_]
+  (s/keys :opt-un [::endpoint]))
+
+(defmethod ig/init-key ::receiver
+  [_ {:keys [endpoint] :as cfg}]
+  (l/info :msg "intializing ZMQ receiver" :bind endpoint)
+  (let [buffer (a/chan 1)
+        output (a/chan 1 (comp (filter map?)
+                               (map prepare)))
+        mult   (a/mult output)]
+    (when endpoint
+      (a/thread (start-rcv-loop {:out buffer :endpoint endpoint})))
+    (a/pipe buffer output)
+    (with-meta
+      (fn [cmd ch]
+        (case cmd
+          :sub (a/tap mult ch)
+          :unsub (a/untap mult ch))
+        ch)
+      {::output output
+       ::buffer buffer
+       ::mult mult})))
+
+(defmethod ig/halt-key! ::receiver
+  [_ f]
+  (a/close! (::buffer (meta f))))
+
+(defn- start-rcv-loop
+  ([] (start-rcv-loop nil))
+  ([{:keys [out endpoint] :or {endpoint "tcp://localhost:5556"}}]
+   (let [out    (or out (a/chan 1))
+         zctx   (ZContext.)
+         socket (.. zctx (createSocket SocketType/SUB))]
+     (.. socket (connect ^String endpoint))
+     (.. socket (subscribe ""))
+     (.. socket (setReceiveTimeOut 5000))
+     (loop []
+       (let [msg (.recv ^ZMQ$Socket socket)
+             msg (json/decode msg)
+             msg (if (nil? msg) :empty msg)]
+         (if (a/>!! out msg)
+           (recur)
+           (do
+             (.close ^java.lang.AutoCloseable socket)
+             (.close ^java.lang.AutoCloseable zctx))))))))
+
+(defn- prepare
+  [event]
+  (d/merge
+   {:logger     (:loggerName event)
+    :level      (str/lower (:level event))
+    :thread     (:thread event)
+    :created-at (dt/instant (:timeMillis event))
+    :message    (:message event)}
+   (when-let [ctx (:contextMap event)]
+     {:context ctx})
+   (when-let [thrown (:thrown event)]
+     {:error
+      {:class (:name thrown)
+       :message (:message thrown)
+       :trace (:extendedStackTrace thrown)}})))

backend/src/app/main.clj

@@ -2,318 +2,296 @@
 ;; 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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020-2021 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.main
   (:require
    [app.common.data :as d]
-   [app.config :as cfg]
+   [app.config :as cf]
+   [app.util.logging :as l]
    [app.util.time :as dt]
-   [clojure.pprint :as pprint]
-   [clojure.tools.logging :as log]
    [integrant.core :as ig]))
 
-;; Set value for all new threads bindings.
-(alter-var-root #'*assert* (constantly (:asserts-enabled cfg/config)))
+(def system-config
+  {:app.db/pool
+   {:uri        (cf/get :database-uri)
+    :username   (cf/get :database-username)
+    :password   (cf/get :database-password)
+    :metrics    (ig/ref :app.metrics/metrics)
+    :migrations (ig/ref :app.migrations/all)
+    :name :main
+    :min-pool-size 0
+    :max-pool-size 20}
 
-(derive :app.telemetry/server :app.http/server)
+   :app.metrics/metrics
+   {:definitions
+    {:profile-register
+     {:name "actions_profile_register_count"
+      :help "A global counter of user registrations."
+      :type :counter}
+     :profile-activation
+     {:name "actions_profile_activation_count"
+      :help "A global counter of profile activations"
+      :type :counter}}}
 
-;; --- Entry point
+   :app.migrations/all
+   {:main (ig/ref :app.migrations/migrations)}
 
-(defn build-system-config
-  [config]
-  (d/deep-merge
-   {:app.db/pool
-    {:uri        (:database-uri config)
-     :username   (:database-username config)
-     :password   (:database-password config)
-     :metrics    (ig/ref :app.metrics/metrics)
-     :migrations (ig/ref :app.migrations/all)
-     :name "main"
-     :min-pool-size 0
-     :max-pool-size 20}
+   :app.migrations/migrations
+   {}
 
-    :app.metrics/metrics
-    {}
+   :app.msgbus/msgbus
+   {:backend   (cf/get :msgbus-backend :redis)
+    :redis-uri (cf/get :redis-uri)}
 
-    :app.migrations/all
-    {:main (ig/ref :app.migrations/migrations)
-     :telemetry  (ig/ref :app.telemetry/migrations)}
+   :app.tokens/tokens
+   {:sprops (ig/ref :app.setup/props)}
 
-    :app.migrations/migrations
-    {}
+   :app.storage/gc-deleted-task
+   {:pool     (ig/ref :app.db/pool)
+    :storage  (ig/ref :app.storage/storage)
+    :min-age  (dt/duration {:hours 2})}
 
-    :app.telemetry/migrations
-    {}
+   :app.storage/gc-touched-task
+   {:pool     (ig/ref :app.db/pool)}
 
-    :app.redis/redis
-    {:uri (:redis-uri config)}
+   :app.storage/recheck-task
+   {:pool     (ig/ref :app.db/pool)
+    :storage  (ig/ref :app.storage/storage)}
 
-    :app.tokens/tokens
-    {:sprops (ig/ref :app.sprops/props)}
+   :app.http.session/session
+   {:pool   (ig/ref :app.db/pool)
+    :tokens (ig/ref :app.tokens/tokens)}
 
-    :app.storage/gc-deleted-task
-    {:pool     (ig/ref :app.db/pool)
-     :storage  (ig/ref :app.storage/storage)
-     :min-age  (dt/duration {:hours 2})}
+   :app.http.session/gc-task
+   {:pool        (ig/ref :app.db/pool)
+    :max-age     (cf/get :http-session-idle-max-age)}
 
-    :app.storage/gc-touched-task
-    {:pool     (ig/ref :app.db/pool)}
+   :app.http.session/updater
+   {:pool           (ig/ref :app.db/pool)
+    :metrics        (ig/ref :app.metrics/metrics)
+    :executor       (ig/ref :app.worker/executor)
+    :session        (ig/ref :app.http.session/session)
+    :max-batch-age  (cf/get :http-session-updater-batch-max-age)
+    :max-batch-size (cf/get :http-session-updater-batch-max-size)}
 
-    :app.storage/recheck-task
-    {:pool     (ig/ref :app.db/pool)
-     :storage  (ig/ref :app.storage/storage)}
+   :app.http.awsns/handler
+   {:tokens  (ig/ref :app.tokens/tokens)
+    :pool    (ig/ref :app.db/pool)}
 
-    :app.http.session/session
-    {:pool        (ig/ref :app.db/pool)
-     :cookie-name "auth-token"}
+   :app.http/server
+   {:port    (cf/get :http-server-port)
+    :router  (ig/ref :app.http/router)
+    :metrics (ig/ref :app.metrics/metrics)
+    :ws      {"/ws/notifications" (ig/ref :app.notifications/handler)}}
 
-    :app.http/server
-    {:port    (:http-server-port config)
-     :handler (ig/ref :app.http/router)
-     :metrics (ig/ref :app.metrics/metrics)
-     :ws      {"/ws/notifications" (ig/ref :app.notifications/handler)}}
+   :app.http/router
+   {:rpc         (ig/ref :app.rpc/rpc)
+    :session     (ig/ref :app.http.session/session)
+    :tokens      (ig/ref :app.tokens/tokens)
+    :public-uri  (cf/get :public-uri)
+    :metrics     (ig/ref :app.metrics/metrics)
+    :oauth       (ig/ref :app.http.oauth/handlers)
+    :assets      (ig/ref :app.http.assets/handlers)
+    :storage     (ig/ref :app.storage/storage)
+    :sns-webhook (ig/ref :app.http.awsns/handler)
+    :feedback    (ig/ref :app.http.feedback/handler)
+    :error-report-handler (ig/ref :app.loggers.mattermost/handler)}
 
-    :app.http/router
-    {:rpc         (ig/ref :app.rpc/rpc)
-     :session     (ig/ref :app.http.session/session)
-     :tokens      (ig/ref :app.tokens/tokens)
-     :public-uri  (:public-uri config)
-     :metrics     (ig/ref :app.metrics/metrics)
-     :google-auth (ig/ref :app.http.auth/google)
-     :gitlab-auth (ig/ref :app.http.auth/gitlab)
-     :github-auth (ig/ref :app.http.auth/github)
-     :ldap-auth   (ig/ref :app.http.auth/ldap)
-     :assets      (ig/ref :app.http.assets/handlers)
-     :svgparse    (ig/ref :app.svgparse/handler)
-     :storage     (ig/ref :app.storage/storage)
-     :error-report-handler (ig/ref :app.error-reporter/handler)}
+   :app.http.assets/handlers
+   {:metrics           (ig/ref :app.metrics/metrics)
+    :assets-path       (cf/get :assets-path)
+    :storage           (ig/ref :app.storage/storage)
+    :cache-max-age     (dt/duration {:hours 24})
+    :signature-max-age (dt/duration {:hours 24 :minutes 5})}
 
-    :app.http.assets/handlers
-    {:metrics           (ig/ref :app.metrics/metrics)
-     :assets-path       (:assets-path config)
-     :storage           (ig/ref :app.storage/storage)
-     :cache-max-age     (dt/duration {:hours 24})
-     :signature-max-age (dt/duration {:hours 24 :minutes 5})}
+   :app.http.feedback/handler
+   {:pool (ig/ref :app.db/pool)}
 
-    :app.http.auth/google
-    {:rpc           (ig/ref :app.rpc/rpc)
-     :session       (ig/ref :app.http.session/session)
-     :tokens        (ig/ref :app.tokens/tokens)
-     :public-uri    (:public-uri config)
-     :client-id     (:google-client-id config)
-     :client-secret (:google-client-secret config)}
+   :app.http.oauth/handlers
+   {:rpc           (ig/ref :app.rpc/rpc)
+    :session       (ig/ref :app.http.session/session)
+    :tokens        (ig/ref :app.tokens/tokens)
+    :public-uri    (cf/get :public-uri)}
 
-    :app.http.auth/github
-    {:rpc           (ig/ref :app.rpc/rpc)
-     :session       (ig/ref :app.http.session/session)
-     :tokens        (ig/ref :app.tokens/tokens)
-     :public-uri    (:public-uri config)
-     :client-id     (:github-client-id config)
-     :client-secret (:github-client-secret config)}
+   ;; RLimit definition for password hashing
+   :app.rlimits/password
+   (cf/get :rlimits-password)
 
-    :app.http.auth/gitlab
-    {:rpc           (ig/ref :app.rpc/rpc)
-     :session       (ig/ref :app.http.session/session)
-     :tokens        (ig/ref :app.tokens/tokens)
-     :public-uri    (:public-uri config)
-     :base-uri      (:gitlab-base-uri config)
-     :client-id     (:gitlab-client-id config)
-     :client-secret (:gitlab-client-secret config)}
+   ;; RLimit definition for image processing
+   :app.rlimits/image
+   (cf/get :rlimits-image)
 
-    :app.http.auth/ldap
-    {:host               (:ldap-auth-host config)
-     :port               (:ldap-auth-port config)
-     :ssl                (:ldap-auth-ssl config)
-     :starttls           (:ldap-auth-starttls config)
-     :user-query         (:ldap-auth-user-query config)
-     :username-attribute (:ldap-auth-username-attribute config)
-     :email-attribute    (:ldap-auth-email-attribute config)
-     :fullname-attribute (:ldap-auth-fullname-attribute config)
-     :avatar-attribute   (:ldap-auth-avatar-attribute config)
-     :base-dn            (:ldap-auth-base-dn config)
-     :session            (ig/ref :app.http.session/session)
-     :rpc                (ig/ref :app.rpc/rpc)}
+   ;; A collection of rlimits as hash-map.
+   :app.rlimits/all
+   {:password (ig/ref :app.rlimits/password)
+    :image    (ig/ref :app.rlimits/image)}
 
-    :app.svgparse/svgc
-    {:metrics (ig/ref :app.metrics/metrics)}
+   :app.rpc/rpc
+   {:pool       (ig/ref :app.db/pool)
+    :session    (ig/ref :app.http.session/session)
+    :tokens     (ig/ref :app.tokens/tokens)
+    :metrics    (ig/ref :app.metrics/metrics)
+    :storage    (ig/ref :app.storage/storage)
+    :msgbus     (ig/ref :app.msgbus/msgbus)
+    :rlimits    (ig/ref :app.rlimits/all)
+    :public-uri (cf/get :public-uri)}
 
-    ;; HTTP Handler for SVG parsing
-    :app.svgparse/handler
-    {:metrics (ig/ref :app.metrics/metrics)
-     :svgc    (ig/ref :app.svgparse/svgc)}
+   :app.notifications/handler
+   {:msgbus   (ig/ref :app.msgbus/msgbus)
+    :pool     (ig/ref :app.db/pool)
+    :session  (ig/ref :app.http.session/session)
+    :metrics  (ig/ref :app.metrics/metrics)
+    :executor (ig/ref :app.worker/executor)}
 
-    ;; RLimit definition for password hashing
-    :app.rlimits/password
-    (:rlimits-password config)
+   :app.worker/executor
+   {:min-threads 0
+    :max-threads 256
+    :idle-timeout 60000
+    :name :worker}
 
-    ;; RLimit definition for image processing
-    :app.rlimits/image
-    (:rlimits-image config)
+   :app.worker/worker
+   {:executor (ig/ref :app.worker/executor)
+    :tasks    (ig/ref :app.worker/registry)
+    :metrics  (ig/ref :app.metrics/metrics)
+    :pool     (ig/ref :app.db/pool)}
 
-    ;; A collection of rlimits as hash-map.
-    :app.rlimits/all
-    {:password (ig/ref :app.rlimits/password)
-     :image    (ig/ref :app.rlimits/image)}
+   :app.worker/scheduler
+   {:executor   (ig/ref :app.worker/executor)
+    :tasks      (ig/ref :app.worker/registry)
+    :pool       (ig/ref :app.db/pool)
+    :schedule
+    [{:cron #app/cron "0 0 0 */1 * ? *" ;; daily
+      :task :file-media-gc}
 
-    :app.rpc/rpc
-    {:pool    (ig/ref :app.db/pool)
-     :session (ig/ref :app.http.session/session)
-     :tokens  (ig/ref :app.tokens/tokens)
-     :metrics (ig/ref :app.metrics/metrics)
-     :storage (ig/ref :app.storage/storage)
-     :redis   (ig/ref :app.redis/redis)
-     :rlimits (ig/ref :app.rlimits/all)
-     :svgc    (ig/ref :app.svgparse/svgc)}
+     {:cron #app/cron "0 0 */1 * * ?"  ;; hourly
+      :task :file-xlog-gc}
 
-    :app.notifications/handler
-    {:redis   (ig/ref :app.redis/redis)
-     :pool    (ig/ref :app.db/pool)
-     :session (ig/ref :app.http.session/session)
-     :metrics (ig/ref :app.metrics/metrics)}
+     {:cron #app/cron "0 0 1 */1 * ?"  ;; daily (1 hour shift)
+      :task :storage-deleted-gc}
 
-    :app.worker/executor
-    {:name "worker"}
+     {:cron #app/cron "0 0 2 */1 * ?"  ;; daily (2 hour shift)
+      :task :storage-touched-gc}
 
-    :app.worker/worker
-    {:executor   (ig/ref :app.worker/executor)
-     :pool       (ig/ref :app.db/pool)
-     :tasks      (ig/ref :app.tasks/all)}
+     {:cron #app/cron "0 0 3 */1 * ?"  ;; daily (3 hour shift)
+      :task :session-gc}
 
-    :app.worker/scheduler
-    {:executor   (ig/ref :app.worker/executor)
-     :pool       (ig/ref :app.db/pool)
-     :schedule
-     [{:id "file-media-gc"
-       :cron #app/cron "0 0 0 */1 * ? *" ;; daily
-       :fn (ig/ref :app.tasks.file-media-gc/handler)}
+     {:cron #app/cron "0 0 */1 * * ?"  ;; hourly
+      :task :storage-recheck}
 
-      {:id "file-xlog-gc"
-       :cron #app/cron "0 0 */1 * * ?"  ;; hourly
-       :fn (ig/ref :app.tasks.file-xlog-gc/handler)}
+     {:cron #app/cron "0 0 0 */1 * ?"  ;; daily
+      :task :tasks-gc}
 
-      {:id "storage-deleted-gc"
-       :cron #app/cron "0 0 1 */1 * ?"  ;; daily (1 hour shift)
-       :fn (ig/ref :app.storage/gc-deleted-task)}
+     (when (cf/get :telemetry-enabled)
+       {:cron #app/cron "0 0 */6 * * ?" ;; every 6h
+        :task :telemetry})]}
 
-      {:id "storage-touched-gc"
-       :cron #app/cron "0 0 2 */1 * ?"  ;; daily (2 hour shift)
-       :fn (ig/ref :app.storage/gc-touched-task)}
+   :app.worker/registry
+   {:metrics (ig/ref :app.metrics/metrics)
+    :tasks
+    {:sendmail           (ig/ref :app.emails/sendmail-handler)
+     :delete-object      (ig/ref :app.tasks.delete-object/handler)
+     :delete-profile     (ig/ref :app.tasks.delete-profile/handler)
+     :file-media-gc      (ig/ref :app.tasks.file-media-gc/handler)
+     :file-xlog-gc       (ig/ref :app.tasks.file-xlog-gc/handler)
+     :storage-deleted-gc (ig/ref :app.storage/gc-deleted-task)
+     :storage-touched-gc (ig/ref :app.storage/gc-touched-task)
+     :storage-recheck    (ig/ref :app.storage/recheck-task)
+     :tasks-gc           (ig/ref :app.tasks.tasks-gc/handler)
+     :telemetry          (ig/ref :app.tasks.telemetry/handler)
+     :session-gc         (ig/ref :app.http.session/gc-task)}}
 
-      {:id "storage-recheck"
-       :cron #app/cron "0 0 */1 * * ?"  ;; hourly
-       :fn (ig/ref :app.storage/recheck-task)}
+   :app.emails/sendmail-handler
+   {:host             (cf/get :smtp-host)
+    :port             (cf/get :smtp-port)
+    :ssl              (cf/get :smtp-ssl)
+    :tls              (cf/get :smtp-tls)
+    :enabled          (cf/get :smtp-enabled)
+    :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)}
 
-      {:id "tasks-gc"
-       :cron #app/cron "0 0 0 */1 * ?"  ;; daily
-       :fn (ig/ref :app.tasks.tasks-gc/handler)}
+   :app.tasks.tasks-gc/handler
+   {:pool    (ig/ref :app.db/pool)
+    :max-age (dt/duration {:hours 24})
+    :metrics (ig/ref :app.metrics/metrics)}
 
-      (when (:telemetry-enabled config)
-        {:id   "telemetry"
-         :cron #app/cron "0 0 */6 * * ?" ;; every 6h
-         :uri  (:telemetry-uri config)
-         :fn   (ig/ref :app.tasks.telemetry/handler)})]}
+   :app.tasks.delete-object/handler
+   {:pool    (ig/ref :app.db/pool)
+    :metrics (ig/ref :app.metrics/metrics)}
 
-    :app.tasks/all
-    {"sendmail"       (ig/ref :app.tasks.sendmail/handler)
-     "delete-object"  (ig/ref :app.tasks.delete-object/handler)
-     "delete-profile" (ig/ref :app.tasks.delete-profile/handler)}
+   :app.tasks.delete-storage-object/handler
+   {:pool    (ig/ref :app.db/pool)
+    :storage (ig/ref :app.storage/storage)
+    :metrics (ig/ref :app.metrics/metrics)}
 
-    :app.tasks.sendmail/handler
-    {:host             (:smtp-host config)
-     :port             (:smtp-port config)
-     :ssl              (:smtp-ssl config)
-     :tls              (:smtp-tls config)
-     :enabled          (:smtp-enabled config)
-     :username         (:smtp-username config)
-     :password         (:smtp-password config)
-     :metrics          (ig/ref :app.metrics/metrics)
-     :default-reply-to (:smtp-default-reply-to config)
-     :default-from     (:smtp-default-from config)}
+   :app.tasks.delete-profile/handler
+   {:pool    (ig/ref :app.db/pool)
+    :metrics (ig/ref :app.metrics/metrics)}
 
-    :app.tasks.tasks-gc/handler
-    {:pool    (ig/ref :app.db/pool)
-     :max-age (dt/duration {:hours 24})
-     :metrics (ig/ref :app.metrics/metrics)}
+   :app.tasks.file-media-gc/handler
+   {:pool    (ig/ref :app.db/pool)
+    :metrics (ig/ref :app.metrics/metrics)
+    :max-age (dt/duration {:hours 48})}
 
-    :app.tasks.delete-object/handler
-    {:pool    (ig/ref :app.db/pool)
-     :metrics (ig/ref :app.metrics/metrics)}
+   :app.tasks.file-xlog-gc/handler
+   {:pool    (ig/ref :app.db/pool)
+    :metrics (ig/ref :app.metrics/metrics)
+    :max-age (dt/duration {:hours 48})}
 
-    :app.tasks.delete-storage-object/handler
-    {:pool    (ig/ref :app.db/pool)
-     :storage (ig/ref :app.storage/storage)
-     :metrics (ig/ref :app.metrics/metrics)}
+   :app.tasks.telemetry/handler
+   {:pool        (ig/ref :app.db/pool)
+    :version     (:full cf/version)
+    :uri         (cf/get :telemetry-uri)
+    :sprops      (ig/ref :app.setup/props)}
 
-    :app.tasks.delete-profile/handler
-    {:pool    (ig/ref :app.db/pool)
-     :metrics (ig/ref :app.metrics/metrics)}
+   :app.srepl/server
+   {:port (cf/get :srepl-port)
+    :host (cf/get :srepl-host)}
 
-    :app.tasks.file-media-gc/handler
-    {:pool    (ig/ref :app.db/pool)
-     :metrics (ig/ref :app.metrics/metrics)
-     :max-age (dt/duration {:hours 48})}
+   :app.setup/props
+   {:pool (ig/ref :app.db/pool)}
 
-    :app.tasks.file-xlog-gc/handler
-    {:pool    (ig/ref :app.db/pool)
-     :metrics (ig/ref :app.metrics/metrics)
-     :max-age (dt/duration {:hours 48})}
+   :app.loggers.zmq/receiver
+   {:endpoint (cf/get :loggers-zmq-uri)}
 
-    :app.tasks.telemetry/handler
-    {:pool        (ig/ref :app.db/pool)
-     :version     (:full cfg/version)
-     :uri         (:telemetry-uri config)
-     :sprops      (ig/ref :app.sprops/props)}
+   :app.loggers.loki/reporter
+   {:uri      (cf/get :loggers-loki-uri)
+    :receiver (ig/ref :app.loggers.zmq/receiver)
+    :executor (ig/ref :app.worker/executor)}
 
-    :app.srepl/server
-    {:port (:srepl-port config)
-     :host (:srepl-host config)}
+   :app.loggers.mattermost/reporter
+   {:uri      (cf/get :error-report-webhook)
+    :receiver (ig/ref :app.loggers.zmq/receiver)
+    :pool     (ig/ref :app.db/pool)
+    :executor (ig/ref :app.worker/executor)}
 
-    :app.sprops/props
-    {:pool (ig/ref :app.db/pool)}
+   :app.loggers.mattermost/handler
+   {:pool (ig/ref :app.db/pool)}
 
-    :app.error-reporter/reporter
-    {:uri      (:error-report-webhook config)
-     :pool     (ig/ref :app.db/pool)
-     :executor (ig/ref :app.worker/executor)}
+   :app.storage/storage
+   {:pool     (ig/ref :app.db/pool)
+    :executor (ig/ref :app.worker/executor)
+    :backend  (cf/get :storage-backend :fs)
+    :backends {:s3  (ig/ref [::main :app.storage.s3/backend])
+               :db  (ig/ref [::main :app.storage.db/backend])
+               :fs  (ig/ref [::main :app.storage.fs/backend])
+               :tmp (ig/ref [::tmp  :app.storage.fs/backend])}}
 
-    :app.error-reporter/handler
-    {:pool (ig/ref :app.db/pool)}
+   [::main :app.storage.s3/backend]
+   {:region (cf/get :storage-s3-region)
+    :bucket (cf/get :storage-s3-bucket)}
 
-    :app.storage/storage
-    {:pool     (ig/ref :app.db/pool)
-     :executor (ig/ref :app.worker/executor)
-     :backend  (:storage-backend config :fs)
-     :backends {:s3  (ig/ref [::main :app.storage.s3/backend])
-                :db  (ig/ref [::main :app.storage.db/backend])
-                :fs  (ig/ref [::main :app.storage.fs/backend])
-                :tmp (ig/ref [::tmp  :app.storage.fs/backend])}}
+   [::main :app.storage.fs/backend]
+   {:directory (cf/get :storage-fs-directory)}
 
-    [::main :app.storage.s3/backend]
-    {:region (:storage-s3-region config)
-     :bucket (:storage-s3-bucket config)}
+   [::tmp :app.storage.fs/backend]
+   {:directory "/tmp/penpot"}
 
-    [::main :app.storage.fs/backend]
-    {:directory (:storage-fs-directory config)}
-
-    [::tmp :app.storage.fs/backend]
-    {:directory "/tmp/penpot"}
-
-    [::main :app.storage.db/backend]
-    {:pool (ig/ref :app.db/pool)}}
-
-   (when (:telemetry-server-enabled config)
-     {:app.telemetry/handler
-      {:pool     (ig/ref :app.db/pool)
-       :executor (ig/ref :app.worker/executor)}
-
-      :app.telemetry/server
-      {:port    (:telemetry-server-port config 6063)
-       :handler (ig/ref :app.telemetry/handler)
-       :name    "telemetry"}})))
+   [::main :app.storage.db/backend]
+   {:pool (ig/ref :app.db/pool)}})
 
 (defmethod ig/init-key :default [_ data] data)
 (defmethod ig/prep-key :default
@@ -326,15 +304,14 @@
 
 (defn start
   []
-  (let [system-config (build-system-config cfg/config)]
-    (ig/load-namespaces system-config)
-    (alter-var-root #'system (fn [sys]
-                               (when sys (ig/halt! sys))
-                               (-> system-config
-                                   (ig/prep)
-                                   (ig/init))))
-    (log/infof "Welcome to penpot! Version: '%s'."
-               (:full cfg/version))))
+  (ig/load-namespaces system-config)
+  (alter-var-root #'system (fn [sys]
+                             (when sys (ig/halt! sys))
+                             (-> system-config
+                                 (ig/prep)
+                                 (ig/init))))
+  (l/info :msg "welcome to penpot"
+          :version (:full cf/version)))
 
 (defn stop
   []
@@ -342,14 +319,6 @@
                              (when sys (ig/halt! sys))
                              nil)))
 
-(prefer-method print-method
-               clojure.lang.IRecord
-               clojure.lang.IDeref)
-
-(prefer-method pprint/simple-dispatch
-               clojure.lang.IPersistentMap
-               clojure.lang.IDeref)
-
 (defn -main
   [& _args]
   (start))

backend/src/app/media.clj

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.media
   "Media postprocessing."
@@ -15,7 +12,7 @@
    [app.common.media :as cm]
    [app.common.spec :as us]
    [app.rlimits :as rlm]
-   [app.svgparse :as svg]
+   [app.rpc.queries.svg :as svg]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [datoteka.core :as fs])
@@ -77,7 +74,7 @@
       (assoc params
              :format format
              :mtype  (cm/format->mtype format)
-             :size   (alength thumbnail-data)
+             :size   (alength ^bytes thumbnail-data)
              :data   (ByteArrayInputStream. thumbnail-data)))))
 
 (defmulti process :cmd)
@@ -89,7 +86,7 @@
              (.addImage)
              (.autoOrient)
              (.strip)
-             (.thumbnail (int width) (int height) ">")
+             (.thumbnail ^Integer (int width) ^Integer (int height) ">")
              (.quality (double quality))
              (.addImage))]
     (generic-process (assoc params :operation op))))
@@ -101,7 +98,7 @@
              (.addImage)
              (.autoOrient)
              (.strip)
-             (.thumbnail (int width) (int height) "^")
+             (.thumbnail ^Integer (int width) ^Integer (int height) "^")
              (.gravity "center")
              (.extent (int width) (int height))
              (.quality (double quality))
@@ -157,8 +154,11 @@
                     :code :media-type-mismatch
                     :hint (str "Seems like you are uploading a file whose content does not match the extension."
                                "Expected: " mtype ". Got: " mtype')))
-        {:width  (.getImageWidth instance)
-         :height (.getImageHeight instance)
+        ;; For an animated GIF, getImageWidth/Height returns the delta size of one frame (if no frame given
+        ;; it returns size of the last one), whereas getPageWidth/Height always return the full size of
+        ;; any frame.
+        {:width  (.getPageWidth instance)
+         :height (.getPageHeight instance)
          :mtype  mtype}))))
 
 (defmethod process :default
@@ -185,8 +185,9 @@
 ;; --- Utility functions
 
 (defn validate-media-type
-  [media-type]
-  (when-not (cm/valid-media-types media-type)
-    (ex/raise :type :validation
-              :code :media-type-not-allowed
-              :hint "Seems like you are uploading an invalid media object")))
+  ([mtype] (validate-media-type mtype cm/valid-media-types))
+  ([mtype allowed]
+   (when-not (contains? allowed mtype)
+     (ex/raise :type :validation
+               :code :media-type-not-allowed
+               :hint "Seems like you are uploading an invalid media object"))))

backend/src/app/metrics.clj

@@ -2,25 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020-2021 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.metrics
   (:require
    [app.common.exceptions :as ex]
-   [app.util.time :as dt]
-   [app.worker]
+   [app.util.logging :as l]
    [clojure.spec.alpha :as s]
-   [clojure.tools.logging :as log]
-   [integrant.core :as ig]
-   [next.jdbc :as jdbc])
+   [integrant.core :as ig])
   (:import
    io.prometheus.client.CollectorRegistry
    io.prometheus.client.Counter
    io.prometheus.client.Gauge
    io.prometheus.client.Summary
+   io.prometheus.client.Histogram
    io.prometheus.client.exporter.common.TextFormat
    io.prometheus.client.hotspot.DefaultExports
    io.prometheus.client.jetty.JettyStatisticsCollector
@@ -30,41 +25,12 @@
 (declare instrument-vars!)
 (declare instrument)
 (declare create-registry)
-
+(declare create)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Entry Point
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defn- instrument-jdbc!
-  [registry]
-  (instrument-vars!
-   [#'next.jdbc/execute-one!
-    #'next.jdbc/execute!]
-   {:registry registry
-    :type :counter
-    :name "database_query_counter"
-    :help "An absolute counter of database queries."}))
-
-(defn- instrument-workers!
-  [registry]
-  (instrument-vars!
-   [#'app.worker/run-task]
-   {:registry registry
-    :type :summary
-    :name "worker_task_checkout_millis"
-    :help "Latency measured between scheduld_at and execution time."
-    :wrap (fn [rootf mobj]
-            (let [mdata (meta rootf)
-                  origf (::original mdata rootf)]
-              (with-meta
-                (fn [tasks item]
-                  (let [now (inst-ms (dt/now))
-                        sat (inst-ms (:scheduled-at item))]
-                    (mobj :observe (- now sat))
-                    (origf tasks item)))
-                {::original origf})))}))
-
 (defn- handler
   [registry _request]
   (let [samples  (.metricFamilySamples ^CollectorRegistry registry)
@@ -73,13 +39,24 @@
     {:headers {"content-type" TextFormat/CONTENT_TYPE_004}
      :body (.toString writer)}))
 
+(s/def ::definitions
+  (s/map-of keyword? map?))
+
+(defmethod ig/pre-init-spec ::metrics [_]
+  (s/keys :opt-un [::definitions]))
+
 (defmethod ig/init-key ::metrics
-  [_ _cfg]
-  (log/infof "Initializing prometheus registry and instrumentation.")
-  (let [registry (create-registry)]
-    (instrument-workers! registry)
-    (instrument-jdbc! registry)
+  [_ {:keys [definitions] :as cfg}]
+  (l/info :action "initialize metrics")
+  (let [registry    (create-registry)
+        definitions (reduce-kv (fn [res k v]
+                                 (->> (assoc v :registry registry)
+                                      (create)
+                                      (assoc res k)))
+                               {}
+                               definitions)]
     {:handler (partial handler registry)
+     :definitions definitions
      :registry registry}))
 
 (s/def ::handler fn?)
@@ -87,7 +64,6 @@
 (s/def ::metrics
   (s/keys :req-un [::registry ::handler]))
 
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Implementation
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -126,7 +102,7 @@
 
       (invoke [_ cmd labels]
         (.. ^Counter instance
-            (labels labels)
+            (labels (into-array String labels))
             (inc))))))
 
 (defn make-gauge
@@ -150,19 +126,27 @@
           :dec (.dec ^Gauge instance)))
 
       (invoke [_ cmd labels]
-        (case cmd
-          :inc (.. ^Gauge instance (labels labels) (inc))
-          :dec (.. ^Gauge instance (labels labels) (dec)))))))
+        (let [labels (into-array String [labels])]
+          (case cmd
+            :inc (.. ^Gauge instance (labels labels) (inc))
+            :dec (.. ^Gauge instance (labels labels) (dec))))))))
+
+(def default-quantiles
+  [[0.75 0.02]
+   [0.99 0.001]])
 
 (defn make-summary
-  [{:keys [name help registry reg labels max-age] :or {max-age 3600} :as props}]
+  [{:keys [name help registry reg labels max-age quantiles buckets]
+    :or {max-age 3600 buckets 6 quantiles default-quantiles} :as props}]
   (let [registry (or registry reg)
         instance (doto (Summary/build)
                    (.name name)
-                   (.help help)
-                   (.maxAgeSeconds max-age)
-                   (.quantile 0.75 0.02)
-                   (.quantile 0.99 0.001))
+                   (.help help))
+        _        (when (seq quantiles)
+                   (.maxAgeSeconds ^Summary instance max-age)
+                   (.ageBuckets ^Summary instance buckets))
+        _        (doseq [[q e] quantiles]
+                   (.quantile ^Summary instance q e))
         _        (when (seq labels)
                    (.labelNames instance (into-array String labels)))
         instance (.register instance registry)]
@@ -176,7 +160,34 @@
 
       (invoke [_ cmd val labels]
         (.. ^Summary instance
-            (labels labels)
+            (labels (into-array String labels))
+            (observe val))))))
+
+(def default-histogram-buckets
+  [1 5 10 25 50 75 100 250 500 750 1000 2500 5000 7500])
+
+(defn make-histogram
+  [{:keys [name help registry reg labels buckets]
+    :or {buckets default-histogram-buckets}}]
+  (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)]
+    (reify
+      clojure.lang.IDeref
+      (deref [_] instance)
+
+      clojure.lang.IFn
+      (invoke [_ cmd val]
+        (.observe ^Histogram instance val))
+
+      (invoke [_ cmd val labels]
+        (.. ^Histogram instance
+            (labels (into-array String labels))
             (observe val))))))
 
 (defn create
@@ -184,7 +195,8 @@
   (case type
     :counter (make-counter props)
     :gauge   (make-gauge props)
-    :summary (make-summary props)))
+    :summary (make-summary props)
+    :histogram (make-histogram props)))
 
 (defn wrap-counter
   ([rootf mobj]
@@ -204,7 +216,6 @@
        (assoc mdata ::original origf))))
   ([rootf mobj labels]
    (let [mdata  (meta rootf)
-         labels (into-array String labels)
          origf  (::original mdata rootf)]
      (with-meta
        (fn
@@ -241,7 +252,6 @@
 
   ([rootf mobj labels]
    (let [mdata  (meta rootf)
-         labels (into-array String labels)
          origf  (::original mdata rootf)]
      (with-meta
        (fn
@@ -284,6 +294,9 @@
       (instance? Summary @obj)
       ((or wrap wrap-summary) f obj)
 
+      (instance? Histogram @obj)
+      ((or wrap wrap-summary) f obj)
+
       :else
       (ex/raise :type :not-implemented))))
 

backend/src/app/migrations.clj

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.migrations
   (:require
@@ -148,6 +145,27 @@
 
    {:name "0045-add-index-to-file-change-table"
     :fn (mg/resource "app/migrations/sql/0045-add-index-to-file-change-table.sql")}
+
+   {:name "0046-add-profile-complaint-table"
+    :fn (mg/resource "app/migrations/sql/0046-add-profile-complaint-table.sql")}
+
+   {:name "0047-mod-file-change-table"
+    :fn (mg/resource "app/migrations/sql/0047-mod-file-change-table.sql")}
+
+   {:name "0048-mod-storage-tables"
+    :fn (mg/resource "app/migrations/sql/0048-mod-storage-tables.sql")}
+
+   {:name "0049-mod-http-session-table"
+    :fn (mg/resource "app/migrations/sql/0049-mod-http-session-table.sql")}
+
+   {:name "0050-mod-server-prop-table"
+    :fn (mg/resource "app/migrations/sql/0050-mod-server-prop-table.sql")}
+
+   {:name "0051-mod-file-library-rel-table"
+    :fn (mg/resource "app/migrations/sql/0051-mod-file-library-rel-table.sql")}
+
+   {:name "0052-del-legacy-user-and-team"
+    :fn (mg/resource "app/migrations/sql/0052-del-legacy-user-and-team.sql")}
    ])
 
 

backend/src/app/migrations/migration_0023.clj

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.migrations.migration-0023
   (:require

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

@@ -10,11 +10,17 @@ CREATE TABLE storage_object (
   metadata jsonb NULL DEFAULT NULL
 );
 
+CREATE INDEX storage_object__id__deleted_at__idx
+    ON storage_object(id, deleted_at)
+ WHERE deleted_at IS NOT null;
+
 CREATE TABLE storage_data (
   id uuid PRIMARY KEY REFERENCES storage_object (id) ON DELETE CASCADE,
   data bytea NOT NULL
 );
 
+CREATE INDEX storage_data__id__idx ON storage_data(id);
+
 -- Table used for store inflight upload ids, for later recheck and
 -- delete possible staled files that exists on the phisical storage
 -- but does not exists in the 'storage_object' table.
@@ -28,8 +34,3 @@ CREATE TABLE storage_pending (
   PRIMARY KEY (created_at, id)
 );
 
-CREATE INDEX storage_data__id__idx ON storage_data(id);
-CREATE INDEX storage_object__id__deleted_at__idx
-    ON storage_object(id, deleted_at)
- WHERE deleted_at IS NOT null;
-

backend/src/app/migrations/sql/0044-add-storage-refcount.sql

@@ -5,9 +5,6 @@ CREATE INDEX storage_object__id_touched_at__idx
     ON storage_object (touched_at, id)
  WHERE touched_at IS NOT NULL;
 
--- DROP TRIGGER file_media_object__on_delete__tgr ON file_media_object CASCADE;
--- DROP FUNCTION on_delete_file_media_object () ;
-
 CREATE OR REPLACE FUNCTION on_delete_file_media_object()
   RETURNS TRIGGER AS $func$
   BEGIN

backend/src/app/migrations/sql/0046-add-profile-complaint-table.sql

@@ -0,0 +1,45 @@
+CREATE TABLE profile_complaint_report (
+  profile_id uuid NOT NULL REFERENCES profile(id) ON DELETE CASCADE,
+  created_at timestamptz NOT NULL DEFAULT now(),
+
+  type text NOT NULL,
+  content jsonb,
+
+  PRIMARY KEY (profile_id, created_at)
+);
+
+ALTER TABLE profile_complaint_report
+  ALTER COLUMN type SET STORAGE external,
+  ALTER COLUMN content SET STORAGE external;
+
+ALTER TABLE profile
+  ADD COLUMN is_muted boolean DEFAULT false,
+  ADD COLUMN auth_backend text NULL;
+
+ALTER TABLE profile
+  ALTER COLUMN auth_backend SET STORAGE external;
+
+UPDATE profile
+   SET auth_backend = 'google'
+ WHERE password = '!';
+
+UPDATE profile
+   SET auth_backend = 'penpot'
+ WHERE password != '!';
+
+-- Table storing a permanent complaint table for register all
+-- permanent bounces and spam reports (complaints) and avoid sending
+-- more emails there.
+CREATE TABLE global_complaint_report (
+  email text NOT NULL,
+  created_at timestamptz NOT NULL DEFAULT now(),
+
+  type text NOT NULL,
+  content jsonb,
+
+  PRIMARY KEY (email, created_at)
+);
+
+ALTER TABLE global_complaint_report
+  ALTER COLUMN type SET STORAGE external,
+  ALTER COLUMN content SET STORAGE external;

backend/src/app/migrations/sql/0047-mod-file-change-table.sql

@@ -0,0 +1,16 @@
+--- Helps on the lagged changes query on update-file rpc
+CREATE INDEX file_change__file_id__revn__idx ON file_change (file_id, revn);
+
+--- Drop redundant index
+DROP INDEX page_change_file_id_idx;
+
+--- Add profile_id field.
+ALTER TABLE file_change
+  ADD COLUMN profile_id uuid NULL REFERENCES profile (id) ON DELETE SET NULL;
+
+CREATE INDEX file_change__profile_id__idx
+    ON file_change (profile_id)
+ WHERE profile_id IS NOT NULL;
+
+--- Fix naming
+ALTER INDEX file_change__created_at_idx RENAME TO file_change__created_at__idx;

backend/src/app/migrations/sql/0048-mod-storage-tables.sql

@@ -0,0 +1,9 @@
+--- Drop redundant index already covered by primary key
+DROP INDEX storage_data__id__idx;
+
+--- Replace not efficient index with more efficient one
+DROP INDEX storage_object__id__deleted_at__idx;
+
+CREATE INDEX storage_object__id__deleted_at__idx
+    ON storage_object(deleted_at, id)
+ WHERE deleted_at IS NOT NULL;

backend/src/app/migrations/sql/0049-mod-http-session-table.sql

@@ -0,0 +1,6 @@
+ALTER TABLE http_session
+  ADD COLUMN updated_at timestamptz NULL;
+
+CREATE INDEX http_session__updated_at__idx
+    ON http_session (updated_at)
+ WHERE updated_at IS NOT NULL;

backend/src/app/migrations/sql/0050-mod-server-prop-table.sql

@@ -0,0 +1,4 @@
+ALTER TABLE server_prop
+  ADD COLUMN preload boolean DEFAULT false;
+
+UPDATE server_prop SET preload = true;

backend/src/app/migrations/sql/0051-mod-file-library-rel-table.sql

@@ -0,0 +1,4 @@
+ALTER TABLE file_library_rel
+ DROP CONSTRAINT file_library_rel_library_file_id_fkey,
+  ADD CONSTRAINT file_library_rel_library_file_id_fkey
+         FOREIGN KEY (library_file_id) REFERENCES file(id) ON DELETE CASCADE DEFERRABLE;

backend/src/app/migrations/sql/0052-del-legacy-user-and-team.sql

@@ -0,0 +1,2 @@
+DELETE FROM team WHERE id = '00000000-0000-0000-0000-000000000000';
+DELETE FROM profile WHERE id = '00000000-0000-0000-0000-000000000000';

backend/src/app/msgbus.clj

@@ -0,0 +1,294 @@
+;; 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.msgbus
+  "The msgbus abstraction implemented using redis as underlying backend."
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.config :as cfg]
+   [app.util.blob :as blob]
+   [app.util.logging :as l]
+   [app.util.time :as dt]
+   [clojure.core.async :as a]
+   [clojure.spec.alpha :as s]
+   [integrant.core :as ig]
+   [promesa.core :as p])
+  (:import
+   java.time.Duration
+   io.lettuce.core.RedisClient
+   io.lettuce.core.RedisURI
+   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.async.RedisPubSubAsyncCommands))
+
+(def ^:private prefix (cfg/get :tenant))
+
+(defn- prefix-topic
+  [topic]
+  (str prefix "." topic))
+
+(def xform-prefix (map prefix-topic))
+(def xform-topics (map (fn [m] (update m :topics #(into #{} xform-prefix %)))))
+(def xform-topic  (map (fn [m] (update m :topic prefix-topic))))
+
+(s/def ::redis-uri ::us/string)
+(s/def ::buffer-size ::us/integer)
+
+(defmulti init-backend :backend)
+(defmulti stop-backend :backend)
+(defmulti init-pub-loop :backend)
+(defmulti init-sub-loop :backend)
+
+(defmethod ig/pre-init-spec ::msgbus [_]
+  (s/keys :opt-un [::buffer-size ::redis-uri]))
+
+(defmethod ig/prep-key ::msgbus
+  [_ cfg]
+  (merge {:buffer-size 128} cfg))
+
+(defmethod ig/init-key ::msgbus
+  [_ {:keys [backend buffer-size] :as cfg}]
+  (l/debug :action "initialize msgbus"
+           :backend (name backend))
+  (let [cfg     (init-backend cfg)
+
+        ;; Channel used for receive publications from the application.
+        pub-ch  (-> (a/dropping-buffer buffer-size)
+                    (a/chan xform-topic))
+
+        ;; Channel used for receive subscription requests.
+        sub-ch  (a/chan 1 xform-topics)
+
+        cfg     (-> cfg
+                    (assoc ::pub-ch pub-ch)
+                    (assoc ::sub-ch sub-ch))]
+
+    (init-pub-loop cfg)
+    (init-sub-loop cfg)
+
+    (with-meta
+      (fn run
+        ([command] (run command nil))
+        ([command params]
+         (a/go
+           (case command
+             :pub (a/>! pub-ch params)
+             :sub (a/>! sub-ch params)))))
+      cfg)))
+
+(defmethod ig/halt-key! ::msgbus
+  [_ f]
+  (let [mdata (meta f)]
+    (stop-backend mdata)
+    (a/close! (::pub-ch mdata))
+    (a/close! (::sub-ch mdata))))
+
+;; --- IN-MEMORY BACKEND IMPL
+
+(defmethod init-backend :memory [cfg] cfg)
+(defmethod stop-backend :memory [_])
+(defmethod init-pub-loop :memory [_])
+
+(defmethod init-sub-loop :memory
+  [{:keys [::sub-ch ::pub-ch]}]
+  (a/go-loop [state {}]
+    (let [[val port] (a/alts! [pub-ch sub-ch])]
+      (cond
+        (and (= port sub-ch) (some? val))
+        (let [{:keys [topics chan]} val]
+          (recur (reduce #(update %1 %2 (fnil conj #{}) chan) state topics)))
+
+        (and (= port pub-ch) (some? val))
+        (let [topic   (:topic val)
+              message (:message val)
+              state   (loop [state state
+                             chans (get state topic)]
+                        (if-let [c (first chans)]
+                          (if (a/>! c message)
+                            (recur state (rest chans))
+                            (recur (update state topic disj c)
+                                   (rest chans)))
+                          state))]
+          (recur state))
+
+        :else
+        (->> (vals state)
+             (mapcat identity)
+             (run! a/close!))))))
+
+
+;; Add a unique listener to connection
+
+;; --- REDIS BACKEND IMPL
+
+(declare impl-redis-pub)
+(declare impl-redis-sub)
+(declare impl-redis-unsub)
+
+(defmethod init-backend :redis
+  [{:keys [redis-uri] :as cfg}]
+  (let [codec    (RedisCodec/of StringCodec/UTF8 ByteArrayCodec/INSTANCE)
+
+        uri      (RedisURI/create redis-uri)
+        rclient  (RedisClient/create ^RedisURI uri)
+
+        pub-conn (.connect ^RedisClient rclient ^RedisCodec codec)
+        sub-conn (.connectPubSub ^RedisClient rclient ^RedisCodec codec)]
+
+    (.setTimeout ^StatefulRedisConnection pub-conn ^Duration (dt/duration {:seconds 10}))
+    (.setTimeout ^StatefulRedisPubSubConnection sub-conn ^Duration (dt/duration {:seconds 10}))
+
+    (-> cfg
+        (assoc ::pub-conn pub-conn)
+        (assoc ::sub-conn sub-conn))))
+
+(defmethod stop-backend :redis
+  [{:keys [::pub-conn ::sub-conn] :as cfg}]
+  (.close ^StatefulRedisConnection pub-conn)
+  (.close ^StatefulRedisPubSubConnection sub-conn))
+
+(defmethod init-pub-loop :redis
+  [{:keys [::pub-conn ::pub-ch]}]
+  (let [rac (.async ^StatefulRedisConnection pub-conn)]
+    (a/go-loop []
+      (when-let [val (a/<! pub-ch)]
+        (let [result (a/<! (impl-redis-pub rac val))]
+          (when (ex/exception? result)
+            (l/error :cause result
+                     :hint "unexpected error on publish message to redis")))
+        (recur)))))
+
+(defmethod init-sub-loop :redis
+  [{:keys [::sub-conn ::sub-ch buffer-size]}]
+  (let [rcv-ch  (a/chan (a/dropping-buffer buffer-size))
+        chans   (agent {} :error-handler #(l/error :cause % :hint "unexpected error on agent"))
+        rac     (.async ^StatefulRedisPubSubConnection sub-conn)]
+
+    ;; Add a unique listener to connection
+    (.addListener sub-conn
+                  (reify RedisPubSubListener
+                    (message [it pattern topic message])
+                    (message [it topic message]
+                      ;; There are no back pressure, so we use a slidding
+                      ;; buffer for cases when the pubsub broker sends
+                      ;; more messages that we can process.
+                      (let [val {:topic topic :message (blob/decode message)}]
+                        (when-not (a/offer! rcv-ch val)
+                          (l/warn :msg "dropping message on subscription loop"))))
+                    (psubscribed [it pattern count])
+                    (punsubscribed [it pattern count])
+                    (subscribed [it topic count])
+                    (unsubscribed [it topic count])))
+
+    (letfn [(subscribe-to-single-topic [nsubs topic chan]
+              (let [nsubs (if (nil? nsubs) #{chan} (conj nsubs chan))]
+                (when (= 1 (count nsubs))
+                  (let [result (a/<!! (impl-redis-sub rac topic))]
+                    (l/trace :action "open subscription"
+                             :topic topic)
+                    (when (ex/exception? result)
+                      (l/error :cause result
+                               :hint "unexpected exception on subscribing"
+                               :topic topic))))
+                nsubs))
+
+            (subscribe-to-topics [state topics chan]
+              (let [state  (update state :chans assoc chan topics)]
+                (reduce (fn [state topic]
+                          (update-in state [:topics topic] subscribe-to-single-topic topic chan))
+                        state
+                        topics)))
+
+            (unsubscribe-from-single-topic [nsubs topic chan]
+              (let [nsubs (disj nsubs chan)]
+                (when (empty? nsubs)
+                  (let [result (a/<!! (impl-redis-unsub rac topic))]
+                    (l/trace :action "close subscription"
+                             :topic topic)
+                    (when (ex/exception? result)
+                      (l/error :cause result
+                               :hint "unexpected exception on unsubscribing"
+                               :topic topic))))
+                nsubs))
+
+            (unsubscribe-channels [state pending]
+              (reduce (fn [state ch]
+                        (let [topics (get-in state [:chans ch])
+                              state  (update state :chans dissoc ch)]
+                          (reduce (fn [state topic]
+                                    (update-in state [:topics topic] unsubscribe-from-single-topic topic ch))
+                                  state
+                                  topics)))
+                      state
+                      pending))]
+
+      ;; Asynchronous subscription loop;
+      (a/go-loop []
+        (if-let [{:keys [topics chan]} (a/<! sub-ch)]
+          (do
+            (send-off chans subscribe-to-topics topics chan)
+            (recur))
+          (a/close! rcv-ch)))
+
+      ;; Asyncrhonous message processing loop;x
+      (a/go-loop []
+        (if-let [{:keys [topic message]} (a/<! rcv-ch)]
+          ;; This means we receive data from redis and we need to
+          ;; forward it to the underlying subscriptions.
+          (let [pending (loop [chans   (seq (get-in @chans [:topics topic]))
+                               pending #{}]
+                          (if-let [ch (first chans)]
+                            (if (a/>! ch message)
+                              (recur (rest chans) pending)
+                              (recur (rest chans) (conj pending ch)))
+                            pending))]
+            (some->> (seq pending)
+                     (send-off chans unsubscribe-channels))
+
+            (recur))
+
+          ;; Stop condition; close all underlying subscriptions and
+          ;; exit. The close operation is performed asynchronously.
+          (send-off chans (fn [state]
+                            (->> (vals state)
+                                 (mapcat identity)
+                                 (filter some?)
+                                 (run! a/close!)))))))))
+
+
+(defn- impl-redis-pub
+  [^RedisAsyncCommands rac {:keys [topic message]}]
+  (let [message (blob/encode message)
+        res     (a/chan 1)]
+    (-> (.publish rac ^String topic ^bytes message)
+        (p/finally (fn [_ e]
+                     (when e (a/>!! res e))
+                     (a/close! res))))
+    res))
+
+(defn impl-redis-sub
+  [^RedisPubSubAsyncCommands rac topic]
+  (let [res (a/chan 1)]
+    (-> (.subscribe rac (into-array String [topic]))
+        (p/finally (fn [_ e]
+                     (when e (a/>!! res e))
+                     (a/close! res))))
+    res))
+
+(defn impl-redis-unsub
+  [rac topic]
+  (let [res (a/chan 1)]
+    (-> (.unsubscribe rac (into-array String [topic]))
+        (p/finally (fn [_ e]
+                     (when e (a/>!! res e))
+                     (a/close! res))))
+    res))

backend/src/app/notifications.clj

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020-2021 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.notifications
   "A websocket based notifications mechanism."
@@ -13,12 +10,13 @@
    [app.common.spec :as us]
    [app.db :as db]
    [app.metrics :as mtx]
-   [app.redis :as rd]
    [app.util.async :as aa]
+   [app.util.logging :as l]
+   [app.util.time :as dt]
    [app.util.transit :as t]
+   [app.worker :as wrk]
    [clojure.core.async :as a]
    [clojure.spec.alpha :as s]
-   [clojure.tools.logging :as log]
    [integrant.core :as ig]
    [ring.adapter.jetty9 :as jetty]
    [ring.middleware.cookies :refer [wrap-cookies]]
@@ -34,9 +32,10 @@
 (declare handler)
 
 (s/def ::session map?)
+(s/def ::msgbus fn?)
 
 (defmethod ig/pre-init-spec ::handler [_]
-  (s/keys :req-un [::rd/redis ::db/pool ::session ::mtx/metrics]))
+  (s/keys :req-un [::msgbus ::db/pool ::session ::mtx/metrics ::wrk/executor]))
 
 (defmethod ig/init-key ::handler
   [_ {:keys [session metrics] :as cfg}]
@@ -44,29 +43,32 @@
 
         mtx-active-connections
         (mtx/create
-         {:name "websocket_notifications_active_connections"
+         {:name "websocket_active_connections"
           :registry (:registry metrics)
           :type :gauge
-          :help "Active websocket connections on notifications service."})
+          :help "Active websocket connections."})
 
-        mtx-message-recv
+        mtx-messages
         (mtx/create
-         {:name "websocket_notifications_message_recv_timing"
+         {:name "websocket_message_total"
           :registry (:registry metrics)
-          :type :summary
-          :help "Message receive summary timing (ms)."})
+          :labels ["op"]
+          :type :counter
+          :help "Counter of processed messages."})
 
-        mtx-message-send
+        mtx-sessions
         (mtx/create
-         {:name "websocket_notifications_message_send_timing"
+         {:name "websocket_session_timing"
           :registry (:registry metrics)
-          :type :summary
-          :help "Message receive summary timing (ms)."})
+          :quantiles []
+          :help "Websocket session timing (seconds)."
+          :type :summary})
 
         cfg (assoc cfg
                    :mtx-active-connections mtx-active-connections
-                   :mtx-message-recv mtx-message-recv
-                   :mtx-message-send mtx-message-send)]
+                   :mtx-messages mtx-messages
+                   :mtx-sessions mtx-sessions
+                   )]
     (-> #(handler cfg %)
         (wrap-session)
         (wrap-keyword-params)
@@ -109,14 +111,10 @@
   (db/exec-one! conn [sql:retrieve-file id]))
 
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; WebSocket Http Handler
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; --- WEBSOCKET INIT
 
 (declare handle-connect)
 
-(defrecord WebSocket [conn in out sub])
-
 (defn- ws-send
   [conn data]
   (try
@@ -127,177 +125,156 @@
       false)))
 
 (defn websocket
-  [{:keys [file-id team-id redis] :as cfg}]
-  (let [in  (a/chan 32)
-        out (a/chan 32)
-        mtx-active-connections (:mtx-active-connections cfg)
-        mtx-message-send       (:mtx-message-send cfg)
-        mtx-message-recv       (:mtx-message-recv cfg)
-
-        ws-send (mtx/wrap-summary ws-send mtx-message-send)]
+  [{:keys [file-id team-id msgbus executor] :as cfg}]
+  (let [rcv-ch       (a/chan 32)
+        out-ch       (a/chan 32)
+        mtx-aconn    (:mtx-active-connections cfg)
+        mtx-messages (:mtx-messages cfg)
+        mtx-sessions (:mtx-sessions cfg)
+        created-at   (dt/now)
+        ws-send      (mtx/wrap-counter ws-send mtx-messages ["send"])]
 
     (letfn [(on-connect [conn]
-              (mtx-active-connections :inc)
-              (let [sub (rd/subscribe redis {:xform (map t/decode-str)
-                                             :topics [file-id team-id]})
-                    ws  (WebSocket. conn in out sub nil cfg)]
+              (mtx-aconn :inc)
+              ;; A subscription channel should use a lossy buffer
+              ;; because we can't penalize normal clients when one
+              ;; slow client is connected to the room.
+              (let [sub-ch (a/chan (a/dropping-buffer 128))
+                    cfg    (assoc cfg
+                                  :conn conn
+                                  :rcv-ch rcv-ch
+                                  :out-ch out-ch
+                                  :sub-ch sub-ch)]
 
-                ;; message forwarding loop
+                (l/trace :event "connect" :session (:session-id cfg))
+
+                ;; Forward all messages from out-ch to the websocket
+                ;; connection
                 (a/go-loop []
-                  (let [val (a/<! out)]
-                    (when-not (nil? val)
-                      (when (ws-send conn (t/encode-str val))
+                  (let [val (a/<! out-ch)]
+                    (when (some? val)
+                      (when (a/<! (aa/thread-call executor #(ws-send conn (t/encode-str val))))
                         (recur)))))
 
                 (a/go
-                  (a/<! (handle-connect ws))
-                  (a/close! sub))))
+                  ;; Subscribe to corresponding topics
+                  (a/<! (msgbus :sub {:topics [file-id team-id] :chan sub-ch}))
+                  (a/<! (handle-connect cfg))
+
+                  ;; when connection is closed
+                  (mtx-aconn :dec)
+                  (mtx-sessions :observe (/ (inst-ms (dt/duration-between created-at (dt/now))) 1000.0))
+
+                  ;; close subscription
+                  (a/close! sub-ch))))
 
             (on-error [_conn _e]
-              (a/close! out)
-              (a/close! in))
+              (l/trace :event "error" :session (:session-id cfg))
+
+              (a/close! out-ch)
+              (a/close! rcv-ch))
 
             (on-close [_conn _status _reason]
-              (mtx-active-connections :dec)
-              (a/close! out)
-              (a/close! in))
+              (l/trace :event "close" :session (:session-id cfg))
+
+              (a/close! out-ch)
+              (a/close! rcv-ch))
 
             (on-message [_ws message]
               (let [message (t/decode-str message)]
-                (a/>!! in message)))]
+                (when-not (a/offer! rcv-ch message)
+                  (l/warn :msg "drop messages"))))]
 
       {:on-connect on-connect
        :on-error on-error
        :on-close on-close
-       :on-text (mtx/wrap-summary on-message mtx-message-recv)
+       :on-text (mtx/wrap-counter on-message mtx-messages ["recv"])
        :on-bytes (constantly nil)})))
 
+;; --- CONNECTION INIT
+
+(declare send-presence)
 (declare handle-message)
 (declare start-loop!)
 
 (defn- handle-connect
-  [{:keys [conn] :as ws}]
+  [cfg]
   (a/go
-    (try
-      (aa/<? (handle-message ws {:type :connect}))
-      (aa/<? (start-loop! ws))
-      (aa/<? (handle-message ws {:type :disconnect}))
-      (catch Throwable err
-        (log/errorf err "Unexpected exception on websocket handler.")
-        (let [session (.getSession conn)]
-          (when session
-            (.disconnect session)))))))
+    (a/<! (handle-message cfg {:type :connect}))
+    (a/<! (start-loop! cfg))
+    (a/<! (handle-message cfg {:type :disconnect}))))
 
 (defn- start-loop!
-  [{:keys [in out sub session-id] :as ws}]
-  (aa/go-try
-   (loop []
-     (let [timeout (a/timeout 30000)
-           [val port] (a/alts! [in sub timeout])]
+  [{:keys [rcv-ch out-ch sub-ch session-id] :as cfg}]
+  (a/go-loop []
+    (let [timeout    (a/timeout 30000)
+          [val port] (a/alts! [rcv-ch sub-ch timeout])]
+      (cond
+        ;; Process message coming from connected client
+        (and (= port rcv-ch) (some? val))
+        (do
+          (a/<! (handle-message cfg val))
+          (recur))
 
-       ;; (prn "alts" val "from" (cond (= port in)  "input"
-       ;;                              (= port sub) "redis"
-       ;;                              :else "timeout"))
+        ;; Process message coming from pubsub.
+        (and (= port sub-ch) (some? val))
+        (do
+          (when-not (= (:session-id val) session-id)
+            ;; If we receive a connect message of other user, we need
+            ;; to send an update presence to all participants.
+            (when (= :connect (:type val))
+              (a/<! (send-presence cfg :presence)))
 
-       (cond
-         ;; Process message coming from connected client
-         (and (= port in) (not (nil? val)))
-         (do
-           (aa/<? (handle-message ws val))
-           (recur))
+            ;; Then, just forward the message
+            (a/>! out-ch val))
+          (recur))
 
-         ;; Forward message to the websocket
-         (and (= port sub) (not (nil? val)))
-         (do
-           (when-not (= (:session-id val) session-id)
-             (a/>! out val))
-           (recur))
+        ;; When timeout channel is signaled, we need to send a ping
+        ;; message to the output channel. TODO: we need to make this
+        ;; more smart.
+        (= port timeout)
+        (do
+          (a/>! out-ch {:type :ping})
+          (recur))))))
 
-         ;; Timeout channel signaling
-         (= port timeout)
-         (do
-           (a/>! out {:type :ping})
-           (recur))
+(defn send-presence
+  ([cfg] (send-presence cfg :presence))
+  ([{:keys [msgbus session-id profile-id file-id]} type]
+   (a/go
+     (a/<! (msgbus :pub {:topic file-id
+                         :message {:type type
+                                   :session-id session-id
+                                   :profile-id profile-id}})))))
 
-         :else
-         nil)))))
-
-;; Incoming Messages Handling
-
-(defn- publish
-  [redis channel message]
-  (aa/go-try
-   (let [message (t/encode-str message)]
-     (aa/<? (rd/run redis :publish {:channel (str channel)
-                                         :message message})))))
-
-(def ^:private
-  sql:retrieve-presence
-  "select * from presence
-    where file_id=?
-      and (clock_timestamp() - updated_at) < '5 min'::interval")
-
-(defn- retrieve-presence
-  [pool file-id]
-  (aa/thread-try
-   (let [rows (db/exec! pool [sql:retrieve-presence file-id])]
-     (mapv (juxt :session-id :profile-id) rows))))
-
-(def ^:private
-  sql:update-presence
-  "insert into presence (file_id, session_id, profile_id, updated_at)
-   values (?, ?, ?, clock_timestamp())
-       on conflict (file_id, session_id, profile_id)
-       do update set updated_at=clock_timestamp()")
-
-(defn- update-presence
-  [conn file-id session-id profile-id]
-  (aa/thread-try
-   (let [sql [sql:update-presence file-id session-id profile-id]]
-     (db/exec-one! conn sql))))
-
-(defn- delete-presence
-  [pool file-id session-id profile-id]
-  (aa/thread-try
-   (db/delete! pool :presence {:file-id file-id
-                               :profile-id profile-id
-                               :session-id session-id})))
+;; --- INCOMING MSG PROCESSING
 
 (defmulti handle-message
   (fn [_ message] (:type message)))
 
-;; TODO: check permissions for join a file-id channel (probably using
-;; single use token for avoid explicit database query).
-
 (defmethod handle-message :connect
-  [{:keys [file-id profile-id session-id pool redis] :as ws} _message]
-  ;; (log/debugf "profile '%s' is connected to file '%s'" profile-id file-id)
-  (aa/go-try
-   (aa/<? (update-presence pool file-id session-id profile-id))
-   (let [members (aa/<? (retrieve-presence pool file-id))]
-     (aa/<? (publish redis file-id {:type :presence :sessions members})))))
+  [cfg _]
+  (send-presence cfg :connect))
 
 (defmethod handle-message :disconnect
-  [{:keys [profile-id file-id session-id redis pool] :as ws} _message]
-  ;; (log/debugf "profile '%s' is disconnected from '%s'" profile-id file-id)
-  (aa/go-try
-   (aa/<? (delete-presence pool file-id session-id profile-id))
-   (let [members (aa/<? (retrieve-presence pool file-id))]
-     (aa/<? (publish redis file-id {:type :presence :sessions members})))))
+  [cfg _]
+  (send-presence cfg :disconnect))
 
 (defmethod handle-message :keepalive
-  [{:keys [profile-id file-id session-id pool] :as ws} _message]
-  (update-presence pool file-id session-id profile-id))
+  [_ _]
+  (a/go :nothing))
 
 (defmethod handle-message :pointer-update
-  [{:keys [profile-id file-id session-id redis] :as ws} message]
+  [{:keys [profile-id file-id session-id msgbus] :as cfg} message]
   (let [message (assoc message
                        :profile-id profile-id
                        :session-id session-id)]
-    (publish redis file-id message)))
+    (msgbus :pub {:topic file-id
+                  :message message})))
 
 (defmethod handle-message :default
   [_ws message]
   (a/go
-    (log/warnf "received unexpected message: %s" message)))
+    (l/log :level :warn
+           :msg "received unexpected message"
+           :message message)))
 

backend/src/app/redis.clj

@@ -1,58 +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) 2019 Andrey Antukh <niwi@niwi.nz>
-
-(ns app.redis
-  (:refer-clojure :exclude [run!])
-  (:require
-   [app.common.spec :as us]
-   [app.util.redis :as redis]
-   [clojure.spec.alpha :as s]
-   [integrant.core :as ig])
-  (:import
-   java.lang.AutoCloseable))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; State
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defmethod ig/pre-init-spec ::redis [_]
-  (s/keys :req-un [::uri]))
-
-(defmethod ig/init-key ::redis
-  [_ cfg]
-  (let [client (redis/client (:uri cfg "redis://redis/0"))
-        conn   (redis/connect client)]
-    {::client client
-     ::conn conn}))
-
-(defmethod ig/halt-key! ::redis
-  [_ {:keys [::client ::conn]}]
-  (.close ^AutoCloseable conn)
-  (.close ^AutoCloseable client))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; API
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(s/def ::client some?)
-(s/def ::conn some?)
-(s/def ::redis (s/keys :req [::client ::conn]))
-
-(defn subscribe
-  [client opts]
-  (us/assert ::redis client)
-  (redis/subscribe (::client client) opts))
-
-(defn run!
-  [client cmd params]
-  (us/assert ::redis client)
-  (redis/run! (::conn client) cmd params))
-
-(defn run
-  [client cmd params]
-  (us/assert ::redis client)
-  (redis/run (::conn client) cmd params))
-

backend/src/app/rlimits.clj

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020-2021 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.rlimits
   "Resource usage limits (in other words: semaphores)."

backend/src/app/rpc.clj

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020-2021 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.rpc
   (:require
@@ -15,9 +12,9 @@
    [app.db :as db]
    [app.metrics :as mtx]
    [app.rlimits :as rlm]
+   [app.util.logging :as l]
    [app.util.services :as sv]
    [clojure.spec.alpha :as s]
-   [clojure.tools.logging :as log]
    [cuerdas.core :as str]
    [integrant.core :as ig]))
 
@@ -25,18 +22,29 @@
   [_]
   (ex/raise :type :not-found))
 
+(defn- run-hook
+  [hook-fn response]
+  (ex/ignoring (hook-fn))
+  response)
+
 (defn- rpc-query-handler
   [methods {:keys [profile-id] :as request}]
   (let [type   (keyword (get-in request [:path-params :type]))
-        data   (assoc (:params request) ::type type)
+
+        data   (d/merge (:params request)
+                        (:body-params request)
+                        (:uploads request))
+
         data   (if profile-id
                  (assoc data :profile-id profile-id)
                  (dissoc data :profile-id))
+
         result ((get methods type default-handler) data)
         mdata  (meta result)]
 
     (cond->> {:status 200 :body result}
-      (fn? (:transform-response mdata)) ((:transform-response mdata) request))))
+      (fn? (:transform-response mdata))
+      ((:transform-response mdata) request))))
 
 (defn- rpc-mutation-handler
   [methods {:keys [profile-id] :as request}]
@@ -50,7 +58,11 @@
         result ((get methods type default-handler) data)
         mdata  (meta result)]
     (cond->> {:status 200 :body result}
-      (fn? (:transform-response mdata)) ((:transform-response mdata) request))))
+      (fn? (:transform-response mdata))
+      ((:transform-response mdata) request)
+
+      (fn? (:before-complete mdata))
+      (run-hook (:before-complete mdata)))))
 
 (defn- wrap-with-metrics
   [cfg f mdata]
@@ -66,7 +78,8 @@
         (ex/raise :type :internal
                   :code :rlimit-not-configured
                   :hint (str/fmt "%s rlimit not configured" key)))
-      (log/tracef "Adding rlimit to '%s' rpc handler." (::sv/name mdata))
+      (l/trace :action "add rlimit"
+               :handler (::sv/name mdata))
       (fn [cfg params]
         (rlm/execute rlinst (f cfg params))))
     f))
@@ -76,7 +89,8 @@
   (let [f     (wrap-with-rlimits cfg f mdata)
         f     (wrap-with-metrics cfg f mdata)
         spec  (or (::sv/spec mdata) (s/spec any?))]
-    (log/tracef "Registering '%s' command to rpc service." (::sv/name mdata))
+    (l/trace :action "register"
+             :name (::sv/name mdata))
     (fn [params]
       (when (and (:auth mdata true) (not (uuid? (:profile-id params))))
         (ex/raise :type :authentication
@@ -96,7 +110,7 @@
               {:name "rpc_query_timing"
                :labels ["name"]
                :registry (get-in cfg [:metrics :registry])
-               :type :summary
+               :type :histogram
                :help "Timing of query services."})
         cfg  (assoc cfg ::mobj mobj)]
     (->> (sv/scan-ns 'app.rpc.queries.projects
@@ -105,7 +119,8 @@
                      'app.rpc.queries.comments
                      'app.rpc.queries.profile
                      'app.rpc.queries.recent-files
-                     'app.rpc.queries.viewer)
+                     'app.rpc.queries.viewer
+                     'app.rpc.queries.svg)
          (map (partial process-method cfg))
          (into {}))))
 
@@ -115,7 +130,7 @@
               {:name "rpc_mutation_timing"
                :labels ["name"]
                :registry (get-in cfg [:metrics :registry])
-               :type :summary
+               :type :histogram
                :help "Timing of mutation services."})
         cfg  (assoc cfg ::mobj mobj)]
     (->> (sv/scan-ns 'app.rpc.mutations.demo
@@ -126,7 +141,8 @@
                      'app.rpc.mutations.projects
                      'app.rpc.mutations.viewer
                      'app.rpc.mutations.teams
-                     'app.rpc.mutations.feedback
+                     'app.rpc.mutations.management
+                     'app.rpc.mutations.ldap
                      'app.rpc.mutations.verify-token)
          (map (partial process-method cfg))
          (into {}))))

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

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.rpc.mutations.comments
   (:require
@@ -146,14 +143,14 @@
   (db/with-atomic [conn pool]
     (let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
       (when-not thread
-        (ex/raise :type :not-found)
+        (ex/raise :type :not-found))
 
       (files/check-read-permissions! conn profile-id (:file-id thread))
 
       (db/update! conn :comment-thread
                   {:is-resolved is-resolved}
                   {:id id})
-      nil))))
+      nil)))
 
 
 ;; --- Mutation: Add Comment

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

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.rpc.mutations.demo
   "A demo specific mutations."
@@ -14,10 +11,10 @@
    [app.common.uuid :as uuid]
    [app.config :as cfg]
    [app.db :as db]
-   [app.db.profile-initial-data :refer [create-profile-initial-data]]
    [app.rpc.mutations.profile :as profile]
-   [app.tasks :as tasks]
+   [app.setup.initial-data :as sid]
    [app.util.services :as sv]
+   [app.worker :as wrk]
    [buddy.core.codecs :as bc]
    [buddy.core.nonce :as bn]
    [clojure.spec.alpha :as s]))
@@ -36,11 +33,11 @@
         params   {:id id
                   :email email
                   :fullname fullname
-                  :demo? true
+                  :is-demo true
                   :password password
                   :props {:onboarding-viewed true}}]
 
-    (when-not (:allow-demo-users cfg/config)
+    (when-not (cfg/get :allow-demo-users)
       (ex/raise :type :validation
                 :code :demo-users-not-allowed
                 :hint "Demo users are disabled by config."))
@@ -48,12 +45,13 @@
     (db/with-atomic [conn pool]
       (->> (#'profile/create-profile conn params)
            (#'profile/create-profile-relations conn)
-           (create-profile-initial-data conn))
+           (sid/load-initial-project! conn))
 
       ;; Schedule deletion of the demo profile
-      (tasks/submit! conn {:name "delete-profile"
-                           :delay cfg/deletion-delay
-                           :props {:profile-id id}})
+      (wrk/submit! {::wrk/task :delete-profile
+                    ::wrk/delay cfg/deletion-delay
+                    ::wrk/conn conn
+                    :profile-id id})
 
       {:email email
        :password password})))

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

@@ -1,41 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2021 UXBOX Labs SL
-
-(ns app.rpc.mutations.feedback
-  (:require
-   [app.common.exceptions :as ex]
-   [app.common.spec :as us]
-   [app.config :as cfg]
-   [app.db :as db]
-   [app.emails :as emails]
-   [app.rpc.queries.profile :as profile]
-   [app.util.services :as sv]
-   [clojure.spec.alpha :as s]))
-
-(s/def ::subject ::us/string)
-(s/def ::content ::us/string)
-
-(s/def ::send-profile-feedback
-  (s/keys :req-un [::profile-id ::subject ::content]))
-
-(sv/defmethod ::send-profile-feedback
-  [{:keys [pool] :as cfg} {:keys [profile-id subject content] :as params}]
-  (when-not (:feedback-enabled cfg/config)
-    (ex/raise :type :validation
-              :code :feedback-disabled
-              :hint "feedback module is disabled"))
-
-  (db/with-atomic [conn pool]
-    (let [profile (profile/retrieve-profile-data conn profile-id)]
-      (emails/send! conn emails/feedback
-                    {:to (:feedback-destination cfg/config)
-                     :profile profile
-                     :subject subject
-                     :content content})
-      nil)))

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

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.rpc.mutations.files
   (:require
@@ -16,14 +13,13 @@
    [app.common.uuid :as uuid]
    [app.config :as cfg]
    [app.db :as db]
-   [app.redis :as rd]
+   [app.rpc.permissions :as perms]
    [app.rpc.queries.files :as files]
    [app.rpc.queries.projects :as proj]
-   [app.tasks :as tasks]
    [app.util.blob :as blob]
    [app.util.services :as sv]
    [app.util.time :as dt]
-   [app.util.transit :as t]
+   [app.worker :as wrk]
    [clojure.spec.alpha :as s]))
 
 ;; --- Helpers & Specs
@@ -49,14 +45,13 @@
     (proj/check-edition-permissions! conn profile-id project-id)
     (create-file conn params)))
 
-(defn- create-file-profile
-  [conn {:keys [profile-id file-id] :as params}]
-  (db/insert! conn :file-profile-rel
-              {:profile-id profile-id
-               :file-id file-id
-               :is-owner true
-               :is-admin true
-               :can-edit true}))
+
+(defn create-file-role
+  [conn {:keys [file-id profile-id role]}]
+  (let [params {:file-id file-id
+                :profile-id profile-id}]
+    (->> (perms/assign-role-flags params role)
+         (db/insert! conn :file-profile-rel))))
 
 (defn create-file
   [conn {:keys [id name project-id is-shared]
@@ -70,8 +65,8 @@
                           :name name
                           :is-shared is-shared
                           :data (blob/encode data)})]
-    (->> (assoc params :file-id id)
-         (create-file-profile conn))
+    (->> (assoc params :file-id id :role :owner)
+         (create-file-role conn))
     (assoc file :data data)))
 
 
@@ -128,9 +123,11 @@
     (files/check-edition-permissions! conn profile-id id)
 
     ;; Schedule object deletion
-    (tasks/submit! conn {:name "delete-object"
-                         :delay cfg/deletion-delay
-                         :props {:id id :type :file}})
+    (wrk/submit! {::wrk/task :delete-object
+                  ::wrk/delay cfg/deletion-delay
+                  ::wrk/conn conn
+                  :id id
+                  :type :file})
 
     (mark-file-deleted conn params)))
 
@@ -157,6 +154,7 @@
               :hint "A file cannot be linked to itself"))
   (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id file-id)
+    (files/check-edition-permissions! conn profile-id library-id)
     (link-file-to-library conn params)))
 
 (def sql:link-file-to-library
@@ -252,19 +250,22 @@
               :reg-objects :mov-objects} (:type change))
            (some? (:component-id change)))))
 
-(declare update-file)
-(declare retrieve-lagged-changes)
 (declare insert-change)
+(declare retrieve-lagged-changes)
+(declare retrieve-team-id)
+(declare send-notifications)
+(declare update-file)
 
 (sv/defmethod ::update-file
   [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
   (db/with-atomic [conn pool]
     (let [{:keys [id] :as file} (db/get-by-id conn :file id {:for-update true})]
       (files/check-edition-permissions! conn profile-id id)
-      (update-file (assoc cfg :conn  conn) file params))))
+      (update-file (assoc cfg :conn  conn)
+                   (assoc params :file file)))))
 
 (defn- update-file
-  [{:keys [conn redis]} file params]
+  [{:keys [conn] :as cfg} {:keys [file changes session-id profile-id] :as params}]
   (when (> (:revn params)
            (:revn file))
     (ex/raise :type :validation
@@ -272,64 +273,70 @@
               :hint "The incoming revision number is greater that stored version."
               :context {:incoming-revn (:revn params)
                         :stored-revn (:revn file)}))
-  (let [sid      (:session-id params)
-        changes  (:changes params)
-        file     (-> file
-                     (update :data blob/decode)
-                     (update :data assoc :id (:id file))
-                     (update :data pmg/migrate-data)
-                     (update :data cp/process-changes changes)
-                     (update :data blob/encode)
-                     (update :revn inc)
-                     (assoc :changes (blob/encode changes)
-                            :session-id sid))
 
-        _        (insert-change conn file)
-        msg      {:type :file-change
-                  :profile-id (:profile-id params)
-                  :file-id (:id file)
-                  :session-id sid
-                  :revn (:revn file)
-                  :changes changes}
-
-        library-changes (filter library-change? changes)]
-
-    @(rd/run! redis :publish {:channel (str (:id file))
-                              :message (t/encode-str msg)})
-
-    (when (and (:is-shared file) (seq library-changes))
-      (let [{:keys [team-id] :as project}
-            (db/get-by-id conn :project (:project-id file))
-
-            msg {:type :library-change
-                 :profile-id (:profile-id params)
+  (let [file (-> file
+                 (update :revn inc)
+                 (update :data (fn [data]
+                                 (-> data
+                                     (blob/decode)
+                                     (assoc :id (:id file))
+                                     (pmg/migrate-data)
+                                     (cp/process-changes changes)
+                                     (blob/encode)))))]
+    ;; Insert change to the xlog
+    (db/insert! conn :file-change
+                {:id (uuid/next)
+                 :session-id session-id
+                 :profile-id profile-id
                  :file-id (:id file)
-                 :session-id sid
                  :revn (:revn file)
-                 :modified-at (dt/now)
-                 :changes library-changes}]
-
-        @(rd/run! redis :publish {:channel (str team-id)
-                                  :message (t/encode-str msg)})))
+                 :data (:data file)
+                 :changes (blob/encode changes)})
 
+    ;; Update file
     (db/update! conn :file
                 {:revn (:revn file)
-                 :data (:data file)}
+                 :data (:data file)
+                 :has-media-trimmed false}
                 {:id (:id file)})
 
-    (retrieve-lagged-changes conn params)))
+    (let [params (assoc params :file file)]
+      ;; Send asynchronous notifications
+      (send-notifications cfg params)
 
-(defn- insert-change
-  [conn {:keys [revn data changes session-id] :as file}]
-  (let [id      (uuid/next)
-        file-id (:id file)]
-    (db/insert! conn :file-change
-                {:id id
-                 :session-id session-id
-                 :file-id file-id
-                 :revn revn
-                 :data data
-                 :changes changes})))
+      ;; Retrieve and return lagged data
+      (retrieve-lagged-changes conn params))))
+
+(defn- send-notifications
+  [{:keys [msgbus conn] :as cfg} {:keys [file changes session-id] :as params}]
+  (let [lchanges (filter library-change? changes)]
+
+    ;; Asynchronously publish message to the msgbus
+    (msgbus :pub {:topic (:id file)
+                  :message
+                  {:type :file-change
+                   :profile-id (:profile-id params)
+                   :file-id (:id file)
+                   :session-id (:session-id params)
+                   :revn (:revn file)
+                   :changes changes}})
+
+    (when (and (:is-shared file) (seq lchanges))
+      (let [team-id (retrieve-team-id conn (:project-id file))]
+        ;; Asynchronously publish message to the msgbus
+        (msgbus :pub {:topic team-id
+                      :message
+                      {:type :library-change
+                       :profile-id (:profile-id params)
+                       :file-id (:id file)
+                       :session-id session-id
+                       :revn (:revn file)
+                       :modified-at (dt/now)
+                       :changes lchanges}})))))
+
+(defn- retrieve-team-id
+  [conn project-id]
+  (:team-id (db/get-by-id conn :project project-id {:columns [:team-id]})))
 
 (def ^:private
   sql:lagged-changes

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

@@ -0,0 +1,98 @@
+;; 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.rpc.mutations.ldap
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.config :as cfg]
+   [app.rpc.mutations.profile :refer [login-or-register]]
+   [app.util.services :as sv]
+   [clj-ldap.client :as ldap]
+   [clojure.spec.alpha :as s]
+   [clojure.string]))
+
+(defn ^java.lang.AutoCloseable connect
+  []
+  (let [params {:ssl?      (cfg/get :ldap-ssl)
+                :startTLS? (cfg/get :ldap-starttls)
+                :bind-dn   (cfg/get :ldap-bind-dn)
+                :password  (cfg/get :ldap-bind-password)
+                :host      {:address (cfg/get :ldap-host)
+                            :port    (cfg/get :ldap-port)}}]
+    (try
+      (ldap/connect params)
+      (catch Exception e
+        (ex/raise :type :restriction
+                  :code :ldap-disabled
+                  :hint "ldap disabled or unable to connect"
+                  :cause e)))))
+
+;; --- Mutation: login-with-ldap
+
+(declare authenticate)
+
+(s/def ::email ::us/email)
+(s/def ::password ::us/string)
+(s/def ::invitation-token ::us/string)
+
+(s/def ::login-with-ldap
+  (s/keys :req-un [::email ::password]
+          :opt-un [::invitation-token]))
+
+(sv/defmethod ::login-with-ldap {:auth false :rlimit :password}
+  [{:keys [pool session tokens] :as cfg} {:keys [email password invitation-token] :as params}]
+  (let [info (authenticate params)
+        cfg  (assoc cfg :conn pool)]
+    (when-not info
+      (ex/raise :type :validation
+                :code :wrong-credentials))
+    (let [profile (login-or-register cfg {:email (:email info)
+                                          :backend (:backend info)
+                                          :fullname (:fullname info)})]
+      (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,
+        ;; regenerate token and send back to the user a new invitation
+        ;; token (and mark current session as logged).
+        (let [claims (tokens :verify {:token token :iss :team-invitation})
+              claims (assoc claims
+                            :member-id  (:id profile)
+                            :member-email (:email profile))
+              token  (tokens :generate claims)]
+          (with-meta
+            {:invitation-token token}
+            {:transform-response ((:create session) (:id profile))}))
+
+        (with-meta profile
+          {:transform-response ((:create session) (:id profile))})))))
+
+(defn- replace-several [s & {:as replacements}]
+  (reduce-kv clojure.string/replace s replacements))
+
+(defn- get-ldap-user
+  [cpool {:keys [email] :as params}]
+  (let [query   (-> (cfg/get :ldap-user-query)
+                    (replace-several ":username" email))
+
+        attrs   [(cfg/get :ldap-attrs-username)
+                 (cfg/get :ldap-attrs-email)
+                 (cfg/get :ldap-attrs-photo)
+                 (cfg/get :ldap-attrs-fullname)]
+
+        base-dn (cfg/get :ldap-base-dn)
+        params  {:filter query :sizelimit 1 :attributes attrs}]
+    (first (ldap/search cpool base-dn params))))
+
+(defn- authenticate
+  [{:keys [password] :as params}]
+  (with-open [conn (connect)]
+    (when-let [{:keys [dn] :as luser} (get-ldap-user conn params)]
+      (when (ldap/bind? conn dn password)
+        {:photo    (get luser (keyword (cfg/get :ldap-attrs-photo)))
+         :fullname (get luser (keyword (cfg/get :ldap-attrs-fullname)))
+         :email    (get luser (keyword (cfg/get :ldap-attrs-email)))
+         :backend  "ldap"}))))

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

@@ -0,0 +1,322 @@
+;; 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.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.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 Components
+              (and (map? form)
+                   (uuid? (:component-file form)))
+              (update :component-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 analize 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 o on (fmo.media_id = o.id)
+    where fmo.file_id = ?
+      and o.deleted_at is null")
+
+(defn duplicate-file
+  [conn {:keys [profile-id file index project-id name]} {:keys [reset-shared-flag] :as opts}]
+  (let [flibs    (db/exec! conn [sql:retrieve-used-libraries (:id file)])
+        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))
+
+
+;; --- MUTATION: Duplicate File
+
+(declare duplicate-file)
+
+(s/def ::duplicate-file
+  (s/keys :req-un [::profile-id ::file-id]
+          :opt-un [::name]))
+
+(sv/defmethod ::duplicate-file
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id name] :as 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))
+
+      (-> (duplicate-file conn params {:reset-shared-flag true})
+          (update :data blob/decode)))))
+
+
+;; --- MUTATION: Duplicate Project
+
+(declare duplicate-project)
+
+(s/def ::duplicate-project
+  (s/keys :req-un [::profile-id ::project-id]
+          :opt-un [::name]))
+
+(sv/defmethod ::duplicate-project
+  [{:keys [pool] :as cfg} {:keys [profile-id project-id name] :as 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))
+      (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))
+
+
+;; --- 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]))
+
+(sv/defmethod ::move-files
+  [{:keys [pool] :as cfg} {:keys [profile-id ids project-id] :as 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 posible broken relations on moved files
+      (db/exec-one! conn [sql:delete-broken-relations pids])
+
+      nil)))
+
+
+;; --- MUTATION: Move project
+
+(declare move-project)
+
+(s/def ::move-project
+  (s/keys :req-un [::profile-id ::team-id ::project-id]))
+
+(sv/defmethod ::move-project
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id project-id] :as 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 posible broken relations on moved files
+      (db/exec-one! conn [sql:delete-broken-relations pids])
+
+      nil)))

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

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020-2021 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.rpc.mutations.media
   (:require
@@ -92,7 +89,7 @@
 
 
 (defn create-file-media-object
-  [{:keys [conn storage svgc] :as cfg} {:keys [file-id is-local name content] :as params}]
+  [{:keys [conn storage] :as cfg} {:keys [file-id is-local name content] :as params}]
   (media/validate-media-type (:content-type content))
   (let [storage      (assoc storage :conn conn)
         source-path  (fs/path (:tempfile content))
@@ -108,7 +105,7 @@
                                                      :path source-path})))
 
         image        (if (= (:mtype source-info) "image/svg+xml")
-                       (let [data (svgc (slurp source-path))]
+                       (let [data (slurp source-path)]
                          (sto/put-object storage {:content (sto/content data)
                                                   :content-type (:mtype source-info)}))
                        (sto/put-object storage {:content (sto/content source-path)

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

@@ -2,40 +2,35 @@
 ;; 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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020-2021 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.rpc.mutations.profile
   (:require
+   [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
    [app.config :as cfg]
    [app.db :as db]
-   [app.db.profile-initial-data :refer [create-profile-initial-data]]
-   [app.emails :as emails]
-   [app.http.session :as session]
+   [app.emails :as eml]
    [app.media :as media]
    [app.rpc.mutations.projects :as projects]
    [app.rpc.mutations.teams :as teams]
-   [app.rpc.mutations.verify-token :refer [process-token]]
    [app.rpc.queries.profile :as profile]
+   [app.setup.initial-data :as sid]
    [app.storage :as sto]
-   [app.tasks :as tasks]
    [app.util.services :as sv]
    [app.util.time :as dt]
+   [app.worker :as wrk]
    [buddy.hashers :as hashers]
    [clojure.spec.alpha :as s]
-   [clojure.tools.logging :as log]
    [cuerdas.core :as str]))
 
 ;; --- Helpers & Specs
 
 (s/def ::email ::us/email)
 (s/def ::fullname ::us/not-empty-string)
-(s/def ::lang ::us/not-empty-string)
+(s/def ::lang (s/nilable ::us/not-empty-string))
 (s/def ::path ::us/string)
 (s/def ::profile-id ::us/uuid)
 (s/def ::password ::us/not-empty-string)
@@ -44,89 +39,107 @@
 
 ;; --- Mutation: Register Profile
 
+(declare annotate-profile-register)
 (declare check-profile-existence!)
 (declare create-profile)
 (declare create-profile-relations)
 (declare email-domain-in-whitelist?)
+(declare register-profile)
+
+(s/def ::invitation-token ::us/not-empty-string)
+(s/def ::terms-privacy ::us/boolean)
 
-(s/def ::token ::us/not-empty-string)
 (s/def ::register-profile
-  (s/keys :req-un [::email ::password ::fullname]
-          :opt-un [::token]))
+  (s/keys :req-un [::email ::password ::fullname ::terms-privacy]
+          :opt-un [::invitation-token]))
 
 (sv/defmethod ::register-profile {:auth false :rlimit :password}
-  [{:keys [pool tokens session] :as cfg} {:keys [token] :as params}]
-  (when-not (:registration-enabled cfg/config)
+  [{:keys [pool tokens session] :as cfg} params]
+  (when-not (cfg/get :registration-enabled)
     (ex/raise :type :restriction
               :code :registration-disabled))
 
-  (when-not (email-domain-in-whitelist? (:registration-domain-whitelist cfg/config)
-                                        (:email params))
+  (when-not (email-domain-in-whitelist? (cfg/get :registration-domain-whitelist) (:email params))
     (ex/raise :type :validation
               :code :email-domain-is-not-allowed))
 
+  (when-not (:terms-privacy params)
+    (ex/raise :type :validation
+              :code :invalid-terms-and-privacy))
+
   (db/with-atomic [conn pool]
-    (check-profile-existence! conn params)
-    (let [profile (->> (create-profile conn params)
-                       (create-profile-relations conn))]
-      (create-profile-initial-data conn profile)
+    (let [cfg     (assoc cfg :conn conn)]
+      (register-profile cfg params))))
 
-      (if token
-        ;; If token comes in params, this is because the user comes
-        ;; from team-invitation process; in this case we revalidate
-        ;; the token and process the token claims again with the new
-        ;; profile data.
-        (let [claims (tokens :verify {:token token :iss :team-invitation})
-              claims (assoc claims :member-id  (:id profile))
-              params (assoc params :profile-id (:id profile))
-              cfg    (assoc cfg :conn conn)]
+(defn- annotate-profile-register
+  "A helper for properly increase the profile-register metric once the
+  transaction is completed."
+  [metrics profile]
+  (fn []
+    (when (::created profile)
+      ((get-in metrics [:definitions :profile-register]) :inc))))
 
-          (process-token cfg params claims)
+(defn- register-profile
+  [{:keys [conn tokens session metrics] :as cfg} params]
+  (check-profile-existence! conn params)
+  (let [profile (->> (create-profile conn params)
+                     (create-profile-relations conn))
+        profile (assoc profile ::created true)]
 
-          ;; Automatically mark the created profile as active because
-          ;; we already have the verification of email with the
-          ;; team-invitation token.
-          (db/update! conn :profile
-                      {:is-active true}
-                      {:id (:id profile)})
+    (sid/load-initial-project! conn profile)
 
-          ;; Return profile data and create http session for
-          ;; automatically login the profile.
-          (with-meta (assoc profile
-                            :is-active true
-                            :claims claims)
-            {:transform-response
-             (fn [request response]
-               (let [uagent (get-in request [:headers "user-agent"])
-                     id     (session/create! session {:profile-id (:id profile)
-                                                      :user-agent uagent})]
-                 (assoc response
-                        :cookies (session/cookies session {:value id}))))}))
+    (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,
+      ;; regenerate token and send back to the user a new invitation
+      ;; token (and mark current session as logged).
+      (let [claims (tokens :verify {:token token :iss :team-invitation})
+            claims (assoc claims
+                          :member-id  (:id profile)
+                          :member-email (:email profile))
+            token  (tokens :generate claims)
+            resp   {:invitation-token token}]
+        (with-meta resp
+          {:transform-response ((:create session) (:id profile))
+           :before-complete (annotate-profile-register metrics profile)}))
 
-        ;; If no token is provided, send a verification email
-        (let [token (tokens :generate
-                            {:iss :verify-email
-                             :exp (dt/in-future "48h")
-                             :profile-id (:id profile)
-                             :email (:email profile)})]
+      ;; If no token is provided, send a verification email
+      (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)})]
 
-          (emails/send! conn emails/register
-                        {:to (:email profile)
-                         :name (:fullname profile)
-                         :token token})
+        ;; Don't allow proceed in register page if the email is
+        ;; already reported as permanent bounced
+        (when (eml/has-bounce-reports? conn (:email profile))
+          (ex/raise :type :validation
+                    :code :email-has-permanent-bounces
+                    :hint "looks like the email has one or many bounces reported"))
 
-          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})
 
+        (with-meta profile
+          {:before-complete (annotate-profile-register metrics profile)})))))
 
 (defn email-domain-in-whitelist?
   "Returns true if email's domain is in the given whitelist or if given
   whitelist is an empty string."
   [whitelist email]
-  (if (str/blank? whitelist)
+  (if (str/empty-or-nil? whitelist)
     true
     (let [domains (str/split whitelist #",\s*")
-          email-domain (second (str/split email #"@"))]
-      (contains? (set domains) email-domain))))
+          domain  (second (str/split email #"@" 2))]
+      (contains? (set domains) domain))))
 
 (def ^:private sql:profile-existence
   "select exists (select * from profile
@@ -154,31 +167,30 @@
   [attempt password]
   (try
     (hashers/verify attempt password)
-    (catch Exception e
-      (log/warnf e "Error on verify password (only informative, nothing affected to user).")
+    (catch Exception _e
       {:update false
        :valid false})))
 
-(defn- create-profile
+(defn create-profile
   "Create the profile entry on the database with limited input
   filling all the other fields with defaults."
-  [conn {:keys [id fullname email password demo? props is-active]
-         :or {is-active false}
-         :as params}]
-  (let [id       (or id (uuid/next))
-        demo?    (if (boolean? demo?) demo? false)
-        active?  (if demo? true is-active)
-        props    (db/tjson (or props {}))
-        password (derive-password password)]
+  [conn {:keys [id fullname email password props is-active is-muted is-demo opts]
+         :or {is-active false is-muted false is-demo false}}]
+  (let [id        (or id (uuid/next))
+        is-active (if is-demo true is-active)
+        props     (db/tjson (or props {}))
+        password  (derive-password password)
+        params    {:id id
+                   :fullname fullname
+                   :email (str/lower email)
+                   :auth-backend "penpot"
+                   :password password
+                   :props props
+                   :is-active is-active
+                   :is-muted is-muted
+                   :is-demo is-demo}]
     (try
-      (-> (db/insert! conn :profile
-                      {:id id
-                       :fullname fullname
-                       :email (str/lower email)
-                       :password password
-                       :props props
-                       :is-active active?
-                       :is-demo demo?})
+      (-> (db/insert! conn :profile params opts)
           (update :props db/decode-transit-pgobject))
       (catch org.postgresql.util.PSQLException e
         (let [state (.getSQLState e)]
@@ -189,23 +201,27 @@
                       :cause e)))))))
 
 
-(defn- create-profile-relations
+(defn create-profile-relations
   [conn profile]
-  (let [team (teams/create-team conn {:profile-id (:id profile)
-                                      :name "Default"
-                                      :default? true})
-        proj (projects/create-project conn {:profile-id (:id profile)
-                                            :team-id (:id team)
-                                            :name "Drafts"
-                                            :default? true})]
-    (teams/create-team-profile conn {:team-id (:id team)
-                                     :profile-id (:id profile)})
-    (projects/create-project-profile conn {:project-id (:id proj)
-                                           :profile-id (:id profile)})
+  (let [team    (teams/create-team conn {:profile-id (:id profile)
+                                         :name "Default"
+                                         :is-default true})
+        project (projects/create-project conn {:profile-id (:id profile)
+                                               :team-id (:id team)
+                                               :name "Drafts"
+                                               :is-default true})
+        params  {:team-id (:id team)
+                 :profile-id (:id profile)
+                 :project-id (:id project)
+                 :role :owner}]
 
-    (merge (profile/strip-private-attrs profile)
-           {:default-team-id (:id team)
-            :default-project-id (:id proj)})))
+    (teams/create-team-role conn params)
+    (projects/create-project-role conn params)
+
+    (-> profile
+        (profile/strip-private-attrs)
+        (assoc :default-team-id (:id team))
+        (assoc :default-project-id (:id project)))))
 
 ;; --- Mutation: Login
 
@@ -214,10 +230,10 @@
 
 (s/def ::login
   (s/keys :req-un [::email ::password]
-          :opt-un [::scope]))
+          :opt-un [::scope ::invitation-token]))
 
 (sv/defmethod ::login {:auth false :rlimit :password}
-  [{:keys [pool] :as cfg} {:keys [email password scope] :as params}]
+  [{:keys [pool session tokens] :as cfg} {:keys [email password scope] :as params}]
   (letfn [(check-password [profile password]
             (when (= (:password profile) "!")
               (ex/raise :type :validation
@@ -237,45 +253,99 @@
             profile)]
 
     (db/with-atomic [conn pool]
-      (let [prof (-> (profile/retrieve-profile-data-by-email conn email)
-                     (validate-profile)
-                     (profile/strip-private-attrs))
-            addt (profile/retrieve-additional-data conn (:id prof))]
-        (merge prof addt)))))
+      (let [profile (->> (profile/retrieve-profile-data-by-email conn email)
+                         (validate-profile)
+                         (profile/strip-private-attrs)
+                         (profile/populate-additional-data conn))]
+        (if-let [token (:invitation-token params)]
+          ;; If the request comes with an invitation token, this means
+          ;; that user wants to accept it with different user. A very
+          ;; strange case but still can happen. In this case, we
+          ;; proceed in the same way as in register: regenerate the
+          ;; invitation token and return it to the user for proper
+          ;; invitation acceptation.
+          (let [claims (tokens :verify {:token token :iss :team-invitation})
+                claims (assoc claims
+                              :member-id  (:id profile)
+                              :member-email (:email profile))
+                token  (tokens :generate claims)]
+            (with-meta {:invitation-token token}
+              {:transform-response ((:create session) (:id profile))}))
+
+          (with-meta profile
+            {:transform-response ((:create session) (:id profile))}))))))
+
+;; --- Mutation: Logout
+
+(s/def ::logout
+  (s/keys :req-un [::profile-id]))
+
+(sv/defmethod ::logout
+  [{:keys [pool session] :as cfg} {:keys [profile-id] :as params}]
+  (with-meta {}
+    {:transform-response (:delete session)}))
 
 
 ;; --- Mutation: Register if not exists
 
+(declare login-or-register)
+
+(s/def ::backend ::us/string)
 (s/def ::login-or-register
-  (s/keys :req-un [::email ::fullname]))
+  (s/keys :req-un [::email ::fullname ::backend]))
 
 (sv/defmethod ::login-or-register {:auth false}
-  [{:keys [pool] :as cfg} {:keys [email fullname] :as params}]
-  (letfn [(populate-additional-data [conn profile]
-            (let [data (profile/retrieve-additional-data conn (:id profile))]
-              (merge profile data)))
+  [{:keys [pool metrics] :as cfg} params]
+  (db/with-atomic [conn pool]
+    (let [profile (-> (assoc cfg :conn conn)
+                      (login-or-register params))]
+      (with-meta profile
+        {:before-complete (annotate-profile-register metrics profile)}))))
 
-          (create-profile [conn {:keys [fullname email]}]
+(defn login-or-register
+  [{:keys [conn] :as cfg} {:keys [email backend] :as params}]
+  (letfn [(info->props [info]
+            (dissoc info :name :fullname :email :backend))
+
+          (info->lang [{:keys [locale] :as info}]
+            (when (and (string? locale)
+                       (not (str/blank? locale)))
+              locale))
+
+          (create-profile [conn {:keys [email] :as info}]
             (db/insert! conn :profile
                         {:id (uuid/next)
-                         :fullname fullname
+                         :fullname (:fullname info)
                          :email (str/lower email)
+                         :lang (info->lang info)
+                         :auth-backend backend
                          :is-active true
                          :password "!"
+                         :props (db/tjson (info->props info))
                          :is-demo false}))
 
+          (update-profile [conn info profile]
+            (let [props (d/merge (:props profile)
+                                 (info->props info))]
+              (db/update! conn :profile
+                          {:props (db/tjson props)
+                           :modified-at (dt/now)}
+                          {:id (:id profile)})
+              (assoc profile :props props)))
+
           (register-profile [conn params]
             (let [profile (->> (create-profile conn params)
                                (create-profile-relations conn))]
-              (create-profile-initial-data conn profile)
-              profile))]
+              (sid/load-initial-project! conn profile)
+              (assoc profile ::created true)))]
 
-    (db/with-atomic [conn pool]
-      (let [profile (profile/retrieve-profile-data-by-email conn email)
-            profile (if profile
-                      (populate-additional-data conn profile)
-                      (register-profile conn params))]
-        (profile/strip-private-attrs profile)))))
+    (let [profile (profile/retrieve-profile-data-by-email conn email)
+          profile (if profile
+                    (->> profile
+                         (update-profile conn params)
+                         (profile/populate-additional-data conn))
+                    (register-profile conn params))]
+      (profile/strip-private-attrs profile))))
 
 
 ;; --- Mutation: Update Profile (own)
@@ -289,7 +359,8 @@
               {:id id}))
 
 (s/def ::update-profile
-  (s/keys :req-un [::id ::fullname ::lang ::theme]))
+  (s/keys :req-un [::id ::fullname]
+          :opt-un [::lang ::theme]))
 
 (sv/defmethod ::update-profile
   [{:keys [pool] :as cfg} params]
@@ -297,15 +368,10 @@
     (update-profile conn params)
     nil))
 
-
 ;; --- Mutation: Update Password
 
-(defn- validate-password!
-  [conn {:keys [profile-id old-password] :as params}]
-  (let [profile (db/get-by-id conn :profile profile-id)]
-    (when-not (:valid (verify-password old-password (:password profile)))
-      (ex/raise :type :validation
-                :code :old-password-not-match))))
+(declare validate-password!)
+(declare update-profile-password!)
 
 (s/def ::update-profile-password
   (s/keys :req-un [::profile-id ::password ::old-password]))
@@ -313,12 +379,23 @@
 (sv/defmethod ::update-profile-password {:rlimit :password}
   [{:keys [pool] :as cfg} {:keys [password profile-id] :as params}]
   (db/with-atomic [conn pool]
-    (validate-password! conn params)
-    (db/update! conn :profile
-                {:password (derive-password password)}
-                {:id profile-id})
-    nil))
+    (let [profile (validate-password! conn params)]
+      (update-profile-password! conn (assoc profile :password password))
+      nil)))
 
+(defn- validate-password!
+  [conn {:keys [profile-id old-password] :as params}]
+  (let [profile (db/get-by-id conn :profile profile-id)]
+    (when-not (:valid (verify-password old-password (:password profile)))
+      (ex/raise :type :validation
+                :code :old-password-not-match))
+    profile))
+
+(defn update-profile-password!
+  [conn {:keys [id password] :as profile}]
+  (db/update! conn :profile
+              {:password (derive-password password)}
+              {:id id}))
 
 ;; --- Mutation: Update Photo
 
@@ -330,8 +407,8 @@
 
 (sv/defmethod ::update-profile-photo
   [{:keys [pool storage] :as cfg} {:keys [profile-id file] :as params}]
-  (media/validate-media-type (:content-type file))
   (db/with-atomic [conn pool]
+    (media/validate-media-type (:content-type file) #{"image/jpeg" "image/png" "image/webp"})
     (let [profile (db/get-by-id conn :profile profile-id)
           _       (media/run cfg {:cmd :info :input {:path (:tempfile file)
                                                      :mtype (:content-type file)}})
@@ -352,31 +429,70 @@
               {:id profile-id})
   nil)
 
+
 ;; --- Mutation: Request Email Change
 
+(declare request-email-change)
+(declare change-email-inmediatelly)
+
 (s/def ::request-email-change
   (s/keys :req-un [::email]))
 
 (sv/defmethod ::request-email-change
-  [{:keys [pool tokens] :as cfg} {:keys [profile-id email] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id email] :as params}]
   (db/with-atomic [conn pool]
-    (let [email   (str/lower email)
-          profile (db/get-by-id conn :profile profile-id)
-          token   (tokens :generate
-                          {:iss :change-email
-                           :exp (dt/in-future "15m")
-                           :profile-id profile-id
-                           :email email})]
+    (let [profile (db/get-by-id conn :profile profile-id)
+          cfg     (assoc cfg :conn conn)
+          params  (assoc params
+                         :profile profile
+                         :email (str/lower email))]
+      (if (cfg/get :smtp-enabled)
+        (request-email-change cfg params)
+        (change-email-inmediatelly cfg params)))))
 
-      (when (not= email (:email profile))
-        (check-profile-existence! conn params))
+(defn- change-email-inmediatelly
+  [{:keys [conn]} {:keys [profile email] :as params}]
+  (when (not= email (:email profile))
+    (check-profile-existence! conn params))
+  (db/update! conn :profile
+              {:email email}
+              {:id (:id profile)})
+  {: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)})]
+
+    (when (not= email (:email profile))
+      (check-profile-existence! conn params))
+
+    (when-not (eml/allow-send-emails? conn profile)
+      (ex/raise :type :validation
+                :code :profile-is-muted
+                :hint "looks like the profile has reported repeatedly as spam or has permanent bounces."))
+
+    (when (eml/has-bounce-reports? conn email)
+      (ex/raise :type :validation
+                :code :email-has-permanent-bounces
+                :hint "looks like the email you invite has been repeatedly reported as spam or permanent bounce"))
+
+    (eml/send! {::eml/conn conn
+                ::eml/factory eml/change-email
+                :public-uri (:public-uri cfg)
+                :to (:email profile)
+                :name (:fullname profile)
+                :pending-email email
+                :token token
+                :extra-data ptoken})
+    nil))
 
-      (emails/send! conn emails/change-email
-                    {:to (:email profile)
-                     :name (:fullname profile)
-                     :pending-email email
-                     :token token})
-      nil)))
 
 (defn select-profile-for-update
   [conn id]
@@ -397,18 +513,35 @@
               (assoc profile :token token)))
 
           (send-email-notification [conn profile]
-            (emails/send! conn emails/password-recovery
-                          {:to (:email profile)
-                           :token (:token profile)
-                           :name (:fullname profile)})
-            nil)]
+            (let [ptoken (tokens :generate-predefined
+                                 {:iss :profile-identity
+                                  :profile-id (:id profile)})]
+              (eml/send! {::eml/conn conn
+                          ::eml/factory eml/password-recovery
+                          :public-uri (:public-uri cfg)
+                          :to (:email profile)
+                          :token (:token profile)
+                          :name (:fullname profile)
+                          :extra-data ptoken})
+              nil))]
 
     (db/with-atomic [conn pool]
       (when-let [profile (profile/retrieve-profile-data-by-email conn email)]
+        (when-not (eml/allow-send-emails? conn profile)
+          (ex/raise :type :validation
+                    :code :profile-is-muted
+                    :hint "looks like the profile has reported repeatedly as spam or has permanent bounces."))
+
         (when-not (:is-active profile)
           (ex/raise :type :validation
                     :code :profile-not-verified
                     :hint "the user need to validate profile before recover password"))
+
+        (when (eml/has-bounce-reports? conn (:email profile))
+          (ex/raise :type :validation
+                    :code :email-has-permanent-bounces
+                    :hint "looks like the email you invite has been repeatedly reported as spam or permanent bounce"))
+
         (->> profile
              (create-recovery-token)
              (send-email-notification conn))))))
@@ -471,20 +604,17 @@
     (check-can-delete-profile! conn profile-id)
 
     ;; Schedule a complete deletion of profile
-    (tasks/submit! conn {:name "delete-profile"
-                         :delay cfg/deletion-delay
-                         :props {:profile-id profile-id}})
+    (wrk/submit! {::wrk/task :delete-profile
+                  ::wrk/dalay cfg/deletion-delay
+                  ::wrk/conn conn
+                  :profile-id profile-id})
 
     (db/update! conn :profile
                 {:deleted-at (dt/now)}
                 {:id profile-id})
 
     (with-meta {}
-      {:transform-response
-       (fn [request response]
-         (session/delete! session request)
-         (assoc response
-                :cookies (session/cookies session {:value "" :max-age -1})))})))
+      {:transform-response (:delete session)})))
 
 (def sql:owned-teams
   "with owner_teams as (

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

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.rpc.mutations.projects
   (:require
@@ -13,10 +10,12 @@
    [app.common.uuid :as uuid]
    [app.config :as cfg]
    [app.db :as db]
+   [app.rpc.permissions :as perms]
    [app.rpc.queries.projects :as proj]
-   [app.tasks :as tasks]
+   [app.rpc.queries.teams :as teams]
    [app.util.services :as sv]
    [app.util.time :as dt]
+   [app.worker :as wrk]
    [clojure.spec.alpha :as s]))
 
 ;; --- Helpers & Specs
@@ -29,7 +28,7 @@
 ;; --- Mutation: Create Project
 
 (declare create-project)
-(declare create-project-profile)
+(declare create-project-role)
 (declare create-team-project-profile)
 
 (s/def ::team-id ::us/uuid)
@@ -38,33 +37,35 @@
           :opt-un [::id]))
 
 (sv/defmethod ::create-project
-  [{:keys [pool] :as cfg} params]
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
   (db/with-atomic [conn pool]
-    (let [proj   (create-project conn params)
-          params (assoc params :project-id (:id proj))]
-      (create-project-profile conn params)
+    (teams/check-edition-permissions! conn profile-id team-id)
+    (let [project (create-project conn params)
+          params  (assoc params
+                         :project-id (:id project)
+                         :role :owner)]
+      (create-project-role conn params)
       (create-team-project-profile conn params)
-      (assoc proj :is-pinned true))))
+      (assoc project :is-pinned true))))
 
 (defn create-project
-  [conn {:keys [id team-id name default?] :as params}]
-  (let [id (or id (uuid/next))
-        default? (if (boolean? default?) default? false)]
+  [conn {:keys [id team-id name is-default] :as params}]
+  (let [id         (or id (uuid/next))
+        is-default (if (boolean? is-default) is-default false)]
     (db/insert! conn :project
                 {:id id
-                 :team-id team-id
                  :name name
-                 :is-default default?})))
+                 :team-id team-id
+                 :is-default is-default})))
 
-(defn create-project-profile
-  [conn {:keys [project-id profile-id] :as params}]
-  (db/insert! conn :project-profile-rel
-              {:project-id project-id
-               :profile-id profile-id
-               :is-owner true
-               :is-admin true
-               :can-edit true}))
+(defn create-project-role
+  [conn {:keys [project-id profile-id role]}]
+  (let [params {:project-id project-id
+                :profile-id profile-id}]
+    (->> (perms/assign-role-flags params role)
+         (db/insert! conn :project-profile-rel))))
 
+;; TODO: pending to be refactored
 (defn create-team-project-profile
   [conn {:keys [team-id project-id profile-id] :as params}]
   (db/insert! conn :team-project-profile-rel
@@ -92,6 +93,7 @@
 (sv/defmethod ::update-project-pin
   [{:keys [pool] :as cfg} {:keys [id profile-id team-id is-pinned] :as params}]
   (db/with-atomic [conn pool]
+    (proj/check-edition-permissions! conn profile-id id)
     (db/exec-one! conn [sql:update-project-pin team-id id profile-id is-pinned is-pinned])
     nil))
 
@@ -123,9 +125,11 @@
     (proj/check-edition-permissions! conn profile-id id)
 
     ;; Schedule object deletion
-    (tasks/submit! conn {:name "delete-object"
-                         :delay cfg/deletion-delay
-                         :props {:id id :type :project}})
+    (wrk/submit! {::wrk/task :delete-object
+                  ::wrk/delay cfg/deletion-delay
+                  ::wrk/conn conn
+                  :id id
+                  :type :project})
 
     (db/update! conn :project
                 {:deleted-at (dt/now)}

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

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020-2021 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.rpc.mutations.teams
   (:require
@@ -15,15 +12,16 @@
    [app.common.uuid :as uuid]
    [app.config :as cfg]
    [app.db :as db]
-   [app.emails :as emails]
+   [app.emails :as eml]
    [app.media :as media]
    [app.rpc.mutations.projects :as projects]
+   [app.rpc.permissions :as perms]
    [app.rpc.queries.profile :as profile]
    [app.rpc.queries.teams :as teams]
    [app.storage :as sto]
-   [app.tasks :as tasks]
    [app.util.services :as sv]
    [app.util.time :as dt]
+   [app.worker :as wrk]
    [clojure.spec.alpha :as s]
    [datoteka.core :as fs]))
 
@@ -36,7 +34,7 @@
 ;; --- Mutation: Create Team
 
 (declare create-team)
-(declare create-team-profile)
+(declare create-team-role)
 (declare create-team-default-project)
 
 (s/def ::create-team
@@ -47,37 +45,39 @@
   [{:keys [pool] :as cfg} params]
   (db/with-atomic [conn pool]
     (let [team   (create-team conn params)
-          params (assoc params :team-id (:id team))]
-      (create-team-profile conn params)
+          params (assoc params
+                        :team-id (:id team)
+                        :role :owner)]
+      (create-team-role conn params)
       (create-team-default-project conn params)
       team)))
 
 (defn create-team
-  [conn {:keys [id name default?] :as params}]
-  (let [id (or id (uuid/next))
-        default? (if (boolean? default?) default? false)]
+  [conn {:keys [id name is-default] :as params}]
+  (let [id         (or id (uuid/next))
+        is-default (if (boolean? is-default) is-default false)]
     (db/insert! conn :team
                 {:id id
                  :name name
-                 :is-default default?})))
+                 :is-default is-default})))
 
-(defn create-team-profile
-  [conn {:keys [team-id profile-id] :as params}]
-  (db/insert! conn :team-profile-rel
-              {:team-id team-id
-               :profile-id profile-id
-               :is-owner true
-               :is-admin true
-               :can-edit true}))
+(defn create-team-role
+  [conn {:keys [team-id profile-id role] :as params}]
+  (let [params {:team-id team-id
+                :profile-id profile-id}]
+    (->> (perms/assign-role-flags params role)
+         (db/insert! conn :team-profile-rel))))
 
 (defn create-team-default-project
   [conn {:keys [team-id profile-id] :as params}]
-  (let [proj (projects/create-project conn {:team-id team-id
-                                            :name "Drafts"
-                                            :default? true})]
-    (projects/create-project-profile conn {:project-id (:id proj)
-                                           :profile-id profile-id})))
-
+  (let [project {:id (uuid/next)
+                 :team-id team-id
+                 :name "Drafts"
+                 :is-default true}]
+    (projects/create-project conn project)
+    (projects/create-project-role conn {:project-id (:id project)
+                                        :profile-id profile-id
+                                        :role :owner})))
 
 ;; --- Mutation: Update Team
 
@@ -136,9 +136,11 @@
                   :code :only-owner-can-delete-team))
 
       ;; Schedule object deletion
-      (tasks/submit! conn {:name "delete-object"
-                           :delay cfg/deletion-delay
-                           :props {:id id :type :team}})
+      (wrk/submit! {::wrk/task :delete-object
+                    ::wrk/delay cfg/deletion-delay
+                    ::wrk/conn conn
+                    :id id
+                    :type :team})
 
       (db/update! conn :team
                   {:deleted-at (dt/now)}
@@ -146,7 +148,7 @@
       nil)))
 
 
-;; --- Mutation: Tean Update Role
+;; --- Mutation: Team Update Role
 
 (declare retrieve-team-member)
 (declare role->params)
@@ -171,7 +173,10 @@
           ;; convenience, if this bocomes a bottleneck or problematic,
           ;; we will change it to more efficient fetch mechanims.
           members (teams/retrieve-team-members conn team-id)
-          member  (d/seek #(= member-id (:id %)) members)]
+          member  (d/seek #(= member-id (:id %)) members)
+
+          is-owner? (some :is-owner perms)
+          is-admin? (some :is-admin perms)]
 
       ;; If no member is found, just 404
       (when-not member
@@ -179,8 +184,7 @@
                   :code :member-does-not-exist))
 
       ;; First check if we have permissions to change roles
-      (when-not (or (some :is-owner perms)
-                    (some :is-admin perms))
+      (when-not (or is-owner? is-admin?)
         (ex/raise :type :validation
                   :code :insufficient-permissions))
 
@@ -190,21 +194,20 @@
                   :code :cant-change-role-to-owner))
 
       ;; Don't allow promote to owner to admin users.
-      (when (and (= role :owner)
-                 (not (:is-owner perms)))
+      (when (and (not is-owner?) (= role :owner))
         (ex/raise :type :validation
                   :code :cant-promote-to-owner))
 
       (let [params (role->params role)]
         ;; Only allow single owner on team
-        (when (and (= role :owner)
-                   (:is-owner perms))
+        (when (= role :owner)
           (db/update! conn :team-profile-rel
                       {:is-owner false}
                       {:team-id team-id
                        :profile-id profile-id}))
 
-        (db/update! conn :team-profile-rel params
+        (db/update! conn :team-profile-rel
+                    params
                     {:team-id team-id
                      :profile-id member-id})
         nil))))
@@ -218,7 +221,7 @@
     :viewer {:is-owner false :is-admin false :can-edit false}))
 
 
-;; --- Mutation: Team Update Role
+;; --- Mutation: Delete Team Member
 
 (s/def ::delete-team-member
   (s/keys :req-un [::profile-id ::team-id ::member-id]))
@@ -227,8 +230,8 @@
   [{:keys [pool] :as cfg} {:keys [team-id profile-id member-id] :as params}]
   (db/with-atomic [conn pool]
     (let [perms (teams/check-read-permissions! conn profile-id team-id)]
-      (when-not (or (:is-owner perms)
-                    (:is-admin perms))
+      (when-not (or (some :is-owner perms)
+                    (some :is-admin perms))
         (ex/raise :type :validation
                   :code :insufficient-permissions))
 
@@ -252,9 +255,10 @@
 
 (sv/defmethod ::update-team-photo
   [{:keys [pool storage] :as cfg} {:keys [profile-id file team-id] :as params}]
-  (media/validate-media-type (:content-type file))
   (db/with-atomic [conn pool]
     (teams/check-edition-permissions! conn profile-id team-id)
+    (media/validate-media-type (:content-type file) #{"image/jpeg" "image/png" "image/webp"})
+
     (let [team    (teams/retrieve-team conn profile-id team-id)
           _       (media/run cfg {:cmd :info :input {:path (:tempfile file)
                                                      :mtype (:content-type file)}})
@@ -297,26 +301,50 @@
 (sv/defmethod ::invite-team-member
   [{:keys [pool tokens] :as cfg} {:keys [profile-id team-id email role] :as params}]
   (db/with-atomic [conn pool]
-    (let [perms   (teams/check-edition-permissions! conn profile-id team-id)
-          profile (db/get-by-id conn :profile profile-id)
-          member  (profile/retrieve-profile-data-by-email conn email)
-          team    (db/get-by-id conn :team team-id)
-          token   (tokens :generate
-                          {:iss :team-invitation
-                           :exp (dt/in-future "24h")
-                           :profile-id (:id profile)
-                           :role role
-                           :team-id team-id
-                           :member-email (:email member email)
-                           :member-id (:id member)})]
+    (let [perms    (teams/check-edition-permissions! conn profile-id team-id)
+          profile  (db/get-by-id conn :profile profile-id)
+          member   (profile/retrieve-profile-data-by-email conn email)
+          team     (db/get-by-id conn :team team-id)
+          itoken   (tokens :generate
+                           {:iss :team-invitation
+                            :exp (dt/in-future "48h")
+                            :profile-id (:id profile)
+                            :role role
+                            :team-id team-id
+                            :member-email (:email member email)
+                            :member-id (:id member)})
+          ptoken   (tokens :generate-predefined
+                           {:iss :profile-identity
+                            :profile-id (:id profile)})]
 
       (when-not (some :is-admin perms)
         (ex/raise :type :validation
                   :code :insufficient-permissions))
 
-      (emails/send! conn emails/invite-to-team
-                    {:to email
-                     :invited-by (:fullname profile)
-                     :team (:name team)
-                     :token token})
+      ;; First check if the current profile is allowed to send emails.
+      (when-not (eml/allow-send-emails? conn profile)
+        (ex/raise :type :validation
+                  :code :profile-is-muted
+                  :hint "looks like the profile has reported repeatedly as spam or has permanent bounces"))
+
+      (when (and member (not (eml/allow-send-emails? conn member)))
+        (ex/raise :type :validation
+                  :code :member-is-muted
+                  :hint "looks like the profile has reported repeatedly as spam or has permanent 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
+                  :hint "looks like the email you invite has been repeatedly reported as spam or permanent bounce"))
+
+      (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})
       nil)))

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

@@ -2,17 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.rpc.mutations.verify-token
   (:require
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.db :as db]
-   [app.http.session :as session]
    [app.rpc.mutations.teams :as teams]
    [app.rpc.queries.profile :as profile]
    [app.util.services :as sv]
@@ -41,8 +37,15 @@
               {:id profile-id})
   claims)
 
+(defn- annotate-profile-activation
+  "A helper for properly increase the profile-activation metric once the
+  transaction is completed."
+  [metrics]
+  (fn []
+    ((get-in metrics [:definitions :profile-activation]) :inc)))
+
 (defmethod process-token :verify-email
-  [{:keys [conn session] :as cfg} _params {:keys [profile-id] :as claims}]
+  [{:keys [conn session metrics] :as cfg} _ {:keys [profile-id] :as claims}]
   (let [profile (profile/retrieve-profile conn profile-id)
         claims  (assoc claims :profile profile)]
 
@@ -57,14 +60,8 @@
                   {:id (:id profile)}))
 
     (with-meta claims
-      {:transform-response
-       (fn [request response]
-         (let [uagent (get-in request [:headers "user-agent"])
-               id     (session/create! session {:profile-id profile-id
-                                                :user-agent uagent})]
-           (assoc response
-                  :cookies (session/cookies session {:value id}))))})))
-
+      {:transform-response ((:create session) profile-id)
+       :before-complete (annotate-profile-activation metrics)})))
 
 (defmethod process-token :auth
   [{:keys [conn] :as cfg} _params {:keys [profile-id] :as claims}]
@@ -91,47 +88,78 @@
                    :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] :as claims}]
+  (let [params (merge {:team-id team-id
+                       :profile-id member-id}
+                      (teams/role->params role))
+        member (profile/retrieve-profile conn member-id)]
+
+    ;; 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)))
+
 (defmethod process-token :team-invitation
-  [{:keys [conn session] :as cfg} {:keys [profile-id token]} {:keys [member-id team-id role] :as claims}]
+  [{:keys [session] :as cfg} {:keys [profile-id token]} {:keys [member-id] :as claims}]
   (us/assert ::team-invitation-claims claims)
-  (if (uuid? member-id)
-    (let [params (merge {:team-id team-id
-                         :profile-id member-id}
-                        (teams/role->params role))
-          claims (assoc claims :state :created)]
-
-      (db/insert! conn :team-profile-rel params
-                  {:on-conflict-do-nothing true})
-
-      (if (and (uuid? profile-id)
-               (= member-id profile-id))
+  (cond
+    ;; This happens when token is filled with member-id and current
+    ;; user is already logged in with some account.
+    (and (uuid? profile-id)
+         (uuid? member-id))
+    (do
+      (accept-invitation cfg claims)
+      (if (= member-id profile-id)
         ;; If the current session is already matches the invited
         ;; member, then just return the token and leave the frontend
         ;; app redirect to correct team.
-        claims
+        (assoc claims :state :created)
 
-        ;; If the session does not matches the invited member id,
-        ;; replace the session with a new one matching the invited
-        ;; member. This techinique should be considered secure because
-        ;; the user clicking the link he already has access to the
-        ;; email account.
-        (with-meta claims
-          {:transform-response
-           (fn [request response]
-             (let [uagent (get-in request [:headers "user-agent"])
-                   id     (session/create! session {:profile-id member-id
-                                                    :user-agent uagent})]
-               (assoc response
-                      :cookies (session/cookies session {:value id}))))})))
+        ;; If the session does not matches the invited member, replace
+        ;; the session with a new one matching the invited member.
+        ;; This techinique should be considered secure because the
+        ;; user clicking the link he already has access to the email
+        ;; account.
+        (with-meta
+          (assoc claims :state :created)
+          {:transform-response ((:create session) member-id)})))
+
+    ;; This happens when member-id is not filled in the invitation but
+    ;; the user already has an account (probably with other mail) and
+    ;; is already logged-in.
+    (and (uuid? profile-id)
+         (nil? member-id))
+    (do
+      (accept-invitation cfg (assoc claims :member-id profile-id))
+      (assoc claims :state :created))
+
+    ;; This happens when member-id is filled but the accessing user is
+    ;; not logged-in. In this case we proceed to accept invitation and
+    ;; leave the user logged-in.
+    (and (nil? profile-id)
+         (uuid? member-id))
+    (do
+      (accept-invitation cfg claims)
+      (with-meta
+        (assoc claims :state :created)
+        {:transform-response ((:create session) member-id)}))
 
     ;; In this case, we wait until frontend app redirect user to
     ;; registeration page, the user is correctly registered and the
     ;; register mutation call us again with the same token to finally
     ;; create the corresponding team-profile relation from the first
     ;; condition of this if.
-    (assoc claims
-           :token token
-           :state :pending)))
+    :else
+    {:invitation-token token
+     :iss :team-invitation
+     :state :pending}))
 
 
 ;; --- Default

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

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.rpc.mutations.viewer
   (:require

backend/src/app/rpc/permissions.clj

@@ -2,16 +2,40 @@
 ;; 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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.rpc.permissions
   "A permission checking helper factories."
   (:require
    [app.common.exceptions :as ex]
-   [app.common.spec :as us]))
+   [app.common.spec :as us]
+   [clojure.spec.alpha :as s]))
+
+(s/def ::role #{:admin :owner :editor :viewer})
+
+(defn assign-role-flags
+  [params role]
+  (us/verify ::role role)
+  (cond-> params
+    (= role :owner)
+    (assoc :is-owner true
+           :is-admin true
+           :can-edit true)
+
+    (= role :admin)
+    (assoc :is-owner false
+           :is-admin true
+           :can-edit true)
+
+    (= role :editor)
+    (assoc :is-owner false
+           :is-admin false
+           :can-edit true)
+
+    (= role :viewer)
+    (assoc :is-owner false
+           :is-admin false
+           :can-edit false)))
 
 (defn make-edition-check-fn
   "A simple factory for edition permission check functions."

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

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.rpc.queries.comments
   (:require
@@ -131,7 +128,6 @@
       (-> (db/exec-one! conn [sql profile-id file-id id])
           (decode-row)))))
 
-
 ;; --- Query: Comments
 
 (declare retrieve-comments)

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

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.rpc.queries.files
   (:require
@@ -166,7 +163,6 @@
     (let [file (retrieve-file conn file-id)]
       (get-in file [:data :pages-index id]))))
 
-
 ;; --- Query: Shared Library Files
 
 (def ^:private sql:shared-files
@@ -256,12 +252,11 @@
 ;; --- Helpers
 
 (defn decode-row
-  [{:keys [pages data changes] :as row}]
+  [{:keys [data changes] :as row}]
   (when row
     (cond-> row
       changes (assoc :changes (blob/decode changes))
-      data (assoc :data (blob/decode data))
-      pages (assoc :pages (vec (.getArray pages))))))
+      data    (assoc :data (blob/decode data)))))
 
 (def decode-row-xf
   (comp (map decode-row)

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

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.rpc.queries.profile
   (:require
@@ -14,8 +11,7 @@
    [app.common.uuid :as uuid]
    [app.db :as db]
    [app.util.services :as sv]
-   [clojure.spec.alpha :as s]
-   [cuerdas.core :as str]))
+   [clojure.spec.alpha :as s]))
 
 ;; --- Helpers & Specs
 
@@ -45,32 +41,34 @@
     {:id uuid/zero
      :fullname "Anonymous User"}))
 
-;; NOTE: this query make the assumption that union all preserves the
-;; order so the first id will always be the team id and the second the
-;; project_id; this is a postgresql behavior because UNION ALL works
-;; like APPEND operation.
-
-(def ^:private sql:default-team-and-project
-  "select t.id
+(def ^:private sql:default-profile-team
+  "select t.id, name
      from team as t
     inner join team_profile_rel as tp on (tp.team_id = t.id)
     where tp.profile_id = ?
       and tp.is_owner is true
-      and t.is_default is true
-    union all
-   select p.id
+      and t.is_default is true")
+
+(def ^:private sql:default-profile-project
+  "select p.id, name
      from project as p
     inner join project_profile_rel as tp on (tp.project_id = p.id)
     where tp.profile_id = ?
       and tp.is_owner is true
-      and p.is_default is true")
+      and p.is_default is true
+      and p.team_id = ?")
 
 (defn retrieve-additional-data
   [conn id]
-  (let [[team project] (db/exec! conn [sql:default-team-and-project id id])]
+  (let [team    (db/exec-one! conn [sql:default-profile-team id])
+        project (db/exec-one! conn [sql:default-profile-project id (:id team)])]
     {:default-team-id (:id team)
      :default-project-id (:id project)}))
 
+(defn populate-additional-data
+  [conn profile]
+  (merge profile (retrieve-additional-data conn (:id profile))))
+
 (defn decode-profile-row
   [{:keys [props] :as row}]
   (cond-> row
@@ -83,27 +81,25 @@
 
 (defn retrieve-profile
   [conn id]
-  (let [profile (some-> (retrieve-profile-data conn id)
-                        (strip-private-attrs)
-                        (merge (retrieve-additional-data conn id)))]
+  (let [profile (some->> (retrieve-profile-data conn id)
+                         (strip-private-attrs)
+                         (populate-additional-data conn))]
     (when (nil? profile)
       (ex/raise :type :not-found
                 :hint "Object doest not exists."))
 
     profile))
 
-
-(def sql:profile-by-email
-  "select * from profile
-    where email=?
-      and deleted_at is null")
+(def sql:retrieve-profile-by-email
+  "select p.* from profile as p
+    where p.email = lower(?)
+      and p.deleted_at is null")
 
 (defn retrieve-profile-data-by-email
   [conn email]
-  (let [email (str/lower email)]
-    (-> (db/exec-one! conn [sql:profile-by-email email])
-        (decode-profile-row))))
-
+  (let [sql  [sql:retrieve-profile-by-email email]]
+    (some-> (db/exec-one! conn sql)
+            (decode-profile-row))))
 
 ;; --- Attrs Helpers
 

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

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.rpc.queries.projects
   (:require
@@ -82,6 +79,50 @@
   (db/exec! conn [sql:projects profile-id team-id]))
 
 
+;; --- Query: All projects
+
+(declare retrieve-all-projects)
+
+(s/def ::profile-id ::us/uuid)
+(s/def ::all-projects
+  (s/keys :req-un [::profile-id]))
+
+(sv/defmethod ::all-projects
+  [{:keys [pool]} {:keys [profile-id]}]
+  (with-open [conn (db/open pool)]
+    (retrieve-all-projects conn profile-id)))
+
+(def sql:all-projects
+  "select p1.*, t.name as team_name, t.is_default as is_default_team
+     from project as p1
+    inner join team as t
+            on t.id = p1.team_id
+    where t.id in (select team_id
+                     from team_profile_rel as tpr
+                    where tpr.profile_id = ?
+                      and (tpr.can_edit = true or
+                           tpr.is_owner = true or
+                           tpr.is_admin = true))
+      and p1.deleted_at is null
+   union
+   select p2.*, t.name as team_name, t.is_default as is_default_team
+     from project as p2
+    inner join team as t
+              on t.id = p2.team_id
+    where p2.id in (select project_id
+                     from project_profile_rel as ppr
+                    where ppr.profile_id = ?
+                      and (ppr.can_edit = true or
+                           ppr.is_owner = true or
+                           ppr.is_admin = true))
+      and p2.deleted_at is null
+    order by team_name, name;")
+
+(defn retrieve-all-projects
+  [conn profile-id]
+  (db/exec! conn [sql:all-projects profile-id profile-id]))
+
+
 ;; --- Query: Project
 
 (s/def ::id ::us/uuid)
@@ -94,3 +135,4 @@
     (let [project (db/get-by-id conn :project id)]
       (check-read-permissions! conn profile-id id)
       project)))
+

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

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.rpc.queries.recent-files
   (:require
@@ -27,7 +24,7 @@
      window w as (partition by f.project_id order by f.modified_at desc)
       order by f.modified_at desc
    )
-   select * from recent_files where row_num <= 6;")
+   select * from recent_files where row_num <= 10;")
 
 (s/def ::team-id ::us/uuid)
 (s/def ::profile-id ::us/uuid)
@@ -41,5 +38,3 @@
     (teams/check-read-permissions! conn profile-id team-id)
     (let [files (db/exec! conn [sql:recent-files team-id])]
       (into [] decode-row-xf files))))
-
-

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

@@ -0,0 +1,58 @@
+;; 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.rpc.queries.svg
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.util.logging :as l]
+   [app.util.services :as sv]
+   [clojure.spec.alpha :as s]
+   [clojure.xml :as xml]
+   [cuerdas.core :as str])
+  (:import
+   javax.xml.XMLConstants
+   javax.xml.parsers.SAXParserFactory
+   org.apache.commons.io.IOUtils))
+
+(defn- secure-parser-factory
+  [s ch]
+  (.. (doto (SAXParserFactory/newInstance)
+        (.setFeature XMLConstants/FEATURE_SECURE_PROCESSING true)
+        (.setFeature "http://apache.org/xml/features/disallow-doctype-decl" true))
+      (newSAXParser)
+      (parse s ch)))
+
+(defn parse
+  [data]
+  (try
+    (with-open [istream (IOUtils/toInputStream data "UTF-8")]
+      (xml/parse istream secure-parser-factory))
+    (catch Exception e
+      (l/warn :hint "error on processing svg"
+              :message (ex-message e))
+      (ex/raise :type :validation
+                :code :invalid-svg-file
+                :cause e))))
+
+(declare pre-process)
+
+(s/def ::data ::us/string)
+(s/def ::parsed-svg (s/keys :req-un [::data]))
+
+(sv/defmethod ::parsed-svg
+  [_ {:keys [data] :as params}]
+  (->> data pre-process parse))
+
+;; --- PROCESSORS
+
+(defn strip-doctype
+  [data]
+  (cond-> data
+    (str/includes? data "<!DOCTYPE")
+    (str/replace #"<\!DOCTYPE[^>]+>" "")))
+
+(def pre-process strip-doctype)

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

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.rpc.queries.teams
   (:require

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

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.rpc.queries.viewer
   (:require

backend/src/app/setup.clj

@@ -2,13 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020-2021 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
-(ns app.sprops
-  "Server props module."
+(ns app.setup
+  "Initial data setup of instance."
   (:require
    [app.common.uuid :as uuid]
    [app.db :as db]
@@ -17,42 +14,45 @@
    [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
-(declare initialize)
+(declare initialize-instance-id!)
+(declare initialize-secret-key!)
+(declare retrieve-all)
 
 (defmethod ig/pre-init-spec ::props [_]
   (s/keys :req-un [::db/pool]))
 
 (defmethod ig/init-key ::props
-  [_ cfg]
-  (initialize cfg))
+  [_ {:keys [pool] :as cfg}]
+  (db/with-atomic [conn pool]
+    (let [cfg (assoc cfg :conn conn)]
+      (initialize-secret-key! cfg)
+      (initialize-instance-id! cfg)
+      (retrieve-all cfg))))
 
-(defn- initialize-secret-key
+(defn- initialize-secret-key!
   [{:keys [conn] :as cfg}]
   (let [key (-> (bn/random-bytes 64)
                 (bc/bytes->b64u)
                 (bc/bytes->str))]
-    (db/exec-one! conn ["insert into server_prop (id, content)
-                         values ('secret-key', ?) on conflict do nothing"
-                        (db/tjson key)])))
+    (db/insert! conn :server-prop
+                {:id "secret-key"
+                 :preload true
+                 :content (db/tjson key)}
+                {:on-conflict-do-nothing true})))
 
-(defn- initialize-instance-id
+(defn- initialize-instance-id!
   [{:keys [conn] :as cfg}]
   (let [iid (uuid/random)]
-    (db/exec-one! conn ["insert into server_prop (id, content)
-                         values ('instance-id', ?::jsonb) on conflict do nothing"
-                        (db/tjson iid)])))
+
+    (db/insert! conn :server-prop
+                {:id "instance-id"
+                 :preload true
+                 :content (db/tjson iid)}
+                {:on-conflict-do-nothing true})))
 
 (defn- retrieve-all
   [{:keys [conn] :as cfg}]
   (reduce (fn [acc row]
             (assoc acc (keyword (:id row)) (db/decode-transit-pgobject (:content row))))
           {}
-          (db/exec! conn ["select * from server_prop;"])))
-
-(defn- initialize
-  [{:keys [pool] :as cfg}]
-  (db/with-atomic [conn pool]
-    (let [cfg (assoc cfg :conn conn)]
-      (initialize-secret-key cfg)
-      (initialize-instance-id cfg)
-      (retrieve-all cfg))))
+          (db/query conn :server-prop {:preload true})))

backend/src/app/setup/initial_data.clj

@@ -0,0 +1,100 @@
+;; 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.setup.initial-data
+  (:refer-clojure :exclude [load])
+  (:require
+   [app.common.uuid :as uuid]
+   [app.config :as cfg]
+   [app.db :as db]
+   [app.rpc.mutations.management :refer [duplicate-file]]
+   [app.rpc.mutations.projects :refer [create-project create-project-role]]
+   [app.rpc.queries.profile :as profile]))
+
+;; --- DUMP GENERATION
+
+(def sql:file
+  "select * from file where project_id = ?")
+
+(def sql:file-library-rel
+  "with file_ids as (select id from file where project_id = ?)
+   select *
+     from file_library_rel
+     where file_id in (select id from file_ids)")
+
+(def sql:file-media-object
+  "with file_ids as (select id from file where project_id = ?)
+   select *
+     from file_media_object
+     where file_id in (select id from file_ids)")
+
+(defn dump
+  ([system project-id] (dump system project-id nil))
+  ([system project-id {:keys [skey project-name]
+                       :or {project-name "Penpot Onboarding"}}]
+   (db/with-atomic [conn (:app.db/pool system)]
+     (let [skey  (or skey (cfg/get :initial-project-skey))
+           files (db/exec! conn [sql:file project-id])
+           flibs (db/exec! conn [sql:file-library-rel project-id])
+           fmeds (db/exec! conn [sql:file-media-object project-id])
+           data  {:project-name project-name
+                  :files files
+                  :flibs flibs
+                  :fmeds fmeds}]
+
+       (db/delete! conn :server-prop {:id skey})
+       (db/insert! conn :server-prop
+                   {:id skey
+                    :preload false
+                    :content (db/tjson data)})
+       skey))))
+
+
+;; --- DUMP LOADING
+
+(defn- retrieve-data
+  [conn skey]
+  (when-let [row (db/exec-one! conn ["select content from server_prop where id = ?" skey])]
+    (when-let [content (:content row)]
+      (when (db/pgobject? content)
+        (db/decode-transit-pgobject content)))))
+
+(defn load-initial-project!
+  ([conn profile] (load-initial-project! conn profile nil))
+  ([conn profile opts]
+   (let [skey (or (:skey opts) (cfg/get :initial-project-skey))
+         data (retrieve-data conn skey)]
+     (when data
+       (let [index   (reduce #(assoc %1 (:id %2) (uuid/next)) {} (:files data))
+             project {:id (uuid/next)
+                      :profile-id (:id profile)
+                      :team-id (:default-team-id profile)
+                      :name (:project-name data)}]
+
+         (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
+
+         (create-project conn project)
+         (create-project-role conn {:project-id (:id project)
+                                    :profile-id (:id profile)
+                                    :role :owner})
+
+         (doseq [file (:files data)]
+           (let [params {:profile-id (:id profile)
+                         :project-id (:id project)
+                         :file file
+                         :index index}
+                 opts   {:reset-shared-flag false}]
+             (duplicate-file conn params opts))))))))
+
+(defn load
+  [system {:keys [email] :as opts}]
+  (db/with-atomic [conn (:app.db/pool system)]
+    (when-let [profile (some->> email
+                                (profile/retrieve-profile-data-by-email conn)
+                                (profile/populate-additional-data conn))]
+      (load-initial-project! conn profile opts)
+      true)))
+

backend/src/app/srepl.clj

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.srepl
   "Server Repl."

backend/src/app/srepl/main.clj

@@ -3,14 +3,16 @@
   #_:clj-kondo/ignore
   (:require
    [app.common.pages :as cp]
+   [app.common.uuid :as uuid]
    [app.common.pages.migrations :as pmg]
    [app.config :as cfg]
    [app.db :as db]
-   [app.db.profile-initial-data :as pid]
+   [app.db.sql :as sql]
    [app.main :refer [system]]
    [app.rpc.queries.profile :as prof]
    [app.srepl.dev :as dev]
    [app.util.blob :as blob]
+   [cuerdas.core :as str]
    [clojure.pprint :refer [pprint]]))
 
 (defn update-file
@@ -53,27 +55,6 @@
 ;;         (fn [{:keys [data] :as file}]
 ;;           (update-in data [:pages-index #uuid "878278c0-3ef0-11eb-9d67-8551e7624f43" :objects] dissoc nil))))
 
-(def default-project-id #uuid "5761a890-3b81-11eb-9e7d-556a2f641513")
-
-(defn initial-data-dump
-  ([system file] (initial-data-dump system default-project-id file))
-  ([system project-id path]
-   (db/with-atomic [conn (:app.db/pool system)]
-     (pid/create-initial-data-dump conn project-id path))))
-
-(defn load-data-into-user
-  ([system user-email]
-   (if-let [file (:initial-data-file cfg/config)]
-     (load-data-into-user system file user-email)
-     (prn "Data file not found in configuration")))
-
-  ([system file user-email]
-   (db/with-atomic [conn (:app.db/pool system)]
-     (let [profile (prof/retrieve-profile-data-by-email conn user-email)
-           profile (merge profile (prof/retrieve-additional-data conn (:id profile)))]
-       (pid/create-profile-initial-data conn file profile)))))
-
-
 ;; Migrate
 
 (defn update-file-data-blob-format
@@ -86,3 +67,17 @@
                     {:data (-> (blob/decode data)
                                (blob/encode {:version 2}))}
                     {:id id})))))
+
+
+(defn duplicate-file
+  "This is a raw version of duplication of file just only for forensic analisys"
+  [system file-id email]
+  (db/with-atomic [conn (:app.db/pool system)]
+    (when-let [profile (some->> (prof/retrieve-profile-data-by-email conn (str/lower email))
+                                (prof/populate-additional-data conn))]
+      (when-let [file (db/exec-one! conn (sql/select :file {:id file-id}))]
+        (let [params (assoc file
+                            :id (uuid/next)
+                            :project-id (:default-project-id profile))]
+          (db/insert! conn :file params)
+          (:id file))))))

backend/src/app/storage.clj

@@ -2,10 +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/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.storage
   "File Storage abstraction layer."
@@ -19,10 +16,10 @@
    [app.storage.fs :as sfs]
    [app.storage.impl :as impl]
    [app.storage.s3 :as ss3]
+   [app.util.logging :as l]
    [app.util.time :as dt]
    [app.worker :as wrk]
    [clojure.spec.alpha :as s]
-   [clojure.tools.logging :as log]
    [cuerdas.core :as str]
    [datoteka.core :as fs]
    [integrant.core :as ig]
@@ -308,9 +305,11 @@
           (if-let [[groups total] (retrieve-deleted-objects conn)]
             (do
               (run! (partial delete-in-bulk conn) groups)
-              (recur (+ n total)))
+              (recur (+ n ^long total)))
             (do
-              (log/infof "gc-deleted: processed %s items" n)
+              (l/info :task "gc-deleted"
+                      :action "permanently delete items"
+                      :count n)
               {:deleted n})))))))
 
 (def sql:retrieve-deleted-objects
@@ -382,7 +381,12 @@
               (recur (+ cntf (count to-freeze))
                      (+ cntd (count to-delete))))
             (do
-              (log/infof "gc-touched: %s objects marked as freeze and %s marked to be deleted" cntf cntd)
+              (l/info :task "gc-touched"
+                      :action "mark freeze"
+                      :count cntf)
+              (l/info :task "gc-touched"
+                      :action "mark for deletion"
+                      :count cntd)
               {:freeze cntf :delete cntd})))))))
 
 (def sql:retrieve-touched-objects
@@ -459,7 +463,10 @@
               (recur (+ n (count all))
                      (+ d (count to-delete))))
             (do
-              (log/infof "recheck: processed %s items, %s deleted" n d)
+              (l/info :task "recheck"
+                      :action "recheck items"
+                      :processed n
+                      :deleted n)
               {:processed n :deleted d})))))))
 
 (def sql:retrieve-pending-to-recheck