📎 Update changelog and increase version (minor).

Related to stroage.

.circleci/config.yml

@@ -9,7 +9,7 @@ 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
@@ -29,21 +29,30 @@ 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/"
+          name: common lint
+          working_directory: "./common"
+          command: "clj-kondo --parallel --lint src/"
 
-      # run test
       - 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
-          command: "clojure -M:dev:tests"
+          working_directory: "./backend"
+          command: "clojure -X:dev:test"
           environment:
             PENPOT_TEST_DATABASE_URI: "postgresql://localhost/penpot_test"
             PENPOT_TEST_DATABASE_USERNAME: penpot_test
@@ -51,11 +60,26 @@ jobs:
             PENPOT_TEST_REDIS_URI: "redis://localhost/1"
 
       - run:
-          working_directory: "./frontend"
           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:
+            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
@@ -63,5 +87,5 @@ jobs:
       - 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

@@ -26,9 +26,12 @@ node_modules
 /frontend/out/
 /frontend/.shadow-cljs
 /frontend/resources/public/*
+/frontend/resources/fonts/experiments
 /exporter/target
 /exporter/.shadow-cljs
 /docker/images/bundle*
+/common/.shadow-cljs
+/common/target
 /.clj-kondo/.cache
 /bundle*
 /media

CHANGES.md

@@ -3,17 +3,219 @@
 ## :rocket: Next
 
 ### :sparkles: New features
+
 ### :bug: Bugs fixed
 ### :arrow_up: Deps updates
 ### :boom: Breaking changes
 ### :heart: Community contributions by (Thank you!)
 
+## 1.7.4-alpha
+
+### :bug: Bugs fixed
+
+- Fix demo user creation (self-hosted only)
+- Add better ldap response validation and reporting (self-hosted only)
+
+
+## 1.7.3-alpha
+
+### :bug: Bugs fixed
+
+- Fix font uploading issue on Windows.
+
+
+## 1.7.2-alpha
+
+### :sparkles: New features
+
+- 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

README.md

@@ -2,24 +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")
-[![Gitpod ready-to-code](https://img.shields.io/badge/Gitpod-ready--to--code-blue?logo=gitpod)](https://gitpod.io/#https://github.com/penpot/penpot)
+<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? ##
 
-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 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://penpot.app/images/workspace-ui.jpg)
+- [How to use](#how-to-use)
+- [Help center](#help-center)
+- [Contributing](#contributing)
+- [Give feedback](#give-feedback)
+- [Tutorials](#tutorials)
+- [License](#license)
 
+## How to use ##
+
+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.
+
+✏️ [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**.
+
+🐳 [Install docker](https://help.penpot.app/technical-guide/getting-started/)
+
+## Help center ##
+
+In this documentation you will find (almost) everything you need to know about how to work with Penpot. From the interface basics to advanced functionality.
+
+📖 [User guide](https://help.penpot.app/user-guide/)
+
+❓ [FAQs](https://help.penpot.app/faqs/)
+
+🖥️ [Technical guide](https://help.penpot.app/technical-guide/)
+
+❤️ [Contributing guide](https://help.penpot.app/contributing-guide/)
+
+![User guide](https://penpot.app/images/readme/help-center.jpg)
 
 ## Contributing ##
 
+<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
@@ -28,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 the [help center](https://help.penpot.app).
+✉️ [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 ##
 

backend/deps.edn

@@ -1,22 +1,14 @@
-{: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.3"}
-  org.clojure/data.json {:mvn/version "2.2.1"}
-  org.clojure/core.async {:mvn/version "1.3.610"}
-  org.clojure/tools.cli {:mvn/version "1.0.206"}
-  org.clojure/clojurescript {:mvn/version "1.10.844"}
+ {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.1"}
-  org.apache.logging.log4j/log4j-core {:mvn/version "2.14.1"}
-  org.apache.logging.log4j/log4j-web {:mvn/version "2.14.1"}
-  org.apache.logging.log4j/log4j-jul {:mvn/version "2.14.1"}
-  org.apache.logging.log4j/log4j-slf4j18-impl {:mvn/version "2.14.1"}
-  org.slf4j/slf4j-api {:mvn/version "2.0.0-alpha1"}
   org.zeromq/jeromq {:mvn/version "0.5.2"}
 
   com.taoensso/nippy {:mvn/version "3.1.1"}
@@ -32,69 +24,57 @@
                                                  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.9"}
-  com.cognitect/transit-clj {:mvn/version "1.0.324"}
-
-  io.lettuce/lettuce-core {:mvn/version "6.1.1.RELEASE"}
+  io.lettuce/lettuce-core {:mvn/version "6.1.2.RELEASE"}
   java-http-clj/java-http-clj {:mvn/version "0.4.2"}
 
   info.sunng/ring-jetty9-adapter {:mvn/version "0.15.1"}
-  com.github.seancorfield/next.jdbc {:mvn/version "1.1.646"}
-  metosin/reitit-ring {:mvn/version "0.5.12"}
-  metosin/jsonista {:mvn/version "0.3.1"}
-
-  org.postgresql/postgresql {:mvn/version "42.2.19"}
+  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"}
 
-  funcool/datoteka {:mvn/version "1.2.0"}
-  funcool/promesa {:mvn/version "6.0.0"}
-  funcool/cuerdas {:mvn/version "2020.03.26-3"}
+  funcool/datoteka {:mvn/version "2.0.0"}
 
-  buddy/buddy-core {:mvn/version "1.9.0"}
-  buddy/buddy-hashers {:mvn/version "1.7.0"}
-  buddy/buddy-sign {:mvn/version "3.3.0"}
+  buddy/buddy-core {:mvn/version "1.10.1"}
+  buddy/buddy-hashers {:mvn/version "1.8.1"}
+  buddy/buddy-sign {:mvn/version "3.4.1"}
 
-  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"}
-  com.sun.mail/jakarta.mail {:mvn/version "2.0.1"}
 
   org.clojars.pntblnk/clj-ldap {:mvn/version "0.0.17"}
   integrant/integrant {:mvn/version "0.8.0"}
 
-  software.amazon.awssdk/s3 {:mvn/version "2.16.44"}
+  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
+  :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 {com.github.liquidz/antq {:mvn/version "RELEASE"}}
    :main-opts ["-m" "antq.core"]}

backend/dev/user.clj

@@ -50,7 +50,7 @@
 ;; --- Development Stuff
 
 (defn- run-tests
-  ([] (run-tests #"^app.tests.*"))
+  ([] (run-tests #"^app.*-test$"))
   ([o]
    (repl/refresh)
    (cond

backend/resources/log4j2-devenv.xml

@@ -12,6 +12,11 @@
       </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>
@@ -30,10 +35,12 @@
 
     <Logger name="app" level="all" additivity="false">
       <AppenderRef ref="main" level="trace" />
+      <AppenderRef ref="zmq" level="debug" />
     </Logger>
 
-    <Logger name="penpot" level="fatal" additivity="false">
-      <AppenderRef ref="main" level="fatal" />
+    <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">

backend/scripts/build

@@ -49,6 +49,7 @@
 
 ;; 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]

backend/scripts/repl

@@ -2,7 +2,9 @@
 
 export PENPOT_ASSERTS_ENABLED=true
 
-export OPTIONS="-A:jmx-remote:dev -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager -J-Xms512m -J-Xmx512m -J-Dlog4j2.configurationFile=log4j2-devenv.xml"
+export OPTIONS="-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/src/app/config.clj

@@ -8,6 +8,8 @@
   "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]
@@ -16,7 +18,8 @@
    [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
@@ -26,6 +29,16 @@
                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"
@@ -34,8 +47,7 @@
    :database-username "penpot"
    :database-password "penpot"
 
-   :default-blob-version 1
-
+   :default-blob-version 3
    :loggers-zmq-uri "tcp://localhost:45556"
 
    :asserts-enabled false
@@ -46,11 +58,8 @@
    :srepl-host "127.0.0.1"
    :srepl-port 6062
 
-   :storage-backend :fs
-
-   :storage-fs-directory "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
@@ -72,7 +81,6 @@
 
    :allow-demo-users true
    :registration-enabled true
-   :registration-domain-whitelist ""
 
    :telemetry-enabled false
    :telemetry-uri "https://telemetry.penpot.app/"
@@ -87,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)
@@ -142,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)
@@ -157,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
@@ -235,15 +258,21 @@
                    ::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
@@ -263,9 +292,17 @@
 
 (defn- read-config
   []
-  (->> (read-env "penpot")
-       (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))))
 
 (def version (v/parse (or (some-> (io/resource "version.txt")
                                   (slurp)

backend/src/app/db.clj

@@ -10,13 +10,14 @@
    [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]
    [integrant.core :as ig]
@@ -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,14 +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 {:keys [uncheked] :or {uncheked false} :as opts}]
    (let [res (exec-one! ds (sql/select table params opts))]
-     (when (and (not uncheked)
-                (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)))
 
@@ -238,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]
@@ -326,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."
@@ -347,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

@@ -32,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

backend/src/app/emails.clj

@@ -127,9 +127,9 @@
 (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."

backend/src/app/http.clj

@@ -136,7 +136,9 @@
     ["/webhooks"
      ["/sns" {:post (:sns-webhook cfg)}]]
 
-    ["/api" {:middleware [[middleware/etag]
+    ["/api" {:middleware [
+                          ;; Temporary disabled
+                          #_[middleware/etag]
                           [middleware/format-response-body]
                           [middleware/params]
                           [middleware/multipart-params]

backend/src/app/http/assets.clj

@@ -49,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/errors.clj

@@ -76,6 +76,7 @@
 
     {:status 500
      :body {:type :server-error
+            :code :assertion
             :data (-> edata
                       (assoc :explain (explain-error edata))
                       (dissoc :data))}}))
@@ -103,6 +104,7 @@
                  :cause error)
         {:status 500
          :body {:type :server-error
+                :code :unexpected
                 :hint (ex-message error)
                 :data edata}}))))
 
@@ -115,7 +117,8 @@
     (l/error :hint "psql exception"
              :error-message (ex-message error)
              :error-id (str (:id cdata))
-             :sql-state state)
+             :sql-state state
+             :cause error)
 
     (cond
       (= state "57014")
@@ -132,7 +135,8 @@
 
       :else
       {:status 500
-       :body {:type :server-timeout
+       :body {:type :server-error
+              :code :psql-exception
               :hint (ex-message error)
               :state state}})))
 

backend/src/app/http/middleware.clj

@@ -6,13 +6,14 @@
 
 (ns app.http.middleware
   (:require
+   [app.common.transit :as t]
    [app.metrics :as mtx]
    [app.util.json :as json]
    [app.util.logging :as l]
-   [app.util.transit :as t]
    [buddy.core.codecs :as bc]
    [buddy.core.hash :as bh]
    [clojure.java.io :as io]
+   [ring.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

backend/src/app/http/oauth.clj

@@ -6,10 +6,14 @@
 
 (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]
@@ -19,36 +23,6 @@
    [cuerdas.core :as str]
    [integrant.core :as ig]))
 
-(defn redirect-response
-  [uri]
-  {:status 302
-   :headers {"location" (str uri)}
-   :body ""})
-
-(defn generate-error-redirect-uri
-  [cfg]
-  (-> (u/uri (:public-uri cfg))
-      (assoc :path "/#/auth/login")
-      (assoc :query (u/map->query-string {:error "unable-to-auth"}))))
-
-(defn register-profile
-  [{:keys [rpc] :as cfg} info]
-  (let [method-fn (get-in rpc [:methods :mutation :login-or-register])
-        profile   (method-fn info)]
-    (cond-> profile
-      (some? (:invitation-token info))
-      (assoc :invitation-token (:invitation-token info)))))
-
-(defn generate-redirect-uri
-  [{:keys [tokens] :as cfg} profile]
-  (let [token (or (:invitation-token profile)
-                  (tokens :generate {:iss :auth
-                                     :exp (dt/in-future "15m")
-                                     :profile-id (:id profile)}))]
-    (-> (u/uri (:public-uri cfg))
-        (assoc :path "/#/auth/verify-token")
-        (assoc :query (u/map->query-string {:token token})))))
-
 (defn- build-redirect-uri
   [{:keys [provider] :as cfg}]
   (let [public (u/uri (:public-uri cfg))]
@@ -98,16 +72,28 @@
           res (http/send! req)]
 
       (when (= 200 (:status res))
-        (let [{:keys [name] :as data} (json/read-str (:body res) :key-fn keyword)]
-          (-> data
-              (assoc :backend (:name provider))
-              (assoc :fullname name)))))
+        (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])
@@ -115,9 +101,13 @@
         info   (some->> (get-in request [:params :code])
                         (retrieve-access-token cfg)
                         (retrieve-user-info cfg))]
-    (when-not info
+
+    (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))
+                :code :unable-to-auth
+                :hint "no user info"))
 
     ;; If the provider is OIDC, we can proceed to check
     ;; roles if they are defined.
@@ -130,6 +120,7 @@
                                (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
@@ -138,33 +129,107 @@
 
     (cond-> info
       (some? (:invitation-token state))
-      (assoc :invitation-token (: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} request]
-  (let [invitation (get-in request [:params :invitation-token])
+  [{: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
-  [{:keys [session] :as cfg} request]
+  [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)))))
+    (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
 
@@ -175,8 +240,8 @@
 (s/def ::tokens fn?)
 (s/def ::rpc map?)
 
-(defmethod ig/pre-init-spec :app.http.oauth/handlers [_]
-  (s/keys :req-un [::public-uri ::session ::tokens ::rpc]))
+(defmethod ig/pre-init-spec ::handler [_]
+  (s/keys :req-un [::public-uri ::session ::tokens ::rpc ::db/pool]))
 
 (defn wrap-handler
   [cfg handler]
@@ -190,7 +255,7 @@
       (-> (assoc @cfg :provider provider)
           (handler request)))))
 
-(defmethod ig/init-key :app.http.oauth/handlers
+(defmethod ig/init-key ::handler
   [_ cfg]
   (let [cfg (initialize cfg)]
     {:handler (wrap-handler cfg auth-handler)
@@ -207,6 +272,13 @@
                :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)
@@ -215,8 +287,7 @@
               :token-uri     (cf/get :oidc-token-uri)
               :auth-uri      (cf/get :oidc-auth-uri)
               :user-uri      (cf/get :oidc-user-uri)
-              :scopes        (into #{"openid" "profile" "email" "name"}
-                                   (cf/get :oidc-scopes #{}))
+              :scopes        (cf/get :oidc-scopes #{"openid" "profile" "email"})
               :roles-attr    (cf/get :oidc-roles-attr)
               :roles         (cf/get :oidc-roles)
               :name          "oidc"}]
@@ -227,10 +298,12 @@
                (string? (:user-uri opts))
                (string? (:auth-uri opts)))
         (do
-          (l/info :action "initialize" :provider "oid" :method "static")
+          (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 "oid" :method "discover")
+          (l/info :action "initialize" :provider "oidc" :method "discover"
+                  :opts (pr-str (update opts :client-secret obfuscate-string)))
           (assoc-in cfg [:providers "oidc"] opts)))
       cfg)))
 
@@ -238,9 +311,7 @@
   [cfg]
   (let [opts {:client-id     (cf/get :google-client-id)
               :client-secret (cf/get :google-client-secret)
-              :scopes        #{"email" "profile" "openid"
-                               "https://www.googleapis.com/auth/userinfo.email"
-                               "https://www.googleapis.com/auth/userinfo.profile"}
+              :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"
@@ -248,7 +319,8 @@
     (if (and (string? (:client-id opts))
              (string? (:client-secret opts)))
       (do
-        (l/info :action "initialize" :provider "google")
+        (l/info :action "initialize" :provider "google"
+                :opts (pr-str (update opts :client-secret obfuscate-string)))
         (assoc-in cfg [:providers "google"] opts))
       cfg)))
 
@@ -256,8 +328,7 @@
   [cfg]
   (let [opts {:client-id     (cf/get :github-client-id)
               :client-secret (cf/get :github-client-secret)
-              :scopes        #{"read:user"
-                               "user:email"}
+              :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"
@@ -265,7 +336,8 @@
     (if (and (string? (:client-id opts))
              (string? (:client-secret opts)))
       (do
-        (l/info :action "initialize" :provider "github")
+        (l/info :action "initialize" :provider "github"
+                :opts (pr-str (update opts :client-secret obfuscate-string)))
         (assoc-in cfg [:providers "github"] opts))
       cfg)))
 
@@ -284,7 +356,8 @@
     (if (and (string? (:client-id opts))
              (string? (:client-secret opts)))
       (do
-        (l/info :action "initialize" :provider "gitlab")
+        (l/info :action "initialize" :provider "gitlab"
+                :opts (pr-str (update opts :client-secret obfuscate-string)))
         (assoc-in cfg [:providers "gitlab"] opts))
       cfg)))
 

backend/src/app/http/session.clj

@@ -106,7 +106,6 @@
 
 ;; --- STATE INIT: SESSION UPDATER
 
-(declare batch-events)
 (declare update-sessions)
 
 (s/def ::session map?)
@@ -129,7 +128,9 @@
   (l/info :action "initialize session updater"
           :max-batch-age (str (:max-batch-age cfg))
           :max-batch-size (str (:max-batch-size cfg)))
-  (let [input (batch-events cfg (::events-ch session))
+  (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_update_total"
                 :help "A counter of session update batch events."
@@ -139,46 +140,19 @@
       (when-let [[reason batch] (a/<! input)]
         (let [result (a/<! (update-sessions cfg batch))]
           (mcnt :inc)
-          (if (ex/exception? result)
+          (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

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

@@ -31,16 +31,16 @@
   [_ {:keys [receiver uri] :as cfg}]
   (when uri
     (l/info :msg "intializing loki reporter" :uri uri)
-    (let [output (a/chan (a/sliding-buffer 1024))]
-      (receiver :sub output)
+    (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)
             (l/info :msg "stoping error reporting loop")
             (do
               (a/<! (handle-event cfg msg))
               (recur)))))
-      output)))
+      input)))
 
 (defmethod ig/halt-key! ::reporter
   [_ output]
@@ -69,17 +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
-          (l/error :hint "error on sending log to loki"
-                   :try i
+          (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
-      (l/error :hint "error on sending message to loki"
-               :cause e
-               :try i)
+      (l/error :hint "error on sending message to loki" :cause e :try i)
       false)))
 
 (defn- handle-event

backend/src/app/loggers/mattermost.clj

@@ -40,36 +40,35 @@
 
 (defmethod ig/init-key ::reporter
   [_ {:keys [receiver uri] :as cfg}]
-  (l/info :msg "intializing mattermost error reporter" :uri uri)
-  (let [output (a/chan (a/sliding-buffer 128)
-                       (filter #(= (:level %) "error")))]
-    (receiver :sub output)
-    (a/go-loop []
-      (let [msg (a/<! output)]
-        (if (nil? msg)
-          (l/info :msg "stoping error reporting loop")
-          (do
-            (a/<! (handle-event cfg msg))
-            (recur)))))
-    output))
+  (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: " (cfg/get :public-uri) "/dbg/error-by-id/" id "\n"
-                    "- profile-id: `" (:profile-id cdata) "`\n"
-                    "- host: `" host "`\n"
-                    "- version: `" version "`\n")
-          rsp    (http/send! {:uri uri
-                              :method :post
-                              :headers {"content-type" "application/json"}
-                              :body (json/encode-str {:text text})})]
+          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)
         (l/error :hint "error on sending data to mattermost"
                  :response (pr-str rsp))))
@@ -110,7 +109,7 @@
   (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

backend/src/app/main.clj

@@ -6,7 +6,6 @@
 
 (ns app.main
   (:require
-   [app.common.data :as d]
    [app.config :as cf]
    [app.util.logging :as l]
    [app.util.time :as dt]
@@ -45,7 +44,7 @@
     :redis-uri (cf/get :redis-uri)}
 
    :app.tokens/tokens
-   {:sprops (ig/ref :app.setup/props)}
+   {:keys (ig/ref :app.setup/keys)}
 
    :app.storage/gc-deleted-task
    {:pool     (ig/ref :app.db/pool)
@@ -91,7 +90,7 @@
     :tokens      (ig/ref :app.tokens/tokens)
     :public-uri  (cf/get :public-uri)
     :metrics     (ig/ref :app.metrics/metrics)
-    :oauth       (ig/ref :app.http.oauth/handlers)
+    :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)
@@ -108,10 +107,12 @@
    :app.http.feedback/handler
    {:pool (ig/ref :app.db/pool)}
 
-   :app.http.oauth/handlers
+   :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)}
 
    ;; RLimit definition for password hashing
@@ -122,10 +123,15 @@
    :app.rlimits/image
    (cf/get :rlimits-image)
 
+   ;; RLimit definition for font processing
+   :app.rlimits/font
+   (cf/get :rlimits-font 2)
+
    ;; A collection of rlimits as hash-map.
    :app.rlimits/all
    {:password (ig/ref :app.rlimits/password)
-    :image    (ig/ref :app.rlimits/image)}
+    :image    (ig/ref :app.rlimits/image)
+    :font     (ig/ref :app.rlimits/font)}
 
    :app.rpc/rpc
    {:pool       (ig/ref :app.db/pool)
@@ -135,7 +141,8 @@
     :storage    (ig/ref :app.storage/storage)
     :msgbus     (ig/ref :app.msgbus/msgbus)
     :rlimits    (ig/ref :app.rlimits/all)
-    :public-uri (cf/get :public-uri)}
+    :public-uri (cf/get :public-uri)
+    :audit      (ig/ref :app.loggers.audit/collector)}
 
    :app.notifications/handler
    {:msgbus   (ig/ref :app.msgbus/msgbus)
@@ -161,27 +168,42 @@
     :tasks      (ig/ref :app.worker/registry)
     :pool       (ig/ref :app.db/pool)
     :schedule
-    [{:cron #app/cron "0 0 0 */1 * ? *" ;; daily
+    [{:cron #app/cron "0 0 0 * * ?" ;; daily
       :task :file-media-gc}
 
-     {:cron #app/cron "0 0 */1 * * ?"  ;; hourly
+     {:cron #app/cron "0 0 * * * ?"  ;; hourly
       :task :file-xlog-gc}
 
-     {:cron #app/cron "0 0 1 */1 * ?"  ;; daily (1 hour shift)
+     {:cron #app/cron "0 0 0 * * ?"  ;; daily
       :task :storage-deleted-gc}
 
-     {:cron #app/cron "0 0 2 */1 * ?"  ;; daily (2 hour shift)
+     {:cron #app/cron "0 0 0 * * ?"  ;; daily
       :task :storage-touched-gc}
 
-     {:cron #app/cron "0 0 3 */1 * ?"  ;; daily (3 hour shift)
+     {:cron #app/cron "0 0 0 * * ?"  ;; daily
       :task :session-gc}
 
-     {:cron #app/cron "0 0 */1 * * ?"  ;; hourly
+     {:cron #app/cron "0 0 * * * ?"  ;; hourly
       :task :storage-recheck}
 
-     {:cron #app/cron "0 0 0 */1 * ?"  ;; daily
+     {:cron #app/cron "0 0 0 * * ?"  ;; daily
+      :task :objects-gc}
+
+     {:cron #app/cron "0 0 0 * * ?"  ;; daily
       :task :tasks-gc}
 
+     (when (cf/get :fdata-storage-backed)
+       {:cron #app/cron "0 0 * * * ?"  ;; hourly
+        :task :file-offload})
+
+     (when (cf/get :audit-archive-enabled)
+       {:cron #app/cron "0 0 * * * ?" ;; every 1h
+        :task :audit-archive})
+
+     (when (cf/get :audit-archive-gc-enabled)
+       {:cron #app/cron "0 0 * * * ?" ;; every 1h
+        :task :audit-archive-gc})
+
      (when (cf/get :telemetry-enabled)
        {:cron #app/cron "0 0 */6 * * ?" ;; every 6h
         :task :telemetry})]}
@@ -190,6 +212,7 @@
    {: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)
@@ -199,7 +222,10 @@
      :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)}}
+     :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)}}
 
    :app.emails/sendmail-handler
    {:host             (cf/get :smtp-host)
@@ -215,31 +241,33 @@
 
    :app.tasks.tasks-gc/handler
    {:pool    (ig/ref :app.db/pool)
-    :max-age (dt/duration {:hours 24})
-    :metrics (ig/ref :app.metrics/metrics)}
+    :max-age cf/deletion-delay}
 
    :app.tasks.delete-object/handler
    {:pool    (ig/ref :app.db/pool)
-    :metrics (ig/ref :app.metrics/metrics)}
+    :storage (ig/ref :app.storage/storage)}
 
