📎 Update changelog.

Related to stroage.

.circleci/config.yml

@@ -9,11 +9,11 @@ jobs:
       # CircleCI maintains a library of pre-built images
       # documented at https://circleci.com/docs/2.0/circleci-images/
       # - image: circleci/postgres:9.4
-      - image: circleci/postgres:13.1-ram
+      - image: circleci/postgres:13.3-ram
         environment:
           POSTGRES_USER: penpot_test
           POSTGRES_PASSWORD: penpot_test
-          POSTGRES_DB: penpot
+          POSTGRES_DB: penpot_test
 
       - image: circleci/redis:6.0.8
 
@@ -29,38 +29,63 @@ jobs:
       # Download and cache dependencies
       - restore_cache:
          keys:
-           - v1-dependencies-{{ checksum "backend/deps.edn" }}-{{ checksum "frontend/deps.edn"}}
+           - v1-dependencies-{{ checksum "backend/deps.edn" }}-{{ checksum "frontend/deps.edn"}}-{{ checksum "common/deps.edn"}}
            # fallback to using the latest cache if no exact match is found
            - v1-dependencies-
 
-      # run lint
       - run:
-          working_directory: "./backend"
-          name: backend lint
-          command: "clj-kondo --lint src/"
-
-      # run test
-      - run:
-          working_directory: "./backend"
-          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"
+          name: common lint
+          working_directory: "./common"
+          command: "clj-kondo --parallel --lint src/"
 
       - run:
+          name: frontend lint
           working_directory: "./frontend"
+          command: "clj-kondo --parallel --lint src/"
+
+      - run:
+          name: backend lint
+          working_directory: "./backend"
+          command: "clj-kondo --parallel --lint src/"
+
+      # run backend test
+      - run:
+          name: backend test
+          working_directory: "./backend"
+          command: "clojure -X:dev:test"
+          environment:
+            PENPOT_TEST_DATABASE_URI: "postgresql://localhost/penpot_test"
+            PENPOT_TEST_DATABASE_USERNAME: penpot_test
+            PENPOT_TEST_DATABASE_PASSWORD: penpot_test
+            PENPOT_TEST_REDIS_URI: "redis://localhost/1"
+
+      - run:
           name: frontend tests
+          working_directory: "./frontend"
           command: |
             yarn install
-            npx shadow-cljs compile tests
+            clojure -M:dev:shadow-cljs compile test
+            node target/tests.js
+
           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
+
+      - run:
+          working_directory: "./common"
+          name: common tests
+          command: |
+            yarn install
+            clojure -M:dev:shadow-cljs compile test
+            node target/tests.js
+            clojure -X:dev:test
+
+          environment:
+            JAVA_HOME: /usr/lib/jvm/openjdk16
+            PATH: /usr/local/nodejs/bin/:/usr/local/bin:/bin:/usr/bin:/usr/lib/jvm/openjdk16/bin
 
       - save_cache:
          paths:
            - ~/.m2
-         key: v1-dependencies-{{ checksum "backend/deps.edn" }}-{{ checksum "frontend/deps.edn"}}
+         key: v1-dependencies-{{ checksum "backend/deps.edn" }}-{{ checksum "frontend/deps.edn"}}-{{ checksum "common/deps.edn"}}
 

.clj-kondo/config.edn

@@ -1,9 +1,23 @@
-{:lint-as {potok.core/reify clojure.core/reify
-           promesa.core/let clojure.core/let
-           rumext.alpha/defc clojure.core/defn
-           app.db/with-atomic clojure.core/with-open}
+{:lint-as
+ {promesa.core/let clojure.core/let
+  rumext.alpha/defc clojure.core/defn
+  rumext.alpha/fnc clojure.core/fn
+  app.common.data/export clojure.core/def
+  app.db/with-atomic clojure.core/with-open}
+
+ :hooks
+ {:analyze-call
+  {app.common.data/export hooks.export/export
+   potok.core/reify hooks.export/potok-reify
+   cljs.core/specify! hooks.export/clojure-specify
+   app.util.services/defmethod hooks.export/service-defmethod
+   }}
+
  :output
- {:exclude-files ["data_readers.clj"]}
+ {:exclude-files
+  ["data_readers.clj"
+   "app/util/perf.cljs"
+   "app/common/exceptions.cljc"]}
 
  :linters
  {:unsorted-required-namespaces
@@ -16,12 +30,12 @@
   :single-key-in
   {:level :warning}
 
+  :redundant-do
+  {:level :off}
+
   :unused-binding
   {:exclude-destructured-as true
    :exclude-destructured-keys-in-fn-args false
    }
-
-  :unresolved-symbol
-  {:exclude ['(app.util.services/defmethod)
-             ]}}}
+  }}
 

.clj-kondo/hooks/export.clj

@@ -0,0 +1,49 @@
+(ns hooks.export
+  (:require [clj-kondo.hooks-api :as api]))
+
+(defn export
+  [{:keys [:node]}]
+  (let [[_ sname] (:children node)
+        result  (api/list-node
+                 [(api/token-node (symbol "def"))
+                  (api/token-node (symbol (name (:value sname))))
+                  sname])]
+    {:node result}))
+
+(defn potok-reify
+  [{:keys [:node]}]
+  (let [[rnode rtype & other] (:children node)
+        result  (api/list-node
+                 (into [(api/token-node (symbol "deftype"))
+                        (api/token-node (gensym (name (:k rtype))))
+                        (api/vector-node [])]
+                       other))]
+    {:node result}))
+
+(defn clojure-specify
+  [{:keys [:node]}]
+  (let [[rnode rtype & other] (:children node)
+        result  (api/list-node
+                 (into [(api/token-node (symbol "extend-type"))
+                        (api/token-node (gensym (:string-value rtype)))]
+                       other))]
+    {:node result}))
+
+
+(defn service-defmethod
+  [{:keys [:node]}]
+  (let [[rnode rtype & other] (:children node)
+        rsym    (gensym (name (:k rtype)))
+        result  (api/list-node
+                 [(api/token-node (symbol "do"))
+                  (api/list-node
+                   [(api/token-node (symbol "declare"))
+                    (api/token-node rsym)])
+                  (api/list-node
+                   (into [(api/token-node (symbol "defmethod"))
+                          (api/token-node rsym)
+                          rtype]
+                         other))])]
+    {:node result}))
+
+

.gitignore

