📎 Update version.txt file.

🐛 Fix problem with masking images in viewer

.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,14 +1,31 @@
-{: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
   {:level :warning}
 
+  :potok/reify-type
+  {:level :error}
+
   :unresolved-namespace
   {:level :warning
    :exclude [data_readers]}
@@ -16,12 +33,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,68 @@
+(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}))
+
+(def registry (atom {}))
+
+(defn potok-reify
+  [{:keys [:node :filename] :as params}]
+  (let [[rnode rtype & other] (:children node)
+        rsym (symbol (str "event-type-" (name (:k rtype))))
+        reg  (get @registry filename #{})]
+    (when-not (:namespaced? rtype)
+      (let [{:keys [:row :col]} (meta rtype)]
+        (api/reg-finding! {:message "ptk/reify type should be namespaced"
+                           :type :potok/reify-type
+                           :row row
+                           :col col})))
+
+    (if (contains? reg rsym)
+      (let [{:keys [:row :col]} (meta rtype)]
+        (api/reg-finding! {:message (str "duplicate type: " (name (:k rtype)))
+                           :type :potok/reify-type
+                           :row row
+                           :col col}))
+      (swap! registry update filename (fnil conj #{}) rsym))
+
+    (let [result  (api/list-node
+                   (into [(api/token-node (symbol "deftype"))
+                          (api/token-node rsym)
+                          (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

@@ -30,6 +30,8 @@ node_modules
 /exporter/target
 /exporter/.shadow-cljs
 /docker/images/bundle*
+/common/.shadow-cljs
+/common/target
 /.clj-kondo/.cache
 /bundle*
 /media

CHANGES.md

@@ -1,15 +1,195 @@
-# CHANGELOG #
-
+# CHANGELOG
 
 ## :rocket: Next
 
+### :boom: Breaking changes
 ### :sparkles: New features
-
 ### :bug: Bugs fixed
 ### :arrow_up: Deps updates
 ### :boom: Breaking changes
 ### :heart: Community contributions by (Thank you!)
 
+## 1.8.2-alpha
+
+### :bug: Bugs fixed
+
+- Fix problem with masking images in viewer [#1238](https://github.com/penpot/penpot/issues/1238)
+
+## 1.8.1-alpha
+
+### :bug: Bugs fixed
+
+- Fix project renaming issue (and some other related to the same underlying bug).
+- Fix internal exception on audit log persistence layer.
+- Set proper environment variable on docker images for chrome executable.
+- Fix internal metrics on websocket connections.
+
+
+## 1.8.0-alpha
+
+### :boom: Breaking changes
+
+- This release includes a new approach for handling share links, and
+  this feature is incompatible with the previous one. This means that
+  all the public share links generated previously will stop working.
+
+### :sparkles: New features
+
+- Add tooltips to color picker tabs [Taiga #1814](https://tree.taiga.io/project/penpot/us/1814).
+- Add styling to the end point of any open paths [Taiga #1107](https://tree.taiga.io/project/penpot/us/1107).
+- Allow to zoom with ctrl + middle button [Taiga #1428](https://tree.taiga.io/project/penpot/us/1428).
+- Auto placement of duplicated objects [Taiga #1386](https://tree.taiga.io/project/penpot/us/1386).
+- Enable penpot SVG metadata only when exporting complete files [Taiga #1914](https://tree.taiga.io/project/penpot/us/1914?milestone=295883).
+- Export to PDF all artboards of one page [Taiga #1895](https://tree.taiga.io/project/penpot/us/1895).
+- Go to a undo step clicking on a history element of the list [Taiga #1374](https://tree.taiga.io/project/penpot/us/1374).
+- Increment font size by 10 with shift+arrows [1047](https://github.com/penpot/penpot/issues/1047).
+- New shortcut to detach components Ctrl+Shift+K [Taiga #1799](https://tree.taiga.io/project/penpot/us/1799).
+- Set email inputs to type "email", to aid keyboard entry [Taiga #1921](https://tree.taiga.io/project/penpot/issue/1921).
+- Use shift+move to move element orthogonally [#823](https://github.com/penpot/penpot/issues/823).
+- Use space + mouse drag to pan, instead of only space [Taiga #1800](https://tree.taiga.io/project/penpot/us/1800).
+- Allow navigate through pages on the viewer [Taiga #1550](https://tree.taiga.io/project/penpot/us/1550).
+- Allow create share links with specific pages [Taiga #1844](https://tree.taiga.io/project/penpot/us/1844).
+
+### :bug: Bugs fixed
+
+- Prevent adding numeric suffix to layer names when not needed [Taiga #1929](https://tree.taiga.io/project/penpot/us/1929).
+- Prevent deleting or moving the drafts project [Taiga #1935](https://tree.taiga.io/project/penpot/issue/1935).
+- Fix problem with zoom and selection [Taiga #1919](https://tree.taiga.io/project/penpot/issue/1919)
+- Fix problem with borders on shape export [#1092](https://github.com/penpot/penpot/issues/1092)
+- Fix thumbnail cropping issue [Taiga #1964](https://tree.taiga.io/project/penpot/issue/1964)
+- Fix repeated fetch on file selection [Taiga #1933](https://tree.taiga.io/project/penpot/issue/1933)
+- Fix rename typography on text options [Taiga #1963](https://tree.taiga.io/project/penpot/issue/1963)
+- Fix problems with order in groups [Taiga #1960](https://tree.taiga.io/project/penpot/issue/1960)
+- Fix SVG components preview [#1134](https://github.com/penpot/penpot/issues/1134)
+- Fix group renaming problem [Taiga #1969](https://tree.taiga.io/project/penpot/issue/1969)
+- Fix problem with import broken images links [#1197](https://github.com/penpot/penpot/issues/1197)
+- Fix problem while moving imported SVG's [#1199](https://github.com/penpot/penpot/issues/1199)
+
+### :arrow_up: Deps updates
+### :boom: Breaking changes
+### :heart: Community contributions by (Thank you!)
+
+- eduayme [#1129](https://github.com/penpot/penpot/pull/1129).
+
+
+## 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.
+
+### :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)
+
+
+## 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
 

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.3"}
-  org.clojure/core.async {:mvn/version "1.3.618"}
-  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.40"}
-  expound/expound {:mvn/version "0.8.9"}
-  com.cognitect/transit-clj {:mvn/version "1.0.324"}
-
   io.lettuce/lettuce-core {:mvn/version "6.1.2.RELEASE"}
   java-http-clj/java-http-clj {:mvn/version "0.4.2"}
 
   info.sunng/ring-jetty9-adapter {:mvn/version "0.15.1"}
   com.github.seancorfield/next.jdbc {:mvn/version "1.2.659"}
   metosin/reitit-ring {:mvn/version "0.5.13"}
-  metosin/jsonista {:mvn/version "0.3.3"}
-
   org.postgresql/postgresql {:mvn/version "42.2.20"}
   com.zaxxer/HikariCP {:mvn/version "4.0.3"}
 
   funcool/datoteka {:mvn/version "2.0.0"}
-  funcool/promesa {:mvn/version "6.0.1"}
-  funcool/cuerdas {:mvn/version "2021.05.09-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.62"}
+  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 "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/emails-mjml/register/en.mjml

@@ -22,7 +22,7 @@
         <mj-text font-size="24px" font-weight="600">Hello {{name}}!</mj-text>
         <mj-text>
           Thanks for signing up for your Penpot account! Please verify your
-          email using the link below adn get started building mockups and
+          email using the link below and get started building mockups and
           prototypes today!
         </mj-text>
         <mj-button href="{{ public-uri }}/#/auth/verify-token?token={{token}}">

backend/resources/emails/register/en.html

@@ -173,7 +173,7 @@
                   </tr>
                   <tr>
                     <td align="left" style="font-size:0px;padding:10px 25px;word-break:break-word;">
-                      <div style="font-family:Source Sans Pro, sans-serif;font-size:16px;line-height:150%;text-align:left;color:#000000;">Thanks for signing up for your Penpot account! Please verify your email using the link below adn get started building mockups and prototypes today!</div>
+                      <div style="font-family:Source Sans Pro, sans-serif;font-size:16px;line-height:150%;text-align:left;color:#000000;">Thanks for signing up for your Penpot account! Please verify your email using the link below and get started building mockups and prototypes today!</div>
                     </td>
                   </tr>
                   <tr>
@@ -465,4 +465,4 @@
   </div>
 </body>
 
-</html>
+</html>

backend/resources/emails/register/en.txt

@@ -1,7 +1,7 @@
 Hello {{name}}!
 
 Thanks for signing up for your Penpot account! Please verify your email using the
-link below adn get started building mockups and prototypes today!
+link below and get started building mockups and prototypes today!
 
 {{ public-uri }}/#/auth/verify-token?token={{token}}
 

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,7 @@
 
 export PENPOT_ASSERTS_ENABLED=true
 
-export OPTIONS="-A:jmx-remote:dev -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager -J-Dlog4j2.configurationFile=log4j2-devenv.xml -J-XX:+UseZGC -J-XX:ConcGCThreads=1 -J-XX:-OmitStackTraceInFastThrow -J-Xms50m -J-Xmx512m";
+export OPTIONS="-A:jmx-remote:dev -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager -J-Dlog4j2.configurationFile=log4j2-devenv.xml -J-Djdk.attach.allowAttachSelf -J-XX:+UseZGC -J-XX:ConcGCThreads=1 -J-XX:-OmitStackTraceInFastThrow -J-Xms50m -J-Xmx512m";
 # export OPTIONS="$OPTIONS -J-XX:+UnlockDiagnosticVMOptions";
 # export OPTIONS="$OPTIONS -J-XX:-TieredCompilation -J-XX:CompileThreshold=10000";
 

backend/src/app/config.clj

@@ -58,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
@@ -175,10 +172,14 @@
 (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-uri ::us/string)
 (s/def ::telemetry-with-taiga ::us/boolean)
@@ -257,12 +258,20 @@
                    ::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-uri
                    ::telemetry-referer

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]
@@ -221,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}]
+  ([ds table params {:keys [check-not-found] :or {check-not-found true} :as opts}]
    (let [res (exec-one! ds (sql/select table params opts))]
-     (when (and (not uncheked)
-                (or (:deleted-at res) (not res)))
+     (when (and check-not-found (or (not res) (is-deleted? res)))
        (ex/raise :type :not-found
+                 :table table
                  :hint "database object not found"))
      res)))
 
@@ -245,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]
@@ -257,13 +267,28 @@
   (instance? PGpoint v))
 
 (defn pgarray?
-  [v]
-  (instance? PgArray v))
+  ([v] (instance? PgArray v))
+  ([v type]
+   (and (instance? PgArray v)
+        (= type (.getBaseTypeName ^PgArray v)))))
 
 (defn pgarray-of-uuid?
   [v]
   (and (pgarray? v) (= "uuid" (.getBaseTypeName ^PgArray v))))
 
+(defn decode-pgarray
+  ([v] (into [] (.getArray ^PgArray v)))
+  ([v in] (into in (.getArray ^PgArray v)))
+  ([v in xf] (into in xf (.getArray ^PgArray v))))
+
+(defn pgarray->set
+  [v]
+  (set (.getArray ^PgArray v)))
+
+(defn pgarray->vector
+  [v]
+  (vec (.getArray ^PgArray v)))
+
 (defn pgpoint
   [p]
   (PGpoint. (:x p) (:y p)))
@@ -275,7 +300,6 @@
       (.createArrayOf conn ^String type (into-array Object objects))
       (.createArrayOf conn ^String type objects))))
 
-
 (defn decode-pgpoint
   [^PGpoint v]
   (gpt/point (.-x v) (.-y v)))
@@ -339,12 +363,18 @@
     (.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."
@@ -353,10 +383,23 @@
     (.setType "jsonb")
     (.setValue (json/encode-str data))))
 
-(defn pgarray->set
-  [v]
-  (set (.getArray ^PgArray v)))
+;; --- Locks
 
-(defn pgarray->vector
-  [v]
-  (vec (.getArray ^PgArray v)))
+(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

@@ -43,8 +43,8 @@
   ([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

@@ -114,9 +114,14 @@
 (s/def ::storage map?)
 (s/def ::assets map?)
 (s/def ::feedback fn?)
+(s/def ::error-report-handler fn?)
+(s/def ::audit-http-handler fn?)
 
 (defmethod ig/pre-init-spec ::router [_]
-  (s/keys :req-un [::rpc ::session ::mtx/metrics ::oauth ::storage ::assets ::feedback]))
+  (s/keys :req-un [::rpc ::session ::mtx/metrics
+                   ::oauth ::storage ::assets ::feedback
+                   ::error-report-handler
+                   ::audit-http-handler]))
 
 (defmethod ig/init-key ::router
   [_ {:keys [session rpc oauth metrics assets feedback] :as cfg}]
@@ -147,10 +152,12 @@
 
      ["/feedback" {:middleware [(:middleware session)]
                    :post feedback}]
-
      ["/auth/oauth/:provider" {:post (:handler oauth)}]
      ["/auth/oauth/:provider/callback" {:get (:callback-handler oauth)}]
 
+     ["/audit/events" {:middleware [(:middleware session)]
+                       :post (:audit-http-handler cfg)}]
+
      ["/rpc" {:middleware [(:middleware session)]}
       ["/query/:type" {:get (:query-handler rpc)
                        :post (:query-handler rpc)}]

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/middleware.clj

@@ -6,10 +6,10 @@
 
 (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]
@@ -74,16 +74,14 @@
    :compile (constantly wrap-parse-request-body)})
 
 (defn- impl-format-response-body
-  [response]
+  [response _request]
   (let [body (:body response)
-        type :json-verbose]
+        opts {:type :json}]
     (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 (t/encode body opts)))
 
       (nil? body)
       (assoc response :status 204 :body "")
@@ -96,7 +94,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))]
@@ -146,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
@@ -175,6 +150,63 @@
              {}
              params))
 
+(defn- retrieve-profile
+  [{:keys [pool] :as cfg} info]
+  (with-open [conn (db/open pool)]
+    (some->> (:email info)
+             (profile/retrieve-profile-data-by-email conn)
+             (profile/populate-additional-data conn)
+             (profile/decode-profile-row))))
+
+(defn- redirect-response
+  [uri]
+  {:status 302
+   :headers {"location" (str uri)}
+   :body ""})
+
+(defn- generate-error-redirect
+  [cfg error]
+  (let [uri (-> (u/uri (:public-uri cfg))
+                (assoc :path "/#/auth/login")
+                (assoc :query (u/map->query-string {:error "unable-to-auth" :hint (ex-message error)})))]
+    (redirect-response uri)))
+
+(defn- generate-redirect
+  [{:keys [tokens session audit] :as cfg} request info profile]
+  (if profile
+    (let [sxf    ((:create session) (:id profile))
+          token  (or (:invitation-token info)
+                     (tokens :generate {:iss :auth
+                                        :exp (dt/in-future "15m")
+                                        :profile-id (:id profile)}))
+          params {:token token}
+
+          uri    (-> (u/uri (:public-uri cfg))
+                     (assoc :path "/#/auth/verify-token")
+                     (assoc :query (u/map->query-string params)))]
+
+      (when (fn? audit)
+        (audit :cmd :submit
+               :type "mutation"
+               :name "login"
+               :profile-id (:id profile)
+               :ip-addr (audit/parse-client-ip request)
+               :props (audit/profile->props profile)))
+
+      (->> (redirect-response uri)
+           (sxf request)))
+    (let [info   (assoc info
+                        :iss :prepared-register
+                        :exp (dt/in-future {:hours 48}))
+          token  (tokens :generate info)
+          params (d/without-nils
+                  {:token token
+                   :fullname (:fullname info)})
+          uri    (-> (u/uri (:public-uri cfg))
+                     (assoc :path "/#/auth/register/validate")
+                     (assoc :query (u/map->query-string params)))]
+      (redirect-response uri))))
+
 (defn- auth-handler
   [{:keys [tokens] :as cfg} {:keys [params] :as request}]
   (let [invitation (:invitation-token params)
@@ -189,17 +221,15 @@
      :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
 
@@ -210,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]
@@ -225,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)

backend/src/app/http/session.clj

@@ -140,10 +140,13 @@
       (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)

backend/src/app/loggers/audit.clj

@@ -7,8 +7,10 @@
 (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]
@@ -16,12 +18,25 @@
    [app.util.http :as http]
    [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]
+   [cuerdas.core :as str]
    [integrant.core :as ig]
-   [lambdaisland.uri :as u]))
+   [lambdaisland.uri :as u]
+   [promesa.exec :as px]))
+
+(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}]
@@ -50,8 +65,68 @@
                            (assoc k (name v))))
                        {}
                        props))]
+
     (update event :props #(-> % clean-common clean-profile-id clean-complex-data))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; HTTP Handler
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare persist-http-events)
+
+(s/def ::profile-id ::us/uuid)
+(s/def ::name ::us/string)
+(s/def ::type ::us/string)
+(s/def ::props (s/map-of ::us/keyword any?))
+(s/def ::timestamp dt/instant?)
+(s/def ::context (s/map-of ::us/keyword any?))
+
+(s/def ::event
+  (s/keys :req-un [::type ::name ::props ::timestamp ::profile-id]
+          :opt-un [::context]))
+
+(s/def ::events (s/every ::event))
+
+(defmethod ig/init-key ::http-handler
+  [_  {:keys [executor enabled] :as cfg}]
+  (fn [{:keys [params _headers _cookies profile-id] :as request}]
+    (when enabled
+      (let [events  (->> (:events params)
+                         (remove #(not= profile-id (:profile-id %)))
+                         (us/conform ::events))
+            ip-addr (parse-client-ip request)
+            cfg     (-> cfg
+                        (assoc :source "frontend")
+                        (assoc :events events)
+                        (assoc :ip-addr ip-addr))]
+        (px/run! executor #(persist-http-events cfg))))
+    {:status 204 :body ""}))
+
+(defn- persist-http-events
+  [{:keys [pool events ip-addr source] :as cfg}]
+  (try
+    (let [columns    [:id :name :source :type :tracked-at :profile-id :ip-addr :props :context]
+          prepare-xf (map (fn [event]
+                            [(uuid/next)
+                             (:name event)
+                             source
+                             (:type event)
+                             (:timestamp event)
+                             (:profile-id event)
+                             (db/inet ip-addr)
+                             (db/tjson (:props event))
+                             (db/tjson (d/without-nils (:context event)))]))
+          events     (us/conform ::events events)
+          rows       (into [] prepare-xf events)]
+      (db/insert-multi! pool :audit-log columns rows))
+    (catch Throwable e
+      (let [xdata (ex-data e)]
+        (if (= :spec-validation (:code xdata))
+          (l/error ::l/raw (str "spec validation on persist-events:\n"
+                                (:explain xdata)))
+          (l/error :hint "error on persist-events"
+                   :cause e))))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Collector
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -75,26 +150,26 @@
   [_ {:keys [enabled] :as cfg}]
   (when enabled
     (l/info :msg "intializing audit collector")
-    (let [input  (a/chan 1 event-xform)
+    (let [input  (a/chan 512 event-xform)
           buffer (aa/batch input {:max-batch-size 100
-                                  :max-batch-age (* 5 1000)
+                                  :max-batch-age (* 10 1000) ; 10s
                                   :init []})]
       (a/go-loop []
-        (when-let [[type events] (a/<! buffer)]
-          (l/debug :action "persist-events (batch)"
-                   :reason (name type)
-                   :count (count events))
+        (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 [& [cmd & params]]
-        (case cmd
-          :stop (a/close! input)
-          :submit (when-not (a/offer! input (first params))
-                    (l/warn :msg "activity channel is full")))))))
+      (fn [& {:keys [cmd] :as params}]
+        (let [params (-> params
+                         (dissoc :cmd)
+                         (assoc :tracked-at (dt/now)))]
+          (case cmd
+            :stop   (a/close! input)
+            :submit (when-not (a/offer! input params)
+                      (l/warn :msg "activity channel is full"))))))))
 
 
 (defn- persist-events
@@ -104,13 +179,16 @@
              (:name event)
              (:type event)
              (:profile-id event)
-             (db/tjson (:props event))])]
-
+             (:tracked-at event)
+             (some-> (:ip-addr event) db/inet)
+             (db/tjson (:props event))
+             "backend"])]
     (aa/with-thread executor
-      (db/with-atomic [conn pool]
-        (db/insert-multi! conn :audit-log
-                          [:id :name :type :profile-id :props]
-                          (sequence (map event->row) events))))))
+      (when (seq events)
+        (db/with-atomic [conn pool]
+          (db/insert-multi! conn :audit-log
+                            [:id :name :type :profile-id :tracked-at :ip-addr :props :source]
+                            (sequence (map event->row) events)))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Archive Task
@@ -130,16 +208,22 @@
 
 (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))))))
+  (fn [props]
+    ;; NOTE: this let allows overwrite default configured values from
+    ;; the repl, when manually invoking the task.
+    (let [enabled (or enabled (:enabled props false))
+          uri     (or uri (:uri props))
+          cfg     (assoc cfg :uri uri)]
+      (when (and enabled (not uri))
+        (ex/raise :type :internal
+                  :code :task-not-configured
+                  :hint "archive task not configured, missing uri"))
+      (when enabled
+        (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
@@ -150,17 +234,27 @@
 
 (defn archive-events
   [{:keys [pool uri tokens] :as cfg}]
-  (letfn [(decode-row [{:keys [props] :as row}]
+  (letfn [(decode-row [{:keys [props ip-addr context] :as row}]
             (cond-> row
               (db/pgobject? props)
-              (assoc :props (db/decode-transit-pgobject props))))
+              (assoc :props (db/decode-transit-pgobject props))
 
-          (row->event [{:keys [name type created-at profile-id props]}]
-            {:type type
-             :name name
-             :timestamp created-at
-             :profile-id profile-id
-             :props props})
+              (db/pgobject? context)
+              (assoc :context (db/decode-transit-pgobject context))
+
+              (db/pgobject? ip-addr "inet")
+              (assoc :ip-addr (db/decode-inet ip-addr))))
+
+          (row->event [row]
+            (select-keys row [:type
+                              :name
+                              :source
+                              :created-at
+                              :tracked-at
+                              :profile-id
+                              :ip-addr
+                              :props
+                              :context]))
 
           (send [events]
             (let [token   (tokens :generate {:iss "authentication"
@@ -171,7 +265,7 @@
                            "origin" (cf/get :public-uri)
                            "cookie" (u/map->query-string {:auth-token token})}
                   params  {:uri uri
-                           :timeout 5000
+                           :timeout 6000
                            :method :post
                            :headers headers
                            :body body}
@@ -190,7 +284,6 @@
 
     (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)]

backend/src/app/loggers/loki.clj

@@ -31,7 +31,7 @@
   [_ {:keys [receiver uri] :as cfg}]
   (when uri
     (l/info :msg "intializing loki reporter" :uri uri)
-    (let [input (a/chan (a/sliding-buffer 1024))]
+    (let [input (a/chan (a/dropping-buffer 512))]
       (receiver :sub input)
       (a/go-loop []
         (let [msg (a/<! input)]
@@ -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] :as cdata}]
+  [cfg {:keys [host id] :as cdata}]
   (try
     (let [uri  (:uri cfg)
-          text (str "Unhandled exception:\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

@@ -28,11 +28,24 @@
      {:name "actions_profile_register_count"
       :help "A global counter of user registrations."
       :type :counter}
+
      :profile-activation
      {:name "actions_profile_activation_count"
       :help "A global counter of profile activations"
+      :type :counter}
+
+     :update-file-changes
+     {:name "rpc_update_file_changes_total"
+      :help "A total number of changes submitted to update-file."
+      :type :counter}
+
+     :update-file-bytes-processed
+     {:name "rpc_update_file_bytes_processed_total"
+      :help "A total number of bytes processed by update-file."
       :type :counter}}}
 
+
+
    :app.migrations/all
    {:main (ig/ref :app.migrations/migrations)}
 
@@ -44,7 +57,7 @@
     :redis-uri (cf/get :redis-uri)}
 
    :app.tokens/tokens
-   {:props (ig/ref :app.setup/props)}
+   {:keys (ig/ref :app.setup/keys)}
 
    :app.storage/gc-deleted-task
    {:pool     (ig/ref :app.db/pool)
@@ -90,11 +103,12 @@
     :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)
     :feedback    (ig/ref :app.http.feedback/handler)
+    :audit-http-handler   (ig/ref :app.loggers.audit/http-handler)
     :error-report-handler (ig/ref :app.loggers.mattermost/handler)}
 
    :app.http.assets/handlers
@@ -107,10 +121,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
@@ -166,27 +182,34 @@
     :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})
@@ -203,6 +226,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)
@@ -213,6 +237,7 @@
      :tasks-gc           (ig/ref :app.tasks.tasks-gc/handler)
      :telemetry          (ig/ref :app.tasks.telemetry/handler)
      :session-gc         (ig/ref :app.http.session/gc-task)
+     :file-offload       (ig/ref :app.tasks.file-offload/handler)
      :audit-archive      (ig/ref :app.loggers.audit/archive-task)
      :audit-archive-gc   (ig/ref :app.loggers.audit/archive-gc-task)}}
 
@@ -230,31 +255,33 @@
 
    :app.tasks.tasks-gc/handler
    {:pool    (ig/ref :app.db/pool)
-    :max-age cf/deletion-delay
-    :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 cf/deletion-delay}
 
    :app.tasks.file-xlog-gc/handler
    {:pool    (ig/ref :app.db/pool)
-    :metrics (ig/ref :app.metrics/metrics)
-    :max-age cf/deletion-delay}
+    :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)
@@ -270,9 +297,17 @@
    {: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/http-handler
+   {:enabled  (cf/get :audit-enabled false)
+    :pool     (ig/ref :app.db/pool)
+    :executor (ig/ref :app.worker/executor)}
+
    :app.loggers.audit/collector
    {:enabled  (cf/get :audit-enabled false)
     :pool     (ig/ref :app.db/pool)
@@ -306,23 +341,34 @@
    :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)}})
 
 (def system nil)

backend/src/app/media.clj

@@ -11,6 +11,7 @@
    [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]
@@ -28,10 +29,6 @@
    org.im4java.core.IMOperation
    org.im4java.core.Info))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; --- Utility functions
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
 (s/def ::image-content-type cm/valid-image-types)
 (s/def ::font-content-type cm/valid-font-types)
 
@@ -330,3 +327,17 @@
               (= 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))))
+

backend/src/app/metrics.clj

@@ -92,18 +92,14 @@
         _        (when (seq labels)
                    (.labelNames instance (into-array String labels)))
         instance (.register instance registry)]
-    (reify
-      clojure.lang.IDeref
-      (deref [_] instance)
 
-      clojure.lang.IFn
-      (invoke [_ cmd]
-        (.inc ^Counter instance))
-
-      (invoke [_ cmd labels]
-        (.. ^Counter instance
-            (labels (into-array String labels))
-            (inc))))))
+    {::instance instance
+     ::fn (fn [{:keys [by labels] :or {by 1}}]
+            (if labels
+              (.. ^Counter instance
+                  (labels (into-array String labels))
+                  (inc by))
+              (.inc ^Counter instance by)))}))
 
 (defn make-gauge
   [{:keys [name help registry reg labels] :as props}]
@@ -115,21 +111,16 @@
                    (.labelNames instance (into-array String labels)))
         instance (.register instance registry)]
 
-    (reify
-      clojure.lang.IDeref
-      (deref [_] instance)
-
-      clojure.lang.IFn
-      (invoke [_ cmd]
-        (case cmd
-          :inc (.inc ^Gauge instance)
-          :dec (.dec ^Gauge instance)))
-
-      (invoke [_ cmd labels]
-        (let [labels (into-array String [labels])]
-          (case cmd
-            :inc (.. ^Gauge instance (labels labels) (inc))
-            :dec (.. ^Gauge instance (labels labels) (dec))))))))
+    {::instance instance
+     ::fn (fn [{:keys [cmd by labels] :or {by 1}}]
+            (if labels
+              (let [labels (into-array String [labels])]
+                (case cmd
+                  :inc (.. ^Gauge instance (labels labels) (inc by))
+                  :dec (.. ^Gauge instance (labels labels) (dec by))))
+              (case cmd
+                :inc (.inc ^Gauge instance by)
+                :dec (.dec ^Gauge instance by))))}))
 
 (def default-quantiles
   [[0.75 0.02]
@@ -150,18 +141,14 @@
         _        (when (seq labels)
                    (.labelNames instance (into-array String labels)))
         instance (.register instance registry)]
-    (reify
-      clojure.lang.IDeref
-      (deref [_] instance)
 
-      clojure.lang.IFn
-      (invoke [_ cmd val]
-        (.observe ^Summary instance val))
-
-      (invoke [_ cmd val labels]
-        (.. ^Summary instance
-            (labels (into-array String labels))
-            (observe val))))))
+    {::instance instance
+     ::fn (fn [{:keys [val labels]}]
+            (if labels
+              (.. ^Summary instance
+                  (labels (into-array String labels))
+                  (observe val))
+              (.observe ^Summary instance val)))}))
 
 (def default-histogram-buckets
   [1 5 10 25 50 75 100 250 500 750 1000 2500 5000 7500])