-   :app.tasks.delete-storage-object/handler
+   :app.tasks.objects-gc/handler
    {:pool    (ig/ref :app.db/pool)
     :storage (ig/ref :app.storage/storage)
-    :metrics (ig/ref :app.metrics/metrics)}
+    :max-age cf/deletion-delay}
 
    :app.tasks.delete-profile/handler
-   {:pool    (ig/ref :app.db/pool)
-    :metrics (ig/ref :app.metrics/metrics)}
+   {:pool    (ig/ref :app.db/pool)}
 
    :app.tasks.file-media-gc/handler
    {:pool    (ig/ref :app.db/pool)
-    :metrics (ig/ref :app.metrics/metrics)
-    :max-age (dt/duration {:hours 48})}
+    :max-age cf/deletion-delay}
 
    :app.tasks.file-xlog-gc/handler
    {:pool    (ig/ref :app.db/pool)
-    :metrics (ig/ref :app.metrics/metrics)
-    :max-age (dt/duration {:hours 48})}
+    :max-age (dt/duration {:hours 72})}
+
+   :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.telemetry/handler
    {:pool        (ig/ref :app.db/pool)
@@ -252,11 +280,31 @@
     :host (cf/get :srepl-host)}
 
    :app.setup/props
-   {:pool (ig/ref :app.db/pool)}
+   {:pool (ig/ref :app.db/pool)
+    :key  (cf/get :secret-key)}
+
+   :app.setup/keys
+   {:props (ig/ref :app.setup/props)}
 
    :app.loggers.zmq/receiver
    {:endpoint (cf/get :loggers-zmq-uri)}
 
+   :app.loggers.audit/collector
+   {:enabled  (cf/get :audit-enabled false)
+    :pool     (ig/ref :app.db/pool)
+    :executor (ig/ref :app.worker/executor)}
+
+   :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.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.loki/reporter
    {:uri      (cf/get :loggers-loki-uri)
     :receiver (ig/ref :app.loggers.zmq/receiver)
@@ -274,32 +322,36 @@
    :app.storage/storage
    {:pool     (ig/ref :app.db/pool)
     :executor (ig/ref :app.worker/executor)
-    :backend  (cf/get :storage-backend :fs)
-    :backends {:s3  (ig/ref [::main :app.storage.s3/backend])
-               :db  (ig/ref [::main :app.storage.db/backend])
-               :fs  (ig/ref [::main :app.storage.fs/backend])
-               :tmp (ig/ref [::tmp  :app.storage.fs/backend])}}
 
-   [::main :app.storage.s3/backend]
-   {:region (cf/get :storage-s3-region)
-    :bucket (cf/get :storage-s3-bucket)}
+    :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])
 
-   [::main :app.storage.fs/backend]
-   {:directory (cf/get :storage-fs-directory)}
+               ;; keep this for backward compatibility
+               :s3        (ig/ref [::assets :app.storage.s3/backend])
+               :fs        (ig/ref [::assets :app.storage.fs/backend])}}
+
+   [::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)}
+
+   [::assets :app.storage.s3/backend]
+   {:region (cf/get :storage-assets-s3-region)
+    :bucket (cf/get :storage-assets-s3-bucket)}
+
+   [::assets :app.storage.fs/backend]
+   {:directory (cf/get :storage-assets-fs-directory)}
 
    [::tmp :app.storage.fs/backend]
    {:directory "/tmp/penpot"}
 
-   [::main :app.storage.db/backend]
+   [::assets :app.storage.db/backend]
    {:pool (ig/ref :app.db/pool)}})
 
-(defmethod ig/init-key :default [_ data] data)
-(defmethod ig/prep-key :default
-  [_ data]
-  (if (map? data)
-    (d/without-nils data)
-    data))
-
 (def system nil)
 
 (defn start

backend/src/app/media.clj

@@ -5,28 +5,36 @@
 ;; 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.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
@@ -35,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?)
 
@@ -77,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)
@@ -138,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))
 
@@ -161,33 +202,142 @@
          :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
-  ([mtype] (validate-media-type mtype cm/valid-media-types))
-  ([mtype allowed]
-   (when-not (contains? allowed mtype)
-     (ex/raise :type :validation
-               :code :media-type-not-allowed
-               :hint "Seems like you are uploading an invalid media object"))))

backend/src/app/metrics.clj

@@ -210,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

@@ -166,6 +166,33 @@
 
    {: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/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/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

@@ -21,6 +21,7 @@
    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
@@ -130,6 +131,7 @@
 
 ;; --- REDIS BACKEND IMPL
 
+(declare impl-redis-open?)
 (declare impl-redis-pub)
 (declare impl-redis-sub)
 (declare impl-redis-unsub)
@@ -162,7 +164,8 @@
     (a/go-loop []
       (when-let [val (a/<! pub-ch)]
         (let [result (a/<! (impl-redis-pub rac val))]
-          (when (ex/exception? result)
+          (when (and (impl-redis-open? pub-conn)
+                     (ex/exception? result))
             (l/error :cause result
                      :hint "unexpected error on publish message to redis")))
         (recur)))))
@@ -214,7 +217,8 @@
                   (let [result (a/<!! (impl-redis-unsub rac topic))]
                     (l/trace :action "close subscription"
                              :topic topic)
-                    (when (ex/exception? result)
+                    (when (and (impl-redis-open? sub-conn)
+                               (ex/exception? result))
                       (l/error :cause result
                                :hint "unexpected exception on unsubscribing"
                                :topic topic))))
@@ -265,6 +269,10 @@
                                  (run! a/close!)))))))))
 
 
+(defn- impl-redis-open?
+  [^StatefulConnection conn]
+  (.isOpen conn))
+
 (defn- impl-redis-pub
   [^RedisAsyncCommands rac {:keys [topic message]}]
   (let [message (blob/encode message)

backend/src/app/notifications.clj

@@ -8,12 +8,12 @@
   "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]
@@ -163,7 +163,7 @@
 
                   ;; when connection is closed
                   (mtx-aconn :dec)
-                  (mtx-sessions :observe (/ (inst-ms (dt/duration-between created-at (dt/now))) 1000.0))
+                  (mtx-sessions :observe (/ (inst-ms (dt/diff created-at (dt/now))) 1000.0))
 
                   ;; close subscription
                   (a/close! sub-ch))))