@@ -15,18 +15,23 @@ 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/
 /frontend/out/
 /frontend/.shadow-cljs
 /frontend/resources/public/*
+/frontend/resources/fonts/experiments
 /exporter/target
 /exporter/.shadow-cljs
-/docker/images/bundle
+/docker/images/bundle*
+/common/.shadow-cljs
+/common/target
 /.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

@@ -5,9 +5,373 @@
 ### :sparkles: New features
 
 ### :bug: Bugs fixed
+### :arrow_up: Deps updates
+### :boom: Breaking changes
+### :heart: Community contributions by (Thank you!)
+
+
+## 1.7.3-alpha
+
+### :bug: Bugs fixed
+
+- Fix font uploading issue on Windows.
+
+
+## 1.7.2-alpha
+
+### :sparkles: New features
+
+- Add many improvements to text tool.
+
+### :bug: Bugs fixed
+
+- Add scroll bar to Teams menu [Taiga #1894](https://tree.taiga.io/project/penpot/issue/1894).
+- Fix repeated names when duplicating artboards or groups [Taiga #1892](https://tree.taiga.io/project/penpot/issue/1892).
+- Fix properly messages lifecycle on navigate.
+- Fix handling repeated names on duplicate object trees.
+- Fix group naming on group creation.
+- Fix some issues in svg transformation.
+
+### :arrow_up: Deps updates
+
+- Update frontend build tooling.
+
+### :boom: Breaking changes
+### :heart: Community contributions by (Thank you!)
+
+- soultipsy [#1100](https://github.com/penpot/penpot/pull/1100)
+
+
+## 1.7.1-alpha
+
+### :bug: Bugs fixed
+
+- Fix issue related to the GC and images in path shapes.
+- Fix issue on the shape order on some undo operations.
+- Fix issue on undo page deletion.
+- Fix some issues related to constraints.
+
+
+## 1.7.0-alpha
+
+### :sparkles: New features
+
+- Allow nested asset groups [Taiga #1716](https://tree.taiga.io/project/penpot/us/1716).
+- Allow to ungroup assets [Taiga #1719](https://tree.taiga.io/project/penpot/us/1719).
+- Allow to rename assets groups [Taiga #1721](https://tree.taiga.io/project/penpot/us/1721).
+- Component constraints (left, right, left and right, center, scale...) [Taiga #1125](https://tree.taiga.io/project/penpot/us/1125).
+- Export elements to PDF [Taiga #519](https://tree.taiga.io/project/penpot/us/519).
+- Memorize collapse state of assets in panel [Taiga #1718](https://tree.taiga.io/project/penpot/us/1718).
+- Headers button sets and menus review [Taiga #1663](https://tree.taiga.io/project/penpot/us/1663).
+- Preserve components if possible, when pasted into a different file [Taiga #1063](https://tree.taiga.io/project/penpot/issue/1063).
+- Add the ability to offload file data to a cheaper storage when file becomes inactive.
+- Import/Export Penpot files from dashboard.
+- Double click won't make a shape a path until you change a node [Taiga #1796](https://tree.taiga.io/project/penpot/us/1796)
+- Incremental area selection [#779](https://github.com/penpot/penpot/discussions/779)
+
+### :bug: Bugs fixed
+
+- Process numeric input changes only if the value actually changed.
+- Remove unnecesary redirect from history when user goes to workspace from dashboard [Taiga #1820](https://tree.taiga.io/project/penpot/issue/1820).
+- Detach shapes from deleted assets [Taiga #1850](https://tree.taiga.io/project/penpot/issue/1850).
+- Fix tooltip position on view application [Taiga #1819](https://tree.taiga.io/project/penpot/issue/1819).
+- Fix dashboard navigation on moving file to other team [Taiga #1817](https://tree.taiga.io/project/penpot/issue/1817).
+- Fix workspace header presence styles and invalid link [Taiga #1813](https://tree.taiga.io/project/penpot/issue/1813).
+- Fix color-input wrong behavior (on workspace page color) [Taiga #1795](https://tree.taiga.io/project/penpot/issue/1795).
+- Fix file contextual menu in shared libraries at dashboard [Taiga #1865](https://tree.taiga.io/project/penpot/issue/1865).
+- Fix problem with color picker and fonts [#1049](https://github.com/penpot/penpot/issues/1049)
+- Fix negative values in blur [Taiga #1815](https://tree.taiga.io/project/penpot/issue/1815)
+- Fix problem when editing color in group [Taiga #1816](https://tree.taiga.io/project/penpot/issue/1816)
+- Fix resize/rotate with mouse buttons different than left [#1060](https://github.com/penpot/penpot/issues/1060)
+- Fix header partialy visible on fullscreen viewer mode [Taiga #1875](https://tree.taiga.io/project/penpot/issue/1875)
+- Fix dynamic alignment enabled with hidden objects [#1063](https://github.com/penpot/penpot/issues/1063)
+
+
+### :arrow_up: Deps updates
+### :boom: Breaking changes
+### :heart: Community contributions by (Thank you!)
+
+## 1.6.5-alpha
+
+### :bug: Bugs fixed
+
+- Fix problem with paths editing after flip [#1040](https://github.com/penpot/penpot/issues/1040)
+
+## 1.6.4-alpha
+
+### :sparkles: Minor improvements
+
+-  Decrease default bulk buffers on storage tasks.
+-  Reduce file_change preserve interval to 24h.
+
+### :bug: Bugs fixed
+
+- Don't allow rename drafts project.
+- Fix custom font deletion task.
+- Fix custom font rendering on exporting shapes.
+- Fix font loading on viewer app.
+- Fix problem when moving files with drag & drop.
+- Fix unexpected exception on searching without term.
+- Properly handle nil values on `update-shapes` function.
+- Replace frame term usage by artboard on viewer app.
+
+
+## 1.6.3-alpha
+
+### :bug: Bugs fixed
+
+- Fix problem with merge and join nodes [#990](https://github.com/penpot/penpot/issues/990)
+- Fix problem with empty path editing.
+- Fix problem with create component.
+- Fix problem with move-objects.
+- Fix problem with merge and join nodes.
+
+## 1.6.2-alpha
+
+### :bug: Bugs fixed
+
+- Add better auth module logging.
+- Add missing `email` scope to OIDC backend.
+- Add missing cause prop on error loging.
+- Fix empty font-family handling on custom fonts page.
+- Fix incorrect unicode code points handling on draft-to-penpot conversion.
+- Fix some problems with paths.
+- Fix unexpected exception on duplicate project.
+- Fix unexpected exception when user leaves typography name empty.
+- Improve error report on uploading invalid image to library.
+- Minor fix on previous commit.
+- Minor improvements on svg uploading on libraries.
+
+
+## 1.6.1-alpha
+
+### :bug: Bugs fixed
+
+- Add safety check on reg-objects change impl.
+- Fix custom fonts embbedding issue.
+- Fix dashboard ordering issue.
+- Fix problem when creating a component with empty data.
+- Fix problem with moving shapes into frames.
+- Fix problems with mov-objects.
+- Fix unexpected excetion related to rounding integers.
+- Fix wrong type usage on libraries changes.
+- Improve editor lifecycle management.
+- Make the navigation async by default.
+
+
+## 1.6.0-alpha
+
+### :sparkles: New features
+
+- Add improved workspace font selector [Taiga US #292](https://tree.taiga.io/project/penpot/us/292).
+- Add option to interactively scale text [Taiga #1527](https://tree.taiga.io/project/penpot/us/1527)
+- Add performance improvements on dashboard data loading.
+- Add performance improvements to indexes handling on workspace.
+- Add the ability to upload/use custom fonts (and automatically generate all needed webfonts) [Taiga US #292](https://tree.taiga.io/project/penpot/us/292).
+- Transform shapes to path on double click
+- Translate automatic names of new files and projects.
+- Use shift instead of ctrl/cmd to keep aspect ratio [Taiga 1697](https://tree.taiga.io/project/penpot/issue/1697).
+- New translations: Portuguese (Brazil) and Romanias. 
+
+
+### :bug: Bugs fixed
+
+- Remove interactions when the destination artboard is deleted [Taiga #1656](https://tree.taiga.io/project/penpot/issue/1656).
+- Fix problem with fonts that ends with numbers [#940](https://github.com/penpot/penpot/issues/940).
+- Fix problem with imported SVG on editing paths [#971](https://github.com/penpot/penpot/issues/971)
+- Fix problem with color picker positioning
+- Fix order on color palette [#961](https://github.com/penpot/penpot/issues/961)
+- Fix issue when group creation leaves an empty group [#1724](https://tree.taiga.io/project/penpot/issue/1724)
+- Fix problem with :multiple for colors and typographies [#1668](https://tree.taiga.io/project/penpot/issue/1668)
+- Fix problem with locked shapes when change parents [#974](https://github.com/penpot/penpot/issues/974)
+- Fix problem with new nodes in paths [#978](https://github.com/penpot/penpot/issues/978)
+
+### :arrow_up: Deps updates
+
+- Update exporter dependencies (puppeteer), that fixes some unexpected exceptions.
+- Update string manipulation library.
+
+
+### :boom: Breaking changes
+
+- The OIDC setting `PENPOT_OIDC_SCOPES` has changed the default semantics. Before this
+  configuration added scopes to the default set. Now it replaces it, so use with care, because
+  penpot requires at least `name` and `email` props found on the user info object.
 
 ### :heart: Community contributions by (Thank you!)
 
+- Translations: Portuguese (Brazil) and Romanias.
+
+
+## 1.5.4-alpha
+
+### :bug: Bugs fixed
+
+- Fix issues on group rendering.
+- Fix problem with text editing auto-height [Taiga #1683](https://tree.taiga.io/project/penpot/issue/1683)
+
+
+## 1.5.3-alpha
+
+### :bug: Bugs fixed
+
+- 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
 
@@ -29,7 +393,7 @@
 
 - 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 (problem with Firefox rendering)
+- 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.
@@ -37,8 +401,8 @@
 - 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 problem width handoff code generation [Taiga #1204](https://tree.taiga.io/project/penpot/issue/1204)
-- Fix problem with indices refreshing on page changes [#646](https://github.com/penpot/penpot/issues/646)
+- 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.
@@ -71,16 +435,16 @@
 
 - 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)

README.md

@@ -2,36 +2,60 @@
 [uri_license]: https://www.mozilla.org/en-US/MPL/2.0
 [uri_license_image]: https://img.shields.io/badge/MPL-2.0-blue.svg
 
-[![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")
+<h1 align="center">
+  <br>
+  <img src="https://penpot.app/images/readme/readme-logo.jpg" alt="PENPOT">
+</h1>
+
+<p align="center"><a href="https://www.mozilla.org/en-US/MPL/2.0" rel="nofollow"><img src="https://camo.githubusercontent.com/3fcf3d6b678ea15fde3cf7d6af0e242160366282d62a7c182d83a50bfee3f45e/68747470733a2f2f696d672e736869656c64732e696f2f62616467652f4d504c2d322e302d626c75652e737667" alt="License: MPL-2.0" data-canonical-src="https://img.shields.io/badge/MPL-2.0-blue.svg" style="max-width:100%;"></a>
+<a href="https://gitter.im/penpot/community" rel="nofollow"><img src="https://camo.githubusercontent.com/5b0aecb33434f82a7b158eab7247544235ada0cf7eeb9ce8e52562dd67f614b7/68747470733a2f2f6261646765732e6769747465722e696d2f736572656e6f2d78797a2f636f6d6d756e6974792e737667" alt="Gitter" data-canonical-src="https://badges.gitter.im/sereno-xyz/community.svg" style="max-width:100%;"></a>
+<a href="https://tree.taiga.io/project/penpot/" title="Managed with Taiga.io" rel="nofollow"><img src="https://camo.githubusercontent.com/4a1d1112f0272e3393b1e8da312ff4435418e9e2eb4c0964881e3680f90a653c/68747470733a2f2f696d672e736869656c64732e696f2f62616467652f6d616e61676564253230776974682d54414947412e696f2d3730396631342e737667" alt="Managed with Taiga.io" data-canonical-src="https://img.shields.io/badge/managed%20with-TAIGA.io-709f14.svg" style="max-width:100%;"></a>
+<a href="https://gitpod.io/#https://github.com/penpot/penpot" rel="nofollow"><img src="https://camo.githubusercontent.com/daadb4894128d1e19b72d80236f5959f1f2b47f9fe081373f3246131f0189f6c/68747470733a2f2f696d672e736869656c64732e696f2f62616467652f476974706f642d72656164792d2d746f2d2d636f64652d626c75653f6c6f676f3d676974706f64" alt="Gitpod ready-to-code" data-canonical-src="https://img.shields.io/badge/Gitpod-ready--to--code-blue?logo=gitpod" style="max-width:100%;"></a></p>
+
+![PENPOT](https://penpot.app/images/readme/home-ui.jpg)
 
 
-# PENPOT #
+## What is 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)
+- [How to use](#how-to-use)
+- [Help center](#help-center)
+- [Contributing](#contributing)
+- [Give feedback](#give-feedback)
+- [Tutorials](#tutorials)
+- [License](#license)
 
+## How to use ##
 
-## Introduction ##
+Login or Register on our Penpot cloud app. Create a team to work together on projects and share design assets or jump right away into Penpot and **start designing** by your own.
 
-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!
+✏️ [Start using Penpot](https://design.penpot.app)
 
+You can also install Penpot in a local environment. This section details everything you need to know to get Penpot up and running in production environments. Although it can be installed in many ways, the recommended approach is using **docker** and **docker-compose**.
 
-## SVG based ##
+🐳 [Install docker](https://help.penpot.app/technical-guide/getting-started/)
 
-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.
+## Help center ##
 
-[See SVG specification](https://www.w3.org/Graphics/SVG/)
+In this documentation you will find (almost) everything you need to know about how to work with Penpot. From the interface basics to advanced functionality.
+
+📖 [User guide](https://help.penpot.app/user-guide/)
+
+❓ [FAQs](https://help.penpot.app/faqs/)
+
+🖥️ [Technical guide](https://help.penpot.app/technical-guide/)
+
+❤️ [Contributing guide](https://help.penpot.app/contributing-guide/)
+
+![User guide](https://penpot.app/images/readme/help-center.jpg)
 
 ## Contributing ##
 
+<p align="center">
+  <img src="https://penpot.app/images/open-source.png" alt="Open Source">
+</p>
+
 **Open to you!**
 
 We love the open source software community. Contributing is our
@@ -40,11 +64,24 @@ and improve Penpot. All your awesome ideas and code are welcome!
 
 Please refer to the [Contributing Guide](./CONTRIBUTING.md)
 
+## Give feedback ##
 
-## Documentation ##
+You can ask and answer questions, have open-ended conversations, and follow along on decisions affecting the project.
 
-Please refer to [docs/ directory](./docs/).
+✉️ [Mail us](mailto:info@penpot.app)
 
+💬 [Github discussions](https://github.com/penpot/penpot/discussions)
+
+🐞 [Github issues](mailto:info@penpot.apphttps://github.com/penpot/penpot/issues)
+
+✍️️ [Gitter](https://gitter.im/penpot/community)
+
+## Tutorials ##
+
+You can ask and answer questions, have open-ended conversations, and follow along on decisions affecting the project.
+Would you like to know more about Penpot? We recommend you to visit our youtube channel and learn more about the functionalities and possibilities of Penpot with our video tutorials.
+
+🎞️ [Youtube channel](https://www.youtube.com/channel/UCAqS8G72uv9P5HG1IfgnQ9g)
 
 ## License ##
 
@@ -52,4 +89,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

@@ -1,29 +1,22 @@
-{:mvn/repos
- {"central" {:url "https://repo1.maven.org/maven2/"}
-  "clojars" {:url "https://clojars.org/repo"}
-  "jcenter" {:url "https://jcenter.bintray.com/"}}
+{
+ ;; :mvn/repos
+ ;; {"central" {:url "https://repo1.maven.org/maven2/"}
+ ;;  "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/core.async {:mvn/version "1.3.610"}
-  org.clojure/tools.cli {:mvn/version "1.0.194"}
+ {penpot/common
+  {:local/root "../common"}
 
   ;; 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.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"
@@ -31,72 +24,59 @@
                                                  org.eclipse.jetty/jetty-servlet]}
   io.prometheus/simpleclient_httpserver {:mvn/version "0.9.0"}
 
-  selmer/selmer {:mvn/version "1.12.33"}
-  expound/expound {:mvn/version "0.8.7"}
-  com.cognitect/transit-clj {:mvn/version "1.0.324"}
+  io.lettuce/lettuce-core {:mvn/version "6.1.2.RELEASE"}
+  java-http-clj/java-http-clj {:mvn/version "0.4.2"}
 
-  io.lettuce/lettuce-core {:mvn/version "6.0.2.RELEASE"}
-  java-http-clj/java-http-clj {:mvn/version "0.4.1"}
+  info.sunng/ring-jetty9-adapter {:mvn/version "0.15.1"}
+  com.github.seancorfield/next.jdbc {:mvn/version "1.2.659"}
+  metosin/reitit-ring {:mvn/version "0.5.13"}
+  org.postgresql/postgresql {:mvn/version "42.2.20"}
+  com.zaxxer/HikariCP {:mvn/version "4.0.3"}
 
-  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"}
-  metosin/jsonista {:mvn/version "0.3.1"}
+  funcool/datoteka {:mvn/version "2.0.0"}
 
-  org.postgresql/postgresql {:mvn/version "42.2.18"}
-  com.zaxxer/HikariCP {:mvn/version "3.4.5"}
+  buddy/buddy-core {:mvn/version "1.10.1"}
+  buddy/buddy-hashers {:mvn/version "1.8.1"}
+  buddy/buddy-sign {:mvn/version "3.4.1"}
 
-  funcool/datoteka {:mvn/version "1.2.0"}
-  funcool/promesa {:mvn/version "6.0.0"}
-  funcool/cuerdas {:mvn/version "2020.03.26-3"}
-
-  buddy/buddy-core {:mvn/version "1.9.0"}
-  buddy/buddy-hashers {:mvn/version "1.7.0"}
-  buddy/buddy-sign {:mvn/version "3.3.0"}
-
-  lambdaisland/uri {:mvn/version "1.4.54"
-                    :exclusions [org.clojure/data.json]}
-
-  frankiesardo/linked {:mvn/version "1.3.0"}
-  danlentz/clj-uuid {:mvn/version "0.1.9"}
   org.jsoup/jsoup {:mvn/version "1.13.1"}
   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"}
 
-  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.62"}}
 
-  ;; exception printing
-  io.aviso/pretty {:mvn/version "0.1.37"}
-  environ/environ {:mvn/version "1.2.0"}}
- :paths ["src" "resources" "../common" "common"]
+ :paths ["src" "resources"]
  :aliases
  {:dev
   {:extra-deps
-   {com.bhauman/rebel-readline {:mvn/version "0.1.4"}
-    org.clojure/tools.namespace {:mvn/version "1.1.0"}
-    org.clojure/test.check {:mvn/version "1.1.0"}
+   {com.bhauman/rebel-readline {:mvn/version "RELEASE"}
+    org.clojure/tools.namespace {:mvn/version "RELEASE"}
+    org.clojure/test.check {:mvn/version "RELEASE"}
+    com.clojure-goes-fast/clj-async-profiler {:mvn/version "0.5.0"}
 
-    fipp/fipp {:mvn/version "0.6.23"}
-    criterium/criterium {:mvn/version "0.4.6"}
-    mockery/mockery {:mvn/version "0.1.4"}}
-   :extra-paths ["tests" "dev"]}
+    criterium/criterium {:mvn/version "RELEASE"}
+    mockery/mockery {:mvn/version "RELEASE"}}
+   :extra-paths ["test" "dev"]}
 
   :fn-fixtures
   {:exec-fn app.cli.fixtures/run
    :args {}}
 
-  :tests
-  {:extra-deps {lambdaisland/kaocha {:mvn/version "1.0.732"}}
+  :kaocha
+  {:extra-deps {lambdaisland/kaocha {:mvn/version "1.0.829"}}
    :main-opts ["-m" "kaocha.runner"]}
 
+  :test
+  {:extra-deps {io.github.cognitect-labs/test-runner
+                {:git/url "https://github.com/cognitect-labs/test-runner.git"
+                 :sha "705ad25bbf0228b1c38d0244a36001c2987d7337"}}
+   :exec-fn cognitect.test-runner.api/test}
+
   :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,21 +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) 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.util.json :as json]
    [clojure.java.io :as io]
-   [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]
@@ -25,8 +23,7 @@
    [clojure.tools.namespace.repl :as repl]
    [clojure.walk :refer [macroexpand-all]]
    [criterium.core :refer [quick-bench bench with-progress-reporting]]
-   [integrant.core :as ig]
-   [taoensso.nippy :as nippy]))
+   [integrant.core :as ig]))
 
 (repl/disable-reload! (find-ns 'integrant.core))
 
@@ -53,7 +50,7 @@
 ;; --- Development Stuff
 
 (defn- run-tests
-  ([] (run-tests #"^app.tests.*"))
+  ([] (run-tests #"^app.*-test$"))
   ([o]
    (repl/refresh)
    (cond
@@ -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/invite-to-team/en.subj

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

backend/resources/log4j2-bundle.xml

@@ -1,21 +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" />
-    <Logger name="org.eclipse.jetty" level="error" />
-
-    <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,54 @@
+<?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>
+
+    <JeroMQ name="zmq">
+      <Property name="endpoint">tcp://localhost:45556</Property>
+      <JsonLayout complete="false" compact="true" includeTimeMillis="true" stacktraceAsString="true" properties="true" />
+    </JeroMQ>
+  </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" />
+      <AppenderRef ref="zmq" level="debug" />
+    </Logger>
+
+    <Logger name="penpot" level="debug" additivity="false">
+      <AppenderRef ref="main" level="debug" />
+      <AppenderRef ref="zmq" level="debug" />
+    </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,49 +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>
-
-    <JeroMQ name="zmq">
-      <Property name="endpoint">tcp://localhost:45556</Property>
-      <JsonLayout complete="false" compact="true" includeTimeMillis="true" stacktraceAsString="true" properties="true" />
-    </JeroMQ>
   </Appenders>
 
   <Loggers>
-    <Logger name="com.zaxxer.hikari" level="error"/>
-    <Logger name="io.lettuce" level="error" />
+    <Logger name="com.zaxxer.hikari" level="error" />
     <Logger name="org.eclipse.jetty" 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="debug" additivity="false">
-      <AppenderRef ref="main" level="trace" />
-      <AppenderRef ref="zmq" level="debug" />
+      <AppenderRef ref="console" />
     </Logger>
 
-    <Logger name="user" level="trace" additivity="false">
-      <AppenderRef ref="main" level="trace" />
-      <AppenderRef ref="zmq" level="debug" />
+    <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,79 @@
+#!/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,77 +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"
-
-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
-
-tee -a ./target/dist/manage.sh  >> /dev/null <<EOF
-#!/usr/bin/env bash
-CP="$NEWCP"
-
-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 \$CP -Dlog4j.configurationFile=./log4j2.xml clojure.main -m app.cli.manage "\$@"
-EOF
-
-chmod +x ./target/dist/run.sh
-chmod +x ./target/dist/manage.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,7 +2,10 @@
 
 export PENPOT_ASSERTS_ENABLED=true
 
-export OPTIONS="-A:jmx-remote:dev -J-Dclojure.tools.logging.factory=clojure.tools.logging.impl/log4j2-factory -J-Xms512m -J-Xmx512m"
+export OPTIONS="-A:jmx-remote:dev -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager -J-Dlog4j2.configurationFile=log4j2-devenv.xml -J-Djdk.attach.allowAttachSelf -J-XX:+UseZGC -J-XX:ConcGCThreads=1 -J-XX:-OmitStackTraceInFastThrow -J-Xms50m -J-Xmx512m";
+# export OPTIONS="$OPTIONS -J-XX:+UnlockDiagnosticVMOptions";
+# export OPTIONS="$OPTIONS -J-XX:-TieredCompilation -J-XX:CompileThreshold=10000";
+
 export OPTIONS_EVAL="nil"
 # export OPTIONS_EVAL="(set! *warn-on-reflection* true)"
 

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,7 +71,9 @@
   (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
@@ -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

@@ -2,22 +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) 2021 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.cli.manage
   "A manage cli api."
   (:require
-   [app.config :as cfg]
    [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]]
-   [clojure.tools.logging :as log]
    [integrant.core :as ig])
   (:import
    java.io.Console))
@@ -26,7 +22,7 @@
 
 (defn init-system
   []
-  (let [data (-> (main/build-system-config cfg/config)
+  (let [data (-> main/system-config
                  (select-keys [:app.db/pool :app.metrics/metrics])
                  (assoc :app.migrations/all {}))]
     (-> data ig/prep ig/init)))
@@ -35,7 +31,7 @@
   [{:keys [label type] :or {type :text}}]
   (let [^Console console (System/console)]
     (when-not console
-      (log/error "no console found, can proceed")
+      (l/error :hint "no console found, can proceed")
       (System/exit 1))
 
     (binding [*out* (.writer console)]

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,48 +2,64 @@
 ;; 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.config
   "A configuration management."
   (:refer-clojure :exclude [get])
   (:require
+   [app.common.data :as d]
+   [app.common.exceptions :as ex]
    [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]]))
+   [environ.core :refer [env]]
+   [integrant.core :as ig]))
+
+(prefer-method print-method
+               clojure.lang.IRecord
+               clojure.lang.IDeref)
+
+(prefer-method pprint/simple-dispatch
+               clojure.lang.IPersistentMap
+               clojure.lang.IDeref)
+
+(defmethod ig/init-key :default
+  [_ data]
+  (d/without-nils data))
+
+(defmethod ig/prep-key :default
+  [_ data]
+  (if (map? data)
+    (d/without-nils data)
+    data))
 
 (def defaults
   {:http-server-port 6060
    :host "devenv"
    :tenant "dev"
-   :database-uri "postgresql://127.0.0.1/penpot"
+   :database-uri "postgresql://postgres/penpot"
    :database-username "penpot"
    :database-password "penpot"
 
-   :default-blob-version 1
-
+   :default-blob-version 3
    :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-s3-region :eu-central-1
-   :storage-s3-bucket "penpot-devenv-assets-pre"
+   :assets-storage-backend :assets-fs
+   :storage-assets-fs-directory "assets"
 
    :feedback-destination "info@example.com"
    :feedback-enabled false
@@ -65,12 +81,11 @@
 
    :allow-demo-users true
    :registration-enabled true
-   :registration-domain-whitelist ""
 
    :telemetry-enabled false
    :telemetry-uri "https://telemetry.penpot.app/"
 
-   :ldap-user-query "(|(uid=$username)(mail=$username))"
+   :ldap-user-query "(|(uid=:username)(mail=:username))"
    :ldap-attrs-username "uid"
    :ldap-attrs-email "mail"
    :ldap-attrs-fullname "cn"
@@ -80,6 +95,13 @@
    :initial-project-skey "initial-project"
    })
 
+(s/def ::audit-enabled ::us/boolean)
+(s/def ::audit-archive-enabled ::us/boolean)
+(s/def ::audit-archive-uri ::us/string)
+(s/def ::audit-archive-gc-enabled ::us/boolean)
+(s/def ::audit-archive-gc-max-age ::dt/duration)
+
+(s/def ::secret-key ::us/string)
 (s/def ::allow-demo-users ::us/boolean)
 (s/def ::asserts-enabled ::us/boolean)
 (s/def ::assets-path ::us/string)
@@ -90,7 +112,6 @@
 (s/def ::error-report-webhook ::us/string)
 (s/def ::feedback-destination ::us/string)
 (s/def ::feedback-enabled ::us/boolean)
-(s/def ::feedback-reply-to ::us/email)
 (s/def ::feedback-token ::us/string)
 (s/def ::github-client-id ::us/string)
 (s/def ::github-client-secret ::us/string)
@@ -99,9 +120,17 @@
 (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-cookie-name ::us/string)
 (s/def ::http-session-idle-max-age ::dt/duration)
 (s/def ::http-session-updater-batch-max-age ::dt/duration)
 (s/def ::http-session-updater-batch-max-size ::us/integer)
@@ -128,7 +157,7 @@
 (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-domain-whitelist ::us/set-of-str)
 (s/def ::registration-enabled ::us/boolean)
 (s/def ::rlimits-image ::us/integer)
 (s/def ::rlimits-password ::us/integer)
@@ -143,19 +172,27 @@
 (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 ::assets-storage-backend ::us/keyword)
+(s/def ::fdata-storage-backend ::us/keyword)
+(s/def ::storage-assets-fs-directory ::us/string)
+(s/def ::storage-assets-s3-bucket ::us/string)
+(s/def ::storage-assets-s3-region ::us/keyword)
+(s/def ::storage-fdata-s3-bucket ::us/string)
+(s/def ::storage-fdata-s3-region ::us/keyword)
+(s/def ::storage-fdata-s3-prefix ::us/string)
 (s/def ::telemetry-enabled ::us/boolean)
-(s/def ::telemetry-server-enabled ::us/boolean)
-(s/def ::telemetry-server-port ::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
+  (s/keys :opt-un [::secret-key
+                   ::allow-demo-users
+                   ::audit-enabled
+                   ::audit-archive-enabled
+                   ::audit-archive-uri
+                   ::audit-archive-gc-enabled
+                   ::audit-archive-gc-max-age
                    ::asserts-enabled
                    ::database-password
                    ::database-uri
@@ -164,7 +201,6 @@
                    ::error-report-webhook
                    ::feedback-destination
                    ::feedback-enabled
-                   ::feedback-reply-to
                    ::feedback-token
                    ::github-client-id
                    ::github-client-secret
@@ -173,6 +209,15 @@
                    ::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
                    ::http-session-idle-max-age
@@ -213,49 +258,57 @@
                    ::smtp-ssl
                    ::smtp-tls
                    ::smtp-username
+
                    ::srepl-host
                    ::srepl-port
-                   ::storage-backend
-                   ::storage-fs-directory
-                   ::storage-s3-bucket
-                   ::storage-s3-region
+
+                   ::assets-storage-backend
+                   ::storage-assets-fs-directory
+                   ::storage-assets-s3-bucket
+                   ::storage-assets-s3-region
+
+                   ::fdata-storage-backend
+                   ::storage-fdata-s3-bucket
+                   ::storage-fdata-s3-region
+                   ::storage-fdata-s3-prefix
+
                    ::telemetry-enabled
-                   ::telemetry-server-enabled
-                   ::telemetry-server-port
                    ::telemetry-uri
+                   ::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)
-       (merge defaults)
-       (us/conform ::config)))
+  []
+  (try
+    (->> (read-env "penpot")
+         (merge defaults)
+         (us/conform ::config))
+    (catch Throwable e
+      (when (ex/ex-info? e)
+        (println ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")
+        (println "Error on validating configuration:")
+        (println (:explain (ex-data e))
+        (println ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")))
+      (throw e))))
 
-(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}))
@@ -263,6 +316,9 @@
 (defn get
   "A configuration getter. Helps code be more testable."
   ([key]
-   (c/get config key))
+   (c/get @config key))
   ([key default]
-   (c/get config 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,25 +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) 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.common.transit :as t]
+   [app.common.uuid :as uuid]
    [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]
    [clojure.java.io :as io]
    [clojure.spec.alpha :as s]
-   [clojure.tools.logging :as log]
    [integrant.core :as ig]
    [next.jdbc :as jdbc]
    [next.jdbc.date-time :as jdbc-dt])
@@ -48,8 +47,8 @@
 
 (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?)
@@ -59,14 +58,16 @@
 
 (defmethod ig/init-key ::pool
   [_ {:keys [migrations metrics] :as cfg}]
-  (log/infof "initialize connection pool '%s' with uri '%s'" (:name cfg) (:uri 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 ^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
@@ -80,7 +81,7 @@
     #'next.jdbc/execute!]
    {:registry registry
     :type :counter
-    :name "database_query_count"
+    :name "database_query_total"
     :help "An absolute counter of database queries."}))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -100,7 +101,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
@@ -200,6 +201,13 @@
               (sql/insert table params opts)
               (assoc opts :return-keys true))))
 
+(defn insert-multi!
+  ([ds table cols rows] (insert-multi! ds table cols rows nil))
+  ([ds table cols rows opts]
+   (exec! ds
+          (sql/insert-multi table cols rows opts)
+          (assoc opts :return-keys true))))
+
 (defn update!
   ([ds table params where] (update! ds table params where nil))
   ([ds table params where opts]
@@ -214,13 +222,20 @@
               (sql/delete table params opts)
               (assoc opts :return-keys true))))
 
+(defn- is-deleted?
+  [{:keys [deleted-at]}]
+  (and (dt/instant? deleted-at)
+       (< (inst-ms deleted-at)
+          (inst-ms (dt/now)))))
+
 (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 (not res) (is-deleted? res)))
        (ex/raise :type :not-found
+                 :table table
                  :hint "database object not found"))
      res)))
 
@@ -237,8 +252,11 @@
    (exec! ds (sql/select table params opts))))
 
 (defn pgobject?
-  [v]
-  (instance? PGobject v))
+  ([v]
+   (instance? PGobject v))
+  ([v type]
+   (and (instance? PGobject v)
+        (= type (.getType ^PGobject v)))))
 
 (defn pginterval?
   [v]
@@ -261,9 +279,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]
@@ -322,12 +343,24 @@
       (t/decode-str val)
       val)))
 
+(defn inet
+  [ip-addr]
+  (doto (org.postgresql.util.PGobject.)
+    (.setType "inet")
+    (.setValue (str ip-addr))))
+
+(defn decode-inet
+  [^PGobject o]
+  (if (= "inet" (.getType o))
+    (.getValue o)
+    nil))
+
 (defn tjson
   "Encode as transit json."
   [data]
   (doto (org.postgresql.util.PGobject.)
     (.setType "jsonb")
-    (.setValue (t/encode-verbose-str data))))
+    (.setValue (t/encode-str data {:type :json-verbose}))))
 
 (defn json
   "Encode as plain json."
@@ -343,3 +376,25 @@
 (defn pgarray->vector
   [v]
   (vec (.getArray ^PgArray v)))
+
+
+;; --- Locks
+
+(defn- xact-check-param
+  [n]
+  (cond
+    (uuid? n) (uuid/get-word-high n)
+    (int? n)  n
+    :else (throw (IllegalArgumentException. "uuid or number allowed"))))
+
+(defn xact-lock!
+  [conn n]
+  (let [n (xact-check-param n)]
+    (exec-one! conn ["select pg_advisory_xact_lock(?::bigint) as lock" n])
+    true))
+
+(defn xact-try-lock!
+  [conn n]
+  (let [n   (xact-check-param n)
+        row (exec-one! conn ["select pg_try_advisory_xact_lock(?::bigint) as lock" n])]
+    (:lock row)))

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])
@@ -35,14 +32,19 @@
                 (assoc :suffix "ON CONFLICT DO NOTHING"))]
      (sql/for-insert table key-map opts))))
 
+(defn insert-multi
+  [table cols rows opts]
+  (let [opts (merge default-opts opts)]
+    (sql/for-insert-multi table cols rows opts)))
+
 (defn select
   ([table where-params]
    (select table where-params nil))
   ([table where-params opts]
    (let [opts (merge default-opts opts)
          opts (cond-> opts
-                (:for-update opts)
-                (assoc :suffix "FOR UPDATE"))]
+                (:for-update opts)    (assoc :suffix "FOR UPDATE")
+                (:for-key-share opts) (assoc :suffix "FOR KEY SHARE"))]
      (sql/for-query table where-params opts))))
 
 (defn update
@@ -58,4 +60,3 @@
   ([table where-params opts]
    (let [opts (merge default-opts opts)]
      (sql/for-delete table where-params opts))))
-

backend/src/app/emails.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.emails
   "Main api for send emails."
@@ -14,18 +11,13 @@
    [app.config :as cfg]
    [app.db :as db]
    [app.db.sql :as sql]
-   [app.tasks :as tasks]
    [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]
@@ -33,17 +25,20 @@
 
 (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))))
 
 
+;; --- BOUNCE/COMPLAINS HANDLING
+
 (def sql:profile-complaint-report
   "select (select count(*)
              from profile_complaint_report
@@ -91,7 +86,7 @@
      (>= (count reports) threshold))))
 
 
-;; --- Emails
+;; --- EMAIL FACTORIES
 
 (s/def ::subject ::us/string)
 (s/def ::content ::us/string)
@@ -101,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
@@ -109,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
@@ -117,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
@@ -125,17 +120,63 @@
 
 (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)
 (s/def :internal.emails.invite-to-team/token ::us/string)
 
 (s/def ::invite-to-team
-  (s/keys :keys [:internal.emails.invite-to-team/invited-by
-                 :internal.emails.invite-to-team/token
-                 :internal.emails.invite-to-team/team]))
+  (s/keys :req-un [:internal.emails.invite-to-team/invited-by
+                   :internal.emails.invite-to-team/token
+                   :internal.emails.invite-to-team/team]))
 
 (def invite-to-team
   "Teams member invitation email."
-  (emails/template-factory ::invite-to-team 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,22 +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.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])
@@ -26,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)))))
@@ -63,61 +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 ::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 ::metrics ::oauth ::storage ::assets ::feedback]))
-
-(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 oauth metrics svgparse assets feedback] :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)}]]
@@ -128,7 +136,10 @@
     ["/webhooks"
      ["/sns" {:post (:sns-webhook cfg)}]]
 
-    ["/api" {:middleware [[middleware/format-response-body]
+    ["/api" {:middleware [
+                          ;; Temporary disabled
+                          #_[middleware/etag]
+                          [middleware/format-response-body]
                           [middleware/params]
                           [middleware/multipart-params]
                           [middleware/keyword-params]
@@ -136,20 +147,13 @@
                           [middleware/errors errors/handle]
                           [middleware/cookies]]}
 
-     ["/svg" {:post svgparse}]
      ["/feedback" {:middleware [(:middleware session)]
                    :post feedback}]
 
-     ["/oauth"
-      ["/google" {:post (get-in oauth [:google :handler])}]
-      ["/google/callback" {:get (get-in oauth [:google :callback-handler])}]
-
-      ["/gitlab" {:post (get-in oauth [:gitlab :handler])}]
-      ["/gitlab/callback" {:get (get-in oauth [:gitlab :callback-handler])}]
-
-      ["/github" {:post (get-in oauth [:github :handler])}]
-      ["/github/callback" {:get (get-in oauth [:github :callback-handler])}]]
+     ["/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}))
@@ -52,7 +49,7 @@
       {:status 200
        :headers {"content-type" (:content-type mdata)
                  "cache-control" (str "max-age=" (inst-ms cache-max-age))}
-       :body (sto/get-object-data storage obj)}
+       :body (sto/get-object-bytes storage obj)}
 
       :s3
       (let [url (sto/get-object-url storage obj {:max-age signature-max-age})]

backend/src/app/http/awsns.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 Andrey Antukh <niwi@niwi.nz>
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.http.awsns
   "AWS SNS webhook handler for bounces."
@@ -14,9 +11,8 @@
    [app.db :as db]
    [app.db.sql :as sql]
    [app.util.http :as http]
-   [clojure.pprint :refer [pprint]]
+   [app.util.logging :as l]
    [clojure.spec.alpha :as s]
-   [clojure.tools.logging :as log]
    [cuerdas.core :as str]
    [integrant.core :as ig]
    [jsonista.core :as j]))
@@ -25,11 +21,6 @@
 (declare parse-notification)
 (declare process-report)
 
-(defn- pprint-report
-  [message]
-  (binding [clojure.pprint/*print-right-margin* 120]
-    (with-out-str (pprint message))))
-
 (defmethod ig/pre-init-spec ::handler [_]
   (s/keys :req-un [::db/pool]))
 
@@ -42,19 +33,17 @@
         (= mtype "SubscriptionConfirmation")
         (let [surl   (get body "SubscribeURL")
               stopic (get body "TopicArn")]
-          (log/infof "subscription received (topic=%s, url=%s)" stopic surl)
+          (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"))]
-          ;; (log/infof "Received: %s" (pr-str message))
           (let [notification (parse-notification cfg message)]
             (process-report cfg notification)))
 
         :else
-        (log/warn (str "unexpected data received\n"
-                       (pprint-report body))))
-
+        (l/warn :hint "unexpected data received"
+                :report (pr-str body)))
       {:status 200 :body ""})))
 
 (defn- parse-bounce
@@ -184,15 +173,15 @@
 
 (defn- process-report
   [cfg {:keys [type profile-id] :as report}]
-  (log/trace (str "procesing report:\n" (pprint-report 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)
-    (log/warn (str "a notification without identity recevied from AWS\n"
-                   (pprint-report report)))
+    (l/warn :msg "a notification without identity recevied from AWS"
+            :report (pr-str report))
 
     (= "bounce" type)
     (register-bounce-for-profile cfg report)
@@ -201,7 +190,7 @@
     (register-complaint-for-profile cfg report)
 
     :else
-    (log/warn (str "unrecognized report received from AWS\n"
-                   (pprint-report report)))))
+    (l/warn :msg "unrecognized report received from AWS"
+            :report (pr-str report))))
 
 

backend/src/app/http/errors.clj

@@ -2,17 +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.util.log4j :refer [update-thread-context!]]
-   [clojure.tools.logging :as log]
+   [app.util.logging :as l]
    [cuerdas.core :as str]
    [expound.alpha :as expound]))
 
@@ -72,10 +69,14 @@
   [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
+            :code :assertion
             :data (-> edata
                       (assoc :explain (explain-error edata))
                       (dissoc :data))}}))
@@ -86,15 +87,58 @@
 
 (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
+                :code :unexpected
+                :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
+             :cause error)
+
+    (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-error
+              :code :psql-exception
+              :hint (ex-message error)
+              :state state}})))
 
 (defn handle
   [error req]

backend/src/app/http/feedback.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) 2021 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.http.feedback
   "A general purpose feedback module."
@@ -15,7 +12,7 @@
    [app.common.spec :as us]
    [app.config :as cfg]
    [app.db :as db]
-   [app.emails :as emails]
+   [app.emails :as eml]
    [app.rpc.queries.profile :as profile]
    [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
@@ -61,13 +58,13 @@
 (defn send-feedback
   [pool profile params]
   (let [params      (us/conform ::feedback params)
-        destination (cfg/get :feedback-destination)
-        reply-to    (cfg/get :feedback-reply-to)]
-    (emails/send! pool emails/feedback
-                  {:to       destination
-                   :profile  profile
-                   :reply-to (:from params)
-                   :email    (:from params)
-                   :subject  (:subject params)
-                   :content  (:content 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,17 +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.middleware
   (:require
+   [app.common.transit :as t]
    [app.metrics :as mtx]
    [app.util.json :as json]
-   [app.util.transit :as t]
+   [app.util.logging :as l]
+   [buddy.core.codecs :as bc]
+   [buddy.core.hash :as bh]
    [clojure.java.io :as io]
+   [ring.core.protocols :as rp]
    [ring.middleware.cookies :refer [wrap-cookies]]
    [ring.middleware.keyword-params :refer [wrap-keyword-params]]
    [ring.middleware.multipart-params :refer [wrap-multipart-params]]
@@ -73,17 +74,33 @@
   {:name ::parse-request-body
    :compile (constantly wrap-parse-request-body)})
 
+(defn- transit-streamable-body
+  [data opts]
+  (reify rp/StreamableResponseBody
+    (write-body-to-stream [_ response output-stream]
+      (try
+        (let [tw (t/writer output-stream opts)]
+          (t/write! tw data))
+        (finally
+          (.close ^java.io.OutputStream output-stream))))))
+
 (defn- impl-format-response-body
-  [response]
+  [response _request]
   (let [body (:body response)
-        type :json-verbose]
+        opts {:type :json-verbose}]
     (cond
       (coll? body)
       (-> response
-          (assoc :body (t/encode body {:type type}))
-          (update :headers assoc
-                  "content-type"
-                  "application/transit+json"))
+          (update :headers assoc "content-type" "application/transit+json")
+          (assoc :body (transit-streamable-body body opts)))
+
+      ;; ;; Temporary disabled
+      ;; (-> response
+      ;;     (update :headers assoc "content-type" "application/transit+json")
+      ;;     (assoc :body
+      ;;            (if (= :post (:request-method request))
+      ;;              (transit-streamable-body body opts)
+      ;;              (t/encode body opts))))
 
       (nil? body)
       (assoc response :status 204 :body "")
@@ -96,7 +113,7 @@
   (fn [request]
     (let [response (handler request)]
       (cond-> response
-        (map? response) (impl-format-response-body)))))
+        (map? response) (impl-format-response-body request)))))
 
 (def format-response-body
   {:name ::format-response-body
@@ -119,8 +136,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 +155,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,371 @@
+;; 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.data :as d]
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.common.uri :as u]
+   [app.config :as cf]
+   [app.db :as db]
+   [app.loggers.audit :as audit]
+   [app.rpc.queries.profile :as profile]
+   [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- 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 [info (json/read-str (:body res) :key-fn keyword)]
+          {:backend (:name provider)
+           :email (:email info)
+           :fullname (:name info)
+           :props (dissoc info :name :email)})))
+
+    (catch Exception e
+      (l/error :hint "unexpected exception on retrieve-user-info"
+               :cause e)
+      nil)))
+
+(s/def ::backend ::us/not-empty-string)
+(s/def ::email ::us/not-empty-string)
+(s/def ::fullname ::us/not-empty-string)
+(s/def ::props (s/map-of ::us/keyword any?))
+
+(s/def ::info
+  (s/keys :req-un [::backend
+                   ::email
+                   ::fullname
+                   ::props]))
+
+(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 (s/valid? ::info info)
+      (l/warn :hint "received incomplete profile info object (please set correct scopes)"
+              :info (pr-str info))
+      (ex/raise :type :internal
+                :code :unable-to-auth
+                :hint "no user info"))
+
+    ;; 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))
+
+      ;; If state token comes with props, merge them. The state token
+      ;; props can contain pm_ and utm_ prefixed query params.
+      (map? (:props state))
+      (update :props merge (:props state)))))
+
+;; --- HTTP HANDLERS
+
+(defn extract-props
+  [params]
+  (reduce-kv (fn [params k v]
+               (let [sk (name k)]
+                 (cond-> params
+                   (or (str/starts-with? sk "pm_")
+                       (str/starts-with? sk "pm-")
+                       (str/starts-with? sk "utm_"))
+                   (assoc (-> sk str/kebab keyword) v))))
+             {}
+             params))
+
+(defn- retrieve-profile
+  [{:keys [pool] :as cfg} info]
+  (with-open [conn (db/open pool)]
+    (some->> (:email info)
+             (profile/retrieve-profile-data-by-email conn)
+             (profile/populate-additional-data conn)
+             (profile/decode-profile-row))))
+
+(defn- redirect-response
+  [uri]
+  {:status 302
+   :headers {"location" (str uri)}
+   :body ""})
+
+(defn- generate-error-redirect
+  [cfg error]
+  (let [uri (-> (u/uri (:public-uri cfg))
+                (assoc :path "/#/auth/login")
+                (assoc :query (u/map->query-string {:error "unable-to-auth" :hint (ex-message error)})))]
+    (redirect-response uri)))
+
+(defn- generate-redirect
+  [{:keys [tokens session audit] :as cfg} request info profile]
+  (if profile
+    (let [sxf    ((:create session) (:id profile))
+          token  (or (:invitation-token info)
+                     (tokens :generate {:iss :auth
+                                        :exp (dt/in-future "15m")
+                                        :profile-id (:id profile)}))
+          params {:token token}
+
+          uri    (-> (u/uri (:public-uri cfg))
+                     (assoc :path "/#/auth/verify-token")
+                     (assoc :query (u/map->query-string params)))]
+
+      (when (fn? audit)
+        (audit :cmd :submit
+               :type "mutation"
+               :name "login"
+               :profile-id (:id profile)
+               :ip-addr (audit/parse-client-ip request)
+               :props (audit/profile->props profile)))
+
+      (->> (redirect-response uri)
+           (sxf request)))
+    (let [info   (assoc info
+                        :iss :prepared-register
+                        :exp (dt/in-future {:hours 48}))
+          token  (tokens :generate info)
+          params (d/without-nils
+                  {:token token
+                   :fullname (:fullname info)})
+          uri    (-> (u/uri (:public-uri cfg))
+                     (assoc :path "/#/auth/register/validate")
+                     (assoc :query (u/map->query-string params)))]
+      (redirect-response uri))))
+
+(defn- auth-handler
+  [{:keys [tokens] :as cfg} {:keys [params] :as request}]
+  (let [invitation (:invitation-token params)
+        props      (extract-props params)
+        state      (tokens :generate
+                           {:iss :oauth
+                            :invitation-token invitation
+                            :props props
+                            :exp (dt/in-future "15m")})
+        uri        (build-auth-uri cfg state)]
+    {:status 200
+     :body {:redirect-uri uri}}))
+
+(defn- callback-handler
+  [cfg request]
+  (try
+    (let [info     (retrieve-info cfg request)
+          profile  (retrieve-profile cfg info)]
+      (generate-redirect cfg request info profile))
+    (catch Exception e
+      (l/warn :hint "error on oauth process"
+              :cause e)
+      (generate-error-redirect cfg e))))
+
+;; --- 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 ::handler [_]
+  (s/keys :req-un [::public-uri ::session ::tokens ::rpc ::db/pool]))
+
+(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 ::handler
+  [_ 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- obfuscate-string
+  [s]
+  (if (< (count s) 10)
+    (apply str (take (count s) (repeat "*")))
+    (str (subs s 0 5)
+         (apply str (take (- (count s) 5) (repeat "*"))))))
+
+(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        (cf/get :oidc-scopes #{"openid" "profile" "email"})
+              :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 "oidc" :method "static"
+                  :opts (pr-str (update opts :client-secret obfuscate-string)))
+          (assoc-in cfg [:providers "oidc"] opts))
+        (let [opts (discover-oidc-config opts)]
+          (l/info :action "initialize" :provider "oidc" :method "discover"
+                  :opts (pr-str (update opts :client-secret obfuscate-string)))
+          (assoc-in cfg [:providers "oidc"] opts)))
+      cfg)))
+
+(defn- initialize-google-provider
+  [cfg]
+  (let [opts {:client-id     (cf/get :google-client-id)
+              :client-secret (cf/get :google-client-secret)
+              :scopes        #{"openid" "email" "profile"}
+              :auth-uri      "https://accounts.google.com/o/oauth2/v2/auth"
+              :token-uri     "https://oauth2.googleapis.com/token"
+              :user-uri      "https://openidconnect.googleapis.com/v1/userinfo"
+              :name          "google"}]
+    (if (and (string? (:client-id opts))
+             (string? (:client-secret opts)))
+      (do
+        (l/info :action "initialize" :provider "google"
+                :opts (pr-str (update opts :client-secret obfuscate-string)))
+        (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"
+                :opts (pr-str (update opts :client-secret obfuscate-string)))
+        (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"
+                :opts (pr-str (update opts :client-secret obfuscate-string)))
+        (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/oauth/github.clj

@@ -1,159 +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.oauth.github
-  (:require
-   [app.common.exceptions :as ex]
-   [app.common.spec :as us]
-   [app.config :as cfg]
-   [app.http.oauth.google :as gg]
-   [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]
-  (try
-    (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)
-                  :timeout 6000
-                  :body (u/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 (str user-info-url)
-               :headers {"authorization" (str "token " token)}
-               :timeout 6000
-               :method :get}
-          res (http/send! req)]
-      (when (= 200 (:status res))
-        (let [data (json/read-str (:body res))]
-          {:email (get data "email")
-           :backend "github"
-           :fullname (get data "name")})))
-    (catch Exception e
-      (log/error e "unexpected exception on get-user-info")
-      nil)))
-
-(defn- retrieve-info
-  [{:keys [tokens] :as cfg} request]
-  (let [token (get-in request [:params :state])
-        state (tokens :verify {:token token :iss :github-oauth})
-        info  (some->> (get-in request [:params :code])
-                       (get-access-token cfg state)
-                       (get-user-info cfg))]
-    (when-not info
-      (ex/raise :type :internal
-                :code :unable-to-auth))
-
-    (cond-> info
-      (some? (:invitation-token state))
-      (assoc :invitation-token (:invitation-token state)))))
-
-(defn auth-handler
-  [{:keys [tokens] :as cfg} request]
-  (let [invitation (get-in request [:params :invitation-token])
-        state      (tokens :generate {:iss :github-oauth
-                                      :invitation-token invitation
-                                      :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-handler
-  [{:keys [session] :as cfg} request]
-  (try
-    (let [info    (retrieve-info cfg request)
-          profile (gg/register-profile cfg info)
-          uri     (gg/generate-redirect-uri cfg profile)
-          sxf     ((:create session) (:id profile))]
-      (->> (gg/redirect-response uri)
-           (sxf request)))
-    (catch Exception _e
-      (-> (gg/generate-error-redirect-uri cfg)
-          (gg/redirect-response)))))
-
-
-;; --- 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.oauth/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.oauth/github
-  [_ cfg]
-  (if (and (:client-id cfg)
-           (:client-secret cfg))
-    {:handler #(auth-handler cfg %)
-     :callback-handler #(callback-handler cfg %)}
-    {:handler default-handler
-     :callback-handler default-handler}))
-

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

@@ -1,167 +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.oauth.gitlab
-  (:require
-   [app.common.data :as d]
-   [app.common.exceptions :as ex]
-   [app.common.spec :as us]
-   [app.http.oauth.google :as gg]
-   [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 scope "read_user")
-
-(defn- build-redirect-url
-  [cfg]
-  (let [public (u/uri (:public-uri cfg))]
-    (str (assoc public :path "/api/oauth/gitlab/callback"))))
-
-(defn- build-oauth-uri
-  [cfg]
-  (let [base-uri (u/uri (:base-uri cfg))]
-    (assoc base-uri :path "/oauth/authorize")))
-
-(defn- build-token-url
-  [cfg]
-  (let [base-uri (u/uri (:base-uri cfg))]
-    (str (assoc base-uri :path "/oauth/token"))))
-
-(defn- build-user-info-url
-  [cfg]
-  (let [base-uri (u/uri (:base-uri cfg))]
-    (str (assoc base-uri :path "/api/v4/user"))))
-
-(defn- get-access-token
-  [cfg code]
-  (try
-    (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 (u/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
-  [cfg token]
-  (try
-    (let [req {:uri (build-user-info-url cfg)
-               :headers {"Authorization" (str "Bearer " token)}
-               :timeout 6000
-               :method :get}
-          res (http/send! req)]
-
-      (when (= 200 (:status res))
-        (let [data (json/read-str (:body res))]
-          {:email (get data "email")
-           :backend "gitlab"
-           :fullname (get data "name")})))
-
-    (catch Exception e
-      (log/error e "unexpected exception on get-user-info")
-      nil)))
-
-
-(defn- retrieve-info
-  [{:keys [tokens] :as cfg} request]
-  (let [token (get-in request [:params :state])
-        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 :internal
-                :code :unable-to-auth))
-
-    (cond-> info
-      (some? (:invitation-token state))
-      (assoc :invitation-token (:invitation-token state)))))
-
-
-(defn- auth-handler
-  [{:keys [tokens] :as cfg} request]
-  (let [invitation (get-in request [:params :invitation-token])
-        state      (tokens :generate
-                           {:iss :gitlab-oauth
-                            :invitation-token invitation
-                            :exp (dt/in-future "15m")})
-
-        params     {:client_id (:client-id cfg)
-                    :redirect_uri (build-redirect-url cfg)
-                    :response_type "code"
-                    :state state
-                    :scope scope}
-        query      (u/map->query-string params)
-        uri        (-> (build-oauth-uri cfg)
-                       (assoc :query query))]
-    {:status 200
-     :body {:redirect-uri (str uri)}}))
-
-(defn- callback-handler
-  [{:keys [session] :as cfg} request]
-  (try
-    (let [info    (retrieve-info cfg request)
-          profile (gg/register-profile cfg info)
-          uri     (gg/generate-redirect-uri cfg profile)
-          sxf     ((:create session) (:id profile))]
-      (->> (gg/redirect-response uri)
-           (sxf request)))
-    (catch Exception _e
-      (-> (gg/generate-error-redirect-uri cfg)
-          (gg/redirect-response)))))
-
-(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.oauth/gitlab [_]
-  (s/keys :req-un [::public-uri
-                   ::session
-                   ::tokens]
-          :opt-un [::base-uri
-                   ::client-id
-                   ::client-secret]))
-
-(defmethod ig/prep-key :app.http.oauth/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.oauth/gitlab
-  [_ cfg]
-  (if (and (:client-id cfg)
-           (:client-secret cfg))
-    {:handler #(auth-handler cfg %)
-     :callback-handler #(callback-handler cfg %)}
-    {:handler default-handler
-     :callback-handler default-handler}))

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

@@ -1,182 +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.oauth.google
-  (:require
-   [app.common.exceptions :as ex]
-   [app.common.spec :as us]
-   [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-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 (u/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"
-                  :timeout 6000
-                  :body (u/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)}
-               :timeout 6000
-               :method :get}
-          res (http/send! req)]
-
-      (when (= 200 (:status res))
-        (let [data (json/read-str (:body res))]
-          {:email (get data "email")
-           :backend "google"
-           :fullname (get data "name")})))
-    (catch Exception e
-      (log/error e "unexpected exception on get-user-info")
-      nil)))
-
-(defn- retrieve-info
-  [{:keys [tokens] :as cfg} request]
-  (let [token (get-in request [:params :state])
-        state (tokens :verify {:token token :iss :google-oauth})
-        info  (some->> (get-in request [:params :code])
-                       (get-access-token cfg)
-                       (get-user-info cfg))]
-
-
-    (when-not info
-      (ex/raise :type :internal
-                :code :unable-to-auth))
-
-    (cond-> info
-      (some? (:invitation-token state))
-      (assoc :invitation-token (:invitation-token state)))))
-
-(defn register-profile
-  [{:keys [rpc] :as cfg} info]
-  (let [method-fn (get-in rpc [:methods :mutation :login-or-register])
-        profile   (method-fn {:email (:email info)
-                              :backend (:backend info)
-                              :fullname (:fullname 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 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 redirect-response
-  [uri]
-  {:status 302
-   :headers {"location" (str uri)}
-   :body ""})
-
-(defn- auth-handler
-  [{:keys [tokens] :as cfg} request]
-  (let [invitation (get-in request [:params :invitation-token])
-        state      (tokens :generate
-                           {:iss :google-oauth
-                            :invitation-token invitation
-                            :exp (dt/in-future "15m")})
-        params     {:scope scope
-                    :access_type "offline"
-                    :include_granted_scopes true
-                    :state state
-                    :response_type "code"
-                    :redirect_uri (build-redirect-url cfg)
-                    :client_id (:client-id cfg)}
-        query      (u/map->query-string params)
-        uri        (-> (u/uri base-goauth-uri)
-                       (assoc :query query))]
-
-    {:status 200
-     :body {:redirect-uri (str 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)))))
-
-(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.oauth/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.oauth/google
-  [_ cfg]
-  (if (and (:client-id cfg)
-           (:client-secret cfg))
-    {:handler #(auth-handler cfg %)
-     :callback-handler #(callback-handler cfg %)}
-    {:handler default-handler
-     :callback-handler default-handler}))

backend/src/app/http/session.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.http.session
   (:require
@@ -15,104 +12,100 @@
    [app.db :as db]
    [app.metrics :as mtx]
    [app.util.async :as aa]
-   [app.util.log4j :refer [update-thread-context!]]
+   [app.util.logging :as l]
    [app.util.time :as dt]
    [app.worker :as wrk]
-   [buddy.core.codecs :as bc]
-   [buddy.core.nonce :as bn]
    [clojure.core.async :as a]
    [clojure.spec.alpha :as s]
-   [clojure.tools.logging :as log]
    [integrant.core :as ig]))
 
+;; A default cookie name for storing the session. We don't allow
+;; configure it.
+(def cookie-name "auth-token")
+
 ;; --- IMPL
 
-(defn- next-session-id
-  ([] (next-session-id 96))
-  ([n]
-   (-> (bn/random-nonce n)
-       (bc/bytes->b64u)
-       (bc/bytes->str))))
+(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- 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))
-
-(defn- delete
-  [{:keys [conn cookie-name] :as cfg} {:keys [cookies] :as request}]
+(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 id, profile_id from http_session where id = ?" token])))
+(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} {:keys [cookies] :as request}]
+  [cfg {:keys [cookies] :as request}]
   (->> (get-in cookies [cookie-name :value])
-       (retrieve cfg)))
+       (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- clear-cookies
+  [response]
+  (assoc response :cookies {cookie-name {:value "" :max-age -1}}))
 
 (defn- middleware
   [cfg handler]
   (fn [request]
     (if-let [{:keys [id profile-id] :as session} (retrieve-from-request cfg request)]
-      (let [ech (::events-ch cfg)]
-        (a/>!! ech id)
-        (update-thread-context! {:profile-id profile-id})
+      (do
+        (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
 
-(s/def ::cookie-name ::cfg/http-session-cookie-name)
-
 (defmethod ig/pre-init-spec ::session [_]
-  (s/keys :req-un [::db/pool]
-          :opt-un [::cookie-name]))
+  (s/keys :req-un [::db/pool]))
 
 (defmethod ig/prep-key ::session
   [_ cfg]
-  (merge {:cookie-name "auth-token"
-          :buffer-size 64}
-         (d/without-nils cfg)))
+  (d/merge {:buffer-size 64}
+           (d/without-nils cfg)))
 
 (defmethod ig/init-key ::session
   [_ {:keys [pool] :as cfg}]
   (let [events (a/chan (a/dropping-buffer (:buffer-size cfg)))
-        cfg    (assoc cfg
-                      :conn pool
-                      ::events-ch events)]
+        cfg    (-> cfg
+                   (assoc :conn pool)
+                   (assoc ::events-ch events))]
     (-> cfg
         (assoc :middleware #(middleware cfg %))
         (assoc :create (fn [profile-id]
                          (fn [request response]
-                           (let [uagent (get-in request [:headers "user-agent"])
-                                 value  (create cfg {:profile-id profile-id :user-agent uagent})]
-                             (assoc response :cookies (cookies cfg {:value value}))))))
+                           (let [request (assoc request :profile-id profile-id)
+                                 session (create-session cfg request)]
+                             (add-cookies response session)))))
         (assoc :delete (fn [request response]
-                         (delete cfg request)
-                         (assoc response
-                                :status 204
-                                :body ""
-                                :cookies (cookies cfg {:value "" :max-age -1})))))))
+                         (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?)
@@ -132,12 +125,14 @@
 
 (defmethod ig/init-key ::updater
   [_ {:keys [session metrics] :as cfg}]
-  (log/infof "initialize session updater (max-batch-age=%s, max-batch-size=%s)"
-             (str (:max-batch-age cfg))
-             (str (:max-batch-size cfg)))
-  (let [input (batch-events cfg (::events-ch session))
+  (l/info :action "initialize session updater"
+          :max-batch-age (str (:max-batch-age cfg))
+          :max-batch-size (str (:max-batch-size cfg)))
+  (let [input (aa/batch (::events-ch session)
+                        {:max-batch-size (:max-batch-size cfg)
+                         :max-batch-age (inst-ms (:max-batch-age cfg))})
         mcnt  (mtx/create
-               {:name "http_session_updater_count"
+               {:name "http_session_update_total"
                 :help "A counter of session update batch events."
                 :registry (:registry metrics)
                 :type :counter})]
@@ -145,41 +140,19 @@
       (when-let [[reason batch] (a/<! input)]
         (let [result (a/<! (update-sessions cfg batch))]
           (mcnt :inc)
-          (if (ex/exception? result)
-            (log/error result "updater: unexpected error on update sessions")
-            (log/tracef "updater: updated %s sessions (reason: %s)." result (name reason)))
+          (cond
+            (ex/exception? result)
+            (l/error :task "updater"
+                     :hint "unexpected error on update sessions"
+                     :cause result)
+
+            (= :size reason)
+            (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
@@ -209,7 +182,9 @@
       (let [interval (db/interval max-age)
             result   (db/exec-one! conn [sql:delete-expired interval])
             result   (:next.jdbc/update-count result)]
-        (log/debugf "gc-task: removed %s rows from http-session table" result)
+        (l/debug :task "gc"
+                 :action "clean http sessions"
+                 :count result)
         result))))
 
 (def ^:private

backend/src/app/loggers/audit.clj

@@ -0,0 +1,250 @@
+;; 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.audit
+  "Services related to the user activity (audit log)."
+  (:require
+   [app.common.data :as d]
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.common.transit :as t]
+   [app.common.uuid :as uuid]
+   [app.config :as cf]
+   [app.db :as db]
+   [app.util.async :as aa]
+   [app.util.http :as http]
+   [app.util.logging :as l]
+   [app.util.time :as dt]
+   [app.worker :as wrk]
+   [clojure.core.async :as a]
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [integrant.core :as ig]
+   [lambdaisland.uri :as u]))
+
+(defn parse-client-ip
+  [{:keys [headers] :as request}]
+  (or (some-> (get headers "x-forwarded-for") (str/split ",") first)
+      (get headers "x-real-ip")
+      (get request :remote-addr)))
+
+(defn profile->props
+  [profile]
+  (-> profile
+      (select-keys [:is-active :is-muted :auth-backend :email :default-team-id :default-project-id :fullname :lang])
+      (d/without-nils)))
+
+(defn clean-props
+  [{:keys [profile-id] :as event}]
+  (letfn [(clean-common [props]
+            (-> props
+                (dissoc :session-id)
+                (dissoc :password)
+                (dissoc :old-password)
+                (dissoc :token)))
+
+          (clean-profile-id [props]
+            (cond-> props
+              (= profile-id (:profile-id props))
+              (dissoc :profile-id)))
+
+          (clean-complex-data [props]
+            (reduce-kv (fn [props k v]
+                         (cond-> props
+                           (or (string? v)
+                               (uuid? v)
+                               (boolean? v)
+                               (number? v))
+                           (assoc k v)
+
+                           (keyword? v)
+                           (assoc k (name v))))
+                       {}
+                       props))]
+
+    (update event :props #(-> % clean-common clean-profile-id clean-complex-data))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Collector
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Defines a service that collects the audit/activity log using
+;; internal database. Later this audit log can be transferred to
+;; an external storage and data cleared.
+
+(declare persist-events)
+(s/def ::enabled ::us/boolean)
+
+(defmethod ig/pre-init-spec ::collector [_]
+  (s/keys :req-un [::db/pool ::wrk/executor ::enabled]))
+
+(def event-xform
+  (comp
+   (filter :profile-id)
+   (map clean-props)))
+
+(defmethod ig/init-key ::collector
+  [_ {:keys [enabled] :as cfg}]
+  (when enabled
+    (l/info :msg "intializing audit collector")
+    (let [input  (a/chan 512 event-xform)
+          buffer (aa/batch input {:max-batch-size 100
+                                  :max-batch-age (* 10 1000) ; 10s
+                                  :init []})]
+      (a/go-loop []
+        (when-let [[_type events] (a/<! buffer)]
+          (let [res (a/<! (persist-events cfg events))]
+            (when (ex/exception? res)
+              (l/error :hint "error on persiting events"
+                       :cause res)))
+          (recur)))
+
+      (fn [& {:keys [cmd] :as params}]
+        (let [params (dissoc params :cmd)]
+          (case cmd
+            :stop   (a/close! input)
+            :submit (when-not (a/offer! input params)
+                      (l/warn :msg "activity channel is full"))))))))
+
+
+(defn- persist-events
+  [{:keys [pool executor] :as cfg} events]
+  (letfn [(event->row [event]
+            [(uuid/next)
+             (:name event)
+             (:type event)
+             (:profile-id event)
+             (some-> (:ip-addr event) db/inet)
+             (db/tjson (:props event))])]
+
+    (aa/with-thread executor
+      (db/with-atomic [conn pool]
+        (db/insert-multi! conn :audit-log
+                          [:id :name :type :profile-id :ip-addr :props]
+                          (sequence (map event->row) events))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Archive Task
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; This is a task responsible to send the accomulated events to an
+;; external service for archival.
+
+(declare archive-events)
+
+(s/def ::uri ::us/string)
+(s/def ::tokens fn?)
+
+(defmethod ig/pre-init-spec ::archive-task [_]
+  (s/keys :req-un [::db/pool ::tokens ::enabled]
+          :opt-un [::uri]))
+
+(defmethod ig/init-key ::archive-task
+  [_ {:keys [uri enabled] :as cfg}]
+  (fn [_]
+    (when (and enabled (not uri))
+      (ex/raise :type :internal
+                :code :task-not-configured
+                :hint "archive task not configured, missing uri"))
+    (loop []
+      (let [res (archive-events cfg)]
+        (when (= res :continue)
+          (aa/thread-sleep 200)
+          (recur))))))
+
+(def sql:retrieve-batch-of-audit-log
+  "select * from audit_log
+    where archived_at is null
+    order by created_at asc
+    limit 100
+      for update skip locked;")
+
+(defn archive-events
+  [{:keys [pool uri tokens] :as cfg}]
+  (letfn [(decode-row [{:keys [props ip-addr] :as row}]
+            (cond-> row
+              (db/pgobject? props)
+              (assoc :props (db/decode-transit-pgobject props))
+
+              (db/pgobject? ip-addr "inet")
+              (assoc :ip-addr (db/decode-inet ip-addr))))
+
+          (row->event [{:keys [name type created-at profile-id props ip-addr]}]
+            (cond-> {:type type
+                     :name name
+                     :timestamp created-at
+                     :profile-id profile-id
+                     :props props}
+              (some? ip-addr)
+              (update :context assoc :source-ip ip-addr)))
+
+          (send [events]
+            (let [token   (tokens :generate {:iss "authentication"
+                                             :iat (dt/now)
+                                             :uid uuid/zero})
+                  body    (t/encode {:events events})
+                  headers {"content-type" "application/transit+json"
+                           "origin" (cf/get :public-uri)
+                           "cookie" (u/map->query-string {:auth-token token})}
+                  params  {:uri uri
+                           :timeout 6000
+                           :method :post
+                           :headers headers
+                           :body body}
+                  resp    (http/send! params)]
+              (when (not= (:status resp) 204)
+                (ex/raise :type :internal
+                          :code :unable-to-send-events
+                          :hint "unable to send events"
+                          :context resp))))
+
+          (mark-as-archived [conn rows]
+            (db/exec-one! conn ["update audit_log set archived_at=now() where id = ANY(?)"
+                                (->> (map :id rows)
+                                     (into-array java.util.UUID)
+                                     (db/create-array conn "uuid"))]))]
+
+    (db/with-atomic [conn pool]
+      (let [rows   (db/exec! conn [sql:retrieve-batch-of-audit-log])
+            xform  (comp (map decode-row)
+                         (map row->event))
+            events (into [] xform rows)]
+        (l/debug :action "archive-events" :uri uri :events (count events))
+        (if (empty? events)
+          :empty
+          (do
+            (send events)
+            (mark-as-archived conn rows)
+            :continue))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; GC Task
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare clean-archived)
+
+(s/def ::max-age ::cf/audit-archive-gc-max-age)
+
+(defmethod ig/pre-init-spec ::archive-gc-task [_]
+  (s/keys :req-un [::db/pool ::enabled ::max-age]))
+
+(defmethod ig/init-key ::archive-gc-task
+  [_ cfg]
+  (fn [_]
+    (clean-archived cfg)))
+
+(def sql:clean-archived
+  "delete from audit_log
+    where archived_at is not null
+      and archived_at < now() - ?::interval")
+
+(defn- clean-archived
+  [{:keys [pool max-age]}]
+  (let [interval (db/interval max-age)
+        result   (db/exec-one! pool [sql:clean-archived interval])
+        result   (:next.jdbc/update-count result)]
+    (l/debug :action "clean archived audit log" :removed result)
+    result))

backend/src/app/loggers/loki.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.loggers.loki
   "A Loki integration."
@@ -15,10 +12,10 @@
    [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]
-   [clojure.tools.logging :as log]
    [integrant.core :as ig]))
 
 (declare handle-event)
@@ -33,17 +30,17 @@
 (defmethod ig/init-key ::reporter
   [_ {:keys [receiver uri] :as cfg}]
   (when uri
-    (log/info "intializing loki reporter")
-    (let [output (a/chan (a/sliding-buffer 1024))]
-      (receiver :sub output)
+    (l/info :msg "intializing loki reporter" :uri uri)
+    (let [input (a/chan (a/dropping-buffer 512))]
+      (receiver :sub input)
       (a/go-loop []
-        (let [msg (a/<! output)]
+        (let [msg (a/<! input)]
           (if (nil? msg)
-            (log/info "stoping error reporting loop")
+            (l/info :msg "stoping error reporting loop")
             (do
               (a/<! (handle-event cfg msg))
               (recur)))))
-      output)))
+      input)))
 
 (defmethod ig/halt-key! ::reporter
   [_ output]
@@ -72,13 +69,23 @@
                                 :method :post
                                 :headers {"content-type" "application/json"}
                                 :body (json/encode payload)})]
-      (if (= (:status response) 204)
+      (cond
+        (= (:status response) 204)
         true
+
+        (= (:status response) 400)
         (do
-          (log/errorf "error on sending log to loki (try %s)\n%s" i (pr-str response))
+          (l/error :hint "error on sending log to loki (no retry)"
+                   :rsp (pr-str response))
+          true)
+
+        :else
+        (do
+          (l/error :hint "error on sending log to loki" :try i
+                   :rsp (pr-str response))
           false)))
     (catch Exception e
-      (log/errorf e "error on sending message to loki (try %s)" i)
+      (l/error :hint "error on sending message to loki" :cause e :try i)
       false)))
 
 (defn- handle-event

backend/src/app/loggers/mattermost.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.loggers.mattermost
   "A mattermost integration for error reporting."
@@ -18,12 +15,12 @@
    [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]))
 
@@ -42,43 +39,43 @@
           :opt-un [::uri]))
 
 (defmethod ig/init-key ::reporter
-  [_ {:keys [receiver] :as cfg}]
-  (log/info "intializing mattermost error reporter")
-  (let [output (a/chan (a/sliding-buffer 128)
-                       (filter #(= (:level %) "error")))]
-    (receiver :sub output)
-    (a/go-loop []
-      (let [msg (a/<! output)]
-        (if (nil? msg)
-          (log/info "stoping error reporting loop")
-          (do
-            (a/<! (handle-event cfg msg))
-            (recur)))))
-    output))
+  [_ {:keys [receiver uri] :as cfg}]
+  (when uri
+    (l/info :msg "initializing mattermost error reporter" :uri uri)
+    (let [output (a/chan (a/sliding-buffer 128)
+                         (filter #(= (:level %) "error")))]
+      (receiver :sub output)
+      (a/go-loop []
+        (let [msg (a/<! output)]
+          (if (nil? msg)
+            (l/info :msg "stoping error reporting loop")
+            (do
+              (a/<! (handle-event cfg msg))
+              (recur)))))
+      output)))
 
 (defmethod ig/halt-key! ::reporter
   [_ output]
-  (a/close! output))
+  (when output
+    (a/close! output)))
 
 (defn- send-mattermost-notification!
-  [cfg {:keys [host version id error] :as cdata}]
+  [cfg {:keys [host id] :as cdata}]
   (try
     (let [uri  (:uri cfg)
-          text (str "Unhandled exception (@channel):\n"
-                    "- detail: " (:public-uri cfg/config) "/dbg/error-by-id/" id "\n"
-                    "- host: `" host "`\n"
-                    "- version: `" version "`\n"
-                    (when error
-                      (str "```\n" (:trace error)  "\n```")))
-          rsp    (http/send! {:uri uri
-                              :method :post
-                              :headers {"content-type" "application/json"}
-                              :body (json/encode-str {:text text})})]
+          text (str "Unhandled exception (host: " host ", url: " (cfg/get :public-uri) "/dbg/error-by-id/" id "\n"
+                    "- profile-id: #" (:profile-id cdata) "\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/errorf "error on sending data to mattermost\n%s" (pr-str rsp))))
+        (l/error :hint "error on sending data to mattermost"
+                 :response (pr-str rsp))))
 
     (catch Exception e
-      (log/error 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}]
@@ -112,11 +109,12 @@
   (aa/with-thread executor
     (try
       (let [cdata (parse-event event)]
-        (when (and (:uri cfg) @enabled-mattermost)
+        (when @enabled-mattermost
           (send-mattermost-notification! cfg cdata))
         (persist-on-database! cfg cdata))
       (catch Exception e
-        (log/error e "unexpected exception on error reporter")))))
+        (l/error :hint "unexpected exception on error reporter"
+                 :cause e)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Http Handler

backend/src/app/loggers/zmq.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.loggers.zmq
   "A generic ZMQ listener."
@@ -13,10 +10,10 @@
    [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]
-   [clojure.tools.logging :as log]
    [cuerdas.core :as str]
    [integrant.core :as ig])
   (:import
@@ -34,7 +31,7 @@
 
 (defmethod ig/init-key ::receiver
   [_ {:keys [endpoint] :as cfg}]
-  (log/infof "intializing ZMQ receiver on '%s'" endpoint)
+  (l/info :msg "intializing ZMQ receiver" :bind endpoint)
   (let [buffer (a/chan 1)
         output (a/chan 1 (comp (filter map?)
                                (map prepare)))

backend/src/app/main.clj

@@ -2,381 +2,368 @@
 ;; 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
-    {: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}}}
+   :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
+   {:keys (ig/ref :app.setup/keys)}
 
-    :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.msgbus/msgbus
-    {: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.setup/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 (:http-session-cookie-name config)}
+   :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.session/gc-task
-    {:pool        (ig/ref :app.db/pool)
-     :max-age     (:http-session-idle-max-age config)}
+   :app.http/router
+   {:rpc         (ig/ref :app.rpc/rpc)
+    :session     (ig/ref :app.http.session/session)
+    :tokens      (ig/ref :app.tokens/tokens)
+    :public-uri  (cf/get :public-uri)
+    :metrics     (ig/ref :app.metrics/metrics)
+    :oauth       (ig/ref :app.http.oauth/handler)
+    :assets      (ig/ref :app.http.assets/handlers)
+    :storage     (ig/ref :app.storage/storage)
+    :sns-webhook (ig/ref :app.http.awsns/handler)
+    :feedback    (ig/ref :app.http.feedback/handler)
+    :error-report-handler (ig/ref :app.loggers.mattermost/handler)}
 
-    :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  (:http-session-updater-batch-max-age config)
-     :max-batch-size (:http-session-updater-batch-max-size config)}
+   :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.awsns/handler
-    {:tokens  (ig/ref :app.tokens/tokens)
-     :pool    (ig/ref :app.db/pool)}
+   :app.http.feedback/handler
+   {:pool (ig/ref :app.db/pool)}
 
-    :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.oauth/handler
+   {:rpc           (ig/ref :app.rpc/rpc)
+    :session       (ig/ref :app.http.session/session)
+    :pool          (ig/ref :app.db/pool)
+    :tokens        (ig/ref :app.tokens/tokens)
+    :audit         (ig/ref :app.loggers.audit/collector)
+    :public-uri    (cf/get :public-uri)}
 
-    :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)
-     :oauth       (ig/ref :app.http.oauth/all)
-     :assets      (ig/ref :app.http.assets/handlers)
-     :svgparse    (ig/ref :app.svgparse/handler)
-     :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)}
+   ;; RLimit definition for password hashing
+   :app.rlimits/password
+   (cf/get :rlimits-password)
 
-    :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})}
+   ;; RLimit definition for image processing
+   :app.rlimits/image
+   (cf/get :rlimits-image)
 
-    :app.http.feedback/handler
-    {:pool (ig/ref :app.db/pool)}
+   ;; RLimit definition for font processing
+   :app.rlimits/font
+   (cf/get :rlimits-font 2)
 
-    :app.http.oauth/all
-    {:google (ig/ref :app.http.oauth/google)
-     :gitlab (ig/ref :app.http.oauth/gitlab)
-     :github (ig/ref :app.http.oauth/github)}
+   ;; A collection of rlimits as hash-map.
+   :app.rlimits/all
+   {:password (ig/ref :app.rlimits/password)
+    :image    (ig/ref :app.rlimits/image)
+    :font     (ig/ref :app.rlimits/font)}
 
-    :app.http.oauth/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.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)
+    :audit      (ig/ref :app.loggers.audit/collector)}
 
-    :app.http.oauth/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)}
+   :app.notifications/handler
+   {:msgbus   (ig/ref :app.msgbus/msgbus)
+    :pool     (ig/ref :app.db/pool)
+    :session  (ig/ref :app.http.session/session)
+    :metrics  (ig/ref :app.metrics/metrics)
+    :executor (ig/ref :app.worker/executor)}
 
-    :app.http.oauth/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)}
+   :app.worker/executor
+   {:min-threads 0
+    :max-threads 256
+    :idle-timeout 60000
+    :name :worker}
 
-    :app.svgparse/svgc
-    {:metrics (ig/ref :app.metrics/metrics)}
+   :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)}
 
-    ;; HTTP Handler for SVG parsing
-    :app.svgparse/handler
-    {:metrics (ig/ref :app.metrics/metrics)
-     :svgc    (ig/ref :app.svgparse/svgc)}
+   :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 * * ?" ;; daily
+      :task :file-media-gc}
 
-    ;; RLimit definition for password hashing
-    :app.rlimits/password
-    (:rlimits-password config)
+     {:cron #app/cron "0 0 * * * ?"  ;; hourly
+      :task :file-xlog-gc}
 
-    ;; RLimit definition for image processing
-    :app.rlimits/image
-    (:rlimits-image config)
+     {:cron #app/cron "0 0 0 * * ?"  ;; daily
+      :task :storage-deleted-gc}
 
-    ;; A collection of rlimits as hash-map.
-    :app.rlimits/all
-    {:password (ig/ref :app.rlimits/password)
-     :image    (ig/ref :app.rlimits/image)}
+     {:cron #app/cron "0 0 0 * * ?"  ;; daily
+      :task :storage-touched-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)
-     :msgbus  (ig/ref :app.msgbus/msgbus)
-     :rlimits (ig/ref :app.rlimits/all)
-     :svgc    (ig/ref :app.svgparse/svgc)}
+     {:cron #app/cron "0 0 0 * * ?"  ;; daily
+      :task :session-gc}
 
-    :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)}
+     {:cron #app/cron "0 0 * * * ?"  ;; hourly
+      :task :storage-recheck}
 
-    :app.worker/executor
-    {:name "worker"}
+     {:cron #app/cron "0 0 0 * * ?"  ;; daily
+      :task :objects-gc}
 
-    :app.worker/worker
-    {:executor   (ig/ref :app.worker/executor)
-     :pool       (ig/ref :app.db/pool)
-     :tasks      (ig/ref :app.tasks/registry)}
+     {:cron #app/cron "0 0 0 * * ?"  ;; daily
+      :task :tasks-gc}
 
-    :app.worker/scheduler
-    {:executor   (ig/ref :app.worker/executor)
-     :pool       (ig/ref :app.db/pool)
-     :tasks      (ig/ref :app.tasks/registry)
-     :schedule
-     [{:id "file-media-gc"
-       :cron #app/cron "0 0 0 */1 * ? *" ;; daily
-       :task :file-media-gc}
+     (when (cf/get :fdata-storage-backed)
+       {:cron #app/cron "0 0 * * * ?"  ;; hourly
+        :task :file-offload})
 