@@ -177,18 +164,14 @@
         _        (when (seq labels)
                    (.labelNames instance (into-array String labels)))
         instance (.register instance registry)]
-    (reify
-      clojure.lang.IDeref
-      (deref [_] instance)
 
-      clojure.lang.IFn
-      (invoke [_ cmd val]
-        (.observe ^Histogram instance val))
-
-      (invoke [_ cmd val labels]
-        (.. ^Histogram instance
-            (labels (into-array String labels))
-            (observe val))))))
+    {::instance instance
+     ::fn (fn [{:keys [val labels]}]
+            (if labels
+              (.. ^Histogram instance
+                  (labels (into-array String labels))
+                  (observe val))
+              (.observe ^Histogram instance val)))}))
 
 (defn create
   [{:keys [type] :as props}]
@@ -205,14 +188,20 @@
      (with-meta
        (fn
          ([a]
-          (mobj :inc)
+          ((::fn mobj) nil)
           (origf a))
          ([a b]
-          (mobj :inc)
+          ((::fn mobj) nil)
           (origf a b))
-         ([a b & more]
-          (mobj :inc)
-          (apply origf a b more)))
+         ([a b c]
+          ((::fn mobj) nil)
+          (origf a b c))
+         ([a b c d]
+          ((::fn mobj) nil)
+          (origf a b c d))
+         ([a b c d & more]
+          ((::fn mobj) nil)
+          (apply origf a b c d more)))
        (assoc mdata ::original origf))))
   ([rootf mobj labels]
    (let [mdata  (meta rootf)
@@ -220,13 +209,13 @@
      (with-meta
        (fn
          ([a]
-          (mobj :inc labels)
+          ((::fn mobj) {:labels labels})
           (origf a))
          ([a b]
-          (mobj :inc labels)
+          ((::fn mobj) {:labels labels})
           (origf a b))
          ([a b & more]
-          (mobj :inc labels)
+          ((::fn mobj) {:labels labels})
           (apply origf a b more)))
        (assoc mdata ::original origf)))))
 