backend/src/app/rlimits.clj

@@ -18,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

@@ -10,6 +10,7 @@
    [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]
@@ -31,9 +32,10 @@
   [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)
@@ -49,12 +51,15 @@
 (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}
@@ -85,18 +90,43 @@
     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?))]
-    (l/trace :action "register"
-             :name (::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]
@@ -112,7 +142,7 @@
                :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
@@ -120,6 +150,7 @@
                      'app.rpc.queries.profile
                      'app.rpc.queries.recent-files
                      'app.rpc.queries.viewer
+                     'app.rpc.queries.fonts
                      'app.rpc.queries.svg)
          (map (partial process-method cfg))
          (into {}))))
@@ -132,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
@@ -143,6 +174,7 @@
                      '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 {}))))
@@ -150,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/demo.clj

@@ -11,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.util.services :as sv]
-   [app.worker :as wrk]
+   [app.util.time :as dt]
    [buddy.core.codecs :as bc]
    [buddy.core.nonce :as bn]
    [clojure.spec.alpha :as s]))
@@ -34,6 +35,7 @@
                   :email email
                   :fullname fullname
                   :is-demo true
+                  :deleted-at (dt/in-future cfg/deletion-delay)
                   :password password
                   :props {:onboarding-viewed true}}]
 
@@ -47,11 +49,6 @@
            (#'profile/create-profile-relations conn)
            (sid/load-initial-project! conn))
 
-      ;; Schedule deletion of the demo profile
-      (wrk/submit! {::wrk/task :delete-profile
-                    ::wrk/delay cfg/deletion-delay
-                    ::wrk/conn conn
-                    :profile-id id})
-
-      {:email email
-       :password password})))
+      (with-meta {:email email
+                  :password password}
+        {::audit/profile-id id}))))

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

@@ -11,17 +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.storage.impl :as simpl]
    [app.util.blob :as blob]
    [app.util.services :as sv]
    [app.util.time :as dt]
-   [app.worker :as wrk]
    [clojure.spec.alpha :as s]))
 
+(declare create-file)
+
 ;; --- Helpers & Specs
 
 (s/def ::id ::us/uuid)
@@ -32,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]
@@ -45,7 +44,6 @@
     (proj/check-edition-permissions! conn profile-id project-id)
     (create-file conn params)))
 
-
 (defn create-file-role
   [conn {:keys [file-id profile-id role]}]
   (let [params {:file-id file-id
@@ -54,21 +52,24 @@
          (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)})]
+                          :data (blob/encode data)
+                          :deleted-at deleted-at})]
+
     (->> (assoc params :file-id id :role :owner)
          (create-file-role conn))
-    (assoc file :data data)))
 
+    (assoc file :data data)))
 
 ;; --- Mutation: Rename File
 
@@ -109,7 +110,6 @@
               {:is-shared is-shared}
               {:id id}))
 
-
 ;; --- Mutation: Delete File
 
 (declare mark-file-deleted)
@@ -122,13 +122,6 @@
   (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id id)
 
-    ;; Schedule object deletion
-    (wrk/submit! {::wrk/task :delete-object
-                  ::wrk/delay cfg/deletion-delay
-                  ::wrk/conn conn
-                  :id id
-                  :type :file})
-
     (mark-file-deleted conn params)))
 
 (defn mark-file-deleted
@@ -175,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)))
@@ -195,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)))
@@ -207,7 +200,6 @@
               {:file-id file-id
                :library-file-id library-id}))
 
-
 ;; --- Mutation: Ignore updates in linked files
 
 (declare ignore-sync)
@@ -216,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)))
@@ -228,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?
@@ -256,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)]
@@ -338,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

@@ -9,12 +9,24 @@
    [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.logging :as l]
    [app.util.services :as sv]
    [clj-ldap.client :as ldap]
    [clojure.spec.alpha :as s]
    [clojure.string]))
 
+
+(s/def ::fullname ::us/not-empty-string)
+(s/def ::email ::us/email)
+(s/def ::backend ::us/not-empty-string)
+
+(s/def ::info-data
+  (s/keys :req-un [::fullname ::email ::backend]))
+
 (defn ^java.lang.AutoCloseable connect
   []
   (let [params {:ssl?      (cfg/get :ldap-ssl)
@@ -34,6 +46,7 @@
 ;; --- Mutation: login-with-ldap
 
 (declare authenticate)
+(declare login-or-register)
 
 (s/def ::email ::us/email)
 (s/def ::password ::us/string)
@@ -44,31 +57,44 @@
           :opt-un [::invitation-token]))
 
 (sv/defmethod ::login-with-ldap {:auth false :rlimit :password}
-  [{:keys [pool session tokens] :as cfg} {:keys [email password invitation-token] :as params}]
-  (let [info (authenticate params)
-        cfg  (assoc cfg :conn pool)]
-    (when-not info
-      (ex/raise :type :validation
-                :code :wrong-credentials))
-    (let [profile (login-or-register cfg {:email (:email info)
-                                          :backend (:backend info)
-                                          :fullname (:fullname info)})]
-      (if-let [token (:invitation-token params)]
-        ;; If invitation token comes in params, this is because the
-        ;; user comes from team-invitation process; in this case,
-        ;; regenerate token and send back to the user a new invitation
-        ;; token (and mark current session as logged).
-        (let [claims (tokens :verify {:token token :iss :team-invitation})
-              claims (assoc claims
-                            :member-id  (:id profile)
-                            :member-email (:email profile))
-              token  (tokens :generate claims)]
-          (with-meta
-            {:invitation-token token}
-            {:transform-response ((:create session) (:id profile))}))
+  [{:keys [pool session tokens] :as cfg} params]
+  (db/with-atomic [conn pool]
+    (let [info (authenticate params)
+          cfg  (assoc cfg :conn conn)]
 
-        (with-meta profile
-          {:transform-response ((:create session) (:id profile))})))))
+      (when-not info
+        (ex/raise :type :validation
+                  :code :wrong-credentials))
+
+      (when-not (s/valid? ::info-data info)
+        (let [explain (s/explain-str ::info-data info)]
+          (l/warn ::l/raw (str "invalid response from ldap, looks like ldap is not configured correctly\n" explain))
+          (ex/raise :type :restriction
+                    :code :wrong-ldap-response
+                    :reason explain)))
+
+      (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,15 +110,31 @@
                  (cfg/get :ldap-attrs-fullname)]
 
         base-dn (cfg/get :ldap-base-dn)
-        params  {:filter query :sizelimit 1 :attributes attrs}]
+        params  {:filter query
+                 :sizelimit 1
+                 :attributes attrs}]
     (first (ldap/search cpool base-dn params))))
 
 (defn- authenticate
-  [{:keys [password] :as params}]
+  [{: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    (get luser (keyword (cfg/get :ldap-attrs-email)))
+         :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

@@ -91,21 +91,21 @@
 (def sql:retrieve-used-media-objects
   "select fmo.*
      from file_media_object as fmo
-    inner join storage_object as o on (fmo.media_id = o.id)
+    inner join storage_object as so on (fmo.media_id = so.id)
     where fmo.file_id = ?
-      and o.deleted_at is null")
+      and so.deleted_at is null")
 
 (defn duplicate-file
-  [conn {:keys [profile-id file index project-id name]} {:keys [reset-shared-flag] :as opts}]
-  (let [flibs    (db/exec! conn [sql:retrieve-used-libraries (:id file)])
-        fmeds    (db/exec! conn [sql:retrieve-used-media-objects (:id file)])
+  [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)
+        index    (reduce #(assoc %1 (:id %2) (uuid/next)) index fmeds)
 
         flibs-xf (comp
                   (map #(remap-id % index :file-id))
@@ -167,13 +167,13 @@
           :opt-un [::name]))
 
 (sv/defmethod ::duplicate-file
-  [{:keys [pool] :as cfg} {:keys [profile-id file-id name] :as params}]
+  [{: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)))))
 
@@ -187,10 +187,11 @@
           :opt-un [::name]))
 
 (sv/defmethod ::duplicate-project
-  [{:keys [pool] :as cfg} {:keys [profile-id project-id name] :as params}]
+  [{: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

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

@@ -37,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
@@ -89,12 +91,11 @@
 
 
 (defn create-file-media-object
-  [{:keys [conn storage] :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))
@@ -115,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

@@ -6,13 +6,14 @@
 
 (ns app.rpc.mutations.profile
   (:require
-   [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
-   [app.config :as cfg]
+   [app.config :as cf]
    [app.db :as db]
    [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]
@@ -21,7 +22,6 @@
    [app.storage :as sto]
    [app.util.services :as sv]
    [app.util.time :as dt]
-   [app.worker :as wrk]
    [buddy.hashers :as hashers]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]))
@@ -36,110 +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 ::terms-privacy ::us/boolean)
-
-(s/def ::register-profile
-  (s/keys :req-un [::email ::password ::fullname ::terms-privacy]
-          :opt-un [::invitation-token]))
-
-(sv/defmethod ::register-profile {:auth false :rlimit :password}
-  [{:keys [pool tokens session] :as cfg} 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))
-
-  (when-not (:terms-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 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 (eml/has-bounce-reports? conn (:email profile))
-          (ex/raise :type :validation
-                    :code :email-has-permanent-bounces
-                    :hint "looks like the email has one or many bounces reported"))
-
-        (eml/send! {::eml/conn conn
-                    ::eml/factory eml/register
-                    :public-uri (:public-uri cfg)
-                    :to (:email profile)
-                    :name (:fullname profile)
-                    :token vtoken
-                    :extra-data ptoken})
-
-        (with-meta profile
-          {:before-complete (annotate-profile-register metrics profile)})))))
-
 (defn email-domain-in-whitelist?
-  "Returns true if email's domain is in the given whitelist or if given
-  whitelist is an empty string."
-  [whitelist email]
-  (if (str/empty-or-nil? 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*")
-          domain  (second (str/split email #"@" 2))]
-      (contains? (set domains) domain))))
+    (let [[_ candidate] (-> (str/lower email)
+                            (str/split #"@" 2))]
+      (contains? domains candidate))))
 
 (def ^:private sql:profile-existence
   "select exists (select * from profile
@@ -171,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")
@@ -223,7 +286,7 @@
         (assoc :default-team-id (:id team))
         (assoc :default-project-id (:id project)))))
 
-;; --- Mutation: Login
+;; --- MUTATION: Login
 
 (s/def ::email ::us/email)
 (s/def ::scope ::us/string)
@@ -233,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
@@ -256,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
@@ -270,85 +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 [(info->props [info]
-            (dissoc info :name :fullname :email :backend))
-
-          (info->lang [{:keys [locale] :as info}]
-            (when (and (string? locale)
-                       (not (str/blank? locale)))
-              locale))
-
-          (create-profile [conn {:keys [email] :as info}]
-            (db/insert! conn :profile
-                        {:id (uuid/next)
-                         :fullname (:fullname info)
-                         :email (str/lower email)
-                         :lang (info->lang info)
-                         :auth-backend backend
-                         :is-active true
-                         :password "!"
-                         :props (db/tjson (info->props info))
-                         :is-demo false}))
-
-          (update-profile [conn info profile]
-            (let [props (d/merge (:props profile)
-                                 (info->props info))]
-              (db/update! conn :profile
-                          {:props (db/tjson props)
-                           :modified-at (dt/now)}
-                          {:id (:id profile)})
-              (assoc profile :props props)))
-
-          (register-profile [conn params]
-            (let [profile (->> (create-profile conn params)
-                               (create-profile-relations conn))]
-              (sid/load-initial-project! conn profile)
-              (assoc profile ::created true)))]
-
-    (let [profile (profile/retrieve-profile-data-by-email conn email)
-          profile (if profile
-                    (->> profile
-                         (update-profile conn params)
-                         (profile/populate-additional-data conn))
-                    (register-profile conn params))]
-      (profile/strip-private-attrs profile))))
-
-
-;; --- Mutation: Update Profile (own)
+;; --- MUTATION: Update Profile (own)
 
 (defn- update-profile
   [conn {:keys [id fullname lang theme] :as params}]
@@ -368,7 +373,7 @@
     (update-profile conn params)
     nil))
 
-;; --- Mutation: Update Password
+;; --- MUTATION: Update Password
 
 (declare validate-password!)
 (declare update-profile-password!)
@@ -377,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))
@@ -397,11 +402,14 @@
               {: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]))
 
@@ -409,11 +417,13 @@
   [{:keys [pool storage] :as cfg} {:keys [profile-id file] :as params}]
   (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)]
@@ -430,7 +440,7 @@
   nil)
 
 
-;; --- Mutation: Request Email Change
+;; --- MUTATION: Request Email Change
 
 (declare request-email-change)
 (declare change-email-inmediatelly)
@@ -446,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)))))
 
@@ -498,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]))
@@ -547,7 +557,7 @@
              (send-email-notification conn))))))
 
 
-;; --- Mutation: Recover Profile
+;; --- MUTATION: Recover Profile
 
 (s/def ::token ::us/not-empty-string)
 (s/def ::recover-profile
@@ -568,7 +578,7 @@
            (update-password conn))
       nil)))
 
-;; --- Mutation: Update Profile Props
+;; --- MUTATION: Update Profile Props
 
 (s/def ::props map?)
 (s/def ::update-profile-props
@@ -590,7 +600,7 @@
       nil)))
 
 
-;; --- Mutation: Delete Profile
+;; --- MUTATION: Delete Profile
 
 (declare check-can-delete-profile!)
 (declare mark-profile-as-deleted!)
@@ -603,12 +613,6 @@
   (db/with-atomic [conn pool]
     (check-can-delete-profile! conn profile-id)
 
-    ;; Schedule a complete deletion of profile
-    (wrk/submit! {::wrk/task :delete-profile
-                  ::wrk/dalay cfg/deletion-delay
-                  ::wrk/conn conn
-                  :profile-id profile-id})
-
     (db/update! conn :profile
                 {:deleted-at (dt/now)}
                 {:id profile-id})

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

@@ -8,14 +8,12 @@
   (: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.util.services :as sv]
    [app.util.time :as dt]
-   [app.worker :as wrk]
    [clojure.spec.alpha :as s]))
 
 ;; --- Helpers & Specs
@@ -119,19 +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
-    (wrk/submit! {::wrk/task :delete-object
-                  ::wrk/delay cfg/deletion-delay
-                  ::wrk/conn conn
-                  :id id
-                  :type :project})
-
     (db/update! conn :project
                 {:deleted-at (dt/now)}
-                {:id id})
+                {:id id :is-default false})
     nil))

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

@@ -10,7 +10,6 @@
    [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 eml]
    [app.media :as media]
@@ -21,7 +20,6 @@
    [app.storage :as sto]
    [app.util.services :as sv]
    [app.util.time :as dt]
-   [app.worker :as wrk]
    [clojure.spec.alpha :as s]
    [datoteka.core :as fs]))
 
@@ -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,16 +137,9 @@
         (ex/raise :type :validation
                   :code :only-owner-can-delete-team))
 