-      {:id "file-xlog-gc"
-       :cron #app/cron "0 0 */1 * * ?"  ;; hourly
-       :task :file-xlog-gc}
+     (when (cf/get :audit-archive-enabled)
+       {:cron #app/cron "0 0 * * * ?" ;; every 1h
+        :task :audit-archive})
 
-      {:id "storage-deleted-gc"
-       :cron #app/cron "0 0 1 */1 * ?"  ;; daily (1 hour shift)
-       :task :storage-deleted-gc}
+     (when (cf/get :audit-archive-gc-enabled)
+       {:cron #app/cron "0 0 * * * ?" ;; every 1h
+        :task :audit-archive-gc})
 
-      {:id "storage-touched-gc"
-       :cron #app/cron "0 0 2 */1 * ?"  ;; daily (2 hour shift)
-       :task :storage-touched-gc}
+     (when (cf/get :telemetry-enabled)
+       {:cron #app/cron "0 0 */6 * * ?" ;; every 6h
+        :task :telemetry})]}
 
-      {:id "session-gc"
-       :cron #app/cron "0 0 3 */1 * ?"  ;; daily (3 hour shift)
-       :task :session-gc}
+   :app.worker/registry
+   {:metrics (ig/ref :app.metrics/metrics)
+    :tasks
+    {:sendmail           (ig/ref :app.emails/sendmail-handler)
+     :objects-gc         (ig/ref :app.tasks.objects-gc/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)
+     :file-offload       (ig/ref :app.tasks.file-offload/handler)
+     :audit-archive      (ig/ref :app.loggers.audit/archive-task)
+     :audit-archive-gc   (ig/ref :app.loggers.audit/archive-gc-task)}}
 