@@ -239,15 +228,15 @@
          ([a]
          (with-measure
            :expr (origf a)
-           :cb   #(mobj :observe %)))
+           :cb   #((::fn mobj) {:val %})))
          ([a b]
           (with-measure
             :expr (origf a b)
-            :cb   #(mobj :observe %)))
+            :cb   #((::fn mobj) {:val %})))
          ([a b & more]
           (with-measure
             :expr (apply origf a b more)
-            :cb   #(mobj :observe %))))
+            :cb   #((::fn mobj) {:val %}))))
        (assoc mdata ::original origf))))
 
   ([rootf mobj labels]
@@ -258,26 +247,26 @@
          ([a]
          (with-measure
            :expr (origf a)
-           :cb   #(mobj :observe % labels)))
+           :cb   #((::fn mobj) {:val % :labels labels})))
          ([a b]
           (with-measure
             :expr (origf a b)
-            :cb   #(mobj :observe % labels)))
+            :cb   #((::fn mobj) {:val % :labels labels})))
          ([a b & more]
           (with-measure
             :expr (apply origf a b more)
-            :cb   #(mobj :observe % labels))))
+            :cb   #((::fn mobj) {:val % :labels labels}))))
        (assoc mdata ::original origf)))))
 
 (defn instrument-vars!
   [vars {:keys [wrap] :as props}]
   (let [obj (create props)]
     (cond
-      (instance? Counter @obj)
+      (instance? Counter (::instance obj))
       (doseq [var vars]
         (alter-var-root var (or wrap wrap-counter) obj))
 
-      (instance? Summary @obj)
+      (instance? Summary (::instance obj))
       (doseq [var vars]
         (alter-var-root var (or wrap wrap-summary) obj))
 
@@ -288,13 +277,13 @@
   [f {:keys [wrap] :as props}]
   (let [obj (create props)]
     (cond
-      (instance? Counter @obj)
+      (instance? Counter (::instance obj))
       ((or wrap wrap-counter) f obj)
 
-      (instance? Summary @obj)
+      (instance? Summary (::instance obj))
       ((or wrap wrap-summary) f obj)
 
-      (instance? Histogram @obj)
+      (instance? Histogram (::instance obj))
       ((or wrap wrap-summary) f obj)
 
       :else

backend/src/app/migrations.clj

@@ -175,6 +175,33 @@
 
    {: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")}
+
+   {:name "0062-fix-metadata-media"
+    :fn (mg/resource "app/migrations/sql/0062-fix-metadata-media.sql")}
+
+   {:name "0063-add-share-link-table"
+    :fn (mg/resource "app/migrations/sql/0063-add-share-link-table.sql")}
+
+   {:name "0064-mod-audit-log-table"
+    :fn (mg/resource "app/migrations/sql/0064-mod-audit-log-table.sql")}
    ])
 
 

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/migrations/sql/0063-add-share-link-table.sql

@@ -0,0 +1,12 @@
+CREATE TABLE share_link (
+  id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
+  file_id uuid NOT NULL REFERENCES file(id) ON DELETE CASCADE DEFERRABLE,
+  owner_id uuid NULL REFERENCES profile(id) ON DELETE SET NULL DEFERRABLE,
+  created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
+
+  pages uuid[],
+  flags text[]
+);
+
+CREATE INDEX share_link_file_id_idx ON share_link(file_id);
+CREATE INDEX share_link_owner_id_idx ON share_link(owner_id);

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

@@ -0,0 +1,13 @@
+ALTER TABLE audit_log
+  ADD COLUMN tracked_at timestamptz NULL DEFAULT clock_timestamp(),
+  ADD COLUMN source text NULL,
+  ADD COLUMN context jsonb NULL;
+
+ALTER TABLE audit_log
+  ALTER COLUMN source SET STORAGE external,
+  ALTER COLUMN context SET STORAGE external;
+
+UPDATE audit_log SET source = 'backend', tracked_at=created_at;
+
+-- ALTER TABLE audit_log ALTER COLUMN source SET NOT NULL;
+-- ALTER TABLE audit_log ALTER COLUMN tracked_at SET NOT NULL;

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]
@@ -135,7 +135,7 @@
         ws-send      (mtx/wrap-counter ws-send mtx-messages ["send"])]
 
     (letfn [(on-connect [conn]
-              (mtx-aconn :inc)
+              ((::mtx/fn mtx-aconn) {:cmd :inc :by 1})
               ;; A subscription channel should use a lossy buffer
               ;; because we can't penalize normal clients when one
               ;; slow client is connected to the room.
@@ -162,8 +162,8 @@
                   (a/<! (handle-connect cfg))
 
                   ;; when connection is closed
-                  (mtx-aconn :dec)
-                  (mtx-sessions :observe (/ (inst-ms (dt/duration-between created-at (dt/now))) 1000.0))
+                  ((::mtx/fn mtx-aconn) {:cmd :dec :by 1})
+                  ((::mtx/fn mtx-sessions) {:val (/ (inst-ms (dt/diff created-at (dt/now))) 1000.0)})
 
                   ;; close subscription
                   (a/close! sub-ch))))

backend/src/app/rpc.clj

@@ -32,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)
@@ -50,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,7 +89,6 @@
         (rlm/execute rlinst (f cfg params))))
     f))
 
-
 (defn- wrap-impl
   [{:keys [audit] :as cfg} f mdata]
   (let [f      (wrap-with-rlimits cfg f mdata)
@@ -95,23 +98,34 @@
 
     (l/trace :action "register" :name (::sv/name mdata))
     (fn [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"))
-      (let [params  (us/conform spec params)
-            result  (f cfg params)
-            resultm (meta result)]
-        (when (and (::type cfg) (fn? audit))
-          (let [profile-id (or (:profile-id 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 :submit {:type (::type cfg)
-                            :name (or (::audit/name resultm)
-                                      (::sv/name mdata))
-                            :profile-id profile-id
-                            :props props})))
+                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 props)))
+
         result))))
 
 (defn- process-method
@@ -161,6 +175,7 @@
                      'app.rpc.mutations.management
                      'app.rpc.mutations.ldap
                      'app.rpc.mutations.fonts
+                     'app.rpc.mutations.share-link
                      'app.rpc.mutations.verify-token)
          (map (partial process-method cfg))
          (into {}))))

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

@@ -15,7 +15,7 @@
    [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]))