-      ;; Schedule object deletion
-      (wrk/submit! {::wrk/task :delete-object
-                    ::wrk/delay cfg/deletion-delay
-                    ::wrk/conn conn
-                    :id id
-                    :type :team})
-
       (db/update! conn :team
                   {:deleted-at (dt/now)}
-                  {:id id})
+                  {:id id :is-default false})
       nil)))
 
 
@@ -249,7 +244,9 @@
 
 (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]))
 
@@ -258,10 +255,12 @@
   (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
@@ -270,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)))))
 

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

@@ -6,12 +6,14 @@
 
 (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]))
@@ -97,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 ('%' || ? || '%')
@@ -105,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.*
@@ -136,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]))
@@ -150,21 +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
@@ -179,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]))
@@ -219,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

@@ -11,7 +11,8 @@
    [app.common.uuid :as uuid]
    [app.db :as db]
    [app.util.services :as sv]
-   [clojure.spec.alpha :as s]))
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]))
 
 ;; --- Helpers & Specs
 
@@ -72,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]
@@ -90,16 +92,16 @@
 
     profile))
 
-(def sql:retrieve-profile-by-email
+(def ^:private sql:profile-by-email
   "select p.* from profile as p
-    where p.email = lower(?)
-      and p.deleted_at is null")
+    where p.email = ?
+      and (p.deleted_at is null or
+           p.deleted_at > now())")
 
 (defn retrieve-profile-data-by-email
   [conn email]
-  (let [sql  [sql:retrieve-profile-by-email email]]
-    (some-> (db/exec-one! conn sql)
-            (decode-profile-row))))
+  (ex/ignoring
+   (db/exec-one! conn [sql:profile-by-email (str/lower email)])))
 
 ;; --- Attrs Helpers
 

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

@@ -13,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

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

@@ -36,6 +36,7 @@
               :message (ex-message e))
       (ex/raise :type :validation
                 :code :invalid-svg-file
+                :hint "invalid svg file"
                 :cause e))))
 
 (declare pre-process)
@@ -53,6 +54,6 @@
   [data]
   (cond-> data
     (str/includes? data "<!DOCTYPE")
-    (str/replace #"<\!DOCTYPE[^>]+>" "")))
+    (str/replace #"<\!DOCTYPE[^>]*>" "")))
 
 (def pre-process strip-doctype)

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

@@ -42,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

@@ -29,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

@@ -8,7 +8,7 @@
   (:refer-clojure :exclude [load])
   (:require
    [app.common.uuid :as uuid]
-   [app.config :as cfg]
+   [app.config :as cf]
    [app.db :as db]
    [app.rpc.mutations.management :refer [duplicate-file]]
    [app.rpc.mutations.projects :refer [create-project create-project-role]]
@@ -36,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])
@@ -65,7 +65,7 @@
 (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 [index   (reduce #(assoc %1 (:id %2) (uuid/next)) {} (:files data))
@@ -82,10 +82,16 @@
                                     :role :owner})
 
          (doseq [file (:files data)]
-           (let [params {:profile-id (:id profile)
+           (let [flibs  (filterv #(= (:id file) (:file-id %)) (:flibs data))
+                 fmeds  (filterv #(= (:id file) (:file-id %)) (:fmeds data))
+
+                 params {:profile-id (:id profile)
                          :project-id (:id project)
                          :file file
-                         :index index}
+                         :index index
+                         :flibs flibs
+                         :fmeds fmeds}
+
                  opts   {:reset-shared-flag false}]
              (duplicate-file conn params 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))))
+

backend/src/app/srepl.clj

@@ -9,6 +9,7 @@
   (:require
    [app.common.spec :as us]
    [app.srepl.main]
+   [app.util.logging :as l]
    [clojure.core.server :as ccs]
    [clojure.main :as cm]
    [clojure.spec.alpha :as s]
@@ -41,14 +42,17 @@
 
 (defmethod ig/init-key ::server
   [_ {:keys [port host name] :as cfg}]
-  (ccs/start-server {:address host
-                     :port port
-                     :name name
-                     :accept 'app.srepl/repl})
-  cfg)
+  (when (and port host name)
+    (l/info :msg "initializing server repl" :port port :host host :name name)
+    (ccs/start-server {:address host
+                       :port port
+                       :name name
+                       :accept 'app.srepl/repl})
+    cfg))
 
 (defmethod ig/halt-key! ::server
   [_ cfg]
-  (ccs/stop-server (:name cfg)))
+  (when cfg
+    (ccs/stop-server (:name cfg))))
 
 

backend/src/app/storage.clj

@@ -5,7 +5,7 @@
 ;; Copyright (c) UXBOX Labs SL
 
 (ns app.storage
-  "File Storage abstraction layer."
+  "Objects storage abstraction layer."
   (:require
    [app.common.data :as d]
    [app.common.exceptions :as ex]
@@ -20,29 +20,27 @@
    [app.util.time :as dt]
    [app.worker :as wrk]
    [clojure.spec.alpha :as s]
-   [cuerdas.core :as str]
    [datoteka.core :as fs]
    [integrant.core :as ig]
-   [promesa.exec :as px])
-  (:import
-   java.io.InputStream))
-
+   [promesa.exec :as px]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Storage Module State
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(s/def ::backend ::us/keyword)
-
 (s/def ::s3 ::ss3/backend)
 (s/def ::fs ::sfs/backend)
 (s/def ::db ::sdb/backend)
 
 (s/def ::backends
-  (s/keys :opt-un [::s3 ::fs ::db]))
+  (s/map-of ::us/keyword
+            (s/nilable
+             (s/or :s3 ::ss3/backend
+                   :fs ::sfs/backend
+                   :db ::sdb/backend))))
 
 (defmethod ig/pre-init-spec ::storage [_]
-  (s/keys :req-un [::backend ::wrk/executor ::db/pool ::backends]))
+  (s/keys :req-un [::wrk/executor ::db/pool ::backends]))
 
 (defmethod ig/prep-key ::storage
   [_ {:keys [backends] :as cfg}]
@@ -50,11 +48,12 @@
       (assoc :backends (d/without-nils backends))))
 
 (defmethod ig/init-key ::storage
-  [_ cfg]
-  cfg)
+  [_ {:keys [backends] :as cfg}]
+  (-> (d/without-nils cfg)
+      (assoc :backends (d/without-nils backends))))
 
 (s/def ::storage
-  (s/keys :req-un [::backends ::wrk/executor ::db/pool ::backend]))
+  (s/keys :req-un [::backends ::wrk/executor ::db/pool]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Database Objects
@@ -151,8 +150,6 @@
 ;; API
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(declare resolve-backend)
-
 (defn object->relative-path
   [{:keys [id] :as obj}]
   (impl/id->path id))
@@ -185,7 +182,7 @@
     (px/run! executor #(register-recheck storage backend (:id object)))
 
     ;; Store the data finally on the underlying storage subsystem.
-    (-> (resolve-backend storage backend)
+    (-> (impl/resolve-backend storage backend)
         (impl/put-object object content))
 
     object))
@@ -201,28 +198,37 @@
       ;; if the source and destination backends are the same, we
       ;; proceed to use the fast path with specific copy
       ;; implementation on backend.
-      (-> (resolve-backend storage (:backend storage))
+      (-> (impl/resolve-backend storage (:backend storage))
           (impl/copy-object object object*))
 
       ;; if the source and destination backends are different, we just
       ;; need to obtain the streams and proceed full copy of the data
-      (with-open [^InputStream input
-                  (-> (resolve-backend storage (:backend object))
-                      (impl/get-object-data object))]
-        (-> (resolve-backend storage (:backend storage))
-            (impl/put-object object* (impl/content input (:size object))))))
-
+      (with-open [is (-> (impl/resolve-backend storage (:backend object))
+                         (impl/get-object-data object))]
+        (-> (impl/resolve-backend storage (:backend storage))
+            (impl/put-object object* (impl/content is (:size object))))))
     object*))
 
 (defn get-object-data
+  "Return an input stream instance of the object content."
   [{:keys [pool conn] :as storage} object]
   (us/assert ::storage storage)
   (when (or (nil? (:expired-at object))
             (dt/is-after? (:expired-at object) (dt/now)))
     (-> (assoc storage :conn (or conn pool))
-        (resolve-backend (:backend object))
+        (impl/resolve-backend (:backend object))
         (impl/get-object-data object))))
 
+(defn get-object-bytes
+  "Returns a byte array of object content."
+  [{:keys [pool conn] :as storage} object]
+  (us/assert ::storage storage)
+  (when (or (nil? (:expired-at object))
+            (dt/is-after? (:expired-at object) (dt/now)))
+    (-> (assoc storage :conn (or conn pool))
+        (impl/resolve-backend (:backend object))
+        (impl/get-object-bytes object))))
+
 (defn get-object-url
   ([storage object]
    (get-object-url storage object nil))
@@ -231,14 +237,14 @@
    (when (or (nil? (:expired-at object))
              (dt/is-after? (:expired-at object) (dt/now)))
      (-> (assoc storage :conn (or conn pool))
-         (resolve-backend (:backend object))
+         (impl/resolve-backend (:backend object))
          (impl/get-object-url object options)))))
 
 (defn get-object-path
   "Get the Path to the object. Only works with `:fs` type of
   storages."
   [storage object]
-  (let [backend (resolve-backend storage (:backend object))]
+  (let [backend (impl/resolve-backend storage (:backend object))]
     (when (not= :fs (:type backend))
       (ex/raise :type :internal
                 :code :operation-not-allowed
@@ -254,16 +260,7 @@
   (-> (assoc storage :conn (or conn pool))
       (delete-database-object (if (uuid? id-or-obj) id-or-obj (:id id-or-obj)))))
 
-;; --- impl
-
-(defn resolve-backend
-  [{:keys [conn pool] :as storage} backend-id]
-  (let [backend (get-in storage [:backends backend-id])]
-    (when-not backend
-      (ex/raise :type :internal
-                :code :backend-not-configured
-                :hint (str/fmt "backend '%s' not configured" backend-id)))
-    (assoc backend :conn (or conn pool))))
+(d/export impl/resolve-backend)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Garbage Collection: Permanently delete objects
@@ -295,7 +292,7 @@
               (some-> (seq rows) (group-by-backend))))
 
           (delete-in-bulk [conn [backend ids]]
-            (let [backend (resolve-backend storage backend)
+            (let [backend (impl/resolve-backend storage backend)
                   backend (assoc backend :conn conn)]
               (impl/del-objects-in-bulk backend ids)))]
 
@@ -319,7 +316,7 @@
       where s.deleted_at is not null
         and s.deleted_at < (now() - ?::interval)
       order by s.deleted_at
-      limit 500
+      limit 100
    )
    delete from storage_object
     where id in (select id from items_part)
@@ -396,7 +393,7 @@
      from storage_object as so
     where so.touched_at is not null
     order by so.touched_at
-    limit 500;")
+    limit 100;")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Recheck Stalled Task
@@ -445,7 +442,7 @@
               (some-> (seq rows) (group-results))))
 
           (delete-group [conn [backend ids]]
-            (let [backend (resolve-backend storage backend)
+            (let [backend (impl/resolve-backend storage backend)
                   backend (assoc backend :conn conn)]
               (impl/del-objects-in-bulk backend ids)))
 

backend/src/app/storage/db.clj

@@ -46,12 +46,24 @@
   (let [result (db/exec-one! conn ["select data from storage_data where id=?" id])]
     (ByteArrayInputStream. (:data result))))
 
+(defmethod impl/get-object-bytes :db
+  [{:keys [conn] :as backend} {:keys [id] :as object}]
+  (let [result (db/exec-one! conn ["select data from storage_data where id=?" id])]
+    (:data result)))
+
 (defmethod impl/get-object-url :db
   [_ _]
   (throw (UnsupportedOperationException. "not supported")))
 
+(defmethod impl/del-object :db
+  [_ _]
+  ;; NOOP: because deleting the row already deletes the file data from
+  ;; the database.
+  nil)
+
 (defmethod impl/del-objects-in-bulk :db
   [_ _]
   ;; NOOP: because deleting the row already deletes the file data from
   ;; the database.
   nil)
+

backend/src/app/storage/fs.clj

@@ -79,6 +79,10 @@
                 :path (str full)))
     (io/input-stream full)))
 
+(defmethod impl/get-object-bytes :fs
+  [backend object]
+  (fs/slurp-bytes (impl/get-object-data backend object)))
+
 (defmethod impl/get-object-url :fs
   [{:keys [uri] :as backend} {:keys [id] :as object} _]
   (update uri :path
@@ -87,6 +91,13 @@
               (str existing (impl/id->path id))
               (str existing "/" (impl/id->path id))))))
 
+(defmethod impl/del-object :fs
+  [backend {:keys [id] :as object}]
+  (let [base (fs/path (:directory backend))
+        path (fs/path (impl/id->path id))
+        path (fs/join base path)]
+    (Files/deleteIfExists ^Path path)))
+
 (defmethod impl/del-objects-in-bulk :fs
   [backend ids]
   (let [base (fs/path (:directory backend))]
@@ -94,3 +105,4 @@
       (let [path (fs/path (impl/id->path id))
             path (fs/join base path)]
         (Files/deleteIfExists ^Path path)))))
+

backend/src/app/storage/impl.clj

@@ -8,10 +8,10 @@
   "Storage backends abstraction layer."
   (:require
    [app.common.exceptions :as ex]
-   [app.common.spec :as us]
    [app.common.uuid :as uuid]
    [buddy.core.codecs :as bc]
-   [clojure.java.io :as io])
+   [clojure.java.io :as io]
+   [cuerdas.core :as str])
   (:import
    java.nio.ByteBuffer
    java.util.UUID
@@ -45,6 +45,14 @@
             :code :invalid-storage-backend
             :context cfg))
 
+(defmulti get-object-bytes (fn [cfg _] (:type cfg)))
+
+(defmethod get-object-bytes :default
+  [cfg _]
+  (ex/raise :type :internal
+            :code :invalid-storage-backend
+            :context cfg))
+
 (defmulti get-object-url (fn [cfg _ _] (:type cfg)))
 
 (defmethod get-object-url :default
@@ -54,6 +62,14 @@
             :context cfg))
 
 
+(defmulti del-object (fn [cfg _] (:type cfg)))
+
+(defmethod del-object :default
+  [cfg _]
+  (ex/raise :type :internal
+            :code :invalid-storage-backend
+            :context cfg))
+
 (defmulti del-objects-in-bulk (fn [cfg _] (:type cfg)))
 
 (defmethod del-objects-in-bulk :default
@@ -62,7 +78,6 @@
             :code :invalid-storage-backend
             :context cfg))
 
