Merge branch 'release-1.2.0' into main

🐛 Fix behavior of select all command when there are objects outsi…

.circleci/config.yml

@@ -0,0 +1,66 @@
+version: 2
+jobs:
+  build:
+    docker:
+      # specify the version you desire here
+      - image: penpotapp/devenv:latest
+
+      # Specify service dependencies here if necessary
+      # 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
+        environment:
+          POSTGRES_USER: penpot_test
+          POSTGRES_PASSWORD: penpot_test
+          POSTGRES_DB: penpot
+
+      - image: circleci/redis:6.0.8
+
+    working_directory: ~/repo
+
+    environment:
+      # Customize the JVM maximum heap limit
+      JVM_OPTS: -Xmx1g
+
+    steps:
+      - checkout
+
+      # Download and cache dependencies
+      - restore_cache:
+         keys:
+           - v1-dependencies-{{ checksum "backend/deps.edn" }}-{{ checksum "frontend/deps.edn"}}
+           # fallback to using the latest cache if no exact match is found
+           - v1-dependencies-
+
+      # run lint
+      - run:
+          working_directory: "./backend"
+          name: backend lint
+          command: "clj-kondo --lint src/"
+
+      # run test
+      - run:
+          working_directory: "./backend"
+          name: backend test
+          command: "clojure -M:dev:tests"
+          environment:
+            PENPOT_DATABASE_URI: "postgresql://localhost/penpot"
+            PENPOT_DATABASE_USERNAME: penpot_test
+            PENPOT_DATABASE_PASSWORD: penpot_test
+            PENPOT_REDIS_URI: "redis://localhost/1"
+
+      - run:
+          working_directory: "./frontend"
+          name: frontend tests
+          command: |
+            yarn install
+            npx shadow-cljs compile tests
+          environment:
+            PATH: /usr/local/nodejs/bin/:/usr/local/bin:/bin:/usr/bin
+
+      - save_cache:
+         paths:
+           - ~/.m2
+         key: v1-dependencies-{{ checksum "backend/deps.edn" }}-{{ checksum "frontend/deps.edn"}}
+

.clj-kondo/config.edn

@@ -1,5 +1,6 @@
 {: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}
  :output
  {:exclude-files ["data_readers.clj"]}
@@ -21,9 +22,6 @@
    }
 
   :unresolved-symbol
-  {:exclude ['(app.services.mutations/defmutation)
-             '(app.services.queries/defquery)
-             '(app.util.dispatcher/defservice)
-             '(mount.core/defstate)
+  {:exclude ['(app.util.services/defmethod)
              ]}}}
 

.gitignore

@@ -14,6 +14,7 @@ figwheel_server.log
 node_modules
 /backend/target/
 /backend/resources/public/media
+/backend/resources/public/assets
 /backend/dist/
 /backend/logs/
 /backend/-
@@ -32,3 +33,4 @@ node_modules
 /deploy
 /web
 /_dump
+/vendor/svgclean/bundle*.js

CHANGES.md