-      {:id "storage-recheck"
-       :cron #app/cron "0 0 */1 * * ?"  ;; hourly
-       :task :storage-recheck}
+   :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
-       :task :tasks-gc}
+   :app.tasks.tasks-gc/handler
+   {:pool    (ig/ref :app.db/pool)
+    :max-age cf/deletion-delay}
 
-      (when (:telemetry-enabled config)
-        {:id   "telemetry"
-         :cron #app/cron "0 0 */6 * * ?" ;; every 6h
-         :uri  (:telemetry-uri config)
-         :task :telemetry})]}
+   :app.tasks.delete-object/handler
+   {:pool    (ig/ref :app.db/pool)
+    :storage (ig/ref :app.storage/storage)}
 
-    :app.tasks/registry
-    {:metrics (ig/ref :app.metrics/metrics)
-     :tasks
-     {: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)
-      :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)}}
+   :app.tasks.objects-gc/handler
+   {:pool    (ig/ref :app.db/pool)
+    :storage (ig/ref :app.storage/storage)
+    :max-age cf/deletion-delay}
 
-    :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)}
 
-    :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)
+    :max-age cf/deletion-delay}
 
-    :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)
+    :max-age (dt/duration {:hours 72})}
 
-    :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.file-offload/handler
+   {:pool    (ig/ref :app.db/pool)
+    :max-age (dt/duration {:seconds 5})
+    :storage (ig/ref :app.storage/storage)
+    :backend (cf/get :fdata-storage-backed :fdata-s3)}
 
-    :app.tasks.delete-profile/handler
-    {:pool    (ig/ref :app.db/pool)
-     :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.file-media-gc/handler
-    {:pool    (ig/ref :app.db/pool)
-     :metrics (ig/ref :app.metrics/metrics)
-     :max-age (dt/duration {:hours 48})}
+   :app.srepl/server
+   {:port (cf/get :srepl-port)
+    :host (cf/get :srepl-host)}
 
-    :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.setup/props
+   {:pool (ig/ref :app.db/pool)
+    :key  (cf/get :secret-key)}
 
-    :app.tasks.telemetry/handler
-    {:pool        (ig/ref :app.db/pool)
-     :version     (:full cfg/version)
-     :uri         (:telemetry-uri config)
-     :sprops      (ig/ref :app.setup/props)}
+   :app.setup/keys
+   {:props (ig/ref :app.setup/props)}
 
-    :app.srepl/server
-    {:port (:srepl-port config)
-     :host (:srepl-host config)}
+   :app.loggers.zmq/receiver
+   {:endpoint (cf/get :loggers-zmq-uri)}
 
-    :app.setup/props
-    {:pool (ig/ref :app.db/pool)}
+   :app.loggers.audit/collector
+   {:enabled  (cf/get :audit-enabled false)
+    :pool     (ig/ref :app.db/pool)
+    :executor (ig/ref :app.worker/executor)}
 
-    :app.loggers.zmq/receiver
-    {:endpoint (:loggers-zmq-uri config)}
+   :app.loggers.audit/archive-task
+   {:uri      (cf/get :audit-archive-uri)
+    :enabled  (cf/get :audit-archive-enabled false)
+    :tokens   (ig/ref :app.tokens/tokens)
+    :pool     (ig/ref :app.db/pool)}
 
-    :app.loggers.loki/reporter
-    {:uri      (:loggers-loki-uri config)
-     :receiver (ig/ref :app.loggers.zmq/receiver)
-     :executor (ig/ref :app.worker/executor)}
+   :app.loggers.audit/archive-gc-task
+   {:enabled  (cf/get :audit-archive-gc-enabled false)
+    :max-age  (cf/get :audit-archive-gc-max-age cf/deletion-delay)
+    :pool     (ig/ref :app.db/pool)}
 
-    :app.loggers.mattermost/reporter
-    {:uri      (:error-report-webhook config)
-     :receiver (ig/ref :app.loggers.zmq/receiver)
-     :pool     (ig/ref :app.db/pool)
-     :executor (ig/ref :app.worker/executor)}
+   :app.loggers.loki/reporter
+   {:uri      (cf/get :loggers-loki-uri)
+    :receiver (ig/ref :app.loggers.zmq/receiver)
+    :executor (ig/ref :app.worker/executor)}
 
-    :app.loggers.mattermost/handler
-    {:pool (ig/ref :app.db/pool)}
+   :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.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])}}
+   :app.loggers.mattermost/handler
+   {:pool (ig/ref :app.db/pool)}
 
-    [::main :app.storage.s3/backend]
-    {:region (:storage-s3-region config)
-     :bucket (:storage-s3-bucket config)}
+   :app.storage/storage
+   {:pool     (ig/ref :app.db/pool)
+    :executor (ig/ref :app.worker/executor)
 
-    [::main :app.storage.fs/backend]
-    {:directory (:storage-fs-directory config)}
+    :backends {
+               :assets-s3 (ig/ref [::assets :app.storage.s3/backend])
+               :assets-db (ig/ref [::assets :app.storage.db/backend])
+               :assets-fs (ig/ref [::assets :app.storage.fs/backend])
+               :tmp       (ig/ref [::tmp  :app.storage.fs/backend])
+               :fdata-s3  (ig/ref [::fdata :app.storage.s3/backend])
 
-    [::tmp :app.storage.fs/backend]
-    {:directory "/tmp/penpot"}
+               ;; keep this for backward compatibility
+               :s3        (ig/ref [::assets :app.storage.s3/backend])
+               :fs        (ig/ref [::assets :app.storage.fs/backend])}}
 
-    [::main :app.storage.db/backend]
-    {:pool (ig/ref :app.db/pool)}}
+   [::fdata :app.storage.s3/backend]
+   {:region (cf/get :storage-fdata-s3-region)
+    :bucket (cf/get :storage-fdata-s3-bucket)
+    :prefix (cf/get :storage-fdata-s3-prefix)}
 
-   (when (:telemetry-server-enabled config)
-     {:app.telemetry/handler
-      {:pool     (ig/ref :app.db/pool)
-       :executor (ig/ref :app.worker/executor)}
+   [::assets :app.storage.s3/backend]
+   {:region (cf/get :storage-assets-s3-region)
+    :bucket (cf/get :storage-assets-s3-bucket)}
 
-      :app.telemetry/server
-      {:port    (:telemetry-server-port config 6063)
-       :handler (ig/ref :app.telemetry/handler)
-       :name    "telemetry"}})))
+   [::assets :app.storage.fs/backend]
+   {:directory (cf/get :storage-assets-fs-directory)}
 
-(defmethod ig/init-key :default [_ data] data)
-(defmethod ig/prep-key :default
-  [_ data]
-  (if (map? data)
-    (d/without-nils data)
-    data))
+   [::tmp :app.storage.fs/backend]
+   {:directory "/tmp/penpot"}
+
+   [::assets :app.storage.db/backend]
+   {:pool (ig/ref :app.db/pool)}})
 
 (def system nil)
 
 (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
   []
@@ -384,14 +371,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,34 +2,39 @@
 ;; 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."
+  "Media & Font postprocessing."
   (:require
    [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.media :as cm]
    [app.common.spec :as us]
+   [app.config :as cf]
    [app.rlimits :as rlm]
-   [app.svgparse :as svg]
+   [app.rpc.queries.svg :as svg]
+   [buddy.core.bytes :as bb]
+   [buddy.core.codecs :as bc]
+   [clojure.java.io :as io]
+   [clojure.java.shell :as sh]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [datoteka.core :as fs])
   (:import
    java.io.ByteArrayInputStream
+   java.io.OutputStream
+   org.apache.commons.io.IOUtils
    org.im4java.core.ConvertCmd
    org.im4java.core.IMOperation
    org.im4java.core.Info))
 
-;; --- Generic specs
+(s/def ::image-content-type cm/valid-image-types)
+(s/def ::font-content-type cm/valid-font-types)
 
 (s/def :internal.http.upload/filename ::us/string)
 (s/def :internal.http.upload/size ::us/integer)
-(s/def :internal.http.upload/content-type cm/valid-media-types)
+(s/def :internal.http.upload/content-type ::us/string)
 (s/def :internal.http.upload/tempfile any?)
 
 (s/def ::upload
@@ -38,8 +43,44 @@
                    :internal.http.upload/tempfile
                    :internal.http.upload/content-type]))
 
