🎉 Add server repl helper for duplicate file.

Add more Chinese translations

.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)
              ]}}}
 

.github/ISSUE_TEMPLATE/bug_report.md

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

.gitignore

@@ -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,108 @@
+# CHANGELOG #
+
+## :rocket: Next
+
+### :sparkles: New features
+
+### :bug: Bugs fixed
+
+### :heart: Community contributions by (Thank you!)
+
+
+## 1.3.0-alpha
+
+### :sparkles: New features
+
+- Add emailcatcher and ldap test containers to devenv. [#506](https://github.com/penpot/penpot/pull/506)
+- Add major refactor of internal pubsub/redis code; improves scalability and performance [#640](https://github.com/penpot/penpot/pull/640)
+- Add more chinese transtions [#687](https://github.com/penpot/penpot/pull/687)
+- Add more presets for artboard [#654](https://github.com/penpot/penpot/pull/654)
+- Add optional loki integration [#645](https://github.com/penpot/penpot/pull/645)
+- Add proper http session lifecycle handling.
+- Allow to set border radius of each rect corner individually
+- Bounce & Complaint handling [#635](https://github.com/penpot/penpot/pull/635)
+- Disable groups interactions when holding "Ctrl" key (deep selection)
+- New action in context menu to "edit" some shapes (binded to key "Enter")
+
+
+### :bug: Bugs fixed
+
+- Add more improvements to french translation strings [#591](https://github.com/penpot/penpot/pull/591)
+- Add some missing database indexes (mainly improves performance on large databases on file-update rpc method, and some background tasks).
+- Disables filters in masking elements (problem with Firefox rendering)
+- Drawing tool will have priority over resize/rotate handlers [Taiga #1225](https://tree.taiga.io/project/penpot/issue/1225)
+- Fix broken bounding box on editing paths [Taiga #1254](https://tree.taiga.io/project/penpot/issue/1254)
+- Fix corner cases on invitation/signup flows.
+- Fix errors on onboarding file [Taiga #1287](https://tree.taiga.io/project/penpot/issue/1287)
+- Fix infinite recursion on logout.
+- Fix issues with frame selection [Taiga #1300](https://tree.taiga.io/project/penpot/issue/1300), [Taiga #1255](https://tree.taiga.io/project/penpot/issue/1255)
+- Fix local fonts error [#691](https://github.com/penpot/penpot/issues/691)
+- Fix problem width handoff code generation [Taiga #1204](https://tree.taiga.io/project/penpot/issue/1204)
+- Fix problem with indices refreshing on page changes [#646](https://github.com/penpot/penpot/issues/646)
+- Have language change notification written in the new language [Taiga #1205](https://tree.taiga.io/project/penpot/issue/1205)
+- Hide register screen when registration is disabled [#598](https://github.com/penpot/penpot/issues/598)
+- Properly handle errors on github, gitlab and ldap auth backends.
+- Properly mark profile auth backend (on first register/ auth with 3rd party auth provider).
+- Refactor LDAP auth backend.
+
+
+### :heart: Community contributions by (Thank you!)
+
+- girafic [#538](https://github.com/penpot/penpot/pull/654)
+- arkhi [#591](https://github.com/penpot/penpot/pull/591)
+
+
+## 1.2.0-alpha
+
+### :sparkles: New features
+
+- Add horizontal/vertical flip
+- Add images lock proportions by default [#541](https://github.com/penpot/penpot/discussions/541), [#609](https://github.com/penpot/penpot/issues/609)
+- 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)
+
+
+### :bug: Bugs fixed
+
+- Fix 404 when access shared link [#615](https://github.com/penpot/penpot/issues/615)
+- Fix 500 when requestion password reset
+- Fix Problems when transforming path shapes [Taiga #1170](https://tree.taiga.io/project/penpot/issue/1170)
+- Fix 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)
+
+### :heart: Community contributions by (Thank you!)
+
+- 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,51 @@
   "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"}
+  org.clojure/tools.cli {:mvn/version "1.0.194"}
 
   ;; 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.zeromq/jeromq {:mvn/version "0.5.2"}
+
+
+  org.graalvm.js/js {:mvn/version "20.3.0"}
+  com.taoensso/nippy {:mvn/version "3.1.1"}
+  com.github.luben/zstd-jni {:mvn/version "1.4.8-3"}
 
   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"}
+  io.lettuce/lettuce-core {:mvn/version "6.0.2.RELEASE"}
   java-http-clj/java-http-clj {:mvn/version "0.4.1"}
 
-  info.sunng/ring-jetty9-adapter {:mvn/version "0.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 +62,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.common.exceptions :as ex]
+   [app.config :as cfg]
+   [app.main :as main]
+   [app.util.time :as dt]
+   [app.util.transit :as t]
+   [app.util.json :as json]
+   [clojure.java.io :as io]
+   [clojure.pprint :refer [pprint]]
+   [clojure.repl :refer :all]
    [clojure.spec.alpha :as s]
+   [clojure.spec.gen.alpha :as sgen]
+   [clojure.test :as test]
+   [clojure.test :as test]
    [clojure.tools.namespace.repl :as repl]
    [clojure.walk :refer [macroexpand-all]]
-   [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]
+   [taoensso.nippy :as nippy]))
+
+(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 @@
+[PENPOT FEEDBACK]: {{subject|abbreviate:19}} (from {{email}})

backend/resources/emails/feedback/en.txt

@@ -0,0 +1,9 @@
+{% if profile %}
+Feedback profile: {{profile.fullname}} <{{profile.email}}> / {{profile.id}}
+{% else %}
+Feedback from: {{email}}
+{% endif %}
+
+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,194 @@
+<!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: 60px;
+        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">UAGT: </div>
+        <div class="table-val">{{user-agent}}</div>
+      </div>
+      {% endif %}
+
+      {% if frontend-version %}
+      <div class="table-row">
+        <div class="table-key">FVER: </div>
+        <div class="table-val">{{frontend-version}}</div>
+      </div>
+      {% endif %}
+
+      <div class="table-row">
+        <div class="table-key">BVER: </div>
+        <div class="table-val">{{version}}</div>
+      </div>
+
+      {% if host %}
+      <div class="table-row">
+        <div class="table-key">HOST: </div>
+        <div class="table-val">{{host}}</div>
+      </div>
+      {% endif %}
+
+      {% if tenant %}
+      <div class="table-row">
+        <div class="table-key">ENV: </div>
+        <div class="table-val">{{tenant}}</div>
+      </div>
+      {% endif %}
+
+      {% if public-uri %}
+      <div class="table-row">
+        <div class="table-key">PURI: </div>
+        <div class="table-val">{{public-uri}}</div>
+      </div>
+      {% endif %}
+
+      {% if type %}
+      <div class="table-row">
+        <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 %}
+
+      {% if error %}
+      <div class="table-row">
+        <div class="table-key">CLSS: </div>
+        <div class="table-val">{{error.class}}</div>
+      </div>
+      {% endif %}
+
+      {% if error %}
+      <div class="table-row">
+        <div class="table-key">HINT: </div>
+        <div class="table-val">{{error.message}}</div>
+      </div>
+      {% endif %}
+
+      {% if method %}
+      <div class="table-row">
+        <div class="table-key">PATH: </div>
+        <div class="table-val">{{method|upper}} {{path}}</div>
+      </div>
+      {% endif %}
+
+      {% if explain %}
+        <div>(<a href="#explain">go to explain</a>)</div>
+      {% endif %}
+      {% if data %}
+        <div>(<a href="#edata">go to edata</a>)</div>
+      {% endif %}
+      {% if error %}
+        <div>(<a href="#trace">go to trace</a>)</div>
+      {% endif %}
+
+      {% if params %}
+      <div id="params" class="table-row multiline">
+        <div class="table-key">PARAMS: </div>
+        <div class="table-val">
+          <pre>{{params}}</pre>
+        </div>
+      </div>
+      {% endif %}
+
+      {% if explain %}
+      <div id="explain" class="table-row multiline">
+        <div class="table-key">EXPLAIN: </div>
+        <div class="table-val">
+          <pre>{{explain}}</pre>
+        </div>
+      </div>
+      {% endif %}
+
+      {% if data %}
+      <div id="edata" class="table-row multiline">
+        <div class="table-key">EDATA: </div>
+        <div class="table-val">
+          <pre>{{data}}</pre>
+        </div>
+      </div>
+      {% endif %}
+
+      {% if error %}
+      <div id="trace" class="table-row multiline">
+        <div class="table-key">TRACE:</div>
+        <div class="table-val">
+          <pre>{{error.trace}}</pre>
+        </div>
+      </div>
+      {% endif %}
+    </div>
+  </body>
+</html>
+

backend/resources/log4j2-bundle.xml

@@ -7,20 +7,15 @@
   </Appenders>
 
   <Loggers>
-    <Logger name="com.zaxxer.hikari" level="error" additivity="false">
-      <AppenderRef ref="console"/>
-    </Logger>
-
-    <Logger name="org.eclipse.jetty" level="info" additivity="false">
-      <AppenderRef ref="console"/>
-    </Logger>
+    <Logger name="com.zaxxer.hikari" level="error" />
+    <Logger name="org.eclipse.jetty" level="error" />
 
     <Logger name="app" level="debug" additivity="false">
-      <AppenderRef ref="console"/>
+      <AppenderRef ref="console" />
     </Logger>
 
     <Root level="info">
-      <AppenderRef ref="console"/>
+      <AppenderRef ref="console" />
     </Root>
   </Loggers>
 </Configuration>

backend/resources/log4j2.xml

@@ -13,27 +13,33 @@
       <DefaultRolloverStrategy max="9"/>
     </RollingFile>
 
-    <CljFn name="error-reporter" ns="app.error-reporter" fn="enqueue">
-      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] [%t] %level{length=1} %logger{36} - %msg%n"/>
-    </CljFn>
+    <JeroMQ name="zmq">
+      <Property name="endpoint">tcp://localhost:45556</Property>
+      <JsonLayout complete="false" compact="true" includeTimeMillis="true" stacktraceAsString="true" properties="true" />
+    </JeroMQ>
   </Appenders>
 
   <Loggers>
-    <Logger name="com.zaxxer.hikari" level="error" additivity="false" />
-    <Logger name="org.eclipse.jetty" level="error" additivity="false" />
-    <Logger name="io.lettuce" level="error" additivity="false" />
+    <Logger name="com.zaxxer.hikari" level="error"/>
+    <Logger name="io.lettuce" level="error" />
+    <Logger name="org.eclipse.jetty" level="error" />
 
     <Logger name="app.cli" level="debug" additivity="false">
       <AppenderRef ref="console"/>
     </Logger>
 
-    <Logger name="app.error-reporter" level="debug" additivity="false">
-      <AppenderRef ref="console"/>
+    <Logger name="app.loggers" level="debug" additivity="false">
+      <AppenderRef ref="main" level="debug" />
     </Logger>
 
     <Logger name="app" level="debug" additivity="false">
-      <AppenderRef ref="main" level="debug" />
-      <AppenderRef ref="error-reporter" level="error" />
+      <AppenderRef ref="main" level="trace" />
+      <AppenderRef ref="zmq" level="debug" />
+    </Logger>
+
+    <Logger name="user" level="trace" additivity="false">
+      <AppenderRef ref="main" level="trace" />
+      <AppenderRef ref="zmq" level="debug" />
     </Logger>
 
     <Root level="info">

backend/scripts/build.sh

@@ -17,18 +17,16 @@ done
 cp ./resources/log4j2-bundle.xml ./target/dist/log4j2.xml
 cp -r ./src ./target/dist/main
 cp -r ./resources/emails ./target/dist/main/
+cp -r ./resources/svgclean.js ./target/dist/main/
+cp -r ./resources/error-report.tmpl ./target/dist/main/
 cp -r ../common ./target/dist/common
 
 echo $NEWCP > ./target/dist/classpath;
 
 tee -a ./target/dist/run.sh  >> /dev/null <<EOF
 #!/usr/bin/env bash
-
 CP="$NEWCP"
 
-# Exports
-
-# Find java executable
 set +e
 JAVA_CMD=\$(type -p java)
 
@@ -47,7 +45,33 @@ 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
+
+tee -a ./target/dist/manage.sh  >> /dev/null <<EOF
+#!/usr/bin/env bash
+CP="$NEWCP"
+
+set +e
+JAVA_CMD=\$(type -p java)
+
+set -e
+if [[ ! -n "\$JAVA_CMD" ]]; then
+  if [[ -n "\$JAVA_HOME" ]] && [[ -x "\$JAVA_HOME/bin/java" ]]; then
+    JAVA_CMD="\$JAVA_HOME/bin/java"
+  else
+    >&2 echo "Couldn't find 'java'. Please set JAVA_HOME."
+    exit 1
+  fi
+fi
+
+if [ -f ./environ ]; then
+   source ./environ
+fi
+
+exec \$JAVA_CMD \$JVM_OPTS -classpath \$CP -Dlog4j.configurationFile=./log4j2.xml clojure.main -m app.cli.manage "\$@"
 EOF
 
 chmod +x ./target/dist/run.sh
+chmod +x ./target/dist/manage.sh
+

backend/scripts/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,10 @@
 #!/usr/bin/env bash
-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
+export PENPOT_ASSERTS_ENABLED=true
+
+export OPTIONS="-A:jmx-remote:dev -J-Dclojure.tools.logging.factory=clojure.tools.logging.impl/log4j2-factory -J-Xms512m -J-Xmx512m"
+export OPTIONS_EVAL="nil"
+# export OPTIONS_EVAL="(set! *warn-on-reflection* true)"
+
+set -ex
+exec clojure $OPTIONS -M -e "$OPTIONS_EVAL" -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")})
+                                            :is-demo true
+                                            :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/manage.clj

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

backend/src/app/cli/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

@@ -5,173 +5,228 @@
 ;; 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.config
   "A configuration management."
+  (:refer-clojure :exclude [get])
   (:require
    [app.common.spec :as us]
    [app.common.version :as v]
    [app.util.time :as dt]
+   [clojure.core :as c]
    [clojure.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"
+   :host "devenv"
+   :tenant "dev"
    :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/"
+   :loggers-zmq-uri "tcp://localhost:45556"
+
+   :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"
+   :smtp-default-reply-to "Penpot <no-reply@example.com>"
+   :smtp-default-from "Penpot <no-reply@example.com>"
 
-   :host "devenv"
+   :profile-complaint-max-age (dt/duration {:days 7})
+   :profile-complaint-threshold 2
+
+   :profile-bounce-max-age (dt/duration {:days 7})
+   :profile-bounce-threshold 10
 
    :allow-demo-users true
    :registration-enabled true
    :registration-domain-whitelist ""
-   :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"
-   ;:ldap-auth-port 389
-   ;:ldap-bind-dn "cn=admin,dc=ldap,dc=mysupercompany,dc=com"
-   ;:ldap-bind-password "verysecure"
-   ;:ldap-auth-ssl false
-   ;:ldap-auth-starttls false
-   ;:ldap-auth-base-dn "ou=People,dc=ldap,dc=mysupercompany,dc=com"
+   :ldap-user-query "(|(uid=$username)(mail=$username))"
+   :ldap-attrs-username "uid"
+   :ldap-attrs-email "mail"
+   :ldap-attrs-fullname "cn"
+   :ldap-attrs-photo "jpegPhoto"
 
-   :ldap-auth-user-query "(|(uid=$username)(mail=$username))"
-   :ldap-auth-username-attribute "uid"
-   :ldap-auth-email-attribute "mail"
-   :ldap-auth-fullname-attribute "displayName"
-   :ldap-auth-avatar-attribute "jpegPhoto"})
+   ;; a server prop key where initial project is stored.
+   :initial-project-skey "initial-project"
+   })
 
-(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 ::allow-demo-users ::us/boolean)
+(s/def ::asserts-enabled ::us/boolean)
+(s/def ::assets-path ::us/string)
 (s/def ::database-password (s/nilable ::us/string))
 (s/def ::database-uri ::us/string)
-(s/def ::redis-uri ::us/string)
-(s/def ::assets-uri ::us/string)
-(s/def ::assets-directory ::us/string)
-(s/def ::media-uri ::us/string)
-(s/def ::media-directory ::us/string)
-(s/def ::secret-key ::us/string)
-
-(s/def ::host ::us/string)
+(s/def ::database-username (s/nilable ::us/string))
+(s/def ::default-blob-version ::us/integer)
 (s/def ::error-report-webhook ::us/string)
-(s/def ::smtp-enabled ::us/boolean)
-(s/def ::smtp-default-reply-to ::us/email)
-(s/def ::smtp-default-from ::us/email)
-(s/def ::smtp-host ::us/string)
-(s/def ::smtp-port ::us/integer)
-(s/def ::smtp-username (s/nilable ::us/string))
-(s/def ::smtp-password (s/nilable ::us/string))
-(s/def ::smtp-tls ::us/boolean)
-(s/def ::smtp-ssl ::us/boolean)
-(s/def ::allow-demo-users ::us/boolean)
-(s/def ::registration-enabled ::us/boolean)
-(s/def ::registration-domain-whitelist ::us/string)
-(s/def ::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 ::google-client-id ::us/string)
-(s/def ::google-client-secret ::us/string)
-
+(s/def ::feedback-destination ::us/string)
+(s/def ::feedback-enabled ::us/boolean)
+(s/def ::feedback-reply-to ::us/email)
+(s/def ::feedback-token ::us/string)
+(s/def ::github-client-id ::us/string)
+(s/def ::github-client-secret ::us/string)
+(s/def ::gitlab-base-uri ::us/string)
 (s/def ::gitlab-client-id ::us/string)
 (s/def ::gitlab-client-secret ::us/string)
-(s/def ::gitlab-base-uri ::us/string)
-
-(s/def ::ldap-auth-host ::us/string)
-(s/def ::ldap-auth-port ::us/integer)
+(s/def ::google-client-id ::us/string)
+(s/def ::google-client-secret ::us/string)
+(s/def ::host ::us/string)
+(s/def ::http-server-port ::us/integer)
+(s/def ::http-session-cookie-name ::us/string)
+(s/def ::http-session-idle-max-age ::dt/duration)
+(s/def ::http-session-updater-batch-max-age ::dt/duration)
+(s/def ::http-session-updater-batch-max-size ::us/integer)
+(s/def ::initial-project-skey ::us/string)
+(s/def ::ldap-attrs-email ::us/string)
+(s/def ::ldap-attrs-fullname ::us/string)
+(s/def ::ldap-attrs-photo ::us/string)
+(s/def ::ldap-attrs-username ::us/string)
+(s/def ::ldap-base-dn ::us/string)
 (s/def ::ldap-bind-dn ::us/string)
 (s/def ::ldap-bind-password ::us/string)
-(s/def ::ldap-auth-ssl ::us/boolean)
-(s/def ::ldap-auth-starttls ::us/boolean)
-(s/def ::ldap-auth-base-dn ::us/string)
-(s/def ::ldap-auth-user-query ::us/string)
-(s/def ::ldap-auth-username-attribute ::us/string)
-(s/def ::ldap-auth-email-attribute ::us/string)
-(s/def ::ldap-auth-fullname-attribute ::us/string)
-(s/def ::ldap-auth-avatar-attribute ::us/string)
+(s/def ::ldap-host ::us/string)
+(s/def ::ldap-port ::us/integer)
+(s/def ::ldap-ssl ::us/boolean)
+(s/def ::ldap-starttls ::us/boolean)
+(s/def ::ldap-user-query ::us/string)
+(s/def ::loggers-loki-uri ::us/string)
+(s/def ::loggers-zmq-uri ::us/string)
+(s/def ::media-directory ::us/string)
+(s/def ::media-uri ::us/string)
+(s/def ::profile-bounce-max-age ::dt/duration)
+(s/def ::profile-bounce-threshold ::us/integer)
+(s/def ::profile-complaint-max-age ::dt/duration)
+(s/def ::profile-complaint-threshold ::us/integer)
+(s/def ::public-uri ::us/string)
+(s/def ::redis-uri ::us/string)
+(s/def ::registration-domain-whitelist ::us/string)
+(s/def ::registration-enabled ::us/boolean)
+(s/def ::rlimits-image ::us/integer)
+(s/def ::rlimits-password ::us/integer)
+(s/def ::smtp-default-from ::us/string)
+(s/def ::smtp-default-reply-to ::us/string)
+(s/def ::smtp-enabled ::us/boolean)
+(s/def ::smtp-host ::us/string)
+(s/def ::smtp-password (s/nilable ::us/string))
+(s/def ::smtp-port ::us/integer)
+(s/def ::smtp-ssl ::us/boolean)
+(s/def ::smtp-tls ::us/boolean)
+(s/def ::smtp-username (s/nilable ::us/string))
+(s/def ::srepl-host ::us/string)
+(s/def ::srepl-port ::us/integer)
+(s/def ::storage-backend ::us/keyword)
+(s/def ::storage-fs-directory ::us/string)
+(s/def ::storage-s3-bucket ::us/string)
+(s/def ::storage-s3-region ::us/keyword)
+(s/def ::telemetry-enabled ::us/boolean)
+(s/def ::telemetry-server-enabled ::us/boolean)
+(s/def ::telemetry-server-port ::us/integer)
+(s/def ::telemetry-uri ::us/string)
+(s/def ::telemetry-with-taiga ::us/boolean)
+(s/def ::tenant ::us/string)
 
 (s/def ::config
-  (s/keys :opt-un [::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-destination
+                   ::feedback-enabled
+                   ::feedback-reply-to
+                   ::feedback-token
+                   ::github-client-id
+                   ::github-client-secret
+                   ::gitlab-base-uri
+                   ::gitlab-client-id
+                   ::gitlab-client-secret
+                   ::google-client-id
+                   ::google-client-secret
+                   ::host
+                   ::http-server-port
+                   ::http-session-idle-max-age
+                   ::http-session-updater-batch-max-age
+                   ::http-session-updater-batch-max-size
+                   ::initial-project-skey
+                   ::ldap-attrs-email
+                   ::ldap-attrs-fullname
+                   ::ldap-attrs-photo
+                   ::ldap-attrs-username
+                   ::ldap-base-dn
+                   ::ldap-bind-dn
+                   ::ldap-bind-password
+                   ::ldap-host
+                   ::ldap-port
+                   ::ldap-ssl
+                   ::ldap-starttls
+                   ::ldap-user-query
+                   ::local-assets-uri
+                   ::loggers-loki-uri
+                   ::loggers-zmq-uri
+                   ::profile-bounce-max-age
+                   ::profile-bounce-threshold
+                   ::profile-complaint-max-age
+                   ::profile-complaint-threshold
+                   ::public-uri
+                   ::redis-uri
+                   ::registration-domain-whitelist
+                   ::registration-enabled
+                   ::rlimits-image
+                   ::rlimits-password
                    ::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
+                   ::srepl-host
+                   ::srepl-port
+                   ::storage-backend
+                   ::storage-fs-directory
+                   ::storage-s3-bucket
+                   ::storage-s3-region
+                   ::telemetry-enabled
+                   ::telemetry-server-enabled
+                   ::telemetry-server-port
+                   ::telemetry-uri
+                   ::telemetry-with-taiga
+                   ::tenant]))
 
-(defn env->config
+(defn- env->config
   [env]
   (reduce-kv
    (fn [acc k v]
@@ -184,38 +239,30 @@
    {}
    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 version (v/parse "%version%"))
+(def config (read-config env))
+(def test-config (read-test-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 deletion-delay
+  (dt/duration {:days 7}))
 
+(defn get
+  "A configuration getter. Helps code be more testable."
+  ([key]
+   (c/get config key))
+  ([key default]
+   (c/get config key default)))

backend/src/app/db.clj

@@ -11,54 +11,107 @@
   (:require
    [app.common.exceptions :as ex]
    [app.common.geom.point :as gpt]
-   [app.config :as cfg]
+   [app.common.spec :as us]
+   [app.db.sql :as sql]
    [app.metrics :as mtx]
+   [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]]
+   [clojure.tools.logging :as log]
+   [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.lang.AutoCloseable
    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
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare instrument-jdbc!)
+
+(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?)
+
+(defmethod ig/pre-init-spec ::pool [_]
+  (s/keys :req-un [::uri ::name ::min-pool-size ::max-pool-size ::migrations ::mtx/metrics]))
+
+(defmethod ig/init-key ::pool
+  [_ {:keys [migrations metrics] :as cfg}]
+  (log/infof "initialize connection pool '%s' with uri '%s'" (:name cfg) (:uri cfg))
+  (instrument-jdbc! (:registry metrics))
+  (let [pool (create-pool cfg)]
+    (when (seq migrations)
+      (with-open [conn ^AutoCloseable (open pool)]
+        (mg/setup! conn)
+        (doseq [[mname steps] migrations]
+          (mg/migrate! conn {:name (name mname) :steps steps}))))
+    pool))
+
+(defmethod ig/halt-key! ::pool
+  [_ pool]
+  (.close ^HikariDataSource pool))
+
+(defn- instrument-jdbc!
+  [registry]
+  (mtx/instrument-vars!
+   [#'next.jdbc/execute-one!
+    #'next.jdbc/execute!]
+   {:registry registry
+    :type :counter
+    :name "database_query_count"
+    :help "An absolute counter of database queries."}))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; API & Impl
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (def initsql
-  (str "SET statement_timeout = 10000;\n"
-       "SET idle_in_transaction_session_timeout = 30000;"))
+  (str "SET statement_timeout = 120000;\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 +124,7 @@
 
 (defn pool-closed?
   [pool]
-  (.isClosed ^com.zaxxer.hikari.HikariDataSource pool))
+  (.isClosed ^HikariDataSource pool))
 
 (defn- create-pool
   [cfg]
@@ -79,66 +132,96 @@
     (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
-  []
+(defn ^Connection 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 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 +234,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 +260,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)))
@@ -212,7 +297,7 @@
     (pginterval data)
 
     (dt/duration? data)
-    (->> (/ (.toMillis data) 1000.0)
+    (->> (/ (.toMillis ^java.time.Duration data) 1000.0)
          (format "%s seconds")
          (pginterval))
 
@@ -225,7 +310,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 +334,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 +343,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/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

@@ -5,13 +5,15 @@
 ;; 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.emails
   "Main api for send emails."
   (:require
    [app.common.spec :as us]
    [app.config :as cfg]
+   [app.db :as db]
+   [app.db.sql :as sql]
    [app.tasks :as tasks]
    [app.util.emails :as emails]
    [clojure.spec.alpha :as s]))
@@ -41,8 +43,66 @@
                          :priority 200
                          :props email})))
 
+
+(def sql:profile-complaint-report
+  "select (select count(*)
+             from profile_complaint_report
+            where type = 'complaint'
+              and profile_id = ?
+              and created_at > now() - ?::interval) as complaints,
+          (select count(*)
+             from profile_complaint_report
+            where type = 'bounce'
+              and profile_id = ?
+              and created_at > now() - ?::interval) as bounces;")
+
+(defn allow-send-emails?
+  [conn profile]
+  (when-not (:is-muted profile false)
+    (let [complaint-threshold (cfg/get :profile-complaint-threshold)
+          complaint-max-age   (cfg/get :profile-complaint-max-age)
+          bounce-threshold    (cfg/get :profile-bounce-threshold)
+          bounce-max-age      (cfg/get :profile-bounce-max-age)
+
+          {:keys [complaints bounces] :as result}
+          (db/exec-one! conn [sql:profile-complaint-report
+                              (:id profile)
+                              (db/interval complaint-max-age)
+                              (:id profile)
+                              (db/interval bounce-max-age)])]
+
+      (and (< complaints complaint-threshold)
+           (< bounces bounce-threshold)))))
+
+(defn has-complaint-reports?
+  ([conn email] (has-complaint-reports? conn email nil))
+  ([conn email {:keys [threshold] :or {threshold 1}}]
+   (let [reports (db/exec! conn (sql/select :global-complaint-report
+                                            {:email email :type "complaint"}
+                                            {:limit 10}))]
+     (>= (count reports) threshold))))
+
+(defn has-bounce-reports?
+  ([conn email] (has-bounce-reports? conn email nil))
+  ([conn email {:keys [threshold] :or {threshold 1}}]
+   (let [reports (db/exec! conn (sql/select :global-complaint-report
+                                            {:email email :type "bounce"}
+                                            {:limit 10}))]
+     (>= (count reports) threshold))))
+
+
 ;; --- 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

@@ -1,83 +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 Andrey Antukh <niwi@niwi.nz>
-
-(ns app.error-reporter
-  "A mattermost integration for error reporting."
-  (:require
-   [app.common.exceptions :as ex]
-   [app.common.spec :as us]
-   [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]
-   [clojure.core.async :as a]
-   [clojure.data.json :as json]
-   [clojure.spec.alpha :as s]
-   [clojure.tools.logging :as log]
-   [cuerdas.core :as str]
-   [mount.core :as mount :refer [defstate]]
-   [promesa.exec :as px]))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Public API
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defonce enqueue identity)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Implementation
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn- send-to-mattermost!
-  [log-event]
-  (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})})]
-      (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- start
-  []
-  (let [qch (a/chan (a/sliding-buffer 128))]
-    (log/info "Starting error reporter loop.")
-
-    ;; 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))))))
-
-    qch))
-
-(defstate reporter
-  :start (start)
-  :stop  (a/close! reporter))

backend/src/app/http.clj

@@ -5,76 +5,151 @@
 ;; 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 ::oauth map?)
+(s/def ::storage map?)
+(s/def ::assets map?)
+(s/def ::feedback fn?)
+
+(defmethod ig/pre-init-spec ::router [_]
+  (s/keys :req-un [::rpc ::session ::metrics ::oauth ::storage ::assets ::feedback]))
+
+(defmethod ig/init-key ::router
+  [_ cfg]
+  (let [handler (rr/ring-handler
+                 (create-router cfg)
+                 (rr/routes
+                  (rr/create-resource-handler {:path "/"})
+                  (rr/create-default-handler))
+                 {:middleware [middleware/server-timing]})]
+    (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 oauth metrics svgparse assets feedback] :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)}]]
+
+    ["/webhooks"
+     ["/sns" {:post (:sns-webhook 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}]
+     ["/feedback" {:middleware [(:middleware session)]
+                   :post feedback}]
+
      ["/oauth"
-      ["/google" {:post google/auth}]
-      ["/google/callback" {:get google/callback}]
-      ["/gitlab" {:post gitlab/auth}]
-      ["/gitlab/callback" {:get gitlab/callback}]]
+      ["/google" {:post (get-in oauth [:google :handler])}]
+      ["/google/callback" {:get (get-in oauth [:google :callback-handler])}]
 
-     ["/echo" {:get handlers/echo-handler
-               :post handlers/echo-handler}]
+      ["/gitlab" {:post (get-in oauth [:gitlab :handler])}]
+      ["/gitlab/callback" {:get (get-in oauth [:gitlab :callback-handler])}]
 
-     ["/login" {:handler auth/login-handler
-                :method :post}]
-     ["/logout" {:handler auth/logout-handler
-                 :method :post}]
-     ["/login-ldap" {:handler ldap/auth
-                     :method :post}]
+      ["/github" {:post (get-in oauth [:github :handler])}]
+      ["/github/callback" {:get (get-in oauth [:github :callback-handler])}]]
 
-     ["/w" {:middleware [session/middleware]}
-      ["/query/:type" {:get handlers/query-handler}]
-      ["/mutation/:type" {:post handlers/mutation-handler}]]]]))
-
-(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)))
-
-(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

@@ -1,31 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
-
-(ns app.http.auth
-  (:require
-   [app.http.session :as session]
-   [app.services.mutations :as sm]))
-
-(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)]
-    {:status 200
-     :cookies (session/cookies id)
-     :body profile}))
-
-(defn logout-handler
-  [req]
-  (some-> (session/extract-auth-token req)
-          (session/delete))
-  {:status 200
-   :cookies (session/cookies "" {:max-age -1})
-   :body ""})

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