-
 ;; --- HELPERS
 
 (defn uuid->hex
@@ -109,7 +124,10 @@
       (make-output-stream [_ opts]
         (throw (UnsupportedOperationException. "not implemented")))
       clojure.lang.Counted
-      (count [_] size))))
+      (count [_] size)
+
+    java.lang.AutoCloseable
+    (close [_]))))
 
 (defn string->content
   [^String v]
@@ -129,7 +147,10 @@
 
       clojure.lang.Counted
       (count [_]
-        (alength data)))))
+        (alength data))
+
+    java.lang.AutoCloseable
+    (close [_]))))
 
 (defn- input-stream->content
   [^InputStream is size]
@@ -137,7 +158,7 @@
     IContentObject
     io/IOFactory
     (make-reader [_ opts]
-	  (io/make-reader is opts))
+      (io/make-reader is opts))
     (make-writer [_ opts]
       (throw (UnsupportedOperationException. "not implemented")))
     (make-input-stream [_ opts]
@@ -145,8 +166,12 @@
     (make-output-stream [_ opts]
       (throw (UnsupportedOperationException. "not implemented")))
 
-      clojure.lang.Counted
-      (count [_] size)))
+    clojure.lang.Counted
+    (count [_] size)
+
+    java.lang.AutoCloseable
+    (close [_]
+      (.close is))))
 
 (defn content
   ([data] (content data nil))
@@ -179,10 +204,20 @@
 
 (defn slurp-bytes
   [content]
-  (us/assert content? content)
   (with-open [input  (io/input-stream content)
               output (java.io.ByteArrayOutputStream. (count content))]
     (io/copy input output)
     (.toByteArray output)))
 
+(defn resolve-backend
+  [{:keys [conn pool] :as storage} backend-id]
+  (when backend-id
+    (let [backend (get-in storage [:backends backend-id])]
+      (when-not backend
+        (ex/raise :type :internal
+                  :code :backend-not-configured
+                  :hint (str/fmt "backend '%s' not configured" backend-id)))
+      (assoc backend
+             :conn (or conn pool)
+             :id backend-id))))
 

backend/src/app/storage/s3.clj

@@ -5,7 +5,7 @@
 ;; Copyright (c) UXBOX Labs SL
 
 (ns app.storage.s3
-  "Storage backends abstraction layer."
+  "S3 Storage backend implementation."
   (:require
    [app.common.data :as d]
    [app.common.exceptions :as ex]
@@ -18,25 +18,34 @@
    [integrant.core :as ig])
   (:import
    java.time.Duration
+   java.io.InputStream
    java.util.Collection
    software.amazon.awssdk.core.sync.RequestBody
+   software.amazon.awssdk.core.ResponseBytes
+   ;; software.amazon.awssdk.core.ResponseInputStream
    software.amazon.awssdk.regions.Region
    software.amazon.awssdk.services.s3.S3Client
    software.amazon.awssdk.services.s3.model.Delete
    software.amazon.awssdk.services.s3.model.CopyObjectRequest
    software.amazon.awssdk.services.s3.model.DeleteObjectsRequest
    software.amazon.awssdk.services.s3.model.DeleteObjectsResponse
+   software.amazon.awssdk.services.s3.model.DeleteObjectRequest
    software.amazon.awssdk.services.s3.model.GetObjectRequest
    software.amazon.awssdk.services.s3.model.ObjectIdentifier
    software.amazon.awssdk.services.s3.model.PutObjectRequest
+   ;; software.amazon.awssdk.services.s3.model.GetObjectResponse
    software.amazon.awssdk.services.s3.presigner.S3Presigner
    software.amazon.awssdk.services.s3.presigner.model.GetObjectPresignRequest
-   software.amazon.awssdk.services.s3.presigner.model.PresignedGetObjectRequest))
+   software.amazon.awssdk.services.s3.presigner.model.PresignedGetObjectRequest
+
+   ))
 
 (declare put-object)
 (declare copy-object)
-(declare get-object)
+(declare get-object-bytes)
+(declare get-object-data)
 (declare get-object-url)
+(declare del-object)
 (declare del-object-in-bulk)
 (declare build-s3-client)
 (declare build-s3-presigner)
@@ -87,12 +96,20 @@
 
 (defmethod impl/get-object-data :s3
   [backend object]
-  (get-object backend object))
+  (get-object-data backend object))
+
+(defmethod impl/get-object-bytes :s3
+  [backend object]
+  (get-object-bytes backend object))
 
 (defmethod impl/get-object-url :s3
   [backend object options]
   (get-object-url backend object options))
 
+(defmethod impl/del-object :s3
+  [backend object]
+  (del-object backend object))
+
 (defmethod impl/del-objects-in-bulk :s3
   [backend ids]
   (del-object-in-bulk backend ids))
@@ -104,19 +121,19 @@
   (case region
     :eu-central-1 Region/EU_CENTRAL_1))
 
-(defn- build-s3-client
+(defn build-s3-client
   [{:keys [region]}]
   (.. (S3Client/builder)
       (region (lookup-region region))
       (build)))
 
-(defn- build-s3-presigner
+(defn build-s3-presigner
   [{:keys [region]}]
   (.. (S3Presigner/builder)
       (region (lookup-region region))
       (build)))
 
-(defn- put-object
+(defn put-object
   [{:keys [client bucket prefix]} {:keys [id] :as object} content]
   (let [path    (str prefix (impl/id->path id))
         mdata   (meta object)
@@ -125,14 +142,15 @@
                     (bucket bucket)
                     (contentType mtype)
                     (key path)
-                    (build))
-        content (RequestBody/fromInputStream (io/input-stream content)
-                                             (count content))]
-    (.putObject ^S3Client client
-                ^PutObjectRequest request
-                ^RequestBody content)))
+                    (build))]
 
-(defn- copy-object
+    (with-open [^InputStream is (io/input-stream content)]
+      (let [content (RequestBody/fromInputStream is (count content))]
+        (.putObject ^S3Client client
+                    ^PutObjectRequest request
+                    ^RequestBody content)))))
+
+(defn copy-object
   [{:keys [client bucket prefix]} src-object dst-object]
   (let [source-path  (str prefix (impl/id->path (:id src-object)))
         source-mdata (meta src-object)
@@ -146,22 +164,33 @@
                          (contentType source-mtype)
                          (build))]
 
-    (.copyObject ^S3Client client
-                 ^CopyObjectRequest request)))
+    (.copyObject ^S3Client client ^CopyObjectRequest request)))
 
-(defn- get-object
+(defn get-object-data
   [{:keys [client bucket prefix]} {:keys [id]}]
   (let [gor (.. (GetObjectRequest/builder)
                 (bucket bucket)
                 (key (str prefix (impl/id->path id)))
                 (build))
-        obj (.getObject ^S3Client client ^GetObjectRequest gor)]
+        obj (.getObject ^S3Client client ^GetObjectRequest gor)
+        ;; rsp (.response ^ResponseInputStream obj)
+        ;; len (.contentLength ^GetObjectResponse rsp)
+        ]
     (io/input-stream obj)))
 
+(defn get-object-bytes
+  [{:keys [client bucket prefix]} {:keys [id]}]
+  (let [gor (.. (GetObjectRequest/builder)
+                (bucket bucket)
+                (key (str prefix (impl/id->path id)))
+                (build))
+        obj (.getObjectAsBytes ^S3Client client ^GetObjectRequest gor)]
+    (.asByteArray ^ResponseBytes obj)))
+
 (def default-max-age
   (dt/duration {:minutes 10}))
 
-(defn- get-object-url
+(defn get-object-url
   [{:keys [presigner bucket prefix]} {:keys [id]} {:keys [max-age] :or {max-age default-max-age}}]
   (us/assert dt/duration? max-age)
   (let [gor  (.. (GetObjectRequest/builder)
@@ -175,7 +204,16 @@
         pgor (.presignGetObject ^S3Presigner presigner ^GetObjectPresignRequest gopr)]
     (u/uri (str (.url ^PresignedGetObjectRequest pgor)))))
 
-(defn- del-object-in-bulk
+(defn del-object
+  [{:keys [bucket client prefix]} {:keys [id] :as obj}]
+  (let [dor (.. (DeleteObjectRequest/builder)
+                (bucket bucket)
+                (key (str prefix (impl/id->path id)))
+                (build))]
+    (.deleteObject ^S3Client client
+                   ^DeleteObjectRequest dor)))
+
+(defn del-object-in-bulk
   [{:keys [bucket client prefix]} ids]
   (let [oids (map (fn [id]
                     (.. (ObjectIdentifier/builder)

backend/src/app/tasks/delete_object.clj

@@ -4,12 +4,16 @@
 ;;
 ;; Copyright (c) UXBOX Labs SL
 
+;; TODO: DEPRECATED
+;; Should be removed in the 1.8.x
+
 (ns app.tasks.delete-object
   "Generic task for permanent deletion of objects."
   (:require
    [app.common.data :as d]
    [app.common.spec :as us]
    [app.db :as db]
+   [app.storage :as sto]
    [app.util.logging :as l]
    [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
@@ -17,14 +21,15 @@
 (declare handle-deletion)
 
 (defmethod ig/pre-init-spec ::handler [_]
-  (s/keys :req-un [::db/pool]))
+  (s/keys :req-un [::db/pool ::sto/storage]))
 
 (defmethod ig/init-key ::handler
   [_ {:keys [pool] :as cfg}]
   (fn [{:keys [props] :as task}]
     (us/verify ::props props)
     (db/with-atomic [conn pool]
-      (handle-deletion conn props))))
+      (let [cfg (assoc cfg :conn conn)]
+        (handle-deletion cfg props)))))
 
 (s/def ::type ::us/keyword)
 (s/def ::id ::us/uuid)
@@ -34,21 +39,32 @@
   (fn [_ props] (:type props)))
 
 (defmethod handle-deletion :default
-  [_conn {:keys [type]}]
+  [_cfg {:keys [type]}]
   (l/warn :hint "no handler found"
           :type (d/name type)))
 
 (defmethod handle-deletion :file
-  [conn {:keys [id] :as props}]
+  [{:keys [conn]} {:keys [id] :as props}]
   (let [sql "delete from file where id=? and deleted_at is not null"]
     (db/exec-one! conn [sql id])))
 
 (defmethod handle-deletion :project
-  [conn {:keys [id] :as props}]
+  [{:keys [conn]} {:keys [id] :as props}]
   (let [sql "delete from project where id=? and deleted_at is not null"]
     (db/exec-one! conn [sql id])))
 
 (defmethod handle-deletion :team
-  [conn {:keys [id] :as props}]
+  [{:keys [conn]} {:keys [id] :as props}]
   (let [sql "delete from team where id=? and deleted_at is not null"]
     (db/exec-one! conn [sql id])))
+
+(defmethod handle-deletion :team-font-variant
+  [{:keys [conn storage]} {:keys [id] :as props}]
+  (let [font    (db/get-by-id conn :team-font-variant id {:uncheked true})
+        storage (assoc storage :conn conn)]
+    (when (:deleted-at font)
+      (db/delete! conn :team-font-variant {:id id})
+      (some->> (:woff1-file-id font) (sto/del-object storage))
+      (some->> (:woff2-file-id font) (sto/del-object storage))
+      (some->> (:otf-file-id font)   (sto/del-object storage))
+      (some->> (:ttf-file-id font)   (sto/del-object storage)))))

backend/src/app/tasks/delete_profile.clj

@@ -14,6 +14,9 @@
    [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
+;; TODO: DEPRECATED
+;; Should be removed in the 1.8.x
+
 (declare delete-profile-data)
 
 ;; --- INIT

backend/src/app/tasks/file_media_gc.clj

@@ -64,16 +64,21 @@
   (comp
    (map :objects)
    (mapcat vals)
-   (filter #(= :image (:type %)))
-   (map :metadata)
-   (map :id)))
+   (map (fn [{:keys [type] :as obj}]
+          (case type
+            :path (get-in obj [:fill-image :id])
+            :image (get-in obj [:metadata :id])
+            nil)))
+   (filter uuid?)))
 
 (defn- collect-used-media
   [data]
+  (let [pages (concat
+               (vals (:pages-index data))
+               (vals (:components data)))]
   (-> #{}
-      (into collect-media-xf (vals (:pages-index data)))
-      (into collect-media-xf (vals (:components data)))
-      (into (keys (:media data)))))
+      (into collect-media-xf pages)
+      (into (keys (:media data))))))
 
 (defn- process-file
   [{:keys [conn] :as cfg} {:keys [id data age] :as file}]
@@ -100,8 +105,12 @@
                :id (:id mobj)
                :media-id (:media-id mobj)
                :thumbnail-id (:thumbnail-id mobj))
+
       ;; NOTE: deleting the file-media-object in the database
-      ;; automatically marks as toched the referenced storage objects.
+      ;; automatically marks as toched the referenced storage
+      ;; objects. The touch mechanism is needed because many files can
+      ;; point to the same storage objects and we can't just delete
+      ;; them.
       (db/delete! conn :file-media-object {:id (:id mobj)}))
 
     nil))

backend/src/app/tasks/file_offload.clj

@@ -0,0 +1,63 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) UXBOX Labs SL
+
+(ns app.tasks.file-offload
+  "A maintenance task that offloads file data to an external storage (S3)."
+  (:require
+   [app.common.spec :as us]
+   [app.db :as db]
+   [app.storage :as sto]
+   [app.storage.impl :as simpl]
+   [app.util.logging :as l]
+   [app.util.time :as dt]
+   [clojure.spec.alpha :as s]
+   [integrant.core :as ig]))
+
+(def sql:offload-candidates-chunk
+  "select f.id, f.data from file as f
+    where f.data is not null
+      and f.modified_at < now() - ?::interval
+    order by f.modified_at
+    limit 10")
+
+(defn- retrieve-candidates
+  [{:keys [conn max-age]}]
+  (db/exec! conn [sql:offload-candidates-chunk max-age]))
+
+(defn- offload-candidate
+  [{:keys [storage conn backend] :as cfg} {:keys [id data] :as file}]
+  (l/debug :action "offload file data" :id id)
+  (let [backend (simpl/resolve-backend storage backend)]
+    (->> (simpl/content data)
+         (simpl/put-object backend file))
+    (db/update! conn :file
+                {:data nil
+                 :data-backend (name (:id backend))}
+                {:id id})))
+
+;; ---- STATE INIT
+
+(s/def ::max-age ::dt/duration)
+(s/def ::backend ::us/keyword)
+
+(defmethod ig/pre-init-spec ::handler [_]
+  (s/keys :req-un [::db/pool ::max-age ::sto/storage ::backend]))
+
+(defmethod ig/init-key ::handler
+  [_ {:keys [pool max-age] :as cfg}]
+  (fn [_]
+    (db/with-atomic [conn pool]
+      (let [max-age (db/interval max-age)
+            cfg     (-> cfg
+                        (assoc :conn conn)
+                        (assoc :max-age max-age))]
+        (loop [n 0]
+          (let [candidates (retrieve-candidates cfg)]
+            (if (seq candidates)
+              (do
+                (run! (partial offload-candidate cfg) candidates)
+                (recur (+ n (count candidates))))
+              (l/debug :hint "offload summary" :count n))))))))

backend/src/app/tasks/file_xlog_gc.clj

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

backend/src/app/tasks/objects_gc.clj

@@ -0,0 +1,171 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) UXBOX Labs SL
+
+(ns app.tasks.objects-gc
+  "A maintenance task that performs a general purpose garbage collection
+  of deleted objects."
+  (:require
+   [app.config :as cf]
+   [app.db :as db]
+   [app.storage :as sto]
+   [app.storage.impl :as simpl]
+   [app.util.logging :as l]
+   [app.util.time :as dt]
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [integrant.core :as ig]))
+
+(def target-tables
+  ["profile"
+   "team"
+   "file"
+   "project"
+   "team_font_variant"])
+
+(defmulti delete-objects :table)
+
+(def sql:delete-objects
+  "with deleted as (
+    select id from %(table)s
+     where deleted_at is not null
+       and deleted_at < now() - ?::interval
+     order by deleted_at
+     limit %(limit)s
+   )
+   delete from %(table)s
+    where id in (select id from deleted)
+   returning *")
+
+;; --- IMPL: generic object deletion
+
+(defmethod delete-objects :default
+  [{:keys [conn max-age table] :as cfg}]
+  (let [sql     (str/fmt sql:delete-objects
+                         {:table table :limit 50})
+        result  (db/exec! conn [sql max-age])]
+
+    (doseq [{:keys [id] :as item} result]
+      (l/trace :action "delete object" :table table :id id))
+
+    (count result)))
+
+
+;; --- IMPL: file deletion
+
+(defmethod delete-objects "file"
+  [{:keys [conn max-age table storage] :as cfg}]
+  (let [sql     (str/fmt sql:delete-objects
+                         {:table table :limit 50})
+        result  (db/exec! conn [sql max-age])
+        backend (simpl/resolve-backend storage (cf/get :fdata-storage-backend))]
+
+    (doseq [{:keys [id] :as item} result]
+      (l/trace :action "delete object" :table table :id id)
+      (when backend
+        (simpl/del-object backend item)))
+
+    (count result)))
+
+;; --- IMPL: team-font-variant deletion
+
+(defmethod delete-objects "team_font_variant"
+  [{:keys [conn max-age storage table] :as cfg}]
+  (let [sql     (str/fmt sql:delete-objects
+                         {:table table :limit 50})
+        fonts   (db/exec! conn [sql max-age])
+        storage (assoc storage :conn conn)]
+    (doseq [{:keys [id] :as font} fonts]
+      (l/trace :action "delete object" :table table :id id)
+      (some->> (:woff1-file-id font) (sto/del-object storage))
+      (some->> (:woff2-file-id font) (sto/del-object storage))
+      (some->> (:otf-file-id font)   (sto/del-object storage))
+      (some->> (:ttf-file-id font)   (sto/del-object storage)))
+    (count fonts)))
+
+;; --- IMPL: team deletion
+
+(defmethod delete-objects "team"
+  [{:keys [conn max-age storage table] :as cfg}]
+  (let [sql     (str/fmt sql:delete-objects
+                         {:table table :limit 50})
+        teams   (db/exec! conn [sql max-age])
+        storage (assoc storage :conn conn)]
+
+    (doseq [{:keys [id] :as team} teams]
+      (l/trace :action "delete object" :table table :id id)
+      (some->> (:photo-id team) (sto/del-object storage)))
+
+    (count teams)))
+
+;; --- IMPL: profile deletion
+
+(def sql:retrieve-deleted-profiles
+  "select id, photo_id from profile
+    where deleted_at is not null
+      and deleted_at < now() - ?::interval
+    order by deleted_at
+    limit %(limit)s
+    for update")
+
+(def sql:mark-owned-teams-deleted
+  "with owned as (
+    select tpr.team_id as id
+      from team_profile_rel as tpr
+     where tpr.is_owner is true
+       and tpr.profile_id = ?
+   )
+   update team set deleted_at = now() - ?::interval
+    where id in (select id from owned)")
+
+(defmethod delete-objects "profile"
+  [{:keys [conn max-age storage table] :as cfg}]
+  (let [sql      (str/fmt sql:retrieve-deleted-profiles {:limit 50})
+        profiles (db/exec! conn [sql max-age])
+        storage  (assoc storage :conn conn)]
+
+    (doseq [{:keys [id] :as profile} profiles]
+      (l/trace :action "delete object" :table table :id id)
+
+      ;; Mark the owned teams as deleted; this enables them to be procesed
+      ;; in the same transaction in the "team" table step.
+      (db/exec-one! conn [sql:mark-owned-teams-deleted id max-age])
+
+      ;; Mark as deleted the storage object related with the photo-id
+      ;; field.
+      (some->> (:photo-id profile) (sto/del-object storage))
+
+      ;; And finally, permanently delete the profile.
+      (db/delete! conn :profile {:id id}))
+
+    (count profiles)))
+
+;; --- INIT
+
+(defn- process-table
+  [{:keys [table] :as cfg}]
+  (loop [n 0]
+    (let [res (delete-objects cfg)]
+      (if (pos? res)
+        (recur (+ n res))
+        (l/debug :hint "table gc summary" :table table :deleted n)))))
+
+(s/def ::max-age ::dt/duration)
+
+(defmethod ig/pre-init-spec ::handler [_]
+  (s/keys :req-un [::db/pool ::sto/storage ::max-age]))
+
+(defmethod ig/init-key ::handler
+  [_ {:keys [pool max-age] :as cfg}]
+  (fn [task]
+    ;; Checking first on task argument allows properly testing it.
+    (let [max-age (get task :max-age max-age)]
+      (db/with-atomic [conn pool]
+        (let [max-age (db/interval max-age)
+              cfg     (-> cfg
+                          (assoc :max-age max-age)
+                          (assoc :conn conn))]
+          (doseq [table target-tables]
+            (process-table (assoc cfg :table table))))))))

backend/src/app/tasks/telemetry.clj

@@ -60,10 +60,9 @@
                                  :uri (:uri cfg)
                                  :headers {"content-type" "application/json"}
                                  :body (json/encode-str data)})]