+(defn validate-media-type
+  ([mtype] (validate-media-type mtype cm/valid-image-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"))))
 
+
+(defmulti process :cmd)
+(defmulti process-error class)
+
+(defmethod process :default
+  [{:keys [cmd] :as params}]
+  (ex/raise :type :internal
+            :code :not-implemented
+            :hint (str/fmt "No impl found for process cmd: %s" cmd)))
+
+(defmethod process-error :default
+  [error]
+  (throw error))
+
+(defn run
+  [{:keys [rlimits] :as cfg} {:keys [rlimit] :or {rlimit :image} :as params}]
+  (us/assert map? rlimits)
+  (let [rlimit (get rlimits rlimit)]
+    (when-not rlimit
+      (ex/raise :type :internal
+                :code :rlimit-not-configured
+                :hint ":image rlimit not configured"))
+    (try
+      (rlm/execute rlimit (process params))
+      (catch Throwable e
+        (process-error e)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; --- Thumbnails Generation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (s/def ::cmd keyword?)
 
@@ -80,8 +121,6 @@
              :size   (alength ^bytes thumbnail-data)
              :data   (ByteArrayInputStream. thumbnail-data)))))
 
-(defmulti process :cmd)
-
 (defmethod process :generic-thumbnail
   [{:keys [quality width height] :as params}]
   (us/assert ::thumbnail-params params)
@@ -141,11 +180,10 @@
   (us/assert ::input input)
   (let [{:keys [path mtype]} input]
     (if (= mtype "image/svg+xml")
-      (let [data (svg/parse (slurp path))
-            info (get-basic-info-from-svg data)]
+      (let [info (some-> path slurp svg/parse get-basic-info-from-svg)]
         (when-not info
           (ex/raise :type :validation
-                    :code :unable-to-retrieve-dimensions
+                    :code :invalid-svg-file
                     :hint "uploaded svg does not provides dimensions"))
         (assoc info :mtype mtype))
 
@@ -157,36 +195,149 @@
                     :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
-  [{:keys [cmd] :as params}]
-  (ex/raise :type :internal
-            :code :not-implemented
-            :hint (str "No impl found for process cmd:" cmd)))
+(defmethod process-error org.im4java.core.InfoException
+  [error]
+  (ex/raise :type :validation
+            :code :invalid-image
+            :hint "invalid image"
+            :cause error))
 
-(defn run
-  [{:keys [rlimits]} params]
-  (us/assert map? rlimits)
-  (let [rlimit (get rlimits :image)]
-    (when-not rlimit
-      (ex/raise :type :internal
-                :code :rlimit-not-configured
-                :hint ":image rlimit not configured"))
-    (try
-      (rlm/execute rlimit (process params))
-      (catch org.im4java.core.InfoException e
-        (ex/raise :type :validation
-                  :code :invalid-image
-                  :cause e)))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; --- Fonts Generation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-;; --- Utility functions
+(def all-fotmats #{"font/woff2", "font/woff", "font/otf", "font/ttf"})
+
+(defmethod process :generate-fonts
+  [{:keys [input] :as params}]
+  (letfn [(ttf->otf [data]
+            (let [input-file  (fs/create-tempfile :prefix "penpot")
+                  output-file (fs/path (str input-file ".otf"))
+                  _           (with-open [out (io/output-stream input-file)]
+                                (IOUtils/writeChunked ^bytes data ^OutputStream out)
+                                (.flush ^OutputStream out))
+                  res         (sh/sh "fontforge" "-lang=ff" "-c"
+                                     (str/fmt "Open('%s'); Generate('%s')"
+                                              (str input-file)
+                                              (str output-file)))]
+              (when (zero? (:exit res))
+                (fs/slurp-bytes output-file))))
+
+
+          (otf->ttf [data]
+            (let [input-file  (fs/create-tempfile :prefix "penpot")
+                  output-file (fs/path (str input-file ".ttf"))
+                  _           (with-open [out (io/output-stream input-file)]
+                                (IOUtils/writeChunked ^bytes data ^OutputStream out)
+                                (.flush ^OutputStream out))
+                  res         (sh/sh "fontforge" "-lang=ff" "-c"
+                                     (str/fmt "Open('%s'); Generate('%s')"
+                                              (str input-file)
+                                              (str output-file)))]
+              (when (zero? (:exit res))
+                (fs/slurp-bytes output-file))))
+
+          (ttf-or-otf->woff [data]
+            (let [input-file  (fs/create-tempfile :prefix "penpot" :suffix "")
+                  output-file (fs/path (str input-file ".woff"))
+                  _           (with-open [out (io/output-stream input-file)]
+                                (IOUtils/writeChunked ^bytes data ^OutputStream out)
+                                (.flush ^OutputStream out))
+                  res         (sh/sh "sfnt2woff" (str input-file))]
+              (when (zero? (:exit res))
+                (fs/slurp-bytes output-file))))
+
+          (ttf-or-otf->woff2 [data]
+            (let [input-file  (fs/create-tempfile :prefix "penpot" :suffix "")
+                  output-file (fs/path (str input-file ".woff2"))
+                  _           (with-open [out (io/output-stream input-file)]
+                                (IOUtils/writeChunked ^bytes data ^OutputStream out)
+                                (.flush ^OutputStream out))
+                  res         (sh/sh "woff2_compress" (str input-file))]
+              (when (zero? (:exit res))
+                (fs/slurp-bytes output-file))))
+
+          (woff->sfnt [data]
+            (let [input-file  (fs/create-tempfile :prefix "penpot" :suffix "")
+                  _           (with-open [out (io/output-stream input-file)]
+                                (IOUtils/writeChunked ^bytes data ^OutputStream out)
+                                (.flush ^OutputStream out))
+                  res         (sh/sh "woff2sfnt" (str input-file)
+                                     :out-enc :bytes)]
+              (when (zero? (:exit res))
+                (:out res))))
+
+          ;; Documented here:
+          ;; https://docs.microsoft.com/en-us/typography/opentype/spec/otff#table-directory
+          (get-sfnt-type [data]
+            (let [buff (bb/slice data 0 4)
+                  type (bc/bytes->hex buff)]
+              (case type
+                "4f54544f" :otf
+                "00010000" :ttf
+                (ex/raise :type :internal
+                          :code :unexpected-data
+                          :hint "unexpected font data"))))
+
+          (gen-if-nil [val factory]
+            (if (nil? val)
+              (factory)
+              val))]
+
+    (let [current (into #{} (keys input))]
+      (cond
+        (contains? current "font/ttf")
+        (let [data (get input "font/ttf")]
+          (-> input
+              (update "font/otf" gen-if-nil #(ttf->otf data))
+              (update "font/woff" gen-if-nil #(ttf-or-otf->woff data))
+              (assoc "font/woff2" (ttf-or-otf->woff2 data))))
+
+        (contains? current "font/otf")
+        (let [data (get input "font/otf")]
+          (-> input
+              (update "font/woff" gen-if-nil #(ttf-or-otf->woff data))
+              (assoc "font/ttf" (otf->ttf data))
+              (assoc "font/woff2" (ttf-or-otf->woff2 data))))
+
+        (contains? current "font/woff")
+        (let [data (get input "font/woff")
+              sfnt (woff->sfnt data)]
+          (when-not sfnt
+            (ex/raise :type :validation
+                      :code :invalid-woff-file
+                      :hint "invalid woff file"))
+          (let [stype (get-sfnt-type sfnt)]
+            (cond-> input
+              true
+              (-> (assoc "font/woff" data)
+                  (assoc "font/woff2" (ttf-or-otf->woff2 sfnt)))
+
+              (= stype :otf)
+              (-> (assoc "font/otf" sfnt)
+                  (assoc "font/ttf" (otf->ttf sfnt)))
+
+              (= stype :ttf)
+              (-> (assoc "font/otf" (ttf->otf sfnt))
+                  (assoc "font/ttf" sfnt)))))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Utility functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn configure-assets-storage
+  "Given storage map, returns a storage configured with the apropriate
+  backend for assets."
+  [storage conn]
+  (-> storage
+      (assoc :conn conn)
+      (assoc :backend (cf/get :assets-storage-backend :assets-fs))))
 
-(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")))

backend/src/app/metrics.clj

@@ -2,16 +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-2021 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.metrics
   (:require
    [app.common.exceptions :as ex]
+   [app.util.logging :as l]
    [clojure.spec.alpha :as s]
-   [clojure.tools.logging :as log]
    [integrant.core :as ig])
   (:import
    io.prometheus.client.CollectorRegistry
@@ -50,7 +47,7 @@
 
 (defmethod ig/init-key ::metrics
   [_ {:keys [definitions] :as cfg}]
-  (log/infof "Initializing prometheus registry and instrumentation.")
+  (l/info :action "initialize metrics")
   (let [registry    (create-registry)
         definitions (reduce-kv (fn [res k v]
                                  (->> (assoc v :registry registry)
@@ -213,9 +210,15 @@
          ([a b]
           (mobj :inc)
           (origf a b))
-         ([a b & more]
+         ([a b c]
           (mobj :inc)
-          (apply origf a b more)))
+          (origf a b c))
+         ([a b c d]
+          (mobj :inc)
+          (origf a b c d))
+         ([a b c d & more]
+          (mobj :inc)
+          (apply origf a b c d more)))
        (assoc mdata ::original origf))))
   ([rootf mobj labels]
    (let [mdata  (meta rootf)

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
@@ -163,6 +160,39 @@
 
    {: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")}
+
+   {:name "0053-add-team-font-variant-table"
+    :fn (mg/resource "app/migrations/sql/0053-add-team-font-variant-table.sql")}
+
+   {:name "0054-add-audit-log-table"
+    :fn (mg/resource "app/migrations/sql/0054-add-audit-log-table.sql")}
+
+   {:name "0055-mod-file-media-object-table"
+    :fn (mg/resource "app/migrations/sql/0055-mod-file-media-object-table.sql")}
+
+   {:name "0056-add-missing-index-on-deleted-at"
+    :fn (mg/resource "app/migrations/sql/0056-add-missing-index-on-deleted-at.sql")}
+
+   {:name "0057-del-profile-on-delete-trigger"
+    :fn (mg/resource "app/migrations/sql/0057-del-profile-on-delete-trigger.sql")}
+
+   {:name "0058-del-team-on-delete-trigger"
+    :fn (mg/resource "app/migrations/sql/0058-del-team-on-delete-trigger.sql")}
+
+   {:name "0059-mod-audit-log-table"
+    :fn (mg/resource "app/migrations/sql/0059-mod-audit-log-table.sql")}
+
+   {:name "0060-mod-file-change-table"
+    :fn (mg/resource "app/migrations/sql/0060-mod-file-change-table.sql")}
+
+   {:name "0061-mod-file-table"
+    :fn (mg/resource "app/migrations/sql/0061-mod-file-table.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/0015-improve-tasks-tables.sql

@@ -1,4 +1,4 @@
-DROP TABLE task;
+DROP TABLE IF EXISTS task;
 
 CREATE TABLE task (
   id uuid DEFAULT uuid_generate_v4(),
@@ -27,3 +27,11 @@ CREATE TABLE task_default partition OF task default;
 CREATE INDEX task__scheduled_at__queue__idx
     ON task (scheduled_at, queue)
  WHERE status = 'new' or status = 'retry';
+
+ALTER TABLE task
+  ALTER COLUMN queue SET STORAGE external,
+  ALTER COLUMN name SET STORAGE external,
+  ALTER COLUMN props SET STORAGE external,
+  ALTER COLUMN status SET STORAGE external,
+  ALTER COLUMN error SET STORAGE external;
+

backend/src/app/migrations/sql/0019-add-improved-scheduled-tasks.sql

@@ -1,4 +1,4 @@
-DROP TABLE scheduled_task;
+DROP TABLE IF EXISTS scheduled_task;
 
 CREATE TABLE scheduled_task (
   id text PRIMARY KEY,
@@ -22,3 +22,7 @@ CREATE TABLE scheduled_task_history (
 
 CREATE INDEX scheduled_task_history__task_id__idx
     ON scheduled_task_history(task_id);
+
+ALTER TABLE scheduled_task
+  ALTER COLUMN id SET STORAGE external,
+  ALTER COLUMN cron_expr SET STORAGE external;

backend/src/app/migrations/sql/0041-mod-pg-storage-options.sql

@@ -27,17 +27,6 @@ ALTER TABLE comment_thread
   ALTER COLUMN participants SET STORAGE external,
   ALTER COLUMN page_name SET STORAGE external;
 
-ALTER TABLE task
-  ALTER COLUMN queue SET STORAGE external,
-  ALTER COLUMN name SET STORAGE external,
-  ALTER COLUMN props SET STORAGE external,
-  ALTER COLUMN status SET STORAGE external,
-  ALTER COLUMN error SET STORAGE external;
-
-ALTER TABLE scheduled_task
-  ALTER COLUMN id SET STORAGE external,
-  ALTER COLUMN cron_expr SET STORAGE external;
-
 ALTER TABLE http_session
   ALTER COLUMN id SET STORAGE external,
   ALTER COLUMN user_agent SET STORAGE external;

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/migrations/sql/0053-add-team-font-variant-table.sql

@@ -0,0 +1,43 @@
+CREATE TABLE team_font_variant (
+  id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
+
+  team_id    uuid NOT NULL REFERENCES team(id) ON DELETE CASCADE DEFERRABLE,
+  profile_id uuid NULL REFERENCES profile(id) ON DELETE SET NULL DEFERRABLE,
+
+  created_at timestamptz NOT NULL DEFAULT now(),
+  modified_at timestamptz NOT NULL DEFAULT now(),
+  deleted_at timestamptz NULL DEFAULT NULL,
+
+  font_id uuid NOT NULL,
+  font_family text NOT NULL,
+  font_weight smallint NOT NULL,
+  font_style text NOT NULL,
+
+  otf_file_id   uuid NULL REFERENCES storage_object(id) ON DELETE SET NULL DEFERRABLE,
+  ttf_file_id   uuid NULL REFERENCES storage_object(id) ON DELETE SET NULL DEFERRABLE,
+  woff1_file_id uuid NULL REFERENCES storage_object(id) ON DELETE SET NULL DEFERRABLE,
+  woff2_file_id uuid NULL REFERENCES storage_object(id) ON DELETE SET NULL DEFERRABLE
+);
+
+CREATE INDEX team_font_variant_team_id_font_id_idx
+    ON team_font_variant (team_id, font_id);
+
+CREATE INDEX team_font_variant_profile_id_idx
+    ON team_font_variant (profile_id);
+
+CREATE INDEX team_font_variant_otf_file_id_idx
+    ON team_font_variant (otf_file_id);
+
+CREATE INDEX team_font_variant_ttf_file_id_idx
+    ON team_font_variant (ttf_file_id);
+
+CREATE INDEX team_font_variant_woff1_file_id_idx
+    ON team_font_variant (woff1_file_id);
+
+CREATE INDEX team_font_variant_woff2_file_id_idx
+    ON team_font_variant (woff2_file_id);
+
+ALTER TABLE team_font_variant
+  ALTER COLUMN font_family SET STORAGE external,
+  ALTER COLUMN font_style SET STORAGE external;
+

backend/src/app/migrations/sql/0054-add-audit-log-table.sql

@@ -0,0 +1,25 @@
+CREATE TABLE audit_log (
+   id uuid NOT NULL DEFAULT uuid_generate_v4(),
+
+   name text NOT NULL,
+   type text NOT NULL,
+
+   created_at timestamptz DEFAULT clock_timestamp() NOT NULL,
+   archived_at timestamptz NULL,
+
+   profile_id uuid NOT NULL,
+   props jsonb,
+
+   PRIMARY KEY (created_at, profile_id)
+) PARTITION BY RANGE (created_at);
+
+ALTER TABLE audit_log
+  ALTER COLUMN name SET STORAGE external,
+  ALTER COLUMN type SET STORAGE external,
+  ALTER COLUMN props SET STORAGE external;
+
+CREATE INDEX audit_log_id_archived_at_idx ON audit_log (id, archived_at);
+
+CREATE TABLE audit_log_default (LIKE audit_log INCLUDING ALL);
+
+ALTER TABLE audit_log ATTACH PARTITION audit_log_default DEFAULT;

backend/src/app/migrations/sql/0055-mod-file-media-object-table.sql

@@ -0,0 +1,4 @@
+ALTER TABLE file_media_object
+ DROP CONSTRAINT file_media_object_thumbnail_id_fkey,
+  ADD CONSTRAINT file_media_object_thumbnail_id_fkey
+      FOREIGN KEY (thumbnail_id) REFERENCES storage_object (id) ON DELETE SET NULL;

backend/src/app/migrations/sql/0056-add-missing-index-on-deleted-at.sql

@@ -0,0 +1,15 @@
+CREATE INDEX profile_deleted_at_idx
+    ON profile(deleted_at, id)
+ WHERE deleted_at IS NOT NULL;
+
+CREATE INDEX project_deleted_at_idx
+    ON project(deleted_at, id)
+ WHERE deleted_at IS NOT NULL;
+
+CREATE INDEX team_deleted_at_idx
+    ON team(deleted_at, id)
+ WHERE deleted_at IS NOT NULL;
+
+CREATE INDEX team_font_variant_deleted_at_idx
+    ON team_font_variant(deleted_at, id)
+ WHERE deleted_at IS NOT NULL;

backend/src/app/migrations/sql/0057-del-profile-on-delete-trigger.sql

@@ -0,0 +1,2 @@
+DROP TRIGGER profile__on_delete__tgr ON profile CASCADE;
+DROP FUNCTION on_delete_profile ();

backend/src/app/migrations/sql/0058-del-team-on-delete-trigger.sql

@@ -0,0 +1,2 @@
+DROP TRIGGER team__on_delete__tgr ON team CASCADE;
+DROP FUNCTION on_delete_team ();

backend/src/app/migrations/sql/0059-mod-audit-log-table.sql

@@ -0,0 +1,2 @@
+ALTER TABLE audit_log
+  ADD COLUMN ip_addr inet NULL;

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

@@ -0,0 +1,2 @@
+ALTER TABLE file_change
+ALTER COLUMN data DROP NOT NULL;

backend/src/app/migrations/sql/0061-mod-file-table.sql

@@ -0,0 +1,10 @@
+CREATE INDEX IF NOT EXISTS file__modified_at__with__data__idx
+    ON file (modified_at, id)
+ WHERE data IS NOT NULL;
+
+ALTER TABLE file
+  ADD COLUMN data_backend text NULL,
+ALTER COLUMN data_backend SET STORAGE EXTERNAL;
+
+DROP TRIGGER file_on_update_tgr ON file;
+DROP FUNCTION handle_file_update ();

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

@@ -0,0 +1,8 @@
+-- Fix problem with content-type inconherence
+
+UPDATE storage_object so
+SET metadata = jsonb_set(metadata, '{~:content-type}', to_jsonb(fmo.mtype))
+FROM file_media_object fmo
+WHERE so.id = fmo.media_id and
+      so.metadata->>'~:content-type' != fmo.mtype;
+

backend/src/app/msgbus.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) 2021 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.msgbus
   "The msgbus abstraction implemented using redis as underlying backend."
@@ -14,16 +11,17 @@
    [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]
-   [clojure.tools.logging :as log]
    [integrant.core :as ig]
    [promesa.core :as p])
   (:import
    java.time.Duration
    io.lettuce.core.RedisClient
    io.lettuce.core.RedisURI
+   io.lettuce.core.api.StatefulConnection
    io.lettuce.core.api.StatefulRedisConnection
    io.lettuce.core.api.async.RedisAsyncCommands
    io.lettuce.core.codec.ByteArrayCodec
@@ -33,56 +31,50 @@
    io.lettuce.core.pubsub.StatefulRedisPubSubConnection
    io.lettuce.core.pubsub.api.async.RedisPubSubAsyncCommands))
 
-(declare impl-publish-loop)
-(declare impl-redis-pub)
-(declare impl-redis-sub)
-(declare impl-redis-unsub)
-(declare impl-subscribe-loop)
+(def ^:private prefix (cfg/get :tenant))
 
+(defn- prefix-topic
+  [topic]
+  (str prefix "." topic))
 
-;; --- STATE INIT: Publisher
+(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 ::uri ::us/string)
+(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 :req-un [::uri]
-          :opt-un [::buffer-size]))
+  (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 [uri buffer-size] :as cfg}]
-  (let [codec    (RedisCodec/of StringCodec/UTF8 ByteArrayCodec/INSTANCE)
-
-        uri      (RedisURI/create uri)
-        rclient  (RedisClient/create ^RedisURI uri)
-
-        snd-conn (.connect ^RedisClient rclient ^RedisCodec codec)
-        rcv-conn (.connectPubSub ^RedisClient rclient ^RedisCodec codec)
+  [_ {: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-chan (a/chan (a/dropping-buffer buffer-size))
-
-        ;; Channel used for receive data from redis
-        rcv-chan (a/chan (a/dropping-buffer buffer-size))
+        pub-ch  (-> (a/dropping-buffer buffer-size)
+                    (a/chan xform-topic))
 
         ;; Channel used for receive subscription requests.
-        sub-chan (a/chan)
-        cch      (a/chan 1)]
+        sub-ch  (a/chan 1 xform-topics)
 
-    (.setTimeout ^StatefulRedisConnection snd-conn ^Duration (dt/duration {:seconds 10}))
-    (.setTimeout ^StatefulRedisPubSubConnection rcv-conn ^Duration (dt/duration {:seconds 10}))
+        cfg     (-> cfg
+                    (assoc ::pub-ch pub-ch)
+                    (assoc ::sub-ch sub-ch))]
 
-    (log/debugf "initializing msgbus (uri: '%s')" (str uri))
-
-    ;; Start the sending (publishing) loop
-    (impl-publish-loop snd-conn pub-chan cch)
-
-    ;; Start the receiving (subscribing) loop
-    (impl-subscribe-loop rcv-conn rcv-chan sub-chan cch)
+    (init-pub-loop cfg)
+    (init-sub-loop cfg)
 
     (with-meta
       (fn run
@@ -90,159 +82,220 @@
         ([command params]
          (a/go
            (case command
-             :pub (a/>! pub-chan params)
-             :sub (a/>! sub-chan params)))))
-
-      {::snd-conn snd-conn
-       ::rcv-conn rcv-conn
-       ::cch cch
-       ::pub-chan pub-chan
-       ::rcv-chan rcv-chan})))
+             :pub (a/>! pub-ch params)
+             :sub (a/>! sub-ch params)))))
+      cfg)))
 
 (defmethod ig/halt-key! ::msgbus
   [_ f]
   (let [mdata (meta f)]
-    (.close ^StatefulRedisConnection (::snd-conn mdata))
-    (.close ^StatefulRedisPubSubConnection (::rcv-conn mdata))
-    (a/close! (::cch mdata))
-    (a/close! (::pub-chan mdata))
-    (a/close! (::rcv-chan mdata))))
+    (stop-backend mdata)
+    (a/close! (::pub-ch mdata))
+    (a/close! (::sub-ch mdata))))
 
-(defn- impl-publish-loop
-  [conn pub-chan cch]
-  (let [rac (.async ^StatefulRedisConnection conn)]
+;; --- 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-open?)
+(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 []
-      (let [[val _] (a/alts! [cch pub-chan] :priority true)]
-        (when (some? val)
-          (let [result (a/<! (impl-redis-pub rac val))]
-            (when (ex/exception? result)
-              (log/error result "unexpected error on publish message to redis")))
-          (recur))))))
+      (when-let [val (a/<! pub-ch)]
+        (let [result (a/<! (impl-redis-pub rac val))]
+          (when (and (impl-redis-open? pub-conn)
+                     (ex/exception? result))
+            (l/error :cause result
+                     :hint "unexpected error on publish message to redis")))
+        (recur)))))
 
-(defn- impl-subscribe-loop
-  [conn rcv-chan sub-chan cch]
-  ;; Add a unique listener to connection
-  (.addListener 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-chan val)
-                             (log/warn "dropping message on subscription loop"))))
-                       (psubscribed [it pattern count])
-                       (punsubscribed [it pattern count])
-                       (subscribed [it topic count])
-                       (unsubscribed [it topic count])))
+(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)]
 
-  (let [chans   (agent {} :error-handler #(log/error % "unexpected error on agent"))
-        tprefix (str (cfg/get :tenant) ".")
+    ;; 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])))
 
-        subscribe-to-single-topic
-        (fn [nsubs topic chan]
-          (let [nsubs (if (nil? nsubs) #{chan} (conj nsubs chan))]
-            (when (= 1 (count nsubs))
-              (let [result (a/<!! (impl-redis-sub conn topic))]
-                (log/tracef "opening subscription to %s" topic)
-                (when (ex/exception? result)
-                  (log/errorf result "unexpected exception on subscribing to '%s'" topic))))
-            nsubs))
+    (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
-        (fn [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)))
+            (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
-        (fn [nsubs topic chan]
-          (let [nsubs (disj nsubs chan)]
-            (when (empty? nsubs)
-              (let [result (a/<!! (impl-redis-unsub conn topic))]
-                (log/tracef "closing subscription to %s" topic)
-                (when (ex/exception? result)
-                  (log/errorf result "unexpected exception on unsubscribing from '%s'" topic))))
-            nsubs))
+            (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 (and (impl-redis-open? sub-conn)
+                               (ex/exception? result))
+                      (l/error :cause result
+                               :hint "unexpected exception on unsubscribing"
+                               :topic topic))))
+                nsubs))
 
-        unsubscribe-channels
-        (fn [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))]
+            (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; terminates when sub-chan is
-    ;; closed.
-    (a/go-loop []
-      (when-let [{:keys [topics chan]} (a/<! sub-chan)]
-        (let [topics (into #{} (map #(str tprefix %)) topics)]
-          (send-off chans subscribe-to-topics topics chan)
-          (recur))))
-
-    (a/go-loop []
-      (let [[val port] (a/alts! [cch rcv-chan])]
-        (cond
-          ;; Stop condition; close all underlying subscriptions and
-          ;; exit. The close operation is performed asynchronously.
-          (= port cch)
-          (send-off chans (fn [state]
-                            (log/tracef "close")
-                            (->> (vals state)
-                                 (mapcat identity)
-                                 (filter some?)
-                                 (run! a/close!))))
+      ;; 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.
-          (= port rcv-chan)
-          (let [topic   (:topic val)    ; topic is already string
-                pending (loop [chans   (seq (get-in @chans [:topics topic]))
+          (let [pending (loop [chans   (seq (get-in @chans [:topics topic]))
                                pending #{}]
                           (if-let [ch (first chans)]
-                            (if (a/>! ch (:message val))
+                            (if (a/>! ch message)
                               (recur (rest chans) pending)
                               (recur (rest chans) (conj pending ch)))
                             pending))]
-            ;; (log/tracef "received message => pending: %s" (pr-str pending))
             (some->> (seq pending)
                      (send-off chans unsubscribe-channels))
 
-            (recur)))))))
+            (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-open?
+  [^StatefulConnection conn]
+  (.isOpen conn))
 
 (defn- impl-redis-pub
-  [rac {:keys [topic message]}]
-  (let [topic   (str (cfg/get :tenant) "." topic)
-        message (blob/encode message)
+  [^RedisAsyncCommands rac {:keys [topic message]}]
+  (let [message (blob/encode message)
         res     (a/chan 1)]
-    (-> (.publish ^RedisAsyncCommands rac ^String topic ^bytes message)
+    (-> (.publish rac ^String topic ^bytes message)
         (p/finally (fn [_ e]
                      (when e (a/>!! res e))
                      (a/close! res))))
     res))
 
 (defn impl-redis-sub
-  [conn topic]
-  (let [^RedisPubSubAsyncCommands cmd (.async ^StatefulRedisPubSubConnection conn)
-        res (a/chan 1)]
-    (-> (.subscribe cmd (into-array String [topic]))
+  [^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
-  [conn topic]
-  (let [^RedisPubSubAsyncCommands cmd (.async ^StatefulRedisPubSubConnection conn)
-        res (a/chan 1)]
-    (-> (.unsubscribe cmd (into-array String [topic]))
+  [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))))

backend/src/app/notifications.clj

@@ -2,31 +2,26 @@
 ;; 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."
   (:require
    [app.common.spec :as us]
+   [app.common.transit :as t]
    [app.db :as db]
    [app.metrics :as mtx]
    [app.util.async :as aa]
+   [app.util.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]]
    [ring.middleware.keyword-params :refer [wrap-keyword-params]]
-   [ring.middleware.params :refer [wrap-params]])
-  (:import
-   org.eclipse.jetty.websocket.api.WebSocketAdapter))
+   [ring.middleware.params :refer [wrap-params]]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Http Handler
@@ -55,7 +50,7 @@
 
         mtx-messages
         (mtx/create
-         {:name "websocket_message_count"
+         {:name "websocket_message_total"
           :registry (:registry metrics)
           :labels ["op"]
           :type :counter
@@ -151,7 +146,7 @@
                                   :out-ch out-ch
                                   :sub-ch sub-ch)]
 
-                (log/tracef "on-connect %s" (:session-id cfg))
+                (l/trace :event "connect" :session (:session-id cfg))
 
                 ;; Forward all messages from out-ch to the websocket
                 ;; connection
@@ -165,26 +160,30 @@
                   ;; 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/diff created-at (dt/now))) 1000.0))
+
+                  ;; close subscription
                   (a/close! sub-ch))))
 
-            (on-error [_conn e]
-              (mtx-aconn :dec)
-              (mtx-sessions :observe (/ (inst-ms (dt/duration-between created-at (dt/now))) 1000.0))
-              (log/tracef "on-error %s (%s)" (:session-id cfg) (ex-message e))
+            (on-error [_conn _e]
+              (l/trace :event "error" :session (:session-id cfg))
+
               (a/close! out-ch)
               (a/close! rcv-ch))
 
             (on-close [_conn _status _reason]
-              (mtx-aconn :dec)
-              (mtx-sessions :observe (/ (inst-ms (dt/duration-between created-at (dt/now))) 1000.0))
-              (log/tracef "on-close %s" (:session-id cfg))
+              (l/trace :event "close" :session (:session-id cfg))
+
               (a/close! out-ch)
               (a/close! rcv-ch))
 
             (on-message [_ws message]
               (let [message (t/decode-str message)]
                 (when-not (a/offer! rcv-ch message)
-                  (log/warn "droping ws input message, channe full"))))]
+                  (l/warn :msg "drop messages"))))]
 
       {:on-connect on-connect
        :on-error on-error
@@ -194,100 +193,58 @@
 
 ;; --- CONNECTION INIT
 
+(declare send-presence)
 (declare handle-message)
 (declare start-loop!)
 
 (defn- handle-connect
-  [{:keys [conn] :as cfg}]
+  [cfg]
   (a/go
-    (try
-      (aa/<? (handle-message cfg {:type :connect}))
-      (aa/<? (start-loop! cfg))
-      (aa/<? (handle-message cfg {:type :disconnect}))
-      (catch Throwable err
-        (log/errorf err "unexpected exception on websocket handler")
-        (let [session (.getSession ^WebSocketAdapter 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 [rcv-ch out-ch sub-ch session-id] :as cfg}]
-  (aa/go-try
-   (loop []
-     (let [timeout    (a/timeout 30000)
-           [val port] (a/alts! [rcv-ch sub-ch timeout])]
+  (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))
 
-       (cond
-         ;; Process message coming from connected client
-         (and (= port rcv-ch) (some? val))
-         (do
-           (aa/<? (handle-message cfg val))
-           (recur))
+        ;; Process message coming from pubsub.
+        (and (= port sub-ch) (some? val))
+        (do
+          (when-not (= (:session-id val) session-id)
+            ;; If we receive a connect message of other user, we need
+            ;; to send an update presence to all participants.
+            (when (= :connect (:type val))
+              (a/<! (send-presence cfg :presence)))
 
-         ;; If message comes from subscription channel; we just need
-         ;; to foreward it to the output channel.
-         (and (= port sub-ch) (some? val))
-         (do
-           (when-not (= (:session-id val) session-id)
-             (a/>! out-ch val))
-           (recur))
+            ;; Then, just forward the message
+            (a/>! out-ch val))
+          (recur))
 
-         ;; When timeout channel is signaled, we need to send a ping
-         ;; message to the output channel. TODO: we need to make this
-         ;; more smart.
-         (= port timeout)
-         (do
-           (a/>! out-ch {:type :ping})
-           (recur))
+        ;; 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))))))
 
-         :else
-         nil)))))
-
-;; --- PRESENCE HANDLING API
-
-(def ^:private
-  sql:retrieve-presence
-  "select * from presence
-    where file_id=?
-      and (clock_timestamp() - updated_at) < '5 min'::interval")
-
-(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- retrieve-presence
-  [{:keys [pool file-id] :as cfg}]
-  (let [rows (db/exec! pool [sql:retrieve-presence file-id])]
-    (mapv (juxt :session-id :profile-id) rows)))
-
-(defn- retrieve-presence*
-  [{:keys [executor] :as cfg}]
-  (aa/with-thread executor
-    (retrieve-presence cfg)))
-
-(defn- update-presence
-  [{:keys [pool file-id session-id profile-id] :as cfg}]
-  (let [sql [sql:update-presence file-id session-id profile-id]]
-    (db/exec-one! pool sql)))
-
-(defn- update-presence*
-  [{:keys [executor] :as cfg}]
-  (aa/with-thread executor
-    (update-presence cfg)))
-
-(defn- delete-presence
-  [{:keys [pool file-id session-id profile-id] :as cfg}]
-  (db/delete! pool :presence {:file-id file-id
-                              :profile-id profile-id
-                              :session-id session-id}))
-
-(defn- delete-presence*
-  [{:keys [executor] :as cfg}]
-  (aa/with-thread executor
-    (delete-presence cfg)))
+(defn send-presence
+  ([cfg] (send-presence cfg :presence))
+  ([{:keys [msgbus session-id profile-id file-id]} type]
+   (a/go
+     (a/<! (msgbus :pub {:topic file-id
+                         :message {:type type
+                                   :session-id session-id
+                                   :profile-id profile-id}})))))
 
 ;; --- INCOMING MSG PROCESSING
 
@@ -295,26 +252,16 @@
   (fn [_ message] (:type message)))
 
 (defmethod handle-message :connect
-  [{:keys [file-id msgbus] :as cfg} _message]
-  ;; (log/debugf "profile '%s' is connected to file '%s'" profile-id file-id)
-  (aa/go-try
-   (aa/<? (update-presence* cfg))
-   (let [members (aa/<? (retrieve-presence* cfg))
-         val     {:topic file-id :message {:type :presence :sessions members}}]
-     (a/<! (msgbus :pub val)))))
+  [cfg _]
+  (send-presence cfg :connect))
 
 (defmethod handle-message :disconnect
-  [{:keys [file-id msgbus] :as cfg} _message]
-  ;; (log/debugf "profile '%s' is disconnected from '%s'" profile-id file-id)
-  (aa/go-try
-   (aa/<? (delete-presence* cfg))
-   (let [members (aa/<? (retrieve-presence* cfg))
-         val     {:topic file-id :message {:type :presence :sessions members}}]
-     (a/<! (msgbus :pub val)))))
+  [cfg _]
+  (send-presence cfg :disconnect))
 
 (defmethod handle-message :keepalive
-  [cfg _message]
-  (update-presence* cfg))
+  [_ _]
+  (a/go :nothing))
 
 (defmethod handle-message :pointer-update
   [{:keys [profile-id file-id session-id msgbus] :as cfg} message]
@@ -327,5 +274,7 @@
 (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/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)."
@@ -21,6 +18,7 @@
 
 (derive ::password ::instance)
 (derive ::image ::instance)
+(derive ::font ::instance)
 
 (defmethod ig/pre-init-spec ::instance [_]
   (s/spec int?))

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
@@ -13,11 +10,12 @@
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.db :as db]
+   [app.loggers.audit :as audit]
    [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]))
 