@@ -1,147 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
-
-(ns app.http.auth.gitlab
-  (:require
-   [app.common.exceptions :as ex]
-   [app.config :as cfg]
-   [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.tools.logging :as log]
-   [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))]
-    (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))]
-    (assoc base-uri :path "/oauth/authorize")))
-
-
-(defn- build-token-url
-  []
-  (let [base-uri (uri/uri (:gitlab-base-uri cfg/config default-base-gitlab-uri))]
-    (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))]
-    (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)
-                :code code
-                :grant_type "authorization_code"
-                :redirect_uri (build-redirect-url)}
-        req    {:method :post
-                :headers {"content-type" "application/x-www-form-urlencoded"}
-                :uri (build-token-url)
-                :body (uri/map->query-string params)}
-        res    (http/send! req)]
-
-    (when (not= 200 (:status res))
-      (ex/raise :type :internal
-                :code :invalid-response-from-gitlab
-                :context {:status (:status res)
-                          :body (:body res)}))
-
-    (try
-      (let [data (json/read-str (:body res))]
-        (get data "access_token"))
-      (catch Throwable e
-        (log/error "unexpected error on parsing response body from gitlab access token request" e)
-        nil))))
-
-
-(defn- get-user-info
-  [token]
-  (let [req {:uri (build-user-info-url)
-             :headers {"Authorization" (str "Bearer " token)}
-             :method :get}
-        res (http/send! req)]
-
-    (when (not= 200 (:status res))
-      (ex/raise :type :internal
-                :code :invalid-response-from-gitlab
-                :context {:status (:status res)
-                          :body (:body res)}))
-
-    (try
-      (let [data (json/read-str (:body res))]
-        ;; (clojure.pprint/pprint data)
-        {:email (get data "email")
-         :fullname (get data "name")})
-      (catch Throwable e
-        (log/error "unexpected error on parsing response body from gitlab access token request" e)
-        nil))))
-
-(defn auth
-  [_req]
-  (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)
-                :response_type "code"
-                :state token
-                :scope scope}
-        query  (uri/map->query-string params)
-        uri    (-> (build-oauth-uri)
-                   (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))]
-
-    (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"])
-
-          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)]
-
-      {:status 302
-       :headers {"location" (str uri)}
-       :cookies (session/cookies sid)
-       :body ""})))

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