@@ -35,6 +35,7 @@
                   :email email
                   :fullname fullname
                   :is-demo true
+                  :deleted-at (dt/in-future cfg/deletion-delay)
                   :password password
                   :props {:onboarding-viewed true}}]
 
@@ -48,12 +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})
-
       (with-meta {:email email
                   :password password}
         {::audit/profile-id id}))))

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

@@ -11,17 +11,19 @@
    [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.metrics :as mtx]
    [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 +34,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 +45,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 +53,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 +111,6 @@
               {:is-shared is-shared}
               {:id id}))
 
-
 ;; --- Mutation: Delete File
 
 (declare mark-file-deleted)
@@ -122,13 +123,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 +169,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 +189,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 +201,6 @@
               {:file-id file-id
                :library-file-id library-id}))
 
-
 ;; --- Mutation: Ignore updates in linked files
 
 (declare ignore-sync)
@@ -216,7 +209,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)))
@@ -278,28 +271,53 @@
 (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 changes-with-metadata session-id profile-id] :as params}]
+  [{:keys [conn metrics] :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 [changes (if changes-with-metadata
+  (let [mtx1    (get-in metrics [:definitions :update-file-changes])
+        mtx2    (get-in metrics [:definitions :update-file-bytes-processed])
+
+        changes (if changes-with-metadata
                   (mapcat :changes changes-with-metadata)
                   changes)
 
-        file    (-> file
+        ;; Trace the number of changes processed
+        _       ((::mtx/fn mtx1) {:by (count changes)})
+
+        ts      (dt/now)
+        file    (-> (files/retrieve-data cfg file)
                     (update :revn inc)
                     (update :data (fn [data]
+                                    ;; Trace the length of bytes of processed data
+                                    ((::mtx/fn mtx2) {:by (alength data)})
                                     (-> data
                                         (blob/decode)
                                         (assoc :id (:id file))
@@ -311,26 +329,55 @@
                 {: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 (-> params (assoc :file file
-                                   :changes changes))]
+    ;; 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)]
@@ -362,17 +409,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

@@ -6,6 +6,7 @@
 
 (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]
@@ -47,7 +48,9 @@
 (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 (assoc storage :conn conn)
+        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"}))
@@ -64,6 +67,13 @@
                   (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)
@@ -104,21 +114,10 @@
   (db/with-atomic [conn pool]
     (teams/check-edition-permissions! conn profile-id team-id)
 
-    (let [items (db/query conn :team-font-variant
-                          {:font-id id :team-id team-id}
-                          {:for-update true})]
-      (doseq [item items]
-        ;; Schedule object deletion
-        (wrk/submit! {::wrk/task :delete-object
-                      ::wrk/delay cf/deletion-delay
-                      ::wrk/conn conn
-                      :id (:id item)
-                      :type :team-font-variant}))
-
-      (db/update! conn :team-font-variant
-                  {:deleted-at (dt/now)}
-                  {:font-id id :team-id team-id})
-      nil)))
+    (db/update! conn :team-font-variant
+                {:deleted-at (dt/now)}
+                {:font-id id :team-id team-id})
+    nil))
 
 ;; --- DELETE FONT VARIANT
 

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

@@ -167,7 +167,7 @@
           :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)}
@@ -187,7 +187,7 @@
           :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))

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

@@ -32,7 +32,6 @@
 (s/def ::file-id ::us/uuid)
 (s/def ::team-id ::us/uuid)
 
-
 ;; --- Create File Media object (upload)
 
 (declare create-file-media-object)
@@ -92,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))
@@ -118,7 +116,7 @@
                        (sto/put-object storage {:content (sto/content (:data thumb) (:size thumb))
                                                 :content-type (:mtype thumb)}))]
     (db/insert! conn :file-media-object
-                {:id (uuid/next)
+                {:id (or id (uuid/next))
                  :file-id file-id
                  :is-local is-local
                  :name name

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

@@ -9,12 +9,13 @@
    [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.metrics :as mtx]
    [app.rpc.mutations.projects :as projects]
    [app.rpc.mutations.teams :as teams]
    [app.rpc.queries.profile :as profile]
@@ -22,7 +23,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]))
@@ -37,106 +37,14 @@
 (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-let [domains (cfg/get :registration-domain-whitelist)]
-    (when-not (email-domain-in-whitelist? domains (: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)
-           ::audit/props (:props profile)
-           ::audit/profile-id (:id 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)
-           ::audit/props (:props profile)
-           ::audit/profile-id (:id 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."
@@ -178,28 +86,177 @@
       {: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 []
+    (let [mobj (get-in metrics [:definitions :profile-register])]
+      ((::mtx/fn mobj) {:by 1}))))
+
+(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 is-active is-muted is-demo opts]
-         :or {is-active false is-muted false is-demo false}
-         :as params}]
-  (let [id        (or id (uuid/next))
-        is-active (if is-demo true is-active)
-        props     (-> params extract-props db/tjson)
-        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")
@@ -231,7 +288,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)
@@ -241,7 +298,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
@@ -264,7 +321,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
@@ -279,90 +337,25 @@
                 token  (tokens :generate claims)]
             (with-meta {:invitation-token token}
               {: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))
+             ::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))
-          props   (merge
-                   (select-keys profile [:backend :fullname :email])
-                   (:props profile))]
-      (with-meta profile
-        {:before-complete (annotate-profile-register metrics profile)
-         ::audit/name (if (::created profile) "register" "login")
-         ::audit/props props
-         ::audit/profile-id (:id profile)}))))
-
-(defn login-or-register
-  [{:keys [conn] :as cfg} {:keys [email] :as params}]
-  (letfn [(info->lang [{:keys [locale] :as info}]
-            (when (and (string? locale)
-                       (not (str/blank? locale)))
-              locale))
-
-          (create-profile [conn {:keys [fullname backend email props] :as info}]
-            (let [params {:id (uuid/next)
-                          :fullname fullname
-                          :email (str/lower email)
-                          :lang (info->lang props)
-                          :auth-backend backend
-                          :is-active true
-                          :password "!"
-                          :props (db/tjson props)
-                          :is-demo false}]
-              (-> (db/insert! conn :profile params)
-                  (update :props db/decode-transit-pgobject))))
-
-          (update-profile [conn info profile]
-            (let [props (merge (:props profile)
-                               (: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}]
@@ -382,7 +375,7 @@
     (update-profile conn params)
     nil))
 
-;; --- Mutation: Update Password
+;; --- MUTATION: Update Password
 
 (declare validate-password!)
 (declare update-profile-password!)
@@ -391,7 +384,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))
@@ -411,7 +404,8 @@
               {:password (derive-password password)}
               {:id id}))
 