@@ -0,0 +1,63 @@
+# CHANGELOG #
+
+## Next
+
+### New features
+
+### Bugs fixed
+
+
+## 1.2.0-alpha
+
+### New features
+
+- Add horizontal/vertical flip
+- Add images lock proportions by default [#541](https://github.com/penpot/penpot/discussions/541), [#609](https://github.com/penpot/penpot/issues/609)
+- Add new blob storage format (Zstd+nippy)
+- Add user feedback form
+- Improve French translations
+- Improve component testing
+- Increase default deletion delay to 7 days
+- Show a pixel grid when zoom greater than 800% [#519](https://github.com/penpot/penpot/discussions/519)
+- Fix behavior of select all command when there are objects outside frames [Taiga #1209](https://tree.taiga.io/project/penpot/issue/1209)
+
+
+### Bugs fixed
+
+- Fix 404 when access shared link [#615](https://github.com/penpot/penpot/issues/615)
+- Fix 500 when requestion password reset
+- Fix Problems when transforming path shapes [Taiga #1170](https://tree.taiga.io/project/penpot/issue/1170)
+- Fix apply a color to a text selection from color palette was not working [Taiga #1189](https://tree.taiga.io/project/penpot/issue/1189)
+- Fix issues when moving shapes outside groups [Taiga #1138](https://tree.taiga.io/project/penpot/issue/1138)
+- Fix ldap function called on login click
+- Fix logo icon in viewer should go to dashboard [Taiga #1149](https://tree.taiga.io/project/penpot/issue/1149)
+- Fix ordering when restoring deleted shapes in sync [Taiga #1163](https://tree.taiga.io/project/penpot/issue/1163)
+- Fix problem when editing text immediately after creating [Taiga #1207](https://tree.taiga.io/project/penpot/issue/1207)
+- Fix problem when pasting URL's copied from the browser url bar [Taiga #1187](https://tree.taiga.io/project/penpot/issue/1187)
+- Fix problem with multiple selection and groups [Taiga #1128](https://tree.taiga.io/project/penpot/issue/1128)
+- Fix problem with red handler indicator on resize [Taiga #1188](https://tree.taiga.io/project/penpot/issue/1188)
+- Fix show correct error when google auth is disabled [Taiga #1119](https://tree.taiga.io/project/penpot/issue/1119)
+- Fix text alignment in preview [#594](https://github.com/penpot/penpot/issues/594)
+- Fix unexpected exception when uploading image [Taiga #1120](https://tree.taiga.io/project/penpot/issue/1120)
+- Fix updates on collaborative editing not updating selection rectangles [Taiga #1127](https://tree.taiga.io/project/penpot/issue/1127)
+- Make the team deletion deferred (in the same way other objects)
+
+### Community contributions by (Thank you! :heart:)
+
+- abtinmo [#538](https://github.com/penpot/penpot/pull/538)
+- kdrag0n [#585](https://github.com/penpot/penpot/pull/585)
+- nisrulz [#586](https://github.com/penpot/penpot/pull/586)
+- tomer [#575](https://github.com/penpot/penpot/pull/575)
+- violoncelloCH [#554](https://github.com/penpot/penpot/pull/554)
+
+## 1.1.0-alpha
+
+- Bugfixing and stabilization post-launch
+- Some changes to the register flow
+- Improved MacOS shortcuts and helpers
+- Small changes to shape creation
+
+
+## 1.0.0-alpha
+
+Initial release

CONTRIBUTING.md

@@ -1,8 +1,8 @@
 # Contributing Guide #
 
 Thank you for your interest in contributing to Penpot. This is a
-generic guide that details how to contribute to Penpot in a way that is
-efficient for everyone. If you want a specific documentation for
+generic guide that details how to contribute to Penpot in a way that
+is efficient for everyone. If you want a specific documentation for
 different parts of the platform, please refer to `docs/` directory.
 
 
@@ -19,12 +19,20 @@ If you found a bug, please report it, as far as possible with:
 - a browser and the browser version used
 - a dev tools console exception stack trace (if it is available)
 
+If you found a bug that you consider better discuse in private (for
+example: security bugs), consider first send an email to
+`info@penpot.app`.
+
+**We don't have formal bug bounty program for security reports; this
+is an open source application and your contribution will be recognized
+in the changelog.**
+
 
 ## Pull requests ##
 
 If you want propose a change or bug fix with the Pull-Request system
-firstly you should carefully read the **Contributor License Aggreement**
-section and format your commits accordingly.
+firstly you should carefully read the **DCO** section and format your
+commits accordingly.
 
 If you intend to fix a bug it's fine to submit a pull request right
 away but we still recommend to file an issue detailing what you're
@@ -127,7 +135,7 @@ This Code of Conduct is adapted from the Contributor Covenant, version
 1.1.0, available from http://contributor-covenant.org/version/1/1/0/
 
 
-## Contributor License Agreement ##
+## Developer's Certificate of Origin (DCO) ##
 
 By submitting code you are agree and can certify the below:
 
@@ -157,9 +165,9 @@ By submitting code you are agree and can certify the below:
         maintained indefinitely and may be redistributed consistent with
         this project or the open source license(s) involved.
 
-Then, all your patches should contain a sign-off at the end of the
-patch/commit description body. It can be automatically added on adding
-`-s` parameter to `git commit`.
+Then, all your code patches (**documentation are excluded**) should
+contain a sign-off at the end of the patch/commit description body. It
+can be automatically added on adding `-s` parameter to `git commit`.
 
 This is an example of the aspect of the line:
 

README.md

@@ -3,7 +3,8 @@
 [uri_license_image]: https://img.shields.io/badge/MPL-2.0-blue.svg
 
 [![License: MPL-2.0][uri_license_image]][uri_license]
-[![Managed with Taiga.io](https://img.shields.io/badge/managed%20with-TAIGA.io-709f14.svg)](https://tree.taiga.io/project/uxbox/ "Managed with Taiga.io")
+[![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")
 
 
 # PENPOT #
@@ -40,6 +41,11 @@ and improve Penpot. All your awesome ideas and code are welcome!
 Please refer to the [Contributing Guide](./CONTRIBUTING.md)
 
 
+## Documentation ##
+
+Please refer to [docs/ directory](./docs/).
+
+
 ## License ##
 
 ```

backend/deps.edn

@@ -3,40 +3,49 @@
   "clojars" {:url "https://clojars.org/repo"}
   "jcenter" {:url "https://jcenter.bintray.com/"}}
  :deps
- {org.clojure/clojure {:mvn/version "1.10.1"}
+ {org.clojure/clojure {:mvn/version "1.10.2"}
   org.clojure/clojurescript {:mvn/version "1.10.773"}
   org.clojure/data.json {:mvn/version "1.0.0"}
   org.clojure/core.async {:mvn/version "1.3.610"}
 
   ;; Logging
   org.clojure/tools.logging {:mvn/version "1.1.0"}
-  org.apache.logging.log4j/log4j-api {:mvn/version "2.13.3"}
-  org.apache.logging.log4j/log4j-core {:mvn/version "2.13.3"}
-  org.apache.logging.log4j/log4j-web {:mvn/version "2.13.3"}
-  org.apache.logging.log4j/log4j-jul {:mvn/version "2.13.3"}
-  org.apache.logging.log4j/log4j-slf4j-impl {:mvn/version "2.13.3"}
+  org.apache.logging.log4j/log4j-api {:mvn/version "2.14.0"}
+  org.apache.logging.log4j/log4j-core {:mvn/version "2.14.0"}
+  org.apache.logging.log4j/log4j-web {:mvn/version "2.14.0"}
+  org.apache.logging.log4j/log4j-jul {:mvn/version "2.14.0"}
+  org.apache.logging.log4j/log4j-slf4j-impl {:mvn/version "2.14.0"}
   org.slf4j/slf4j-api {:mvn/version "1.7.30"}
 
+  org.graalvm.js/js {:mvn/version "20.3.0"}
+  com.taoensso/nippy {:mvn/version "3.1.1"}
+  com.github.luben/zstd-jni {:mvn/version "1.4.8-3"}
+
   io.prometheus/simpleclient {:mvn/version "0.9.0"}
   io.prometheus/simpleclient_hotspot {:mvn/version "0.9.0"}
+  io.prometheus/simpleclient_jetty {:mvn/version "0.9.0"
+                                    :exclusions [org.eclipse.jetty/jetty-server
+                                                 org.eclipse.jetty/jetty-servlet]}
   io.prometheus/simpleclient_httpserver {:mvn/version "0.9.0"}
 
-  selmer/selmer {:mvn/version "1.12.28"}
-  expound/expound {:mvn/version "0.8.5"}
+  selmer/selmer {:mvn/version "1.12.33"}
+  expound/expound {:mvn/version "0.8.7"}
   com.cognitect/transit-clj {:mvn/version "1.0.324"}
 
   io.lettuce/lettuce-core {:mvn/version "5.2.2.RELEASE"}
   java-http-clj/java-http-clj {:mvn/version "0.4.1"}
 
-  info.sunng/ring-jetty9-adapter {:mvn/version "0.14.0"}
-  seancorfield/next.jdbc {:mvn/version "1.1.588"}
-  metosin/reitit-ring {:mvn/version "0.5.5"}
-  org.postgresql/postgresql {:mvn/version "42.2.16"}
+  info.sunng/ring-jetty9-adapter {:mvn/version "0.14.2"}
+  seancorfield/next.jdbc {:mvn/version "1.1.613"}
+  metosin/reitit-ring {:mvn/version "0.5.11"}
+  metosin/jsonista {:mvn/version "0.3.1"}
+
+  org.postgresql/postgresql {:mvn/version "42.2.18"}
   com.zaxxer/HikariCP {:mvn/version "3.4.5"}
 
   funcool/log4j2-clojure {:mvn/version "2020.11.23-1"}
   funcool/datoteka {:mvn/version "1.2.0"}
-  funcool/promesa {:mvn/version "5.1.0"}
+  funcool/promesa {:mvn/version "6.0.0"}
   funcool/cuerdas {:mvn/version "2020.03.26-3"}
 
   buddy/buddy-core {:mvn/version "1.9.0"}
@@ -51,54 +60,42 @@
   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"}
-  com.github.spullara.mustache.java/compiler {:mvn/version "0.9.6"}
   commons-io/commons-io {:mvn/version "2.8.0"}
-  com.draines/postal {:mvn/version "2.0.3"
-                      :exclusions [commons-codec/commons-codec]}
+  org.apache.commons/commons-pool2 {:mvn/version "2.9.0"}
+  com.sun.mail/jakarta.mail {:mvn/version "2.0.0"}
 
   puppetlabs/clj-ldap {:mvn/version"0.3.0"}
+  integrant/integrant {:mvn/version "0.8.0"}
+
+  software.amazon.awssdk/s3 {:mvn/version "2.15.73"}
 
   ;; exception printing
   io.aviso/pretty {:mvn/version "0.1.37"}
-
-  mount/mount {:mvn/version "0.1.16"}
   environ/environ {:mvn/version "1.2.0"}}
  :paths ["src" "resources" "../common" "common"]
  :aliases
  {:dev
   {:extra-deps
    {com.bhauman/rebel-readline {:mvn/version "0.1.4"}
-    org.clojure/tools.namespace {:mvn/version "1.0.0"}
-    org.clojure/test.check {:mvn/version "1.0.0"}
-    clj-kondo/clj-kondo {:mvn/version "RELEASE"}
+    org.clojure/tools.namespace {:mvn/version "1.1.0"}
+    org.clojure/test.check {:mvn/version "1.1.0"}
 
-    fipp/fipp {:mvn/version "0.6.21"}
-    criterium/criterium {:mvn/version "0.4.5"}
+    fipp/fipp {:mvn/version "0.6.23"}
+    criterium/criterium {:mvn/version "0.4.6"}
     mockery/mockery {:mvn/version "0.1.4"}}
-   :extra-paths ["tests"]}
-
-  ;; :fn-media-loader
-  ;; {:exec-fn app.cli.media-loader/run
-  ;;  :args {}}
+   :extra-paths ["tests" "dev"]}
 
   :fn-fixtures
   {:exec-fn app.cli.fixtures/run
    :args {}}
 
-  :lint
-  {:main-opts ["-m" "clj-kondo.main"]}
-
   :tests
-  {:extra-deps {lambdaisland/kaocha {:mvn/version "0.0-581"}}
+  {:extra-deps {lambdaisland/kaocha {:mvn/version "1.0.732"}}
    :main-opts ["-m" "kaocha.runner"]}
 
   :outdated
-  {:extra-deps {olical/depot {:mvn/version "1.8.4"}}
-   :main-opts ["-m" "depot.outdated.main"]}
-
-  :jar
-  {:extra-deps {seancorfield/depstar {:mvn/version "RELEASE"}}
-   :main-opts ["-m" "hf.depstar.jar" "-S" "target/app.jar"]}
+  {:extra-deps {antq/antq {:mvn/version "RELEASE"}}
+   :main-opts ["-m" "antq.core"]}
 
   :jmx-remote
   {:jvm-opts ["-Dcom.sun.management.jmxremote"

backend/dev/user.clj

@@ -9,23 +9,28 @@
 
 (ns user
   (:require
+   [app.config :as cfg]
+   [app.main :as main]
+   [app.util.time :as dt]
+   [app.util.transit :as t]
+   [app.common.exceptions :as ex]
+   [taoensso.nippy :as nippy]
+   [clojure.data.json :as json]
+   [clojure.java.io :as io]
+   [clojure.test :as test]
+   [clojure.pprint :refer [pprint]]
+   [clojure.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]]
-   [clojure.pprint :refer [pprint]]
-   [clojure.test :as test]
-   [clojure.java.io :as io]
-   [app.common.pages :as cp]
-   [clojure.repl :refer :all]
    [criterium.core :refer [quick-bench bench with-progress-reporting]]
-   [clj-kondo.core :as kondo]
-   [app.migrations]
-   [app.db :as db]
-   [app.metrics :as mtx]
-   [app.util.storage :as st]
-   [app.util.time :as tm]
-   [app.util.blob :as blob]
-   [mount.core :as mount]))
+   [integrant.core :as ig]))
+
+(repl/disable-reload! (find-ns 'integrant.core))
+
+(defonce system nil)
 
 ;; --- Benchmarking Tools
 
@@ -47,20 +52,6 @@
 
 ;; --- Development Stuff
 
-(defn- start
-  []
-  (-> #_(mount/except #{#'app.scheduled-jobs/scheduler})
-      (mount/start)))
-
-(defn- stop
-  []
-  (mount/stop))
-
-(defn restart
-  []
-  (stop)
-  (repl/refresh :after 'user/start))
-
 (defn- run-tests
   ([] (run-tests #"^app.tests.*"))
   ([o]
@@ -75,16 +66,28 @@
            (test/test-vars [(resolve o)]))
        (test/test-ns o)))))
 
-(defn lint
-  ([] (lint ""))
-  ([path]
-   (-> (kondo/run!
-        {:lint [(str "src/" path)]
-         :cache false
-         :config {:linters
-                  {:unresolved-symbol
-                   {:exclude ['(app.services.mutations/defmutation)
-                              '(app.services.queries/defquery)
-                              '(app.db/with-atomic)
-                              '(promesa.core/let)]}}}})
-       (kondo/print!))))
+(defn- start
+  []
+  (alter-var-root #'system (fn [sys]
+                             (when sys (ig/halt! sys))
+                             (-> (main/build-system-config cfg/config)
+                                 (ig/prep)
+                                 (ig/init))))
+  :started)
+
+(defn- stop
+  []
+  (alter-var-root #'system (fn [sys]
+                             (when sys (ig/halt! sys))
+                             nil))
+  :stoped)
+
+(defn restart
+  []
+  (stop)
+  (repl/refresh :after 'user/start))
+
+(defn restart-all
+  []
+  (stop)
+  (repl/refresh-all :after 'user/start))

backend/resources/emails-mjml/change-email/en.mjml

@@ -30,14 +30,14 @@
           for security reasons.
         </mj-text>
         <mj-text>Enjoy!</mj-text>
-        <mj-text>The UXBOX team.</mj-text>
+        <mj-text>The Penpot team.</mj-text>
       </mj-column>
     </mj-section>
 
     <mj-section padding="24px 0 0 0">
       <mj-column width="425px">
         <mj-text align="center" font-size="14px" color="#64666A">
-          UXBOX is the first Open Source prototyping platform that will be embraced by multidisciplinary teams.
+          Penpot is the first Open Source prototyping platform that will be embraced by multidisciplinary teams.
         </mj-text>
       </mj-column>
     </mj-section>
@@ -57,7 +57,7 @@
     <mj-section padding="0 0 24px 0">
       <mj-column>
         <mj-text align="center" font-size="14px" color="#64666A" line-height="150%">
-          UXBOX © 2020 | Made with &lt;3 and Open Source
+          Penpot © 2020 | Made with &lt;3 and Open Source
         </mj-text>
       </mj-column>
     </mj-section>

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

@@ -23,14 +23,14 @@
           Accept invite
         </mj-button>
         <mj-text>Enjoy!</mj-text>
-        <mj-text>The UXBOX team.</mj-text>
+        <mj-text>The Penpot team.</mj-text>
       </mj-column>
     </mj-section>
 
     <mj-section padding="24px 0 0 0">
       <mj-column width="425px">
         <mj-text align="center" font-size="14px" color="#64666A">
-          UXBOX is the first Open Source prototyping platform that will be embraced by multidisciplinary teams.
+          Penpot is the first Open Source prototyping platform that will be embraced by multidisciplinary teams.
         </mj-text>
       </mj-column>
     </mj-section>
@@ -50,7 +50,7 @@
     <mj-section padding="0 0 24px 0">
       <mj-column>
         <mj-text align="center" font-size="14px" color="#64666A" line-height="150%">
-          UXBOX © 2020 | Made with &lt;3 and Open Source
+          Penpot © 2020 | Made with &lt;3 and Open Source
         </mj-text>
       </mj-column>
     </mj-section>

backend/resources/emails-mjml/password-recovery/en.mjml

@@ -32,14 +32,14 @@
           it. Your password won't be changed.
         </mj-text>
         <mj-text>Enjoy!</mj-text>
-        <mj-text>The UXBOX team.</mj-text>
+        <mj-text>The Penpot team.</mj-text>
       </mj-column>
     </mj-section>
 
     <mj-section padding="24px 0 0 0">
       <mj-column width="425px">
         <mj-text align="center" font-size="14px" color="#64666A">
-          UXBOX is the first Open Source prototyping platform that will be embraced by multidisciplinary teams.
+          Penpot is the first Open Source prototyping platform that will be embraced by multidisciplinary teams.
         </mj-text>
       </mj-column>
     </mj-section>
@@ -59,7 +59,7 @@
     <mj-section padding="0 0 24px 0">
       <mj-column>
         <mj-text align="center" font-size="14px" color="#64666A" line-height="150%">
-          UXBOX © 2020 | Made with &lt;3 and Open Source
+          Penpot © 2020 | Made with &lt;3 and Open Source
         </mj-text>
       </mj-column>
     </mj-section>

backend/resources/emails-mjml/register/en.mjml

@@ -21,7 +21,7 @@
       <mj-column>
         <mj-text font-size="24px" font-weight="600">Hello {{name}}!</mj-text>
         <mj-text>
-          Thanks for signing up for your UXBOX account! Please verify your
+          Thanks for signing up for your Penpot account! Please verify your
           email using the link below adn get started building mockups and
           prototypes today!
         </mj-text>
@@ -29,14 +29,14 @@
           Verify email
         </mj-button>
         <mj-text>Enjoy!</mj-text>
-        <mj-text>The UXBOX team.</mj-text>
+        <mj-text>The Penpot team.</mj-text>
       </mj-column>
     </mj-section>
 
     <mj-section padding="24px 0 0 0">
       <mj-column width="425px">
         <mj-text align="center" font-size="14px" color="#64666A">
-          UXBOX is the first Open Source prototyping platform that will be embraced by multidisciplinary teams.
+          Penpot is the first Open Source prototyping platform that will be embraced by multidisciplinary teams.
         </mj-text>
       </mj-column>
     </mj-section>
@@ -56,7 +56,7 @@
     <mj-section padding="0 0 24px 0">
       <mj-column>
         <mj-text align="center" font-size="14px" color="#64666A" line-height="150%">
-          UXBOX © 2020 | Made with &lt;3 and Open Source
+          Penpot © 2020 | Made with &lt;3 and Open Source
         </mj-text>
       </mj-column>
     </mj-section>

backend/resources/emails/change-email/en.html

@@ -450,7 +450,7 @@
                 <table border="0" cellpadding="0" cellspacing="0" role="presentation" style="vertical-align:top;" width="100%">
                   <tr>
                     <td align="center" style="font-size:0px;padding:10px 25px;word-break:break-word;">
-                      <div style="font-family:Source Sans Pro, sans-serif;font-size:14px;line-height:150%;text-align:center;color:#64666A;">Penpot © 2020 | Made with &lt;3 and Open Source</div>
+                      <div style="font-family:Source Sans Pro, sans-serif;font-size:14px;line-height:150%;text-align:center;color:#64666A;">Penpot @ 2021 | Made with &lt;3 and Open Source</div>
                     </td>
                   </tr>
                 </table>

backend/resources/emails/change-email/en.txt

@@ -10,4 +10,4 @@ If you received this email by mistake, please consider changing your password
 for security reasons.
 
 Enjoy!
-The UXBOX team.
+The Penpot team.

backend/resources/emails/feedback/en.subj

@@ -0,0 +1 @@
+[FEEDBACK]: From {{ profile.email }}

backend/resources/emails/feedback/en.txt

@@ -0,0 +1,7 @@
+Feedback from: {{profile.fullname}} <{{profile.email}}>
+
+Profile ID: {{profile.id}}
+
+Subject: {{subject}}
+
+{{content}}

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

@@ -440,7 +440,7 @@
                 <table border="0" cellpadding="0" cellspacing="0" role="presentation" style="vertical-align:top;" width="100%">
                   <tr>
                     <td align="center" style="font-size:0px;padding:10px 25px;word-break:break-word;">
-                      <div style="font-family:Source Sans Pro, sans-serif;font-size:14px;line-height:150%;text-align:center;color:#64666A;">Penpot © 2020 | Made with &lt;3 and Open Source</div>
+                      <div style="font-family:Source Sans Pro, sans-serif;font-size:14px;line-height:150%;text-align:center;color:#64666A;">Penpot @ 2021 | Made with &lt;3 and Open Source</div>
                     </td>
                   </tr>
                 </table>

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

@@ -7,4 +7,4 @@ Accept invitation using this link:
 {{ public-uri }}/#/auth/verify-token?token={{token}}
 
 Enjoy!
-The UXBOX team.
+The Penpot team.

backend/resources/emails/password-recovery/en.html

@@ -445,7 +445,7 @@
                 <table border="0" cellpadding="0" cellspacing="0" role="presentation" style="vertical-align:top;" width="100%">
                   <tr>
                     <td align="center" style="font-size:0px;padding:10px 25px;word-break:break-word;">
-                      <div style="font-family:Source Sans Pro, sans-serif;font-size:14px;line-height:150%;text-align:center;color:#64666A;">Penpot © 2020 | Made with &lt;3 and Open Source</div>
+                      <div style="font-family:Source Sans Pro, sans-serif;font-size:14px;line-height:150%;text-align:center;color:#64666A;">Penpot @ 2021 | Made with &lt;3 and Open Source</div>
                     </td>
                   </tr>
                 </table>

backend/resources/emails/password-recovery/en.txt

@@ -9,4 +9,4 @@ If you received this email by mistake, you can safely ignore it. Your password
 won't be changed.
 
 Enjoy!
-The UXBOX team.
+The Penpot team.

backend/resources/emails/register/en.html

@@ -440,7 +440,7 @@
                 <table border="0" cellpadding="0" cellspacing="0" role="presentation" style="vertical-align:top;" width="100%">
                   <tr>
                     <td align="center" style="font-size:0px;padding:10px 25px;word-break:break-word;">
-                      <div style="font-family:Source Sans Pro, sans-serif;font-size:14px;line-height:150%;text-align:center;color:#64666A;">Penpot © 2020 | Made with &lt;3 and Open Source</div>
+                      <div style="font-family:Source Sans Pro, sans-serif;font-size:14px;line-height:150%;text-align:center;color:#64666A;">Penpot @ 2021 | Made with &lt;3 and Open Source</div>
                     </td>
                   </tr>
                 </table>

backend/resources/emails/register/en.txt

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

backend/resources/error-report.tmpl

@@ -0,0 +1,162 @@
+<!DOCTYPE html>
+<html>
+  <head>
+    <meta charset="utf-8" />
+    <meta http-equiv="x-ua-compatible" content="ie=edge" />
+    <title>penpot - error report {{id}}</title>
+    <link rel="stylesheet" href="https://fonts.googleapis.com/css2?family=JetBrains+Mono">
+    <style>
+      body {
+        margin: 0px;
+        padding: 0px;
+      }
+      pre {
+        margin: 0px;
+      }
+      * {
+        font-family: "JetBrains Mono", monospace; 
+        font-size: 12px;
+      }
+      .table {
+        display: flex;
+        flex-direction: column;
+        margin: 10px;
+      }
+
+      .table-row {
+        display: flex;
+        /* width: 100%; */
+        /* border: 1px solid red; */
+      }
+
+      .table-key {
+        font-weight: 600;
+        width: 70px;
+        padding: 4px;
+      }
+
+      .table-val {
+        font-weight: 200;
+        color: #333;
+        padding: 4px;
+      }
+
+      .multiline {
+        margin-top: 15px;
+        flex-direction: column;
+      }
+
+      .multiline .table-key {
+        margin-bottom: 10px;
+        border-bottom: 1px dashed #dddddd;
+        /* padding: 4px; */
+        width: unset;
+      }
+
+    </style>
+  </head>
+  <body>
+    <div class="table">
+      <div class="table-row">
+        <div class="table-key" title="Error ID">ERID: </div>
+        <div class="table-val">{{id}}</div>
+      </div>
+      {% if profile-id %}
+      <div class="table-row">
+        <div class="table-key" title="Profile ID">PFID: </div>
+        <div class="table-val">{{profile-id}}</div>
+      </div>
+      {% endif %}
+
+      {% if user-agent %}
+      <div class="table-row">
+        <div class="table-key">UAGENT: </div>
+        <div class="table-val">{{user-agent}}</div>
+      </div>
+      {% endif %}
+
+      {% if frontend-version %}
+      <div class="table-row">
+        <div class="table-key">FVERS: </div>
+        <div class="table-val">{{frontend-version}}</div>
+      </div>
+      {% endif %}
+
+      <div class="table-row">
+        <div class="table-key">BVERS: </div>
+        <div class="table-val">{{version}}</div>
+      </div>
+
+      <div class="table-row">
+        <div class="table-key">HOST: </div>
+        <div class="table-val">{{host}}</div>
+      </div>
+
+      {% if type %}
+      <div class="table-row">
+        <div class="table-key">TYPE: </div>
+        <div class="table-val">{{type}}</div>
+      </div>
+      {% endif %}
+
+      {% if code %}
+      <div class="table-row">
+        <div class="table-key">CODE: </div>
+        <div class="table-val">{{code}}</div>
+      </div>
+      {% endif %}
+
+      <div class="table-row">
+        <div class="table-key">CLASS: </div>
+        <div class="table-val">{{class}}</div>
+      </div>
+
+      <div class="table-row">
+        <div class="table-key">HINT: </div>
+        <div class="table-val">{{hint}}</div>
+      </div>
+
+      {% if method %}
+      <div class="table-row">
+        <div class="table-key">PATH: </div>
+        <div class="table-val">{{method|upper}} {{path}}</div>
+      </div>
+      {% endif %}
+
+      {% if params %}
+      <div class="table-row multiline">
+        <div class="table-key">PARAMS: </div>
+        <div class="table-val">
+          <pre>{{params}}</pre>
+        </div>
+      </div>
+      {% endif %}
+
+      {% if explain %}
+      <div class="table-row multiline">
+        <div class="table-key">EXPLAIN: </div>
+        <div class="table-val">
+          <pre>{{explain}}</pre>
+        </div>
+      </div>
+      {% endif %}
+
+      {% if data %}
+      <div class="table-row multiline">
+        <div class="table-key">EDATA: </div>
+        <div class="table-val">
+          <pre>{{data}}</pre>
+        </div>
+      </div>
+      {% endif %}
+
+      <div class="table-row multiline">
+        <div class="table-key">TRACE:</div>
+        <div class="table-val">
+          <pre>{{message}}</pre>
+        </div>
+      </div>
+    </div>
+  </body>
+</html>
+

backend/resources/log4j2.xml

@@ -13,7 +13,7 @@
       <DefaultRolloverStrategy max="9"/>
     </RollingFile>
 
-    <CljFn name="error-reporter" ns="app.error-reporter" fn="enqueue">
+    <CljFn name="error-reporter" ns="app.error-reporter" fn="queue-fn">
       <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] [%t] %level{length=1} %logger{36} - %msg%n"/>
     </CljFn>
   </Appenders>
@@ -28,7 +28,7 @@
     </Logger>
 
     <Logger name="app.error-reporter" level="debug" additivity="false">
-      <AppenderRef ref="console"/>
+      <AppenderRef ref="main" level="debug" />
     </Logger>
 
     <Logger name="app" level="debug" additivity="false">

backend/scripts/build.sh

@@ -17,6 +17,8 @@ done
 cp ./resources/log4j2-bundle.xml ./target/dist/log4j2.xml
 cp -r ./src ./target/dist/main
 cp -r ./resources/emails ./target/dist/main/
+cp -r ./resources/svgclean.js ./target/dist/main/
+cp -r ./resources/error-report.tmpl ./target/dist/main/
 cp -r ../common ./target/dist/common
 
 echo $NEWCP > ./target/dist/classpath;
@@ -47,7 +49,7 @@ if [ -f ./environ ]; then
 fi
 
 set -x
-exec \$JAVA_CMD \$JVM_OPTS -Dapp.enable-asserts=false -classpath \$CP -Dlog4j.configurationFile=./log4j2.xml "\$@" clojure.main -m app.main
+exec \$JAVA_CMD \$JVM_OPTS -classpath \$CP -Dlog4j.configurationFile=./log4j2.xml "\$@" clojure.main -m app.main
 EOF
 
 chmod +x ./target/dist/run.sh

backend/scripts/psql.sh

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

backend/scripts/repl

@@ -1,6 +1,7 @@
 #!/usr/bin/env bash
-set -ex
 
+export PENPOT_ASSERTS_ENABLED=true
+
+set -ex
 # clojure -Ojmx-remote -A:dev -e "(set! *warn-on-reflection* true)" -m rebel-readline.main
-# clojure -Ojmx-remote -A:dev -J-XX:+UnlockExperimentalVMOptions -J-XX:+UseZGC -J-Xms128m -J-Xmx128m -m rebel-readline.main
-clojure -A:jmx-remote:dev -J-Xms128m -J-Xmx128m -M -m rebel-readline.main
+clojure -A:jmx-remote:dev -J-Xms512m -J-Xmx512m -M -m rebel-readline.main

backend/scripts/start-dev

@@ -1,5 +1,7 @@
 #!/bin/sh
 
+export PENPOT_ASSERTS_ENABLED=true
+
 set -ex
 
 if [ ! -e ~/.fixtures-loaded ]; then
@@ -8,6 +10,6 @@ if [ ! -e ~/.fixtures-loaded ]; then
     touch ~/.fixtures-loaded
 fi
 
-clojure -M -m app.main
+clojure -A:dev -M -m app.main
 
 

backend/scripts/tests.sh

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

backend/src/app/cli/fixtures.clj

@@ -14,12 +14,12 @@
    [app.common.uuid :as uuid]
    [app.config :as cfg]
    [app.db :as db]
-   [app.migrations]
-   [app.services.mutations.profile :as profile]
+   [app.main :as main]
+   [app.rpc.mutations.profile :as profile]
    [app.util.blob :as blob]
    [buddy.hashers :as hashers]
    [clojure.tools.logging :as log]
-   [mount.core :as mount]))
+   [integrant.core :as ig]))
 
 (defn- mk-uuid
   [prefix & args]
@@ -71,18 +71,18 @@
        (#'profile/create-profile-relations conn)))
 
 (defn impl-run
-  [opts]
+  [pool opts]
   (let [rng (java.util.Random. 1)]
     (letfn [(create-profile [conn index]
               (let [id   (mk-uuid "profile" index)
-                    _    (log/info "create profile" id)
+                    _    (log/info "create profile" index id)
 
                     prof (register-profile conn
                                            {:id id
                                             :fullname (str "Profile " index)
                                             :password "123123"
                                             :demo? true
-                                            :email (str "profile" index ".test@penpot.app")})
+                                            :email (str "profile" index "@example.com")})
                     team-id  (:default-team-id prof)
                     owner-id id]
                 (let [project-ids (collect (partial create-project conn team-id owner-id)
@@ -98,10 +98,9 @@
             (create-team [conn index]
               (let [id (mk-uuid "team" index)
                     name (str "Team" index)]
-                (log/info "create team" id)
+                (log/info "create team" index id)
                 (db/insert! conn :team {:id id
-                                        :name name
-                                        :photo ""})
+                                        :name name})
                 id))
 
             (create-teams [conn]
@@ -112,8 +111,8 @@
             (create-file [conn owner-id project-id index]
               (let [id (mk-uuid "file" project-id index)
                     name (str "file" index)
-                    data (cp/make-file-data)]
-                (log/info "create file" id)
+                    data (cp/make-file-data id)]
+                (log/info "create file" index id)
                 (db/insert! conn :file
                             {:id id
                              :data (blob/encode data)
@@ -135,7 +134,7 @@
             (create-project [conn team-id owner-id index]
               (let [id (mk-uuid "project" team-id index)
                     name (str "project " index)]
-                (log/info "create project" id)
+                (log/info "create project" index id)
                 (db/insert! conn :project
                             {:id id
                              :team-id team-id
@@ -186,9 +185,9 @@
                     id         (mk-uuid "file" "draft" owner-id index)
                     name       (str "file" index)
                     project-id (:default-project-id owner)
-                    data       (cp/make-file-data)]
+                    data       (cp/make-file-data id)]
 
-                (log/info "create draft file" id)
+                (log/info "create draft file" index id)
                 (db/insert! conn :file
                             {:id id
                              :data (blob/encode data)
@@ -206,33 +205,38 @@
               (run! (partial create-draft-file conn profile)
                     (range (:num-draft-files-per-profile opts))))
             ]
-      (db/with-atomic [conn db/pool]
+      (db/with-atomic [conn pool]
         (let [profiles (create-profiles conn)
               teams    (create-teams conn)]
           (assign-teams-and-profiles conn teams (map :id profiles))
           (run! (partial create-draft-files conn) profiles))))))
 
-(defn run*
-  [preset]
-  (let [preset (if (map? preset)
+(defn run-in-system
+  [system preset]
+  (let [pool   (:app.db/pool system)
+        preset (if (map? preset)
                  preset
                  (case preset
                    (nil "small" :small) preset-small
                    ;; "medium" preset-medium
                    ;; "big" preset-big
                    preset-small))]
-    (impl-run preset)))
+    (impl-run pool preset)))
 
 (defn run
-  [{:keys [preset]
-    :or {preset :small}}]
-  (try
-    (-> (mount/only #{#'app.config/config
-                      #'app.db/pool
-                      #'app.migrations/migrations})
-        (mount/start))
-    (run* preset)
-    (catch Exception e
-      (log/errorf e "Unhandled exception."))
-    (finally
-      (mount/stop))))
+  [{:keys [preset] :or {preset :small}}]
+  (let [config (select-keys (main/build-system-config cfg/config)
+                            [:app.db/pool
+                             :app.telemetry/migrations
+                             :app.migrations/migrations
+                             :app.migrations/all
+                             :app.metrics/metrics])
+        _      (ig/load-namespaces config)
+        system (-> (ig/prep config)
+                   (ig/init))]
+    (try
+      (run-in-system system preset)
+      (catch Exception e
+        (log/errorf e "Unhandled exception."))
+      (finally
+        (ig/halt! system)))))

backend/src/app/cli/media_loader.clj

@@ -1,232 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
-
-(ns app.cli.media-loader
-  "Media libraries importer (command line helper)."
-  #_(:require
-   [app.common.spec :as us]
-   [app.common.uuid :as uuid]
-   [app.config]
-   [app.db :as db]
-   [app.media-storage]
-   [app.media]
-   [app.migrations]
-   [app.services.mutations.files :as files]
-   [app.services.mutations.media :as media]
-   [app.services.mutations.projects :as projects]
-   [clojure.java.io :as io]
-   [clojure.spec.alpha :as s]
-   [clojure.tools.logging :as log]
-   [datoteka.core :as fs]
-   [mount.core :as mount])
-  #_(:import
-   java.io.PushbackReader))
-
-;; --- Constants & Helpers
-
-;; (def ^:const +graphics-uuid-ns+ #uuid "3642a582-565f-4070-beba-af797ab27a6a")
-;; (def ^:const +colors-uuid-ns+ #uuid "3642a582-565f-4070-beba-af797ab27a6c")
-
-;; (s/def ::id ::us/uuid)
-;; (s/def ::name ::us/string)
-;; (s/def ::path ::us/string)
-;; (s/def ::regex #(instance? java.util.regex.Pattern %))
-
-;; (s/def ::import-graphics
-;;   (s/keys :req-un [::path ::regex]))
-
-;; (s/def ::import-color
-;;   (s/* (s/cat :name ::us/string :color ::us/color)))
-
-;; (s/def ::import-colors (s/coll-of ::import-color))
-
-;; (s/def ::import-library
-;;   (s/keys :req-un [::name]
-;;           :opt-un [::import-graphics ::import-colors]))
-
-;; (defn exit!
-;;   ([] (exit! 0))
-;;   ([code]
-;;    (System/exit code)))
-
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; ;; Graphics Importer
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; (defn- create-media-object
-;;   [conn file-id media-object-id localpath]
-;;   (s/assert fs/path? localpath)
-;;   (s/assert ::us/uuid file-id)
-;;   (s/assert ::us/uuid media-object-id)
-;;   (let [filename (fs/name localpath)
-;;         extension (second (fs/split-ext filename))
-;;         file (io/as-file localpath)
-;;         mtype (case extension
-;;                 ".jpg"  "image/jpeg"
-;;                 ".png"  "image/png"
-;;                 ".webp" "image/webp"
-;;                 ".svg"  "image/svg+xml")]
-;;     (log/info "Creating image" filename media-object-id)
-;;     (media/create-media-object conn {:content {:tempfile localpath
-;;                                                :filename filename
-;;                                                :content-type mtype
-;;                                                :size (.length file)}
-;;                                      :id media-object-id
-;;                                      :file-id file-id
-;;                                      :name filename
-;;                                      :is-local false})))
-
-;; (defn- media-object-exists?
-;;   [conn id]
-;;   (s/assert ::us/uuid id)
-;;   (let [row (db/get-by-id conn :media-object id)]
-;;     (if row true false)))
-
-;; (defn- import-media-object-if-not-exists
-;;   [conn file-id fpath]
-;;   (s/assert ::us/uuid file-id)
-;;   (s/assert fs/path? fpath)
-;;   (let [media-object-id (uuid/namespaced +graphics-uuid-ns+ (str file-id (fs/name fpath)))]
-;;     (when-not (media-object-exists? conn media-object-id)
-;;       (create-media-object conn file-id media-object-id fpath))
-;;     media-object-id))
-
-;; (defn- import-graphics
-;;   [conn file-id {:keys [path regex]}]
-;;   (run! (fn [fpath]
-;;           (when (re-matches regex (str fpath))
-;;             (import-media-object-if-not-exists conn file-id fpath)))
-;;         (->> (fs/list-dir path)
-;;              (filter fs/regular-file?))))
-
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; ;; Colors Importer
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; (defn- create-color
-;;   [conn file-id name content]
-;;   (s/assert ::us/uuid file-id)
-;;   (s/assert ::us/color content)
-;;   (let [color-id (uuid/namespaced +colors-uuid-ns+ (str file-id content))]
-;;     (log/info "Creating color" color-id "-" name content)
-;;     (colors/create-color conn {:id color-id
-;;                                :file-id file-id
-;;                                :name name
-;;                                :content content})
-;;     color-id))
-
-;; (defn- import-colors
-;;   [conn file-id colors]
-;;   (db/delete! conn :color {:file-id file-id})
-;;   (run! (fn [[name content]]
-;;           (create-color conn file-id name content))
-;;         (partition-all 2 colors)))
-
-
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; ;; Library files Importer
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; (defn- library-file-exists?
-;;   [conn id]
-;;   (s/assert ::us/uuid id)
-;;   (let [row (db/get-by-id conn :file id)]
-;;     (if row true false)))
-
-;; (defn- create-library-file-if-not-exists
-;;   [conn project-id {:keys [name]}]
-;;   (let [id (uuid/namespaced +colors-uuid-ns+ name)]
-;;     (when-not (library-file-exists? conn id)
-;;       (log/info "Creating library-file:" name)
-;;       (files/create-file conn {:id id
-;;                                :profile-id uuid/zero
-;;                                :project-id project-id
-;;                                :name name
-;;                                :is-shared true})
-;;       (files/create-page conn {:file-id id}))
-;;     id))
-
-;; (defn- process-library
-;;   [conn basedir project-id {:keys [graphics colors] :as library}]
-;;   (us/verify ::import-library library)
-;;   (let [library-file-id (create-library-file-if-not-exists conn project-id library)]
-;;     (when graphics
-;;       (->> (assoc graphics :path (fs/join basedir (:path graphics)))
-;;            (import-graphics conn library-file-id)))
-;;     (when colors
-;;       (import-colors conn library-file-id colors))))
-
-
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; ;; Entry Point
-;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; (defn- project-exists?
-;;   [conn id]
-;;   (s/assert ::us/uuid id)
-;;   (let [row (db/get-by-id conn :project id)]
-;;     (if row true false)))
-
-;; (defn- create-project-if-not-exists
-;;   [conn {:keys [name] :as project}]
-;;   (let [id (uuid/namespaced +colors-uuid-ns+ name)]
-;;     (when-not (project-exists? conn id)
-;;       (log/info "Creating project" name)
-;;       (projects/create-project conn {:id id
-;;                                      :team-id uuid/zero
-;;                                      :name name
-;;                                      :default? false}))
-;;     id))
-
-;; (defn- validate-path
-;;   [path]
-;;   (let [path (if (symbol? path) (str path) path)]
-;;     (log/infof "Trying to load config from '%s'." path)
-;;     (when-not path
-;;       (log/error "No path is provided")
-;;       (exit! -1))
-;;     (when-not (fs/exists? path)
-;;       (log/error "Path does not exists.")
-;;       (exit! -1))
-;;     (when (fs/directory? path)
-;;       (log/error "The provided path is a directory.")
-;;       (exit! -1))
-;;     (fs/path path)))
-
-;; (defn- read-file
-;;   [path]
-;;   (let [reader (PushbackReader. (io/reader path))]
-;;     [(fs/parent path)
-;;      (read reader)]))
-
-;; (defn run*
-;;   [path]
-;;   (let [[basedir libraries] (read-file path)]
-;;     (db/with-atomic [conn db/pool]
-;;       (let [project-id (create-project-if-not-exists conn {:name "System libraries"})]
-;;         (run! #(process-library conn basedir project-id %) libraries)))))
-
-;; (defn run
-;;   [{:keys [path] :as params}]
-;;   (log/infof "Starting media loader.")
-;;   (let [path (validate-path path)]
-
-;;     (try
-;;       (-> (mount/only #{#'app.config/config
-;;                         #'app.db/pool
-;;                         #'app.migrations/migrations
-;;                         #'app.media/semaphore
-;;                         #'app.media-storage/media-storage})
-;;           (mount/start))
-;;       (run* path)
-;;       (catch Exception e
-;;         (log/errorf e "Unhandled exception."))
-;;       (finally
-;;         (mount/stop)))))
-

backend/src/app/cli/migrate_media.clj

@@ -0,0 +1,132 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; This Source Code Form is "Incompatible With Secondary Licenses", as
+;; defined by the Mozilla Public License, v. 2.0.
+;;
+;; Copyright (c) 2020 UXBOX Labs SL
+
+(ns app.cli.migrate-media
+  (:require
+   [app.common.media :as cm]
+   [app.config :as cfg]
+   [app.db :as db]
+   [app.main :as main]
+   [app.storage :as sto]
+   [clojure.tools.logging :as log]
+   [cuerdas.core :as str]
+   [datoteka.core :as fs]
+   [integrant.core :as ig]))
+
+(declare migrate-profiles)
+(declare migrate-teams)
+(declare migrate-file-media)
+
+(defn run-in-system
+  [system]
+  (db/with-atomic [conn (:app.db/pool system)]
+    (let [system (assoc system ::conn conn)]
+      (migrate-profiles system)
+      (migrate-teams system)
+      (migrate-file-media system))
+    system))
+
+(defn run
+  []
+  (let [config (select-keys (main/build-system-config cfg/config)
+                            [:app.db/pool
+                             :app.migrations/migrations
+                             :app.metrics/metrics
+                             :app.storage.s3/backend
+                             :app.storage.db/backend
+                             :app.storage.fs/backend
+                             :app.storage/storage])]
+    (ig/load-namespaces config)
+    (try
+      (-> (ig/prep config)
+          (ig/init)
+          (run-in-system)
+          (ig/halt!))
+      (catch Exception e
+        (log/errorf e "Unhandled exception.")))))
+
+
+;; --- IMPL
+
+(defn migrate-profiles
+  [{:keys [::conn] :as system}]
+  (letfn [(retrieve-profiles [conn]
+            (->> (db/exec! conn ["select * from profile"])
+                 (filter #(not (str/empty? (:photo %))))
+                 (seq)))]
+    (let [base    (fs/path (:storage-fs-old-directory cfg/config))
+          storage (-> (:app.storage/storage system)
+                      (assoc :conn conn))]
+      (doseq [profile (retrieve-profiles conn)]
+        (let [path  (fs/path (:photo profile))
+              full  (-> (fs/join base path)
+                        (fs/normalize))
+              ext   (fs/ext path)
+              mtype (cm/format->mtype (keyword ext))
+              obj   (sto/put-object storage {:content (sto/content full)
+                                             :content-type mtype})]
+          (db/update! conn :profile
+                      {:photo-id (:id obj)}
+                      {:id (:id profile)}))))))
+
+(defn migrate-teams
+  [{:keys [::conn] :as system}]
+  (letfn [(retrieve-teams [conn]
+            (->> (db/exec! conn ["select * from team"])
+                 (filter #(not (str/empty? (:photo %))))
+                 (seq)))]
+    (let [base    (fs/path (:storage-fs-old-directory cfg/config))
+          storage (-> (:app.storage/storage system)
+                      (assoc :conn conn))]
+      (doseq [team (retrieve-teams conn)]
+        (let [path  (fs/path (:photo team))
+              full  (-> (fs/join base path)
+                        (fs/normalize))
+              ext   (fs/ext path)
+              mtype (cm/format->mtype (keyword ext))
+              obj   (sto/put-object storage {:content (sto/content full)
+                                             :content-type mtype})]
+          (db/update! conn :team
+                      {:photo-id (:id obj)}
+                      {:id (:id team)}))))))
+
+
+
+(defn migrate-file-media
+  [{:keys [::conn] :as system}]
+  (letfn [(retrieve-media-objects [conn]
+            (->> (db/exec! conn ["select fmo.id, fmo.path, fth.path as thumbnail_path
+                                    from file_media_object as fmo
+                                    join file_media_thumbnail as fth on (fth.media_object_id = fmo.id)"])
+                 (seq)))]
+    (let [base    (fs/path (:storage-fs-old-directory cfg/config))
+          storage (-> (:app.storage/storage system)
+                      (assoc :conn conn))]
+      (doseq [mobj (retrieve-media-objects conn)]
+        (let [img-path  (fs/path (:path mobj))
+              thm-path  (fs/path (:thumbnail-path mobj))
+              img-path  (-> (fs/join base img-path)
+                            (fs/normalize))
+              thm-path  (-> (fs/join base thm-path)
+                            (fs/normalize))
+              img-ext   (fs/ext img-path)
+              thm-ext   (fs/ext thm-path)
+
+              img-mtype (cm/format->mtype (keyword img-ext))
+              thm-mtype (cm/format->mtype (keyword thm-ext))
+
+              img-obj   (sto/put-object storage {:content (sto/content img-path)
+                                                 :content-type img-mtype})
+              thm-obj   (sto/put-object storage {:content (sto/content thm-path)
+                                                 :content-type thm-mtype})]
+
+          (db/update! conn :file-media-object
+                      {:media-id (:id img-obj)
+                       :thumbnail-id (:id thm-obj)}
+                      {:id (:id mobj)}))))))

backend/src/app/config.clj

@@ -15,43 +15,49 @@
    [app.util.time :as dt]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
-   [environ.core :refer [env]]
-   [mount.core :refer [defstate]]))
+   [environ.core :refer [env]]))
 
 (def defaults
   {:http-server-port 6060
-   :http-server-cors "http://localhost:3449"
+
    :database-uri "postgresql://127.0.0.1/penpot"
    :database-username "penpot"
    :database-password "penpot"
-   :secret-key "default"
 
-   :media-directory "resources/public/media"
-   :assets-directory "resources/public/static"
+   :default-blob-version 1
 
-   :public-uri "http://localhost:3449/"
+   :asserts-enabled false
+
+   :public-uri "http://localhost:3449"
    :redis-uri "redis://localhost/0"
-   :media-uri "http://localhost:3449/media/"
-   :assets-uri "http://localhost:3449/static/"
 
-   :image-process-max-threads 2
+   :srepl-host "127.0.0.1"
+   :srepl-port 6062
+
+   :storage-backend :fs
+
+   :storage-fs-directory "resources/public/assets"
+   :storage-s3-region :eu-central-1
+   :storage-s3-bucket "penpot-devenv-assets-pre"
+
+   :feedback-destination "info@example.com"
+   :feedback-enabled false
+
+   :assets-path "/internal/assets/"
+
+   :rlimits-password 10
+   :rlimits-image 2
 
    :smtp-enabled false
-   :smtp-default-reply-to "no-reply@example.com"
-   :smtp-default-from "no-reply@example.com"
-
-   :host "devenv"
+   :smtp-default-reply-to "Penpot <no-reply@example.com>"
+   :smtp-default-from "Penpot <no-reply@example.com>"
 
    :allow-demo-users true
    :registration-enabled true
    :registration-domain-whitelist ""
-   :debug-humanize-transit true
 
-   ;; This is the time should transcurr after the last page
-   ;; modification in order to make the file ellegible for
-   ;; trimming. The value only supports s(econds) m(inutes) and
-   ;; h(ours) as time unit.
-   :file-trimming-threshold "72h"
+   :telemetry-enabled false
+   :telemetry-uri "https://telemetry.penpot.app/"
 
    ;; LDAP auth disabled by default. Set ldap-auth-host to enable
    ;:ldap-auth-host "ldap.mysupercompany.com"
@@ -66,26 +72,37 @@
    :ldap-auth-username-attribute "uid"
    :ldap-auth-email-attribute "mail"
    :ldap-auth-fullname-attribute "displayName"
-   :ldap-auth-avatar-attribute "jpegPhoto"})
+   :ldap-auth-avatar-attribute "jpegPhoto"
+
+   ;; :initial-data-file "resources/initial-data.json"
+   ;; :initial-data-project-name "Penpot Oboarding"
+   })
 
 (s/def ::http-server-port ::us/integer)
-(s/def ::http-server-debug ::us/boolean)
-(s/def ::http-server-cors ::us/string)
 (s/def ::database-username (s/nilable ::us/string))
 (s/def ::database-password (s/nilable ::us/string))
 (s/def ::database-uri ::us/string)
 (s/def ::redis-uri ::us/string)
-(s/def ::assets-uri ::us/string)
-(s/def ::assets-directory ::us/string)
+
+
+(s/def ::storage-backend ::us/keyword)
+(s/def ::storage-fs-directory ::us/string)
+(s/def ::assets-path ::us/string)
+(s/def ::storage-s3-region ::us/keyword)
+(s/def ::storage-s3-bucket ::us/string)
+
 (s/def ::media-uri ::us/string)
 (s/def ::media-directory ::us/string)
-(s/def ::secret-key ::us/string)
+(s/def ::asserts-enabled ::us/boolean)
+
+(s/def ::feedback-enabled ::us/boolean)
+(s/def ::feedback-destination ::us/string)
 
-(s/def ::host ::us/string)
 (s/def ::error-report-webhook ::us/string)
+
 (s/def ::smtp-enabled ::us/boolean)
-(s/def ::smtp-default-reply-to ::us/email)
-(s/def ::smtp-default-from ::us/email)
+(s/def ::smtp-default-reply-to ::us/string)
+(s/def ::smtp-default-from ::us/string)
 (s/def ::smtp-host ::us/string)
 (s/def ::smtp-port ::us/integer)
 (s/def ::smtp-username (s/nilable ::us/string))
@@ -95,12 +112,13 @@
 (s/def ::allow-demo-users ::us/boolean)
 (s/def ::registration-enabled ::us/boolean)
 (s/def ::registration-domain-whitelist ::us/string)
-(s/def ::debug-humanize-transit ::us/boolean)
 (s/def ::public-uri ::us/string)
-(s/def ::backend-uri ::us/string)
 
-(s/def ::image-process-max-threads ::us/integer)
-(s/def ::file-trimming-threshold ::dt/duration)
+(s/def ::srepl-host ::us/string)
+(s/def ::srepl-port ::us/integer)
+
+(s/def ::rlimits-password ::us/integer)
+(s/def ::rlimits-image ::us/integer)
 
 (s/def ::google-client-id ::us/string)
 (s/def ::google-client-secret ::us/string)
@@ -109,6 +127,9 @@
 (s/def ::gitlab-client-secret ::us/string)
 (s/def ::gitlab-base-uri ::us/string)
 
+(s/def ::github-client-id ::us/string)
+(s/def ::github-client-secret ::us/string)
+
 (s/def ::ldap-auth-host ::us/string)
 (s/def ::ldap-auth-port ::us/integer)
 (s/def ::ldap-bind-dn ::us/string)
@@ -122,56 +143,78 @@
 (s/def ::ldap-auth-fullname-attribute ::us/string)
 (s/def ::ldap-auth-avatar-attribute ::us/string)
 
+(s/def ::telemetry-enabled ::us/boolean)
+(s/def ::telemetry-with-taiga ::us/boolean)
+(s/def ::telemetry-uri ::us/string)
+(s/def ::telemetry-server-enabled ::us/boolean)
+(s/def ::telemetry-server-port ::us/integer)
+
+(s/def ::initial-data-file ::us/string)
+(s/def ::initial-data-project-name ::us/string)
+
+(s/def ::default-blob-version ::us/integer)
+
 (s/def ::config
-  (s/keys :opt-un [::http-server-cors
-                   ::http-server-debug
-                   ::http-server-port
-                   ::google-client-id
-                   ::google-client-secret
-                   ::gitlab-client-id
-                   ::gitlab-client-secret
-                   ::gitlab-base-uri
-                   ::redis-uri
-                   ::public-uri
-                   ::database-username
+  (s/keys :opt-un [::allow-demo-users
+                   ::asserts-enabled
                    ::database-password
                    ::database-uri
-                   ::assets-directory
-                   ::assets-uri
-                   ::media-directory
-                   ::media-uri
+                   ::database-username
+                   ::default-blob-version
                    ::error-report-webhook
-                   ::secret-key
+                   ::feedback-enabled
+                   ::feedback-destination
+                   ::github-client-id
+                   ::github-client-secret
+                   ::gitlab-base-uri
+                   ::gitlab-client-id
+                   ::gitlab-client-secret
+                   ::google-client-id
+                   ::google-client-secret
+                   ::http-server-port
+                   ::ldap-auth-avatar-attribute
+                   ::ldap-auth-base-dn
+                   ::ldap-auth-email-attribute
+                   ::ldap-auth-fullname-attribute
+                   ::ldap-auth-host
+                   ::ldap-auth-port
+                   ::ldap-auth-ssl
+                   ::ldap-auth-starttls
+                   ::ldap-auth-user-query
+                   ::ldap-auth-username-attribute
+                   ::ldap-bind-dn
+                   ::ldap-bind-password
+                   ::public-uri
+                   ::redis-uri
+                   ::registration-domain-whitelist
+                   ::registration-enabled
+                   ::rlimits-password
+                   ::rlimits-image
                    ::smtp-default-from
                    ::smtp-default-reply-to
                    ::smtp-enabled
                    ::smtp-host
-                   ::smtp-port
-                   ::smtp-username
                    ::smtp-password
-                   ::smtp-tls
+                   ::smtp-port
                    ::smtp-ssl
-                   ::host
-                   ::file-trimming-threshold
-                   ::debug-humanize-transit
-                   ::allow-demo-users
-                   ::registration-enabled
-                   ::registration-domain-whitelist
-                   ::image-process-max-threads
-                   ::ldap-auth-host
-                   ::ldap-auth-port
-                   ::ldap-bind-dn
-                   ::ldap-bind-password
-                   ::ldap-auth-ssl
-                   ::ldap-auth-starttls
-                   ::ldap-auth-base-dn
-                   ::ldap-auth-user-query
-                   ::ldap-auth-username-attribute
-                   ::ldap-auth-email-attribute
-                   ::ldap-auth-fullname-attribute
-                   ::ldap-auth-avatar-attribute]))
+                   ::smtp-tls
+                   ::smtp-username
+                   ::storage-backend
+                   ::storage-fs-directory
+                   ::srepl-host
+                   ::srepl-port
+                   ::local-assets-uri
+                   ::storage-s3-bucket
+                   ::storage-s3-region
+                   ::telemetry-enabled
+                   ::telemetry-with-taiga
+                   ::telemetry-server-enabled
+                   ::telemetry-server-port
+                   ::telemetry-uri
+                   ::initial-data-file
+                   ::initial-data-project-name]))
 
-(defn env->config
+(defn- env->config
   [env]
   (reduce-kv
    (fn [acc k v]
@@ -184,38 +227,23 @@
    {}
    env))
 
-(defn read-config
+(defn- read-config
   [env]
   (->> (env->config env)
        (merge defaults)
        (us/conform ::config)))
 
-(defn read-test-config
+(defn- read-test-config
   [env]
-  (assoc (read-config env)
-         :redis-uri "redis://redis/1"
-         :database-uri "postgresql://postgres/penpot_test"
-         :media-directory "/tmp/app/media"
-         :assets-directory "/tmp/app/static"
-         :migrations-verbose false))
+  (merge {:redis-uri "redis://redis/1"
+          :database-uri "postgresql://postgres/penpot_test"
+          :storage-fs-directory "/tmp/app/storage"
+          :migrations-verbose false}
+         (read-config env)))
 
-(defstate config
-  :start (read-config env))
-
-(def default-deletion-delay
-  (dt/duration {:hours 48}))
-
-(def version
-  (delay (v/parse "%version%")))
-
-(defn smtp
-  [cfg]
-  {:host (:smtp-host cfg "localhost")
-   :port (:smtp-port cfg 25)
-   :default-reply-to (:smtp-default-reply-to cfg)
-   :default-from (:smtp-default-from cfg)
-   :tls (:smtp-tls cfg)
-   :enabled (:smtp-enabled cfg)
-   :username (:smtp-username cfg)
-   :password (:smtp-password cfg)})
+(def version (v/parse "%version%"))
+(def config (read-config env))
+(def test-config (read-test-config env))
 
+(def deletion-delay
+  (dt/duration {:days 7}))

backend/src/app/db.clj

@@ -11,54 +11,91 @@
   (:require
    [app.common.exceptions :as ex]
    [app.common.geom.point :as gpt]
-   [app.config :as cfg]
-   [app.metrics :as mtx]
+   [app.common.spec :as us]
+   [app.db.sql :as sql]
+   [app.util.json :as json]
+   [app.util.migrations :as mg]
    [app.util.time :as dt]
    [app.util.transit :as t]
-   [clojure.data.json :as json]
+   [clojure.java.io :as io]
    [clojure.spec.alpha :as s]
-   [clojure.string :as str]
-   [mount.core :as mount :refer [defstate]]
+   [integrant.core :as ig]
    [next.jdbc :as jdbc]
-   [next.jdbc.date-time :as jdbc-dt]
-   [next.jdbc.optional :as jdbc-opt]
-   [next.jdbc.sql :as jdbc-sql]
-   [next.jdbc.sql.builder :as jdbc-bld])
+   [next.jdbc.date-time :as jdbc-dt])
   (:import
    com.zaxxer.hikari.HikariConfig
    com.zaxxer.hikari.HikariDataSource
    com.zaxxer.hikari.metrics.prometheus.PrometheusMetricsTrackerFactory
    java.sql.Connection
    java.sql.Savepoint
+   org.postgresql.PGConnection
    org.postgresql.geometric.PGpoint
+   org.postgresql.largeobject.LargeObject
+   org.postgresql.largeobject.LargeObjectManager
    org.postgresql.jdbc.PgArray
    org.postgresql.util.PGInterval
    org.postgresql.util.PGobject))
 
+(declare open)
+(declare create-pool)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Initialization
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(s/def ::uri ::us/not-empty-string)
+(s/def ::name ::us/not-empty-string)
+(s/def ::min-pool-size ::us/integer)
+(s/def ::max-pool-size ::us/integer)
+(s/def ::migrations map?)
+(s/def ::metrics map?)
+
+(defmethod ig/pre-init-spec ::pool [_]
+  (s/keys :req-un [::uri ::name ::min-pool-size ::max-pool-size ::migrations]))
+
+(defmethod ig/init-key ::pool
+  [_ {:keys [migrations] :as cfg}]
+  (let [pool (create-pool cfg)]
+    (when (seq migrations)
+      (with-open [conn (open pool)]
+        (mg/setup! conn)
+        (doseq [[mname steps] migrations]
+          (mg/migrate! conn {:name (name mname) :steps steps}))))
+    pool))
+
+(defmethod ig/halt-key! ::pool
+  [_ pool]
+  (.close ^HikariDataSource pool))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; API & Impl
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (def initsql
-  (str "SET statement_timeout = 10000;\n"
-       "SET idle_in_transaction_session_timeout = 30000;"))
+  (str "SET statement_timeout = 60000;\n"
+       "SET idle_in_transaction_session_timeout = 120000;"))
 
 (defn- create-datasource-config
-  [cfg]
-  (let [dburi    (:database-uri cfg)
-        username (:database-username cfg)
-        password (:database-password cfg)
-        config (HikariConfig.)
-        mfactory (PrometheusMetricsTrackerFactory. mtx/registry)]
+  [{:keys [metrics] :as cfg}]
+  (let [dburi    (:uri cfg)
+        username (:username cfg)
+        password (:password cfg)
+        config   (HikariConfig.)
+        mtf      (PrometheusMetricsTrackerFactory. (:registry metrics))]
     (doto config
       (.setJdbcUrl (str "jdbc:" dburi))
-      (.setPoolName "main")
+      (.setPoolName (:name cfg "default"))
       (.setAutoCommit true)
       (.setReadOnly false)
       (.setConnectionTimeout 8000)  ;; 8seg
-      (.setValidationTimeout 4000)  ;; 4seg
-      (.setIdleTimeout 300000)      ;; 5min
-      (.setMaxLifetime 900000)      ;; 15min
-      (.setMinimumIdle 0)
-      (.setMaximumPoolSize 15)
+      (.setValidationTimeout 8000)  ;; 8seg
+      (.setIdleTimeout 120000)      ;; 2min
+      (.setMaxLifetime 1800000)     ;; 30min
+      (.setMinimumIdle (:min-pool-size cfg 0))
+      (.setMaximumPoolSize (:max-pool-size cfg 30))
+      (.setMetricsTrackerFactory mtf)
       (.setConnectionInitSql initsql)
-      (.setMetricsTrackerFactory mfactory))
+      (.setInitializationFailTimeout -1))
     (when username (.setUsername config username))
     (when password (.setPassword config password))
     config))
@@ -71,7 +108,7 @@
 
 (defn pool-closed?
   [pool]
-  (.isClosed ^com.zaxxer.hikari.HikariDataSource pool))
+  (.isClosed ^HikariDataSource pool))
 
 (defn- create-pool
   [cfg]
@@ -79,66 +116,101 @@
     (jdbc-dt/read-as-instant)
     (HikariDataSource. dsc)))
 
-(declare pool)
+(defn unwrap
+  [conn klass]
+  (.unwrap ^Connection conn klass))
 
-(defstate pool
-  :start (create-pool cfg/config)
-  :stop (.close pool))
+(defn lobj-manager
+  [conn]
+  (let [conn (unwrap conn org.postgresql.PGConnection)]
+    (.getLargeObjectAPI ^PGConnection conn)))
+
+(defn lobj-create
+  [manager]
+  (.createLO ^LargeObjectManager manager LargeObjectManager/READWRITE))
+
+(defn lobj-open
+  ([manager oid]
+   (lobj-open manager oid {}))
+  ([manager oid {:keys [mode] :or {mode :rw}}]
+   (let [mode (case mode
+                (:r :read) LargeObjectManager/READ
+                (:w :write) LargeObjectManager/WRITE
+                (:rw :read+write) LargeObjectManager/READWRITE)]
+     (.open ^LargeObjectManager manager (long oid) mode))))
+
+(defn lobj-unlink
+  [manager oid]
+  (.unlink ^LargeObjectManager manager (long oid)))
+
+(extend-type LargeObject
+  io/IOFactory
+  (make-reader [lobj opts]
+    (let [^InputStream is (.getInputStream ^LargeObject lobj)]
+      (io/make-reader is opts)))
+  (make-writer [lobj opts]
+    (let [^OutputStream os (.getOutputStream ^LargeObject lobj)]
+      (io/make-writer os opts)))
+  (make-input-stream [lobj opts]
+    (let [^InputStream is (.getInputStream ^LargeObject lobj)]
+      (io/make-input-stream is opts)))
+  (make-output-stream [lobj opts]
+    (let [^OutputStream os (.getOutputStream ^LargeObject lobj)]
+      (io/make-output-stream os opts))))
 
 (defmacro with-atomic
   [& args]
   `(jdbc/with-transaction ~@args))
 
-(defn- kebab-case [s] (str/replace s #"_" "-"))
-(defn- snake-case [s] (str/replace s #"-" "_"))
-(defn- as-kebab-maps
-  [rs opts]
-  (jdbc-opt/as-unqualified-modified-maps rs (assoc opts :label-fn kebab-case)))
-
 (defn open
-  []
+  [pool]
   (jdbc/get-connection pool))
 
 (defn exec!
   ([ds sv]
    (exec! ds sv {}))
   ([ds sv opts]
-   (jdbc/execute! ds sv (assoc opts :builder-fn as-kebab-maps))))
+   (jdbc/execute! ds sv (assoc opts :builder-fn sql/as-kebab-maps))))
 
 (defn exec-one!
   ([ds sv] (exec-one! ds sv {}))
   ([ds sv opts]
-   (jdbc/execute-one! ds sv (assoc opts :builder-fn as-kebab-maps))))
-
-(def ^:private default-options
-  {:table-fn snake-case
-   :column-fn snake-case
-   :builder-fn as-kebab-maps})
+   (jdbc/execute-one! ds sv (assoc opts :builder-fn sql/as-kebab-maps))))
 
 (defn insert!
-  [ds table params]
-  (jdbc-sql/insert! ds table params default-options))
+  ([ds table params] (insert! ds table params nil))
+  ([ds table params opts]
+   (exec-one! ds
+              (sql/insert table params opts)
+              (assoc opts :return-keys true))))
+
+(defn insert-multi!
+  [ds table param-list]
+  (doseq [params param-list]
+    (insert! ds table params)))
 
 (defn update!
-  [ds table params where]
-  (let [opts (assoc default-options :return-keys true)]
-    (jdbc-sql/update! ds table params where opts)))
+  ([ds table params where] (update! ds table params where nil))
+  ([ds table params where opts]
+   (exec-one! ds
+              (sql/update table params where opts)
+              (assoc opts :return-keys true))))
 
 (defn delete!
-  [ds table params]
-  (let [opts (assoc default-options :return-keys true)]
-    (jdbc-sql/delete! ds table params opts)))
+  ([ds table params] (delete! ds table params nil))
+  ([ds table params opts]
+   (exec-one! ds
+              (sql/delete table params opts)
+              (assoc opts :return-keys true))))
 
 (defn get-by-params
   ([ds table params]
    (get-by-params ds table params nil))
   ([ds table params opts]
-   (let [opts (cond-> (merge default-options opts)
-                (:for-update opts)
-                (assoc :suffix "for update"))
-         res  (exec-one! ds (jdbc-bld/for-query table params opts) opts)]
+   (let [res (exec-one! ds (sql/select table params opts))]
      (when (or (:deleted-at res) (not res))
-       (ex/raise :type :not-found))
+       (ex/raise :type :not-found
+                 :hint "database object not found"))
      res)))
 
 (defn get-by-id
@@ -151,10 +223,7 @@
   ([ds table params]
    (query ds table params nil))
   ([ds table params opts]
-   (let [opts (cond-> (merge default-options opts)
-                (:for-update opts)
-                (assoc :suffix "for update"))]
-     (exec! ds (jdbc-bld/for-query table params opts) opts))))
+   (exec! ds (sql/select table params opts))))
 
 (defn pgobject?
   [v]
@@ -180,6 +249,11 @@
   [p]
   (PGpoint. (:x p) (:y p)))
 
+(defn create-array
+  [conn type aobjects]
+  (let [^PGConnection conn (unwrap conn org.postgresql.PGConnection)]
+    (.createArrayOf conn ^String type aobjects)))
+
 (defn decode-pgpoint
   [^PGpoint v]
   (gpt/point (.-x v) (.-y v)))
@@ -225,7 +299,7 @@
         val (.getValue o)]
     (if (or (= typ "json")
             (= typ "jsonb"))
-      (json/read-str val :key-fn keyword)
+      (json/decode-str val)
       val)))
 
 (defn decode-transit-pgobject
@@ -249,7 +323,7 @@
   [data]
   (doto (org.postgresql.util.PGobject.)
     (.setType "jsonb")
-    (.setValue (json/write-str data))))
+    (.setValue (json/encode-str data))))
 
 (defn pgarray->set
   [v]
@@ -258,11 +332,3 @@
 (defn pgarray->vector
   [v]
   (vec (.getArray ^PgArray v)))
-
-;; Instrumentation
-
-(mtx/instrument-with-counter!
- {:var [#'jdbc/execute-one!
-        #'jdbc/execute!]
-  :id "database__query_counter"
-  :help "An absolute counter of database queries."})

backend/src/app/db/profile_initial_data.clj

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

backend/src/app/db/sql.clj

@@ -0,0 +1,61 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; This Source Code Form is "Incompatible With Secondary Licenses", as
+;; defined by the Mozilla Public License, v. 2.0.
+;;
+;; Copyright (c) 2020 UXBOX Labs SL
+
+(ns app.db.sql
+  (:refer-clojure :exclude [update])
+  (:require
+   [clojure.string :as str]
+   [next.jdbc.optional :as jdbc-opt]
+   [next.jdbc.sql.builder :as sql]))
+
+(defn kebab-case [s] (str/replace s #"_" "-"))
+(defn snake-case [s] (str/replace s #"-" "_"))
+
+(def default-opts
+  {:table-fn snake-case
+   :column-fn snake-case})
+
+(defn as-kebab-maps
+  [rs opts]
+  (jdbc-opt/as-unqualified-modified-maps rs (assoc opts :label-fn kebab-case)))
+
+(defn insert
+  ([table key-map]
+   (insert table key-map nil))
+  ([table key-map opts]
+   (let [opts (merge default-opts opts)
+         opts (cond-> opts
+                (:on-conflict-do-nothing opts)
+                (assoc :suffix "ON CONFLICT DO NOTHING"))]
+     (sql/for-insert table key-map opts))))
+
+(defn select
+  ([table where-params]
+   (select table where-params nil))
+  ([table where-params opts]
+   (let [opts (merge default-opts opts)
+         opts (cond-> opts
+                (:for-update opts)
+                (assoc :suffix "FOR UPDATE"))]
+     (sql/for-query table where-params opts))))
+
+(defn update
+  ([table key-map where-params]
+   (update table key-map where-params nil))
+  ([table key-map where-params opts]
+   (let [opts (merge default-opts opts)]
+     (sql/for-update table key-map where-params opts))))
+
+(defn delete
+  ([table where-params]
+   (delete table where-params nil))
+  ([table where-params opts]
+   (let [opts (merge default-opts opts)]
+     (sql/for-delete table where-params opts))))
+

backend/src/app/emails.clj

@@ -43,6 +43,16 @@
 
 ;; --- Emails
 
+(s/def ::subject ::us/string)
+(s/def ::content ::us/string)
+
+(s/def ::feedback
+  (s/keys :req-un [::subject ::content]))
+
+(def feedback
+  "A profile feedback email."
+  (emails/template-factory ::feedback default-context))
+
 (s/def ::name ::us/string)
 (s/def ::register
   (s/keys :req-un [::name]))

backend/src/app/error_reporter.clj

@@ -12,72 +12,149 @@
   (:require
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
+   [app.common.uuid :as uuid]
    [app.config :as cfg]
    [app.db :as db]
-   [app.tasks :as tasks]
-   [app.util.async :as aa]
-   [app.worker :as wrk]
    [app.util.http :as http]
+   [app.util.json :as json]
+   [app.util.template :as tmpl]
+   [app.worker :as wrk]
    [clojure.core.async :as a]
-   [clojure.data.json :as json]
+   [clojure.java.io :as io]
    [clojure.spec.alpha :as s]
    [clojure.tools.logging :as log]
    [cuerdas.core :as str]
-   [mount.core :as mount :refer [defstate]]
-   [promesa.exec :as px]))
+   [integrant.core :as ig]
+   [promesa.exec :as px])
+  (:import
+   org.apache.logging.log4j.core.LogEvent
+   org.apache.logging.log4j.util.ReadOnlyStringMap))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Public API
+;; Error Listener
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defonce enqueue identity)
+(declare handle-event)
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Implementation
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defonce enabled-mattermost (atom true))
+(defonce queue (a/chan (a/sliding-buffer 64)))
+(defonce queue-fn (fn [event] (a/>!! queue event)))
 
-(defn- send-to-mattermost!
-  [log-event]
+(s/def ::uri ::us/string)
+
+(defmethod ig/pre-init-spec ::reporter [_]
+  (s/keys :req-un [::wrk/executor ::db/pool]
+          :opt-un [::uri]))
+
+(defmethod ig/init-key ::reporter
+  [_ {:keys [executor] :as cfg}]
+  (log/info "Intializing error reporter.")
+  (let [close-ch (a/chan 1)]
+    (a/go-loop []
+      (let [[val port] (a/alts! [close-ch queue])]
+        (cond
+          (= port close-ch)
+          (log/info "Stoping error reporting loop.")
+
+          (nil? val)
+          (log/info "Stoping error reporting loop.")
+
+          :else
+          (do
+            (px/run! executor #(handle-event cfg val))
+            (recur)))))
+    close-ch))
+
+(defmethod ig/halt-key! ::reporter
+  [_ close-ch]
+  (a/close! close-ch))
+
+(defn- get-context-data
+  [event]
+  (let [^LogEvent levent (deref event)
+        ^ReadOnlyStringMap rosm (.getContextData levent)]
+    (into {:message (str event)
+           :id      (uuid/next)} ; set default uuid for cases when it not comes.
+          (comp
+           (map (fn [[key val]]
+                  (cond
+                    (= "id" key)         [:id (uuid/uuid val)]
+                    (= "profile-id" key) [:profile-id (uuid/uuid val)]
+                    (str/blank? val)     nil
+                    (string? key)        [(keyword key) val]
+                    :else                [key val])))
+           (filter some?))
+
+          (.toMap rosm))))
+
+(defn- send-mattermost-notification!
+  [cfg {:keys [message host version id] :as cdata}]
   (try
-    (let [text  (str/fmt "Unhandled exception: `host='%s'`, `version=%s`.\n@channel ⇊\n```%s\n```"
-                         (:host cfg/config)
-                         (:full @cfg/version)
-                         (str log-event))
-          rsp   (http/send! {:uri (:error-reporter-webhook cfg/config)
-                             :method :post
-                             :headers {"content-type" "application/json"}
-                             :body (json/write-str {:text text})})]
+    (let [uri    (:uri cfg)
+          prefix (str "Unhandled exception (@channel):\n"
+                      "- detail: " (:public-uri cfg/config) "/dbg/error-by-id/" id "\n"
+                      "- host: `" host "`\n"
+                      "- version: `" version "`\n")
+          text   (str prefix "```\n" message "\n```")
+          rsp    (http/send! {:uri uri
+                              :method :post
+                              :headers {"content-type" "application/json"}
+                              :body (json/encode-str {:text text})})]
       (when (not= (:status rsp) 200)
         (log/warnf "Error reporting webhook replying with unexpected status: %s\n%s"
                    (:status rsp)
                    (pr-str rsp))))
+
     (catch Exception e
       (log/warnf e "Unexpected exception on error reporter."))))
 
-(defn- send!
-  [val]
-  (aa/thread-call wrk/executor (partial send-to-mattermost! val)))
+(defn- persist-on-database!
+  [{:keys [pool] :as cfg} {:keys [id] :as cdata}]
+  (db/with-atomic [conn pool]
+    (db/insert! conn :server-error-report
+                {:id id :content (db/tjson cdata)})))
 
-(defn- start
-  []
-  (let [qch (a/chan (a/sliding-buffer 128))]
-    (log/info "Starting error reporter loop.")
+(defn handle-event
+  [cfg event]
+  (try
+    (let [cdata (get-context-data event)]
+      (when (and (:uri cfg) @enabled-mattermost)
+        (send-mattermost-notification! cfg cdata))
+      (persist-on-database! cfg cdata))
+    (catch Exception e
+      (log/warnf e "Unexpected exception on error reporter."))))
 
-    ;; Only enable when a valid URL is provided.
-    (when (:error-reporter-webhook cfg/config)
-      (alter-var-root #'enqueue (constantly #(a/>!! qch %)))
-      (a/go-loop []
-        (let [val (a/<! qch)]
-          (if (nil? val)
-            (do
-              (log/info "Closing error reporting loop.")
-              (alter-var-root #'enqueue (constantly identity)))
-            (do
-              (a/<! (send! val))
-              (recur))))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Http Handler
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-    qch))
+(defmethod ig/pre-init-spec ::handler [_]
+  (s/keys :req-un [::db/pool]))
 
-(defstate reporter
-  :start (start)
-  :stop  (a/close! reporter))
+(defmethod ig/init-key ::handler
+  [_ {:keys [pool] :as cfg}]
+  (letfn [(parse-id [request]
+            (let [id (get-in request [:path-params :id])
+                  id (us/uuid-conformer id)]
+              (when (uuid? id)
+                id)))
+          (retrieve-report [id]
+            (ex/ignoring
+             (when-let [{:keys [content] :as row} (db/get-by-id pool :server-error-report id)]
+               (assoc row :content (db/decode-transit-pgobject content)))))
+
+          (render-template [{:keys [content] :as report}]
+            (some-> (io/resource "error-report.tmpl")
+                    (tmpl/render content)))]
+
+
+    (fn [request]
+      (let [result (some-> (parse-id request)
+                           (retrieve-report)
+                           (render-template))]
+        (if result
+          {:status 200
+           :headers {"content-type" "text/html; charset=utf-8"}
+           :body result}
+          {:status 404
+           :body "not found"})))))

backend/src/app/http.clj

@@ -5,76 +5,153 @@
 ;; This Source Code Form is "Incompatible With Secondary Licenses", as
 ;; defined by the Mozilla Public License, v. 2.0.
 ;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) 2020-2021 UXBOX Labs SL
 
 (ns app.http
   (:require
+   [app.common.data :as d]
+   [app.common.spec :as us]
    [app.config :as cfg]
    [app.http.auth :as auth]
-   [app.http.auth.gitlab :as gitlab]
-   [app.http.auth.google :as google]
-   [app.http.auth.ldap :as ldap]
    [app.http.errors :as errors]
-   [app.http.handlers :as handlers]
    [app.http.middleware :as middleware]
-   [app.http.session :as session]
-   [app.http.ws :as ws]
    [app.metrics :as mtx]
+   [app.util.log4j :refer [update-thread-context!]]
+   [clojure.spec.alpha :as s]
    [clojure.tools.logging :as log]
-   [mount.core :as mount :refer [defstate]]
-   [reitit.ring :as rring]
-   [ring.adapter.jetty9 :as jetty]))
+   [integrant.core :as ig]
+   [reitit.ring :as rr]
+   [ring.adapter.jetty9 :as jetty])
+  (:import
+   org.eclipse.jetty.server.Server
+   org.eclipse.jetty.server.handler.ErrorHandler
+   org.eclipse.jetty.server.handler.StatisticsHandler))
+
+(s/def ::handler fn?)
+(s/def ::ws (s/map-of ::us/string fn?))
+(s/def ::port ::cfg/http-server-port)
+(s/def ::name ::us/string)
+
+(defmethod ig/pre-init-spec ::server [_]
+  (s/keys :req-un [::handler ::port]
+          :opt-un [::ws ::name ::mtx/metrics]))
+
+(defmethod ig/prep-key ::server
+  [_ cfg]
+  (merge {:name "http"}
+         (d/without-nils cfg)))
+
+(defmethod ig/init-key ::server
+  [_ {:keys [handler ws port name metrics] :as opts}]
+  (log/infof "Starting %s server on port %s." name port)
+  (let [pre-start (fn [^Server server]
+                    (let [handler (doto (ErrorHandler.)
+                                    (.setShowStacks true)
+                                    (.setServer server))]
+                      (.setErrorHandler server ^ErrorHandler handler)
+                      (when metrics
+                        (let [stats (new StatisticsHandler)]
+                          (.setHandler ^StatisticsHandler stats (.getHandler server))
+                          (.setHandler server stats)
+                          (mtx/instrument-jetty! (:registry metrics) stats)))))
+
+        options   (merge
+                   {:port port
+                    :h2c? true
+                    :join? false
+                    :allow-null-path-info true
+                    :configurator pre-start}
+                   (when (seq ws)
+                     {:websockets ws}))
+
+        server    (jetty/run-jetty handler options)]
+    (assoc opts :server server)))
+
+(defmethod ig/halt-key! ::server
+  [_ {:keys [server name port] :as opts}]
+  (log/infof "Stoping %s server on port %s." name port)
+  (jetty/stop-server server))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Http Main Handler (Router)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare create-router)
+
+(s/def ::rpc map?)
+(s/def ::session map?)
+(s/def ::metrics map?)
+(s/def ::google-auth map?)
+(s/def ::gitlab-auth map?)
+(s/def ::ldap-auth fn?)
+(s/def ::storage map?)
+(s/def ::assets map?)
+
+(defmethod ig/pre-init-spec ::router [_]
+  (s/keys :req-un [::rpc ::session ::metrics ::google-auth ::gitlab-auth ::storage ::assets]))
+
+(defmethod ig/init-key ::router
+  [_ cfg]
+  (let [handler (rr/ring-handler
+                 (create-router cfg)
+                 (rr/routes
+                  (rr/create-resource-handler {:path "/"})
+                  (rr/create-default-handler))
+                 {:middleware [middleware/server-timing]})]
+    (fn [request]
+      (try
+        (handler request)
+        (catch Throwable e
+          (try
+            (let [cdata (errors/get-error-context request e)]
+              (update-thread-context! cdata)
+              (log/errorf e "Unhandled exception: %s (id: %s)" (ex-message e) (str (:id cdata)))
+              {:status 500
+               :body "internal server error"})
+            (catch Throwable e
+              (log/errorf e "Unhandled exception: %s" (ex-message e))
+              {:status 500
+               :body "internal server error"})))))))
 
 (defn- create-router
-  []
-  (rring/router
-   [["/metrics" {:get mtx/dump}]
+  [{:keys [session rpc google-auth gitlab-auth github-auth metrics ldap-auth svgparse assets] :as cfg}]
+  (rr/router
+   [["/metrics" {:get (:handler metrics)}]
+
+    ["/assets" {:middleware [[middleware/format-response-body]
+                             [middleware/errors errors/handle]]}
+     ["/by-id/:id" {:get (:objects-handler assets)}]
+     ["/by-file-media-id/:id" {:get (:file-objects-handler assets)}]
+     ["/by-file-media-id/:id/thumbnail" {:get (:file-thumbnails-handler assets)}]]
+
+    ["/dbg"
+     ["/error-by-id/:id" {:get (:error-report-handler cfg)}]]
+
     ["/api" {:middleware [[middleware/format-response-body]
-                          [middleware/parse-request-body]
-                          [middleware/errors errors/handle]
                           [middleware/params]
                           [middleware/multipart-params]
                           [middleware/keyword-params]
+                          [middleware/parse-request-body]
+                          [middleware/errors errors/handle]
                           [middleware/cookies]]}
 
+     ["/svg" {:post svgparse}]
+
      ["/oauth"
-      ["/google" {:post google/auth}]
-      ["/google/callback" {:get google/callback}]
-      ["/gitlab" {:post gitlab/auth}]
-      ["/gitlab/callback" {:get gitlab/callback}]]
+      ["/google" {:post (:auth-handler google-auth)}]
+      ["/google/callback" {:get (:callback-handler google-auth)}]
 
-     ["/echo" {:get handlers/echo-handler
-               :post handlers/echo-handler}]
+      ["/gitlab" {:post (:auth-handler gitlab-auth)}]
+      ["/gitlab/callback" {:get (:callback-handler gitlab-auth)}]
 
-     ["/login" {:handler auth/login-handler
-                :method :post}]
-     ["/logout" {:handler auth/logout-handler
-                 :method :post}]
-     ["/login-ldap" {:handler ldap/auth
-                     :method :post}]
+      ["/github" {:post (:auth-handler github-auth)}]
+      ["/github/callback" {:get (:callback-handler github-auth)}]]
 
-     ["/w" {:middleware [session/middleware]}
-      ["/query/:type" {:get handlers/query-handler}]
-      ["/mutation/:type" {:post handlers/mutation-handler}]]]]))
+     ["/login" {:post #(auth/login-handler cfg %)}]
+     ["/logout" {:post #(auth/logout-handler cfg %)}]
 
-(defn start-server
-  []
-  (let [wsockets {"/ws/notifications" ws/handler}
-        options  {:port (:http-server-port cfg/config)
-                  :h2c? true
-                  :join? false
-                  :allow-null-path-info true
-                  :websockets wsockets}
-        handler  (rring/ring-handler
-                  (create-router)
-                  (constantly {:status 404, :body ""})
-                  {:middleware [[middleware/development-resources]
-                                [middleware/development-cors]
-                                [middleware/metrics]]})]
-    (log/infof "Http server listening on http://localhost:%s/"
-               (:http-server-port cfg/config))
-    (jetty/run-jetty handler options)))
+     ["/login-ldap" {:post ldap-auth}]
 
-(defstate server
-  :start (start-server)
-  :stop (.stop server))
+     ["/rpc" {:middleware [(:middleware session)]}
+      ["/query/:type" {:get (:query-handler rpc)}]
+      ["/mutation/:type" {:post (:mutation-handler rpc)}]]]]))

backend/src/app/http/assets.clj

@@ -0,0 +1,113 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; This Source Code Form is "Incompatible With Secondary Licenses", as
+;; defined by the Mozilla Public License, v. 2.0.
+;;
+;; Copyright (c) 2020-2021 UXBOX Labs SL
+
+(ns app.http.assets
+  "Assets related handlers."
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.db :as db]
+   [app.metrics :as mtx]
+   [app.storage :as sto]
+   [app.util.time :as dt]
+   [clojure.spec.alpha :as s]
+   [integrant.core :as ig]
+   [lambdaisland.uri :as u]))
+
+(def ^:private cache-max-age
+  (dt/duration {:hours 24}))
+
+(def ^:private signature-max-age
+  (dt/duration {:hours 24 :minutes 15}))
+
+(defn coerce-id
+  [id]
+  (let [res (us/uuid-conformer id)]
+    (when-not (uuid? res)
+      (ex/raise :type :not-found
+                :hint "object not found"))
+    res))
+
+(defn- get-file-media-object
+  [{:keys [pool] :as storage} id]
+  (let [id   (coerce-id id)
+        mobj (db/exec-one! pool ["select * from file_media_object where id=?" id])]
+    (when-not mobj
+      (ex/raise :type :not-found
+                :hint "object does not found"))
+      mobj))
+
+(defn- serve-object
+  [{:keys [storage] :as cfg} obj]
+  (let [mdata   (meta obj)
+        backend (sto/resolve-backend storage (:backend obj))]
+    (case (:type backend)
+      :db
+      {: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)}
+
+      :s3
+      (let [url (sto/get-object-url storage obj {:max-age signature-max-age})]
+        {:status 307
+         :headers {"location" (str url)
+                   "x-host"   (:host url)
+                   "cache-control" (str "max-age=" (inst-ms cache-max-age))}
+         :body ""})
+
+      :fs
+      (let [purl (u/uri (:assets-path cfg))
+            purl (u/join purl (sto/object->relative-path obj))]
+        {:status 204
+         :headers {"x-accel-redirect" (:path purl)
+                   "content-type" (:content-type mdata)
+                   "cache-control" (str "max-age=" (inst-ms cache-max-age))}
+         :body ""}))))
+
+(defn- generic-handler
+  [{:keys [storage] :as cfg} _request id]
+  (let [obj (sto/get-object storage id)]
+    (if obj
+      (serve-object cfg obj)
+      {:status 404 :body ""})))
+
+(defn objects-handler
+  [cfg request]
+  (let [id (get-in request [:path-params :id])]
+    (generic-handler cfg request (coerce-id id))))
+
+(defn file-objects-handler
+  [{:keys [storage] :as cfg} request]
+  (let [id   (get-in request [:path-params :id])
+        mobj (get-file-media-object storage id)]
+    (generic-handler cfg request (:media-id mobj))))
+
+(defn file-thumbnails-handler
+  [{:keys [storage] :as cfg} request]
+  (let [id   (get-in request [:path-params :id])
+        mobj (get-file-media-object storage id)]
+    (generic-handler cfg request (or (:thumbnail-id mobj) (:media-id mobj)))))
+
+
+;; --- Initialization
+
+(s/def ::storage some?)
+(s/def ::assets-path ::us/string)
+(s/def ::cache-max-age ::dt/duration)
+(s/def ::signature-max-age ::dt/duration)
+
+(defmethod ig/pre-init-spec ::handlers [_]
+  (s/keys :req-un [::storage ::mtx/metrics ::assets-path ::cache-max-age ::signature-max-age]))
+
+(defmethod ig/init-key ::handlers
+  [_ cfg]
+  {:objects-handler #(objects-handler cfg %)
+   :file-objects-handler #(file-objects-handler cfg %)
+   :file-thumbnails-handler #(file-thumbnails-handler cfg %)})

backend/src/app/http/auth.clj

@@ -9,23 +9,23 @@
 
 (ns app.http.auth
   (:require
-   [app.http.session :as session]
-   [app.services.mutations :as sm]))
+   [app.http.session :as session]))
 
 (defn login-handler
-  [req]
-  (let [data    (:body-params req)
-        uagent  (get-in req [:headers "user-agent"])
-        profile (sm/handle (assoc data ::sm/type :login))
-        id      (session/create (:id profile) uagent)]
+  [{:keys [session rpc] :as cfg} request]
+  (let [data    (:params request)
+        uagent  (get-in request [:headers "user-agent"])
+        method  (get-in rpc [:methods :mutation :login])
+        profile (method data)
+        id      (session/create! session {:profile-id (:id profile)
+                                          :user-agent uagent})]
     {:status 200
-     :cookies (session/cookies id)
+     :cookies (session/cookies session {:value id})
      :body profile}))
 
 (defn logout-handler
-  [req]
-  (some-> (session/extract-auth-token req)
-          (session/delete))
-  {:status 200
-   :cookies (session/cookies "" {:max-age -1})
+  [{:keys [session] :as cfg} request]
+  (session/delete! cfg request)
+  {:status 204
+   :cookies (session/cookies session {:value "" :max-age -1})
    :body ""})

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

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

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

@@ -9,55 +9,53 @@
 
 (ns app.http.auth.gitlab
   (:require
+   [app.common.data :as d]
    [app.common.exceptions :as ex]
-   [app.config :as cfg]
+   [app.common.spec :as us]
    [app.http.session :as session]
-   [app.services.mutations :as sm]
-   [app.services.tokens :as tokens]
    [app.util.http :as http]
    [app.util.time :as dt]
    [clojure.data.json :as json]
+   [clojure.spec.alpha :as s]
    [clojure.tools.logging :as log]
+   [integrant.core :as ig]
    [lambdaisland.uri :as uri]))
 
-(def default-base-gitlab-uri "https://gitlab.com")
-
 (def scope "read_user")
 
 (defn- build-redirect-url
-  []
-  (let [public (uri/uri (:public-uri cfg/config))]
+  [cfg]
+  (let [public (uri/uri (:public-uri cfg))]
     (str (assoc public :path "/api/oauth/gitlab/callback"))))
 
 
 (defn- build-oauth-uri
-  []
-  (let [base-uri (uri/uri (:gitlab-base-uri cfg/config default-base-gitlab-uri))]
+  [cfg]
+  (let [base-uri (uri/uri (:base-uri cfg))]
     (assoc base-uri :path "/oauth/authorize")))
 
 
 (defn- build-token-url
-  []
-  (let [base-uri (uri/uri (:gitlab-base-uri cfg/config default-base-gitlab-uri))]
+  [cfg]
+  (let [base-uri (uri/uri (:base-uri cfg))]
     (str (assoc base-uri :path "/oauth/token"))))
 
 
 (defn- build-user-info-url
-  []
-  (let [base-uri (uri/uri (:gitlab-base-uri cfg/config default-base-gitlab-uri))]
+  [cfg]
+  (let [base-uri (uri/uri (:base-uri cfg))]
     (str (assoc base-uri :path "/api/v4/user"))))
 
-
 (defn- get-access-token
-  [code]
-  (let [params {:client_id (:gitlab-client-id cfg/config)
-                :client_secret (:gitlab-client-secret cfg/config)
+  [cfg code]
+  (let [params {:client_id (:client-id cfg)
+                :client_secret (:client-secret cfg)
                 :code code
                 :grant_type "authorization_code"
-                :redirect_uri (build-redirect-url)}
+                :redirect_uri (build-redirect-url cfg)}
         req    {:method :post
                 :headers {"content-type" "application/x-www-form-urlencoded"}
-                :uri (build-token-url)
+                :uri (build-token-url cfg)
                 :body (uri/map->query-string params)}
         res    (http/send! req)]
 
@@ -76,8 +74,8 @@
 
 
 (defn- get-user-info
-  [token]
-  (let [req {:uri (build-user-info-url)
+  [cfg token]
+  (let [req {:uri (build-user-info-url cfg)
              :headers {"Authorization" (str "Bearer " token)}
              :method :get}
         res (http/send! req)]
@@ -98,50 +96,84 @@
         nil))))
 
 (defn auth
-  [_req]
-  (let [token  (tokens/generate
-                {:iss :gitlab-oauth
-                 :exp (dt/in-future "15m")})
+  [{:keys [tokens] :as cfg} _request]
+  (let [token  (tokens :generate {:iss :gitlab-oauth
+                                  :exp (dt/in-future "15m")})
 
-        params {:client_id (:gitlab-client-id cfg/config)
-                :redirect_uri (build-redirect-url)
+        params {:client_id (:client-id cfg)
+                :redirect_uri (build-redirect-url cfg)
                 :response_type "code"
                 :state token
                 :scope scope}
         query  (uri/map->query-string params)
-        uri    (-> (build-oauth-uri)
+        uri    (-> (build-oauth-uri cfg)
                    (assoc :query query))]
     {:status 200
      :body {:redirect-uri (str uri)}}))
 
 (defn callback
-  [req]
-  (let [token (get-in req [:params :state])
-        _     (tokens/verify token {:iss :gitlab-oauth})
-        info  (some-> (get-in req [:params :code])
-                      (get-access-token)
-                      (get-user-info))]
+  [{:keys [tokens rpc session] :as cfg} request]
+  (let [token (get-in request [:params :state])
+        _     (tokens :verify {:token token :iss :gitlab-oauth})
+        info  (some->> (get-in request [:params :code])
+                       (get-access-token cfg)
+                       (get-user-info cfg))]
 
     (when-not info
       (ex/raise :type :authentication
                 :code :unable-to-authenticate-with-gitlab))
 
-    (let [profile (sm/handle {::sm/type :login-or-register
-                              :email (:email info)
-                              :fullname (:fullname info)})
-          uagent  (get-in req [:headers "user-agent"])
+    (let [method-fn (get-in rpc [:methods :mutation :login-or-register])
+          profile   (method-fn {:email (:email info)
+                                :fullname (:fullname info)})
+          uagent    (get-in request [:headers "user-agent"])
 
-          token   (tokens/generate
-                   {:iss :auth
-                    :exp (dt/in-future "15m")
-                    :profile-id (:id profile)})
+          token     (tokens :generate {:iss :auth
+                                       :exp (dt/in-future "15m")
+                                       :profile-id (:id profile)})
 
-          uri     (-> (uri/uri (:public-uri cfg/config))
-                      (assoc :path "/#/auth/verify-token")
-                      (assoc :query (uri/map->query-string {:token token})))
-          sid     (session/create (:id profile) uagent)]
+          uri       (-> (uri/uri (:public-uri cfg))
+                        (assoc :path "/#/auth/verify-token")
+                        (assoc :query (uri/map->query-string {:token token})))
 
+          sid       (session/create! session {:profile-id (:id profile)
+                                              :user-agent uagent})]
       {:status 302
        :headers {"location" (str uri)}
-       :cookies (session/cookies sid)
+       :cookies (session/cookies session {:value sid})
        :body ""})))
+
+
+(s/def ::client-id ::us/not-empty-string)
+(s/def ::client-secret ::us/not-empty-string)
+(s/def ::base-uri ::us/not-empty-string)
+(s/def ::public-uri ::us/not-empty-string)
+(s/def ::session map?)
+(s/def ::tokens fn?)
+
+(defmethod ig/pre-init-spec :app.http.auth/gitlab [_]
+  (s/keys :req-un [::public-uri
+                   ::session
+                   ::tokens]
+          :opt-un [::base-uri
+                   ::client-id
+                   ::client-secret]))
+
+
+(defmethod ig/prep-key :app.http.auth/gitlab
+  [_ cfg]
+  (d/merge {:base-uri "https://gitlab.com"}
+           (d/without-nils cfg)))
+
+(defn- default-handler
+  [_]
+  (ex/raise :type :not-found))
+
+(defmethod ig/init-key :app.http.auth/gitlab
+  [_ cfg]
+  (if (and (:client-id cfg)
+           (:client-secret cfg))
+    {:auth-handler #(auth cfg %)
+     :callback-handler #(callback cfg %)}
+    {:auth-handler default-handler
+     :callback-handler default-handler}))

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

@@ -10,14 +10,14 @@
 (ns app.http.auth.google
   (:require
    [app.common.exceptions :as ex]
-   [app.config :as cfg]
+   [app.common.spec :as us]
    [app.http.session :as session]
-   [app.services.mutations :as sm]
-   [app.services.tokens :as tokens]
    [app.util.http :as http]
    [app.util.time :as dt]
    [clojure.data.json :as json]
+   [clojure.spec.alpha :as s]
    [clojure.tools.logging :as log]
+   [integrant.core :as ig]
    [lambdaisland.uri :as uri]))
 
 (def base-goauth-uri "https://accounts.google.com/o/oauth2/v2/auth")
@@ -29,103 +29,121 @@
        "openid"))
 
 (defn- build-redirect-url
-  []
-  (let [public (uri/uri (:public-uri cfg/config))]
+  [cfg]
+  (let [public (uri/uri (:public-uri cfg))]
     (str (assoc public :path "/api/oauth/google/callback"))))
 
 (defn- get-access-token
-  [code]
-  (let [params {:code code
-                :client_id (:google-client-id cfg/config)
-                :client_secret (:google-client-secret cfg/config)
-                :redirect_uri (build-redirect-url)
-                :grant_type "authorization_code"}
-        req    {:method :post
-                :headers {"content-type" "application/x-www-form-urlencoded"}
-                :uri "https://oauth2.googleapis.com/token"
-                :body (uri/map->query-string params)}
-        res    (http/send! req)]
+  [cfg code]
+  (try
+    (let [params {:code code
+                  :client_id (:client-id cfg)
+                  :client_secret (:client-secret cfg)
+                  :redirect_uri (build-redirect-url cfg)
+                  :grant_type "authorization_code"}
+          req    {:method :post
+                  :headers {"content-type" "application/x-www-form-urlencoded"}
+                  :uri "https://oauth2.googleapis.com/token"
+                  :body (uri/map->query-string params)}
+          res    (http/send! req)]
 
-    (when (not= 200 (:status res))
-      (ex/raise :type :internal
-                :code :invalid-response-from-google
-                :context {:status (:status res)
-                          :body (:body res)}))
-
-    (try
-      (let [data (json/read-str (:body res))]
-        (get data "access_token"))
-      (catch Throwable e
-        (log/error "unexpected error on parsing response body from google access token request" e)
-        nil))))
+      (when (= 200 (:status res))
+        (-> (json/read-str (:body res))
+            (get "access_token"))))
 
+    (catch Exception e
+      (log/error e "unexpected error on get-access-token")
+      nil)))
 
 (defn- get-user-info
   [token]
-  (let [req {:uri "https://openidconnect.googleapis.com/v1/userinfo"
-             :headers {"Authorization" (str "Bearer " token)}
-             :method :get}
-        res (http/send! req)]
+  (try
+    (let [req {:uri "https://openidconnect.googleapis.com/v1/userinfo"
+               :headers {"Authorization" (str "Bearer " token)}
+               :method :get}
+          res (http/send! req)]
+      (when (= 200 (:status res))
+        (let [data (json/read-str (:body res))]
+          {:email (get data "email")
+           :fullname (get data "name")})))
+    (catch Exception e
+      (log/error e "unexpected exception on get-user-info")
+      nil)))
 
-    (when (not= 200 (:status res))
-      (ex/raise :type :internal
-                :code :invalid-response-from-google
-                :context {:status (:status res)
-                          :body (:body res)}))
-
-    (try
-      (let [data (json/read-str (:body res))]
-        ;; (clojure.pprint/pprint data)
-        {:email (get data "email")
-         :fullname (get data "name")})
-      (catch Throwable e
-        (log/error "unexpected error on parsing response body from google access token request" e)
-        nil))))
-
-(defn auth
-  [_req]
-  (let [token  (tokens/generate {:iss :google-oauth :exp (dt/in-future "15m")})
+(defn- auth
+  [{:keys [tokens] :as cfg} _req]
+  (let [token  (tokens :generate {:iss :google-oauth :exp (dt/in-future "15m")})
         params {:scope scope
                 :access_type "offline"
                 :include_granted_scopes true
                 :state token
                 :response_type "code"
-                :redirect_uri (build-redirect-url)
-                :client_id (:google-client-id cfg/config)}
+                :redirect_uri (build-redirect-url cfg)
+                :client_id (:client-id cfg)}
         query  (uri/map->query-string params)
         uri    (-> (uri/uri base-goauth-uri)
                    (assoc :query query))]
     {:status 200
      :body {:redirect-uri (str uri)}}))
 
+(defn- callback
+  [{:keys [tokens rpc session] :as cfg} request]
+  (try
+    (let [token (get-in request [:params :state])
+          _     (tokens :verify {:token token :iss :google-oauth})
+          info  (some->> (get-in request [:params :code])
+                         (get-access-token cfg)
+                         (get-user-info))
+          _     (when-not info
+                  (ex/raise :type :internal
+                            :code :unable-to-auth))
+          method-fn (get-in rpc [:methods :mutation :login-or-register])
+          profile   (method-fn {:email (:email info)
+                                :fullname (:fullname info)})
+          uagent    (get-in request [:headers "user-agent"])
+          token     (tokens :generate {:iss :auth
+                                       :exp (dt/in-future "15m")
+                                       :profile-id (:id profile)})
+          uri       (-> (uri/uri (:public-uri cfg))
+                        (assoc :path "/#/auth/verify-token")
+                        (assoc :query (uri/map->query-string {:token token})))
 
-(defn callback
-  [req]
-  (let [token (get-in req [:params :state])
-        _     (tokens/verify token {:iss :google-oauth})
-        info  (some-> (get-in req [:params :code])
-                      (get-access-token)
-                      (get-user-info))]
-
-    (when-not info
-      (ex/raise :type :authentication
-                :code :unable-to-authenticate-with-google))
-
-    (let [profile (sm/handle {::sm/type :login-or-register
-                              :email (:email info)
-                              :fullname (:fullname info)})
-          uagent  (get-in req [:headers "user-agent"])
-
-          token   (tokens/generate
-                   {:iss :auth
-                    :exp (dt/in-future "15m")
-                    :profile-id (:id profile)})
-          uri     (-> (uri/uri (:public-uri cfg/config))
-                      (assoc :path "/#/auth/verify-token")
-                      (assoc :query (uri/map->query-string {:token token})))
-          sid     (session/create (:id profile) uagent)]
-
+          sid       (session/create! session {:profile-id (:id profile)
+                                              :user-agent uagent})]
       {:status 302
        :headers {"location" (str uri)}
-       :cookies (session/cookies sid)
-       :body ""})))
+       :cookies (session/cookies session {:value sid})
+       :body ""})
+    (catch Exception _e
+      (let [uri (-> (uri/uri (:public-uri cfg))
+                    (assoc :path "/#/auth/login")
+                    (assoc :query (uri/map->query-string {:error "unable-to-auth"})))]
+        {:status 302
+         :headers {"location" (str uri)}
+         :body ""}))))
+
+(s/def ::client-id ::us/not-empty-string)
+(s/def ::client-secret ::us/not-empty-string)
+(s/def ::public-uri ::us/not-empty-string)
+(s/def ::session map?)
+(s/def ::tokens fn?)
+
+(defmethod ig/pre-init-spec :app.http.auth/google [_]
+  (s/keys :req-un [::public-uri
+                   ::session
+                   ::tokens]
+          :opt-un [::client-id
+                   ::client-secret]))
+
+(defn- default-handler
+  [_]
+  (ex/raise :type :not-found))
+
+(defmethod ig/init-key :app.http.auth/google
+  [_ cfg]
+  (if (and (:client-id cfg)
+           (:client-secret cfg))
+    {:auth-handler #(auth cfg %)
+     :callback-handler #(callback cfg %)}
+    {:auth-handler default-handler
+     :callback-handler default-handler}))

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

@@ -12,50 +12,110 @@
    [app.common.exceptions :as ex]
    [app.config :as cfg]
    [app.http.session :as session]
-   [app.services.mutations :as sm]
    [clj-ldap.client :as client]
    [clojure.set :as set]
-   [clojure.string]
+   [clojure.spec.alpha :as s]
+   [clojure.string ]
    [clojure.tools.logging :as log]
-   [mount.core :refer [defstate]]))
+   [integrant.core :as ig]))
 
-(defn replace-several [s & {:as replacements}]
+(declare authenticate)
+(declare create-connection)
+(declare replace-several)
+
+
+(s/def ::host ::cfg/ldap-auth-host)
+(s/def ::port ::cfg/ldap-auth-port)
+(s/def ::ssl ::cfg/ldap-auth-ssl)
+(s/def ::starttls ::cfg/ldap-auth-starttls)
+(s/def ::user-query ::cfg/ldap-auth-user-query)
+(s/def ::base-dn ::cfg/ldap-auth-base-dn)
+(s/def ::username-attribute ::cfg/ldap-auth-username-attribute)
+(s/def ::email-attribute ::cfg/ldap-auth-email-attribute)
+(s/def ::fullname-attribute ::cfg/ldap-auth-fullname-attribute)
+(s/def ::avatar-attribute ::cfg/ldap-auth-avatar-attribute)
+
+(s/def ::rpc map?)
+(s/def ::session map?)
+
+(defmethod ig/pre-init-spec :app.http.auth/ldap
+  [_]
+  (s/keys
+   :req-un [::rpc ::session]
+   :opt-un [::host
+            ::port
+            ::ssl
+            ::starttls
+            ::username-attribute
+            ::base-dn
+            ::username-attribute
+            ::email-attribute
+            ::fullname-attribute
+            ::avatar-attribute]))
+
+(defmethod ig/init-key :app.http.auth/ldap
+  [_ {:keys [session rpc] :as cfg}]
+  (let [conn (create-connection cfg)]
+    (with-meta
+      (fn [request]
+        (let [data   (:body-params request)]
+          (when-some [info (authenticate (assoc cfg
+                                                :conn conn
+                                                :username (:email data)
+                                                :password (:password data)))]
+            (let [method-fn (get-in rpc [:methods :mutation :login-or-register])
+                  profile   (method-fn {:email (:email info)
+                                        :fullname (:fullname info)})
+                  uagent    (get-in request [:headers "user-agent"])
+                  sid       (session/create! session {:profile-id (:id profile)
+                                                      :user-agent uagent})]
+              {:status 200
+               :cookies (session/cookies session {:value sid})
+               :body profile}))))
+      {::conn conn})))
+
+(defmethod ig/halt-key! ::client
+  [_ handler]
+  (let [{:keys [::conn]} (meta handler)]
+    (when (realized? conn)
+      (.close @conn))))
+
+(defn- replace-several [s & {:as replacements}]
   (reduce-kv clojure.string/replace s replacements))
 
-(declare *ldap-pool)
+(defn- create-connection
+  [cfg]
+  (let [params (merge {:host {:address (:host cfg)
+                              :port (:port cfg)}}
+                      (-> cfg
+                          (select-keys [:ssl
+                                        :starttls
+                                        :ldap-bind-dn
+                                        :ldap-bind-password])
+                          (set/rename-keys {:ssl :ssl?
+                                            :starttls :startTLS?
+                                            :ldap-bind-dn  :bind-dn
+                                            :ldap-bind-password :password})))]
+    (delay
+      (try
+        (client/connect params)
+        (catch Exception e
+          (log/errorf e "Cannot connect to LDAP %s:%s"
+                      (:host cfg) (:port cfg)))))))
 
-(defstate *ldap-pool
-  :start (delay
-           (try
-             (client/connect (merge {:host {:address (:ldap-auth-host cfg/config)
-                                            :port (:ldap-auth-port cfg/config)}}
-                                    (-> cfg/config
-                                        (select-keys [:ldap-auth-ssl
-                                                      :ldap-auth-starttls
-                                                      :ldap-bind-dn
-                                                      :ldap-bind-password])
-                                        (set/rename-keys {:ldap-auth-ssl :ssl?
-                                                          :ldap-auth-starttls :startTLS?
-                                                          :ldap-bind-dn  :bind-dn
-                                                          :ldap-bind-password :password}))))
-             (catch Exception e
-               (log/errorf e "Cannot connect to LDAP %s:%s"
-                             (:ldap-auth-host cfg/config) (:ldap-auth-port cfg/config)))))
-  :stop (when (realized? *ldap-pool)
-          (some-> *ldap-pool deref (.close))))
 
-(defn- auth-with-ldap [username password]
-  (when-some [conn (some-> *ldap-pool deref)]
-    (let [user-search-query (replace-several (:ldap-auth-user-query cfg/config)
-                                             "$username" username)
-          user-attributes (-> cfg/config
-                              (select-keys [:ldap-auth-username-attribute
-                                            :ldap-auth-email-attribute
-                                            :ldap-auth-fullname-attribute
-                                            :ldap-auth-avatar-attribute])
-                              vals)]
+(defn- authenticate
+  [{:keys [conn username password] :as cfg}]
+  (when-some [conn (some-> conn deref)]
+    (let [user-search-query (replace-several (:user-query cfg) "$username" username)
+          user-attributes   (-> cfg
+                                (select-keys [:username-attribute
+                                              :email-attribute
+                                              :fullname-attribute
+                                              :avatar-attribute])
+                                vals)]
       (when-some [user-entry (-> conn
-                                 (client/search (:ldap-auth-base-dn cfg/config)
+                                 (client/search (:base-dn cfg)
                                                 {:filter user-search-query
                                                  :sizelimit 1
                                                  :attributes user-attributes})
@@ -63,18 +123,7 @@
         (when-not (client/bind? conn (:dn user-entry) password)
           (ex/raise :type :authentication
                     :code :wrong-credentials))
-        (set/rename-keys user-entry {(keyword (:ldap-auth-avatar-attribute cfg/config)) :photo
-                                     (keyword (:ldap-auth-fullname-attribute cfg/config)) :fullname
-                                     (keyword (:ldap-auth-email-attribute cfg/config)) :email})))))
+        (set/rename-keys user-entry {(keyword (:avatar-attribute cfg)) :photo
+                                     (keyword (:fullname-attribute cfg)) :fullname
+                                     (keyword (:email-attribute cfg)) :email})))))
 
-(defn auth [req]
-  (let [data (:body-params req)
-        uagent (get-in req [:headers "user-agent"])]
-    (when-some [info (auth-with-ldap (:email data) (:password data))]
-      (let [profile (sm/handle {::sm/type :login-or-register
-                                :email (:email info)
-                                :fullname (:fullname info)})
-            sid (session/create (:id profile) uagent)]
-        {:status 200
-         :cookies (session/cookies sid)
-         :body profile}))))

backend/src/app/http/errors.clj

@@ -10,97 +10,93 @@
 (ns app.http.errors
   "A errors handling for the http server."
   (:require
-   [app.common.exceptions :as ex]
+   [app.common.uuid :as uuid]
+   [app.config :as cfg]
+   [app.util.log4j :refer [update-thread-context!]]
    [clojure.tools.logging :as log]
    [cuerdas.core :as str]
    [expound.alpha :as expound]))
 
+(defn- explain-error
+  [error]
+  (with-out-str
+    (expound/printer (:data error))))
+
+(defn get-error-context
+  [request error]
+  (let [edata (ex-data error)]
+    (merge
+     {:id      (uuid/next)
+      :path    (:uri request)
+      :method  (:request-method request)
+      :params  (:params request)
+      :version (:full cfg/version)
+      :host    (:public-uri cfg/config)
+      :class   (.getCanonicalName ^java.lang.Class (class error))
+      :hint    (ex-message error)
+      :data    edata}
+
+     (let [headers (:headers request)]
+       {:user-agent (get headers "user-agent")
+        :frontend-version (get headers "x-frontend-version" "unknown")})
+
+     (when (and (map? edata) (:data edata))
+       {:explain (explain-error edata)}))))
+
 (defmulti handle-exception
   (fn [err & _rest]
     (let [edata (ex-data err)]
       (or (:type edata)
           (class err)))))
 
-(defmethod handle-exception :authorization
+(defmethod handle-exception :authentication
   [err _]
-  {:status 403
-   :body (ex-data err)})
+  {:status 401 :body (ex-data err)})
 
 (defmethod handle-exception :validation
   [err req]
   (let [header (get-in req [:headers "accept"])
         edata  (ex-data err)]
-    (cond
-      (and (str/starts-with? header "text/html")
-           (= :spec-validation (:code edata)))
+    (if (and (= :spec-validation (:code edata))
+             (str/starts-with? header "text/html"))
       {:status 400
        :headers {"content-type" "text/html"}
        :body (str "<pre style='font-size:16px'>"
-                  (with-out-str
-                    (:data edata))
+                  (explain-error edata)
                   "</pre>\n")}
-      :else
       {:status 400
-       :body edata})))
+       :body   (cond-> edata
+                 (map? (:data edata))
+                 (-> (assoc :explain (explain-error edata))
+                     (dissoc :data)))})))
 
-(defmethod handle-exception :ratelimit
-  [_ _]
-  {:status 429
-   :headers {"retry-after" 1000}
-   :body ""})
+(defmethod handle-exception :assertion
+  [error request]
+  (let [edata (ex-data error)
+        cdata (get-error-context request error)]
+    (update-thread-context! cdata)
+    (log/errorf error "Internal error: assertion (id: %s)" (str (:id cdata)))
+    {:status 500
+     :body {:type :server-error
+            :data (-> edata
+                      (assoc :explain (explain-error edata))
+                      (dissoc :data))}}))
 
 (defmethod handle-exception :not-found
   [err _]
-  (let [response (ex-data err)]
-    {:status 404
-     :body response}))
-
-(defmethod handle-exception :service-error
-  [err req]
-  (handle-exception (.getCause ^Throwable err) req))
-
-(defmethod handle-exception :parse
-  [err _]
-  {:status 400
-   :body {:type :parse
-          :message (ex-message err)}})
-
-(defn get-context-string
-  [err request]
-  (str
-   "=| uri:          " (pr-str (:uri request)) "\n"
-   "=| method:       " (pr-str (:request-method request)) "\n"
-   "=| path-params:  " (pr-str (:path-params request)) "\n"
-   "=| query-params: " (pr-str (:query-params request)) "\n"
-
-   (when-let [bparams (:body-params request)]
-     (str "=| body-params:  " (pr-str bparams) "\n"))
-
-   (when (ex/ex-info? err)
-     (str "=| ex-data:      " (pr-str (ex-data err)) "\n"))
-
-   "\n"))
-
-
-(defmethod handle-exception :assertion
-  [err request]
-  (let [{:keys [data] :as edata} (ex-data err)]
-    (log/errorf err
-                (str "Assertion error\n"
-                     (get-context-string err request)
-                     (with-out-str (expound/printer data))))
-    {:status 500
-     :body {:type :internal-error
-            :message "Assertion error"
-            :data (ex-data err)}}))
+  {:status 404 :body (ex-data err)})
 
 (defmethod handle-exception :default
-  [err request]
-  (log/errorf err (str "Internal Error\n" (get-context-string err request)))
-  {:status 500
-   :body {:type :internal-error
-          :message (ex-message err)
-          :data (ex-data err)}})
+  [error request]
+  (let [cdata (get-error-context request error)]
+    (update-thread-context! cdata)
+    (log/errorf error "Internal error: %s (id: %s)"
+                (ex-message error)
+                (str (:id cdata)))
+    {:status 500
+     :body {:type :server-error
+            :hint (ex-message error)
+            :data (ex-data error)}}))
 
 (defn handle
   [error req]

backend/src/app/http/handlers.clj

@@ -1,76 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
-
-(ns app.http.handlers
-  (:require
-   [app.common.data :as d]
-   [app.common.exceptions :as ex]
-   [app.emails :as emails]
-   [app.http.session :as session]
-   [app.services.init]
-   [app.services.mutations :as sm]
-   [app.services.queries :as sq]))
-
-(def unauthorized-services
-  #{:create-demo-profile
-    :logout
-    :profile
-    :verify-token
-    :recover-profile
-    :register-profile
-    :request-profile-recovery
-    :viewer-bundle
-    :login})
-
-(defn query-handler
-  [{:keys [profile-id] :as request}]
-  (let [type (keyword (get-in request [:path-params :type]))
-        data (assoc (:params request) ::sq/type type)
-        data (if profile-id
-               (assoc data :profile-id profile-id)
-               (dissoc data :profile-id))]
-
-    (if (or (uuid? profile-id)
-            (contains? unauthorized-services type))
-      {:status 200
-       :body (sq/handle (with-meta data {:req request}))}
-      {:status 403
-       :body {:type :authentication
-              :code :unauthorized}})))
-
-(defn mutation-handler
-  [{:keys [profile-id] :as request}]
-  (let [type (keyword (get-in request [:path-params :type]))
-        data (d/merge (:params request)
-                      (:body-params request)
-                      (:uploads request)
-                      {::sm/type type})
-        data (if profile-id
-               (assoc data :profile-id profile-id)
-               (dissoc data :profile-id))]
-
-    (if (or (uuid? profile-id)
-            (contains? unauthorized-services type))
-      (let [result (sm/handle (with-meta data {:req request}))
-            mdata  (meta result)
-            resp   {:status (if (nil? (seq result)) 204 200)
-                    :body result}]
-        (cond->> resp
-          (:transform-response mdata) ((:transform-response mdata) request)))
-      {:status 403
-       :body {:type :authentication
-              :code :unauthorized}})))
-
-(defn echo-handler
-  [req]
-  {:status 200
-   :body {:params (:params req)
-          :cookies (:cookies req)
-          :headers (:headers req)}})
-

backend/src/app/http/middleware.clj

@@ -5,36 +5,69 @@
 ;; This Source Code Form is "Incompatible With Secondary Licenses", as
 ;; defined by the Mozilla Public License, v. 2.0.
 ;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) 2020-2021 UXBOX Labs SL
 
 (ns app.http.middleware
   (:require
-   [app.common.exceptions :as ex]
-   [app.config :as cfg]
    [app.metrics :as mtx]
+   [app.util.json :as json]
    [app.util.transit :as t]
+   [clojure.java.io :as io]
    [ring.middleware.cookies :refer [wrap-cookies]]
    [ring.middleware.keyword-params :refer [wrap-keyword-params]]
    [ring.middleware.multipart-params :refer [wrap-multipart-params]]
-   [ring.middleware.params :refer [wrap-params]]
-   [ring.middleware.resource :refer [wrap-resource]]))
+   [ring.middleware.params :refer [wrap-params]]))
 
-(defn- wrap-parse-request-body
+(defn wrap-server-timing
   [handler]
-  (letfn [(parse-body [body]
+  (let [seconds-from #(float (/ (- (System/nanoTime) %) 1000000000))]
+    (fn [request]
+      (let [start    (System/nanoTime)
+            response (handler request)]
+        (update response :headers
+                (fn [headers]
+                  (assoc headers "Server-Timing" (str "total;dur=" (seconds-from start)))))))))
+
+(defn wrap-parse-request-body
+  [handler]
+  (letfn [(parse-transit [body]
+            (let [reader (t/reader body)]
+              (t/read! reader)))
+
+          (parse-json [body]
+            (let [reader (io/reader body)]
+              (json/read reader)))
+
+          (parse [type body]
             (try
-              (let [reader (t/reader body)]
-                (t/read! reader))
+              (case type
+                :json (parse-json body)
+                :transit (parse-transit body))
               (catch Exception e
-                (ex/raise :type :parse
-                          :message "Unable to parse transit from request body."
-                          :cause e))))]
-    (fn [{:keys [headers body request-method] :as request}]
-      (handler
-       (cond-> request
-         (and (= "application/transit+json" (get headers "content-type"))
-              (not= request-method :get))
-         (assoc :body-params (parse-body body)))))))
+                (let [data {:type :parse
+                            :hint "unable to parse request body"
+                            :message (ex-message e)}]
+                  {:status 400
+                   :headers {"content-type" "application/transit+json"}
+                   :body (t/encode-str data {:type :json-verbose})}))))]
+
+    (fn [{:keys [headers body] :as request}]
+      (let [ctype (get headers "content-type")]
+        (handler
+         (case ctype
+           "application/transit+json"
+           (let [params (parse :transit body)]
+             (-> request
+                 (assoc :body-params params)
+                 (update :params merge params)))
+
+           "application/json"
+           (let [params (parse :json body)]
+             (-> request
+                 (assoc :body-params params)
+                 (update :params merge params)))
+
+           request))))))
 
 (def parse-request-body
   {:name ::parse-request-body
@@ -43,9 +76,7 @@
 (defn- impl-format-response-body
   [response]
   (let [body (:body response)
-        type (if (:debug-humanize-transit cfg/config)
-               :json-verbose
-               :json)]
+        type :json-verbose]
     (cond
       (coll? body)
       (-> response
@@ -71,7 +102,7 @@
   {:name ::format-response-body
    :compile (constantly wrap-format-response-body)})
 
-(defn- wrap-errors
+(defn wrap-errors
   [handler on-error]
   (fn [request]
     (try
@@ -89,6 +120,7 @@
            (mtx/wrap-counter handler {:id "http__requests_counter"
                                       :help "Absolute http requests counter."}))})
 
+
 (def cookies
   {:name ::cookies
    :compile (constantly wrap-cookies)})
@@ -105,33 +137,6 @@
   {:name ::keyword-params
    :compile (constantly wrap-keyword-params)})
 
-(defn- wrap-development-cors
-  [handler]
-  (letfn [(add-cors-headers [response]
-            (update response :headers
-                    (fn [headers]
-                      (-> headers
-                          (assoc "access-control-allow-origin" "http://localhost:3449")
-                          (assoc "access-control-allow-methods" "GET,POST,DELETE,OPTIONS,PUT,HEAD,PATCH")
-                          (assoc "access-control-allow-credentials" "true")
-                          (assoc "access-control-expose-headers" "x-requested-with, content-type, cookie")
-                          (assoc "access-control-allow-headers" "content-type")))))]
-    (fn [request]
-      (if (= (:request-method request) :options)
-        (-> {:status 200 :body ""}
-            (add-cors-headers))
-        (let [response (handler request)]
-          (add-cors-headers response))))))
-
-(def development-cors
-  {:name ::development-cors
-   :compile (fn [& _args]
-              (when *assert*
-                wrap-development-cors))})
-
-(def development-resources
-  {:name ::development-resources
-   :compile (fn [& _args]
-              (when *assert*
-                #(wrap-resource % "public")))})
-
+(def server-timing
+  {:name ::server-timing
+   :compile (constantly wrap-server-timing)})

backend/src/app/http/session.clj

@@ -7,60 +7,68 @@
 ;;
 ;; Copyright (c) 2020 UXBOX Labs SL
 
-;; TODO: move to services.
-
 (ns app.http.session
   (:require
    [app.db :as db]
+   [app.util.log4j :refer [update-thread-context!]]
    [buddy.core.codecs :as bc]
-   [buddy.core.nonce :as bn]))
+   [buddy.core.nonce :as bn]
+   [clojure.spec.alpha :as s]
+   [integrant.core :as ig]))
 
-(defn next-token
-  [n]
-  (-> (bn/random-nonce n)
-      (bc/bytes->b64u)
-      (bc/bytes->str)))
+(defn next-session-id
+  ([] (next-session-id 96))
+  ([n]
+   (-> (bn/random-nonce n)
+       (bc/bytes->b64u)
+       (bc/bytes->str))))
 
-(defn extract-auth-token
-  [request]
-  (get-in request [:cookies "auth-token" :value]))
+(defn create!
+  [{:keys [conn] :as cfg} {:keys [profile-id user-agent]}]
+  (let [id (next-session-id)]
+    (db/insert! conn :http-session {:id id
+                                    :profile-id profile-id
+                                    :user-agent user-agent})
+    id))
+
+(defn delete!
+  [{:keys [conn cookie-name] :as cfg} request]
+  (when-let [token (get-in request [:cookies cookie-name :value])]
+    (db/delete! conn :http-session {:id token}))
+  nil)
 
 (defn retrieve
-  [conn token]
+  [{:keys [conn] :as cfg} token]
   (when token
     (-> (db/exec-one! conn ["select profile_id from http_session where id = ?" token])
         (:profile-id))))
 
 (defn retrieve-from-request
-  [conn request]
-  (->> (extract-auth-token request)
-       (retrieve conn)))
-
-(defn create
-  [profile-id user-agent]
-  (let [id (next-token 64)]
-    (db/insert! db/pool :http-session {:id id
-                                       :profile-id profile-id
-                                       :user-agent user-agent})
-    id))
-
-(defn delete
-  [token]
-  (db/delete! db/pool :http-session {:id token})
-  nil)
+  [{:keys [cookie-name] :as cfg} request]
+  (->> (get-in request [:cookies cookie-name :value])
+       (retrieve cfg)))
 
 (defn cookies
-  ([id] (cookies id {}))
-  ([id opts]
-   {"auth-token" (merge opts {:value id :path "/" :http-only true})}))
+  [{:keys [cookie-name] :as cfg} vals]
+  {cookie-name (merge vals {:path "/" :http-only true})})
 
-(defn wrap-session
-  [handler]
+(defn middleware
+  [cfg handler]
   (fn [request]
-    (if-let [profile-id (retrieve-from-request db/pool request)]
-      (handler (assoc request :profile-id profile-id))
+    (if-let [profile-id (retrieve-from-request cfg request)]
+      (do
+        (update-thread-context! {:profile-id profile-id})
+        (handler (assoc request :profile-id profile-id)))
       (handler request))))
 
-(def middleware
-  {:nane ::middleware
-   :compile (constantly wrap-session)})
+(defmethod ig/pre-init-spec ::session [_]
+  (s/keys :req-un [::db/pool]))
+
+(defmethod ig/prep-key ::session
+  [_ cfg]
+  (merge {:cookie-name "auth-token"} cfg))
+
+(defmethod ig/init-key ::session
+  [_ {:keys [pool] :as cfg}]
+  (let [cfg (assoc cfg :conn pool)]
+    (merge cfg {:middleware #(middleware cfg %)})))

backend/src/app/http/ws.clj

@@ -1,61 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
-
-(ns app.http.ws
-  "Web Socket handlers"
-  (:require
-   [app.common.spec :as us]
-   [app.db :as db]
-   [app.http.session :refer [wrap-session]]
-   [app.services.notifications :as nf]
-   [clojure.spec.alpha :as s]
-   [ring.middleware.cookies :refer [wrap-cookies]]
-   [ring.middleware.keyword-params :refer [wrap-keyword-params]]
-   [ring.middleware.params :refer [wrap-params]]))
-
-(s/def ::file-id ::us/uuid)
-(s/def ::session-id ::us/uuid)
-
-(s/def ::websocket-params
-  (s/keys :req-un [::file-id ::session-id]))
-
-(def sql:retrieve-file
-  "select f.id as id,
-          p.team_id as team_id
-     from file as f
-     join project as p on (p.id = f.project_id)
-    where f.id = ?")
-
-(defn retrieve-file
-  [conn id]
-  (db/exec-one! conn [sql:retrieve-file id]))
-
-(defn websocket
-  [{:keys [profile-id] :as req}]
-  (let [params (us/conform ::websocket-params (:params req))
-        file   (retrieve-file db/pool (:file-id params))
-        params (assoc params
-                      :profile-id profile-id
-                      :team-id (:team-id file))]
-    (cond
-      (not profile-id)
-      {:error {:code 403 :message "Authentication required"}}
-
-      (not file)
-      {:error {:code 404 :message "File does not exists"}}
-
-      :else
-      (nf/websocket params))))
-
-(def handler
-  (-> websocket
-      (wrap-session)
-      (wrap-keyword-params)
-      (wrap-cookies)
-      (wrap-params)))

backend/src/app/main.clj

@@ -5,38 +5,351 @@
 ;; This Source Code Form is "Incompatible With Secondary Licenses", as
 ;; defined by the Mozilla Public License, v. 2.0.
 ;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) 2020-2021 UXBOX Labs SL
 
 (ns app.main
   (:require
+   [app.common.data :as d]
    [app.config :as cfg]
+   [app.util.time :as dt]
+   [clojure.pprint :as pprint]
    [clojure.tools.logging :as log]
-   [mount.core :as mount]))
-
-(defn- enable-asserts
-  [_]
-  (let [m (System/getProperty "app.enable-asserts")]
-    (or (nil? m) (= "true" m))))
+   [integrant.core :as ig]))
 
 ;; Set value for all new threads bindings.
-(alter-var-root #'*assert* enable-asserts)
+(alter-var-root #'*assert* (constantly (:asserts-enabled cfg/config)))
 
-;; Set value for current thread binding.
-(set! *assert* (enable-asserts nil))
+(derive :app.telemetry/server :app.http/server)
 
 ;; --- Entry point
 
-(defn run
-  [_params]
-  (require 'app.srepl.server
-           'app.services
-           'app.migrations
-           'app.worker
-           'app.media
-           'app.http)
-  (mount/start)
-  (log/infof "Welcome to penpot! Version: '%s'." (:full @cfg/version)))
+(defn build-system-config
+  [config]
+  (d/deep-merge
+   {:app.db/pool
+    {:uri        (:database-uri config)
+     :username   (:database-username config)
+     :password   (:database-password config)
+     :metrics    (ig/ref :app.metrics/metrics)
+     :migrations (ig/ref :app.migrations/all)
+     :name "main"
+     :min-pool-size 0
+     :max-pool-size 20}
+
+    :app.metrics/metrics
+    {}
+
+    :app.migrations/all
+    {:main (ig/ref :app.migrations/migrations)
+     :telemetry  (ig/ref :app.telemetry/migrations)}
+
+    :app.migrations/migrations
+    {}
+
+    :app.telemetry/migrations
+    {}
+
+    :app.redis/redis
+    {:uri (:redis-uri config)}
+
+    :app.tokens/tokens
+    {:sprops (ig/ref :app.sprops/props)}
+
+    :app.storage/gc-deleted-task
+    {:pool     (ig/ref :app.db/pool)
+     :storage  (ig/ref :app.storage/storage)
+     :min-age  (dt/duration {:hours 2})}
+
+    :app.storage/gc-touched-task
+    {:pool     (ig/ref :app.db/pool)}
+
+    :app.storage/recheck-task
+    {:pool     (ig/ref :app.db/pool)
+     :storage  (ig/ref :app.storage/storage)}
+
+    :app.http.session/session
+    {:pool        (ig/ref :app.db/pool)
+     :cookie-name "auth-token"}
+
+    :app.http/server
+    {:port    (:http-server-port config)
+     :handler (ig/ref :app.http/router)
+     :metrics (ig/ref :app.metrics/metrics)
+     :ws      {"/ws/notifications" (ig/ref :app.notifications/handler)}}
+
+    :app.http/router
+    {:rpc         (ig/ref :app.rpc/rpc)
+     :session     (ig/ref :app.http.session/session)
+     :tokens      (ig/ref :app.tokens/tokens)
+     :public-uri  (:public-uri config)
+     :metrics     (ig/ref :app.metrics/metrics)
+     :google-auth (ig/ref :app.http.auth/google)
+     :gitlab-auth (ig/ref :app.http.auth/gitlab)
+     :github-auth (ig/ref :app.http.auth/github)
+     :ldap-auth   (ig/ref :app.http.auth/ldap)
+     :assets      (ig/ref :app.http.assets/handlers)
+     :svgparse    (ig/ref :app.svgparse/handler)
+     :storage     (ig/ref :app.storage/storage)
+     :error-report-handler (ig/ref :app.error-reporter/handler)}
+
+    :app.http.assets/handlers
+    {:metrics           (ig/ref :app.metrics/metrics)
+     :assets-path       (:assets-path config)
+     :storage           (ig/ref :app.storage/storage)
+     :cache-max-age     (dt/duration {:hours 24})
+     :signature-max-age (dt/duration {:hours 24 :minutes 5})}
+
+    :app.http.auth/google
+    {:rpc           (ig/ref :app.rpc/rpc)
+     :session       (ig/ref :app.http.session/session)
+     :tokens        (ig/ref :app.tokens/tokens)
+     :public-uri    (:public-uri config)
+     :client-id     (:google-client-id config)
+     :client-secret (:google-client-secret config)}
+
+    :app.http.auth/github
+    {:rpc           (ig/ref :app.rpc/rpc)
+     :session       (ig/ref :app.http.session/session)
+     :tokens        (ig/ref :app.tokens/tokens)
+     :public-uri    (:public-uri config)
+     :client-id     (:github-client-id config)
+     :client-secret (:github-client-secret config)}
+
+    :app.http.auth/gitlab
+    {:rpc           (ig/ref :app.rpc/rpc)
+     :session       (ig/ref :app.http.session/session)
+     :tokens        (ig/ref :app.tokens/tokens)
+     :public-uri    (:public-uri config)
+     :base-uri      (:gitlab-base-uri config)
+     :client-id     (:gitlab-client-id config)
+     :client-secret (:gitlab-client-secret config)}
+
+    :app.http.auth/ldap
+    {:host               (:ldap-auth-host config)
+     :port               (:ldap-auth-port config)
+     :ssl                (:ldap-auth-ssl config)
+     :starttls           (:ldap-auth-starttls config)
+     :user-query         (:ldap-auth-user-query config)
+     :username-attribute (:ldap-auth-username-attribute config)
+     :email-attribute    (:ldap-auth-email-attribute config)
+     :fullname-attribute (:ldap-auth-fullname-attribute config)
+     :avatar-attribute   (:ldap-auth-avatar-attribute config)
+     :base-dn            (:ldap-auth-base-dn config)
+     :session            (ig/ref :app.http.session/session)
+     :rpc                (ig/ref :app.rpc/rpc)}
+
+    :app.svgparse/svgc
+    {:metrics (ig/ref :app.metrics/metrics)}
+
+    ;; HTTP Handler for SVG parsing
+    :app.svgparse/handler
+    {:metrics (ig/ref :app.metrics/metrics)
+     :svgc    (ig/ref :app.svgparse/svgc)}
+
+    ;; RLimit definition for password hashing
+    :app.rlimits/password
+    (:rlimits-password config)
+
+    ;; RLimit definition for image processing
+    :app.rlimits/image
+    (:rlimits-image config)
+
+    ;; A collection of rlimits as hash-map.
+    :app.rlimits/all
+    {:password (ig/ref :app.rlimits/password)
+     :image    (ig/ref :app.rlimits/image)}
+
+    :app.rpc/rpc
+    {:pool    (ig/ref :app.db/pool)
+     :session (ig/ref :app.http.session/session)
+     :tokens  (ig/ref :app.tokens/tokens)
+     :metrics (ig/ref :app.metrics/metrics)
+     :storage (ig/ref :app.storage/storage)
+     :redis   (ig/ref :app.redis/redis)
+     :rlimits (ig/ref :app.rlimits/all)
+     :svgc    (ig/ref :app.svgparse/svgc)}
+
+    :app.notifications/handler
+    {:redis   (ig/ref :app.redis/redis)
+     :pool    (ig/ref :app.db/pool)
+     :session (ig/ref :app.http.session/session)
+     :metrics (ig/ref :app.metrics/metrics)}
+
+    :app.worker/executor
+    {:name "worker"}
+
+    :app.worker/worker
+    {:executor   (ig/ref :app.worker/executor)
+     :pool       (ig/ref :app.db/pool)
+     :tasks      (ig/ref :app.tasks/all)}
+
+    :app.worker/scheduler
+    {:executor   (ig/ref :app.worker/executor)
+     :pool       (ig/ref :app.db/pool)
+     :schedule
+     [{:id "file-media-gc"
+       :cron #app/cron "0 0 0 */1 * ? *" ;; daily
+       :fn (ig/ref :app.tasks.file-media-gc/handler)}
+
+      {:id "file-xlog-gc"
+       :cron #app/cron "0 0 */1 * * ?"  ;; hourly
+       :fn (ig/ref :app.tasks.file-xlog-gc/handler)}
+
+      {:id "storage-deleted-gc"
+       :cron #app/cron "0 0 1 */1 * ?"  ;; daily (1 hour shift)
+       :fn (ig/ref :app.storage/gc-deleted-task)}
+
+      {:id "storage-touched-gc"
+       :cron #app/cron "0 0 2 */1 * ?"  ;; daily (2 hour shift)
+       :fn (ig/ref :app.storage/gc-touched-task)}
+
+      {:id "storage-recheck"
+       :cron #app/cron "0 0 */1 * * ?"  ;; hourly
+       :fn (ig/ref :app.storage/recheck-task)}
+
+      {:id "tasks-gc"
+       :cron #app/cron "0 0 0 */1 * ?"  ;; daily
+       :fn (ig/ref :app.tasks.tasks-gc/handler)}
+
+      (when (:telemetry-enabled config)
+        {:id   "telemetry"
+         :cron #app/cron "0 0 */6 * * ?" ;; every 6h
+         :uri  (:telemetry-uri config)
+         :fn   (ig/ref :app.tasks.telemetry/handler)})]}
+
+    :app.tasks/all
+    {"sendmail"       (ig/ref :app.tasks.sendmail/handler)
+     "delete-object"  (ig/ref :app.tasks.delete-object/handler)
+     "delete-profile" (ig/ref :app.tasks.delete-profile/handler)}
+
+    :app.tasks.sendmail/handler
+    {:host             (:smtp-host config)
+     :port             (:smtp-port config)
+     :ssl              (:smtp-ssl config)
+     :tls              (:smtp-tls config)
+     :enabled          (:smtp-enabled config)
+     :username         (:smtp-username config)
+     :password         (:smtp-password config)
+     :metrics          (ig/ref :app.metrics/metrics)
+     :default-reply-to (:smtp-default-reply-to config)
+     :default-from     (:smtp-default-from config)}
+
+    :app.tasks.tasks-gc/handler
+    {:pool    (ig/ref :app.db/pool)
+     :max-age (dt/duration {:hours 24})
+     :metrics (ig/ref :app.metrics/metrics)}
+
+    :app.tasks.delete-object/handler
+    {:pool    (ig/ref :app.db/pool)
+     :metrics (ig/ref :app.metrics/metrics)}
+
+    :app.tasks.delete-storage-object/handler
+    {:pool    (ig/ref :app.db/pool)
+     :storage (ig/ref :app.storage/storage)
+     :metrics (ig/ref :app.metrics/metrics)}
+
+    :app.tasks.delete-profile/handler
+    {:pool    (ig/ref :app.db/pool)
+     :metrics (ig/ref :app.metrics/metrics)}
+
+    :app.tasks.file-media-gc/handler
+    {:pool    (ig/ref :app.db/pool)
+     :metrics (ig/ref :app.metrics/metrics)
+     :max-age (dt/duration {:hours 48})}
+
+    :app.tasks.file-xlog-gc/handler
+    {:pool    (ig/ref :app.db/pool)
+     :metrics (ig/ref :app.metrics/metrics)
+     :max-age (dt/duration {:hours 48})}
+
+    :app.tasks.telemetry/handler
+    {:pool        (ig/ref :app.db/pool)
+     :version     (:full cfg/version)
+     :uri         (:telemetry-uri config)
+     :sprops      (ig/ref :app.sprops/props)}
+
+    :app.srepl/server
+    {:port (:srepl-port config)
+     :host (:srepl-host config)}
+
+    :app.sprops/props
+    {:pool (ig/ref :app.db/pool)}
+
+    :app.error-reporter/reporter
+    {:uri      (:error-report-webhook config)
+     :pool     (ig/ref :app.db/pool)
+     :executor (ig/ref :app.worker/executor)}
+
+    :app.error-reporter/handler
+    {:pool (ig/ref :app.db/pool)}
+
+    :app.storage/storage
+    {:pool     (ig/ref :app.db/pool)
+     :executor (ig/ref :app.worker/executor)
+     :backend  (:storage-backend config :fs)
+     :backends {:s3  (ig/ref [::main :app.storage.s3/backend])
+                :db  (ig/ref [::main :app.storage.db/backend])
+                :fs  (ig/ref [::main :app.storage.fs/backend])
+                :tmp (ig/ref [::tmp  :app.storage.fs/backend])}}
+
+    [::main :app.storage.s3/backend]
+    {:region (:storage-s3-region config)
+     :bucket (:storage-s3-bucket config)}
+
+    [::main :app.storage.fs/backend]
+    {:directory (:storage-fs-directory config)}
+
+    [::tmp :app.storage.fs/backend]
+    {:directory "/tmp/penpot"}
+
+    [::main :app.storage.db/backend]
+    {:pool (ig/ref :app.db/pool)}}
+
+   (when (:telemetry-server-enabled config)
+     {:app.telemetry/handler
+      {:pool     (ig/ref :app.db/pool)
+       :executor (ig/ref :app.worker/executor)}
+
+      :app.telemetry/server
+      {:port    (:telemetry-server-port config 6063)
+       :handler (ig/ref :app.telemetry/handler)
+       :name    "telemetry"}})))
+
+(defmethod ig/init-key :default [_ data] data)
+(defmethod ig/prep-key :default
+  [_ data]
+  (if (map? data)
+    (d/without-nils data)
+    data))
+
+(def system nil)
+
+(defn start
+  []
+  (let [system-config (build-system-config cfg/config)]
+    (ig/load-namespaces system-config)
+    (alter-var-root #'system (fn [sys]
+                               (when sys (ig/halt! sys))
+                               (-> system-config
+                                   (ig/prep)
+                                   (ig/init))))
+    (log/infof "Welcome to penpot! Version: '%s'."
+               (:full cfg/version))))
+
+(defn stop
+  []
+  (alter-var-root #'system (fn [sys]
+                             (when sys (ig/halt! sys))
+                             nil)))
+
+(prefer-method print-method
+               clojure.lang.IRecord
+               clojure.lang.IDeref)
+
+(prefer-method pprint/simple-dispatch
+               clojure.lang.IPersistentMap
+               clojure.lang.IDeref)
 
 (defn -main
   [& _args]
-  (run {}))
+  (start))

backend/src/app/media.clj

@@ -10,29 +10,21 @@
 (ns app.media
   "Media postprocessing."
   (:require
+   [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.media :as cm]
    [app.common.spec :as us]
-   [app.config :as cfg]
-   [app.util.http :as http]
-   [clojure.core.async :as a]
-   [clojure.java.io :as io]
+   [app.rlimits :as rlm]
+   [app.svgparse :as svg]
    [clojure.spec.alpha :as s]
-   [datoteka.core :as fs]
-   [mount.core :refer [defstate]])
+   [cuerdas.core :as str]
+   [datoteka.core :as fs])
   (:import
    java.io.ByteArrayInputStream
-   java.util.concurrent.Semaphore
    org.im4java.core.ConvertCmd
    org.im4java.core.IMOperation
    org.im4java.core.Info))
 
-(declare semaphore)
-
-(defstate semaphore
-  :start (Semaphore. (:image-process-max-threads cfg/config 1)))
-
-
 ;; --- Generic specs
 
 (s/def :internal.http.upload/filename ::us/string)
@@ -75,7 +67,7 @@
   (let [{:keys [path mtype]} input
         format (or (cm/mtype->format mtype) format)
         ext    (cm/format->extension format)
-        tmp (fs/create-tempfile :suffix ext)]
+        tmp    (fs/create-tempfile :suffix ext)]
 
     (doto (ConvertCmd.)
       (.run operation (into-array (map str [path tmp]))))
@@ -85,6 +77,7 @@
       (assoc params
              :format format
              :mtype  (cm/format->mtype format)
+             :size   (alength thumbnail-data)
              :data   (ByteArrayInputStream. thumbnail-data)))))
 
 (defmulti process :cmd)
@@ -115,24 +108,58 @@
              (.addImage))]
     (generic-process (assoc params :operation op))))
 
+(defn get-basic-info-from-svg
+  [{:keys [tag attrs] :as data}]
+  (when (not= tag :svg)
+    (ex/raise :type :validation
+              :code :unable-to-parse-svg
+              :hint "uploaded svg has invalid content"))
+  (reduce (fn [default f]
+            (if-let [res (f attrs)]
+              (reduced res)
+              default))
+          {:width 100 :height 100}
+          [(fn parse-width-and-height
+             [{:keys [width height]}]
+             (when (and (string? width)
+                        (string? height))
+               (let [width  (d/parse-double width)
+                     height (d/parse-double height)]
+                 (when (and width height)
+                   {:width (int width)
+                    :height (int height)}))))
+           (fn parse-viewbox
+             [{:keys [viewBox]}]
+             (let [[x y width height] (->> (str/split viewBox #"\s+" 4)
+                                           (map d/parse-double))]
+               (when (and x y width height)
+                 {:width (int width)
+                  :height (int height)})))]))
+
 (defmethod process :info
   [{:keys [input] :as params}]
   (us/assert ::input input)
   (let [{:keys [path mtype]} input]
     (if (= mtype "image/svg+xml")
-      {:width 100
-       :height 100
-       :mtype mtype}
+      (let [data (svg/parse (slurp path))
+            info (get-basic-info-from-svg data)]
+        (when-not info
+          (ex/raise :type :validation
+                    :code :unable-to-retrieve-dimensions
+                    :hint "uploaded svg does not provides dimensions"))
+        (assoc info :mtype mtype))
+
       (let [instance (Info. (str path))
             mtype'   (.getProperty instance "Mime type")]
         (when (and (string? mtype)
                    (not= mtype mtype'))
           (ex/raise :type :validation
                     :code :media-type-mismatch
-                    :hint "Seems like you are uploading a file whose content does not match the extension."))
+                    :hint (str "Seems like you are uploading a file whose content does not match the extension."
+                               "Expected: " mtype ". Got: " mtype')))
         {:width  (.getImageWidth instance)
          :height (.getImageHeight instance)
-         :mtype  mtype'}))))
+         :mtype  mtype}))))
 
 (defmethod process :default
   [{:keys [cmd] :as params}]
@@ -141,20 +168,19 @@
             :hint (str "No impl found for process cmd:" cmd)))
 
 (defn run
-  [params]
-  (try
-    (.acquire semaphore)
-    (let [res (a/<!! (a/thread
-                       (try
-                         (process params)
-                         (catch Throwable e
-                           e))))]
-      (if (instance? Throwable res)
-        (throw res)
-        res))
-    (finally
-      (.release semaphore))))
-
+  [{:keys [rlimits]} params]
+  (us/assert map? rlimits)
+  (let [rlimit (get rlimits :image)]
+    (when-not rlimit
+      (ex/raise :type :internal
+                :code :rlimit-not-configured
+                :hint ":image rlimit not configured"))
+    (try
+      (rlm/execute rlimit (process params))
+      (catch org.im4java.core.InfoException e
+        (ex/raise :type :validation
+                  :code :invalid-image
+                  :cause e)))))
 
 ;; --- Utility functions
 
@@ -164,29 +190,3 @@
     (ex/raise :type :validation
               :code :media-type-not-allowed
               :hint "Seems like you are uploading an invalid media object")))
-
-
-;; TODO: rewrite using jetty http client instead of jvm
-;; builtin (because builtin http client uses a lot of memory for the
-;; same operation.
-
-(defn download-media-object
-  [url]
-  (let [result (http/get! url {:as :byte-array})
-        data (:body result)
-        content-type (get (:headers result) "content-type")
-        format (cm/mtype->format content-type)]
-    (if (nil? format)
-      (ex/raise :type :validation
-                :code :media-type-not-allowed
-                :hint "Seems like the url points to an invalid media object.")
-      (let [tempfile (fs/create-tempfile)
-            base-filename (first (fs/split-ext (fs/name tempfile)))
-            filename (str base-filename (cm/format->extension format))]
-        (with-open [ostream (io/output-stream tempfile)]
-          (.write ostream data))
-        {:filename filename
-         :size (count data)
-         :tempfile tempfile
-         :content-type content-type}))))
-

backend/src/app/media_storage.clj

@@ -1,37 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
-
-(ns app.media-storage
-  "A media storage impl for app."
-  (:require
-   [app.config :refer [config]]
-   [app.util.storage :as ust]
-   [mount.core :refer [defstate]]))
-
-;; --- State
-
-(declare assets-storage)
-
-(defstate assets-storage
-  :start (ust/create {:base-path (:assets-directory config)
-                      :base-uri (:assets-uri config)}))
-
-(declare media-storage)
-
-(defstate media-storage
-  :start (ust/create {:base-path (:media-directory config)
-                      :base-uri (:media-uri config)
-                      :xf (comp ust/random-path
-                                ust/slugify-filename)}))
-
-;; --- Public Api
-
-(defn resolve-asset
-  [path]
-  (str (ust/public-uri assets-storage path)))

backend/src/app/metrics.clj

@@ -5,9 +5,17 @@
 ;; This Source Code Form is "Incompatible With Secondary Licenses", as
 ;; defined by the Mozilla Public License, v. 2.0.
 ;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) 2020-2021 UXBOX Labs SL
 
 (ns app.metrics
+  (:require
+   [app.common.exceptions :as ex]
+   [app.util.time :as dt]
+   [app.worker]
+   [clojure.spec.alpha :as s]
+   [clojure.tools.logging :as log]
+   [integrant.core :as ig]
+   [next.jdbc :as jdbc])
   (:import
    io.prometheus.client.CollectorRegistry
    io.prometheus.client.Counter
@@ -15,31 +23,98 @@
    io.prometheus.client.Summary
    io.prometheus.client.exporter.common.TextFormat
    io.prometheus.client.hotspot.DefaultExports
+   io.prometheus.client.jetty.JettyStatisticsCollector
+   org.eclipse.jetty.server.handler.StatisticsHandler
    java.io.StringWriter))
 
-(defn- create-registry
+(declare instrument-vars!)
+(declare instrument)
+(declare create-registry)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Entry Point
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- instrument-jdbc!
+  [registry]
+  (instrument-vars!
+   [#'next.jdbc/execute-one!
+    #'next.jdbc/execute!]
+   {:registry registry
+    :type :counter
+    :name "database_query_counter"
+    :help "An absolute counter of database queries."}))
+
+(defn- instrument-workers!
+  [registry]
+  (instrument-vars!
+   [#'app.worker/run-task]
+   {:registry registry
+    :type :summary
+    :name "worker_task_checkout_millis"
+    :help "Latency measured between scheduld_at and execution time."
+    :wrap (fn [rootf mobj]
+            (let [mdata (meta rootf)
+                  origf (::original mdata rootf)]
+              (with-meta
+                (fn [tasks item]
+                  (let [now (inst-ms (dt/now))
+                        sat (inst-ms (:scheduled-at item))]
+                    (mobj :observe (- now sat))
+                    (origf tasks item)))
+                {::original origf})))}))
+
+(defn- handler
+  [registry _request]
+  (let [samples  (.metricFamilySamples ^CollectorRegistry registry)
+        writer   (StringWriter.)]
+    (TextFormat/write004 writer samples)
+    {:headers {"content-type" TextFormat/CONTENT_TYPE_004}
+     :body (.toString writer)}))
+
+(defmethod ig/init-key ::metrics
+  [_ _cfg]
+  (log/infof "Initializing prometheus registry and instrumentation.")
+  (let [registry (create-registry)]
+    (instrument-workers! registry)
+    (instrument-jdbc! registry)
+    {:handler (partial handler registry)
+     :registry registry}))
+
+(s/def ::handler fn?)
+(s/def ::registry #(instance? CollectorRegistry %))
+(s/def ::metrics
+  (s/keys :req-un [::registry ::handler]))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Implementation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn create-registry
   []
   (let [registry (CollectorRegistry.)]
     (DefaultExports/register registry)
     registry))
 
-(defonce registry (create-registry))
-(defonce cache (atom {}))
-
 (defmacro with-measure
-  [sym expr teardown]
-  `(let [~sym (System/nanoTime)]
+  [& {:keys [expr cb]}]
+  `(let [start# (System/nanoTime)
+         tdown# ~cb]
      (try
        ~expr
        (finally
-         (let [~sym (/ (- (System/nanoTime) ~sym) 1000000)]
-           ~teardown)))))
+         (tdown# (/ (- (System/nanoTime) start#) 1000000))))))
 
 (defn make-counter
-  [{:keys [id help] :as props}]
-  (let [instance (doto (Counter/build)
-                   (.name id)
-                   (.help help))
+  [{:keys [name help registry reg labels] :as props}]
+  (let [registry (or registry reg)
+        instance (.. (Counter/build)
+                     (name name)
+                     (help help))
+        _        (when (seq labels)
+                   (.labelNames instance (into-array String labels)))
         instance (.register instance registry)]
     (reify
       clojure.lang.IDeref
@@ -49,34 +124,21 @@
       (invoke [_ cmd]
         (.inc ^Counter instance))
 
-      (invoke [_ cmd val]
-        (case cmd
-          :wrap (fn
-                  ([a]
-                   (.inc ^Counter instance)
-                   (val a))
-                  ([a b]
-                   (.inc ^Counter instance)
-                   (val a b))
-                  ([a b c]
-                   (.inc ^Counter instance)
-                   (val a b c)))
-
-          (throw (IllegalArgumentException. "invalid arguments")))))))
-
-(defn counter
-  [{:keys [id] :as props}]
-  (or (get @cache id)
-      (let [v (make-counter props)]
-        (swap! cache assoc id v)
-        v)))
+      (invoke [_ cmd labels]
+        (.. ^Counter instance
+            (labels labels)
+            (inc))))))
 
 (defn make-gauge
-  [{:keys [id help] :as props}]
-  (let [instance (doto (Gauge/build)
-                   (.name id)
-                   (.help help))
+  [{:keys [name help registry reg labels] :as props}]
+  (let [registry (or registry reg)
+        instance (.. (Gauge/build)
+                     (name name)
+                     (help help))
+        _        (when (seq labels)
+                   (.labelNames instance (into-array String labels)))
         instance (.register instance registry)]
+
     (reify
       clojure.lang.IDeref
       (deref [_] instance)
@@ -85,94 +147,149 @@
       (invoke [_ cmd]
         (case cmd
           :inc (.inc ^Gauge instance)
-          :dec (.dec ^Gauge instance))))))
+          :dec (.dec ^Gauge instance)))
 
-(defn gauge
-  [{:keys [id] :as props}]
-  (or (get @cache id)
-      (let [v (make-gauge props)]
-        (swap! cache assoc id v)
-        v)))
+      (invoke [_ cmd labels]
+        (case cmd
+          :inc (.. ^Gauge instance (labels labels) (inc))
+          :dec (.. ^Gauge instance (labels labels) (dec)))))))
 
 (defn make-summary
-  [{:keys [id help] :as props}]
-  (let [instance (doto (Summary/build)
-                   (.name id)
+  [{:keys [name help registry reg labels max-age] :or {max-age 3600} :as props}]
+  (let [registry (or registry reg)
+        instance (doto (Summary/build)
+                   (.name name)
                    (.help help)
-                   (.quantile 0.5 0.05)
-                   (.quantile 0.9 0.01)
+                   (.maxAgeSeconds max-age)
+                   (.quantile 0.75 0.02)
                    (.quantile 0.99 0.001))
-        instance  (.register instance registry)]
+        _        (when (seq labels)
+                   (.labelNames instance (into-array String labels)))
+        instance (.register instance registry)]
     (reify
       clojure.lang.IDeref
       (deref [_] instance)
 
       clojure.lang.IFn
-      (invoke [_ val]
+      (invoke [_ cmd val]
         (.observe ^Summary instance val))
 
-      (invoke [_ cmd val]
-        (case cmd
-          :wrap (fn
-                  ([a]
-                   (with-measure $$
-                     (val a)
-                     (.observe ^Summary instance $$)))
-                  ([a b]
-                   (with-measure $$
-                     (val a b)
-                     (.observe ^Summary instance $$)))
-                  ([a b c]
-                   (with-measure $$
-                     (val a b c)
-                     (.observe ^Summary instance $$))))
+      (invoke [_ cmd val labels]
+        (.. ^Summary instance
+            (labels labels)
+            (observe val))))))
 
-          (throw (IllegalArgumentException. "invalid arguments")))))))
-
-(defn summary
-  [{:keys [id] :as props}]
-  (or (get @cache id)
-      (let [v (make-summary props)]
-        (swap! cache assoc id v)
-        v)))
-
-(defn wrap-summary
-  [f props]
-  (let [sm (summary props)]
-    (sm :wrap f)))
+(defn create
+  [{:keys [type] :as props}]
+  (case type
+    :counter (make-counter props)
+    :gauge   (make-gauge props)
+    :summary (make-summary props)))
 
 (defn wrap-counter
-  [f props]
-  (let [cnt (counter props)]
-    (cnt :wrap f)))
+  ([rootf mobj]
+   (let [mdata (meta rootf)
+         origf (::original mdata rootf)]
+     (with-meta
+       (fn
+         ([a]
+          (mobj :inc)
+          (origf a))
+         ([a b]
+          (mobj :inc)
+          (origf a b))
+         ([a b & more]
+          (mobj :inc)
+          (apply origf a b more)))
+       (assoc mdata ::original origf))))
+  ([rootf mobj labels]
+   (let [mdata  (meta rootf)
+         labels (into-array String labels)
+         origf  (::original mdata rootf)]
+     (with-meta
+       (fn
+         ([a]
+          (mobj :inc labels)
+          (origf a))
+         ([a b]
+          (mobj :inc labels)
+          (origf a b))
+         ([a b & more]
+          (mobj :inc labels)
+          (apply origf a b more)))
+       (assoc mdata ::original origf)))))
 
-(defn instrument-with-counter!
-  [{:keys [var] :as props}]
-  (let [cnt  (counter props)
-        vars (if (var? var) [var] var)]
-    (doseq [var vars]
-      (alter-var-root var (fn [root]
-                            (let [mdata (meta root)
-                                  original (::counter-original mdata root)]
-                              (with-meta
-                                (cnt :wrap original)
-                                (assoc mdata ::counter-original original))))))))
+(defn wrap-summary
+  ([rootf mobj]
+   (let [mdata  (meta rootf)
+         origf  (::original mdata rootf)]
+     (with-meta
+       (fn
+         ([a]
+         (with-measure
+           :expr (origf a)
+           :cb   #(mobj :observe %)))
+         ([a b]
+          (with-measure
+            :expr (origf a b)
+            :cb   #(mobj :observe %)))
+         ([a b & more]
+          (with-measure
+            :expr (apply origf a b more)
+            :cb   #(mobj :observe %))))
+       (assoc mdata ::original origf))))
 
-(defn instrument-with-summary!
-  [{:keys [var] :as props}]
-  (let [sm (summary props)]
-    (alter-var-root var (fn [root]
-                          (let [mdata (meta root)
-                                original (::summary-original mdata root)]
-                            (with-meta
-                              (sm :wrap original)
-                              (assoc mdata ::summary-original original)))))))
+  ([rootf mobj labels]
+   (let [mdata  (meta rootf)
+         labels (into-array String labels)
+         origf  (::original mdata rootf)]
+     (with-meta
+       (fn
+         ([a]
+         (with-measure
+           :expr (origf a)
+           :cb   #(mobj :observe % labels)))
+         ([a b]
+          (with-measure
+            :expr (origf a b)
+            :cb   #(mobj :observe % labels)))
+         ([a b & more]
+          (with-measure
+            :expr (apply origf a b more)
+            :cb   #(mobj :observe % labels))))
+       (assoc mdata ::original origf)))))
 
-(defn dump
-  [& _args]
-  (let [samples (.metricFamilySamples ^CollectorRegistry registry)
-        writer  (StringWriter.)]
-    (TextFormat/write004 writer samples)
-    {:headers {"content-type" TextFormat/CONTENT_TYPE_004}
-     :body (.toString writer)}))
+(defn instrument-vars!
+  [vars {:keys [wrap] :as props}]
+  (let [obj (create props)]
+    (cond
+      (instance? Counter @obj)
+      (doseq [var vars]
+        (alter-var-root var (or wrap wrap-counter) obj))
+
+      (instance? Summary @obj)
+      (doseq [var vars]
+        (alter-var-root var (or wrap wrap-summary) obj))
+
+      :else
+      (ex/raise :type :not-implemented))))
+
+(defn instrument
+  [f {:keys [wrap] :as props}]
+  (let [obj (create props)]
+    (cond
+      (instance? Counter @obj)
+      ((or wrap wrap-counter) f obj)
+
+      (instance? Summary @obj)
+      ((or wrap wrap-summary) f obj)
+
+      :else
+      (ex/raise :type :not-implemented))))
+
+(defn instrument-jetty!
+  [^CollectorRegistry registry ^StatisticsHandler handler]
+  (doto (JettyStatisticsCollector. handler)
+    (.register registry))
+  nil)
 

backend/src/app/migrations.clj

@@ -9,126 +9,146 @@
 
 (ns app.migrations
   (:require
-   [app.db :as db]
    [app.migrations.migration-0023 :as mg0023]
    [app.util.migrations :as mg]
-   [mount.core :as mount :refer [defstate]]))
+   [integrant.core :as ig]))
 
-(def +migrations+
-  {:name "uxbox-main"
-   :steps
-   [{:name "0001-add-extensions"
-     :fn (mg/resource "app/migrations/sql/0001-add-extensions.sql")}
+(def migrations
+  [{:name "0001-add-extensions"
+    :fn (mg/resource "app/migrations/sql/0001-add-extensions.sql")}
 
-    {:name "0002-add-profile-tables"
-     :fn (mg/resource "app/migrations/sql/0002-add-profile-tables.sql")}
+   {:name "0002-add-profile-tables"
+    :fn (mg/resource "app/migrations/sql/0002-add-profile-tables.sql")}
 
-    {:name "0003-add-project-tables"
-     :fn (mg/resource "app/migrations/sql/0003-add-project-tables.sql")}
+   {:name "0003-add-project-tables"
+    :fn (mg/resource "app/migrations/sql/0003-add-project-tables.sql")}
 
-    {:name "0004-add-tasks-tables"
-     :fn (mg/resource "app/migrations/sql/0004-add-tasks-tables.sql")}
+   {:name "0004-add-tasks-tables"
+    :fn (mg/resource "app/migrations/sql/0004-add-tasks-tables.sql")}
 
-    {:name "0005-add-libraries-tables"
-     :fn (mg/resource "app/migrations/sql/0005-add-libraries-tables.sql")}
+   {:name "0005-add-libraries-tables"
+    :fn (mg/resource "app/migrations/sql/0005-add-libraries-tables.sql")}
 
-    {:name "0006-add-presence-tables"
-     :fn (mg/resource "app/migrations/sql/0006-add-presence-tables.sql")}
+   {:name "0006-add-presence-tables"
+    :fn (mg/resource "app/migrations/sql/0006-add-presence-tables.sql")}
 
-    {:name "0007-drop-version-field-from-page-table"
-     :fn (mg/resource "app/migrations/sql/0007-drop-version-field-from-page-table.sql")}
+   {:name "0007-drop-version-field-from-page-table"
+    :fn (mg/resource "app/migrations/sql/0007-drop-version-field-from-page-table.sql")}
 
-    {:name "0008-add-generic-token-table"
-     :fn (mg/resource "app/migrations/sql/0008-add-generic-token-table.sql")}
+   {:name "0008-add-generic-token-table"
+    :fn (mg/resource "app/migrations/sql/0008-add-generic-token-table.sql")}
 
-    {:name "0009-drop-profile-email-table"
-     :fn (mg/resource "app/migrations/sql/0009-drop-profile-email-table.sql")}
+   {:name "0009-drop-profile-email-table"
+    :fn (mg/resource "app/migrations/sql/0009-drop-profile-email-table.sql")}
 
-    {:name "0010-add-http-session-table"
-     :fn (mg/resource "app/migrations/sql/0010-add-http-session-table.sql")}
+   {:name "0010-add-http-session-table"
+    :fn (mg/resource "app/migrations/sql/0010-add-http-session-table.sql")}
 
-    {:name "0011-add-session-id-field-to-page-change-table"
-     :fn (mg/resource "app/migrations/sql/0011-add-session-id-field-to-page-change-table.sql")}
+   {:name "0011-add-session-id-field-to-page-change-table"
+    :fn (mg/resource "app/migrations/sql/0011-add-session-id-field-to-page-change-table.sql")}
 
-    {:name "0012-make-libraries-linked-to-a-file"
-     :fn (mg/resource "app/migrations/sql/0012-make-libraries-linked-to-a-file.sql")}
+   {:name "0012-make-libraries-linked-to-a-file"
+    :fn (mg/resource "app/migrations/sql/0012-make-libraries-linked-to-a-file.sql")}
 
-    {:name "0013-mark-files-shareable"
-     :fn (mg/resource "app/migrations/sql/0013-mark-files-shareable.sql")}
+   {:name "0013-mark-files-shareable"
+    :fn (mg/resource "app/migrations/sql/0013-mark-files-shareable.sql")}
 
-    {:name "0014-refactor-media-storage.sql"
-     :fn (mg/resource "app/migrations/sql/0014-refactor-media-storage.sql")}
+   {:name "0014-refactor-media-storage.sql"
+    :fn (mg/resource "app/migrations/sql/0014-refactor-media-storage.sql")}
 
-    {:name "0015-improve-tasks-tables"
-     :fn (mg/resource "app/migrations/sql/0015-improve-tasks-tables.sql")}
+   {:name "0015-improve-tasks-tables"
+    :fn (mg/resource "app/migrations/sql/0015-improve-tasks-tables.sql")}
 
-    {:name "0016-truncate-and-alter-tokens-table"
-     :fn (mg/resource "app/migrations/sql/0016-truncate-and-alter-tokens-table.sql")}
+   {:name "0016-truncate-and-alter-tokens-table"
+    :fn (mg/resource "app/migrations/sql/0016-truncate-and-alter-tokens-table.sql")}
 
-    {:name "0017-link-files-to-libraries"
-     :fn (mg/resource "app/migrations/sql/0017-link-files-to-libraries.sql")}
+   {:name "0017-link-files-to-libraries"
+    :fn (mg/resource "app/migrations/sql/0017-link-files-to-libraries.sql")}
 
-    {:name "0018-add-file-trimming-triggers"
-     :fn (mg/resource "app/migrations/sql/0018-add-file-trimming-triggers.sql")}
+   {:name "0018-add-file-trimming-triggers"
+    :fn (mg/resource "app/migrations/sql/0018-add-file-trimming-triggers.sql")}
 
-    {:name "0019-add-improved-scheduled-tasks"
-     :fn (mg/resource "app/migrations/sql/0019-add-improved-scheduled-tasks.sql")}
+   {:name "0019-add-improved-scheduled-tasks"
+    :fn (mg/resource "app/migrations/sql/0019-add-improved-scheduled-tasks.sql")}
 
-    {:name "0020-minor-fixes-to-media-object"
-     :fn (mg/resource "app/migrations/sql/0020-minor-fixes-to-media-object.sql")}
+   {:name "0020-minor-fixes-to-media-object"
+    :fn (mg/resource "app/migrations/sql/0020-minor-fixes-to-media-object.sql")}
 
-    {:name "0021-http-session-improvements"
-     :fn (mg/resource "app/migrations/sql/0021-http-session-improvements.sql")}
+   {:name "0021-http-session-improvements"
+    :fn (mg/resource "app/migrations/sql/0021-http-session-improvements.sql")}
 
-    {:name "0022-page-file-refactor"
-     :fn (mg/resource "app/migrations/sql/0022-page-file-refactor.sql")}
+   {:name "0022-page-file-refactor"
+    :fn (mg/resource "app/migrations/sql/0022-page-file-refactor.sql")}
 
-    {:name "0023-adapt-old-pages-and-files"
-     :fn mg0023/migrate}
+   {:name "0023-adapt-old-pages-and-files"
+    :fn mg0023/migrate}
 
-    {:name "0024-mod-profile-table"
-     :fn (mg/resource "app/migrations/sql/0024-mod-profile-table.sql")}
+   {:name "0024-mod-profile-table"
+    :fn (mg/resource "app/migrations/sql/0024-mod-profile-table.sql")}
 
-    {:name "0025-del-generic-tokens-table"
-     :fn (mg/resource "app/migrations/sql/0025-del-generic-tokens-table.sql")}
+   {:name "0025-del-generic-tokens-table"
+    :fn (mg/resource "app/migrations/sql/0025-del-generic-tokens-table.sql")}
 
-    {:name "0026-mod-file-library-rel-table-synced-date"
-     :fn (mg/resource "app/migrations/sql/0026-mod-file-library-rel-table-synced-date.sql")}
+   {:name "0026-mod-file-library-rel-table-synced-date"
+    :fn (mg/resource "app/migrations/sql/0026-mod-file-library-rel-table-synced-date.sql")}
 
-    {:name "0027-mod-file-table-ignore-sync"
-     :fn (mg/resource "app/migrations/sql/0027-mod-file-table-ignore-sync.sql")}
+   {:name "0027-mod-file-table-ignore-sync"
+    :fn (mg/resource "app/migrations/sql/0027-mod-file-table-ignore-sync.sql")}
 
-    {:name "0028-add-team-project-profile-rel-table"
-     :fn (mg/resource "app/migrations/sql/0028-add-team-project-profile-rel-table.sql")}
+   {:name "0028-add-team-project-profile-rel-table"
+    :fn (mg/resource "app/migrations/sql/0028-add-team-project-profile-rel-table.sql")}
 
-    {:name "0029-del-project-profile-rel-indexes"
-     :fn (mg/resource "app/migrations/sql/0029-del-project-profile-rel-indexes.sql")}
+   {:name "0029-del-project-profile-rel-indexes"
+    :fn (mg/resource "app/migrations/sql/0029-del-project-profile-rel-indexes.sql")}
 
-    {:name "0030-mod-file-table-add-missing-index"
-     :fn (mg/resource "app/migrations/sql/0030-mod-file-table-add-missing-index.sql")}
+   {:name "0030-mod-file-table-add-missing-index"
+    :fn (mg/resource "app/migrations/sql/0030-mod-file-table-add-missing-index.sql")}
 
-    {:name "0031-add-conversation-related-tables"
-     :fn (mg/resource "app/migrations/sql/0031-add-conversation-related-tables.sql")}
+   {:name "0031-add-conversation-related-tables"
+    :fn (mg/resource "app/migrations/sql/0031-add-conversation-related-tables.sql")}
 
-    {:name "0032-del-unused-tables"
-     :fn (mg/resource "app/migrations/sql/0032-del-unused-tables.sql")}
+   {:name "0032-del-unused-tables"
+    :fn (mg/resource "app/migrations/sql/0032-del-unused-tables.sql")}
 
-    {:name "0033-mod-comment-thread-table"
-     :fn (mg/resource "app/migrations/sql/0033-mod-comment-thread-table.sql")}
+   {:name "0033-mod-comment-thread-table"
+    :fn (mg/resource "app/migrations/sql/0033-mod-comment-thread-table.sql")}
 
-    {:name "0034-mod-profile-table-add-props-field"
-     :fn (mg/resource "app/migrations/sql/0034-mod-profile-table-add-props-field.sql")}
-    ]})
+   {:name "0034-mod-profile-table-add-props-field"
+    :fn (mg/resource "app/migrations/sql/0034-mod-profile-table-add-props-field.sql")}
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Entry point
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+   {:name "0035-add-storage-tables"
+    :fn (mg/resource "app/migrations/sql/0035-add-storage-tables.sql")}
 
-(defn migrate
-  []
-  (with-open [conn (db/open)]
-    (mg/setup! conn)
-    (mg/migrate! conn +migrations+)))
+   {:name "0036-mod-storage-referenced-tables"
+    :fn (mg/resource "app/migrations/sql/0036-mod-storage-referenced-tables.sql")}
 
-(defstate migrations
-  :start (migrate))
+   {:name "0037-del-obsolete-triggers"
+    :fn (mg/resource "app/migrations/sql/0037-del-obsolete-triggers.sql")}
+
+   {:name "0038-add-storage-on-delete-triggers"
+    :fn (mg/resource "app/migrations/sql/0038-add-storage-on-delete-triggers.sql")}
+
+   {:name "0039-fix-some-on-delete-triggers"
+    :fn (mg/resource "app/migrations/sql/0039-fix-some-on-delete-triggers.sql")}
+
+   {:name "0040-add-error-report-tables"
+    :fn (mg/resource "app/migrations/sql/0040-add-error-report-tables.sql")}
+
+   {:name "0041-mod-pg-storage-options"
+    :fn (mg/resource "app/migrations/sql/0041-mod-pg-storage-options.sql")}
+
+   {:name "0042-add-server-prop-table"
+    :fn (mg/resource "app/migrations/sql/0042-add-server-prop-table.sql")}
+
+   {:name "0043-drop-old-tables-and-fields"
+    :fn (mg/resource "app/migrations/sql/0043-drop-old-tables-and-fields.sql")}
+
+   {:name "0044-add-storage-refcount"
+    :fn (mg/resource "app/migrations/sql/0044-add-storage-refcount.sql")}
+
+   {:name "0045-add-index-to-file-change-table"
+    :fn (mg/resource "app/migrations/sql/0045-add-index-to-file-change-table.sql")}
+   ])
+
+
+(defmethod ig/init-key ::migrations [_ _] migrations)

backend/src/app/migrations/sql/0001-add-extensions.sql

@@ -1,5 +1,4 @@
 CREATE EXTENSION IF NOT EXISTS "uuid-ossp";
-CREATE EXTENSION IF NOT EXISTS "pgcrypto";
 
 CREATE FUNCTION update_modified_at()
   RETURNS TRIGGER AS $updt$

backend/src/app/migrations/sql/0003-add-project-tables.sql

@@ -106,8 +106,6 @@ CREATE TRIGGER file_image__on_delete__tgr
  AFTER DELETE ON file_image
    FOR EACH ROW EXECUTE PROCEDURE handle_delete();
 
-
-
 CREATE TABLE page (
   id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
   file_id uuid NOT NULL REFERENCES file(id) ON DELETE CASCADE,

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

@@ -0,0 +1,35 @@
+CREATE TABLE storage_object (
+  id uuid PRIMARY KEY DEFAULT uuid_generate_v4(),
+
+  created_at timestamptz NOT NULL DEFAULT now(),
+  deleted_at timestamptz NULL DEFAULT NULL,
+
+  size bigint NOT NULL DEFAULT 0,
+  backend text NOT NULL,
+
+  metadata jsonb NULL DEFAULT NULL
+);
+
+CREATE TABLE storage_data (
+  id uuid PRIMARY KEY REFERENCES storage_object (id) ON DELETE CASCADE,
+  data bytea NOT NULL
+);
+
+-- Table used for store inflight upload ids, for later recheck and
+-- delete possible staled files that exists on the phisical storage
+-- but does not exists in the 'storage_object' table.
+
+CREATE TABLE storage_pending (
+  id uuid NOT NULL,
+
+  backend text NOT NULL,
+  created_at timestamptz NOT NULL DEFAULT now(),
+
+  PRIMARY KEY (created_at, id)
+);
+
+CREATE INDEX storage_data__id__idx ON storage_data(id);
+CREATE INDEX storage_object__id__deleted_at__idx
+    ON storage_object(id, deleted_at)
+ WHERE deleted_at IS NOT null;
+

backend/src/app/migrations/sql/0036-mod-storage-referenced-tables.sql

@@ -0,0 +1,22 @@
+-- Profile
+ALTER TABLE profile ADD COLUMN photo_id uuid NULL REFERENCES storage_object(id) ON DELETE SET NULL;
+CREATE INDEX profile__photo_id__idx ON profile(photo_id);
+
+-- Team
+ALTER TABLE team ADD COLUMN photo_id uuid NULL REFERENCES storage_object(id) ON DELETE SET NULL;
+CREATE INDEX team__photo_id__idx ON team(photo_id);
+
+-- Media Objects -> File Media Objects
+ALTER TABLE media_object RENAME TO file_media_object;
+ALTER TABLE media_thumbnail RENAME TO file_media_thumbnail;
+
+ALTER TABLE file_media_object
+  ADD COLUMN media_id uuid NULL REFERENCES storage_object(id) ON DELETE CASCADE,
+  ADD COLUMN thumbnail_id uuid NULL REFERENCES storage_object(id) ON DELETE CASCADE;
+
+CREATE INDEX file_media_object__image_id__idx ON file_media_object(media_id);
+CREATE INDEX file_media_object__thumbnail_id__idx ON file_media_object(thumbnail_id);
+
+ALTER TABLE file_media_object ALTER COLUMN path DROP NOT NULL;
+ALTER TABLE profile ALTER COLUMN photo DROP NOT NULL;
+ALTER TABLE team ALTER COLUMN photo DROP NOT NULL;

backend/src/app/migrations/sql/0037-del-obsolete-triggers.sql

@@ -0,0 +1,3 @@
+DROP FUNCTION update_modified_at () CASCADE;
+DROP FUNCTION handle_delete ( ) CASCADE;
+DROP TABLE pending_to_delete;

backend/src/app/migrations/sql/0038-add-storage-on-delete-triggers.sql

@@ -0,0 +1,50 @@
+CREATE FUNCTION on_delete_profile()
+  RETURNS TRIGGER AS $func$
+  BEGIN
+    UPDATE storage_object
+       SET deleted_at = now()
+     WHERE id = OLD.photo_id;
+
+    RETURN OLD;
+  END;
+$func$ LANGUAGE plpgsql;
+
+CREATE FUNCTION on_delete_team()
+  RETURNS TRIGGER AS $func$
+  BEGIN
+    UPDATE storage_object
+       SET deleted_at = now()
+     WHERE id = OLD.photo_id;
+
+    RETURN OLD;
+  END;
+$func$ LANGUAGE plpgsql;
+
+CREATE FUNCTION on_delete_file_media_object()
+  RETURNS TRIGGER AS $func$
+  BEGIN
+    UPDATE storage_object
+       SET deleted_at = now()
+     WHERE id = OLD.media_id;
+
+    IF OLD.thumbnail_id IS NOT NULL THEN
+      UPDATE storage_object
+         SET deleted_at = now()
+       WHERE id = OLD.thumbnail_id;
+    END IF;
+
+    RETURN OLD;
+  END;
+$func$ LANGUAGE plpgsql;
+
+CREATE TRIGGER profile__on_delete__tgr
+ AFTER DELETE ON profile
+   FOR EACH ROW EXECUTE PROCEDURE on_delete_profile();
+
+CREATE TRIGGER team__on_delete__tgr
+ AFTER DELETE ON team
+   FOR EACH ROW EXECUTE PROCEDURE on_delete_team();
+
+CREATE TRIGGER file_media_object__on_delete__tgr
+ AFTER DELETE ON file_media_object
+   FOR EACH ROW EXECUTE PROCEDURE on_delete_file_media_object();

backend/src/app/migrations/sql/0039-fix-some-on-delete-triggers.sql

@@ -0,0 +1,9 @@
+ALTER TABLE file_library_rel
+ DROP CONSTRAINT file_library_rel_library_file_id_fkey,
+  ADD CONSTRAINT file_library_rel_library_file_id_fkey
+      FOREIGN KEY (library_file_id) REFERENCES file(id) ON DELETE CASCADE;
+
+ALTER TABLE team_profile_rel
+ DROP CONSTRAINT team_profile_rel_profile_id_fkey,
+  ADD CONSTRAINT team_profile_rel_profile_id_fkey
+      FOREIGN KEY (profile_id) REFERENCES profile(id) ON DELETE CASCADE;

backend/src/app/migrations/sql/0040-add-error-report-tables.sql

@@ -0,0 +1,10 @@
+CREATE TABLE server_error_report (
+  id uuid NOT NULL,
+  created_at timestamptz NOT NULL DEFAULT clock_timestamp(),
+  content jsonb,
+
+  PRIMARY KEY (id, created_at)
+);
+
+ALTER TABLE server_error_report
+  ALTER COLUMN content SET STORAGE external;

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

@@ -0,0 +1,57 @@
+ALTER TABLE file
+  ALTER COLUMN data SET STORAGE external,
+  ALTER COLUMN name SET STORAGE external;
+
+ALTER TABLE file_change
+  ALTER COLUMN data SET STORAGE external,
+  ALTER COLUMN changes SET STORAGE external;
+
+ALTER TABLE profile
+  ALTER COLUMN fullname SET STORAGE external,
+  ALTER COLUMN email SET STORAGE external,
+  ALTER COLUMN password SET STORAGE external,
+  ALTER COLUMN lang SET STORAGE external,
+  ALTER COLUMN theme SET STORAGE external,
+  ALTER COLUMN props SET STORAGE external;
+
+ALTER TABLE project
+  ALTER COLUMN name SET STORAGE external;
+
+ALTER TABLE team
+  ALTER COLUMN name SET STORAGE external;
+
+ALTER TABLE comment
+  ALTER COLUMN content SET STORAGE external;
+
+ALTER TABLE comment_thread
+  ALTER COLUMN participants SET STORAGE external,
+  ALTER COLUMN page_name SET STORAGE external;
+
+ALTER TABLE task
+  ALTER COLUMN queue SET STORAGE external,
+  ALTER COLUMN name SET STORAGE external,
+  ALTER COLUMN props SET STORAGE external,
+  ALTER COLUMN status SET STORAGE external,
+  ALTER COLUMN error SET STORAGE external;
+
+ALTER TABLE scheduled_task
+  ALTER COLUMN id SET STORAGE external,
+  ALTER COLUMN cron_expr SET STORAGE external;
+
+ALTER TABLE http_session
+  ALTER COLUMN id SET STORAGE external,
+  ALTER COLUMN user_agent SET STORAGE external;
+
+ALTER TABLE file_share_token
+  ALTER COLUMN token SET STORAGE external;
+
+ALTER TABLE file_media_object
+  ALTER COLUMN name SET STORAGE external,
+  ALTER COLUMN mtype SET STORAGE external;
+
+ALTER TABLE storage_object
+  ALTER COLUMN backend SET STORAGE external,
+  ALTER COLUMN metadata SET STORAGE external;
+
+ALTER TABLE storage_data
+  ALTER COLUMN data SET STORAGE external;

backend/src/app/migrations/sql/0042-add-server-prop-table.sql

@@ -0,0 +1,8 @@
+CREATE TABLE server_prop (
+  id text PRIMARY KEY,
+  content jsonb
+);
+
+ALTER TABLE server_prop
+  ALTER COLUMN id SET STORAGE external,
+  ALTER COLUMN content SET STORAGE external;

backend/src/app/migrations/sql/0043-drop-old-tables-and-fields.sql

@@ -0,0 +1,10 @@
+DROP TABLE IF EXISTS file_media_thumbnail;
+
+ALTER TABLE profile DROP COLUMN photo;
+ALTER TABLE team DROP COLUMN photo;
+
+ALTER TABLE file_media_object DROP COLUMN path;
+ALTER TABLE file_media_object ALTER COLUMN media_id SET NOT NULL;
+
+ALTER TRIGGER media_object__insert__tgr
+   ON file_media_object RENAME TO file_media_object__on_insert__tgr;

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

@@ -0,0 +1,26 @@
+ALTER TABLE storage_object
+  ADD COLUMN touched_at timestamptz NULL;
+
+CREATE INDEX storage_object__id_touched_at__idx
+    ON storage_object (touched_at, id)
+ WHERE touched_at IS NOT NULL;
+
+-- DROP TRIGGER file_media_object__on_delete__tgr ON file_media_object CASCADE;
+-- DROP FUNCTION on_delete_file_media_object () ;
+
+CREATE OR REPLACE FUNCTION on_delete_file_media_object()
+  RETURNS TRIGGER AS $func$
+  BEGIN
+    IF OLD.thumbnail_id IS NOT NULL THEN
+      UPDATE storage_object
+         SET touched_at = now()
+       WHERE id in (OLD.thumbnail_id, OLD.media_id);
+    ELSE
+      UPDATE storage_object
+         SET touched_at = now()
+       WHERE id = OLD.media_id;
+    END IF;
+    RETURN OLD;
+  END;
+$func$ LANGUAGE plpgsql;
+

backend/src/app/migrations/sql/0045-add-index-to-file-change-table.sql

@@ -0,0 +1,2 @@
+CREATE INDEX file_change__created_at_idx
+    ON file_change (created_at);

backend/src/app/migrations/sql/XXXX-drop-obsolete-tables.sql

@@ -0,0 +1,9 @@
+--- This is a second migration but it should be applied when manual
+--- migration intervention is alteady executed.
+
+ALTER TABLE file_media_object ALTER COLUMN media_id SET NOT NULL;
+DROP TABLE file_media_thumbnail;
+
+ALTER TABLE team DROP COLUMN photo;
+ALTER TABLE profile DROP COLUMN photo;
+ALTER TABLE file_media_object DROP COLUMN path;

backend/src/app/notifications.clj

@@ -0,0 +1,303 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; This Source Code Form is "Incompatible With Secondary Licenses", as
+;; defined by the Mozilla Public License, v. 2.0.
+;;
+;; Copyright (c) 2020-2021 UXBOX Labs SL
+
+(ns app.notifications
+  "A websocket based notifications mechanism."
+  (:require
+   [app.common.spec :as us]
+   [app.db :as db]
+   [app.metrics :as mtx]
+   [app.redis :as rd]
+   [app.util.async :as aa]
+   [app.util.transit :as t]
+   [clojure.core.async :as a]
+   [clojure.spec.alpha :as s]
+   [clojure.tools.logging :as log]
+   [integrant.core :as ig]
+   [ring.adapter.jetty9 :as jetty]
+   [ring.middleware.cookies :refer [wrap-cookies]]
+   [ring.middleware.keyword-params :refer [wrap-keyword-params]]
+   [ring.middleware.params :refer [wrap-params]]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Http Handler
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare retrieve-file)
+(declare websocket)
+(declare handler)
+
+(s/def ::session map?)
+
+(defmethod ig/pre-init-spec ::handler [_]
+  (s/keys :req-un [::rd/redis ::db/pool ::session ::mtx/metrics]))
+
+(defmethod ig/init-key ::handler
+  [_ {:keys [session metrics] :as cfg}]
+  (let [wrap-session    (:middleware session)
+
+        mtx-active-connections
+        (mtx/create
+         {:name "websocket_notifications_active_connections"
+          :registry (:registry metrics)
+          :type :gauge
+          :help "Active websocket connections on notifications service."})
+
+        mtx-message-recv
+        (mtx/create
+         {:name "websocket_notifications_message_recv_timing"
+          :registry (:registry metrics)
+          :type :summary
+          :help "Message receive summary timing (ms)."})
+
+        mtx-message-send
+        (mtx/create
+         {:name "websocket_notifications_message_send_timing"
+          :registry (:registry metrics)
+          :type :summary
+          :help "Message receive summary timing (ms)."})
+
+        cfg (assoc cfg
+                   :mtx-active-connections mtx-active-connections
+                   :mtx-message-recv mtx-message-recv
+                   :mtx-message-send mtx-message-send)]
+    (-> #(handler cfg %)
+        (wrap-session)
+        (wrap-keyword-params)
+        (wrap-cookies)
+        (wrap-params))))
+
+(s/def ::file-id ::us/uuid)
+(s/def ::session-id ::us/uuid)
+
+(s/def ::websocket-handler-params
+  (s/keys :req-un [::file-id ::session-id]))
+
+(defn- handler
+  [{:keys [pool] :as cfg} {:keys [profile-id params] :as req}]
+  (let [params (us/conform ::websocket-handler-params params)
+        file   (retrieve-file pool (:file-id params))
+        cfg    (merge cfg params
+                      {:profile-id profile-id
+                       :team-id (:team-id file)})]
+    (cond
+      (not profile-id)
+      {:error {:code 403 :message "Authentication required"}}
+
+      (not file)
+      {:error {:code 404 :message "File does not exists"}}
+
+      :else
+      (websocket cfg))))
+
+(def ^:private
+  sql:retrieve-file
+  "select f.id as id,
+          p.team_id as team_id
+     from file as f
+     join project as p on (p.id = f.project_id)
+    where f.id = ?")
+
+(defn- retrieve-file
+  [conn id]
+  (db/exec-one! conn [sql:retrieve-file id]))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; WebSocket Http Handler
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare handle-connect)
+
+(defrecord WebSocket [conn in out sub])
+
+(defn- ws-send
+  [conn data]
+  (try
+    (when (jetty/connected? conn)
+      (jetty/send! conn data)
+      true)
+    (catch java.lang.NullPointerException _e
+      false)))
+
+(defn websocket
+  [{:keys [file-id team-id redis] :as cfg}]
+  (let [in  (a/chan 32)
+        out (a/chan 32)
+        mtx-active-connections (:mtx-active-connections cfg)
+        mtx-message-send       (:mtx-message-send cfg)
+        mtx-message-recv       (:mtx-message-recv cfg)
+
+        ws-send (mtx/wrap-summary ws-send mtx-message-send)]
+
+    (letfn [(on-connect [conn]
+              (mtx-active-connections :inc)
+              (let [sub (rd/subscribe redis {:xform (map t/decode-str)
+                                             :topics [file-id team-id]})
+                    ws  (WebSocket. conn in out sub nil cfg)]
+
+                ;; message forwarding loop
+                (a/go-loop []
+                  (let [val (a/<! out)]
+                    (when-not (nil? val)
+                      (when (ws-send conn (t/encode-str val))
+                        (recur)))))
+
+                (a/go
+                  (a/<! (handle-connect ws))
+                  (a/close! sub))))
+
+            (on-error [_conn _e]
+              (a/close! out)
+              (a/close! in))
+
+            (on-close [_conn _status _reason]
+              (mtx-active-connections :dec)
+              (a/close! out)
+              (a/close! in))
+
+            (on-message [_ws message]
+              (let [message (t/decode-str message)]
+                (a/>!! in message)))]
+
+      {:on-connect on-connect
+       :on-error on-error
+       :on-close on-close
+       :on-text (mtx/wrap-summary on-message mtx-message-recv)
+       :on-bytes (constantly nil)})))
+
+(declare handle-message)
+(declare start-loop!)
+
+(defn- handle-connect
+  [{:keys [conn] :as ws}]
+  (a/go
+    (try
+      (aa/<? (handle-message ws {:type :connect}))
+      (aa/<? (start-loop! ws))
+      (aa/<? (handle-message ws {:type :disconnect}))
+      (catch Throwable err
+        (log/errorf err "Unexpected exception on websocket handler.")
+        (let [session (.getSession conn)]
+          (when session
+            (.disconnect session)))))))
+
+(defn- start-loop!
+  [{:keys [in out sub session-id] :as ws}]
+  (aa/go-try
+   (loop []
+     (let [timeout (a/timeout 30000)
+           [val port] (a/alts! [in sub timeout])]
+
+       ;; (prn "alts" val "from" (cond (= port in)  "input"
+       ;;                              (= port sub) "redis"
+       ;;                              :else "timeout"))
+
+       (cond
+         ;; Process message coming from connected client
+         (and (= port in) (not (nil? val)))
+         (do
+           (aa/<? (handle-message ws val))
+           (recur))
+
+         ;; Forward message to the websocket
+         (and (= port sub) (not (nil? val)))
+         (do
+           (when-not (= (:session-id val) session-id)
+             (a/>! out val))
+           (recur))
+
+         ;; Timeout channel signaling
+         (= port timeout)
+         (do
+           (a/>! out {:type :ping})
+           (recur))
+
+         :else
+         nil)))))
+
+;; Incoming Messages Handling
+
+(defn- publish
+  [redis channel message]
+  (aa/go-try
+   (let [message (t/encode-str message)]
+     (aa/<? (rd/run redis :publish {:channel (str channel)
+                                         :message message})))))
+
+(def ^:private
+  sql:retrieve-presence
+  "select * from presence
+    where file_id=?
+      and (clock_timestamp() - updated_at) < '5 min'::interval")
+
+(defn- retrieve-presence
+  [pool file-id]
+  (aa/thread-try
+   (let [rows (db/exec! pool [sql:retrieve-presence file-id])]
+     (mapv (juxt :session-id :profile-id) rows))))
+
+(def ^:private
+  sql:update-presence
+  "insert into presence (file_id, session_id, profile_id, updated_at)
+   values (?, ?, ?, clock_timestamp())
+       on conflict (file_id, session_id, profile_id)
+       do update set updated_at=clock_timestamp()")
+
+(defn- update-presence
+  [conn file-id session-id profile-id]
+  (aa/thread-try
+   (let [sql [sql:update-presence file-id session-id profile-id]]
+     (db/exec-one! conn sql))))
+
+(defn- delete-presence
+  [pool file-id session-id profile-id]
+  (aa/thread-try
+   (db/delete! pool :presence {:file-id file-id
+                               :profile-id profile-id
+                               :session-id session-id})))
+
+(defmulti handle-message
+  (fn [_ message] (:type message)))
+
+;; TODO: check permissions for join a file-id channel (probably using
+;; single use token for avoid explicit database query).
+
+(defmethod handle-message :connect
+  [{:keys [file-id profile-id session-id pool redis] :as ws} _message]
+  ;; (log/debugf "profile '%s' is connected to file '%s'" profile-id file-id)
+  (aa/go-try
+   (aa/<? (update-presence pool file-id session-id profile-id))
+   (let [members (aa/<? (retrieve-presence pool file-id))]
+     (aa/<? (publish redis file-id {:type :presence :sessions members})))))
+
+(defmethod handle-message :disconnect
+  [{:keys [profile-id file-id session-id redis pool] :as ws} _message]
+  ;; (log/debugf "profile '%s' is disconnected from '%s'" profile-id file-id)
+  (aa/go-try
+   (aa/<? (delete-presence pool file-id session-id profile-id))
+   (let [members (aa/<? (retrieve-presence pool file-id))]
+     (aa/<? (publish redis file-id {:type :presence :sessions members})))))
+
+(defmethod handle-message :keepalive
+  [{:keys [profile-id file-id session-id pool] :as ws} _message]
+  (update-presence pool file-id session-id profile-id))
+
+(defmethod handle-message :pointer-update
+  [{:keys [profile-id file-id session-id redis] :as ws} message]
+  (let [message (assoc message
+                       :profile-id profile-id
+                       :session-id session-id)]
+    (publish redis file-id message)))
+
+(defmethod handle-message :default
+  [_ws message]
+  (a/go
+    (log/warnf "received unexpected message: %s" message)))
+

backend/src/app/redis.clj

@@ -7,41 +7,52 @@
 (ns app.redis
   (:refer-clojure :exclude [run!])
   (:require
-   [app.config :as cfg]
+   [app.common.spec :as us]
    [app.util.redis :as redis]
-   [mount.core :as mount :refer [defstate]])
+   [clojure.spec.alpha :as s]
+   [integrant.core :as ig])
   (:import
    java.lang.AutoCloseable))
 
-;; --- Connection Handling & State
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; State
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defn- create-client
-  [config]
-  (let [uri (:redis-uri config "redis://redis/0")]
-    (redis/client uri)))
+(defmethod ig/pre-init-spec ::redis [_]
+  (s/keys :req-un [::uri]))
 
-(declare client)
+(defmethod ig/init-key ::redis
+  [_ cfg]
+  (let [client (redis/client (:uri cfg "redis://redis/0"))
+        conn   (redis/connect client)]
+    {::client client
+     ::conn conn}))
 
-(defstate client
-  :start (create-client cfg/config)
-  :stop (.close ^AutoCloseable client))
+(defmethod ig/halt-key! ::redis
+  [_ {:keys [::client ::conn]}]
+  (.close ^AutoCloseable conn)
+  (.close ^AutoCloseable client))
 
-(declare conn)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; API
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defstate conn
-  :start (redis/connect client)
-  :stop (.close ^AutoCloseable conn))
-
-;; --- API FORWARD
+(s/def ::client some?)
+(s/def ::conn some?)
+(s/def ::redis (s/keys :req [::client ::conn]))
 
 (defn subscribe
-  [opts]
-  (redis/subscribe client opts))
+  [client opts]
+  (us/assert ::redis client)
+  (redis/subscribe (::client client) opts))
 
 (defn run!
-  [cmd params]
-  (redis/run! conn cmd params))
+  [client cmd params]
+  (us/assert ::redis client)
+  (redis/run! (::conn client) cmd params))
 
 (defn run
-  [cmd params]
-  (redis/run conn cmd params))
+  [client cmd params]
+  (us/assert ::redis client)
+  (redis/run (::conn client) cmd params))
+

backend/src/app/rlimits.clj

@@ -0,0 +1,47 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; This Source Code Form is "Incompatible With Secondary Licenses", as
+;; defined by the Mozilla Public License, v. 2.0.
+;;
+;; Copyright (c) 2020-2021 UXBOX Labs SL
+
+(ns app.rlimits
+  "Resource usage limits (in other words: semaphores)."
+  (:require
+   [app.common.spec :as us]
+   [clojure.spec.alpha :as s]
+   [integrant.core :as ig])
+  (:import
+   java.util.concurrent.Semaphore))
+
+(s/def ::rlimit  #(instance? Semaphore %))
+(s/def ::rlimits (s/map-of ::us/keyword ::rlimit))
+
+(derive ::password ::instance)
+(derive ::image ::instance)
+
+(defmethod ig/pre-init-spec ::instance [_]
+  (s/spec int?))
+
+(defmethod ig/init-key ::instance
+  [_ permits]
+  (Semaphore. (int permits)))
+
+(defn acquire!
+  [sem]
+  (.acquire ^Semaphore sem))
+
+(defn release!
+  [sem]
+  (.release ^Semaphore sem))
+
+(defmacro execute
+  [rlinst & body]
+  `(try
+     (acquire! ~rlinst)
+     ~@body
+     (finally
+       (release! ~rlinst))))
+

backend/src/app/rpc.clj

@@ -0,0 +1,147 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; This Source Code Form is "Incompatible With Secondary Licenses", as
+;; defined by the Mozilla Public License, v. 2.0.
+;;
+;; Copyright (c) 2020-2021 UXBOX Labs SL
+
+(ns app.rpc
+  (:require
+   [app.common.data :as d]
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.db :as db]
+   [app.metrics :as mtx]
+   [app.rlimits :as rlm]
+   [app.util.services :as sv]
+   [clojure.spec.alpha :as s]
+   [clojure.tools.logging :as log]
+   [cuerdas.core :as str]
+   [integrant.core :as ig]))
+
+(defn- default-handler
+  [_]
+  (ex/raise :type :not-found))
+
+(defn- rpc-query-handler
+  [methods {:keys [profile-id] :as request}]
+  (let [type   (keyword (get-in request [:path-params :type]))
+        data   (assoc (:params request) ::type type)
+        data   (if profile-id
+                 (assoc data :profile-id profile-id)
+                 (dissoc data :profile-id))
+        result ((get methods type default-handler) data)
+        mdata  (meta result)]
+
+    (cond->> {:status 200 :body result}
+      (fn? (:transform-response mdata)) ((:transform-response mdata) request))))
+
+(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   (if profile-id
+                 (assoc data :profile-id profile-id)
+                 (dissoc data :profile-id))
+        result ((get methods type default-handler) data)
+        mdata  (meta result)]
+    (cond->> {:status 200 :body result}
+      (fn? (:transform-response mdata)) ((:transform-response mdata) request))))
+
+(defn- wrap-with-metrics
+  [cfg f mdata]
+  (mtx/wrap-summary f (::mobj cfg) [(::sv/name mdata)]))
+
+;; Wrap the rpc handler with a semaphore if it is specified in the
+;; metadata asocciated with the handler.
+(defn- wrap-with-rlimits
+  [cfg f mdata]
+  (if-let [key (:rlimit mdata)]
+    (let [rlinst (get-in cfg [:rlimits key])]
+      (when-not rlinst
+        (ex/raise :type :internal
+                  :code :rlimit-not-configured
+                  :hint (str/fmt "%s rlimit not configured" key)))
+      (log/tracef "Adding rlimit to '%s' rpc handler." (::sv/name mdata))
+      (fn [cfg params]
+        (rlm/execute rlinst (f cfg params))))
+    f))
+
+(defn- wrap-impl
+  [cfg f mdata]
+  (let [f     (wrap-with-rlimits cfg f mdata)
+        f     (wrap-with-metrics cfg f mdata)
+        spec  (or (::sv/spec mdata) (s/spec any?))]
+    (log/tracef "Registering '%s' command to rpc service." (::sv/name mdata))
+    (fn [params]
+      (when (and (:auth mdata true) (not (uuid? (:profile-id params))))
+        (ex/raise :type :authentication
+                  :code :authentication-required
+                  :hint "authentication required for this endpoint"))
+      (f cfg (us/conform spec params)))))
+
+(defn- process-method
+  [cfg vfn]
+  (let [mdata (meta vfn)]
+    [(keyword (::sv/name mdata))
+     (wrap-impl cfg (deref vfn) mdata)]))
+
+(defn- resolve-query-methods
+  [cfg]
+  (let [mobj (mtx/create
+              {:name "rpc_query_timing"
+               :labels ["name"]
+               :registry (get-in cfg [:metrics :registry])
+               :type :summary
+               :help "Timing of query services."})
+        cfg  (assoc cfg ::mobj mobj)]
+    (->> (sv/scan-ns 'app.rpc.queries.projects
+                     'app.rpc.queries.files
+                     'app.rpc.queries.teams
+                     'app.rpc.queries.comments
+                     'app.rpc.queries.profile
+                     'app.rpc.queries.recent-files
+                     'app.rpc.queries.viewer)
+         (map (partial process-method cfg))
+         (into {}))))
+
+(defn- resolve-mutation-methods
+  [cfg]
+  (let [mobj (mtx/create
+              {:name "rpc_mutation_timing"
+               :labels ["name"]
+               :registry (get-in cfg [:metrics :registry])
+               :type :summary
+               :help "Timing of mutation services."})
+        cfg  (assoc cfg ::mobj mobj)]
+    (->> (sv/scan-ns 'app.rpc.mutations.demo
+                     'app.rpc.mutations.media
+                     'app.rpc.mutations.profile
+                     'app.rpc.mutations.files
+                     'app.rpc.mutations.comments
+                     'app.rpc.mutations.projects
+                     'app.rpc.mutations.viewer
+                     'app.rpc.mutations.teams
+                     'app.rpc.mutations.feedback
+                     'app.rpc.mutations.verify-token)
+         (map (partial process-method cfg))
+         (into {}))))
+
+(s/def ::storage some?)
+(s/def ::session map?)
+(s/def ::tokens fn?)
+
+(defmethod ig/pre-init-spec ::rpc [_]
+  (s/keys :req-un [::db/pool ::storage ::session ::tokens ::mtx/metrics ::rlm/rlimits]))
+
+(defmethod ig/init-key ::rpc
+  [_ cfg]
+  (let [mq (resolve-query-methods cfg)
+        mm (resolve-mutation-methods cfg)]
+    {:methods {:query mq :mutation mm}
+     :query-handler #(rpc-query-handler mq %)
+     :mutation-handler #(rpc-mutation-handler mm %)}))

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

@@ -7,15 +7,15 @@
 ;;
 ;; Copyright (c) 2020 UXBOX Labs SL
 
-(ns app.services.mutations.comments
+(ns app.rpc.mutations.comments
   (:require
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.db :as db]
-   [app.services.mutations :as sm]
-   [app.services.queries.comments :as comments]
-   [app.services.queries.files :as files]
+   [app.rpc.queries.comments :as comments]
+   [app.rpc.queries.files :as files]
    [app.util.blob :as blob]
+   [app.util.services :as sv]
    [app.util.time :as dt]
    [clojure.spec.alpha :as s]))
 
@@ -34,9 +34,9 @@
 (s/def ::create-comment-thread
   (s/keys :req-un [::profile-id ::file-id ::position ::content ::page-id]))
 
-(sm/defmutation ::create-comment-thread
-  [{:keys [profile-id file-id] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::create-comment-thread
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
+  (db/with-atomic [conn pool]
     (files/check-read-permissions! conn profile-id file-id)
     (create-comment-thread conn params)))
 
@@ -113,9 +113,9 @@
 (s/def ::update-comment-thread-status
   (s/keys :req-un [::profile-id ::id]))
 
-(sm/defmutation ::update-comment-thread-status
-  [{:keys [profile-id id] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::update-comment-thread-status
+  [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
+  (db/with-atomic [conn pool]
     (let [cthr (db/get-by-id conn :comment-thread id {:for-update true})]
       (when-not cthr
         (ex/raise :type :not-found))
@@ -141,9 +141,9 @@
 (s/def ::update-comment-thread
   (s/keys :req-un [::profile-id ::id ::is-resolved]))
 
-(sm/defmutation ::update-comment-thread
-  [{:keys [profile-id id is-resolved] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::update-comment-thread
+  [{:keys [pool] :as cfg} {:keys [profile-id id is-resolved] :as params}]
+  (db/with-atomic [conn pool]
     (let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
       (when-not thread
         (ex/raise :type :not-found)
@@ -161,9 +161,9 @@
 (s/def ::add-comment
   (s/keys :req-un [::profile-id ::thread-id ::content]))
 
-(sm/defmutation ::add-comment
-  [{:keys [profile-id thread-id content] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::add-comment
+  [{:keys [pool] :as cfg} {:keys [profile-id thread-id content] :as params}]
+  (db/with-atomic [conn pool]
     (let [thread (-> (db/get-by-id conn :comment-thread thread-id {:for-update true})
                      (comments/decode-row))
           pname  (retrieve-page-name conn thread)]
@@ -218,9 +218,9 @@
 (s/def ::update-comment
   (s/keys :req-un [::profile-id ::id ::content]))
 
-(sm/defmutation ::update-comment
-  [{:keys [profile-id id content] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::update-comment
+  [{:keys [pool] :as cfg} {:keys [profile-id id content] :as params}]
+  (db/with-atomic [conn pool]
     (let [comment (db/get-by-id conn :comment id {:for-update true})
           _       (when-not comment (ex/raise :type :not-found))
           thread  (db/get-by-id conn :comment-thread (:thread-id comment) {:for-update true})
@@ -251,9 +251,9 @@
 (s/def ::delete-comment-thread
   (s/keys :req-un [::profile-id ::id]))
 
-(sm/defmutation ::delete-comment-thread
-  [{:keys [profile-id id] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::delete-comment-thread
+  [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
+  (db/with-atomic [conn pool]
     (let [thread (db/get-by-id conn :comment-thread id {:for-update true})]
       (when-not (= (:owner-id thread) profile-id)
         (ex/raise :type :validation
@@ -267,9 +267,9 @@
 (s/def ::delete-comment
   (s/keys :req-un [::profile-id ::id]))
 
-(sm/defmutation ::delete-comment
-  [{:keys [profile-id id] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::delete-comment
+  [{:keys [pool] :as cfg} {:keys [profile-id id] :as params}]
+  (db/with-atomic [conn pool]
     (let [comment (db/get-by-id conn :comment id {:for-update true})]
       (when-not (= (:owner-id comment) profile-id)
         (ex/raise :type :validation

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

@@ -7,23 +7,28 @@
 ;;
 ;; Copyright (c) 2020 UXBOX Labs SL
 
-(ns app.services.mutations.demo
+(ns app.rpc.mutations.demo
   "A demo specific mutations."
   (:require
+   [app.common.exceptions :as ex]
    [app.common.uuid :as uuid]
    [app.config :as cfg]
    [app.db :as db]
-   [app.services.mutations :as sm]
-   [app.services.mutations.profile :as profile]
+   [app.db.profile-initial-data :refer [create-profile-initial-data]]
+   [app.rpc.mutations.profile :as profile]
    [app.tasks :as tasks]
+   [app.util.services :as sv]
    [buddy.core.codecs :as bc]
-   [buddy.core.nonce :as bn]))
+   [buddy.core.nonce :as bn]
+   [clojure.spec.alpha :as s]))
 
-(sm/defmutation ::create-demo-profile
-  [_]
+(s/def ::create-demo-profile any?)
+
+(sv/defmethod ::create-demo-profile {:auth false}
+  [{:keys [pool] :as cfg} _]
   (let [id       (uuid/next)
         sem      (System/currentTimeMillis)
-        email    (str "demo-" sem ".demo@nodomain.com")
+        email    (str "demo-" sem ".demo@example.com")
         fullname (str "Demo User " sem)
         password (-> (bn/random-bytes 16)
                      (bc/bytes->b64u)
@@ -32,14 +37,23 @@
                   :email email
                   :fullname fullname
                   :demo? true
-                  :password password}]
-    (db/with-atomic [conn db/pool]
+                  :password password
+                  :props {:onboarding-viewed true}}]
+
+    (when-not (:allow-demo-users cfg/config)
+      (ex/raise :type :validation
+                :code :demo-users-not-allowed
+                :hint "Demo users are disabled by config."))
+
+    (db/with-atomic [conn pool]
       (->> (#'profile/create-profile conn params)
-           (#'profile/create-profile-relations conn))
+           (#'profile/create-profile-relations conn)
+           (create-profile-initial-data conn))
 
       ;; Schedule deletion of the demo profile
       (tasks/submit! conn {:name "delete-profile"
-                           :delay cfg/default-deletion-delay
+                           :delay cfg/deletion-delay
                            :props {:profile-id id}})
+
       {:email email
        :password password})))

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

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

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

@@ -7,7 +7,7 @@
 ;;
 ;; Copyright (c) 2020 UXBOX Labs SL
 
-(ns app.services.mutations.files
+(ns app.rpc.mutations.files
   (:require
    [app.common.exceptions :as ex]
    [app.common.pages :as cp]
@@ -16,12 +16,12 @@
    [app.common.uuid :as uuid]
    [app.config :as cfg]
    [app.db :as db]
-   [app.redis :as redis]
-   [app.services.mutations :as sm]
-   [app.services.queries.files :as files]
-   [app.services.queries.projects :as proj]
+   [app.redis :as rd]
+   [app.rpc.queries.files :as files]
+   [app.rpc.queries.projects :as proj]
    [app.tasks :as tasks]
    [app.util.blob :as blob]
+   [app.util.services :as sv]
    [app.util.time :as dt]
    [app.util.transit :as t]
    [clojure.spec.alpha :as s]))
@@ -43,9 +43,9 @@
   (s/keys :req-un [::profile-id ::name ::project-id]
           :opt-un [::id ::is-shared]))
 
-(sm/defmutation ::create-file
-  [{:keys [profile-id project-id] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::create-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 params)))
 
@@ -63,7 +63,7 @@
          :or {is-shared false}
          :as params}]
   (let [id   (or id (uuid/next))
-        data (cp/make-file-data)
+        data (cp/make-file-data id)
         file (db/insert! conn :file
                          {:id id
                           :project-id project-id
@@ -82,9 +82,9 @@
 (s/def ::rename-file
   (s/keys :req-un [::profile-id ::name ::id]))
 
-(sm/defmutation ::rename-file
-  [{:keys [id profile-id] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::rename-file
+  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+  (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id id)
     (rename-file conn params)))
 
@@ -102,9 +102,9 @@
 (s/def ::set-file-shared
   (s/keys :req-un [::profile-id ::id ::is-shared]))
 
-(sm/defmutation ::set-file-shared
-  [{:keys [id profile-id] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::set-file-shared
+  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+  (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id id)
     (set-file-shared conn params)))
 
@@ -122,14 +122,14 @@
 (s/def ::delete-file
   (s/keys :req-un [::id ::profile-id]))
 
-(sm/defmutation ::delete-file
-  [{:keys [id profile-id] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::delete-file
+  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+  (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id id)
 
     ;; Schedule object deletion
     (tasks/submit! conn {:name "delete-object"
-                         :delay cfg/default-deletion-delay
+                         :delay cfg/deletion-delay
                          :props {:id id :type :file}})
 
     (mark-file-deleted conn params)))
@@ -149,13 +149,13 @@
 (s/def ::link-file-to-library
   (s/keys :req-un [::profile-id ::file-id ::library-id]))
 
-(sm/defmutation ::link-file-to-library
-  [{:keys [profile-id file-id library-id] :as params}]
+(sv/defmethod ::link-file-to-library
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id library-id] :as params}]
   (when (= file-id library-id)
     (ex/raise :type :validation
               :code :invalid-library
               :hint "A file cannot be linked to itself"))
-  (db/with-atomic [conn db/pool]
+  (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id file-id)
     (link-file-to-library conn params)))
 
@@ -176,9 +176,9 @@
 (s/def ::unlink-file-from-library
   (s/keys :req-un [::profile-id ::file-id ::library-id]))
 
-(sm/defmutation ::unlink-file-from-library
-  [{:keys [profile-id file-id library-id] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::unlink-file-from-library
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id library-id] :as params}]
+  (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id file-id)
     (unlink-file-from-library conn params)))
 
@@ -196,9 +196,9 @@
 (s/def ::update-sync
   (s/keys :req-un [::profile-id ::file-id ::library-id]))
 
-(sm/defmutation ::update-sync
-  [{:keys [profile-id file-id library-id] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::update-sync
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id library-id] :as params}]
+  (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id file-id)
     (update-sync conn params)))
 
@@ -217,9 +217,9 @@
 (s/def ::ignore-sync
   (s/keys :req-un [::profile-id ::file-id ::date]))
 
-(sm/defmutation ::ignore-sync
-  [{:keys [profile-id file-id date] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::ignore-sync
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id date] :as params}]
+  (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id file-id)
     (ignore-sync conn params)))
 
@@ -256,15 +256,15 @@
 (declare retrieve-lagged-changes)
 (declare insert-change)
 
-(sm/defmutation ::update-file
-  [{:keys [id profile-id] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::update-file
+  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+  (db/with-atomic [conn pool]
     (let [{:keys [id] :as file} (db/get-by-id conn :file id {:for-update true})]
       (files/check-edition-permissions! conn profile-id id)
-      (update-file conn file params))))
+      (update-file (assoc cfg :conn  conn) file params))))
 
 (defn- update-file
-  [conn file params]
+  [{:keys [conn redis]} file params]
   (when (> (:revn params)
            (:revn file))
     (ex/raise :type :validation
@@ -276,6 +276,7 @@
         changes  (:changes params)
         file     (-> file
                      (update :data blob/decode)
+                     (update :data assoc :id (:id file))
                      (update :data pmg/migrate-data)
                      (update :data cp/process-changes changes)
                      (update :data blob/encode)
@@ -293,8 +294,8 @@
 
         library-changes (filter library-change? changes)]
 
-    @(redis/run! :publish {:channel (str (:id file))
-                           :message (t/encode-str msg)})
+    @(rd/run! redis :publish {:channel (str (:id file))
+                              :message (t/encode-str msg)})
 
     (when (and (:is-shared file) (seq library-changes))
       (let [{:keys [team-id] :as project}
@@ -308,8 +309,8 @@
                  :modified-at (dt/now)
                  :changes library-changes}]
 
-        @(redis/run! :publish {:channel (str team-id)
-                               :message (t/encode-str msg)})))
+        @(rd/run! redis :publish {:channel (str team-id)
+                                  :message (t/encode-str msg)})))
 
     (db/update! conn :file
                 {:revn (:revn file)

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

@@ -0,0 +1,200 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; This Source Code Form is "Incompatible With Secondary Licenses", as
+;; defined by the Mozilla Public License, v. 2.0.
+;;
+;; Copyright (c) 2020-2021 UXBOX Labs SL
+
+(ns app.rpc.mutations.media
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.media :as cm]
+   [app.common.spec :as us]
+   [app.common.uuid :as uuid]
+   [app.db :as db]
+   [app.media :as media]
+   [app.rpc.queries.teams :as teams]
+   [app.storage :as sto]
+   [app.util.http :as http]
+   [app.util.services :as sv]
+   [app.util.time :as dt]
+   [clojure.spec.alpha :as s]
+   [datoteka.core :as fs]))
+
+(def thumbnail-options
+  {:width 100
+   :height 100
+   :quality 85
+   :format :jpeg})
+
+(s/def ::id ::us/uuid)
+(s/def ::name ::us/string)
+(s/def ::profile-id ::us/uuid)
+(s/def ::file-id ::us/uuid)
+(s/def ::team-id ::us/uuid)
+
+;; --- Create File Media object (upload)
+
+(declare create-file-media-object)
+(declare select-file)
+
+(s/def ::content ::media/upload)
+(s/def ::is-local ::us/boolean)
+
+(s/def ::upload-file-media-object
+  (s/keys :req-un [::profile-id ::file-id ::is-local ::name ::content]
+          :opt-un [::id]))
+
+(sv/defmethod ::upload-file-media-object
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
+  (db/with-atomic [conn pool]
+    (let [file (select-file conn file-id)]
+      (teams/check-edition-permissions! conn profile-id (:team-id file))
+      (-> (assoc cfg :conn conn)
+          (create-file-media-object params)))))
+
+(defn- big-enough-for-thumbnail?
+  "Checks if the provided image info is big enough for
+  create a separate thumbnail storage object."
+  [info]
+  (or (> (:width info) (:width thumbnail-options))
+      (> (:height info) (:height thumbnail-options))))
+
+(defn- svg-image?
+  [info]
+  (= (:mtype info) "image/svg+xml"))
+
+(defn- fetch-url
+  [url]
+  (try
+    (http/get! url {:as :byte-array})
+    (catch Exception e
+      (ex/raise :type :validation
+                :code :unable-to-access-to-url
+                :cause e))))
+
+(defn- download-media
+  [{:keys [storage] :as cfg} url]
+  (let [result (fetch-url url)
+        data   (:body result)
+        mtype  (get (:headers result) "content-type")
+        format (cm/mtype->format mtype)]
+    (when (nil? format)
+      (ex/raise :type :validation
+                :code :media-type-not-allowed
+                :hint "Seems like the url points to an invalid media object."))
+    (-> (assoc storage :backend :tmp)
+        (sto/put-object {:content (sto/content data)
+                         :content-type mtype
+                         :expired-at (dt/in-future {:minutes 30})}))))
+
+
+(defn create-file-media-object
+  [{:keys [conn storage svgc] :as cfg} {:keys [file-id is-local name content] :as params}]
+  (media/validate-media-type (:content-type content))
+  (let [storage      (assoc storage :conn conn)
+        source-path  (fs/path (:tempfile content))
+        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))
+                                (big-enough-for-thumbnail? source-info))
+                       (media/run cfg (assoc thumbnail-options
+                                             :cmd :generic-thumbnail
+                                             :input {:mtype (:mtype source-info)
+                                                     :path source-path})))
+
+        image        (if (= (:mtype source-info) "image/svg+xml")
+                       (let [data (svgc (slurp source-path))]
+                         (sto/put-object storage {:content (sto/content data)
+                                                  :content-type (:mtype source-info)}))
+                       (sto/put-object storage {:content (sto/content source-path)
+                                                :content-type (:mtype source-info)}))
+
+        thumb        (when thumb
+                       (sto/put-object storage {:content (sto/content (:data thumb) (:size thumb))
+                                                :content-type (:mtype thumb)}))]
+    (db/insert! conn :file-media-object
+                {:id (uuid/next)
+                 :file-id file-id
+                 :is-local is-local
+                 :name name
+                 :media-id (:id image)
+                 :thumbnail-id (:id thumb)
+                 :width  (:width source-info)
+                 :height (:height source-info)
+                 :mtype  source-mtype})))
+
+
+;; --- Create File Media Object (from URL)
+
+(s/def ::create-file-media-object-from-url
+  (s/keys :req-un [::profile-id ::file-id ::is-local ::url]
+          :opt-un [::id ::name]))
+
+(sv/defmethod ::create-file-media-object-from-url
+  [{:keys [pool storage] :as cfg} {:keys [profile-id file-id url name] :as params}]
+  (db/with-atomic [conn pool]
+    (let [file (select-file conn file-id)]
+      (teams/check-edition-permissions! conn profile-id (:team-id file))
+      (let [mobj    (download-media cfg url)
+            content {:filename "tempfile"
+                     :size (:size mobj)
+                     :tempfile (sto/get-object-path storage mobj)
+                     :content-type (:content-type (meta mobj))}
+            params' (merge params {:content content
+                                   :name (or name (:filename content))})]
+        (-> (assoc cfg :conn conn)
+            (create-file-media-object params'))))))
+
+
+;; --- Clone File Media object (Upload and create from url)
+
+(declare clone-file-media-object)
+
+(s/def ::clone-file-media-object
+  (s/keys :req-un [::profile-id ::file-id ::is-local ::id]))
+
+(sv/defmethod ::clone-file-media-object
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
+  (db/with-atomic [conn pool]
+    (let [file (select-file conn file-id)]
+      (teams/check-edition-permissions! conn profile-id (:team-id file))
+
+      (-> (assoc cfg :conn conn)
+          (clone-file-media-object params)))))
+
+(defn clone-file-media-object
+  [{:keys [conn] :as cfg} {:keys [id file-id is-local]}]
+  (let [mobj (db/get-by-id conn :file-media-object id)]
+    (db/insert! conn :file-media-object
+                {:id (uuid/next)
+                 :file-id file-id
+                 :is-local is-local
+                 :name (:name mobj)
+                 :media-id (:media-id mobj)
+                 :thumbnail-id (:thumbnail-id mobj)
+                 :width  (:width mobj)
+                 :height (:height mobj)
+                 :mtype  (:mtype mobj)})))
+
+
+;; --- HELPERS
+
+(def ^:private
+  sql:select-file
+  "select file.*,
+          project.team_id as team_id
+     from file
+    inner join project on (project.id = file.project_id)
+    where file.id = ?")
+
+(defn- select-file
+  [conn id]
+  (let [row (db/exec-one! conn [sql:select-file id])]
+    (when-not row
+      (ex/raise :type :not-found))
+    row))

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

@@ -5,25 +5,26 @@
 ;; This Source Code Form is "Incompatible With Secondary Licenses", as
 ;; defined by the Mozilla Public License, v. 2.0.
 ;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) 2020-2021 UXBOX Labs SL
 
-(ns app.services.mutations.profile
+(ns app.rpc.mutations.profile
   (:require
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
    [app.config :as cfg]
    [app.db :as db]
+   [app.db.profile-initial-data :refer [create-profile-initial-data]]
    [app.emails :as emails]
    [app.http.session :as session]
    [app.media :as media]
-   [app.services.mutations :as sm]
-   [app.services.mutations.projects :as projects]
-   [app.services.mutations.teams :as teams]
-   [app.services.mutations.verify-token :refer [process-token]]
-   [app.services.queries.profile :as profile]
-   [app.services.tokens :as tokens]
+   [app.rpc.mutations.projects :as projects]
+   [app.rpc.mutations.teams :as teams]
+   [app.rpc.mutations.verify-token :refer [process-token]]
+   [app.rpc.queries.profile :as profile]
+   [app.storage :as sto]
    [app.tasks :as tasks]
+   [app.util.services :as sv]
    [app.util.time :as dt]
    [buddy.hashers :as hashers]
    [clojure.spec.alpha :as s]
@@ -53,8 +54,8 @@
   (s/keys :req-un [::email ::password ::fullname]
           :opt-un [::token]))
 
-(sm/defmutation ::register-profile
-  [{:keys [token] :as params}]
+(sv/defmethod ::register-profile {:auth false :rlimit :password}
+  [{:keys [pool tokens session] :as cfg} {:keys [token] :as params}]
   (when-not (:registration-enabled cfg/config)
     (ex/raise :type :restriction
               :code :registration-disabled))
@@ -64,20 +65,23 @@
     (ex/raise :type :validation
               :code :email-domain-is-not-allowed))
 
-  (db/with-atomic [conn db/pool]
+  (db/with-atomic [conn pool]
     (check-profile-existence! conn params)
     (let [profile (->> (create-profile conn params)
                        (create-profile-relations conn))]
+      (create-profile-initial-data conn profile)
 
       (if token
         ;; If token comes in params, this is because the user comes
         ;; from team-invitation process; in this case we revalidate
         ;; the token and process the token claims again with the new
         ;; profile data.
-        (let [claims (tokens/verify token {:iss :team-invitation})
+        (let [claims (tokens :verify {:token token :iss :team-invitation})
               claims (assoc claims :member-id  (:id profile))
-              params (assoc params :profile-id (:id profile))]
-          (process-token conn params claims)
+              params (assoc params :profile-id (:id profile))
+              cfg    (assoc cfg :conn conn)]
+
+          (process-token cfg params claims)
 
           ;; Automatically mark the created profile as active because
           ;; we already have the verification of email with the
@@ -94,16 +98,17 @@
             {:transform-response
              (fn [request response]
                (let [uagent (get-in request [:headers "user-agent"])
-                     id     (session/create (:id profile) uagent)]
+                     id     (session/create! session {:profile-id (:id profile)
+                                                      :user-agent uagent})]
                  (assoc response
-                        :cookies (session/cookies id))))}))
+                        :cookies (session/cookies session {:value id}))))}))
 
         ;; If no token is provided, send a verification email
-        (let [token (tokens/generate
-                     {:iss :verify-email
-                      :exp (dt/in-future "48h")
-                      :profile-id (:id profile)
-                      :email (:email profile)})]
+        (let [token (tokens :generate
+                            {:iss :verify-email
+                             :exp (dt/in-future "48h")
+                             :profile-id (:id profile)
+                             :email (:email profile)})]
 
           (emails/send! conn emails/register
                         {:to (:email profile)
@@ -137,7 +142,7 @@
                 :code :email-already-exists))
     params))
 
-(defn- derive-password
+(defn derive-password
   [password]
   (hashers/derive password
                   {:alg :argon2id
@@ -145,7 +150,7 @@
                    :iterations 20
                    :parallelism 2}))
 
-(defn- verify-password
+(defn verify-password
   [attempt password]
   (try
     (hashers/verify attempt password)
@@ -157,19 +162,32 @@
 (defn- create-profile
   "Create the profile entry on the database with limited input
   filling all the other fields with defaults."
-  [conn {:keys [id fullname email password demo?] :as params}]
+  [conn {:keys [id fullname email password demo? props is-active]
+         :or {is-active false}
+         :as params}]
   (let [id       (or id (uuid/next))
         demo?    (if (boolean? demo?) demo? false)
-        active?  (if demo? true false)
+        active?  (if demo? true is-active)
+        props    (db/tjson (or props {}))
         password (derive-password password)]
-    (db/insert! conn :profile
-                {:id id
-                 :fullname fullname
-                 :email (str/lower email)
-                 :photo ""
-                 :password password
-                 :is-active active?
-                 :is-demo demo?})))
+    (try
+      (-> (db/insert! conn :profile
+                      {:id id
+                       :fullname fullname
+                       :email (str/lower email)
+                       :password password
+                       :props props
+                       :is-active active?
+                       :is-demo demo?})
+          (update :props db/decode-transit-pgobject))
+      (catch org.postgresql.util.PSQLException e
+        (let [state (.getSQLState e)]
+          (if (not= state "23505")
+            (throw e)
+            (ex/raise :type :validation
+                      :code :email-already-exists
+                      :cause e)))))))
+
 
 (defn- create-profile-relations
   [conn profile]
@@ -198,8 +216,8 @@
   (s/keys :req-un [::email ::password]
           :opt-un [::scope]))
 
-(sm/defmutation ::login
-  [{:keys [email password scope] :as params}]
+(sv/defmethod ::login {:auth false :rlimit :password}
+  [{:keys [pool] :as cfg} {:keys [email password scope] :as params}]
   (letfn [(check-password [profile password]
             (when (= (:password profile) "!")
               (ex/raise :type :validation
@@ -218,7 +236,7 @@
                         :code :wrong-credentials))
             profile)]
 
-    (db/with-atomic [conn db/pool]
+    (db/with-atomic [conn pool]
       (let [prof (-> (profile/retrieve-profile-data-by-email conn email)
                      (validate-profile)
                      (profile/strip-private-attrs))
@@ -228,8 +246,11 @@
 
 ;; --- Mutation: Register if not exists
 
-(sm/defmutation ::login-or-register
-  [{:keys [email fullname] :as params}]
+(s/def ::login-or-register
+  (s/keys :req-un [::email ::fullname]))
+
+(sv/defmethod ::login-or-register {:auth false}
+  [{:keys [pool] :as cfg} {:keys [email fullname] :as params}]
   (letfn [(populate-additional-data [conn profile]
             (let [data (profile/retrieve-additional-data conn (:id profile))]
               (merge profile data)))
@@ -240,15 +261,16 @@
                          :fullname fullname
                          :email (str/lower email)
                          :is-active true
-                         :photo ""
                          :password "!"
                          :is-demo false}))
 
           (register-profile [conn params]
-            (->> (create-profile conn params)
-                 (create-profile-relations conn)))]
+            (let [profile (->> (create-profile conn params)
+                               (create-profile-relations conn))]
+              (create-profile-initial-data conn profile)
+              profile))]
 
-    (db/with-atomic [conn db/pool]
+    (db/with-atomic [conn pool]
       (let [profile (profile/retrieve-profile-data-by-email conn email)
             profile (if profile
                       (populate-additional-data conn profile)
@@ -269,9 +291,9 @@
 (s/def ::update-profile
   (s/keys :req-un [::id ::fullname ::lang ::theme]))
 
-(sm/defmutation ::update-profile
-  [params]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::update-profile
+  [{:keys [pool] :as cfg} params]
+  (db/with-atomic [conn pool]
     (update-profile conn params)
     nil))
 
@@ -288,9 +310,9 @@
 (s/def ::update-profile-password
   (s/keys :req-un [::profile-id ::password ::old-password]))
 
-(sm/defmutation ::update-profile-password
-  [{:keys [password profile-id] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::update-profile-password {:rlimit :password}
+  [{:keys [pool] :as cfg} {:keys [password profile-id] :as params}]
+  (db/with-atomic [conn pool]
     (validate-password! conn params)
     (db/update! conn :profile
                 {:password (derive-password password)}
@@ -306,27 +328,27 @@
 (s/def ::update-profile-photo
   (s/keys :req-un [::profile-id ::file]))
 
-(sm/defmutation ::update-profile-photo
-  [{:keys [profile-id file] :as params}]
+(sv/defmethod ::update-profile-photo
+  [{:keys [pool storage] :as cfg} {:keys [profile-id file] :as params}]
   (media/validate-media-type (:content-type file))
-  (db/with-atomic [conn db/pool]
+  (db/with-atomic [conn pool]
     (let [profile (db/get-by-id conn :profile profile-id)
-          _       (media/run {:cmd :info :input {:path (:tempfile file)
-                                                 :mtype (:content-type file)}})
-          photo   (teams/upload-photo conn params)]
+          _       (media/run cfg {:cmd :info :input {:path (:tempfile file)
+                                                     :mtype (:content-type file)}})
+          photo   (teams/upload-photo cfg params)
+          storage (assoc storage :conn conn)]
 
       ;; Schedule deletion of old photo
-      (when (and (string? (:photo profile))
-                 (not (str/blank? (:photo profile))))
-        (tasks/submit! conn {:name "remove-media"
-                             :props {:path (:photo profile)}}))
+      (when-let [id (:photo-id profile)]
+        (sto/del-object storage id))
+
       ;; Save new photo
       (update-profile-photo conn profile-id photo))))
 
 (defn- update-profile-photo
-  [conn profile-id path]
+  [conn profile-id sobj]
   (db/update! conn :profile
-              {:photo (str path)}
+              {:photo-id (:id sobj)}
               {:id profile-id})
   nil)
 
@@ -335,16 +357,16 @@
 (s/def ::request-email-change
   (s/keys :req-un [::email]))
 
-(sm/defmutation ::request-email-change
-  [{:keys [profile-id email] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::request-email-change
+  [{:keys [pool tokens] :as cfg} {:keys [profile-id email] :as params}]
+  (db/with-atomic [conn pool]
     (let [email   (str/lower email)
           profile (db/get-by-id conn :profile profile-id)
-          token   (tokens/generate
-                   {:iss :change-email
-                    :exp (dt/in-future "15m")
-                    :profile-id profile-id
-                    :email email})]
+          token   (tokens :generate
+                          {:iss :change-email
+                           :exp (dt/in-future "15m")
+                           :profile-id profile-id
+                           :email email})]
 
       (when (not= email (:email profile))
         (check-profile-existence! conn params))
@@ -365,27 +387,31 @@
 (s/def ::request-profile-recovery
   (s/keys :req-un [::email]))
 
-(sm/defmutation ::request-profile-recovery
-  [{:keys [email] :as params}]
+(sv/defmethod ::request-profile-recovery {:auth false}
+  [{:keys [pool tokens] :as cfg} {:keys [email] :as params}]
   (letfn [(create-recovery-token [{:keys [id] :as profile}]
-            (let [token (tokens/generate
-                         {:iss :password-recovery
-                          :exp (dt/in-future "15m")
-                          :profile-id id})]
+            (let [token (tokens :generate
+                                {:iss :password-recovery
+                                 :exp (dt/in-future "15m")
+                                 :profile-id id})]
               (assoc profile :token token)))
 
           (send-email-notification [conn profile]
             (emails/send! conn emails/password-recovery
                           {:to (:email profile)
                            :token (:token profile)
-                           :name (:fullname profile)}))]
+                           :name (:fullname profile)})
+            nil)]
 
-    (db/with-atomic [conn db/pool]
-      (some->> email
-               (profile/retrieve-profile-data-by-email conn)
-               (create-recovery-token)
-               (send-email-notification conn))
-      nil)))
+    (db/with-atomic [conn pool]
+      (when-let [profile (profile/retrieve-profile-data-by-email conn email)]
+        (when-not (:is-active profile)
+          (ex/raise :type :validation
+                    :code :profile-not-verified
+                    :hint "the user need to validate profile before recover password"))
+        (->> profile
+             (create-recovery-token)
+             (send-email-notification conn))))))
 
 
 ;; --- Mutation: Recover Profile
@@ -394,17 +420,17 @@
 (s/def ::recover-profile
   (s/keys :req-un [::token ::password]))
 
-(sm/defmutation ::recover-profile
-  [{:keys [token password]}]
+(sv/defmethod ::recover-profile {:auth false :rlimit :password}
+  [{:keys [pool tokens] :as cfg} {:keys [token password]}]
   (letfn [(validate-token [token]
-            (let [tdata (tokens/verify token {:iss :password-recovery})]
+            (let [tdata (tokens :verify {:token token :iss :password-recovery})]
               (:profile-id tdata)))
 
           (update-password [conn profile-id]
             (let [pwd (derive-password password)]
               (db/update! conn :profile {:password pwd} {:id profile-id})))]
 
-    (db/with-atomic [conn db/pool]
+    (db/with-atomic [conn pool]
       (->> (validate-token token)
            (update-password conn))
       nil)))
@@ -415,9 +441,9 @@
 (s/def ::update-profile-props
   (s/keys :req-un [::profile-id ::props]))
 
-(sm/defmutation ::update-profile-props
-  [{:keys [profile-id props]}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::update-profile-props
+  [{:keys [pool] :as cfg} {:keys [profile-id props]}]
+  (db/with-atomic [conn pool]
     (let [profile (profile/retrieve-profile-data conn profile-id)
           props   (reduce-kv (fn [props k v]
                                (if (nil? v)
@@ -433,20 +459,20 @@
 
 ;; --- Mutation: Delete Profile
 
-(declare check-teams-ownership!)
+(declare check-can-delete-profile!)
 (declare mark-profile-as-deleted!)
 
 (s/def ::delete-profile
   (s/keys :req-un [::profile-id]))
 
-(sm/defmutation ::delete-profile
-  [{:keys [profile-id] :as params}]
-  (db/with-atomic [conn db/pool]
-    (check-teams-ownership! conn profile-id)
+(sv/defmethod ::delete-profile
+  [{:keys [pool session] :as cfg} {:keys [profile-id] :as params}]
+  (db/with-atomic [conn pool]
+    (check-can-delete-profile! conn profile-id)
 
     ;; Schedule a complete deletion of profile
     (tasks/submit! conn {:name "delete-profile"
-                         :delay (dt/duration {:hours 48})
+                         :delay cfg/deletion-delay
                          :props {:profile-id profile-id}})
 
     (db/update! conn :profile
@@ -456,29 +482,30 @@
     (with-meta {}
       {:transform-response
        (fn [request response]
-         (some-> (session/extract-auth-token request)
-                 (session/delete))
+         (session/delete! session request)
          (assoc response
-                :cookies (session/cookies "" {:max-age -1})))})))
+                :cookies (session/cookies session {:value "" :max-age -1})))})))
 
-(def ^:private sql:teams-ownership-check
-  "with teams as (
-     select tpr.team_id as id
-       from team_profile_rel as tpr
-      where tpr.profile_id = ?
-        and tpr.is_owner is true
+(def sql:owned-teams
+  "with owner_teams as (
+      select tpr.team_id as id
+        from team_profile_rel as tpr
+       where tpr.is_owner is true
+         and tpr.profile_id = ?
    )
    select tpr.team_id,
           count(tpr.profile_id) as num_profiles
      from team_profile_rel as tpr
-    where tpr.team_id in (select id from teams)
-    group by tpr.team_id
-   having count(tpr.profile_id) > 1")
+    where tpr.team_id in (select id from owner_teams)
+    group by 1")
 
-(defn- check-teams-ownership!
+(defn- check-can-delete-profile!
   [conn profile-id]
-  (let [rows (db/exec! conn [sql:teams-ownership-check profile-id])]
-    (when-not (empty? rows)
+  (let [rows (db/exec! conn [sql:owned-teams profile-id])]
+    ;; If we found owned teams with more than one profile we don't
+    ;; allow delete profile until the user properly transfer ownership
+    ;; or explictly removes all participants from the team.
+    (when (some #(> (:num-profiles %) 1) rows)
       (ex/raise :type :validation
                 :code :owner-teams-with-people
                 :hint "The user need to transfer ownership of owned teams."

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

@@ -7,15 +7,16 @@
 ;;
 ;; Copyright (c) 2020 UXBOX Labs SL
 
-(ns app.services.mutations.projects
+(ns app.rpc.mutations.projects
   (:require
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
    [app.config :as cfg]
    [app.db :as db]
-   [app.services.mutations :as sm]
-   [app.services.queries.projects :as proj]
+   [app.rpc.queries.projects :as proj]
    [app.tasks :as tasks]
+   [app.util.services :as sv]
+   [app.util.time :as dt]
    [clojure.spec.alpha :as s]))
 
 ;; --- Helpers & Specs
@@ -36,9 +37,9 @@
   (s/keys :req-un [::profile-id ::team-id ::name]
           :opt-un [::id]))
 
-(sm/defmutation ::create-project
-  [params]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::create-project
+  [{:keys [pool] :as cfg} params]
+  (db/with-atomic [conn pool]
     (let [proj   (create-project conn params)
           params (assoc params :project-id (:id proj))]
       (create-project-profile conn params)
@@ -88,9 +89,9 @@
 (s/def ::update-project-pin
   (s/keys :req-un [::profile-id ::id ::team-id ::is-pinned]))
 
-(sm/defmutation ::update-project-pin
-  [{:keys [id profile-id team-id is-pinned] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::update-project-pin
+  [{:keys [pool] :as cfg} {:keys [id profile-id team-id is-pinned] :as params}]
+  (db/with-atomic [conn pool]
     (db/exec-one! conn [sql:update-project-pin team-id id profile-id is-pinned is-pinned])
     nil))
 
@@ -102,40 +103,31 @@
 (s/def ::rename-project
   (s/keys :req-un [::profile-id ::name ::id]))
 
-(sm/defmutation ::rename-project
-  [{:keys [id profile-id name] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::rename-project
+  [{:keys [pool] :as cfg} {:keys [id profile-id name] :as params}]
+  (db/with-atomic [conn pool]
     (proj/check-edition-permissions! conn profile-id id)
     (db/update! conn :project
                 {:name name}
-                {:id id})))
+                {:id id})
+    nil))
 
 ;; --- Mutation: Delete Project
 
-(declare mark-project-deleted)
-
 (s/def ::delete-project
   (s/keys :req-un [::id ::profile-id]))
 
-(sm/defmutation ::delete-project
-  [{:keys [id profile-id] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::delete-project
+  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+  (db/with-atomic [conn pool]
     (proj/check-edition-permissions! conn profile-id id)
 
     ;; Schedule object deletion
     (tasks/submit! conn {:name "delete-object"
-                         :delay cfg/default-deletion-delay
+                         :delay cfg/deletion-delay
                          :props {:id id :type :project}})
 
-    (mark-project-deleted conn params)))
-
-(def ^:private sql:mark-project-deleted
-  "update project
-      set deleted_at = clock_timestamp()
-    where id = ?
-   returning id")
-
-(defn mark-project-deleted
-  [conn {:keys [id] :as params}]
-  (db/exec! conn [sql:mark-project-deleted id])
-  nil)
+    (db/update! conn :project
+                {:deleted-at (dt/now)}
+                {:id id})
+    nil))

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

@@ -5,31 +5,26 @@
 ;; This Source Code Form is "Incompatible With Secondary Licenses", as
 ;; defined by the Mozilla Public License, v. 2.0.
 ;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) 2020-2021 UXBOX Labs SL
 
-(ns app.services.mutations.teams
+(ns app.rpc.mutations.teams
   (:require
    [app.common.data :as d]
    [app.common.exceptions :as ex]
-   [app.common.media :as cm]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
+   [app.config :as cfg]
    [app.db :as db]
    [app.emails :as emails]
    [app.media :as media]
-   [app.media-storage :as mst]
-   [app.services.mutations :as sm]
-   [app.services.mutations.projects :as projects]
-   [app.services.queries.profile :as profile]
-   [app.services.queries.teams :as teams]
-   [app.services.tokens :as tokens]
+   [app.rpc.mutations.projects :as projects]
+   [app.rpc.queries.profile :as profile]
+   [app.rpc.queries.teams :as teams]
+   [app.storage :as sto]
    [app.tasks :as tasks]
-   [app.util.storage :as ust]
+   [app.util.services :as sv]
    [app.util.time :as dt]
-   [buddy.core.codecs :as bc]
-   [buddy.core.nonce :as bn]
    [clojure.spec.alpha :as s]
-   [cuerdas.core :as str]
    [datoteka.core :as fs]))
 
 ;; --- Helpers & Specs
@@ -48,9 +43,9 @@
   (s/keys :req-un [::profile-id ::name]
           :opt-un [::id]))
 
-(sm/defmutation ::create-team
-  [params]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::create-team
+  [{:keys [pool] :as cfg} params]
+  (db/with-atomic [conn pool]
     (let [team   (create-team conn params)
           params (assoc params :team-id (:id team))]
       (create-team-profile conn params)
@@ -64,7 +59,6 @@
     (db/insert! conn :team
                 {:id id
                  :name name
-                 :photo ""
                  :is-default default?})))
 
 (defn create-team-profile
@@ -90,9 +84,9 @@
 (s/def ::update-team
   (s/keys :req-un [::profile-id ::name ::id]))
 
-(sm/defmutation ::update-team
-  [{:keys [id name profile-id] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::update-team
+  [{:keys [pool] :as cfg} {:keys [id name profile-id] :as params}]
+  (db/with-atomic [conn pool]
     (teams/check-edition-permissions! conn profile-id id)
     (db/update! conn :team
                 {:name name}
@@ -105,13 +99,13 @@
 (s/def ::leave-team
   (s/keys :req-un [::profile-id ::id]))
 
-(sm/defmutation ::leave-team
-  [{:keys [id profile-id] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::leave-team
+  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+  (db/with-atomic [conn pool]
     (let [perms   (teams/check-read-permissions! conn profile-id id)
           members (teams/retrieve-team-members conn id)]
 
-      (when (:is-owner perms)
+      (when (some :is-owner perms)
         (ex/raise :type :validation
                   :code :owner-cant-leave-team
                   :hint "reasing owner before leave"))
@@ -133,17 +127,25 @@
 (s/def ::delete-team
   (s/keys :req-un [::profile-id ::id]))
 
-(sm/defmutation ::delete-team
-  [{:keys [id profile-id] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::delete-team
+  [{:keys [pool] :as cfg} {:keys [id profile-id] :as params}]
+  (db/with-atomic [conn pool]
     (let [perms (teams/check-edition-permissions! conn profile-id id)]
-      (when-not (:is-owner perms)
+      (when-not (some :is-owner perms)
         (ex/raise :type :validation
                   :code :only-owner-can-delete-team))
 
-      (db/delete! conn :team {:id id})
+      ;; Schedule object deletion
+      (tasks/submit! conn {:name "delete-object"
+                           :delay cfg/deletion-delay
+                           :props {:id id :type :team}})
+
+      (db/update! conn :team
+                  {:deleted-at (dt/now)}
+                  {:id id})
       nil)))
 
+
 ;; --- Mutation: Tean Update Role
 
 (declare retrieve-team-member)
@@ -151,14 +153,17 @@
 
 (s/def ::team-id ::us/uuid)
 (s/def ::member-id ::us/uuid)
-(s/def ::role #{:owner :admin :editor :viewer})
+;; Temporarily disabled viewer role
+;; https://tree.taiga.io/project/uxboxproject/issue/1083
+;; (s/def ::role #{:owner :admin :editor :viewer})
+(s/def ::role #{:owner :admin :editor})
 
 (s/def ::update-team-member-role
   (s/keys :req-un [::profile-id ::team-id ::member-id ::role]))
 
-(sm/defmutation ::update-team-member-role
-  [{:keys [team-id profile-id member-id role] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::update-team-member-role
+  [{:keys [pool] :as cfg} {:keys [team-id profile-id member-id role] :as params}]
+  (db/with-atomic [conn pool]
     (let [perms   (teams/check-read-permissions! conn profile-id team-id)
 
           ;; We retrieve all team members instead of query the
@@ -174,8 +179,8 @@
                   :code :member-does-not-exist))
 
       ;; First check if we have permissions to change roles
-      (when-not (or (:is-owner perms)
-                    (:is-admin perms))
+      (when-not (or (some :is-owner perms)
+                    (some :is-admin perms))
         (ex/raise :type :validation
                   :code :insufficient-permissions))
 
@@ -218,9 +223,9 @@
 (s/def ::delete-team-member
   (s/keys :req-un [::profile-id ::team-id ::member-id]))
 
-(sm/defmutation ::delete-team-member
-  [{:keys [team-id profile-id member-id] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::delete-team-member
+  [{:keys [pool] :as cfg} {:keys [team-id profile-id member-id] :as params}]
+  (db/with-atomic [conn pool]
     (let [perms (teams/check-read-permissions! conn profile-id team-id)]
       (when-not (or (:is-owner perms)
                     (:is-admin perms))
@@ -245,43 +250,42 @@
 (s/def ::update-team-photo
   (s/keys :req-un [::profile-id ::team-id ::file]))
 
-(sm/defmutation ::update-team-photo
-  [{:keys [profile-id file team-id] :as params}]
+(sv/defmethod ::update-team-photo
+  [{:keys [pool storage] :as cfg} {:keys [profile-id file team-id] :as params}]
   (media/validate-media-type (:content-type file))
-  (db/with-atomic [conn db/pool]
+  (db/with-atomic [conn pool]
     (teams/check-edition-permissions! conn profile-id team-id)
     (let [team    (teams/retrieve-team conn profile-id team-id)
-          _       (media/run {:cmd :info :input {:path (:tempfile file)
-                                                 :mtype (:content-type file)}})
-          photo   (upload-photo conn params)]
+          _       (media/run cfg {:cmd :info :input {:path (:tempfile file)
+                                                     :mtype (:content-type file)}})
+          photo   (upload-photo cfg params)]
 
       ;; Schedule deletion of old photo
-      (when (and (string? (:photo team))
-                 (not (str/blank? (:photo team))))
-        (tasks/submit! conn {:name "remove-media"
-                             :props {:path (:photo team)}}))
+      (when-let [id (:photo-id team)]
+        (sto/del-object storage id))
+
       ;; Save new photo
       (db/update! conn :team
-              {:photo (str photo)}
+              {:photo-id (:id photo)}
               {:id team-id})
 
-      (assoc team :photo (str photo)))))
+      (assoc team :photo-id (:id photo)))))
 
 (defn upload-photo
-  [_conn {:keys [file]}]
-  (let [prefix (-> (bn/random-bytes 8)
-                   (bc/bytes->b64u)
-                   (bc/bytes->str))
-        thumb  (media/run
+  [{:keys [storage] :as cfg} {:keys [file]}]
+  (let [thumb  (media/run cfg
                  {:cmd :profile-thumbnail
                   :format :jpeg
                   :quality 85
                   :width 256
                   :height 256
                   :input {:path (fs/path (:tempfile file))
-                          :mtype (:content-type file)}})
-        name   (str prefix (cm/format->extension (:format thumb)))]
-    (ust/save! mst/media-storage name (:data thumb))))
+                          :mtype (:content-type file)}})]
+
+
+    (sto/put-object storage
+                    {:content (sto/content (:data thumb) (:size thumb))
+                     :content-type (:mtype thumb)})))
 
 
 ;; --- Mutation: Invite Member
@@ -290,23 +294,23 @@
 (s/def ::invite-team-member
   (s/keys :req-un [::profile-id ::team-id ::email ::role]))
 
-(sm/defmutation ::invite-team-member
-  [{:keys [profile-id team-id email role] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::invite-team-member
+  [{:keys [pool tokens] :as cfg} {:keys [profile-id team-id email role] :as params}]
+  (db/with-atomic [conn pool]
     (let [perms   (teams/check-edition-permissions! conn profile-id team-id)
           profile (db/get-by-id conn :profile profile-id)
           member  (profile/retrieve-profile-data-by-email conn email)
           team    (db/get-by-id conn :team team-id)
-          token   (tokens/generate
-                   {:iss :team-invitation
-                    :exp (dt/in-future "24h")
-                    :profile-id (:id profile)
-                    :role role
-                    :team-id team-id
-                    :member-email (:email member email)
-                    :member-id (:id member)})]
+          token   (tokens :generate
+                          {:iss :team-invitation
+                           :exp (dt/in-future "24h")
+                           :profile-id (:id profile)
+                           :role role
+                           :team-id team-id
+                           :member-email (:email member email)
+                           :member-id (:id member)})]
 
-      (when-not (:is-admin perms)
+      (when-not (some :is-admin perms)
         (ex/raise :type :validation
                   :code :insufficient-permissions))
 

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

@@ -7,16 +7,15 @@
 ;;
 ;; Copyright (c) 2020 UXBOX Labs SL
 
-(ns app.services.mutations.verify-token
+(ns app.rpc.mutations.verify-token
   (:require
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.db :as db]
    [app.http.session :as session]
-   [app.services.mutations :as sm]
-   [app.services.mutations.teams :as teams]
-   [app.services.queries.profile :as profile]
-   [app.services.tokens :as tokens]
+   [app.rpc.mutations.teams :as teams]
+   [app.rpc.queries.profile :as profile]
+   [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
 
 (defmulti process-token (fn [_ _ claims] (:iss claims)))
@@ -25,14 +24,15 @@
   (s/keys :req-un [::token]
           :opt-un [::profile-id]))
 
-(sm/defmutation ::verify-token
-  [{:keys [token] :as params}]
-  (db/with-atomic [conn db/pool]
-    (let [claims (tokens/verify token)]
-      (process-token conn params claims))))
+(sv/defmethod ::verify-token {:auth false}
+  [{:keys [pool tokens] :as cfg} {:keys [token] :as params}]
+  (db/with-atomic [conn pool]
+    (let [claims (tokens :verify {:token token})
+          cfg    (assoc cfg :conn conn)]
+      (process-token cfg params claims))))
 
 (defmethod process-token :change-email
-  [conn _params {:keys [profile-id email] :as claims}]
+  [{:keys [conn] :as cfg} _params {:keys [profile-id email] :as claims}]
   (when (profile/retrieve-profile-data-by-email conn email)
     (ex/raise :type :validation
               :code :email-already-exists))
@@ -42,23 +42,32 @@
   claims)
 
 (defmethod process-token :verify-email
-  [conn _params {:keys [profile-id] :as claims}]
-  (let [profile (db/get-by-id conn :profile profile-id {:for-update true})]
-    (when (:is-active profile)
-      (ex/raise :type :validation
-                :code :email-already-validated))
-    (when (not= (:email profile)
-                (:email claims))
-      (ex/raise :type :validation
-                :code :invalid-token))
+  [{:keys [conn session] :as cfg} _params {:keys [profile-id] :as claims}]
+  (let [profile (profile/retrieve-profile conn profile-id)
+        claims  (assoc claims :profile profile)]
+
+    (when-not (:is-active profile)
+      (when (not= (:email profile)
+                  (:email claims))
+        (ex/raise :type :validation
+                  :code :invalid-token))
+
+      (db/update! conn :profile
+                  {:is-active true}
+                  {:id (:id profile)}))
+
+    (with-meta claims
+      {:transform-response
+       (fn [request response]
+         (let [uagent (get-in request [:headers "user-agent"])
+               id     (session/create! session {:profile-id profile-id
+                                                :user-agent uagent})]
+           (assoc response
+                  :cookies (session/cookies session {:value id}))))})))
 
-    (db/update! conn :profile
-                {:is-active true}
-                {:id (:id profile)})
-    claims))
 
 (defmethod process-token :auth
-  [conn _params {:keys [profile-id] :as claims}]
+  [{:keys [conn] :as cfg} _params {:keys [profile-id] :as claims}]
   (let [profile (profile/retrieve-profile conn profile-id)]
     (assoc claims :profile profile)))
 
@@ -83,14 +92,17 @@
           :opt-un [:internal.tokens.team-invitation/member-id]))
 
 (defmethod process-token :team-invitation
-  [conn {:keys [profile-id token]} {:keys [member-id team-id role] :as claims}]
+  [{:keys [conn session] :as cfg} {:keys [profile-id token]} {:keys [member-id team-id role] :as claims}]
   (us/assert ::team-invitation-claims claims)
   (if (uuid? member-id)
     (let [params (merge {:team-id team-id
                          :profile-id member-id}
                         (teams/role->params role))
           claims (assoc claims :state :created)]
-      (db/insert! conn :team-profile-rel params)
+
+      (db/insert! conn :team-profile-rel params
+                  {:on-conflict-do-nothing true})
+
       (if (and (uuid? profile-id)
                (= member-id profile-id))
         ;; If the current session is already matches the invited
@@ -107,11 +119,12 @@
           {:transform-response
            (fn [request response]
              (let [uagent (get-in request [:headers "user-agent"])
-                   id     (session/create member-id uagent)]
+                   id     (session/create! session {:profile-id member-id
+                                                    :user-agent uagent})]
                (assoc response
-                      :cookies (session/cookies id))))})))
+                      :cookies (session/cookies session {:value id}))))})))
 
-    ;; In this case, we waint until frontend app redirect user to
+    ;; In this case, we wait until frontend app redirect user to
     ;; registeration page, the user is correctly registered and the
     ;; register mutation call us again with the same token to finally
     ;; create the corresponding team-profile relation from the first

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

@@ -7,12 +7,12 @@
 ;;
 ;; Copyright (c) 2020 UXBOX Labs SL
 
-(ns app.services.mutations.viewer
+(ns app.rpc.mutations.viewer
   (:require
    [app.common.spec :as us]
    [app.db :as db]
-   [app.services.mutations :as sm]
-   [app.services.queries.files :as files]
+   [app.rpc.queries.files :as files]
+   [app.util.services :as sv]
    [buddy.core.codecs :as bc]
    [buddy.core.nonce :as bn]
    [clojure.spec.alpha :as s]))
@@ -24,9 +24,9 @@
 (s/def ::create-file-share-token
   (s/keys :req-un [::profile-id ::file-id ::page-id]))
 
-(sm/defmutation ::create-file-share-token
-  [{:keys [profile-id file-id page-id] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::create-file-share-token
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id page-id] :as params}]
+  (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id file-id)
     (let [token (-> (bn/random-bytes 16)
                     (bc/bytes->b64u)
@@ -42,9 +42,9 @@
 (s/def ::delete-file-share-token
   (s/keys :req-un [::profile-id ::file-id ::token]))
 
-(sm/defmutation ::delete-file-share-token
-  [{:keys [profile-id file-id token]}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::delete-file-share-token
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id token]}]
+  (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id file-id)
     (db/delete! conn :file-share-token
                 {:file-id file-id

backend/src/app/rpc/permissions.clj

@@ -0,0 +1,40 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; This Source Code Form is "Incompatible With Secondary Licenses", as
+;; defined by the Mozilla Public License, v. 2.0.
+;;
+;; Copyright (c) 2020 UXBOX Labs SL
+
+(ns app.rpc.permissions
+  "A permission checking helper factories."
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]))
+
+(defn make-edition-check-fn
+  "A simple factory for edition permission check functions."
+  [qfn]
+  (us/assert fn? qfn)
+  (fn [& args]
+    (let [rows (apply qfn args)]
+      (if (or (empty? rows)
+              (not (or (some :can-edit rows)
+                       (some :is-admin rows)
+                       (some :is-owner rows))))
+        (ex/raise :type :not-found
+                  :code :object-not-found
+                  :hint "not found")
+        rows))))
+
+(defn make-read-check-fn
+  "A simple factory for read permission check functions."
+  [qfn]
+  (us/assert fn? qfn)
+  (fn [& args]
+    (let [rows (apply qfn args)]
+      (if-not (seq rows)
+        (ex/raise :type :not-found
+                  :code :object-not-found)
+        rows))))

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

@@ -7,13 +7,13 @@
 ;;
 ;; Copyright (c) 2020 UXBOX Labs SL
 
-(ns app.services.queries.comments
+(ns app.rpc.queries.comments
   (:require
    [app.common.spec :as us]
    [app.db :as db]
-   [app.services.queries :as sq]
-   [app.services.queries.files :as files]
-   [app.services.queries.teams :as teams]
+   [app.rpc.queries.files :as files]
+   [app.rpc.queries.teams :as teams]
+   [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
 
 (defn decode-row
@@ -34,9 +34,9 @@
                  :opt-un [::file-id ::team-id])
          #(or (:file-id %) (:team-id %))))
 
-(sq/defquery ::comment-threads
-  [{:keys [profile-id file-id] :as params}]
-  (with-open [conn (db/open)]
+(sv/defmethod ::comment-threads
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
+  (with-open [conn (db/open pool)]
     (files/check-read-permissions! conn profile-id file-id)
     (retrieve-comment-threads conn params)))
 
@@ -77,9 +77,9 @@
 (s/def ::unread-comment-threads
   (s/keys :req-un [::profile-id ::team-id]))
 
-(sq/defquery ::unread-comment-threads
-  [{:keys [profile-id team-id] :as params}]
-  (with-open [conn (db/open)]
+(sv/defmethod ::unread-comment-threads
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
+  (with-open [conn (db/open pool)]
     (teams/check-read-permissions! conn profile-id team-id)
     (retrieve-unread-comment-threads conn params)))
 
@@ -122,9 +122,9 @@
 (s/def ::comment-thread
   (s/keys :req-un [::profile-id ::file-id ::id]))
 
-(sq/defquery ::comment-thread
-  [{:keys [profile-id file-id id] :as params}]
-  (with-open [conn (db/open)]
+(sv/defmethod ::comment-thread
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id id] :as params}]
+  (with-open [conn (db/open pool)]
     (files/check-read-permissions! conn profile-id file-id)
     (let [sql (str "with threads as (" sql:comment-threads ")"
                    "select * from threads where id = ?")]
@@ -141,9 +141,9 @@
 (s/def ::comments
   (s/keys :req-un [::profile-id ::thread-id]))
 
-(sq/defquery ::comments
-  [{:keys [profile-id thread-id] :as params}]
-  (with-open [conn (db/open)]
+(sv/defmethod ::comments
+  [{:keys [pool] :as cfg} {:keys [profile-id thread-id] :as params}]
+  (with-open [conn (db/open pool)]
     (let [thread (db/get-by-id conn :comment-thread thread-id)]
       (files/check-read-permissions! conn profile-id (:file-id thread))
       (retrieve-comments conn thread-id))))

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

@@ -7,15 +7,16 @@
 ;;
 ;; Copyright (c) 2020 UXBOX Labs SL
 
-(ns app.services.queries.files
+(ns app.rpc.queries.files
   (:require
    [app.common.exceptions :as ex]
    [app.common.pages.migrations :as pmg]
    [app.common.spec :as us]
    [app.db :as db]
-   [app.services.queries :as sq]
-   [app.services.queries.projects :as projects]
+   [app.rpc.permissions :as perms]
+   [app.rpc.queries.projects :as projects]
    [app.util.blob :as blob]
+   [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
 
 (declare decode-row)
@@ -59,31 +60,18 @@
     where f.id = ?
       and ppr.profile_id = ?")
 
-(defn check-edition-permissions!
+(defn- retrieve-file-permissions
   [conn profile-id file-id]
-  (let [rows (db/exec! conn [sql:file-permissions
-                             file-id profile-id
-                             file-id profile-id
-                             file-id profile-id])]
-    (when (empty? rows)
-      (ex/raise :type :not-found))
+  (db/exec! conn [sql:file-permissions
+                  file-id profile-id
+                  file-id profile-id
+                  file-id profile-id]))
 
-    (when-not (or (some :can-edit rows)
-                  (some :is-admin rows)
-                  (some :is-owner rows))
-      (ex/raise :type :validation
-                :code :not-authorized))))
+(def check-edition-permissions!
+  (perms/make-edition-check-fn retrieve-file-permissions))
 
-
-(defn check-read-permissions!
-  [conn profile-id file-id]
-  (let [rows (db/exec! conn [sql:file-permissions
-                             file-id profile-id
-                             file-id profile-id
-                             file-id profile-id])]
-    (when-not (seq rows)
-      (ex/raise :type :validation
-                :code :not-authorized))))
+(def check-read-permissions!
+  (perms/make-read-check-fn retrieve-file-permissions))
 
 
 ;; --- Query: Files search
@@ -111,11 +99,6 @@
         and (ppr.is_admin = true or
              ppr.is_owner = true or
              ppr.can_edit = true)
-      union
-     select p.*
-       from project as p
-      where p.team_id = uuid_nil()
-        and p.deleted_at is null
    )
    select distinct f.*
      from file as f
@@ -127,9 +110,9 @@
 (s/def ::search-files
   (s/keys :req-un [::profile-id ::team-id ::search-term]))
 
-(sq/defquery ::search-files
-  [{:keys [profile-id team-id search-term] :as params}]
-  (let [rows (db/exec! db/pool [sql:search-files
+(sv/defmethod ::search-files
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id search-term] :as params}]
+  (let [rows (db/exec! pool [sql:search-files
                                 profile-id team-id
                                 profile-id team-id
                                 search-term])]
@@ -149,9 +132,9 @@
 (s/def ::files
   (s/keys :req-un [::profile-id ::project-id]))
 
-(sq/defquery ::files
-  [{:keys [profile-id project-id] :as params}]
-  (with-open [conn (db/open)]
+(sv/defmethod ::files
+  [{:keys [pool] :as cfg} {:keys [profile-id project-id] :as params}]
+  (with-open [conn (db/open pool)]
     (projects/check-read-permissions! conn profile-id project-id)
     (into [] decode-row-xf (db/exec! conn [sql:files project-id]))))
 
@@ -160,25 +143,25 @@
 
 (defn retrieve-file
   [conn id]
-  (let [file (db/get-by-id conn :file id)]
-    (-> (decode-row file)
-        (pmg/migrate-file))))
+  (-> (db/get-by-id conn :file id)
+      (decode-row)
+      (pmg/migrate-file)))
 
 (s/def ::file
   (s/keys :req-un [::profile-id ::id]))
 
-(sq/defquery ::file
-  [{:keys [profile-id id] :as params}]
-  (db/with-atomic [conn db/pool]
+(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)))
 
 (s/def ::page
   (s/keys :req-un [::profile-id ::id ::file-id]))
 
-(sq/defquery ::page
-  [{:keys [profile-id file-id id]}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::page
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id id]}]
+  (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id file-id)
     (let [file (retrieve-file conn file-id)]
       (get-in file [:data :pages-index id]))))
@@ -199,9 +182,9 @@
 (s/def ::shared-files
   (s/keys :req-un [::profile-id ::team-id]))
 
-(sq/defquery ::shared-files
-  [{:keys [profile-id team-id] :as params}]
-  (into [] decode-row-xf (db/exec! db/pool [sql:shared-files team-id])))
+(sv/defmethod ::shared-files
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id] :as params}]
+  (into [] decode-row-xf (db/exec! pool [sql:shared-files team-id])))
 
 
 ;; --- Query: File Libraries used by a File
@@ -237,9 +220,9 @@
 (s/def ::file-libraries
   (s/keys :req-un [::profile-id ::file-id]))
 
-(sq/defquery ::file-libraries
-  [{:keys [profile-id file-id] :as params}]
-  (db/with-atomic [conn db/pool]
+(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)))
 
@@ -263,9 +246,9 @@
 (s/def ::file-library
   (s/keys :req-un [::profile-id ::file-id]))
 
-(sq/defquery ::file-library
-  [{:keys [profile-id file-id] :as params}]
-  (db/with-atomic [conn db/pool]
+(sv/defmethod ::file-library
+  [{:keys [pool] :as cfg} {:keys [profile-id file-id] :as params}]
+  (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id file-id) ;; TODO: this should check read permissions
     (retrieve-file-library conn file-id)))
 

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

@@ -7,13 +7,13 @@
 ;;
 ;; Copyright (c) 2020 UXBOX Labs SL
 
-(ns app.services.queries.profile
+(ns app.rpc.queries.profile
   (:require
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
    [app.db :as db]
-   [app.services.queries :as sq]
+   [app.util.services :as sv]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]))
 
@@ -38,11 +38,10 @@
 (s/def ::profile
   (s/keys :opt-un [::profile-id]))
 
-(sq/defquery ::profile
-  [{:keys [profile-id] :as params}]
+(sv/defmethod ::profile {:auth false}
+  [{:keys [pool] :as cfg} {:keys [profile-id] :as params}]
   (if profile-id
-    (with-open [conn (db/open)]
-      (retrieve-profile conn profile-id))
+    (retrieve-profile pool profile-id)
     {:id uuid/zero
      :fullname "Anonymous User"}))
 

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

@@ -7,13 +7,13 @@
 ;;
 ;; Copyright (c) 2020 UXBOX Labs SL
 
-(ns app.services.queries.projects
+(ns app.rpc.queries.projects
   (:require
-   [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.db :as db]
-   [app.services.queries :as sq]
-   [app.services.queries.teams :as teams]
+   [app.rpc.permissions :as perms]
+   [app.rpc.queries.teams :as teams]
+   [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
 
 ;; --- Check Project Permissions
@@ -34,29 +34,17 @@
     where ppr.project_id = ?
       and ppr.profile_id = ?")
 
-(defn check-edition-permissions!
+(defn- retrieve-project-permissions
   [conn profile-id project-id]
-  (let [rows (db/exec! conn [sql:project-permissions
-                             project-id profile-id
-                             project-id profile-id])]
-    (when (empty? rows)
-      (ex/raise :type :not-found))
-    (when-not (or (some :can-edit rows)
-                  (some :is-admin rows)
-                  (some :is-owner rows))
-      (ex/raise :type :validation
-                :code :not-authorized))))
+  (db/exec! conn [sql:project-permissions
+                  project-id profile-id
+                  project-id profile-id]))
 
-(defn check-read-permissions!
-  [conn profile-id project-id]
-  (let [rows (db/exec! conn [sql:project-permissions
-                             project-id profile-id
-                             project-id profile-id])]
-
-    (when-not (seq rows)
-      (ex/raise :type :validation
-                :code :not-authorized))))
+(def check-edition-permissions!
+  (perms/make-edition-check-fn retrieve-project-permissions))
 
+(def check-read-permissions!
+  (perms/make-read-check-fn retrieve-project-permissions))
 
 
 ;; --- Query: Projects
@@ -68,9 +56,9 @@
 (s/def ::projects
   (s/keys :req-un [::profile-id ::team-id]))
 
-(sq/defquery ::projects
-  [{:keys [profile-id team-id]}]
-  (with-open [conn (db/open)]
+(sv/defmethod ::projects
+  [{:keys [pool]} {:keys [profile-id team-id]}]
+  (with-open [conn (db/open pool)]
     (teams/check-read-permissions! conn profile-id team-id)
     (retrieve-projects conn profile-id team-id)))
 
@@ -100,9 +88,9 @@
 (s/def ::project
   (s/keys :req-un [::profile-id ::id]))
 
-(sq/defquery ::project
-  [{:keys [profile-id id]}]
-  (with-open [conn (db/open)]
+(sv/defmethod ::project
+  [{:keys [pool]} {:keys [profile-id id]}]
+  (with-open [conn (db/open pool)]
     (let [project (db/get-by-id conn :project id)]
       (check-read-permissions! conn profile-id id)
       project)))

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

@@ -7,13 +7,13 @@
 ;;
 ;; Copyright (c) 2020 UXBOX Labs SL
 
-(ns app.services.queries.recent-files
+(ns app.rpc.queries.recent-files
   (:require
    [app.common.spec :as us]
    [app.db :as db]
-   [app.services.queries :as sq]
-   [app.services.queries.files :refer [decode-row-xf]]
-   [app.services.queries.teams :as teams]
+   [app.rpc.queries.files :refer [decode-row-xf]]
+   [app.rpc.queries.teams :as teams]
+   [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
 
 (def sql:recent-files
@@ -35,9 +35,9 @@
 (s/def ::recent-files
   (s/keys :req-un [::profile-id ::team-id]))
 
-(sq/defquery ::recent-files
-  [{:keys [profile-id team-id]}]
-  (with-open [conn (db/open)]
+(sv/defmethod ::recent-files
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
+  (with-open [conn (db/open pool)]
     (teams/check-read-permissions! conn profile-id team-id)
     (let [files (db/exec! conn [sql:recent-files team-id])]
       (into [] decode-row-xf files))))

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

@@ -7,13 +7,14 @@
 ;;
 ;; Copyright (c) 2020 UXBOX Labs SL
 
-(ns app.services.queries.teams
+(ns app.rpc.queries.teams
   (:require
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.db :as db]
-   [app.services.queries :as sq]
-   [app.services.queries.profile :as profile]
+   [app.rpc.permissions :as perms]
+   [app.rpc.queries.profile :as profile]
+   [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
 
 ;; --- Team Edition Permissions
@@ -26,24 +27,15 @@
     where tpr.profile_id = ?
       and tpr.team_id = ?")
 
-(defn check-edition-permissions!
+(defn- retrieve-team-permissions
   [conn profile-id team-id]
-  (let [row (db/exec-one! conn [sql:team-permissions profile-id team-id])]
-    (when-not (or (:can-edit row)
-                  (:is-admin row)
-                  (:is-owner row))
-      (ex/raise :type :validation
-                :code :not-authorized))
-    row))
+  (db/exec! conn [sql:team-permissions profile-id team-id]))
 
-(defn check-read-permissions!
-  [conn profile-id team-id]
-  (let [row (db/exec-one! conn [sql:team-permissions profile-id team-id])]
-    ;; when row is found this means that read permission is granted.
-    (when-not row
-      (ex/raise :type :validation
-                :code :not-authorized))
-    row))
+(def check-edition-permissions!
+  (perms/make-edition-check-fn retrieve-team-permissions))
+
+(def check-read-permissions!
+  (perms/make-read-check-fn retrieve-team-permissions))
 
 
 ;; --- Query: Teams
@@ -54,9 +46,9 @@
 (s/def ::teams
   (s/keys :req-un [::profile-id]))
 
-(sq/defquery ::teams
-  [{:keys [profile-id]}]
-  (with-open [conn (db/open)]
+(sv/defmethod ::teams
+  [{:keys [pool] :as cfg} {:keys [profile-id]}]
+  (with-open [conn (db/open pool)]
     (retrieve-teams conn profile-id)))
 
 (def sql:teams
@@ -84,9 +76,9 @@
 (s/def ::team
   (s/keys :req-un [::profile-id ::id]))
 
-(sq/defquery ::team
-  [{:keys [profile-id id]}]
-  (with-open [conn (db/open)]
+(sv/defmethod ::team
+  [{:keys [pool] :as cfg} {:keys [profile-id id]}]
+  (with-open [conn (db/open pool)]
     (retrieve-team conn profile-id id)))
 
 (defn retrieve-team
@@ -96,7 +88,7 @@
         result   (db/exec-one! conn [sql (:default-team-id defaults) profile-id team-id])]
     (when-not result
       (ex/raise :type :not-found
-                :code :object-does-not-exists))
+                :code :team-does-not-exist))
     result))
 
 
@@ -108,10 +100,10 @@
 (s/def ::team-members
   (s/keys :req-un [::profile-id ::team-id]))
 
-(sq/defquery ::team-members
-  [{:keys [profile-id team-id]}]
-  (with-open [conn (db/open)]
-    (check-edition-permissions! conn profile-id team-id)
+(sv/defmethod ::team-members
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
+  (with-open [conn (db/open pool)]
+    (check-read-permissions! conn profile-id team-id)
     (retrieve-team-members conn team-id)))
 
 (def sql:team-members
@@ -119,7 +111,8 @@
           p.id,
           p.email,
           p.fullname as name,
-          p.photo,
+          p.fullname as fullname,
+          p.photo_id,
           p.is_active
      from team_profile_rel as tp
      join profile as p on (p.id = tp.profile_id)
@@ -141,15 +134,15 @@
                  :opt-un [::team-id ::file-id])
          #(or (:team-id %) (:file-id %))))
 
-(sq/defquery ::team-users
-  [{:keys [profile-id team-id file-id]}]
-  (with-open [conn (db/open)]
+(sv/defmethod ::team-users
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id file-id]}]
+  (with-open [conn (db/open pool)]
     (if team-id
       (do
-        (check-edition-permissions! conn profile-id team-id)
+        (check-read-permissions! conn profile-id team-id)
         (retrieve-users conn team-id))
       (let [{team-id :id} (retrieve-team-for-file conn file-id)]
-        (check-edition-permissions! conn profile-id team-id)
+        (check-read-permissions! conn profile-id team-id)
         (retrieve-users conn team-id)))))
 
 ;; This is a similar query to team members but can contain more data
@@ -157,18 +150,18 @@
 ;; implemented in UI)
 
 (def sql:team-users
-  "select pf.id, pf.fullname, pf.photo
+  "select pf.id, pf.fullname, pf.photo_id
      from profile as pf
     inner join team_profile_rel as tpr on (tpr.profile_id = pf.id)
     where tpr.team_id = ?
     union
-   select pf.id, pf.fullname, pf.photo
+   select pf.id, pf.fullname, pf.photo_id
      from profile as pf
     inner join project_profile_rel as ppr on (ppr.profile_id = pf.id)
     inner join project as p on (ppr.project_id = p.id)
     where p.team_id = ?
    union
-   select pf.id, pf.fullname, pf.photo
+   select pf.id, pf.fullname, pf.photo_id
      from profile as pf
     inner join file_profile_rel as fpr on (fpr.profile_id = pf.id)
     inner join file as f on (fpr.file_id = f.id)
@@ -197,9 +190,9 @@
 (s/def ::team-stats
   (s/keys :req-un [::profile-id ::team-id]))
 
-(sq/defquery ::team-stats
-  [{:keys [profile-id team-id]}]
-  (with-open [conn (db/open)]
+(sv/defmethod ::team-stats
+  [{:keys [pool] :as cfg} {:keys [profile-id team-id]}]
+  (with-open [conn (db/open pool)]
     (check-read-permissions! conn profile-id team-id)
     (retrieve-team-stats conn team-id)))
 

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

@@ -7,14 +7,14 @@
 ;;
 ;; Copyright (c) 2020 UXBOX Labs SL
 
-(ns app.services.queries.viewer
+(ns app.rpc.queries.viewer
   (:require
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
    [app.db :as db]
-   [app.services.queries :as sq]
-   [app.services.queries.files :as files]
-   [app.services.queries.teams :as teams]
+   [app.rpc.queries.files :as files]
+   [app.rpc.queries.teams :as teams]
+   [app.util.services :as sv]
    [clojure.spec.alpha :as s]))
 
 ;; --- Query: Viewer Bundle (by Page ID)
@@ -42,9 +42,9 @@
   (s/keys :req-un [::file-id ::page-id]
           :opt-un [::profile-id ::token]))
 
-(sq/defquery ::viewer-bundle
-  [{:keys [profile-id file-id page-id token] :as params}]
-  (db/with-atomic [conn db/pool]
+(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)
           project (retrieve-project conn (:project-id file))
           page    (get-in file [:data :pages-index page-id])
@@ -71,8 +71,8 @@
   [conn file-id page-id token]
   (let [sql "select exists(select 1 from file_share_token where file_id=? and page_id=? and token=?) as exists"]
     (when-not (:exists (db/exec-one! conn [sql file-id page-id token]))
-      (ex/raise :type :authorization
-                :code :unauthorized-token))))
+      (ex/raise :type :not-found
+                :code :object-not-found))))
 
 (defn retrieve-shared-token
   [conn file-id page-id]

backend/src/app/services.clj

@@ -1,43 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
-
-(ns app.services
-  "A initialization of services."
-  (:require
-   [app.services.middleware :as middleware]
-   [app.util.dispatcher :as uds]
-   [mount.core :as mount :refer [defstate]]))
-
-;; --- Initialization
-
-(defn- load-query-services
-  []
-  (require 'app.services.queries.projects)
-  (require 'app.services.queries.files)
-  (require 'app.services.queries.comments)
-  (require 'app.services.queries.profile)
-  (require 'app.services.queries.recent-files)
-  (require 'app.services.queries.viewer))
-
-(defn- load-mutation-services
-  []
-  (require 'app.services.mutations.demo)
-  (require 'app.services.mutations.media)
-  (require 'app.services.mutations.projects)
-  (require 'app.services.mutations.files)
-  (require 'app.services.mutations.comments)
-  (require 'app.services.mutations.profile)
-  (require 'app.services.mutations.viewer)
-  (require 'app.services.mutations.verify-token))
-
-(defstate query-services
-  :start (load-query-services))
-
-(defstate mutation-services
-  :start (load-mutation-services))