@@ -1,131 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
-
-(ns app.http.auth.google
-  (:require
-   [app.common.exceptions :as ex]
-   [app.config :as cfg]
-   [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.tools.logging :as log]
-   [lambdaisland.uri :as uri]))
-
-(def base-goauth-uri "https://accounts.google.com/o/oauth2/v2/auth")
-
-(def scope
-  (str "email profile "
-       "https://www.googleapis.com/auth/userinfo.email "
-       "https://www.googleapis.com/auth/userinfo.profile "
-       "openid"))
-
-(defn- build-redirect-url
-  []
-  (let [public (uri/uri (:public-uri cfg/config))]
-    (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)]
-
-    (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))))
-
-
-(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)]
-
-    (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")})
-        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)}
-        query  (uri/map->query-string params)
-        uri    (-> (uri/uri base-goauth-uri)
-                   (assoc :query query))]
-    {:status 200
-     :body {:redirect-uri (str uri)}}))
-
-
-(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)]
-
-      {:status 302
-       :headers {"location" (str uri)}
-       :cookies (session/cookies sid)
-       :body ""})))

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

@@ -1,80 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
-
-(ns app.http.auth.ldap
-  (:require
-   [app.common.exceptions :as ex]
-   [app.config :as cfg]
-   [app.http.session :as session]
-   [app.services.mutations :as sm]
-   [clj-ldap.client :as client]
-   [clojure.set :as set]
-   [clojure.string]
-   [clojure.tools.logging :as log]
-   [mount.core :refer [defstate]]))
-
-(defn replace-several [s & {:as replacements}]
-  (reduce-kv clojure.string/replace s replacements))
-
-(declare *ldap-pool)
-
-(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)]
-      (when-some [user-entry (-> conn
-                                 (client/search (:ldap-auth-base-dn cfg/config)
-                                                {:filter user-search-query
-                                                 :sizelimit 1
-                                                 :attributes user-attributes})
-                                 (first))]
-        (when-not (client/bind? conn (:dn user-entry) password)
-          (ex/raise :type :authentication
-                    :code :wrong-credentials))
-        (set/rename-keys user-entry {(keyword (:ldap-auth-avatar-attribute cfg/config)) :photo
-                                     (keyword (:ldap-auth-fullname-attribute cfg/config)) :fullname
-                                     (keyword (:ldap-auth-email-attribute cfg/config)) :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/awsns.clj

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

backend/src/app/http/errors.clj

@@ -10,97 +10,91 @@
 (ns app.http.errors
   "A errors handling for the http server."
   (:require
-   [app.common.exceptions :as ex]
+   [app.common.uuid :as uuid]
+   [app.util.log4j :refer [update-thread-context!]]
    [clojure.tools.logging :as log]
    [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)
+      :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 :restriction
+  [err _]
+  {:status 400 :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/feedback.clj

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

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/oauth/github.clj

@@ -0,0 +1,159 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; This Source Code Form is "Incompatible With Secondary Licenses", as
+;; defined by the Mozilla Public License, v. 2.0.
+;;
+;; Copyright (c) 2020-2021 UXBOX Labs SL
+
+(ns app.http.oauth.github
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.config :as cfg]
+   [app.http.oauth.google :as gg]
+   [app.util.http :as http]
+   [app.util.time :as dt]
+   [clojure.data.json :as json]
+   [clojure.spec.alpha :as s]
+   [clojure.tools.logging :as log]
+   [integrant.core :as ig]
+   [lambdaisland.uri :as u]))
+
+(def base-github-uri
+  (u/uri "https://github.com"))
+
+(def base-api-github-uri
+  (u/uri "https://api.github.com"))
+
+(def authorize-uri
+  (assoc base-github-uri :path "/login/oauth/authorize"))
+
+(def token-url
+  (assoc base-github-uri :path "/login/oauth/access_token"))
+
+(def user-info-url
+  (assoc base-api-github-uri :path "/user"))
+
+(def scope "user:email")
+
+(defn- build-redirect-url
+  [cfg]
+  (let [public (u/uri (:public-uri cfg))]
+    (str (assoc public :path "/api/oauth/github/callback"))))
+
+(defn- get-access-token
+  [cfg state code]
+  (try
+    (let [params {:client_id (:client-id cfg)
+                  :client_secret (:client-secret cfg)
+                  :code code
+                  :state state
+                  :redirect_uri (build-redirect-url cfg)}
+          req    {:method :post
+                  :headers {"content-type" "application/x-www-form-urlencoded"
+                            "accept" "application/json"}
+                  :uri  (str token-url)
+                  :timeout 6000
+                  :body (u/map->query-string params)}
+          res    (http/send! req)]
+
+      (when (= 200 (:status res))
+        (-> (json/read-str (:body res))
+            (get "access_token"))))
+
+    (catch Exception e
+      (log/error e "unexpected error on get-access-token")
+      nil)))
+
+(defn- get-user-info
+  [_ token]
+  (try
+    (let [req {:uri (str user-info-url)
+               :headers {"authorization" (str "token " token)}
+               :timeout 6000
+               :method :get}
+          res (http/send! req)]
+      (when (= 200 (:status res))
+        (let [data (json/read-str (:body res))]
+          {:email (get data "email")
+           :backend "github"
+           :fullname (get data "name")})))
+    (catch Exception e
+      (log/error e "unexpected exception on get-user-info")
+      nil)))
+
+(defn- retrieve-info
+  [{:keys [tokens] :as cfg} request]
+  (let [token (get-in request [:params :state])
+        state (tokens :verify {:token token :iss :github-oauth})
+        info  (some->> (get-in request [:params :code])
+                       (get-access-token cfg state)
+                       (get-user-info cfg))]
+    (when-not info
+      (ex/raise :type :internal
+                :code :unable-to-auth))
+
+    (cond-> info
+      (some? (:invitation-token state))
+      (assoc :invitation-token (:invitation-token state)))))
+
+(defn auth-handler
+  [{:keys [tokens] :as cfg} request]
+  (let [invitation (get-in request [:params :invitation-token])
+        state      (tokens :generate {:iss :github-oauth
+                                      :invitation-token invitation
+                                      :exp (dt/in-future "15m")})
+        params     {:client_id (:client-id cfg/config)
+                    :redirect_uri (build-redirect-url cfg)
+                    :state state
+                    :scope scope}
+        query      (u/map->query-string params)
+        uri        (-> authorize-uri
+                       (assoc :query query))]
+    {:status 200
+     :body {:redirect-uri (str uri)}}))
+
+(defn- callback-handler
+  [{:keys [session] :as cfg} request]
+  (try
+    (let [info    (retrieve-info cfg request)
+          profile (gg/register-profile cfg info)
+          uri     (gg/generate-redirect-uri cfg profile)
+          sxf     ((:create session) (:id profile))]
+      (->> (gg/redirect-response uri)
+           (sxf request)))
+    (catch Exception _e
+      (-> (gg/generate-error-redirect-uri cfg)
+          (gg/redirect-response)))))
+
+
+;; --- ENTRY POINT
+
+(s/def ::client-id ::us/not-empty-string)
+(s/def ::client-secret ::us/not-empty-string)
+(s/def ::public-uri ::us/not-empty-string)
+(s/def ::session map?)
+(s/def ::tokens fn?)
+
+(defmethod ig/pre-init-spec :app.http.oauth/github [_]
+  (s/keys :req-un [::public-uri
+                   ::session
+                   ::tokens]
+          :opt-un [::client-id
+                   ::client-secret]))
+
+(defn- default-handler
+  [_]
+  (ex/raise :type :not-found))
+
+(defmethod ig/init-key :app.http.oauth/github
+  [_ cfg]
+  (if (and (:client-id cfg)
+           (:client-secret cfg))
+    {:handler #(auth-handler cfg %)
+     :callback-handler #(callback-handler cfg %)}
+    {:handler default-handler
+     :callback-handler default-handler}))
+

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

@@ -0,0 +1,167 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; This Source Code Form is "Incompatible With Secondary Licenses", as
+;; defined by the Mozilla Public License, v. 2.0.
+;;
+;; Copyright (c) 2020 UXBOX Labs SL
+
+(ns app.http.oauth.gitlab
+  (:require
+   [app.common.data :as d]
+   [app.common.exceptions :as ex]
+   [app.common.spec :as us]
+   [app.http.oauth.google :as gg]
+   [app.util.http :as http]
+   [app.util.time :as dt]
+   [clojure.data.json :as json]
+   [clojure.spec.alpha :as s]
+   [clojure.tools.logging :as log]
+   [integrant.core :as ig]
+   [lambdaisland.uri :as u]))
+
+(def scope "read_user")
+
+(defn- build-redirect-url
+  [cfg]
+  (let [public (u/uri (:public-uri cfg))]
+    (str (assoc public :path "/api/oauth/gitlab/callback"))))
+
+(defn- build-oauth-uri
+  [cfg]
+  (let [base-uri (u/uri (:base-uri cfg))]
+    (assoc base-uri :path "/oauth/authorize")))
+
+(defn- build-token-url
+  [cfg]
+  (let [base-uri (u/uri (:base-uri cfg))]
+    (str (assoc base-uri :path "/oauth/token"))))
+
+(defn- build-user-info-url
+  [cfg]
+  (let [base-uri (u/uri (:base-uri cfg))]
+    (str (assoc base-uri :path "/api/v4/user"))))
+
+(defn- get-access-token
+  [cfg code]
+  (try
+    (let [params {:client_id (:client-id cfg)
+                  :client_secret (:client-secret cfg)
+                  :code code
+                  :grant_type "authorization_code"
+                  :redirect_uri (build-redirect-url cfg)}
+          req    {:method :post
+                  :headers {"content-type" "application/x-www-form-urlencoded"}
+                  :uri (build-token-url cfg)
+                  :body (u/map->query-string params)}
+        res    (http/send! req)]
+
+      (when (= 200 (:status res))
+        (-> (json/read-str (:body res))
+            (get "access_token"))))
+
+    (catch Exception e
+      (log/error e "unexpected error on get-access-token")
+      nil)))
+
+(defn- get-user-info
+  [cfg token]
+  (try
+    (let [req {:uri (build-user-info-url cfg)
+               :headers {"Authorization" (str "Bearer " token)}
+               :timeout 6000
+               :method :get}
+          res (http/send! req)]
+
+      (when (= 200 (:status res))
+        (let [data (json/read-str (:body res))]
+          {:email (get data "email")
+           :backend "gitlab"
+           :fullname (get data "name")})))
+
+    (catch Exception e
+      (log/error e "unexpected exception on get-user-info")
+      nil)))
+
+
+(defn- retrieve-info
+  [{:keys [tokens] :as cfg} request]
+  (let [token (get-in request [:params :state])
+        state (tokens :verify {:token token :iss :gitlab-oauth})
+        info  (some->> (get-in request [:params :code])
+                       (get-access-token cfg)
+                       (get-user-info cfg))]
+    (when-not info
+      (ex/raise :type :internal
+                :code :unable-to-auth))
+
+    (cond-> info
+      (some? (:invitation-token state))
+      (assoc :invitation-token (:invitation-token state)))))
+
+
+(defn- auth-handler
+  [{:keys [tokens] :as cfg} request]
+  (let [invitation (get-in request [:params :invitation-token])
+        state      (tokens :generate
+                           {:iss :gitlab-oauth
+                            :invitation-token invitation
+                            :exp (dt/in-future "15m")})
+
+        params     {:client_id (:client-id cfg)
+                    :redirect_uri (build-redirect-url cfg)
+                    :response_type "code"
+                    :state state
+                    :scope scope}
+        query      (u/map->query-string params)
+        uri        (-> (build-oauth-uri cfg)
+                       (assoc :query query))]
+    {:status 200
+     :body {:redirect-uri (str uri)}}))
+
+(defn- callback-handler
+  [{:keys [session] :as cfg} request]
+  (try
+    (let [info    (retrieve-info cfg request)
+          profile (gg/register-profile cfg info)
+          uri     (gg/generate-redirect-uri cfg profile)
+          sxf     ((:create session) (:id profile))]
+      (->> (gg/redirect-response uri)
+           (sxf request)))
+    (catch Exception _e
+      (-> (gg/generate-error-redirect-uri cfg)
+          (gg/redirect-response)))))
+
+(s/def ::client-id ::us/not-empty-string)
+(s/def ::client-secret ::us/not-empty-string)
+(s/def ::base-uri ::us/not-empty-string)
+(s/def ::public-uri ::us/not-empty-string)
+(s/def ::session map?)
+(s/def ::tokens fn?)
+
+(defmethod ig/pre-init-spec :app.http.oauth/gitlab [_]
+  (s/keys :req-un [::public-uri
+                   ::session
+                   ::tokens]
+          :opt-un [::base-uri
+                   ::client-id
+                   ::client-secret]))
+
+(defmethod ig/prep-key :app.http.oauth/gitlab
+  [_ cfg]
+  (d/merge {:base-uri "https://gitlab.com"}
+           (d/without-nils cfg)))
+
+(defn- default-handler
+  [_]
+  (ex/raise :type :not-found))
+
+(defmethod ig/init-key :app.http.oauth/gitlab
+  [_ cfg]
+  (if (and (:client-id cfg)
+           (:client-secret cfg))
+    {:handler #(auth-handler cfg %)
+     :callback-handler #(callback-handler cfg %)}
+    {:handler default-handler
+     :callback-handler default-handler}))

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

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

backend/src/app/http/session.clj

@@ -7,60 +7,212 @@
 ;;
 ;; Copyright (c) 2020 UXBOX Labs SL
 
-;; TODO: move to services.
-
 (ns app.http.session
   (:require
+   [app.common.data :as d]
+   [app.common.exceptions :as ex]
+   [app.config :as cfg]
    [app.db :as db]
+   [app.metrics :as mtx]
+   [app.util.async :as aa]
+   [app.util.log4j :refer [update-thread-context!]]
+   [app.util.time :as dt]
+   [app.worker :as wrk]
    [buddy.core.codecs :as bc]
-   [buddy.core.nonce :as bn]))
+   [buddy.core.nonce :as bn]
+   [clojure.core.async :as a]
+   [clojure.spec.alpha :as s]
+   [clojure.tools.logging :as log]
+   [integrant.core :as ig]))
 
-(defn next-token
-  [n]
-  (-> (bn/random-nonce n)
-      (bc/bytes->b64u)
-      (bc/bytes->str)))
+;; --- IMPL
 
-(defn extract-auth-token
-  [request]
-  (get-in request [:cookies "auth-token" :value]))
+(defn- next-session-id
+  ([] (next-session-id 96))
+  ([n]
+   (-> (bn/random-nonce n)
+       (bc/bytes->b64u)
+       (bc/bytes->str))))
 
-(defn retrieve
-  [conn 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})
+(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
-  [token]
-  (db/delete! db/pool :http-session {:id token})
+(defn- delete
+  [{:keys [conn cookie-name] :as cfg} {:keys [cookies] :as request}]
+  (when-let [token (get-in cookies [cookie-name :value])]
+    (db/delete! conn :http-session {:id token}))
   nil)
 
-(defn cookies
-  ([id] (cookies id {}))
-  ([id opts]
-   {"auth-token" (merge opts {:value id :path "/" :http-only true})}))
+(defn- retrieve
+  [{:keys [conn] :as cfg} token]
+  (when token
+    (db/exec-one! conn ["select id, profile_id from http_session where id = ?" token])))
 
-(defn wrap-session
-  [handler]
+(defn- retrieve-from-request
+  [{:keys [cookie-name] :as cfg} {:keys [cookies] :as request}]
+  (->> (get-in cookies [cookie-name :value])
+       (retrieve cfg)))
+
+(defn- cookies
+  [{:keys [cookie-name] :as cfg} vals]
+  {cookie-name (merge vals {:path "/" :http-only true})})
+
+(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 [{:keys [id profile-id] :as session} (retrieve-from-request cfg request)]
+      (let [ech (::events-ch cfg)]
+        (a/>!! ech id)
+        (update-thread-context! {:profile-id profile-id})
+        (handler (assoc request :profile-id profile-id)))
       (handler request))))
 
-(def middleware
-  {:nane ::middleware
-   :compile (constantly wrap-session)})
+;; --- STATE INIT: SESSION
+
+(s/def ::cookie-name ::cfg/http-session-cookie-name)
+
+(defmethod ig/pre-init-spec ::session [_]
+  (s/keys :req-un [::db/pool]
+          :opt-un [::cookie-name]))
+
+(defmethod ig/prep-key ::session
+  [_ cfg]
+  (merge {:cookie-name "auth-token"
+          :buffer-size 64}
+         (d/without-nils cfg)))
+
+(defmethod ig/init-key ::session
+  [_ {:keys [pool] :as cfg}]
+  (let [events (a/chan (a/dropping-buffer (:buffer-size cfg)))
+        cfg    (assoc cfg
+                      :conn pool
+                      ::events-ch events)]
+    (-> cfg
+        (assoc :middleware #(middleware cfg %))
+        (assoc :create (fn [profile-id]
+                         (fn [request response]
+                           (let [uagent (get-in request [:headers "user-agent"])
+                                 value  (create cfg {:profile-id profile-id :user-agent uagent})]
+                             (assoc response :cookies (cookies cfg {:value value}))))))
+        (assoc :delete (fn [request response]
+                         (delete cfg request)
+                         (assoc response
+                                :status 204
+                                :body ""
+                                :cookies (cookies cfg {:value "" :max-age -1})))))))
+
+(defmethod ig/halt-key! ::session
+  [_ data]
+  (a/close! (::events-ch data)))
+
+;; --- STATE INIT: SESSION UPDATER
+
+(declare batch-events)
+(declare update-sessions)
+
+(s/def ::session map?)
+(s/def ::max-batch-age ::cfg/http-session-updater-batch-max-age)
+(s/def ::max-batch-size ::cfg/http-session-updater-batch-max-size)
+
+(defmethod ig/pre-init-spec ::updater [_]
+  (s/keys :req-un [::db/pool ::wrk/executor ::mtx/metrics ::session]
+          :opt-un [::max-batch-age
+                   ::max-batch-size]))
+
+(defmethod ig/prep-key ::updater
+  [_ cfg]
+  (merge {:max-batch-age (dt/duration {:minutes 5})
+          :max-batch-size 200}
+         (d/without-nils cfg)))
+
+(defmethod ig/init-key ::updater
+  [_ {:keys [session metrics] :as cfg}]
+  (log/infof "initialize session updater (max-batch-age=%s, max-batch-size=%s)"
+             (str (:max-batch-age cfg))
+             (str (:max-batch-size cfg)))
+  (let [input (batch-events cfg (::events-ch session))
+        mcnt  (mtx/create
+               {:name "http_session_updater_count"
+                :help "A counter of session update batch events."
+                :registry (:registry metrics)
+                :type :counter})]
+    (a/go-loop []
+      (when-let [[reason batch] (a/<! input)]
+        (let [result (a/<! (update-sessions cfg batch))]
+          (mcnt :inc)
+          (if (ex/exception? result)
+            (log/error result "updater: unexpected error on update sessions")
+            (log/tracef "updater: updated %s sessions (reason: %s)." result (name reason)))
+          (recur))))))
+
+(defn- timeout-chan
+  [cfg]
+  (a/timeout (inst-ms (:max-batch-age cfg))))
+
+(defn- batch-events
+  [cfg in]
+  (let [out (a/chan)]
+    (a/go-loop [tch (timeout-chan cfg)
+                buf #{}]
+      (let [[val port] (a/alts! [tch in])]
+        (cond
+          (identical? port tch)
+          (if (empty? buf)
+            (recur (timeout-chan cfg) buf)
+            (do
+              (a/>! out [:timeout buf])
+              (recur (timeout-chan cfg) #{})))
+
+          (nil? val)
+          (a/close! out)
+
+          (identical? port in)
+          (let [buf (conj buf val)]
+            (if (>= (count buf) (:max-batch-size cfg))
+              (do
+                (a/>! out [:size buf])
+                (recur (timeout-chan cfg) #{}))
+              (recur tch buf))))))
+    out))
+
+(defn- update-sessions
+  [{:keys [pool executor]} ids]
+  (aa/with-thread executor
+    (db/exec-one! pool ["update http_session set updated_at=now() where id = ANY(?)"
+                        (into-array String ids)])
+    (count ids)))
+
+;; --- STATE INIT: SESSION GC
+
+(declare sql:delete-expired)
+
+(s/def ::max-age ::dt/duration)
+
+(defmethod ig/pre-init-spec ::gc-task [_]
+  (s/keys :req-un [::db/pool]
+          :opt-un [::max-age]))
+
+(defmethod ig/prep-key ::gc-task
+  [_ cfg]
+  (merge {:max-age (dt/duration {:days 2})}
+         (d/without-nils cfg)))
+
+(defmethod ig/init-key ::gc-task
+  [_ {:keys [pool max-age] :as cfg}]
+  (fn [_]
+    (db/with-atomic [conn pool]
+      (let [interval (db/interval max-age)
+            result   (db/exec-one! conn [sql:delete-expired interval])
+            result   (:next.jdbc/update-count result)]
+        (log/debugf "gc-task: removed %s rows from http-session table" result)
+        result))))
+
+(def ^:private
+  sql:delete-expired
+  "delete from http_session
+    where updated_at < now() - ?::interval")

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/loggers/loki.clj

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

backend/src/app/loggers/mattermost.clj

@@ -0,0 +1,154 @@
+;; 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.loggers.mattermost
+  "A mattermost integration for error reporting."
+  (: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.util.async :as aa]
+   [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.java.io :as io]
+   [clojure.spec.alpha :as s]
+   [clojure.tools.logging :as log]
+   [cuerdas.core :as str]
+   [integrant.core :as ig]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Error Listener
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare handle-event)
+
+(defonce enabled-mattermost (atom true))
+
+(s/def ::uri ::us/string)
+
+(defmethod ig/pre-init-spec ::reporter [_]
+  (s/keys :req-un [::wrk/executor ::db/pool ::receiver]
+          :opt-un [::uri]))
+
+(defmethod ig/init-key ::reporter
+  [_ {:keys [receiver] :as cfg}]
+  (log/info "intializing mattermost error reporter")
+  (let [output (a/chan (a/sliding-buffer 128)
+                       (filter #(= (:level %) "error")))]
+    (receiver :sub output)
+    (a/go-loop []
+      (let [msg (a/<! output)]
+        (if (nil? msg)
+          (log/info "stoping error reporting loop")
+          (do
+            (a/<! (handle-event cfg msg))
+            (recur)))))
+    output))
+
+(defmethod ig/halt-key! ::reporter
+  [_ output]
+  (a/close! output))
+
+(defn- send-mattermost-notification!
+  [cfg {:keys [host version id error] :as cdata}]
+  (try
+    (let [uri  (:uri cfg)
+          text (str "Unhandled exception (@channel):\n"
+                    "- detail: " (:public-uri cfg/config) "/dbg/error-by-id/" id "\n"
+                    "- host: `" host "`\n"
+                    "- version: `" version "`\n"
+                    (when error
+                      (str "```\n" (:trace error)  "\n```")))
+          rsp    (http/send! {:uri uri
+                              :method :post
+                              :headers {"content-type" "application/json"}
+                              :body (json/encode-str {:text text})})]
+      (when (not= (:status rsp) 200)
+        (log/errorf "error on sending data to mattermost\n%s" (pr-str rsp))))
+
+    (catch Exception e
+      (log/error e "unexpected exception on error reporter"))))
+
+(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- parse-context
+  [event]
+  (reduce-kv
+   (fn [acc k v]
+     (cond
+       (= k :id)         (assoc acc k (uuid/uuid v))
+       (= k :profile-id) (assoc acc k (uuid/uuid v))
+       (str/blank? v)    acc
+       :else             (assoc acc k v)))
+   {:id (uuid/next)}
+   (:context event)))
+
+(defn- parse-event
+  [event]
+  (-> (parse-context event)
+      (merge (dissoc event :context))
+      (assoc :tenant (cfg/get :tenant))
+      (assoc :host (cfg/get :host))
+      (assoc :public-uri (cfg/get :public-uri))
+      (assoc :version (:full cfg/version))))
+
+(defn handle-event
+  [{:keys [executor] :as cfg} event]
+  (aa/with-thread executor
+    (try
+      (let [cdata (parse-event event)]
+        (when (and (:uri cfg) @enabled-mattermost)
+          (send-mattermost-notification! cfg cdata))
+        (persist-on-database! cfg cdata))
+      (catch Exception e
+        (log/error e "unexpected exception on error reporter")))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Http Handler
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmethod ig/pre-init-spec ::handler [_]
+  (s/keys :req-un [::db/pool]))
+
+(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/loggers/zmq.clj

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

backend/src/app/main.clj

@@ -5,38 +5,393 @@
 ;; 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
+    {:definitions
+     {:profile-register
+      {:name "actions_profile_register_count"
+       :help "A global counter of user registrations."
+       :type :counter}
+      :profile-activation
+      {:name "actions_profile_activation_count"
+       :help "A global counter of profile activations"
+       :type :counter}}}
+
+    :app.migrations/all
+    {:main      (ig/ref :app.migrations/migrations)
+     :telemetry (ig/ref :app.telemetry/migrations)}
+
+    :app.migrations/migrations
+    {}
+
+    :app.telemetry/migrations
+    {}
+
+    :app.msgbus/msgbus
+    {:uri (:redis-uri config)}
+
+    :app.tokens/tokens
+    {:sprops (ig/ref :app.setup/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 (:http-session-cookie-name config)}
+
+    :app.http.session/gc-task
+    {:pool        (ig/ref :app.db/pool)
+     :max-age     (:http-session-idle-max-age config)}
+
+    :app.http.session/updater
+    {:pool           (ig/ref :app.db/pool)
+     :metrics        (ig/ref :app.metrics/metrics)
+     :executor       (ig/ref :app.worker/executor)
+     :session        (ig/ref :app.http.session/session)
+     :max-batch-age  (:http-session-updater-batch-max-age config)
+     :max-batch-size (:http-session-updater-batch-max-size config)}
+
+    :app.http.awsns/handler
+    {:tokens  (ig/ref :app.tokens/tokens)
+     :pool    (ig/ref :app.db/pool)}
+
+    :app.http/server
+    {:port    (:http-server-port config)
+     :handler (ig/ref :app.http/router)
+     :metrics (ig/ref :app.metrics/metrics)
+     :ws      {"/ws/notifications" (ig/ref :app.notifications/handler)}}
+
+    :app.http/router
+    {:rpc         (ig/ref :app.rpc/rpc)
+     :session     (ig/ref :app.http.session/session)
+     :tokens      (ig/ref :app.tokens/tokens)
+     :public-uri  (:public-uri config)
+     :metrics     (ig/ref :app.metrics/metrics)
+     :oauth       (ig/ref :app.http.oauth/all)
+     :assets      (ig/ref :app.http.assets/handlers)
+     :svgparse    (ig/ref :app.svgparse/handler)
+     :storage     (ig/ref :app.storage/storage)
+     :sns-webhook (ig/ref :app.http.awsns/handler)
+     :feedback    (ig/ref :app.http.feedback/handler)
+     :error-report-handler (ig/ref :app.loggers.mattermost/handler)}
+
+    :app.http.assets/handlers
+    {:metrics           (ig/ref :app.metrics/metrics)
+     :assets-path       (:assets-path config)
+     :storage           (ig/ref :app.storage/storage)
+     :cache-max-age     (dt/duration {:hours 24})
+     :signature-max-age (dt/duration {:hours 24 :minutes 5})}
+
+    :app.http.feedback/handler
+    {:pool (ig/ref :app.db/pool)}
+
+    :app.http.oauth/all
+    {:google (ig/ref :app.http.oauth/google)
+     :gitlab (ig/ref :app.http.oauth/gitlab)
+     :github (ig/ref :app.http.oauth/github)}
+
+    :app.http.oauth/google
+    {:rpc           (ig/ref :app.rpc/rpc)
+     :session       (ig/ref :app.http.session/session)
+     :tokens        (ig/ref :app.tokens/tokens)
+     :public-uri    (:public-uri config)
+     :client-id     (:google-client-id config)
+     :client-secret (:google-client-secret config)}
+
+    :app.http.oauth/github
+    {:rpc           (ig/ref :app.rpc/rpc)
+     :session       (ig/ref :app.http.session/session)
+     :tokens        (ig/ref :app.tokens/tokens)
+     :public-uri    (:public-uri config)
+     :client-id     (:github-client-id config)
+     :client-secret (:github-client-secret config)}
+
+    :app.http.oauth/gitlab
+    {:rpc           (ig/ref :app.rpc/rpc)
+     :session       (ig/ref :app.http.session/session)
+     :tokens        (ig/ref :app.tokens/tokens)
+     :public-uri    (:public-uri config)
+     :base-uri      (:gitlab-base-uri config)
+     :client-id     (:gitlab-client-id config)
+     :client-secret (:gitlab-client-secret config)}
+
+    :app.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)
+     :msgbus  (ig/ref :app.msgbus/msgbus)
+     :rlimits (ig/ref :app.rlimits/all)
+     :svgc    (ig/ref :app.svgparse/svgc)}
+
+    :app.notifications/handler
+    {:msgbus   (ig/ref :app.msgbus/msgbus)
+     :pool     (ig/ref :app.db/pool)
+     :session  (ig/ref :app.http.session/session)
+     :metrics  (ig/ref :app.metrics/metrics)
+     :executor (ig/ref :app.worker/executor)}
+
+    :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/registry)}
+
+    :app.worker/scheduler
+    {:executor   (ig/ref :app.worker/executor)
+     :pool       (ig/ref :app.db/pool)
+     :tasks      (ig/ref :app.tasks/registry)
+     :schedule
+     [{:id "file-media-gc"
+       :cron #app/cron "0 0 0 */1 * ? *" ;; daily
+       :task :file-media-gc}
+
+      {:id "file-xlog-gc"
+       :cron #app/cron "0 0 */1 * * ?"  ;; hourly
+       :task :file-xlog-gc}
+
+      {:id "storage-deleted-gc"
+       :cron #app/cron "0 0 1 */1 * ?"  ;; daily (1 hour shift)
+       :task :storage-deleted-gc}
+
+      {:id "storage-touched-gc"
+       :cron #app/cron "0 0 2 */1 * ?"  ;; daily (2 hour shift)
+       :task :storage-touched-gc}
+
+      {:id "session-gc"
+       :cron #app/cron "0 0 3 */1 * ?"  ;; daily (3 hour shift)
+       :task :session-gc}
+
+      {:id "storage-recheck"
+       :cron #app/cron "0 0 */1 * * ?"  ;; hourly
+       :task :storage-recheck}
+
+      {:id "tasks-gc"
+       :cron #app/cron "0 0 0 */1 * ?"  ;; daily
+       :task :tasks-gc}
+
+      (when (:telemetry-enabled config)
+        {:id   "telemetry"
+         :cron #app/cron "0 0 */6 * * ?" ;; every 6h
+         :uri  (:telemetry-uri config)
+         :task :telemetry})]}
+
+    :app.tasks/registry
+    {:metrics (ig/ref :app.metrics/metrics)
+     :tasks
+     {:sendmail           (ig/ref :app.tasks.sendmail/handler)
+      :delete-object      (ig/ref :app.tasks.delete-object/handler)
+      :delete-profile     (ig/ref :app.tasks.delete-profile/handler)
+      :file-media-gc      (ig/ref :app.tasks.file-media-gc/handler)
+      :file-xlog-gc       (ig/ref :app.tasks.file-xlog-gc/handler)
+      :storage-deleted-gc (ig/ref :app.storage/gc-deleted-task)
+      :storage-touched-gc (ig/ref :app.storage/gc-touched-task)
+      :storage-recheck    (ig/ref :app.storage/recheck-task)
+      :tasks-gc           (ig/ref :app.tasks.tasks-gc/handler)
+      :telemetry          (ig/ref :app.tasks.telemetry/handler)
+      :session-gc         (ig/ref :app.http.session/gc-task)}}
+
+    :app.tasks.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.setup/props)}
+
+    :app.srepl/server
+    {:port (:srepl-port config)
+     :host (:srepl-host config)}
+
+    :app.setup/props
+    {:pool (ig/ref :app.db/pool)}
+
+    :app.loggers.zmq/receiver
+    {:endpoint (:loggers-zmq-uri config)}
+
+    :app.loggers.loki/reporter
+    {:uri      (:loggers-loki-uri config)
+     :receiver (ig/ref :app.loggers.zmq/receiver)
+     :executor (ig/ref :app.worker/executor)}
+
+    :app.loggers.mattermost/reporter
+    {:uri      (:error-report-webhook config)
+     :receiver (ig/ref :app.loggers.zmq/receiver)
+     :pool     (ig/ref :app.db/pool)
+     :executor (ig/ref :app.worker/executor)}
+
+    :app.loggers.mattermost/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 ^bytes thumbnail-data)
              :data   (ByteArrayInputStream. thumbnail-data)))))
 
 (defmulti process :cmd)
@@ -96,7 +89,7 @@
              (.addImage)
              (.autoOrient)
              (.strip)
-             (.thumbnail (int width) (int height) ">")
+             (.thumbnail ^Integer (int width) ^Integer (int height) ">")
              (.quality (double quality))
              (.addImage))]
     (generic-process (assoc params :operation op))))
@@ -108,31 +101,65 @@
              (.addImage)
              (.autoOrient)
              (.strip)
-             (.thumbnail (int width) (int height) "^")
+             (.thumbnail ^Integer (int width) ^Integer (int height) "^")
              (.gravity "center")
              (.extent (int width) (int height))
              (.quality (double quality))
              (.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,41 +5,95 @@
 ;; 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]
+   [clojure.spec.alpha :as s]
+   [clojure.tools.logging :as log]
+   [integrant.core :as ig])
   (:import
    io.prometheus.client.CollectorRegistry
    io.prometheus.client.Counter
    io.prometheus.client.Gauge
    io.prometheus.client.Summary
+   io.prometheus.client.Histogram
    io.prometheus.client.exporter.common.TextFormat
    io.prometheus.client.hotspot.DefaultExports
+   io.prometheus.client.jetty.JettyStatisticsCollector
+   org.eclipse.jetty.server.handler.StatisticsHandler
    java.io.StringWriter))
 