@@ -33,25 +31,35 @@
 (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   (merge (:params request)
+                      (:body-params request)
+                      (:uploads request)
+                      {::request 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}]
   (let [type   (keyword (get-in request [:path-params :type]))
-        data   (d/merge (:params request)
-                        (:body-params request)
-                        (:uploads request))
+        data   (merge (:params request)
+                      (:body-params request)
+                      (:uploads request)
+                      {::request 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}
@@ -75,23 +83,50 @@
         (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))
 
 (defn- wrap-impl
-  [cfg f mdata]
-  (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))
+  [{:keys [audit] :as cfg} f mdata]
+  (let [f      (wrap-with-rlimits cfg f mdata)
+        f      (wrap-with-metrics cfg f mdata)
+        spec   (or (::sv/spec mdata) (s/spec any?))
+        auth?  (:auth mdata true)]
+
+    (l/trace :action "register" :name (::sv/name mdata))
     (fn [params]
-      (when (and (:auth mdata true) (not (uuid? (:profile-id params))))
+
+      ;; Raise authentication error when rpc method requires auth but
+      ;; no profile-id is found in the request.
+      (when (and auth? (not (uuid? (:profile-id params))))
         (ex/raise :type :authentication
                   :code :authentication-required
                   :hint "authentication required for this endpoint"))
-      (f cfg (us/conform spec params)))))
+
+      (let [params' (dissoc params ::request)
+            params' (us/conform spec params')
+            result  (f cfg params')]
+
+        ;; When audit log is enabled (default false).
+        (when (fn? audit)
+          (let [resultm    (meta result)
+                request    (::request params)
+                profile-id (or (:profile-id params')
+                               (:profile-id result)
+                               (::audit/profile-id resultm))
+                props      (d/merge params (::audit/props resultm))]
+            (audit :cmd :submit
+                   :type (::type cfg)
+                   :name (or (::audit/name resultm)
+                             (::sv/name mdata))
+                   :profile-id profile-id
+                   :ip-addr (audit/parse-client-ip request)
+                   :props (audit/profile->props props))))
+
+        result))))
 
 (defn- process-method
   [cfg vfn]
@@ -107,14 +142,16 @@
                :registry (get-in cfg [:metrics :registry])
                :type :histogram
                :help "Timing of query services."})
-        cfg  (assoc cfg ::mobj mobj)]
+        cfg  (assoc cfg ::mobj mobj ::type "query")]
     (->> (sv/scan-ns 'app.rpc.queries.projects
                      'app.rpc.queries.files
                      'app.rpc.queries.teams
                      'app.rpc.queries.comments
                      'app.rpc.queries.profile
                      'app.rpc.queries.recent-files
-                     'app.rpc.queries.viewer)
+                     'app.rpc.queries.viewer
+                     'app.rpc.queries.fonts
+                     'app.rpc.queries.svg)
          (map (partial process-method cfg))
          (into {}))))
 
@@ -126,7 +163,7 @@
                :registry (get-in cfg [:metrics :registry])
                :type :histogram
                :help "Timing of mutation services."})
-        cfg  (assoc cfg ::mobj mobj)]
+        cfg  (assoc cfg ::mobj mobj ::type "mutation")]
     (->> (sv/scan-ns 'app.rpc.mutations.demo
                      'app.rpc.mutations.media
                      'app.rpc.mutations.profile
@@ -135,7 +172,9 @@
                      'app.rpc.mutations.projects
                      'app.rpc.mutations.viewer
                      'app.rpc.mutations.teams
+                     'app.rpc.mutations.management
                      'app.rpc.mutations.ldap
+                     'app.rpc.mutations.fonts
                      'app.rpc.mutations.verify-token)
          (map (partial process-method cfg))
          (into {}))))
@@ -143,9 +182,11 @@
 (s/def ::storage some?)
 (s/def ::session map?)
 (s/def ::tokens fn?)
+(s/def ::audit (s/nilable fn?))
 
 (defmethod ig/pre-init-spec ::rpc [_]
-  (s/keys :req-un [::db/pool ::storage ::session ::tokens ::mtx/metrics ::rlm/rlimits]))
+  (s/keys :req-un [::storage ::session ::tokens ::audit
+                   ::mtx/metrics ::rlm/rlimits ::db/pool]))
 
 (defmethod ig/init-key ::rpc
   [_ cfg]

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-2021 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.rpc.mutations.demo
   "A demo specific mutations."
@@ -14,10 +11,11 @@
    [app.common.uuid :as uuid]
    [app.config :as cfg]
    [app.db :as db]
+   [app.loggers.audit :as audit]
    [app.rpc.mutations.profile :as profile]
    [app.setup.initial-data :as sid]
-   [app.tasks :as tasks]
    [app.util.services :as sv]
+   [app.util.time :as dt]
    [buddy.core.codecs :as bc]
    [buddy.core.nonce :as bn]
    [clojure.spec.alpha :as s]))
@@ -37,10 +35,11 @@
                   :email email
                   :fullname fullname
                   :is-demo true
+                  :deleted-at (dt/in-future cfg/deletion-delay)
                   :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."))
@@ -50,10 +49,6 @@
            (#'profile/create-profile-relations 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}})
-
-      {:email email
-       :password password})))
+      (with-meta {:email email
+                  :password password}
+        {::audit/profile-id id}))))

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
@@ -14,16 +11,18 @@
    [app.common.pages.migrations :as pmg]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
-   [app.config :as cfg]
    [app.db :as db]
+   [app.rpc.permissions :as perms]
    [app.rpc.queries.files :as files]
    [app.rpc.queries.projects :as proj]
-   [app.tasks :as tasks]
+   [app.storage.impl :as simpl]
    [app.util.blob :as blob]
    [app.util.services :as sv]
    [app.util.time :as dt]
    [clojure.spec.alpha :as s]))
 
+(declare create-file)
+
 ;; --- Helpers & Specs
 
 (s/def ::id ::us/uuid)
@@ -34,8 +33,6 @@
 
 ;; --- Mutation: Create File
 
-(declare create-file)
-
 (s/def ::is-shared ::us/boolean)
 (s/def ::create-file
   (s/keys :req-un [::profile-id ::name ::project-id]
@@ -47,31 +44,32 @@
     (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]
-         :or {is-shared false}
+  [conn {:keys [id name project-id is-shared data deleted-at]
+         :or {is-shared false
+              deleted-at nil}
          :as params}]
-  (let [id   (or id (uuid/next))
-        data (cp/make-file-data id)
+  (let [id   (or id (:id data) (uuid/next))
+        data (or data (cp/make-file-data id))
         file (db/insert! conn :file
                          {:id id
                           :project-id project-id
                           :name name
                           :is-shared is-shared
-                          :data (blob/encode data)})]
-    (->> (assoc params :file-id id)
-         (create-file-profile conn))
-    (assoc file :data data)))
+                          :data (blob/encode data)
+                          :deleted-at deleted-at})]
 
+    (->> (assoc params :file-id id :role :owner)
+         (create-file-role conn))
+
+    (assoc file :data data)))
 
 ;; --- Mutation: Rename File
 
@@ -112,7 +110,6 @@
               {:is-shared is-shared}
               {:id id}))
 
-
 ;; --- Mutation: Delete File
 
 (declare mark-file-deleted)
@@ -125,11 +122,6 @@
   (db/with-atomic [conn pool]
     (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}})
-
     (mark-file-deleted conn params)))
 
 (defn mark-file-deleted
@@ -176,7 +168,7 @@
   (s/keys :req-un [::profile-id ::file-id ::library-id]))
 
 (sv/defmethod ::unlink-file-from-library
-  [{:keys [pool] :as cfg} {:keys [profile-id file-id library-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id file-id)
     (unlink-file-from-library conn params)))
@@ -196,7 +188,7 @@
   (s/keys :req-un [::profile-id ::file-id ::library-id]))
 
 (sv/defmethod ::update-sync
-  [{:keys [pool] :as cfg} {:keys [profile-id file-id library-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id file-id)
     (update-sync conn params)))
@@ -208,7 +200,6 @@
               {:file-id file-id
                :library-file-id library-id}))
 
-
 ;; --- Mutation: Ignore updates in linked files
 
 (declare ignore-sync)
@@ -217,7 +208,7 @@
   (s/keys :req-un [::profile-id ::file-id ::date]))
 
 (sv/defmethod ::ignore-sync
-  [{:keys [pool] :as cfg} {:keys [profile-id file-id date] :as params}]
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id file-id)
     (ignore-sync conn params)))
@@ -229,16 +220,10 @@
               {:id file-id}))
 
 
+;; --- MUTATION: update-file
+
 ;; A generic, Changes based (granular) file update method.
 
-(s/def ::changes
-  (s/coll-of map? :kind vector?))
-
-(s/def ::session-id ::us/uuid)
-(s/def ::revn ::us/integer)
-(s/def ::update-file
-  (s/keys :req-un [::id ::session-id ::profile-id ::revn ::changes]))
-
 ;; File changes that affect to the library, and must be notified
 ;; to all clients using it.
 (defn library-change?
@@ -257,57 +242,133 @@
 (declare send-notifications)
 (declare update-file)
 
+(s/def ::changes
+  (s/coll-of map? :kind vector?))
+
+(s/def ::hint-origin ::us/keyword)
+(s/def ::hint-events
+  (s/every ::us/keyword :kind vector?))
+
+(s/def ::change-with-metadata
+  (s/keys :req-un [::changes]
+          :opt-un [::hint-origin
+                   ::hint-events]))
+
+(s/def ::changes-with-metadata
+  (s/every ::change-with-metadata :kind vector?))
+
+(s/def ::session-id ::us/uuid)
+(s/def ::revn ::us/integer)
+(s/def ::update-file
+  (s/and
+   (s/keys :req-un [::id ::session-id ::profile-id ::revn]
+           :opt-un [::changes ::changes-with-metadata])
+   (fn [o]
+     (or (contains? o :changes)
+         (contains? o :changes-with-metadata)))))
+
 (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})]
+    (db/xact-lock! conn id)
+    (let [{:keys [id] :as file} (db/get-by-id conn :file id {:for-key-share true})]
       (files/check-edition-permissions! conn profile-id id)
       (update-file (assoc cfg :conn  conn)
                    (assoc params :file file)))))
 
+(defn- take-snapshot?
+  "Defines the rule when file `data` snapshot should be saved."
+  [{:keys [revn modified-at] :as file}]
+  ;; The snapshot will be saved every 20 changes or if the last
+  ;; modification is older than 3 hour.
+  (or (zero? (mod revn 20))
+      (> (inst-ms (dt/diff modified-at (dt/now)))
+         (inst-ms (dt/duration {:hours 3})))))
+
+(defn- delete-from-storage
+  [{:keys [storage] :as cfg} file]
+  (when-let [backend (simpl/resolve-backend storage (:data-backend file))]
+    (simpl/del-object backend file)))
+
 (defn- update-file
-  [{:keys [conn] :as cfg} {:keys [file changes session-id profile-id] :as params}]
+  [{:keys [conn] :as cfg} {:keys [file changes changes-with-metadata session-id profile-id] :as params}]
   (when (> (:revn params)
            (:revn file))
+
     (ex/raise :type :validation
               :code :revn-conflict
               :hint "The incoming revision number is greater that stored version."
               :context {:incoming-revn (:revn params)
                         :stored-revn (:revn file)}))
 
-  (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)))))]
+  (let [changes (if changes-with-metadata
+                  (mapcat :changes changes-with-metadata)
+                  changes)
+
+        ts      (dt/now)
+        file    (-> (files/retrieve-data cfg 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
+                 :created-at ts
                  :file-id (:id file)
                  :revn (:revn file)
-                 :data (:data file)
+                 :data (when (take-snapshot? file)
+                         (:data file))
                  :changes (blob/encode changes)})
 
     ;; Update file
     (db/update! conn :file
                 {:revn (:revn file)
                  :data (:data file)
+                 :data-backend nil
+                 :modified-at ts
                  :has-media-trimmed false}
                 {:id (:id file)})
 
-    (let [params (assoc params :file file)]
+    ;; We need to delete the data from external storage backend
+    (when-not (nil? (:data-backend file))
+      (delete-from-storage cfg file))
+
+    (db/update! conn :project
+                {:modified-at ts}
+                {:id (:project-id file)})
+
+    (let [params (assoc params :file file :changes changes)]
       ;; Send asynchronous notifications
       (send-notifications cfg params)
 
       ;; Retrieve and return lagged data
       (retrieve-lagged-changes conn params))))
 
+(def ^:private
+  sql:lagged-changes
+  "select s.id, s.revn, s.file_id,
+          s.session_id, s.changes
+     from file_change as s
+    where s.file_id = ?
+      and s.revn > ?
+    order by s.created_at asc")
+
+(defn- retrieve-lagged-changes
+  [conn params]
+  (->> (db/exec! conn [sql:lagged-changes (:id params) (:revn params)])
+       (into [] (comp (map files/decode-row)
+                      (map (fn [row]
+                             (cond-> row
+                               (= (:revn row) (:revn (:file params)))
+                               (assoc :changes []))))))))
+
 (defn- send-notifications
   [{:keys [msgbus conn] :as cfg} {:keys [file changes session-id] :as params}]
   (let [lchanges (filter library-change? changes)]
@@ -339,17 +400,24 @@
   [conn project-id]
   (:team-id (db/get-by-id conn :project project-id {:columns [:team-id]})))
 
-(def ^:private
-  sql:lagged-changes
-  "select s.id, s.revn, s.file_id,
-          s.session_id, s.changes
-     from file_change as s
-    where s.file_id = ?
-      and s.revn > ?
-    order by s.created_at asc")
 
-(defn- retrieve-lagged-changes
-  [conn params]
-  (->> (db/exec! conn [sql:lagged-changes (:id params) (:revn params)])
-       (mapv files/decode-row)))
+;; TEMPORARY FILE CREATION
 
+(s/def ::create-temp-file ::create-file)
+
+(sv/defmethod ::create-temp-file
+  [{:keys [pool] :as cfg} {:keys [profile-id project-id] :as params}]
+  (db/with-atomic [conn pool]
+    (proj/check-edition-permissions! conn profile-id project-id)
+    (create-file conn (assoc params :deleted-at (dt/in-future {:days 1})))))
+
+(s/def ::persist-temp-file
+  (s/keys :req-un [::id ::profile-id]))
+
+(sv/defmethod ::persist-temp-file
+  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+  (db/with-atomic [conn pool]
+    (files/check-edition-permissions! conn profile-id id)
+    (db/update! conn :file
+                {:deleted-at nil}
+                {:id id})))

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

@@ -0,0 +1,142 @@
+;; 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.fonts
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.common.uuid :as uuid]
+   [app.config :as cf]
+   [app.db :as db]
+   [app.media :as media]
+   [app.rpc.queries.teams :as teams]
+   [app.storage :as sto]
+   [app.util.services :as sv]
+   [app.util.time :as dt]
+   [app.worker :as wrk]
+   [clojure.spec.alpha :as s]))
+
+(declare create-font-variant)
+
+(def valid-weight #{100 200 300 400 500 600 700 800 900 950})
+(def valid-style #{"normal" "italic"})
+
+(s/def ::id ::us/uuid)
+(s/def ::profile-id ::us/uuid)
+(s/def ::team-id ::us/uuid)
+(s/def ::name ::us/not-empty-string)
+(s/def ::weight valid-weight)
+(s/def ::style valid-style)
+(s/def ::font-id ::us/uuid)
+(s/def ::content-type ::media/font-content-type)
+(s/def ::data (s/map-of ::us/string any?))
+
+(s/def ::create-font-variant
+  (s/keys :req-un [::profile-id ::team-id ::data
+                   ::font-id ::font-family ::font-weight ::font-style]))
+
+(sv/defmethod ::create-font-variant
+  [{:keys [pool] :as cfg} {:keys [team-id profile-id] :as params}]
+  (db/with-atomic [conn pool]
+    (let [cfg (assoc cfg :conn conn)]
+      (teams/check-edition-permissions! conn profile-id team-id)
+      (create-font-variant cfg params))))
+
+(defn create-font-variant
+  [{:keys [conn storage] :as cfg} {:keys [data] :as params}]
+  (let [data    (media/run cfg {:cmd :generate-fonts :input data :rlimit :font})
+        storage (media/configure-assets-storage storage conn)
+
+
+        otf     (when-let [fdata (get data "font/otf")]
+                  (sto/put-object storage {:content (sto/content fdata)
+                                           :content-type "font/otf"}))
+
+        ttf     (when-let [fdata (get data "font/ttf")]
+                  (sto/put-object storage {:content (sto/content fdata)
+                                           :content-type "font/ttf"}))
+
+        woff1   (when-let [fdata (get data "font/woff")]
+                  (sto/put-object storage {:content (sto/content fdata)
+                                           :content-type "font/woff"}))
+
+        woff2   (when-let [fdata (get data "font/woff2")]
+                  (sto/put-object storage {:content (sto/content fdata)
+                                           :content-type "font/woff2"}))]
+
+    (when (and (nil? otf)
+               (nil? ttf)
+               (nil? woff1)
+               (nil? woff2))
+      (ex/raise :type :validation
+                :code :invalid-font-upload))
+
+    (db/insert! conn :team-font-variant
+                {:id (uuid/next)
+                 :team-id (:team-id params)
+                 :font-id (:font-id params)
+                 :font-family (:font-family params)
+                 :font-weight (:font-weight params)
+                 :font-style (:font-style params)
+                 :woff1-file-id (:id woff1)
+                 :woff2-file-id (:id woff2)
+                 :otf-file-id (:id otf)
+                 :ttf-file-id (:id ttf)})))
+
+;; --- UPDATE FONT FAMILY
+
+(s/def ::update-font
+  (s/keys :req-un [::profile-id ::team-id ::id ::name]))
+
+(def sql:update-font
+  "update team_font_variant
+      set font_family = ?
+    where team_id = ?
+      and font_id = ?")
+
+(sv/defmethod ::update-font
+  [{:keys [pool] :as cfg} {:keys [team-id profile-id id name] :as params}]
+  (db/with-atomic [conn pool]
+    (teams/check-edition-permissions! conn profile-id team-id)
+    (db/exec-one! conn [sql:update-font name team-id id])
+    nil))
+
+;; --- DELETE FONT
+
+(s/def ::delete-font
+  (s/keys :req-un [::profile-id ::team-id ::id]))
+
+(sv/defmethod ::delete-font
+  [{:keys [pool] :as cfg} {:keys [id team-id profile-id] :as params}]
+  (db/with-atomic [conn pool]
+    (teams/check-edition-permissions! conn profile-id team-id)
+
+    (db/update! conn :team-font-variant
+                {:deleted-at (dt/now)}
+                {:font-id id :team-id team-id})
+    nil))
+
+;; --- DELETE FONT VARIANT
+
+(s/def ::delete-font-variant
+  (s/keys :req-un [::profile-id ::team-id ::id]))
+
+(sv/defmethod ::delete-font-variant
+  [{:keys [pool] :as cfg} {:keys [id team-id profile-id] :as params}]
+  (db/with-atomic [conn pool]
+    (teams/check-edition-permissions! conn profile-id team-id)
+
+    ;; Schedule object deletion
+    (wrk/submit! {::wrk/task :delete-object
+                  ::wrk/delay cf/deletion-delay
+                  ::wrk/conn conn
+                  :id id
+                  :type :team-font-variant})
+
+    (db/update! conn :team-font-variant
+                {:deleted-at (dt/now)}
+                {:id id :team-id team-id})
+    nil))

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

@@ -2,41 +2,42 @@
 ;; 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.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.db :as db]
+   [app.loggers.audit :as audit]
+   [app.rpc.mutations.profile :as profile-m]
+   [app.rpc.queries.profile :as profile-q]
    [app.util.services :as sv]
    [clj-ldap.client :as ldap]
    [clojure.spec.alpha :as s]
-   [clojure.string]
-   [clojure.tools.logging :as log]))
+   [clojure.string]))
 