-;; --- Mutation: Update Photo
+
+;; --- MUTATION: Update Photo
 
 (declare update-profile-photo)
 
@@ -425,11 +419,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)]
@@ -446,7 +442,7 @@
   nil)
 
 
-;; --- Mutation: Request Email Change
+;; --- MUTATION: Request Email Change
 
 (declare request-email-change)
 (declare change-email-inmediatelly)
@@ -462,7 +458,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)))))
 
@@ -514,7 +510,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]))
@@ -563,7 +559,7 @@
              (send-email-notification conn))))))
 
 
-;; --- Mutation: Recover Profile
+;; --- MUTATION: Recover Profile
 
 (s/def ::token ::us/not-empty-string)
 (s/def ::recover-profile
@@ -584,7 +580,7 @@
            (update-password conn))
       nil)))
 
-;; --- Mutation: Update Profile Props
+;; --- MUTATION: Update Profile Props
 
 (s/def ::props map?)
 (s/def ::update-profile-props
@@ -606,7 +602,7 @@
       nil)))
 
 
-;; --- Mutation: Delete Profile
+;; --- MUTATION: Delete Profile
 
 (declare check-can-delete-profile!)
 (declare mark-profile-as-deleted!)
@@ -619,12 +615,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/delay 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/share_link.clj

@@ -0,0 +1,67 @@
+;; 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.share-link
+  "Share link related rpc mutation methods."
+  (:require
+   [app.common.spec :as us]
+   [app.common.uuid :as uuid]
+   [app.db :as db]
+   [app.rpc.queries.files :as files]
+   [app.util.services :as sv]
+   [clojure.spec.alpha :as s]))
+
+;; --- Helpers & Specs
+
+(s/def ::id ::us/uuid)
+(s/def ::profile-id ::us/uuid)
+(s/def ::file-id ::us/uuid)
+(s/def ::flags (s/every ::us/string :kind set?))
+(s/def ::pages (s/every ::us/uuid :kind set?))
+
+;; --- Mutation: Create Share Link
+
+(declare create-share-link)
+
+(s/def ::create-share-link
+  (s/keys :req-un [::profile-id ::file-id ::flags]
+          :opt-un [::pages]))
+
+(sv/defmethod ::create-share-link
+  [{: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)
+    (create-share-link conn params)))
+
+(defn create-share-link
+  [conn {:keys [profile-id file-id pages flags]}]
+  (let [pages (db/create-array conn "uuid" pages)
+        flags (->> (map name flags)
+                   (db/create-array conn "text"))
+        slink (db/insert! conn :share-link
+                          {:id (uuid/next)
+                           :file-id file-id
+                           :flags flags
+                           :pages pages
+                           :owner-id profile-id})]
+    (-> slink
+        (update :pages db/decode-pgarray #{})
+        (update :flags db/decode-pgarray #{}))))
+
+;; --- Mutation: Delete Share Link
+
+(declare delete-share-link)
+
+(s/def ::delete-share-link
+  (s/keys :req-un [::profile-id ::id]))
+
+(sv/defmethod ::delete-share-link
+  [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
+  (db/with-atomic [conn pool]
+    (let [slink (db/get-by-id conn :share-link id)]
+      (files/check-edition-permissions! conn profile-id (:file-id slink))
+      (db/delete! conn :share-link {:id id})
+      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)))
 
 
@@ -260,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
@@ -272,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/mutations/verify_token.clj

@@ -9,6 +9,7 @@
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.db :as db]
+   [app.metrics :as mtx]
    [app.rpc.mutations.teams :as teams]
    [app.rpc.queries.profile :as profile]
    [app.util.services :as sv]
@@ -42,7 +43,8 @@
   transaction is completed."
   [metrics]
   (fn []
-    ((get-in metrics [:definitions :profile-activation]) :inc)))
+    (let [mobj (get-in metrics [:definitions :profile-activation])]
+      ((::mtx/fn mobj) {:by 1}))))
 
 (defmethod process-token :verify-email
   [{:keys [conn session metrics] :as cfg} _ {:keys [profile-id] :as claims}]

backend/src/app/rpc/permissions.clj

@@ -37,6 +37,41 @@
            :is-admin false
            :can-edit false)))
 
+(defn make-edition-predicate-fn
+  "A simple factory for edition permission predicate functions."
+  [qfn]
+  (us/assert fn? qfn)
+  (fn [& args]
+    (let [rows (apply qfn args)]
+      (when-not (or (empty? rows)
+                    (not (or (some :can-edit rows)
+                             (some :is-admin rows)
+                             (some :is-owner rows))))
+        rows))))
+
+(defn make-read-predicate-fn
+  "A simple factory for read permission predicate functions."
+  [qfn]
+  (us/assert fn? qfn)
+  (fn [& args]
+    (let [rows (apply qfn args)]
+      (when (seq rows)
+        rows))))
+
+(defn make-check-fn
+  "Helper that converts a predicate permission function to a check
+  function (function that raises an exception)."
+  [pred]
+  (fn [& args]
+    (when-not (seq (apply pred args))
+      (ex/raise :type :not-found
+                :code :object-not-found
+                :hint "not found"))))
+
+
+;; TODO: the following functions are deprecated and replaced with the
+;; new ones. Should not be used.
+
 (defn make-edition-check-fn
   "A simple factory for edition permission check functions."
   [qfn]

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

@@ -13,6 +13,7 @@
    [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]))
@@ -60,16 +61,23 @@
 
 (defn- retrieve-file-permissions
   [conn profile-id file-id]
-  (db/exec! conn [sql:file-permissions
-                  file-id profile-id
-                  file-id profile-id
-                  file-id profile-id]))
+  (when (and profile-id file-id)
+    (db/exec! conn [sql:file-permissions
+                    file-id profile-id
+                    file-id profile-id
+                    file-id profile-id])))
+
+(def has-edit-permissions?
+  (perms/make-edition-predicate-fn retrieve-file-permissions))
+
+(def has-read-permissions?
+  (perms/make-read-predicate-fn retrieve-file-permissions))
 
 (def check-edition-permissions!
-  (perms/make-edition-check-fn retrieve-file-permissions))
+  (perms/make-check-fn has-edit-permissions?))
 
 (def check-read-permissions!
-  (perms/make-read-check-fn retrieve-file-permissions))
+  (perms/make-check-fn has-read-permissions?))
 
 
 ;; --- Query: Files search
@@ -112,14 +120,16 @@
     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}]
-  (db/exec! pool [sql:search-files
-                  profile-id team-id
-                  profile-id team-id
-                  search-term]))
+  (when search-term
+    (db/exec! pool [sql:search-files
+                    profile-id team-id
+                    profile-id team-id
+                    search-term])))
 
 
 ;; --- Query: Files
@@ -169,11 +179,23 @@
 
 ;; --- 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]))
@@ -181,8 +203,9 @@
 (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 ::file-id]))