-(defn- create-registry
+(declare instrument-vars!)
+(declare instrument)
+(declare create-registry)
+(declare create)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Entry Point
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(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)}))
+
+(s/def ::definitions
+  (s/map-of keyword? map?))
+
+(defmethod ig/pre-init-spec ::metrics [_]
+  (s/keys :opt-un [::definitions]))
+
+(defmethod ig/init-key ::metrics
+  [_ {:keys [definitions] :as cfg}]
+  (log/infof "Initializing prometheus registry and instrumentation.")
+  (let [registry    (create-registry)
+        definitions (reduce-kv (fn [res k v]
+                                 (->> (assoc v :registry registry)
+                                      (create)
+                                      (assoc res k)))
+                               {}
+                               definitions)]
+    {:handler (partial handler registry)
+     :definitions definitions
+     :registry registry}))
+
+(s/def ::handler fn?)
+(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 +103,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 (into-array String 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 +126,186 @@
       (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]
+        (let [labels (into-array String [labels])]
+          (case cmd
+            :inc (.. ^Gauge instance (labels labels) (inc))
+            :dec (.. ^Gauge instance (labels labels) (dec))))))))
+
+(def default-quantiles
+  [[0.75 0.02]
+   [0.99 0.001]])
 
 (defn make-summary
-  [{:keys [id help] :as props}]
-  (let [instance (doto (Summary/build)
-                   (.name id)
-                   (.help help)
-                   (.quantile 0.5 0.05)
-                   (.quantile 0.9 0.01)
-                   (.quantile 0.99 0.001))
-        instance  (.register instance registry)]
+  [{:keys [name help registry reg labels max-age quantiles buckets]
+    :or {max-age 3600 buckets 6 quantiles default-quantiles} :as props}]
+  (let [registry (or registry reg)
+        instance (doto (Summary/build)
+                   (.name name)
+                   (.help help))
+        _        (when (seq quantiles)
+                   (.maxAgeSeconds ^Summary instance max-age)
+                   (.ageBuckets ^Summary instance buckets))
+        _        (doseq [[q e] quantiles]
+                   (.quantile ^Summary instance q e))
+        _        (when (seq labels)
+                   (.labelNames instance (into-array String labels)))
+        instance (.register instance registry)]
     (reify
       clojure.lang.IDeref
       (deref [_] instance)
 
       clojure.lang.IFn
-      (invoke [_ val]
+      (invoke [_ cmd val]
         (.observe ^Summary instance val))
 
+      (invoke [_ cmd val labels]
+        (.. ^Summary instance
+            (labels (into-array String labels))
+            (observe val))))))
+
+(def default-histogram-buckets
+  [1 5 10 25 50 75 100 250 500 750 1000 2500 5000 7500])
+
+(defn make-histogram
+  [{:keys [name help registry reg labels buckets]
+    :or {buckets default-histogram-buckets}}]
+  (let [registry (or registry reg)
+        instance (doto (Histogram/build)
+                   (.name name)
+                   (.help help)
+                   (.buckets (into-array Double/TYPE buckets)))
+        _        (when (seq labels)
+                   (.labelNames instance (into-array String labels)))
+        instance (.register instance registry)]
+    (reify
+      clojure.lang.IDeref
+      (deref [_] instance)
+
+      clojure.lang.IFn
       (invoke [_ cmd val]
-        (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 $$))))
+        (.observe ^Histogram instance val))
 
-          (throw (IllegalArgumentException. "invalid arguments")))))))
+      (invoke [_ cmd val labels]
+        (.. ^Histogram instance
+            (labels (into-array String labels))
+            (observe val))))))
 