-(def cpool
-  (delay
-    (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
-          (log/errorf e "cannot connect to LDAP %s:%s"
-                      (get-in params [:host :address])
-                      (get-in params [:host :port])))))))
+(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)
+(declare login-or-register)
 
 (s/def ::email ::us/email)
 (s/def ::password ::us/string)
@@ -47,36 +48,37 @@
           :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}]
-  (when-not @cpool
-    (ex/raise :type :restriction
-              :code :ldap-disabled
-              :hint "ldap disabled or unable to connect"))
+  [{:keys [pool session tokens] :as cfg} params]
+  (db/with-atomic [conn pool]
+    (let [info (authenticate params)
+          cfg  (assoc cfg :conn conn)]
 
-  (let [info (authenticate @cpool 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))}))
+      (when-not info
+        (ex/raise :type :validation
+                  :code :wrong-credentials))
 
-        (with-meta profile
-          {:transform-response ((:create session) (:id profile))})))))
+      (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))
+               ::audit/props (:props profile)
+               ::audit/profile-id (:id profile)}))
+
+          (with-meta profile
+            {:transform-response ((:create session) (:id profile))
+             ::audit/props (:props profile)
+             ::audit/profile-id (:id profile)}))))))
 
 (defn- replace-several [s & {:as replacements}]
   (reduce-kv clojure.string/replace s replacements))
@@ -84,7 +86,7 @@
 (defn- get-ldap-user
   [cpool {:keys [email] :as params}]
   (let [query   (-> (cfg/get :ldap-user-query)
-                    (replace-several "$username" email))
+                    (replace-several ":username" email))
 
         attrs   [(cfg/get :ldap-attrs-username)
                  (cfg/get :ldap-attrs-email)
@@ -96,10 +98,25 @@
     (first (ldap/search cpool base-dn params))))
 
 (defn- authenticate
-  [cpool {:keys [password] :as params}]
-  (when-let [{:keys [dn] :as luser} (get-ldap-user cpool params)]
-    (when (ldap/bind? cpool 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"})))
+  [{:keys [password email] :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    email
+         :backend  "ldap"}))))
+
+(defn- login-or-register
+  [{:keys [conn] :as cfg} info]
+  (or (some->> (:email info)
+               (profile-q/retrieve-profile-data-by-email conn)
+               (profile-q/populate-additional-data conn)
+               (profile-q/decode-profile-row))
+      (let [params  (-> info
+                        (assoc :is-active true)
+                        (assoc :is-demo false))]
+        (->> params
+             (profile-m/create-profile conn)
+             (profile-m/create-profile-relations conn)
+             (profile-q/strip-private-attrs)))))

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

@@ -0,0 +1,323 @@
+;; 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 so on (fmo.media_id = so.id)
+    where fmo.file_id = ?
+      and so.deleted_at is null")
+
+(defn duplicate-file
+  [conn {:keys [profile-id file index project-id name flibs fmeds]} {:keys [reset-shared-flag] :as opts}]
+  (let [flibs    (or flibs (db/exec! conn [sql:retrieve-used-libraries (:id file)]))
+        fmeds    (or fmeds (db/exec! conn [sql:retrieve-used-media-objects (:id file)]))
+
+        ;; memo uniform creation/modification date
+        now      (dt/now)
+        ignore   (dt/plus now (dt/duration {:seconds 5}))
+
+        ;; add to the index all file media objects.
+        index    (reduce #(assoc %1 (:id %2) (uuid/next)) index fmeds)
+
+        flibs-xf (comp
+                  (map #(remap-id % index :file-id))
+                  (map #(remap-id % index :library-file-id))
+                  (map #(assoc % :synced-at now))
+                  (map #(assoc % :created-at now)))
+
+        ;; remap all file-library-rel row
+        flibs    (sequence flibs-xf flibs)
+
+        fmeds-xf (comp
+                  (map #(assoc % :id (get index (:id %))))
+                  (map #(assoc % :created-at now))
+                  (map #(remap-id % index :file-id)))
+
+        ;; remap all file-media-object rows
+        fmeds   (sequence fmeds-xf fmeds)
+
+        file    (cond-> file
+                  (some? project-id)
+                  (assoc :project-id project-id)
+
+                  (some? name)
+                  (assoc :name name)
+
+                  (true? reset-shared-flag)
+                  (assoc :is-shared false))
+
+        file    (-> file
+                    (assoc :created-at now)
+                    (assoc :modified-at now)
+                    (assoc :ignore-sync-until ignore)
+                    (update :id #(get index %))
+                    (process-file index))]
+
+    (db/insert! conn :file file)
+    (db/insert! conn :file-profile-rel
+                {:file-id (:id file)
+                 :profile-id profile-id
+                 :is-owner true
+                 :is-admin true
+                 :can-edit true})
+
+    (doseq [params flibs]
+      (db/insert! conn :file-library-rel params))
+
+    (doseq [params fmeds]
+      (db/insert! conn :file-media-object params))
+
+    file))
+
+
+;; --- 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] :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))
+      (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
+      (-> (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] :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))
+      (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
+      (duplicate-project conn (assoc params :project project)))))
+
+(defn duplicate-project
+  [conn {:keys [profile-id project name] :as params}]
+  (let [files   (db/query conn :file
+                          {:project-id (:id project)
+                           :deleted-at nil}
+                          {:columns [:id]})
+
+        project (cond-> project
+                  (string? name)
+                  (assoc :name name)
+
+                  :always
+                  (assoc :id (uuid/next)))]
+
+    ;; create the duplicated project and assign the current profile as
+    ;; a project owner
+    (create-project conn project)
+    (create-project-role conn {:project-id (:id project)
+                               :profile-id profile-id
+                               :role :owner})
+
+    ;; duplicate all files
+    (let [index  (reduce #(assoc %1 (:id %2) (uuid/next)) {} files)
+          params (-> params
+                     (dissoc :name)
+                     (assoc :project-id (:id project))
+                     (assoc :index index))]
+      (doseq [{:keys [id]} files]
+        (let [file   (db/get-by-id conn :file id)
+              params (assoc params :file file)
+              opts   {:reset-shared-flag false}]
+          (duplicate-file conn params opts))))
+
+    ;; return the created project
+    project))
+
+
+;; --- 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
@@ -40,7 +37,9 @@
 (declare create-file-media-object)
 (declare select-file)
 
-(s/def ::content ::media/upload)
+(s/def ::content-type ::media/image-content-type)
+(s/def ::content (s/and ::media/upload (s/keys :req-un [::content-type])))
+
 (s/def ::is-local ::us/boolean)
 
 (s/def ::upload-file-media-object
@@ -92,12 +91,11 @@
 
 
 (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 [id file-id is-local name content] :as params}]
   (media/validate-media-type (:content-type content))
-  (let [storage      (assoc storage :conn conn)
+  (let [storage      (media/configure-assets-storage storage conn)
         source-path  (fs/path (:tempfile content))
         source-mtype (:content-type content)
-
         source-info  (media/run cfg {:cmd :info :input {:path source-path :mtype source-mtype}})
 
         thumb        (when (and (not (svg-image? source-info))
@@ -108,7 +106,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)
@@ -118,7 +116,7 @@
                        (sto/put-object storage {:content (sto/content (:data thumb) (:size thumb))
                                                 :content-type (:mtype thumb)}))]
     (db/insert! conn :file-media-object
-                {:id (uuid/next)
+                {:id (or id (uuid/next))
                  :file-id file-id
                  :is-local is-local
                  :name name

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

@@ -2,26 +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) 2020-2021 UXBOX Labs SL
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.rpc.mutations.profile
   (:require
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
-   [app.config :as cfg]
+   [app.config :as cf]
    [app.db :as db]
-   [app.emails :as emails]
+   [app.emails :as eml]
+   [app.http.oauth :refer [extract-props]]
+   [app.loggers.audit :as audit]
    [app.media :as media]
    [app.rpc.mutations.projects :as projects]
    [app.rpc.mutations.teams :as teams]
    [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]
    [buddy.hashers :as hashers]
@@ -38,101 +36,24 @@
 (s/def ::password ::us/not-empty-string)
 (s/def ::old-password ::us/not-empty-string)
 (s/def ::theme ::us/string)
-
-;; --- Mutation: Register Profile
+(s/def ::invitation-token ::us/not-empty-string)
 
 (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 ::register-profile
-  (s/keys :req-un [::email ::password ::fullname]
-          :opt-un [::invitation-token]))
-
-(sv/defmethod ::register-profile {:auth false :rlimit :password}
-  [{: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? (cfg/get :registration-domain-whitelist) (:email params))
-    (ex/raise :type :validation
-              :code :email-domain-is-not-allowed))
-
-  (db/with-atomic [conn pool]
-    (let [cfg     (assoc cfg :conn conn)]
-      (register-profile cfg params))))
-
-(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))))
-
-(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)]
-
-    (sid/load-initial-project! conn profile)
-
-    (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 [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)})]
-
-        ;; Don't allow proceed in register page if the email is
-        ;; already reported as permanent bounced
-        (when (emails/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"))
-
-        (emails/send! conn emails/register
-                      {: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)
+  "Returns true if email's domain is in the given whitelist or if
+  given whitelist is an empty string."
+  [domains email]
+  (if (or (empty? domains)
+          (nil? domains))
     true
-    (let [domains (str/split whitelist #",\s*")
-          email-domain (second (str/split email #"@"))]
-      (contains? (set domains) email-domain))))
+    (let [[_ candidate] (-> (str/lower email)
+                            (str/split #"@" 2))]
+      (contains? domains candidate))))
 
 (def ^:private sql:profile-existence
   "select exists (select * from profile
@@ -164,27 +85,176 @@
       {:update false
        :valid false})))
 
+(defn decode-profile-row
+  [{:keys [props] :as profile}]
+  (cond-> profile
+    (db/pgobject? props "jsonb")
+    (assoc :props (db/decode-transit-pgobject props))))
+
+;; --- MUTATION: Prepare Register
+
+(s/def ::prepare-register-profile
+  (s/keys :req-un [::email ::password]
+          :opt-un [::invitation-token]))
+
+(sv/defmethod ::prepare-register-profile {:auth false}
+  [{:keys [pool tokens] :as cfg} params]
+  (when-not (cf/get :registration-enabled)
+    (ex/raise :type :restriction
+              :code :registration-disabled))
+
+  (when-let [domains (cf/get :registration-domain-whitelist)]
+    (when-not (email-domain-in-whitelist? domains (:email params))
+      (ex/raise :type :validation
+                :code :email-domain-is-not-allowed)))
+
+  ;; Don't allow proceed in preparing registration if the profile is
+  ;; already reported as spamer.
+  (when (eml/has-bounce-reports? pool (:email params))
+    (ex/raise :type :validation
+              :code :email-has-permanent-bounces
+              :hint "looks like the email has one or many bounces reported"))
+
+  (check-profile-existence! pool params)
+
+  (let [params (assoc params
+                      :backend "penpot"
+                      :iss :prepared-register
+                      :exp (dt/in-future "48h"))
+        token  (tokens :generate params)]
+    {:token token}))
+
+;; --- MUTATION: Register Profile
+
+(s/def ::accept-terms-and-privacy ::us/boolean)
+(s/def ::accept-newsletter-subscription ::us/boolean)
+(s/def ::token ::us/not-empty-string)
+
+(s/def ::register-profile
+  (s/keys :req-un [::token ::fullname
+                   ::accept-terms-and-privacy]
+          :opt-un [::accept-newsletter-subscription]))
+
+(sv/defmethod ::register-profile {:auth false :rlimit :password}
+  [{:keys [pool] :as cfg} params]
+  (when-not (:accept-terms-and-privacy params)
+    (ex/raise :type :validation
+              :code :invalid-terms-and-privacy))
+
+  (db/with-atomic [conn pool]
+    (let [cfg     (assoc cfg :conn conn)]
+      (register-profile cfg params))))
+
+(defn- annotate-profile-register
+  "A helper for properly increase the profile-register metric once the
+  transaction is completed."
+  [metrics]
+  (fn []
+    ((get-in metrics [:definitions :profile-register]) :inc)))
+
+(defn register-profile
+  [{:keys [conn tokens session metrics] :as cfg} {:keys [token] :as params}]
+  (let [claims (tokens :verify {:token token :iss :prepared-register})
+        params (merge params claims)]
+    (check-profile-existence! conn params)
+    (let [profile (->> params
+                       (create-profile conn)
+                       (create-profile-relations conn)
+                       (decode-profile-row))]
+      (sid/load-initial-project! conn profile)
+
+      (cond
+        ;; If invitation token comes in params, this is because the
+        ;; user comes from team-invitation process; in this case,
+        ;; regenerate token and send back to the user a new invitation
+        ;; token (and mark current session as logged).
+        (some? (:invitation-token params))
+        (let [token (:invitation-token params)
+              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)
+             ::audit/props (audit/profile->props profile)
+             ::audit/profile-id (:id profile)}))
+
+        ;; If auth backend is different from "penpot" means user is
+        ;; registring using third party auth mechanism; in this case
+        ;; we need to mark this session as logged.
+        (not= "penpot" (:auth-backend profile))
+        (with-meta (profile/strip-private-attrs profile)
+          {:transform-response ((:create session) (:id profile))
+           :before-complete (annotate-profile-register metrics)
+           ::audit/props (audit/profile->props profile)
+           ::audit/profile-id (:id profile)})
+
+        ;; In all other cases, send a verification email.
+        :else
+        (let [vtoken (tokens :generate
+                             {:iss :verify-email
+                              :exp (dt/in-future "48h")
+                              :profile-id (:id profile)
+                              :email (:email profile)})
+              ptoken (tokens :generate-predefined
+                             {:iss :profile-identity
+                              :profile-id (:id profile)})]
+
+          (eml/send! {::eml/conn conn
+                      ::eml/factory eml/register
+                      :public-uri (:public-uri cfg)
+                      :to (:email profile)
+                      :name (:fullname profile)
+                      :token vtoken
+                      :extra-data ptoken})
+
+          (with-meta profile
+            {:before-complete (annotate-profile-register metrics)
+             ::audit/props (audit/profile->props profile)
+             ::audit/profile-id (:id 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 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)
+  "Create the profile entry on the database with limited input filling
+  all the other fields with defaults."
+  [conn params]
+  (let [id        (or (:id params) (uuid/next))
+
+        props     (-> (extract-props params)
+                      (merge (:props params))
+                      (assoc :accept-terms-and-privacy (:accept-terms-and-privacy params true))
+                      (assoc :accept-newsletter-subscription (:accept-newsletter-subscription params false))
+                      (db/tjson))
+
+        password  (if-let [password (:password params)]
+                    (derive-password password)
+                    "!")
+
+        locale    (as-> (:locale params) locale
+                    (and (string? locale) (not (str/blank? locale)) locale))
+
+        backend   (:backend params "penpot")
+        is-demo   (:is-demo params false)
+        is-muted  (:is-muted params false)
+        is-active (:is-active params (or (not= "penpot" backend) is-demo))
+        email     (str/lower (:email params))
+
         params    {:id id
-                   :fullname fullname
-                   :email (str/lower email)
-                   :auth-backend "penpot"
+                   :fullname (:fullname params)
+                   :email email
+                   :auth-backend backend
+                   :lang locale
                    :password password
+                   :deleted-at (:deleted-at params)
                    :props props
                    :is-active is-active
                    :is-muted is-muted
                    :is-demo is-demo}]
     (try
-      (-> (db/insert! conn :profile params opts)
-          (update :props db/decode-transit-pgobject))
+      (-> (db/insert! conn :profile params)
+          (decode-profile-row))
       (catch org.postgresql.util.PSQLException e
         (let [state (.getSQLState e)]
           (if (not= state "23505")
@@ -196,23 +266,27 @@
 
 (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)
 
-;; --- Mutation: Login
+    (-> profile
+        (profile/strip-private-attrs)
+        (assoc :default-team-id (:id team))
+        (assoc :default-project-id (:id project)))))
+
+;; --- MUTATION: Login
 
 (s/def ::email ::us/email)
 (s/def ::scope ::us/string)
@@ -222,7 +296,7 @@
           :opt-un [::scope ::invitation-token]))
 
 (sv/defmethod ::login {:auth false :rlimit :password}
-  [{:keys [pool session tokens] :as cfg} {:keys [email password scope] :as params}]
+  [{:keys [pool session tokens] :as cfg} {:keys [email password] :as params}]
   (letfn [(check-password [profile password]
             (when (= (:password profile) "!")
               (ex/raise :type :validation
@@ -245,7 +319,8 @@
       (let [profile (->> (profile/retrieve-profile-data-by-email conn email)
                          (validate-profile)
                          (profile/strip-private-attrs)
-                         (profile/populate-additional-data conn))]
+                         (profile/populate-additional-data conn)
+                         (decode-profile-row))]
         (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
@@ -259,64 +334,26 @@
                               :member-email (:email profile))
                 token  (tokens :generate claims)]
             (with-meta {:invitation-token token}
-              {:transform-response ((:create session) (:id profile))}))
+              {:transform-response ((:create session) (:id profile))
+               ::audit/props (audit/profile->props profile)
+               ::audit/profile-id (:id profile)}))
 
           (with-meta profile
-            {:transform-response ((:create session) (:id profile))}))))))
+            {:transform-response ((:create session) (:id profile))
+             ::audit/props (audit/profile->props profile)
+             ::audit/profile-id (:id profile)}))))))
 
-;; --- Mutation: Logout
+;; --- MUTATION: Logout
 
 (s/def ::logout
   (s/keys :req-un [::profile-id]))
 
 (sv/defmethod ::logout
-  [{:keys [pool session] :as cfg} {:keys [profile-id] :as params}]
+  [{:keys [session] :as cfg} _]
   (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 ::backend]))
-
-(sv/defmethod ::login-or-register {:auth false}
-  [{: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)}))))
-
-(defn login-or-register
-  [{:keys [conn] :as cfg} {:keys [email backend] :as params}]
-  (letfn [(create-profile [conn {:keys [fullname email]}]
-            (db/insert! conn :profile
-                        {:id (uuid/next)
-                         :fullname fullname
-                         :email (str/lower email)
-                         :auth-backend backend
-                         :is-active true
-                         :password "!"
-                         :is-demo false}))
-
-          (register-profile [conn params]
-            (let [profile (->> (create-profile conn params)
-                               (create-profile-relations conn))]
-              (sid/load-initial-project! conn profile)
-              (assoc profile ::created true)))]
-
-    (let [profile (profile/retrieve-profile-data-by-email conn email)
-          profile (if profile
-                    (profile/populate-additional-data conn profile)
-                    (register-profile conn params))]
-      (profile/strip-private-attrs profile))))
-
-
-;; --- Mutation: Update Profile (own)
+;; --- MUTATION: Update Profile (own)
 
 (defn- update-profile
   [conn {:keys [id fullname lang theme] :as params}]
@@ -327,7 +364,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]
@@ -335,8 +373,7 @@
     (update-profile conn params)
     nil))
 
-
-;; --- Mutation: Update Password
+;; --- MUTATION: Update Password
 
 (declare validate-password!)
 (declare update-profile-password!)
@@ -345,7 +382,7 @@
   (s/keys :req-un [::profile-id ::password ::old-password]))
 
 (sv/defmethod ::update-profile-password {:rlimit :password}
-  [{:keys [pool] :as cfg} {:keys [password profile-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [password] :as params}]
   (db/with-atomic [conn pool]
     (let [profile (validate-password! conn params)]
       (update-profile-password! conn (assoc profile :password password))
@@ -365,23 +402,28 @@
               {:password (derive-password password)}
               {:id id}))
 
-;; --- Mutation: Update Photo
+
+;; --- MUTATION: Update Photo
 
 (declare update-profile-photo)
 
-(s/def ::file ::media/upload)
+(s/def ::content-type ::media/image-content-type)
+(s/def ::file (s/and ::media/upload (s/keys :req-un [::content-type])))
+
 (s/def ::update-profile-photo
   (s/keys :req-un [::profile-id ::file]))
 
 (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"})
+    (media/run cfg {:cmd :info :input {:path (:tempfile file)
+                                       :mtype (:content-type file)}})
+
     (let [profile (db/get-by-id conn :profile profile-id)
-          _       (media/run cfg {:cmd :info :input {:path (:tempfile file)
-                                                     :mtype (:content-type file)}})
-          photo   (teams/upload-photo cfg params)
-          storage (assoc storage :conn conn)]
+          storage (media/configure-assets-storage storage conn)
+          cfg     (assoc cfg :storage storage)
+          photo   (teams/upload-photo cfg params)]
 
       ;; Schedule deletion of old photo
       (when-let [id (:photo-id profile)]
@@ -398,7 +440,7 @@
   nil)
 
 
-;; --- Mutation: Request Email Change
+;; --- MUTATION: Request Email Change
 
 (declare request-email-change)
 (declare change-email-inmediatelly)
@@ -414,7 +456,7 @@
           params  (assoc params
                          :profile profile
                          :email (str/lower email))]
-      (if (cfg/get :smtp-enabled)
+      (if (cf/get :smtp-enabled)
         (request-email-change cfg params)
         (change-email-inmediatelly cfg params)))))
 
@@ -428,7 +470,7 @@
   {:changed true})
 
 (defn- request-email-change
-  [{:keys [conn tokens]} {:keys [profile email] :as params}]
+  [{:keys [conn tokens] :as cfg} {:keys [profile email] :as params}]
   (let [token   (tokens :generate
                         {:iss :change-email
                          :exp (dt/in-future "15m")
@@ -441,22 +483,24 @@
     (when (not= email (:email profile))
       (check-profile-existence! conn params))
 
-    (when-not (emails/allow-send-emails? conn profile)
+    (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 (emails/has-bounce-reports? conn email)
+    (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"))
 
-    (emails/send! conn emails/change-email
-                  {:to (:email profile)
-                   :name (:fullname profile)
-                   :pending-email email
-                   :token token
-                   :extra-data ptoken})
+    (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))
 
 
@@ -464,7 +508,7 @@
   [conn id]
   (db/get-by-id conn :profile id {:for-update true}))
 
-;; --- Mutation: Request Profile Recovery
+;; --- MUTATION: Request Profile Recovery
 
 (s/def ::request-profile-recovery
   (s/keys :req-un [::email]))
@@ -482,16 +526,18 @@
             (let [ptoken (tokens :generate-predefined
                                  {:iss :profile-identity
                                   :profile-id (:id profile)})]
-              (emails/send! conn emails/password-recovery
-                            {:to (:email profile)
-                             :token (:token profile)
-                             :name (:fullname profile)
-                             :extra-data ptoken})
+              (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 (emails/allow-send-emails? conn profile)
+        (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."))
@@ -501,7 +547,7 @@
                     :code :profile-not-verified
                     :hint "the user need to validate profile before recover password"))
 
-        (when (emails/has-bounce-reports? conn (:email profile))
+        (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"))
@@ -511,7 +557,7 @@
              (send-email-notification conn))))))
 
 
-;; --- Mutation: Recover Profile
+;; --- MUTATION: Recover Profile
 
 (s/def ::token ::us/not-empty-string)
 (s/def ::recover-profile
@@ -532,7 +578,7 @@
            (update-password conn))
       nil)))
 
-;; --- Mutation: Update Profile Props
+;; --- MUTATION: Update Profile Props
 
 (s/def ::props map?)
 (s/def ::update-profile-props
@@ -554,7 +600,7 @@
       nil)))
 
 
-;; --- Mutation: Delete Profile
+;; --- MUTATION: Delete Profile
 
 (declare check-can-delete-profile!)
 (declare mark-profile-as-deleted!)
@@ -567,11 +613,6 @@
   (db/with-atomic [conn pool]
     (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}})
-
     (db/update! conn :profile
                 {:deleted-at (dt/now)}
                 {:id profile-id})

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

@@ -2,20 +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.rpc.mutations.projects
   (:require
    [app.common.spec :as us]
    [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.rpc.queries.teams :as teams]
-   [app.tasks :as tasks]
    [app.util.services :as sv]
    [app.util.time :as dt]
    [clojure.spec.alpha :as s]))