@@ -215,11 +238,11 @@
     (update data :objects update-objects)))
 
 (sv/defmethod ::page
-  [{:keys [pool] :as cfg} {:keys [profile-id file-id id strip-thumbnails]}]
-  [{:keys [pool] :as cfg} {:keys [profile-id file-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)
+    (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
@@ -243,7 +266,7 @@
   (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])))
 
 
@@ -268,30 +291,43 @@
   (s/keys :req-un [::profile-id ::team-id]))
 
 (sv/defmethod ::team-shared-files
-  [{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
+  [{: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.*,
-
-          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 [libraries (->> (db/exec! conn [sql:file-libraries file-id])
-                       (map #(assoc % :is-indirect is-indirect))
-                       (into #{} decode-row-xf))]
-    (reduce #(into %1 (retrieve-file-libraries conn true %2))
-            libraries
-            (map :id 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]))
@@ -299,8 +335,9 @@
 (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
 
@@ -332,7 +369,6 @@
     (teams/check-read-permissions! conn profile-id team-id)
     (db/exec! conn [sql:team-recent-files team-id])))
 
-
 ;; --- Helpers
 
 (defn decode-row

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

@@ -8,12 +8,16 @@
   (: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
@@ -27,3 +31,43 @@
               {: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/viewer.clj

@@ -14,24 +14,98 @@
    [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
 
+;; --- Query: View Only Bundle
+
+(defn- decode-share-link-row
+  [row]
+  (-> row
+      (update :flags db/decode-pgarray #{})
+      (update :pages db/decode-pgarray #{})))
+
+(defn- retrieve-project
+  [conn id]
+  (db/get-by-id conn :project id {:columns [:id :name :team-id]}))
+
+(defn- retrieve-share-link
+  [{:keys [conn]} file-id id]
+  (some-> (db/get-by-params conn :share-link
+                            {:id id :file-id file-id}
+                            {:check-not-found false})
+          (decode-share-link-row)))
+
+(defn- retrieve-bundle
+  [{:keys [conn] :as cfg} file-id]
+  (let [file    (files/retrieve-file cfg file-id)
+        project (retrieve-project conn (:project-id file))
+        libs    (files/retrieve-file-libraries cfg false file-id)
+        users   (teams/retrieve-users conn (:team-id project))
+
+        links   (->> (db/query conn :share-link {:file-id file-id})
+                     (mapv decode-share-link-row))
+
+        fonts   (db/query conn :team-font-variant
+                          {:team-id (:team-id project)
+                           :deleted-at nil})]
+    {:file file
+     :users users
+     :fonts fonts
+     :project project
+     :share-links links
+     :libraries libs}))
+
+(s/def ::file-id ::us/uuid)
+(s/def ::profile-id ::us/uuid)
+(s/def ::share-id ::us/uuid)
+
+(s/def ::view-only-bundle
+  (s/keys :req-un [::file-id] :opt-un [::profile-id ::share-id]))
+
+(sv/defmethod ::view-only-bundle {:auth false}
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id share-id] :as params}]
+  (db/with-atomic [conn pool]
+    (let [cfg    (assoc cfg :conn conn)
+          bundle (retrieve-bundle cfg file-id)
+          slink  (retrieve-share-link cfg file-id share-id)]
+
+      ;; When we have neither profile nor share, we just return a not
+      ;; found response to the user.
+      (when (and (not profile-id)
+                 (not slink))
+        (ex/raise :type :not-found
+                  :code :object-not-found))
+
+      ;; When we have only profile, we need to check read permissiones
+      ;; on file.
+      (when (and profile-id (not slink))
+        (files/check-read-permissions! conn profile-id file-id))
+
+      (cond-> bundle
+        ;; If we have current profile, put
+        (some? profile-id)
+        (as-> $ (let [edit? (boolean (files/has-edit-permissions? conn profile-id file-id))
+                      read? (boolean (files/has-read-permissions? conn profile-id file-id))]
+                  (-> (assoc $ :permissions {:read read? :edit edit?})
+                      (cond-> (not edit?) (dissoc :share-links)))))
+
+        (some? slink)
+        (assoc :share slink)
+
+        (and (some? slink)
+             (not (contains? (:flags slink) "view-all-pages")))
+        (update-in [:file :data] (fn [data]
+                                   (let [allowed-pages (:pages slink)]
+                                     (-> data
+                                         (update :pages (fn [pages] (filterv #(contains? allowed-pages %) pages)))
+                                         (update :pages-index (fn [index] (select-keys index allowed-pages)))))))))))
+
 ;; --- Query: Viewer Bundle (by Page ID)
 
+;; DEPRECATED: should be removed in 1.9.x
+
 (declare check-shared-token!)
 (declare retrieve-shared-token)
 
-(def ^:private
-  sql:project
-  "select p.id, p.name, p.team_id
-     from project as p
-    where p.id = ?
-      and p.deleted_at is null")
-
-(defn- retrieve-project
-  [conn id]
-  (db/exec-one! conn [sql:project id]))
-
 (s/def ::id ::us/uuid)
-(s/def ::file-id ::us/uuid)
 (s/def ::page-id ::us/uuid)
 (s/def ::token ::us/string)
 
@@ -42,17 +116,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}]
 
@@ -75,6 +155,3 @@
   [conn file-id page-id]
   (let [sql "select * from file_share_token where file_id=? and page_id=?"]
     (db/exec-one! conn [sql file-id page-id])))
-
-
-

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]
@@ -146,7 +167,11 @@
       (throw (UnsupportedOperationException. "not implemented")))
 
     clojure.lang.Counted
-    (count [_] size)))
+    (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,6 +4,9 @@
 ;;
 ;; 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
@@ -18,7 +21,7 @@
 (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}]
@@ -57,7 +60,7 @@
 
 (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})
+  (let [font    (db/get-by-id conn :team-font-variant id {:check-not-found false})
         storage (assoc storage :conn conn)]
     (when (:deleted-at font)
       (db/delete! conn :team-font-variant {:id id})

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,6 +105,7 @@
                :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. The touch mechanism is needed because many files can

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/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 ::props
-  (s/keys :req-un [::secret-key]))
-
-(defmethod ig/pre-init-spec ::tokens [_]
-  (s/keys :req-un [::props]))
-
 (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 [props] :as cfg}]
-  (let [secret (derive-tokens-secret (:secret-key props))
+  [_ {: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

@@ -64,12 +64,14 @@
 (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)]
+  (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

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/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]))
 
@@ -134,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
@@ -337,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

@@ -4,13 +4,13 @@
 ;;
 ;; Copyright (c) UXBOX Labs SL
 
-(ns app.tests.test-services-fonts
+(ns app.services-fonts-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.java.io :as io]
    [clojure.test :as t]
    [datoteka.core :as fs]))
@@ -24,7 +24,7 @@
         proj-id (:default-project-id prof)
         font-id (uuid/custom 10 1)
 
-        ttfdata (-> (io/resource "app/tests/_files/font-1.ttf")
+        ttfdata (-> (io/resource "app/test_files/font-1.ttf")
                     (fs/slurp-bytes))
 
         params  {::th/type :create-font-variant
@@ -59,7 +59,7 @@
         proj-id (:default-project-id prof)
         font-id (uuid/custom 10 1)
 
-        data    (-> (io/resource "app/tests/_files/font-1.woff")
+        data    (-> (io/resource "app/test_files/font-1.woff")
                     (fs/slurp-bytes))
 
         params  {::th/type :create-font-variant

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,17 +157,6 @@
             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
@@ -187,126 +168,95 @@
     (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

@@ -0,0 +1,104 @@
+;; 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-viewer-test
+  (:require
+   [app.common.uuid :as uuid]
+   [app.db :as db]
+   [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)
+
+(t/deftest retrieve-bundle
+  (let [prof     (th/create-profile* 1 {:is-active true})
+        prof2    (th/create-profile* 2 {:is-active true})
+        team-id  (:default-team-id prof)
+        proj-id  (:default-project-id prof)
+
+        file     (th/create-file* 1 {:profile-id (:id prof)
+                                     :project-id proj-id
+                                     :is-shared false})
+        share-id (atom nil)]
+
+    (t/testing "authenticated with page-id"
+      (let [data {::th/type :view-only-bundle
+                  :profile-id (:id prof)
+                  :file-id (:id file)
+                  :page-id (get-in file [:data :pages 0])}
+
+            out  (th/query! data)]
+
+        ;; (th/print-result! out)
+        (t/is (nil? (:error out)))
+
+        (let [result (:result out)]
+          (t/is (contains? result :share-links))
+          (t/is (contains? result :permissions))
+          (t/is (contains? result :libraries))
+          (t/is (contains? result :file))
+          (t/is (contains? result :project)))))
+
+    (t/testing "generate share token"
+      (let [data {::th/type :create-share-link
+                  :profile-id (:id prof)
+                  :file-id (:id file)
+                  :pages #{(get-in file [:data :pages 0])}
+                  :flags #{}}
+            out  (th/mutation! data)]
+
+        ;; (th/print-result! out)
+        (t/is (nil? (:error out)))
+        (let [result (:result out)]
+          (t/is (uuid? (:id result)))
+          (reset! share-id (:id result)))))
+
+    (t/testing "not authenticated with page-id"
+      (let [data {::th/type :view-only-bundle
+                  :profile-id (:id prof2)
+                  :file-id (:id file)
+                  :page-id (get-in file [:data :pages 0])}
+            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))
+          (t/is (= (:code error-data) :object-not-found)))))
+
+    (t/testing "authenticated with token & profile"
+      (let [data {::th/type :view-only-bundle
+                  :profile-id (:id prof2)
+                  :share-id @share-id
+                  :file-id (:id file)
+                  :page-id (get-in file [:data :pages 0])}
+            out  (th/query! data)]
+
+        ;; (th/print-result! out)
+        (t/is (nil? (:error out)))
+
+        (let [result (:result out)]
+          (t/is (contains? result :share))
+          (t/is (contains? result :file))
+          (t/is (contains? result :project)))))
+
+    (t/testing "authenticated with token"
+      (let [data {::th/type :view-only-bundle
+                  :share-id @share-id
+                  :file-id (:id file)
+                  :page-id (get-in file [:data :pages 0])}
+            out  (th/query! data)]
+
+        ;; (th/print-result! out)
+        (let [result (:result out)]
+          (t/is (contains? result :file))
+          (t/is (contains? result :share))
+          (t/is (contains? result :project)))))
+
+    ))

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}
 

backend/test/app/test_helpers.clj

@@ -4,7 +4,7 @@
 ;;
 ;; Copyright (c) UXBOX Labs SL
 
-(ns app.tests.helpers
+(ns app.test-helpers
   (:require
    [app.common.data :as d]
    [app.common.pages :as cp]
@@ -228,9 +228,12 @@
   ([params] (update-file* *pool* params))
   ([conn {:keys [file-id changes session-id profile-id revn]
           :or {session-id (uuid/next) revn 0}}]
-   (let [file   (db/get-by-id conn :file file-id)
-         msgbus (:app.msgbus/msgbus *system*)]
-     (#'files/update-file {:conn conn :msgbus msgbus}
+   (let [file    (db/get-by-id conn :file file-id)
+         msgbus  (:app.msgbus/msgbus *system*)
+         metrics (:app.metrics/metrics *system*)]
+     (#'files/update-file {:conn conn
+                           :msgbus msgbus
+                           :metrics metrics}
                           {:file file
                            :revn revn
                            :changes changes

backend/tests.edn

@@ -1,5 +1,5 @@
 #kaocha/v1
 {:tests
  [{:id          :unit
-   :test-paths  ["tests" "src"]
-   :ns-patterns ["test-.*"]}]}
+   :test-paths  ["test" "src"]
+   :ns-patterns [".*-test$"]}]}

backend/tests/app/tests/test_services_viewer.clj

@@ -1,101 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; Copyright (c) UXBOX Labs SL
-
-(ns app.tests.test-services-viewer
-  (:require
-   [clojure.test :as t]
-   [datoteka.core :as fs]
-   [app.common.uuid :as uuid]
-   [app.db :as db]
-   [app.tests.helpers :as th]))
-
-(t/use-fixtures :once th/state-init)
-(t/use-fixtures :each th/database-reset)
-
-(t/deftest retrieve-bundle
-  (let [prof    (th/create-profile* 1 {:is-active true})
-        prof2   (th/create-profile* 2 {:is-active true})
-        team-id (:default-team-id prof)
-        proj-id (:default-project-id prof)
-
-        file    (th/create-file* 1 {:profile-id (:id prof)
-                                    :project-id proj-id
-                                    :is-shared false})
-        token   (atom nil)]
-
-    (t/testing "authenticated with page-id"
-      (let [data {::th/type :viewer-bundle
-                  :profile-id (:id prof)
-                  :file-id (:id file)
-                  :page-id (get-in file [:data :pages 0])}
-
-            out  (th/query! data)]
-
-        ;; (th/print-result! out)
-        (t/is (nil? (:error out)))
-
-        (let [result (:result out)]
-          (t/is (contains? result :token))
-          (t/is (contains? result :page))
-          (t/is (contains? result :file))
-          (t/is (contains? result :project)))))
-
-    (t/testing "generate share token"
-      (let [data {::th/type :create-file-share-token
-                  :profile-id (:id prof)
-                  :file-id (:id file)
-                  :page-id (get-in file [:data :pages 0])}
-            out  (th/mutation! data)]
-
-        ;; (th/print-result! out)
-        (t/is (nil? (:error out)))
-        (let [result (:result out)]
-          (t/is (string? (:token result)))
-          (reset! token (:token result)))))
-
-    (t/testing "not authenticated with page-id"
-      (let [data {::th/type :viewer-bundle
-                  :profile-id (:id prof2)
-                  :file-id (:id file)
-                  :page-id (get-in file [:data :pages 0])}
-            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))
-          (t/is (= (:code error-data) :object-not-found)))))
-
-    ;; (t/testing "authenticated with token & profile"
-    ;;   (let [data {::sq/type :viewer-bundle
-    ;;               :profile-id (:id prof2)
-    ;;               :token @token
-    ;;               :file-id (:id file)
-    ;;               :page-id (get-in file [:data :pages 0])}
-    ;;         out  (th/try-on! (sq/handle data))]
-
-    ;;     ;; (th/print-result! out)
-
-    ;;     (let [result (:result out)]
-    ;;       (t/is (contains? result :page))
-    ;;       (t/is (contains? result :file))
-    ;;       (t/is (contains? result :project)))))
-
-    ;; (t/testing "authenticated with token"
-    ;;   (let [data {::sq/type :viewer-bundle
-    ;;               :token @token
-    ;;               :file-id (:id file)
-    ;;               :page-id (get-in file [:data :pages 0])}
-    ;;         out  (th/try-on! (sq/handle data))]
-
-    ;;     ;; (th/print-result! out)
-
-    ;;     (let [result (:result out)]
-    ;;       (t/is (contains? result :page))
-    ;;       (t/is (contains? result :file))
-    ;;       (t/is (contains? result :project)))))
-    ))

common/app/common/geom/shapes/transforms.cljc

@@ -1,419 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; Copyright (c) UXBOX Labs SL
-
-(ns app.common.geom.shapes.transforms
-  (:require
-   [app.common.attrs :as attrs]
-   [app.common.geom.matrix :as gmt]
-   [app.common.geom.point :as gpt]
-   [app.common.geom.shapes.common :as gco]
-   [app.common.geom.shapes.path :as gpa]
-   [app.common.geom.shapes.rect :as gpr]
-   [app.common.math :as mth]
-   [app.common.data :as d]
-   [app.common.text :as txt]))
-
-;; --- Relative Movement
-
-(defn move-selrect [selrect {dx :x dy :y}]
-  (-> selrect
-      (d/update-when :x + dx)
-      (d/update-when :y + dy)
-      (d/update-when :x1 + dx)
-      (d/update-when :y1 + dy)
-      (d/update-when :x2 + dx)
-      (d/update-when :y2 + dy)))
-
-(defn move-points [points move-vec]
-  (->> points
-       (mapv #(gpt/add % move-vec))))
-
-(defn move
-  "Move the shape relativelly to its current
-  position applying the provided delta."
-  [shape {dx :x dy :y}]
-  (let [dx (d/check-num dx)
-        dy (d/check-num dy)
-        move-vec (gpt/point dx dy)]
-
-    (-> shape
-        (update :selrect move-selrect move-vec)
-        (update :points move-points move-vec)
-        (d/update-when :x + dx)
-        (d/update-when :y + dy)
-        (cond-> (= :path (:type shape))
-          (update :content gpa/move-content move-vec)))))
-
-;; --- Absolute Movement
-
-(declare absolute-move-rect)
-
-(defn absolute-move
-  "Move the shape to the exactly specified position."
-  [shape {:keys [x y]}]
-  (let [dx (- (d/check-num x) (-> shape :selrect :x))
-        dy (- (d/check-num y) (-> shape :selrect :y))]
-    (move shape (gpt/point dx dy))))
-
-
-(defn- modif-rotation [shape]
-  (let [cur-rotation (d/check-num (:rotation shape))
-        delta-angle  (d/check-num (get-in shape [:modifiers :rotation]))]
-    (mod (+ cur-rotation delta-angle) 360)))
-
-(defn transform-matrix
-  "Returns a transformation matrix without changing the shape properties.
-  The result should be used in a `transform` attribute in svg"
-  ([shape] (transform-matrix shape nil))
-  ([shape params] (transform-matrix shape params (or (gco/center-shape shape)
-                                                     (gpt/point 0 0))))
-  ([{:keys [flip-x flip-y] :as shape} {:keys [no-flip]} shape-center]
-   (-> (gmt/matrix)
-       (gmt/translate shape-center)
-
-       (gmt/multiply (:transform shape (gmt/matrix)))
-       (cond->
-           (and (not no-flip) flip-x) (gmt/scale (gpt/point -1 1))
-           (and (not no-flip) flip-y) (gmt/scale (gpt/point 1 -1)))
-       (gmt/translate (gpt/negate shape-center)))))
-
-(defn inverse-transform-matrix
-  ([shape]
-   (let [shape-center (or (gco/center-shape shape)
-                          (gpt/point 0 0))]
-     (inverse-transform-matrix shape shape-center)))
-  ([{:keys [flip-x flip-y] :as shape} center]
-   (let []
-     (-> (gmt/matrix)
-         (gmt/translate center)
-         (cond->
-             flip-x (gmt/scale (gpt/point -1 1))
-             flip-y (gmt/scale (gpt/point 1 -1)))
-         (gmt/multiply (:transform-inverse shape (gmt/matrix)))
-         (gmt/translate (gpt/negate center))))))
-
-(defn transform-point-center
-  "Transform a point around the shape center"
-  [point center matrix]
-  (gpt/transform
-   point
-   (gmt/multiply (gmt/translate-matrix center)
-                 matrix
-                 (gmt/translate-matrix (gpt/negate center)))))
-
-(defn transform-points
-  ([points matrix]
-   (transform-points points nil matrix))
-  ([points center matrix]
-   (let [prev (if center (gmt/translate-matrix center) (gmt/matrix))
-         post (if center (gmt/translate-matrix (gpt/negate center)) (gmt/matrix))
-
-         tr-point (fn [point]
-                    (gpt/transform point (gmt/multiply prev matrix post)))]
-     (mapv tr-point points))))
-
-(defn transform-rect
-  "Transform a rectangles and changes its attributes"
-  [rect matrix]
-
-  (let [points (-> (gpr/rect->points rect)
-                   (transform-points matrix))]
-    (gpr/points->rect points)))
-
-(defn normalize-scale
-  "We normalize the scale so it's not too close to 0"
-  [scale]
-  (cond
-    (and (<  scale 0) (> scale -0.01)) -0.01
-    (and (>= scale 0) (< scale  0.01))  0.01
-    :else scale))
-
-(defn modifiers->transform
-  [center modifiers]
-  (let [ds-modifier (:displacement modifiers (gmt/matrix))
-        {res-x :x res-y :y} (:resize-vector modifiers (gpt/point 1 1))
-
-        ;; Normalize x/y vector coordinates because scale by 0 is infinite
-        res-x (normalize-scale res-x)
-        res-y (normalize-scale res-y)
-        resize (gpt/point res-x res-y)
-
-        origin (:resize-origin modifiers (gpt/point 0 0))
-
-        resize-transform (:resize-transform modifiers (gmt/matrix))
-        resize-transform-inverse (:resize-transform-inverse modifiers (gmt/matrix))
-        rt-modif (or (:rotation modifiers) 0)
-
-        center (gpt/transform center ds-modifier)
-
-        transform (-> (gmt/matrix)
-
-                      ;; Applies the current resize transformation
-                      (gmt/translate origin)
-                      (gmt/multiply resize-transform)
-                      (gmt/scale resize)
-                      (gmt/multiply resize-transform-inverse)
-                      (gmt/translate (gpt/negate origin))
-
-                      ;; Applies the stacked transformations
-                      (gmt/translate center)
-                      (gmt/multiply (gmt/rotate-matrix rt-modif))
-                      (gmt/translate (gpt/negate center))
-
-                      ;; Displacement
-                      (gmt/multiply ds-modifier))]
-    transform))
-
-(defn- calculate-skew-angle
-  "Calculates the skew angle of the paralelogram given by the points"
-  [[p1 _ p3 p4]]
-  (let [v1 (gpt/to-vec p3 p4)
-        v2 (gpt/to-vec p4 p1)]
-    ;; If one of the vectors is zero it's a rectangle with 0 height or width
-    ;; We don't skew these
-    (if (or (gpt/almost-zero? v1)
-            (gpt/almost-zero? v2))
-      0
-      (- 90 (gpt/angle-with-other v1 v2)))))
-
-(defn- calculate-height
-  "Calculates the height of a paralelogram given by the points"
-  [[p1 _ _ p4]]
-  (-> (gpt/to-vec p4 p1)
-      (gpt/length)))
-
-(defn- calculate-width
-  "Calculates the width of a paralelogram given by the points"
-  [[p1 p2 _ _]]
-  (-> (gpt/to-vec p1 p2)
-      (gpt/length)))
-
-(defn- calculate-rotation
-  "Calculates the rotation between two shapes given the resize vector direction"
-  [center points-shape1 points-shape2 flip-x flip-y]
-
-  (let [idx-1 0
-        idx-2 (cond (and flip-x       (not flip-y)) 1
-                    (and flip-x       flip-y) 2
-                    (and (not flip-x) flip-y) 3
-                    :else 0)
-        p1 (nth points-shape1 idx-1)
-        p2 (nth points-shape2 idx-2)
-        v1 (gpt/to-vec center p1)
-        v2 (gpt/to-vec center p2)
-
-        rot-angle (gpt/angle-with-other v1 v2)
-        rot-sign (gpt/angle-sign v1 v2)]
-    (* rot-sign rot-angle)))
-
-(defn- calculate-dimensions
-  [[p1 p2 p3 _]]
-  (let [width  (gpt/distance p1 p2)
-        height (gpt/distance p2 p3)]
-    {:width width :height height}))
-
-(defn calculate-adjust-matrix
-  "Calculates a matrix that is a series of transformations we have to do to the transformed rectangle so that
-  after applying them the end result is the `shape-pathn-temp`.
-  This is compose of three transformations: skew, resize and rotation"
-  ([points-temp points-rec] (calculate-adjust-matrix points-temp points-rec false false))
-  ([points-temp points-rec flip-x flip-y]
-   (let [center (gco/center-points points-temp)
-
-         stretch-matrix (gmt/matrix)
-
-         skew-angle (calculate-skew-angle points-temp)
-
-         ;; When one of the axis is flipped we have to reverse the skew
-         ;; skew-angle (if (neg? (* (:x resize-vector) (:y resize-vector))) (- skew-angle) skew-angle )
-         skew-angle (if (and (or flip-x flip-y)
-                             (not (and flip-x flip-y))) (- skew-angle) skew-angle )
-         skew-angle (if (mth/nan? skew-angle) 0 skew-angle)
-
-         stretch-matrix (gmt/multiply stretch-matrix (gmt/skew-matrix skew-angle 0))
-
-         h1 (max 1 (calculate-height points-temp))
-         h2 (max 1 (calculate-height (transform-points points-rec center stretch-matrix)))
-         h3 (if-not (mth/almost-zero? h2) (/ h1 h2) 1)
-         h3 (if (mth/nan? h3) 1 h3)
-
-         w1 (max 1 (calculate-width points-temp))
-         w2 (max 1 (calculate-width (transform-points points-rec center stretch-matrix)))
-         w3 (if-not (mth/almost-zero? w2) (/ w1 w2) 1)
-         w3 (if (mth/nan? w3) 1 w3)
-
-         stretch-matrix (gmt/multiply stretch-matrix (gmt/scale-matrix (gpt/point w3 h3)))
-
-         rotation-angle (calculate-rotation
-                         center
-                         (transform-points points-rec (gco/center-points points-rec) stretch-matrix)
-                         points-temp
-                         flip-x
-                         flip-y)
-
-         stretch-matrix (gmt/multiply (gmt/rotate-matrix rotation-angle) stretch-matrix)
-
-         ;; This is the inverse to be able to remove the transformation
-         stretch-matrix-inverse (-> (gmt/matrix)
-                                    (gmt/scale (gpt/point (/ 1 w3) (/ 1 h3)))
-                                    (gmt/skew (- skew-angle) 0)
-                                    (gmt/rotate (- rotation-angle)))]
-     [stretch-matrix stretch-matrix-inverse rotation-angle])))
-
-(defn apply-transform
-  "Given a new set of points transformed, set up the rectangle so it keeps
-  its properties. We adjust de x,y,width,height and create a custom transform"
-  [shape transform round-coords?]
-  ;;
-  (let [points (-> shape :points (transform-points transform))
-        center (gco/center-points points)
-
-        ;; Reverse the current transformation stack to get the base rectangle
-        tr-inverse      (:transform-inverse shape (gmt/matrix))
-
-        points-temp     (transform-points points center tr-inverse)
-        points-temp-dim (calculate-dimensions points-temp)
-
-        ;; This rectangle is the new data for the current rectangle. We want to change our rectangle
-        ;; to have this width, height, x, y
-        rect-shape      (-> (gco/make-centered-rect
-                             center
-                             (:width points-temp-dim)
-                             (:height points-temp-dim))
-                            (update :width max 1)
-                            (update :height max 1))
-
-        rect-points     (gpr/rect->points rect-shape)
-
-        [matrix matrix-inverse] (calculate-adjust-matrix points-temp rect-points (:flip-x shape) (:flip-y shape))
-
-        rect-shape (cond-> rect-shape
-                     round-coords?
-                     (-> (update :x mth/round)
-                         (update :y mth/round)
-                         (update :width mth/round)
-                         (update :height mth/round)))
-
-        shape (cond
-                (= :path (:type shape))
-                (-> shape
-                    (update :content #(gpa/transform-content % transform)))
-
-                :else
-                (-> shape
-                    (merge rect-shape)))]
-    (as-> shape $
-      (update $ :transform #(gmt/multiply (or % (gmt/matrix)) matrix))
-      (update $ :transform-inverse #(gmt/multiply matrix-inverse (or % (gmt/matrix))))
-      (assoc  $ :points (into [] points))
-      (assoc  $ :selrect (gpr/rect->selrect rect-shape))
-      (update $ :rotation #(mod (+ (or % 0)
-                                   (or (get-in $ [:modifiers :rotation]) 0)) 360)))))
-
-(defn set-flip [shape modifiers]
-  (let [rx (get-in modifiers [:resize-vector :x])
-        ry (get-in modifiers [:resize-vector :y])]
-    (cond-> shape
-      (and rx (< rx 0)) (update :flip-x not)
-      (and ry (< ry 0)) (update :flip-y not))))
-
-(defn apply-displacement [shape]
-  (let [modifiers (:modifiers shape)]
-    (if (contains? modifiers :displacement)
-      (let [mov-vec (-> (gpt/point 0 0)
-                        (gpt/transform (:displacement modifiers)))
-            shape (move shape mov-vec)
-            modifiers (dissoc modifiers :displacement)]
-        (-> shape
-            (assoc :modifiers modifiers)
-            (cond-> (empty? modifiers)
-              (dissoc :modifiers))))
-      shape)))
-
-(defn apply-text-resize
-  [shape orig-shape modifiers]
-  (if (and (= (:type shape) :text)
-           (:resize-scale-text modifiers))
-    (let [merge-attrs (fn [attrs]
-                        (let [font-size (-> (get attrs :font-size 14)
-                                            (d/parse-double)
-                                            (* (-> modifiers :resize-vector :x))
-                                            (str)
-                                            )]
-                          (attrs/merge attrs {:font-size font-size})))]
-      (update shape :content #(txt/transform-nodes
-                                txt/is-text-node?
-                                merge-attrs
-                                %)))
-    shape))
-
-(defn transform-shape
-  ([shape]
-   (transform-shape shape nil))
-
-  ([shape {:keys [round-coords?]
-           :or {round-coords? true}}]
-   (let [shape (apply-displacement shape)
-         center (gco/center-shape shape)
-         modifiers (:modifiers shape)]
-     (if (and modifiers center)
-       (let [transform (modifiers->transform center modifiers)]
-         (-> shape
-             (set-flip modifiers)
-             (apply-transform transform round-coords?)
-             (apply-text-resize shape modifiers)
-             (dissoc :modifiers)))
-       shape))))
-
-(defn update-group-viewbox
-  "Updates the viewbox for groups imported from SVG's"
-  [{:keys [selrect svg-viewbox] :as group} new-selrect]
-  (let [;; Gets deltas for the selrect to update the svg-viewbox (for svg-imports)
-        deltas {:x      (- (:x new-selrect 0)      (:x selrect 0))
-                :y      (- (:y new-selrect 0)      (:y selrect 0))
-                :width  (- (:width new-selrect 1)  (:width selrect 1))
-                :height (- (:height new-selrect 1) (:height selrect 1))}]
-    
-    (cond-> group
-      (and (some? svg-viewbox) (some? selrect) (some? new-selrect))
-      (update :svg-viewbox
-              #(-> %
-                   (update :x + (:x deltas))
-                   (update :y + (:y deltas))
-                   (update :width + (:width deltas))
-                   (update :height + (:height deltas)))))))
-
-(defn update-group-selrect [group children]
-  (let [shape-center (gco/center-shape group)
-        transform (:transform group (gmt/matrix))
-        transform-inverse (:transform-inverse group (gmt/matrix))
-
-        ;; Points for every shape inside the group
-        points (->> children (mapcat :points))
-
-        ;; Invert to get the points minus the transforms applied to the group
-        base-points (transform-points points shape-center (:transform-inverse group (gmt/matrix)))
-
-        ;; Defines the new selection rect with its transformations
-        new-points (-> (gpr/points->selrect base-points)
-                       (gpr/rect->points)
-                       (transform-points shape-center (:transform group (gmt/matrix))))
-
-        ;; Calculte the new selrect
-        new-selrect (gpr/points->selrect base-points)]
-
-    ;; Updates the shape and the applytransform-rect will update the other properties
-    (-> group
-        (update-group-viewbox new-selrect)
-        (assoc :selrect new-selrect)
-        (assoc :points new-points)
-
-        ;; We're regenerating the selrect from its children so we
-        ;; need to remove the flip flags
-        (assoc :flip-x false)
-        (assoc :flip-y false)
-        (apply-transform (gmt/matrix) true))))
-

common/deps.edn

@@ -0,0 +1,72 @@
+{:deps
+ {org.clojure/clojure {:mvn/version "1.10.3"}
+  org.clojure/data.json {:mvn/version "2.3.1"}
+  org.clojure/core.async {:mvn/version "1.3.618"}
+  org.clojure/tools.cli {:mvn/version "1.0.206"}
+  metosin/jsonista {:mvn/version "0.3.3"}
+  org.clojure/clojurescript {:mvn/version "1.10.844"}
+
+  ;; Logging
+  org.clojure/tools.logging {:mvn/version "1.1.0"}
+  org.apache.logging.log4j/log4j-api {:mvn/version "2.14.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"}
+
+  selmer/selmer {:mvn/version "1.12.40"}
+  expound/expound {:mvn/version "0.8.9"}
+  com.cognitect/transit-clj {:mvn/version "1.0.324"}
+  com.cognitect/transit-cljs {:mvn/version "0.8.269"}
+  java-http-clj/java-http-clj {:mvn/version "0.4.2"}
+
+  funcool/promesa {:mvn/version "6.0.1"}
+  funcool/cuerdas {:mvn/version "2021.05.29-0"}
+
+  lambdaisland/uri {:mvn/version "1.4.70"
+                    :exclusions [org.clojure/data.json]}
+
+  frankiesardo/linked {:mvn/version "1.3.0"}
+  danlentz/clj-uuid {:mvn/version "0.1.9"}
+  commons-io/commons-io {:mvn/version "2.8.0"}
+  com.sun.mail/jakarta.mail {:mvn/version "2.0.1"}
+
+  ;; exception printing
+  io.aviso/pretty {:mvn/version "0.1.37"}
+  environ/environ {:mvn/version "1.2.0"}}
+ :paths ["src"]
+ :aliases
+ {:dev
+  {:extra-deps
+   {org.clojure/tools.namespace {:mvn/version "RELEASE"}
+    org.clojure/test.check {:mvn/version "RELEASE"}
+    org.clojure/tools.deps.alpha {:mvn/version "RELEASE"}
+    thheller/shadow-cljs {:mvn/version "2.12.6"}
+    criterium/criterium {:mvn/version "RELEASE"}
+    mockery/mockery {:mvn/version "RELEASE"}}
+   :extra-paths ["test" "dev"]}
+
+  :repl
+  {:extra-deps
+   {com.bhauman/rebel-readline {:mvn/version "RELEASE"}}
+   :main-opts ["-m" "rebel-readline.main"]}
+
+  :kaocha
+  {:extra-deps {lambdaisland/kaocha {:mvn/version "RELEASE"}}
+   :main-opts ["-m" "kaocha.runner"]}
+
+  :test
+  {:extra-paths ["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}
+
+  :shadow-cljs
+  {:main-opts ["-m" "shadow.cljs.devtools.cli"]}
+
+  :outdated
+  {:extra-deps {com.github.liquidz/antq {:mvn/version "RELEASE"}}
+   :main-opts ["-m" "antq.core"]}}}
+

common/dev/user.clj

@@ -0,0 +1,51 @@
+;; 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 user
+  (:require
+   [clojure.java.io :as io]
+   [clojure.pprint :refer [pprint print-table]]
+   [clojure.repl :refer :all]
+   [clojure.spec.alpha :as s]
+   [clojure.spec.gen.alpha :as sgen]
+   [clojure.test :as test]
+   [clojure.tools.namespace.repl :as repl]
+   [clojure.walk :refer [macroexpand-all]]
+   [criterium.core :refer [quick-bench bench with-progress-reporting]]))
+
+;; --- Benchmarking Tools
+
+(defmacro run-quick-bench
+  [& exprs]
+  `(with-progress-reporting (quick-bench (do ~@exprs) :verbose)))
+
+(defmacro run-quick-bench'
+  [& exprs]
+  `(quick-bench (do ~@exprs)))
+
+(defmacro run-bench
+  [& exprs]
+  `(with-progress-reporting (bench (do ~@exprs) :verbose)))
+
+(defmacro run-bench'
+  [& exprs]
+  `(bench (do ~@exprs)))
+
+;; --- Development Stuff
+
+(defn- run-tests
+  ([] (run-tests #"^app.common.tests.*"))
+  ([o]
+   (repl/refresh)
+   (cond
+     (instance? java.util.regex.Pattern o)
+     (test/run-all-tests o)
+
+     (symbol? o)
+     (if-let [sns (namespace o)]
+       (do (require (symbol sns))
+           (test/test-vars [(resolve o)]))
+       (test/test-ns o)))))

common/package.json

@@ -0,0 +1,13 @@
+{
+  "name": "penpot-common",
+  "version": "1.0.0",
+  "main": "index.js",
+  "license": "MPL-2.0",
+  "dependencies": {
+    "luxon": "^1.27.0"
+  },
+  "devDependencies": {
+    "source-map-support": "^0.5.19",
+    "ws": "^7.4.6"
+  }
+}