-(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)
+    :histogram (make-histogram 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)
+         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)
+         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)
+
+      (instance? Histogram @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,161 @@
 
 (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")}
+
+   {:name "0046-add-profile-complaint-table"
+    :fn (mg/resource "app/migrations/sql/0046-add-profile-complaint-table.sql")}
+
+   {:name "0047-mod-file-change-table"
+    :fn (mg/resource "app/migrations/sql/0047-mod-file-change-table.sql")}
+
+   {:name "0048-mod-storage-tables"
+    :fn (mg/resource "app/migrations/sql/0048-mod-storage-tables.sql")}
+
+   {:name "0049-mod-http-session-table"
+    :fn (mg/resource "app/migrations/sql/0049-mod-http-session-table.sql")}
+
+   {:name "0050-mod-server-prop-table"
+    :fn (mg/resource "app/migrations/sql/0050-mod-server-prop-table.sql")}
+   ])
+
+
+(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,36 @@
+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 INDEX storage_object__id__deleted_at__idx
+    ON storage_object(id, deleted_at)
+ WHERE deleted_at IS NOT null;
+
+CREATE TABLE storage_data (
+  id uuid PRIMARY KEY REFERENCES storage_object (id) ON DELETE CASCADE,
+  data bytea NOT NULL
+);
+
+CREATE INDEX storage_data__id__idx ON storage_data(id);
+
+-- Table used for store inflight upload ids, for later recheck and
+-- delete possible staled files that exists on the phisical storage
+-- but does not exists in the 'storage_object' table.
+
+CREATE TABLE storage_pending (
+  id uuid NOT NULL,
+
+  backend text NOT NULL,
+  created_at timestamptz NOT NULL DEFAULT now(),
+
+  PRIMARY KEY (created_at, id)
+);
+

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,23 @@
+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;
+
+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/0046-add-profile-complaint-table.sql

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

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

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

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

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

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

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

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

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

backend/src/app/migrations/sql/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/msgbus.clj

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

backend/src/app/notifications.clj

@@ -0,0 +1,331 @@
+;; 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.util.async :as aa]
+   [app.util.time :as dt]
+   [app.util.transit :as t]
+   [app.worker :as wrk]
+   [clojure.core.async :as a]
+   [clojure.spec.alpha :as s]
+   [clojure.tools.logging :as log]
+   [integrant.core :as ig]
+   [ring.adapter.jetty9 :as jetty]
+   [ring.middleware.cookies :refer [wrap-cookies]]
+   [ring.middleware.keyword-params :refer [wrap-keyword-params]]
+   [ring.middleware.params :refer [wrap-params]])
+  (:import
+   org.eclipse.jetty.websocket.api.WebSocketAdapter))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Http Handler
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare retrieve-file)
+(declare websocket)
+(declare handler)
+
+(s/def ::session map?)
+(s/def ::msgbus fn?)
+
+(defmethod ig/pre-init-spec ::handler [_]
+  (s/keys :req-un [::msgbus ::db/pool ::session ::mtx/metrics ::wrk/executor]))
+
+(defmethod ig/init-key ::handler
+  [_ {:keys [session metrics] :as cfg}]
+  (let [wrap-session    (:middleware session)
+
+        mtx-active-connections
+        (mtx/create
+         {:name "websocket_active_connections"
+          :registry (:registry metrics)
+          :type :gauge
+          :help "Active websocket connections."})
+
+        mtx-messages
+        (mtx/create
+         {:name "websocket_message_count"
+          :registry (:registry metrics)
+          :labels ["op"]
+          :type :counter
+          :help "Counter of processed messages."})
+
+        mtx-sessions
+        (mtx/create
+         {:name "websocket_session_timing"
+          :registry (:registry metrics)
+          :quantiles []
+          :help "Websocket session timing (seconds)."
+          :type :summary})
+
+        cfg (assoc cfg
+                   :mtx-active-connections mtx-active-connections
+                   :mtx-messages mtx-messages
+                   :mtx-sessions mtx-sessions
+                   )]
+    (-> #(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 INIT
+
+(declare handle-connect)
+
+(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 msgbus executor] :as cfg}]
+  (let [rcv-ch       (a/chan 32)
+        out-ch       (a/chan 32)
+        mtx-aconn    (:mtx-active-connections cfg)
+        mtx-messages (:mtx-messages cfg)
+        mtx-sessions (:mtx-sessions cfg)
+        created-at   (dt/now)
+        ws-send      (mtx/wrap-counter ws-send mtx-messages ["send"])]
+
+    (letfn [(on-connect [conn]
+              (mtx-aconn :inc)
+              ;; A subscription channel should use a lossy buffer
+              ;; because we can't penalize normal clients when one
+              ;; slow client is connected to the room.
+              (let [sub-ch (a/chan (a/dropping-buffer 128))
+                    cfg    (assoc cfg
+                                  :conn conn
+                                  :rcv-ch rcv-ch
+                                  :out-ch out-ch
+                                  :sub-ch sub-ch)]
+
+                (log/tracef "on-connect %s" (:session-id cfg))
+
+                ;; Forward all messages from out-ch to the websocket
+                ;; connection
+                (a/go-loop []
+                  (let [val (a/<! out-ch)]
+                    (when (some? val)
+                      (when (a/<! (aa/thread-call executor #(ws-send conn (t/encode-str val))))
+                        (recur)))))
+
+                (a/go
+                  ;; Subscribe to corresponding topics
+                  (a/<! (msgbus :sub {:topics [file-id team-id] :chan sub-ch}))
+                  (a/<! (handle-connect cfg))
+                  (a/close! sub-ch))))
+
+            (on-error [_conn e]
+              (mtx-aconn :dec)
+              (mtx-sessions :observe (/ (inst-ms (dt/duration-between created-at (dt/now))) 1000.0))
+              (log/tracef "on-error %s (%s)" (:session-id cfg) (ex-message e))
+              (a/close! out-ch)
+              (a/close! rcv-ch))
+
+            (on-close [_conn _status _reason]
+              (mtx-aconn :dec)
+              (mtx-sessions :observe (/ (inst-ms (dt/duration-between created-at (dt/now))) 1000.0))
+              (log/tracef "on-close %s" (:session-id cfg))
+              (a/close! out-ch)
+              (a/close! rcv-ch))
+
+            (on-message [_ws message]
+              (let [message (t/decode-str message)]
+                (when-not (a/offer! rcv-ch message)
+                  (log/warn "droping ws input message, channe full"))))]
+
+      {:on-connect on-connect
+       :on-error on-error
+       :on-close on-close
+       :on-text (mtx/wrap-counter on-message mtx-messages ["recv"])
+       :on-bytes (constantly nil)})))
+
+;; --- CONNECTION INIT
+
+(declare handle-message)
+(declare start-loop!)
+
+(defn- handle-connect
+  [{:keys [conn] :as cfg}]
+  (a/go
+    (try
+      (aa/<? (handle-message cfg {:type :connect}))
+      (aa/<? (start-loop! cfg))
+      (aa/<? (handle-message cfg {:type :disconnect}))
+      (catch Throwable err
+        (log/errorf err "unexpected exception on websocket handler")
+        (let [session (.getSession ^WebSocketAdapter conn)]
+          (when session
+            (.disconnect session)))))))
+
+(defn- start-loop!
+  [{:keys [rcv-ch out-ch sub-ch session-id] :as cfg}]
+  (aa/go-try
+   (loop []
+     (let [timeout    (a/timeout 30000)
+           [val port] (a/alts! [rcv-ch sub-ch timeout])]
+
+       (cond
+         ;; Process message coming from connected client
+         (and (= port rcv-ch) (some? val))
+         (do
+           (aa/<? (handle-message cfg val))
+           (recur))
+
+         ;; If message comes from subscription channel; we just need
+         ;; to foreward it to the output channel.
+         (and (= port sub-ch) (some? val))
+         (do
+           (when-not (= (:session-id val) session-id)
+             (a/>! out-ch val))
+           (recur))
+
+         ;; When timeout channel is signaled, we need to send a ping
+         ;; message to the output channel. TODO: we need to make this
+         ;; more smart.
+         (= port timeout)
+         (do
+           (a/>! out-ch {:type :ping})
+           (recur))
+
+         :else
+         nil)))))
+
+;; --- PRESENCE HANDLING API
+
+(def ^:private
+  sql:retrieve-presence
+  "select * from presence
+    where file_id=?
+      and (clock_timestamp() - updated_at) < '5 min'::interval")
+
+(def ^:private
+  sql:update-presence
+  "insert into presence (file_id, session_id, profile_id, updated_at)
+   values (?, ?, ?, clock_timestamp())
+       on conflict (file_id, session_id, profile_id)
+       do update set updated_at=clock_timestamp()")
+
+(defn- retrieve-presence
+  [{:keys [pool file-id] :as cfg}]
+  (let [rows (db/exec! pool [sql:retrieve-presence file-id])]
+    (mapv (juxt :session-id :profile-id) rows)))
+
+(defn- retrieve-presence*
+  [{:keys [executor] :as cfg}]
+  (aa/with-thread executor
+    (retrieve-presence cfg)))
+
+(defn- update-presence
+  [{:keys [pool file-id session-id profile-id] :as cfg}]
+  (let [sql [sql:update-presence file-id session-id profile-id]]
+    (db/exec-one! pool sql)))
+
+(defn- update-presence*
+  [{:keys [executor] :as cfg}]
+  (aa/with-thread executor
+    (update-presence cfg)))
+
+(defn- delete-presence
+  [{:keys [pool file-id session-id profile-id] :as cfg}]
+  (db/delete! pool :presence {:file-id file-id
+                              :profile-id profile-id
+                              :session-id session-id}))
+
+(defn- delete-presence*
+  [{:keys [executor] :as cfg}]
+  (aa/with-thread executor
+    (delete-presence cfg)))
+
+;; --- INCOMING MSG PROCESSING
+
+(defmulti handle-message
+  (fn [_ message] (:type message)))
+
+(defmethod handle-message :connect
+  [{:keys [file-id msgbus] :as cfg} _message]
+  ;; (log/debugf "profile '%s' is connected to file '%s'" profile-id file-id)
+  (aa/go-try
+   (aa/<? (update-presence* cfg))
+   (let [members (aa/<? (retrieve-presence* cfg))
+         val     {:topic file-id :message {:type :presence :sessions members}}]
+     (a/<! (msgbus :pub val)))))
+
+(defmethod handle-message :disconnect
+  [{:keys [file-id msgbus] :as cfg} _message]
+  ;; (log/debugf "profile '%s' is disconnected from '%s'" profile-id file-id)
+  (aa/go-try
+   (aa/<? (delete-presence* cfg))
+   (let [members (aa/<? (retrieve-presence* cfg))
+         val     {:topic file-id :message {:type :presence :sessions members}}]
+     (a/<! (msgbus :pub val)))))
+
+(defmethod handle-message :keepalive
+  [cfg _message]
+  (update-presence* cfg))
+
+(defmethod handle-message :pointer-update
+  [{:keys [profile-id file-id session-id msgbus] :as cfg} message]
+  (let [message (assoc message
+                       :profile-id profile-id
+                       :session-id session-id)]
+    (msgbus :pub {:topic file-id
+                  :message message})))
+
+(defmethod handle-message :default
+  [_ws message]
+  (a/go
+    (log/warnf "received unexpected message: %s" message)))
+

backend/src/app/redis.clj

@@ -1,47 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; Copyright (c) 2019 Andrey Antukh <niwi@niwi.nz>
-
-(ns app.redis
-  (:refer-clojure :exclude [run!])
-  (:require
-   [app.config :as cfg]
-   [app.util.redis :as redis]
-   [mount.core :as mount :refer [defstate]])
-  (:import
-   java.lang.AutoCloseable))
-
-;; --- Connection Handling & State
-
-(defn- create-client
-  [config]
-  (let [uri (:redis-uri config "redis://redis/0")]
-    (redis/client uri)))
-
-(declare client)
-
-(defstate client
-  :start (create-client cfg/config)
-  :stop (.close ^AutoCloseable client))
-
-(declare conn)
-
-(defstate conn
-  :start (redis/connect client)
-  :stop (.close ^AutoCloseable conn))
-
-;; --- API FORWARD
-
-(defn subscribe
-  [opts]
-  (redis/subscribe client opts))
-
-(defn run!
-  [cmd params]
-  (redis/run! conn cmd params))
-
-(defn run
-  [cmd params]
-  (redis/run conn 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,156 @@
+;; 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- run-hook
+  [hook-fn response]
+  (ex/ignoring (hook-fn))
+  response)
+
+(defn- rpc-query-handler
+  [methods {:keys [profile-id] :as request}]
+  (let [type   (keyword (get-in request [:path-params :type]))
+        data   (assoc (:params request) ::type type)
+        data   (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)
+
+      (fn? (:before-complete mdata))
+      (run-hook (:before-complete mdata)))))
+
+(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 :histogram
+               :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 :histogram
+               :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.ldap
+                     '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

@@ -5,25 +5,30 @@
 ;; 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.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.rpc.mutations.profile :as profile]
+   [app.setup.initial-data :as sid]
    [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)
@@ -31,15 +36,24 @@
         params   {:id id
                   :email email
                   :fullname fullname
-                  :demo? true
-                  :password password}]
-    (db/with-atomic [conn db/pool]
+                  :is-demo true
+                  :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)
+           (sid/load-initial-project! 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/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,14 +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.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]))
 
 ;; --- Helpers & Specs
@@ -43,9 +41,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 +61,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 +80,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 +100,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 +120,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,14 +147,15 @@
 (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)
+    (files/check-edition-permissions! conn profile-id library-id)
     (link-file-to-library conn params)))
 
 (def sql:link-file-to-library
@@ -176,9 +175,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 +195,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 +216,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)))
 