-
-    (when (not= 200 (:status response))
+    (when (> (:status response) 206)
       (ex/raise :type :internal
-                :code :invalid-response-from-google
+                :code :invalid-response
                 :context {:status (:status response)
                           :body (:body response)}))))
 

backend/src/app/tokens.clj

@@ -9,21 +9,12 @@
   (:require
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
+   [app.common.transit :as t]
    [app.util.time :as dt]
-   [app.util.transit :as t]
-   [buddy.core.kdf :as bk]
    [buddy.sign.jwe :as jwe]
    [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
-(defn- derive-tokens-secret
-  [key]
-  (let [engine (bk/engine {:key key
-                           :salt "tokens"
-                           :alg :hkdf
-                           :digest :blake2b-512})]
-    (bk/get-bytes engine 32)))
-
 (defn- generate
   [cfg claims]
   (let [payload (t/encode claims)]
@@ -50,13 +41,6 @@
                 :params params))
     claims))
 
-(s/def ::secret-key ::us/string)
-(s/def ::sprops
-  (s/keys :req-un [::secret-key]))
-
-(defmethod ig/pre-init-spec ::tokens [_]
-  (s/keys :req-un [::sprops]))
-
 (defn- generate-predefined
   [cfg {:keys [iss profile-id] :as params}]
   (case iss
@@ -70,9 +54,14 @@
               :code :not-implemented
               :hint "no predefined token")))
 
+(s/def ::keys fn?)
+
+(defmethod ig/pre-init-spec ::tokens [_]
+  (s/keys :req-un [::keys]))
+
 (defmethod ig/init-key ::tokens
-  [_ {:keys [sprops] :as cfg}]
-  (let [secret (derive-tokens-secret (:secret-key sprops))
+  [_ {:keys [keys] :as cfg}]
+  (let [secret (keys :salt "tokens" :size 32)
         cfg    (assoc cfg ::secret secret)]
     (fn [action params]
       (case action

backend/src/app/util/async.clj

@@ -60,3 +60,44 @@
   (if (= executor ::default)
     `(a/thread-call (^:once fn* [] (try ~@body (catch Exception e# e#))))
     `(thread-call ~executor (^:once fn* [] ~@body))))
+
+(defn batch
+  [in {:keys [max-batch-size
+              max-batch-age
+              buffer-size
+              init]
+       :or {max-batch-size 200
+            max-batch-age (* 30 1000)
+            buffer-size 128
+            init #{}}
+       :as opts}]
+  (let [out (a/chan buffer-size)]
+    (a/go-loop [tch (a/timeout max-batch-age) buf init]
+      (let [[val port] (a/alts! [tch in])]
+        (cond
+          (identical? port tch)
+          (if (empty? buf)
+            (recur (a/timeout max-batch-age) buf)
+            (do
+              (a/>! out [:timeout buf])
+              (recur (a/timeout max-batch-age) init)))
+
+          (nil? val)
+          (if (empty? buf)
+            (a/close! out)
+            (do
+              (a/offer! out [:timeout buf])
+              (a/close! out)))
+
+          (identical? port in)
+          (let [buf (conj buf val)]
+            (if (>= (count buf) max-batch-size)
+              (do
+                (a/>! out [:size buf])
+                (recur (a/timeout max-batch-age) init))
+              (recur tch buf))))))
+    out))
+
+(defn thread-sleep
+  [ms]
+  (Thread/sleep ms))

backend/src/app/util/blob.clj

@@ -8,8 +8,8 @@
   "A generic blob storage encoding. Mainly used for page data, page
   options and txlog payload storage."
   (:require
+   [app.common.transit :as t]
    [app.config :as cf]
-   [app.util.transit :as t]
    [taoensso.nippy :as n])
   (:import
    java.io.ByteArrayInputStream
@@ -108,7 +108,7 @@
         cdata (byte-array mlen)
         clen  (Zstd/compressByteArray ^bytes cdata 0 mlen
                                       ^bytes data 0 dlen
-                                      4)]
+                                      6)]
     (with-open [^ByteArrayOutputStream baos (ByteArrayOutputStream. (+ (alength cdata) 2 4))
                 ^DataOutputStream dos (DataOutputStream. baos)]
       (.writeShort dos (short 3)) ;; version number

backend/src/app/util/logging.clj

@@ -60,8 +60,8 @@
           ^Object msg)))
 
 (defmacro log
-  [& {:keys [level cause ::logger ::async] :as props}]
-  (let [props      (dissoc props :level :cause ::logger ::async)
+  [& {:keys [level cause ::logger ::async ::raw] :as props}]
+  (let [props      (dissoc props :level :cause ::logger ::async ::raw)
         logger     (or logger (str *ns*))
         logger-sym (gensym "log")
         level-sym  (gensym "log")]
@@ -69,8 +69,12 @@
            ~level-sym  (get-level ~level)]
        (if (enabled? ~logger-sym ~level-sym)
          ~(if async
-            `(send-off logging-agent (fn [_#] (write-log! ~logger-sym ~level-sym ~cause (build-map-message ~props))))
-            `(write-log! ~logger-sym ~level-sym ~cause (build-map-message ~props)))))))
+            `(send-off logging-agent
+                       (fn [_#]
+                         (let [message# (or ~raw (build-map-message ~props))]
+                           (write-log! ~logger-sym ~level-sym ~cause message#))))
+            `(let [message# (or ~raw (build-map-message ~props))]
+               (write-log! ~logger-sym ~level-sym ~cause message#)))))))
 
 (defmacro info
   [& params]

backend/src/app/util/time.clj

@@ -10,13 +10,14 @@
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str])
   (:import
-   java.time.Instant
    java.time.Duration
-   java.util.Date
-   java.time.ZonedDateTime
+   java.time.Instant
+   java.time.OffsetDateTime
    java.time.ZoneId
+   java.time.ZonedDateTime
    java.time.format.DateTimeFormatter
    java.time.temporal.TemporalAmount
+   java.util.Date
    org.apache.logging.log4j.core.util.CronExpression))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -54,28 +55,37 @@
     (obj->duration ms-or-obj)))
 
 (defn duration-between
+  {:deprecated true}
   [t1 t2]
   (Duration/between t1 t2))
 
-(letfn [(conformer [v]
-          (cond
-            (duration? v) v
+(defn diff
+  [t1 t2]
+  (Duration/between t1 t2))
 
-            (string? v)
-            (try
-              (duration v)
-              (catch java.time.format.DateTimeParseException _e
-                ::s/invalid))
+(s/def ::duration
+  (s/conformer
+   (fn [v]
+     (cond
+       (duration? v) v
 
-            :else
-            ::s/invalid))
-        (unformer [v]
-          (subs (str v) 2))]
-  (s/def ::duration (s/conformer conformer unformer)))
+       (string? v)
+       (try
+         (duration v)
+         (catch java.time.format.DateTimeParseException _e
+           ::s/invalid))
+
+       :else
+       ::s/invalid))
+   (fn [v]
+     (subs (str v) 2))))
 
 (extend-protocol clojure.core/Inst
   java.time.Duration
-  (inst-ms* [v] (.toMillis ^Duration v)))
+  (inst-ms* [v] (.toMillis ^Duration v))
+
+  OffsetDateTime
+  (inst-ms* [v] (.toEpochMilli (.toInstant ^OffsetDateTime v))))
 
 (defmethod print-method Duration
   [mv ^java.io.Writer writer]

backend/src/app/worker.clj

@@ -98,11 +98,11 @@
           ;; Terminate the loop if close channel is closed or
           ;; event-loop-fn returns nil.
           (or (= port close-ch) (nil? val))
-          (l/debug :msg "stop condition found")
+          (l/debug :hint "stop condition found")
 
           (db/pool-closed? pool)
           (do
-            (l/debug :msg "eventloop aborted because pool is closed")
+            (l/debug :hint "eventloop aborted because pool is closed")
             (a/close! close-ch))
 
           (and (instance? java.sql.SQLException val)
@@ -115,7 +115,7 @@
           (and (instance? java.sql.SQLException val)
                (= "40001" (.getSQLState ^java.sql.SQLException val)))
           (do
-            (l/debug :msg "serialization failure (retrying in some instants)")
+            (l/debug :hint "serialization failure (retrying in some instants)")
             (a/<! (a/timeout poll-ms))
             (recur))
 
@@ -243,7 +243,7 @@
   (let [task-fn (get tasks name)]
     (if task-fn
       (task-fn item)
-      (l/warn :msg "no task handler found"
+      (l/warn :hint "no task handler found"
               :name (d/name name)))
     {:status :completed :task item}))
 
@@ -281,19 +281,13 @@
   [{:keys [tasks]} item]
   (let [name (d/name (:name item))]
     (try
-      (l/debug :action "start task"
-               :name name
+      (l/debug :action "execute task"
                :id (:id item)
+               :name name
                :retry (:retry-num item))
-
       (handle-task tasks item)
       (catch Exception e
-        (handle-exception e item))
-      (finally
-        (l/debug :action "end task"
-                 :name name
-                 :id (:id item)
-                 :retry (:retry-num item))))))
+        (handle-exception e item)))))
 
 (def sql:select-next-tasks
   "select * from task as t
@@ -442,7 +436,7 @@
   (s/assert dt/cron? cron)
   (let [now  (dt/now)
         next (dt/next-valid-instant-from cron now)]
-    (inst-ms (dt/duration-between now next))))
+    (inst-ms (dt/diff now next))))
 
 (defn- schedule-task
   [{:keys [scheduler] :as cfg} {:keys [cron] :as task}]

backend/test/app/bounce_handling_test.clj

@@ -4,16 +4,16 @@
 ;;
 ;; Copyright (c) UXBOX Labs SL
 
-(ns app.tests.test-bounces-handling
+(ns app.bounce-handling-test
   (:require
-   [clojure.pprint :refer [pprint]]
-   [app.http.awsns :as awsns]
-   [app.emails :as emails]
-   [app.tests.helpers :as th]
    [app.db :as db]
+   [app.emails :as emails]
+   [app.http.awsns :as awsns]
+   [app.test-helpers :as th]
    [app.util.time :as dt]
-   [mockery.core :refer [with-mocks]]
-   [clojure.test :as t]))
+   [clojure.pprint :refer [pprint]]
+   [clojure.test :as t]
+   [mockery.core :refer [with-mocks]]))
 
 (t/use-fixtures :once th/state-init)
 (t/use-fixtures :each th/database-reset)