@@ -30,7 +26,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)
@@ -43,30 +39,31 @@
   (db/with-atomic [conn pool]
     (teams/check-edition-permissions! conn profile-id team-id)
     (let [project (create-project conn params)
-          params  (assoc params :project-id (:id project))]
-      (create-project-profile conn params)
+          params  (assoc params
+                         :project-id (:id project)
+                         :role :owner)]
+      (create-project-role conn params)
       (create-team-project-profile conn params)
       (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
@@ -120,17 +117,15 @@
 (s/def ::delete-project
   (s/keys :req-un [::id ::profile-id]))
 
+;; TODO: right now, we just don't allow delete default projects, in a
+;; future we need to ensure raise a correct exception signaling that
+;; this is not allowed.
+
 (sv/defmethod ::delete-project
   [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
   (db/with-atomic [conn pool]
     (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}})
-
     (db/update! conn :project
                 {:deleted-at (dt/now)}
-                {:id id})
+                {:id id :is-default false})
     nil))

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
@@ -13,15 +10,14 @@
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [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]
    [clojure.spec.alpha :as s]
@@ -36,7 +32,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 +43,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
 
@@ -127,6 +125,10 @@
 (s/def ::delete-team
   (s/keys :req-un [::profile-id ::id]))
 
+;; TODO: right now just don't allow delete default team, in future it
+;; should raise a speific exception for signal that this acction is
+;; not allowed.
+
 (sv/defmethod ::delete-team
   [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
   (db/with-atomic [conn pool]
@@ -135,14 +137,9 @@
         (ex/raise :type :validation
                   :code :only-owner-can-delete-team))
 
-      ;; Schedule object deletion
-      (tasks/submit! conn {:name "delete-object"
-                           :delay cfg/deletion-delay
-                           :props {:id id :type :team}})
-
       (db/update! conn :team
                   {:deleted-at (dt/now)}
-                  {:id id})
+                  {:id id :is-default false})
       nil)))
 
 
@@ -171,7 +168,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 +179,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 +189,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))))
@@ -246,18 +244,23 @@
 
 (declare upload-photo)
 
-(s/def ::file ::media/upload)
+(s/def ::content-type ::media/image-content-type)
+(s/def ::file (s/and ::media/upload (s/keys :req-un [::content-type])))
+
 (s/def ::update-team-photo
   (s/keys :req-un [::profile-id ::team-id ::file]))
 
 (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"})
+    (media/run cfg {:cmd :info :input {:path (:tempfile file)
+                                       :mtype (:content-type file)}})
+
     (let [team    (teams/retrieve-team conn profile-id team-id)
-          _       (media/run cfg {:cmd :info :input {:path (:tempfile file)
-                                                     :mtype (:content-type file)}})
+          storage (media/configure-assets-storage storage conn)
+          cfg     (assoc cfg :storage storage)
           photo   (upload-photo cfg params)]
 
       ;; Schedule deletion of old photo
@@ -266,8 +269,8 @@
 
       ;; Save new photo
       (db/update! conn :team
-              {:photo-id (:id photo)}
-              {:id team-id})
+                  {:photo-id (:id photo)}
+                  {:id team-id})
 
       (assoc team :photo-id (:id photo)))))
 
@@ -303,7 +306,7 @@
           team     (db/get-by-id conn :team team-id)
           itoken   (tokens :generate
                            {:iss :team-invitation
-                            :exp (dt/in-future "6h")
+                            :exp (dt/in-future "48h")
                             :profile-id (:id profile)
                             :role role
                             :team-id team-id
@@ -318,27 +321,29 @@
                   :code :insufficient-permissions))
 
       ;; First check if the current profile is allowed to send emails.
-      (when-not (emails/allow-send-emails? conn profile)
+      (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 (emails/allow-send-emails? conn member)))
+      (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 (emails/has-bounce-reports? conn email)
+      (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"))
 
-      (emails/send! conn emails/invite-to-team
-                    {:to email
-                     :invited-by (:fullname profile)
-                     :team (:name team)
-                     :token itoken
-                     :extra-data ptoken})
+      (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,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.verify-token
   (:require

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,19 +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.rpc.queries.files
   (:require
-   [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.permissions :as perms]
    [app.rpc.queries.projects :as projects]
+   [app.rpc.queries.teams :as teams]
+   [app.storage.impl :as simpl]
    [app.util.blob :as blob]
    [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
@@ -100,7 +99,13 @@
              ppr.is_owner = true or
              ppr.can_edit = true)
    )
-   select distinct f.*
+   select distinct
+          f.id,
+          f.project_id,
+          f.created_at,
+          f.modified_at,
+          f.name,
+          f.is_shared
      from file as f
     inner join projects as pr on (f.project_id = pr.id)
     where f.name ilike ('%' || ? || '%')
@@ -108,18 +113,21 @@
     order by f.created_at asc")
 
 (s/def ::search-files
-  (s/keys :req-un [::profile-id ::team-id ::search-term]))
+  (s/keys :req-un [::profile-id ::team-id]
+          :opt-un [::search-term]))
 
 (sv/defmethod ::search-files
   [{:keys [pool] :as cfg} {:keys [profile-id team-id search-term] :as params}]
-  (let [rows (db/exec! pool [sql:search-files
-                                profile-id team-id
-                                profile-id team-id
-                                search-term])]
-    (into [] decode-row-xf rows)))
+  (when search-term
+    (db/exec! pool [sql:search-files
+                    profile-id team-id
+                    profile-id team-id
+                    search-term])))
 
 
-;; --- Query: Project Files
+;; --- Query: Files
+
+;; DEPRECATED: should be removed probably on 1.6.x
 
 (def ^:private sql:files
   "select f.*
@@ -139,13 +147,48 @@
     (into [] decode-row-xf (db/exec! conn [sql:files project-id]))))
 
 
+;; --- Query: Project Files
+
+(def ^:private sql:project-files
+  "select f.id,
+          f.project_id,
+          f.created_at,
+          f.modified_at,
+          f.name,
+          f.is_shared
+     from file as f
+    where f.project_id = ?
+      and f.deleted_at is null
+    order by f.modified_at desc")
+
+(s/def ::project-files
+  (s/keys :req-un [::profile-id ::project-id]))
+
+(sv/defmethod ::project-files
+  [{:keys [pool] :as cfg} {:keys [profile-id project-id] :as params}]
+  (with-open [conn (db/open pool)]
+    (projects/check-read-permissions! conn profile-id project-id)
+    (db/exec! conn [sql:project-files project-id])))
+
 ;; --- Query: File (By ID)
 
+(defn- retrieve-data*
+  [{:keys [storage] :as cfg} file]
+  (when-let [backend (simpl/resolve-backend storage (:data-backend file))]
+    (simpl/get-object-bytes backend file)))
+
+(defn retrieve-data
+  [cfg file]
+  (if (bytes? (:data file))
+    file
+    (assoc file :data (retrieve-data* cfg file))))
+
 (defn retrieve-file
-  [conn id]
-  (-> (db/get-by-id conn :file id)
-      (decode-row)
-      (pmg/migrate-file)))
+  [{:keys [conn] :as cfg} id]
+  (->> (db/get-by-id conn :file id)
+       (retrieve-data cfg)
+       (decode-row)
+       (pmg/migrate-file)))
 
 (s/def ::file
   (s/keys :req-un [::profile-id ::id]))
@@ -153,22 +196,55 @@
 (sv/defmethod ::file
   [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
   (db/with-atomic [conn pool]
-    (check-edition-permissions! conn profile-id id)
-    (retrieve-file conn id)))
+    (let [cfg (assoc cfg :conn conn)]
+      (check-edition-permissions! conn profile-id id)
+      (retrieve-file cfg id))))
 
 (s/def ::page
-  (s/keys :req-un [::profile-id ::id ::file-id]))
+  (s/keys :req-un [::profile-id ::file-id]))
+
+(defn remove-thumbnails-frames
+  "Removes from data the children for frames that have a thumbnail set up"
+  [data]
+  (let [filter-shape?
+        (fn [objects [id shape]]
+          (let [frame-id (:frame-id shape)]
+            (or (= id uuid/zero)
+                (= frame-id uuid/zero)
+                (not (some? (get-in objects [frame-id :thumbnail]))))))
+
+        ;; We need to remove from the attribute :shapes its childrens because
+        ;; they will not be sent in the data
+        remove-frame-children
+        (fn [[id shape]]
+          [id (cond-> shape
+                (some? (:thumbnail shape))
+                (assoc :shapes []))])
+
+        update-objects
+        (fn [objects]
+          (into {}
+                (comp (map remove-frame-children)
+                      (filter (partial filter-shape? objects)))
+                objects))]
+
+    (update data :objects update-objects)))
 
 (sv/defmethod ::page
-  [{:keys [pool] :as cfg} {:keys [profile-id file-id id]}]
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id strip-thumbnails]}]
   (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id file-id)
-    (let [file (retrieve-file conn file-id)]
-      (get-in file [:data :pages-index id]))))
-
+    (let [cfg     (assoc cfg :conn conn)
+          file    (retrieve-file cfg file-id)
+          page-id (get-in file [:data :pages 0])]
+      (cond-> (get-in file [:data :pages-index page-id])
+        strip-thumbnails
+        (remove-thumbnails-frames)))))
 
 ;; --- Query: Shared Library Files
 
+;; DEPRECATED: and will be removed on 1.6.x
+
 (def ^:private sql:shared-files
   "select f.*
      from file as f
@@ -183,39 +259,68 @@
   (s/keys :req-un [::profile-id ::team-id]))
 
 (sv/defmethod ::shared-files
-  [{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
+  [{:keys [pool] :as cfg} {:keys [team-id] :as params}]
   (into [] decode-row-xf (db/exec! pool [sql:shared-files team-id])))
 
 
+;; --- Query: Shared Library Files
+
+(def ^:private sql:team-shared-files
+  "select f.id,
+          f.project_id,
+          f.created_at,
+          f.modified_at,
+          f.name,
+          f.is_shared
+     from file as f
+    inner join project as p on (p.id = f.project_id)
+    where f.is_shared = true
+      and f.deleted_at is null
+      and p.deleted_at is null
+      and p.team_id = ?
+    order by f.modified_at desc")
+
+(s/def ::team-shared-files
+  (s/keys :req-un [::profile-id ::team-id]))
+
+(sv/defmethod ::team-shared-files
+  [{:keys [pool] :as cfg} {:keys [team-id] :as params}]
+  (db/exec! pool [sql:team-shared-files team-id]))
+
+
 ;; --- Query: File Libraries used by a File
 
 (def ^:private sql:file-libraries
-  "select fl.*,
-          ? as is_indirect,
-          flr.synced_at as synced_at
-     from file as fl
-    inner join file_library_rel as flr on (flr.library_file_id = fl.id)
-    where flr.file_id = ?
-      and fl.deleted_at is null")
+  "WITH RECURSIVE libs AS (
+     SELECT fl.*, flr.synced_at
+       FROM file AS fl
+       JOIN file_library_rel AS flr ON (flr.library_file_id = fl.id)
+      WHERE flr.file_id = ?::uuid
+    UNION
+     SELECT fl.*, flr.synced_at
+       FROM file AS fl
+       JOIN file_library_rel AS flr ON (flr.library_file_id = fl.id)
+       JOIN libs AS l ON (flr.file_id = l.id)
+   )
+   SELECT l.id,
+          l.data,
+          l.project_id,
+          l.created_at,
+          l.modified_at,
+          l.deleted_at,
+          l.name,
+          l.revn,
+          l.synced_at
+     FROM libs AS l
+    WHERE l.deleted_at IS NULL OR l.deleted_at > now();")
 
 (defn retrieve-file-libraries
-  [conn is-indirect file-id]
-  (let [direct-libraries
-        (into [] decode-row-xf (db/exec! conn [sql:file-libraries is-indirect file-id]))
-
-        select-distinct
-        (fn [used-libraries new-libraries]
-          (remove (fn [new-library]
-                    (some #(= (:id %) (:id new-library)) used-libraries))
-                  new-libraries))]
-
-    (reduce (fn [used-libraries library]
-              (concat used-libraries
-                      (select-distinct
-                        used-libraries
-                        (retrieve-file-libraries conn true (:id library)))))
-            direct-libraries
-            direct-libraries)))
+  [{:keys [conn] :as cfg} is-indirect file-id]
+  (let [xform (comp
+               (map #(assoc % :is-indirect is-indirect))
+               (map #(retrieve-data cfg %))
+               (map decode-row))]
+    (into #{} xform (db/exec! conn [sql:file-libraries file-id]))))
 
 (s/def ::file-libraries
   (s/keys :req-un [::profile-id ::file-id]))
@@ -223,35 +328,39 @@
 (sv/defmethod ::file-libraries
   [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
-    (check-edition-permissions! conn profile-id file-id)
-    (retrieve-file-libraries conn false file-id)))
+    (let [cfg (assoc cfg :conn conn)]
+      (check-edition-permissions! conn profile-id file-id)
+      (retrieve-file-libraries cfg false file-id))))
 
+;; --- QUERY: team-recent-files
 
-;; --- Query: Single File Library
+(def sql:team-recent-files
+  "with recent_files as (
+     select f.id,
+            f.project_id,
+            f.created_at,
+            f.modified_at,
+            f.name,
+            f.is_shared,
+            row_number() over w as row_num
+       from file as f
+       join project as p on (p.id = f.project_id)
+      where p.team_id = ?
+        and p.deleted_at is null
+        and f.deleted_at is null
+     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 <= 10;")
 
-;; TODO: this looks like is duplicate of `::file`
-
-(def ^:private sql:file-library
-  "select fl.*
-     from file as fl
-    where fl.id = ?")
-
-(defn retrieve-file-library
-  [conn file-id]
-  (let [rows (db/exec! conn [sql:file-library file-id])]
-    (when-not (seq rows)
-      (ex/raise :type :not-found))
-    (first (sequence decode-row-xf rows))))
-
-(s/def ::file-library
-  (s/keys :req-un [::profile-id ::file-id]))
-
-(sv/defmethod ::file-library
-  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
-  (db/with-atomic [conn pool]
-    (check-edition-permissions! conn profile-id file-id) ;; TODO: this should check read permissions
-    (retrieve-file-library conn file-id)))
+(s/def ::team-recent-files
+  (s/keys :req-un [::profile-id ::team-id]))
 
+(sv/defmethod ::team-recent-files
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
+  (with-open [conn (db/open pool)]
+    (teams/check-read-permissions! conn profile-id team-id)
+    (db/exec! conn [sql:team-recent-files team-id])))
 
 ;; --- Helpers
 

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

@@ -0,0 +1,73 @@
+;; 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.fonts
+  (:require
+   [app.common.spec :as us]
+   [app.db :as db]
+   [app.rpc.queries.files :as files]
+   [app.rpc.queries.projects :as projects]
+   [app.rpc.queries.teams :as teams]
+   [app.util.services :as sv]
+   [clojure.spec.alpha :as s]))
+
+;; --- Query: Team Font Variants
+
+;; TODO: deprecated, should be removed on 1.7.x
+
+(s/def ::team-id ::us/uuid)
+(s/def ::profile-id ::us/uuid)
+(s/def ::team-font-variants
+  (s/keys :req-un [::profile-id ::team-id]))
+
+(sv/defmethod ::team-font-variants
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
+  (with-open [conn (db/open pool)]
+    (teams/check-read-permissions! conn profile-id team-id)
+    (db/query conn :team-font-variant
+              {:team-id team-id
+               :deleted-at nil})))
+
+;; --- Query: Font Variants
+
+(s/def ::file-id ::us/uuid)
+(s/def ::project-id ::us/uuid)
+(s/def ::font-variants
+  (s/and
+   (s/keys :req-un [::profile-id]
+           :opt-un [::team-id
+                    ::file-id
+                    ::project-id])
+   (fn [o]
+     (or (contains? o :team-id)
+         (contains? o :file-id)
+         (contains? o :project-id)))))
+
+(sv/defmethod ::font-variants
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id file-id project-id] :as params}]
+  (with-open [conn (db/open pool)]
+    (cond
+      (uuid? team-id)
+      (do
+        (teams/check-read-permissions! conn profile-id team-id)
+        (db/query conn :team-font-variant
+                  {:team-id team-id
+                   :deleted-at nil}))
+
+      (uuid? project-id)
+      (let [project (db/get-by-id conn :project project-id {:columns [:id :team-id]})]
+        (projects/check-read-permissions! conn profile-id project-id)
+        (db/query conn :team-font-variant
+                  {:team-id (:team-id project)
+                   :deleted-at nil}))
+
+      (uuid? file-id)
+      (let [file    (db/get-by-id conn :file file-id {:columns [:id :project-id]})
+            project (db/get-by-id conn :project (:project-id file) {:columns [:id :team-id]})]
+        (files/check-read-permissions! conn profile-id file-id)
+        (db/query conn :team-font-variant
+                  {:team-id (:team-id project)
+                   :deleted-at nil})))))

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
@@ -13,7 +10,6 @@
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
    [app.db :as db]
-   [app.db.sql :as sql]
    [app.util.services :as sv]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]))
@@ -46,29 +42,27 @@
     {: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)}))
 
@@ -79,7 +73,8 @@
 (defn decode-profile-row
   [{:keys [props] :as row}]
   (cond-> row
-    (db/pgobject? props) (assoc :props (db/decode-transit-pgobject props))))
+    (db/pgobject? props "jsonb")
+    (assoc :props (db/decode-transit-pgobject props))))
 
 (defn retrieve-profile-data
   [conn id]
@@ -99,10 +94,10 @@
 
 (defn retrieve-profile-data-by-email
   [conn email]
-  (let [sql  (sql/select :profile {:email (str/lower email)})
-        data (db/exec-one! conn sql)]
-    (when (and data (nil? (:deleted-at data)))
-      (decode-profile-row data))))
+  (try
+    (db/get-by-params conn :profile {:email (str/lower email)
+                                     :deleted-at nil})
+    (catch Exception _e)))
 
 ;; --- 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
@@ -16,6 +13,8 @@
    [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
 
+;; DEPRECATED: should be removed on 1.6.x
+
 (def sql:recent-files
   "with recent_files as (
      select f.*, row_number() over w as row_num
@@ -27,7 +26,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)

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

@@ -0,0 +1,59 @@
+;; 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
+                :hint "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
@@ -45,17 +42,23 @@
 (sv/defmethod ::viewer-bundle {:auth false}
   [{:keys [pool] :as cfg} {:keys [profile-id file-id page-id token] :as params}]
   (db/with-atomic [conn pool]
-    (let [file    (files/retrieve-file conn file-id)
+    (let [cfg     (assoc cfg :conn conn)
+          file    (files/retrieve-file cfg file-id)
           project (retrieve-project conn (:project-id file))
           page    (get-in file [:data :pages-index page-id])
           file    (merge (dissoc file :data)
                          (select-keys (:data file) [:colors :media :typographies]))
-          libs    (files/retrieve-file-libraries conn false file-id)
+          libs    (files/retrieve-file-libraries cfg false file-id)
           users   (teams/retrieve-users conn (:team-id project))
 
+          fonts   (db/query conn :team-font-variant
+                            {:team-id (:team-id project)
+                             :deleted-at nil})
+
           bundle  {:file file
                    :page page
                    :users users
+                   :fonts fonts
                    :project project
                    :libraries libs}]
 

backend/src/app/setup.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.setup
   "Initial data setup of instance."
@@ -32,16 +29,26 @@
       (initialize-instance-id! cfg)
       (retrieve-all cfg))))
 
+(def sql:upsert-secret-key
+  "insert into server_prop (id, preload, content)
+   values ('secret-key', true, ?::jsonb)
+   on conflict (id) do update set content = ?::jsonb")
+
+(def sql:insert-secret-key
+  "insert into server_prop (id, preload, content)
+   values ('secret-key', true, ?::jsonb)
+   on conflict (id) do nothing")
+
 (defn- initialize-secret-key!
-  [{:keys [conn] :as cfg}]
-  (let [key (-> (bn/random-bytes 64)
-                (bc/bytes->b64u)
-                (bc/bytes->str))]
-    (db/insert! conn :server-prop
-                {:id "secret-key"
-                 :preload true
-                 :content (db/tjson key)}
-                {:on-conflict-do-nothing true})))
+  [{:keys [conn key] :as cfg}]
+  (if key
+    (let [key (db/tjson key)]
+      (db/exec-one! conn [sql:upsert-secret-key key key]))
+    (let [key (-> (bn/random-bytes 64)
+                  (bc/bytes->b64u)
+                  (bc/bytes->str))
+          key (db/tjson key)]
+      (db/exec-one! conn [sql:insert-secret-key key]))))
 
 (defn- initialize-instance-id!
   [{:keys [conn] :as cfg}]

backend/src/app/setup/initial_data.clj

@@ -2,24 +2,17 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; 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
+;; Copyright (c) UXBOX Labs SL
 
 (ns app.setup.initial-data
   (:refer-clojure :exclude [load])
   (:require
-   [app.common.data :as d]
-   [app.common.pages.migrations :as pmg]
    [app.common.uuid :as uuid]
-   [app.config :as cfg]
+   [app.config :as cf]
    [app.db :as db]
-   [app.rpc.mutations.projects :as projects]
-   [app.rpc.queries.profile :as profile]
-   [app.util.blob :as blob]
-   [app.util.time :as dt]
-   [clojure.walk :as walk]))
+   [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
 
@@ -43,7 +36,7 @@
   ([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))
+     (let [skey  (or skey (cf/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])
@@ -62,58 +55,6 @@
 
 ;; --- DUMP LOADING
 
-(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))))))
-
-(defn- remap-id
-  [item index key]
-  (cond-> item
-    (contains? item key)
-    (assoc key (get index (get item key) (get item key)))))
-
 (defn- retrieve-data
   [conn skey]
   (when-let [row (db/exec-one! conn ["select content from server_prop where id = ?" skey])]
@@ -124,63 +65,35 @@
 (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))
+   (let [skey (or (:skey opts) (cf/get :initial-project-skey))
          data (retrieve-data conn skey)]
      (when data
-       (let [project (projects/create-project conn {:profile-id (:id profile)
-                                                    :team-id (:default-team-id profile)
-                                                    :name (:project-name 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)}]
 
-             now     (dt/now)
-             ignore  (dt/plus now (dt/duration {:seconds 5}))
-             index   (as-> {} index
-                       (reduce #(assoc %1 (:id %2) (uuid/next)) index (:files data))
-                       (reduce #(assoc %1 (:id %2) (uuid/next)) index (:fmeds data)))
+         (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
 
-             flibs   (->> (:flibs data)
-                          (map #(remap-id % index :file-id))
-                          (map #(remap-id % index :library-file-id))
-                          (map #(assoc % :synced-at now))
-                          (map #(assoc % :created-at now)))
+         (create-project conn project)
+         (create-project-role conn {:project-id (:id project)
+                                    :profile-id (:id profile)
+                                    :role :owner})
 
-             files   (->> (:files data)
-                          (map #(assoc % :id (get index (:id %))))
-                          (map #(assoc % :project-id (:id project)))
-                          (map #(assoc % :created-at now))
-                          (map #(assoc % :modified-at now))
-                          (map #(assoc % :ignore-sync-until ignore))
-                          (map #(process-file % index)))
+         (doseq [file (:files data)]
+           (let [flibs  (filterv #(= (:id file) (:file-id %)) (:flibs data))
+                 fmeds  (filterv #(= (:id file) (:file-id %)) (:fmeds data))
 
-             fmeds   (->> (:fmeds data)
-                          (map #(assoc % :id (get index (:id %))))
-                          (map #(assoc % :created-at now))
-                          (map #(remap-id % index :file-id)))
+                 params {:profile-id (:id profile)
+                         :project-id (:id project)
+                         :file file
+                         :index index
+                         :flibs flibs
+                         :fmeds fmeds}
 
-             fprofs  (map #(array-map :file-id (:id %)
-                                      :profile-id (:id profile)
-                                      :is-owner true
-                                      :is-admin true
-                                      :can-edit true) files)]
-
-       (projects/create-project-profile conn {:project-id (:id project)
-                                              :profile-id (:id profile)})
-
-       (projects/create-team-project-profile conn {:team-id (:default-team-id profile)
-                                                   :project-id (:id project)
-                                                   :profile-id (:id profile)})
-
-       ;; Re-insert into the database
-       (doseq [params files]
-         (db/insert! conn :file params))
-
-       (doseq [params fprofs]
-         (db/insert! conn :file-profile-rel params))
-
-       (doseq [params flibs]
-         (db/insert! conn :file-library-rel params))
-
-       (doseq [params fmeds]
-         (db/insert! conn :file-media-object params)))))))
+                 opts   {:reset-shared-flag false}]
+             (duplicate-file conn params opts))))))))
 
 (defn load
   [system {:keys [email] :as opts}]

backend/src/app/setup/keys.clj

@@ -0,0 +1,29 @@
+;; 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.keys
+  "Keys derivation service."
+  (:require
+   [app.common.spec :as us]
+   [buddy.core.kdf :as bk]
+   [clojure.spec.alpha :as s]
+   [integrant.core :as ig]))
+
+(s/def ::secret-key ::us/string)
+(s/def ::props (s/keys :req-un [::secret-key]))
+
+(defmethod ig/pre-init-spec :app.setup/keys [_]
+  (s/keys :req-un [::props]))
+
+(defmethod ig/init-key :app.setup/keys
+  [_ {:keys [props] :as cfg}]
+  (fn [& {:keys [salt _]}]
+    (let [engine (bk/engine {:key (:secret-key props)
+                             :salt salt
+                             :alg :hkdf
+                             :digest :blake2b-512})]
+      (bk/get-bytes engine 32))))
+