@@ -252,19 +251,22 @@
               :reg-objects :mov-objects} (:type change))
            (some? (:component-id change)))))
 
-(declare update-file)
-(declare retrieve-lagged-changes)
 (declare insert-change)
+(declare retrieve-lagged-changes)
+(declare retrieve-team-id)
+(declare send-notifications)
+(declare update-file)
 
-(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)
+                   (assoc params :file file)))))
 
 (defn- update-file
-  [conn file params]
+  [{:keys [conn] :as cfg} {:keys [file changes session-id profile-id] :as params}]
   (when (> (:revn params)
            (:revn file))
     (ex/raise :type :validation
@@ -272,63 +274,70 @@
               :hint "The incoming revision number is greater that stored version."
               :context {:incoming-revn (:revn params)
                         :stored-revn (:revn file)}))
-  (let [sid      (:session-id params)
-        changes  (:changes params)
-        file     (-> file
-                     (update :data blob/decode)
-                     (update :data pmg/migrate-data)
-                     (update :data cp/process-changes changes)
-                     (update :data blob/encode)
-                     (update :revn inc)
-                     (assoc :changes (blob/encode changes)
-                            :session-id sid))
 
-        _        (insert-change conn file)
-        msg      {:type :file-change
-                  :profile-id (:profile-id params)
-                  :file-id (:id file)
-                  :session-id sid
-                  :revn (:revn file)
-                  :changes changes}
-
-        library-changes (filter library-change? changes)]
-
-    @(redis/run! :publish {:channel (str (:id file))
-                           :message (t/encode-str msg)})
-
-    (when (and (:is-shared file) (seq library-changes))
-      (let [{:keys [team-id] :as project}
-            (db/get-by-id conn :project (:project-id file))
-
-            msg {:type :library-change
-                 :profile-id (:profile-id params)
+  (let [file (-> file
+                 (update :revn inc)
+                 (update :data (fn [data]
+                                 (-> data
+                                     (blob/decode)
+                                     (assoc :id (:id file))
+                                     (pmg/migrate-data)
+                                     (cp/process-changes changes)
+                                     (blob/encode)))))]
+    ;; Insert change to the xlog
+    (db/insert! conn :file-change
+                {:id (uuid/next)
+                 :session-id session-id
+                 :profile-id profile-id
                  :file-id (:id file)
-                 :session-id sid
                  :revn (:revn file)
-                 :modified-at (dt/now)
-                 :changes library-changes}]
-
-        @(redis/run! :publish {:channel (str team-id)
-                               :message (t/encode-str msg)})))
+                 :data (:data file)
+                 :changes (blob/encode changes)})
 
+    ;; Update file
     (db/update! conn :file
                 {:revn (:revn file)
-                 :data (:data file)}
+                 :data (:data file)
+                 :has-media-trimmed false}
                 {:id (:id file)})
 
-    (retrieve-lagged-changes conn params)))
+    (let [params (assoc params :file file)]
+      ;; Send asynchronous notifications
+      (send-notifications cfg params)
 
-(defn- insert-change
-  [conn {:keys [revn data changes session-id] :as file}]
-  (let [id      (uuid/next)
-        file-id (:id file)]
-    (db/insert! conn :file-change
-                {:id id
-                 :session-id session-id
-                 :file-id file-id
-                 :revn revn
-                 :data data
-                 :changes changes})))
+      ;; Retrieve and return lagged data
+      (retrieve-lagged-changes conn params))))
+
+(defn- send-notifications
+  [{:keys [msgbus conn] :as cfg} {:keys [file changes session-id] :as params}]
+  (let [lchanges (filter library-change? changes)]
+
+    ;; Asynchronously publish message to the msgbus
+    (msgbus :pub {:topic (:id file)
+                  :message
+                  {:type :file-change
+                   :profile-id (:profile-id params)
+                   :file-id (:id file)
+                   :session-id (:session-id params)
+                   :revn (:revn file)
+                   :changes changes}})
+
+    (when (and (:is-shared file) (seq lchanges))
+      (let [team-id (retrieve-team-id conn (:project-id file))]
+        ;; Asynchronously publish message to the msgbus
+        (msgbus :pub {:topic team-id
+                      :message
+                      {:type :library-change
+                       :profile-id (:profile-id params)
+                       :file-id (:id file)
+                       :session-id session-id
+                       :revn (:revn file)
+                       :modified-at (dt/now)
+                       :changes lchanges}})))))
+
+(defn- retrieve-team-id
+  [conn project-id]
+  (:team-id (db/get-by-id conn :project project-id {:columns [:team-id]})))
 
 (def ^:private
   sql:lagged-changes

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

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