backend/test/app/emails_test.clj

@@ -4,13 +4,13 @@
 ;;
 ;; Copyright (c) UXBOX Labs SL
 
-(ns app.tests.test-emails
+(ns app.emails-test
   (:require
    [clojure.test :as t]
    [promesa.core :as p]
    [app.db :as db]
    [app.emails :as emails]
-   [app.tests.helpers :as th]))
+   [app.test-helpers :as th]))
 
 (t/use-fixtures :once th/state-init)
 (t/use-fixtures :each th/database-reset)

backend/test/app/services_files_test.clj

@@ -4,13 +4,14 @@
 ;;
 ;; Copyright (c) UXBOX Labs SL
 
-(ns app.tests.test-services-files
+(ns app.services-files-test
   (:require
    [app.common.uuid :as uuid]
    [app.db :as db]
    [app.http :as http]
    [app.storage :as sto]
-   [app.tests.helpers :as th]
+   [app.test-helpers :as th]
+   [app.util.time :as dt]
    [clojure.test :as t]
    [datoteka.core :as fs]))
 
@@ -52,7 +53,7 @@
           (t/is (= (:id data) (:id result)))
           (t/is (= (:name data) (:name result))))))
 
-    (t/testing "query files"
+    (t/testing "query files (deprecated)"
       (let [data {::th/type :files
                   :project-id proj-id
                   :profile-id (:id prof)}
@@ -67,6 +68,20 @@
           (t/is (= "new name" (get-in result [0 :name])))
           (t/is (= 1 (count (get-in result [0 :data :pages])))))))
 
+    (t/testing "query files"
+      (let [data {::th/type :project-files
+                  :project-id proj-id
+                  :profile-id (:id prof)}
+            out  (th/query! data)]
+
+        ;; (th/print-result! out)
+        (t/is (nil? (:error out)))
+
+        (let [result (:result out)]
+          (t/is (= 1 (count result)))
+          (t/is (= file-id (get-in result [0 :id])))
+          (t/is (= "new name" (get-in result [0 :name]))))))
+
     (t/testing "query single file without users"
       (let [data {::th/type :file
                   :profile-id (:id prof)
@@ -120,7 +135,7 @@
 (t/deftest file-media-gc-task
   (letfn [(create-file-media-object [{:keys [profile-id file-id]}]
             (let [mfile  {:filename "sample.jpg"
-                          :tempfile (th/tempfile "app/tests/_files/sample.jpg")
+                          :tempfile (th/tempfile "app/test_files/sample.jpg")
                           :content-type "image/jpeg"
                           :size 312043}
                   params {::th/type :upload-file-media-object
@@ -323,3 +338,69 @@
       (t/is (th/ex-info? error))
       (t/is (th/ex-of-type? error :not-found))))
 
+(t/deftest deletion-test
+  (let [task     (:app.tasks.objects-gc/handler th/*system*)
+        profile1 (th/create-profile* 1)
+        file     (th/create-file* 1 {:project-id (:default-project-id profile1)
+                                     :profile-id (:id profile1)})]
+    ;; file is not deleted because it does not meet all
+    ;; conditions to be deleted.
+    (let [result (task {:max-age (dt/duration 0)})]
+      (t/is (nil? result)))
+
+    ;; query the list of files
+    (let [data {::th/type :project-files
+                :project-id (:default-project-id profile1)
+                :profile-id (:id profile1)}
+          out  (th/query! data)]
+      ;; (th/print-result! out)
+      (t/is (nil? (:error out)))
+      (let [result (:result out)]
+        (t/is (= 1 (count result)))))
+
+    ;; Request file to be deleted
+    (let [params {::th/type :delete-file
+                  :id (:id file)
+                  :profile-id (:id profile1)}
+          out    (th/mutation! params)]
+      (t/is (nil? (:error out))))
+
+    ;; query the list of files after soft deletion
+    (let [data {::th/type :project-files
+                :project-id (:default-project-id profile1)
+                :profile-id (:id profile1)}
+          out  (th/query! data)]
+      ;; (th/print-result! out)
+      (t/is (nil? (:error out)))
+      (let [result (:result out)]
+        (t/is (= 0 (count result)))))
+
+    ;; run permanent deletion (should be noop)
+    (let [result (task {:max-age (dt/duration {:minutes 1})})]
+      (t/is (nil? result)))
+
+    ;; query the list of file libraries of a after hard deletion
+    (let [data {::th/type :file-libraries
+                :file-id (:id file)
+                :profile-id (:id profile1)}
+          out  (th/query! data)]
+      ;; (th/print-result! out)
+      (t/is (nil? (:error out)))
+      (let [result (:result out)]
+        (t/is (= 0 (count result)))))
+
+    ;; run permanent deletion
+    (let [result (task {:max-age (dt/duration 0)})]
+      (t/is (nil? result)))
+
+    ;; query the list of file libraries of a after hard deletion
+    (let [data {::th/type :file-libraries
+                :file-id (:id file)
+                :profile-id (:id profile1)}
+          out  (th/query! data)]
+      ;; (th/print-result! out)
+      (let [error (:error out)
+            error-data (ex-data error)]
+        (t/is (th/ex-info? error))
+        (t/is (= (:type error-data) :not-found))))
+    ))

backend/test/app/services_fonts_test.clj

@@ -0,0 +1,94 @@
+;; 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.services-fonts-test
+  (:require
+   [app.common.uuid :as uuid]
+   [app.db :as db]
+   [app.http :as http]
+   [app.storage :as sto]
+   [app.test-helpers :as th]
+   [clojure.java.io :as io]
+   [clojure.test :as t]
+   [datoteka.core :as fs]))
+
+(t/use-fixtures :once th/state-init)
+(t/use-fixtures :each th/database-reset)
+
+(t/deftest ttf-font-upload-1
+  (let [prof    (th/create-profile* 1 {:is-active true})
+        team-id (:default-team-id prof)
+        proj-id (:default-project-id prof)
+        font-id (uuid/custom 10 1)
+
+        ttfdata (-> (io/resource "app/test_files/font-1.ttf")
+                    (fs/slurp-bytes))
+
+        params  {::th/type :create-font-variant
+                 :profile-id (:id prof)
+                 :team-id team-id
+                 :font-id font-id
+                 :font-family "somefont"
+                 :font-weight 400
+                 :font-style "normal"
+                 :data {"font/ttf" ttfdata}}
+        out     (th/mutation! params)]
+
+    ;; (th/print-result! out)
+    (t/is (nil? (:error out)))
+    (let [result (:result out)]
+      (t/is (uuid? (:id result)))
+      (t/is (uuid? (:ttf-file-id result)))
+      (t/is (uuid? (:otf-file-id result)))
+      (t/is (uuid? (:woff1-file-id result)))
+      (t/is (uuid? (:woff2-file-id result)))
+      (t/are [k] (= (get params k)
+                    (get result k))
+        :team-id
+        :font-id
+        :font-family
+        :font-weight
+        :font-style))))
+
+(t/deftest ttf-font-upload-2
+  (let [prof    (th/create-profile* 1 {:is-active true})
+        team-id (:default-team-id prof)
+        proj-id (:default-project-id prof)
+        font-id (uuid/custom 10 1)
+
+        data    (-> (io/resource "app/test_files/font-1.woff")
+                    (fs/slurp-bytes))
+
+        params  {::th/type :create-font-variant
+                 :profile-id (:id prof)
+                 :team-id team-id
+                 :font-id font-id
+                 :font-family "somefont"
+                 :font-weight 400
+                 :font-style "normal"
+                 :data {"font/woff" data}}
+        out     (th/mutation! params)]
+
+    ;; (th/print-result! out)
+    (t/is (nil? (:error out)))
+    (let [result (:result out)]
+      (t/is (uuid? (:id result)))
+      (t/is (uuid? (:ttf-file-id result)))
+      (t/is (uuid? (:otf-file-id result)))
+      (t/is (uuid? (:woff1-file-id result)))
+      (t/is (uuid? (:woff2-file-id result)))
+      (t/are [k] (= (get params k)
+                    (get result k))
+        :team-id
+        :font-id
+        :font-family
+        :font-weight
+        :font-style))))
+
+
+
+
+

backend/test/app/services_management_test.clj

@@ -4,13 +4,13 @@
 ;;
 ;; Copyright (c) UXBOX Labs SL
 
-(ns app.tests.test-services-management
+(ns app.services-management-test
   (:require
    [app.common.uuid :as uuid]
    [app.db :as db]
    [app.http :as http]
    [app.storage :as sto]
-   [app.tests.helpers :as th]
+   [app.test-helpers :as th]
    [clojure.test :as t]
    [buddy.core.bytes :as b]
    [datoteka.core :as fs]))

backend/test/app/services_media_test.clj

@@ -4,12 +4,12 @@
 ;;
 ;; Copyright (c) UXBOX Labs SL
 
-(ns app.tests.test-services-media
+(ns app.services-media-test
   (:require
    [app.common.uuid :as uuid]
    [app.db :as db]
    [app.storage :as sto]
-   [app.tests.helpers :as th]
+   [app.test-helpers :as th]
    [clojure.test :as t]
    [datoteka.core :as fs]))
 
@@ -57,7 +57,7 @@
                                    :project-id (:default-project-id prof)
                                    :is-shared false})
         mfile  {:filename "sample.jpg"
-                :tempfile (th/tempfile "app/tests/_files/sample.jpg")
+                :tempfile (th/tempfile "app/test_files/sample.jpg")
                 :content-type "image/jpeg"
                 :size 312043}
 

backend/test/app/services_profile_test.clj

@@ -4,16 +4,17 @@
 ;;
 ;; Copyright (c) UXBOX Labs SL
 
-(ns app.tests.test-services-profile
+(ns app.services-profile-test
   (:require
-   [clojure.test :as t]
-   [clojure.java.io :as io]
-   [mockery.core :refer [with-mocks]]
-   [cuerdas.core :as str]
-   [datoteka.core :as fs]
    [app.db :as db]
    [app.rpc.mutations.profile :as profile]
-   [app.tests.helpers :as th]))
+   [app.test-helpers :as th]
+   [app.util.time :as dt]
+   [clojure.java.io :as io]
+   [clojure.test :as t]
+   [cuerdas.core :as str]
+   [datoteka.core :as fs]
+   [mockery.core :refer [with-mocks]]))
 
 ;; TODO: profile deletion with teams
 ;; TODO: profile deletion with owner teams
@@ -108,7 +109,7 @@
                   :profile-id (:id profile)
                   :file {:filename "sample.jpg"
                          :size 123123
-                         :tempfile "tests/app/tests/_files/sample.jpg"
+                         :tempfile (th/tempfile "app/test_files/sample.jpg")
                          :content-type "image/jpeg"}}
             out  (th/mutation! data)]
 
@@ -117,7 +118,7 @@
     ))
 
 (t/deftest profile-deletion-simple
-  (let [task (:app.tasks.delete-profile/handler th/*system*)
+  (let [task (:app.tasks.objects-gc/handler th/*system*)
         prof (th/create-profile* 1)
         file (th/create-file* 1 {:profile-id (:id prof)
                                  :project-id (:default-project-id prof)
@@ -125,23 +126,14 @@
 
     ;; profile is not deleted because it does not meet all
     ;; conditions to be deleted.
-    (let [result (task {:props {:profile-id (:id prof)}})]
+    (let [result (task {:max-age (dt/duration 0)})]
       (t/is (nil? result)))
 
     ;; Request profile to be deleted
-    (with-mocks [mock {:target 'app.worker/submit! :return nil}]
-      (let [params {::th/type :delete-profile
-                    :profile-id (:id prof)}
-            out    (th/mutation! params)]
-        (t/is (nil? (:error out)))
-
-        ;; check the mock
-        (let [mock (deref mock)
-              mock-params (first (:call-args mock))]
-          (t/is (:called? mock))
-          (t/is (= 1 (:call-count mock)))
-          (t/is (= :delete-profile (:app.worker/task mock-params)))
-          (t/is (= (:id prof) (:profile-id mock-params))))))
+    (let [params {::th/type :delete-profile
+                  :profile-id (:id prof)}
+          out    (th/mutation! params)]
+      (t/is (nil? (:error out))))
 
     ;; query files after profile soft deletion
     (let [params {::th/type :files
@@ -153,8 +145,8 @@
       (t/is (= 1 (count (:result out)))))
 
     ;; execute permanent deletion task
-    (let [result (task {:props {:profile-id (:id prof)}})]
-      (t/is (true? result)))
+    (let [result (task {:max-age (dt/duration "-1m")})]
+      (t/is (nil? result)))
 
     ;; query profile after delete
     (let [params {::th/type :profile
@@ -165,148 +157,106 @@
             error-data (ex-data error)]
         (t/is (th/ex-info? error))
         (t/is (= (:type error-data) :not-found))))
-
-    ;; query files after profile soft deletion
-    (let [params {::th/type :files
-                  :project-id (:default-project-id prof)
-                  :profile-id (:id prof)}
-          out    (th/query! params)]
-        ;; (th/print-result! out)
-        (let [error (:error out)
-              error-data (ex-data error)]
-          (t/is (th/ex-info? error))
-          (t/is (= (:type error-data) :not-found))))
     ))
 
 (t/deftest registration-domain-whitelist
-  (let [whitelist "gmail.com, hey.com, ya.ru"]
+  (let [whitelist #{"gmail.com" "hey.com" "ya.ru"}]
     (t/testing "allowed email domain"
       (t/is (true? (profile/email-domain-in-whitelist? whitelist "username@ya.ru")))
-      (t/is (true? (profile/email-domain-in-whitelist? "" "username@somedomain.com"))))
+      (t/is (true? (profile/email-domain-in-whitelist? #{} "username@somedomain.com"))))
 
     (t/testing "not allowed email domain"
       (t/is (false? (profile/email-domain-in-whitelist? whitelist "username@somedomain.com"))))))
 
-(t/deftest test-register-with-no-terms-and-privacy
-  (let [data  {::th/type :register-profile
+(t/deftest prepare-register-and-register-profile
+  (let [data  {::th/type :prepare-register-profile
                :email "user@example.com"
-               :password "foobar"
-               :fullname "foobar"
-               :terms-privacy nil}
+               :password "foobar"}
         out   (th/mutation! data)
-        error (:error out)
-        edata (ex-data error)]
-    (t/is (th/ex-info? error))
-    (t/is (= (:type edata) :validation))
-    (t/is (= (:code edata) :spec-validation))))
+        token (get-in out [:result :token])]
+    (t/is (string? token))
 
-(t/deftest test-register-with-bad-terms-and-privacy
-  (let [data  {::th/type :register-profile
-               :email "user@example.com"
-               :password "foobar"
-               :fullname "foobar"
-               :terms-privacy false}
-        out   (th/mutation! data)
-        error (:error out)
-        edata (ex-data error)]
-    (t/is (th/ex-info? error))
-    (t/is (= (:type edata) :validation))
-    (t/is (= (:code edata) :invalid-terms-and-privacy))))
 
-(t/deftest test-register-when-registration-disabled
+    ;; try register without accepting terms
+    (let [data  {::th/type :register-profile
+                 :token token
+                 :fullname "foobar"
+                 :accept-terms-and-privacy false}
+          out   (th/mutation! data)]
+      (let [error (:error out)]
+        (t/is (th/ex-info? error))
+        (t/is (th/ex-of-type? error :validation))
+        (t/is (th/ex-of-code? error :invalid-terms-and-privacy))))
+
+    ;; try register without token
+    (let [data  {::th/type :register-profile
+                 :fullname "foobar"
+                 :accept-terms-and-privacy true}
+          out   (th/mutation! data)]
+      (let [error (:error out)]
+        (t/is (th/ex-info? error))
+        (t/is (th/ex-of-type? error :validation))
+        (t/is (th/ex-of-code? error :spec-validation))))
+
+    ;; try correct register
+    (let [data  {::th/type :register-profile
+                 :token token
+                 :fullname "foobar"
+                 :accept-terms-and-privacy true
+                 :accept-newsletter-subscription true}]
+      (let [{:keys [result error]} (th/mutation! data)]
+        (t/is (nil? error))
+        (t/is (true? (get-in result [:props :accept-newsletter-subscription])))
+        (t/is (true? (get-in result [:props :accept-terms-and-privacy])))))
+    ))
+
+(t/deftest prepare-register-with-registration-disabled
   (with-mocks [mock {:target 'app.config/get
                      :return (th/mock-config-get-with
                               {:registration-enabled false})}]
-    (let [data  {::th/type :register-profile
-                 :email "user@example.com"
-                 :password "foobar"
-                 :fullname "foobar"
-                 :terms-privacy true}
-          out   (th/mutation! data)
-          error (:error out)
-          edata (ex-data error)]
-      (t/is (th/ex-info? error))
-      (t/is (= (:type edata) :restriction))
-      (t/is (= (:code edata) :registration-disabled)))))
 
-(t/deftest test-register-existing-profile
+    (let [data  {::th/type :prepare-register-profile
+                 :email "user@example.com"
+                 :password "foobar"}]
+      (let [{:keys [result error] :as out} (th/mutation! data)]
+        (t/is (th/ex-info? error))
+        (t/is (th/ex-of-type? error :restriction))
+        (t/is (th/ex-of-code? error :registration-disabled))))))
+
+(t/deftest prepare-register-with-existing-user
   (let [profile (th/create-profile* 1)
-        data    {::th/type :register-profile
+        data    {::th/type :prepare-register-profile
                  :email (:email profile)
-                 :password "foobar"
-                 :fullname "foobar"
-                 :terms-privacy true}
-        out     (th/mutation! data)
-        error   (:error out)
-        edata   (ex-data error)]
-      (t/is (th/ex-info? error))
-      (t/is (= (:type edata) :validation))
-      (t/is (= (:code edata) :email-already-exists))))
-
-(t/deftest test-register-profile
-  (with-mocks [mock {:target 'app.emails/send!
-                     :return nil}]
-    (let [pool  (:app.db/pool th/*system*)
-          data  {::th/type :register-profile
-                 :email "user@example.com"
-                 :password "foobar"
-                 :fullname "foobar"
-                 :terms-privacy true}
-          out   (th/mutation! data)]
+                 :password "foobar"}]
+    (let [{:keys [result error] :as out} (th/mutation! data)]
       ;; (th/print-result! out)
-      (let [mock     (deref mock)
-            [params] (:call-args mock)]
-        ;; (clojure.pprint/pprint params)
-        (t/is (:called? mock))
-        (t/is (= (:email data) (:to params)))
-        (t/is (contains? params :extra-data))
-        (t/is (contains? params :token)))
-
-      (let [result (:result out)]
-        (t/is (false? (:is-demo result)))
-        (t/is (= (:email data) (:email result)))
-        (t/is (= "penpot" (:auth-backend result)))
-        (t/is (= "foobar" (:fullname result)))
-        (t/is (not (contains? result :password)))))))
+      (t/is (th/ex-info? error))
+      (t/is (th/ex-of-type? error :validation))
+      (t/is (th/ex-of-code? error :email-already-exists)))))
 
 (t/deftest test-register-profile-with-bounced-email
-  (with-mocks [mock {:target 'app.emails/send!
-                     :return nil}]
-    (let [pool  (:app.db/pool th/*system*)
-          data  {::th/type :register-profile
-                 :email "user@example.com"
-                 :password "foobar"
-                 :fullname "foobar"
-                 :terms-privacy true}
-          _     (th/create-global-complaint-for pool {:type :bounce :email "user@example.com"})
-          out   (th/mutation! data)]
-      ;; (th/print-result! out)
+  (let [pool  (:app.db/pool th/*system*)
+        data  {::th/type :prepare-register-profile
+               :email "user@example.com"
+               :password "foobar"}]
 
-      (let [mock (deref mock)]
-        (t/is (false? (:called? mock))))
+    (th/create-global-complaint-for pool {:type :bounce :email "user@example.com"})
 
-      (let [error (:error out)
-            edata (ex-data error)]
-        (t/is (th/ex-info? error))
-        (t/is (= (:type edata) :validation))
-        (t/is (= (:code edata) :email-has-permanent-bounces))))))
+    (let [{:keys [result error] :as out} (th/mutation! data)]
+      (t/is (th/ex-info? error))
+      (t/is (th/ex-of-type? error :validation))
+      (t/is (th/ex-of-code? error :email-has-permanent-bounces)))))
 
 (t/deftest test-register-profile-with-complained-email
-  (with-mocks [mock {:target 'app.emails/send! :return nil}]
-    (let [pool  (:app.db/pool th/*system*)
-          data  {::th/type :register-profile
-                 :email "user@example.com"
-                 :password "foobar"
-                 :fullname "foobar"
-                 :terms-privacy true}
-          _     (th/create-global-complaint-for pool {:type :complaint :email "user@example.com"})
-          out   (th/mutation! data)]
+  (let [pool  (:app.db/pool th/*system*)
+        data  {::th/type :prepare-register-profile
+               :email "user@example.com"
+               :password "foobar"}]
 
-      (let [mock (deref mock)]
-        (t/is (true? (:called? mock))))
-
-      (let [result (:result out)]
-        (t/is (= (:email data) (:email result)))))))
+    (th/create-global-complaint-for pool {:type :complaint :email "user@example.com"})
+    (let [{:keys [result error] :as out} (th/mutation! data)]
+      (t/is (nil? error))
+      (t/is (string? (:token result))))))
 
 (t/deftest test-email-change-request
   (with-mocks [email-send-mock {:target 'app.emails/send! :return nil}

backend/test/app/services_projects_test.clj

@@ -4,14 +4,14 @@
 ;;
 ;; Copyright (c) UXBOX Labs SL
 
-(ns app.tests.test-services-projects
+(ns app.services-projects-test
   (:require
-   [clojure.test :as t]
-   [promesa.core :as p]
+   [app.common.uuid :as uuid]
    [app.db :as db]
    [app.http :as http]
-   [app.tests.helpers :as th]
-   [app.common.uuid :as uuid]))
+   [app.test-helpers :as th]
+   [app.util.time :as dt]
+   [clojure.test :as t]))
 
 (t/use-fixtures :once th/state-init)
 (t/use-fixtures :each th/database-reset)
@@ -170,3 +170,71 @@
     (t/is (th/ex-info? error))
     (t/is (th/ex-of-type? error :not-found))))
 
+
+(t/deftest test-deletion
+  (let [task     (:app.tasks.objects-gc/handler th/*system*)
+        profile1 (th/create-profile* 1)
+        project  (th/create-project* 1 {:team-id (:default-team-id profile1)
+                                        :profile-id (:id profile1)})]
+
+    ;; project is not deleted because it does not meet all
+    ;; conditions to be deleted.
+    (let [result (task {:max-age (dt/duration 0)})]
+      (t/is (nil? result)))
+
+    ;; query the list of projects
+    (let [data {::th/type :projects
+                :team-id (:default-team-id profile1)
+                :profile-id (:id profile1)}
+          out  (th/query! data)]
+      ;; (th/print-result! out)
+      (t/is (nil? (:error out)))
+      (let [result (:result out)]
+        (t/is (= 2 (count result)))))
+
+    ;; Request project to be deleted
+    (let [params {::th/type :delete-project
+                  :id (:id project)
+                  :profile-id (:id profile1)}
+          out    (th/mutation! params)]
+      (t/is (nil? (:error out))))
+
+    ;; query the list of projects after soft deletion
+    (let [data {::th/type :projects
+                :team-id (:default-team-id profile1)
+                :profile-id (:id profile1)}
+          out  (th/query! data)]
+      ;; (th/print-result! out)
+      (t/is (nil? (:error out)))
+      (let [result (:result out)]
+        (t/is (= 1 (count result)))))
+
+    ;; run permanent deletion (should be noop)
+    (let [result (task {:max-age (dt/duration {:minutes 1})})]
+      (t/is (nil? result)))
+
+    ;; query the list of files of a after soft deletion
+    (let [data {::th/type :project-files
+                :project-id (:id project)
+                :profile-id (:id profile1)}
+          out  (th/query! data)]
+      ;; (th/print-result! out)
+      (t/is (nil? (:error out)))
+      (let [result (:result out)]
+        (t/is (= 0 (count result)))))
+
+    ;; run permanent deletion
+    (let [result (task {:max-age (dt/duration 0)})]
+      (t/is (nil? result)))
+
+    ;; query the list of files of a after hard deletion
+    (let [data {::th/type :project-files
+                :project-id (:id project)
+                :profile-id (:id profile1)}
+          out  (th/query! data)]
+      ;; (th/print-result! out)
+      (let [error (:error out)
+            error-data (ex-data error)]
+        (t/is (th/ex-info? error))
+        (t/is (= (:type error-data) :not-found))))
+    ))

backend/test/app/services_teams_test.clj

@@ -4,16 +4,17 @@
 ;;
 ;; Copyright (c) UXBOX Labs SL
 
-(ns app.tests.test-services-teams
+(ns app.services-teams-test
   (:require
    [app.common.uuid :as uuid]
    [app.db :as db]
    [app.http :as http]
    [app.storage :as sto]
-   [app.tests.helpers :as th]
-   [mockery.core :refer [with-mocks]]
+   [app.test-helpers :as th]
+   [app.util.time :as dt]
    [clojure.test :as t]
-   [datoteka.core :as fs]))
+   [datoteka.core :as fs]
+   [mockery.core :refer [with-mocks]]))
 
 (t/use-fixtures :once th/state-init)
 (t/use-fixtures :each th/database-reset)
@@ -80,6 +81,80 @@
 
       )))
 
+(t/deftest test-deletion
+  (let [task     (:app.tasks.objects-gc/handler th/*system*)
+        profile1 (th/create-profile* 1 {:is-active true})
+        team     (th/create-team* 1 {:profile-id (:id profile1)})
+        pool     (:app.db/pool th/*system*)
+        data     {::th/type :delete-team
+                  :team-id (:id team)
+                  :profile-id (:id profile1)}]
+
+    ;; team is not deleted because it does not meet all
+    ;; conditions to be deleted.
+    (let [result (task {:max-age (dt/duration 0)})]
+      (t/is (nil? result)))
+
+    ;; query the list of teams
+    (let [data {::th/type :teams
+                :profile-id (:id profile1)}
+          out  (th/query! data)]
+      ;; (th/print-result! out)
+      (t/is (nil? (:error out)))
+      (let [result (:result out)]
+        (t/is (= 2 (count result)))
+        (t/is (= (:id team) (get-in result [1 :id])))
+        (t/is (= (:default-team-id profile1) (get-in result [0 :id])))))
+
+    ;; Request team to be deleted
+    (let [params {::th/type :delete-team
+                  :id (:id team)
+                  :profile-id (:id profile1)}
+          out    (th/mutation! params)]
+      (t/is (nil? (:error out))))
+
+    ;; query the list of teams after soft deletion
+    (let [data {::th/type :teams
+                :profile-id (:id profile1)}
+          out  (th/query! data)]
+      ;; (th/print-result! out)
+      (t/is (nil? (:error out)))
+      (let [result (:result out)]
+        (t/is (= 1 (count result)))
+        (t/is (= (:default-team-id profile1) (get-in result [0 :id])))))
+
+    ;; run permanent deletion (should be noop)
+    (let [result (task {:max-age (dt/duration {:minutes 1})})]
+      (t/is (nil? result)))
+
+    ;; query the list of projects of a after hard deletion
+    (let [data {::th/type :projects
+                :team-id (:id team)
+                :profile-id (:id profile1)}
+          out  (th/query! data)]
+      ;; (th/print-result! out)
+
+      (t/is (nil? (:error out)))
+      (let [result (:result out)]
+        (t/is (= 0 (count result)))))
+
+    ;; run permanent deletion
+    (let [result (task {:max-age (dt/duration 0)})]
+      (t/is (nil? result)))
+
+    ;; query the list of projects of a after hard deletion
+    (let [data {::th/type :projects
+                :team-id (:id team)
+                :profile-id (:id profile1)}
+          out  (th/query! data)]
+      ;; (th/print-result! out)
+      (let [error (:error out)
+            error-data (ex-data error)]
+        (t/is (th/ex-info? error))
+        (t/is (= (:type error-data) :not-found))))
+    ))
+
+
 
 
 

backend/test/app/services_viewer_test.clj

@@ -4,13 +4,13 @@
 ;;
 ;; Copyright (c) UXBOX Labs SL
 
-(ns app.tests.test-services-viewer
+(ns app.services-viewer-test
   (:require
-   [clojure.test :as t]
-   [datoteka.core :as fs]
    [app.common.uuid :as uuid]
    [app.db :as db]
-   [app.tests.helpers :as th]))
+   [app.test-helpers :as th]
+   [clojure.test :as t]
+   [datoteka.core :as fs]))
 
 (t/use-fixtures :once th/state-init)
 (t/use-fixtures :each th/database-reset)

backend/test/app/storage_test.clj

@@ -4,12 +4,12 @@
 ;;
 ;; Copyright (c) UXBOX Labs SL
 
-(ns app.tests.test-storage
+(ns app.storage-test
   (:require
    [app.common.exceptions :as ex]
    [app.db :as db]
    [app.storage :as sto]
-   [app.tests.helpers :as th]
+   [app.test-helpers :as th]
    [app.util.time :as dt]
    [clojure.java.io :as io]
    [clojure.test :as t]
@@ -22,7 +22,6 @@
                        th/database-reset
                        th/clean-storage))
 
-;; TODO: add specific tests for DB backend.
 
 (t/deftest put-and-retrieve-object
   (let [storage (:app.storage/storage th/*system*)
@@ -106,7 +105,7 @@
                                     :project-id (:default-project-id prof)
                                     :is-shared false})
         mfile   {:filename "sample.jpg"
-                 :tempfile (th/tempfile "app/tests/_files/sample.jpg")
+                 :tempfile (th/tempfile "app/test_files/sample.jpg")
                  :content-type "image/jpeg"
                  :size 312043}
 
@@ -167,7 +166,7 @@
                                     :project-id (:default-project-id prof)
                                     :is-shared false})
         mfile   {:filename "sample.jpg"
-                 :tempfile (th/tempfile "app/tests/_files/sample.jpg")
+                 :tempfile (th/tempfile "app/test_files/sample.jpg")
                  :content-type "image/jpeg"
                  :size 312043}