more wip

🎉 Add webhooks processing & errors UI integration

.circleci/config.yml

@@ -2,26 +2,20 @@ 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
+      - image: cimg/postgres:14.5
         environment:
           POSTGRES_USER: penpot_test
           POSTGRES_PASSWORD: penpot_test
-          POSTGRES_DB: penpot
-
-      - image: circleci/redis:6.0.8
+          POSTGRES_DB: penpot_test
+      - image: cimg/redis:7.0.5
 
     working_directory: ~/repo
+    resource_class: large
 
     environment:
       # Customize the JVM maximum heap limit
-      JVM_OPTS: -Xmx1g
+      JVM_OPTS: -Xmx4g
 
     steps:
       - checkout
@@ -29,38 +23,79 @@ jobs:
       # Download and cache dependencies
       - restore_cache:
          keys:
-           - v1-dependencies-{{ checksum "backend/deps.edn" }}-{{ checksum "frontend/deps.edn"}}
+           - v1-dependencies-{{ checksum "backend/deps.edn" }}-{{ checksum "frontend/deps.edn"}}-{{ checksum "common/deps.edn"}}
            # fallback to using the latest cache if no exact match is found
            - v1-dependencies-
 
-      # run lint
-      - run:
-          working_directory: "./backend"
-          name: backend lint
-          command: "clj-kondo --lint src/"
-
-      # run test
-      - run:
-          working_directory: "./backend"
-          name: backend test
-          command: "clojure -M:dev:tests"
-          environment:
-            PENPOT_DATABASE_URI: "postgresql://localhost/penpot"
-            PENPOT_DATABASE_USERNAME: penpot_test
-            PENPOT_DATABASE_PASSWORD: penpot_test
-            PENPOT_REDIS_URI: "redis://localhost/1"
+      - run: cd .clj-kondo && cat config.edn
 
       - run:
+          name: frontend styles prettier
           working_directory: "./frontend"
-          name: frontend tests
           command: |
             yarn install
-            npx shadow-cljs compile tests
+            yarn run lint-scss
+
+      - run:
+          name: common lint
+          working_directory: "./common"
+          command: |
+            clj-kondo --version
+            clj-kondo --parallel --lint src/
+
+      - run:
+          name: frontend lint
+          working_directory: "./frontend"
+          command: |
+            clj-kondo --version
+            clj-kondo --parallel --lint src/
+
+      - run:
+          name: backend lint
+          working_directory: "./backend"
+          command: |
+            clj-kondo --version
+            clj-kondo --parallel --lint src/
+
+      - run:
+          working_directory: "./common"
+          name: common tests
+          command: |
+            yarn install
+            yarn test
+            clojure -X:dev:test :patterns '["common-tests.*-test"]'
+
           environment:
             PATH: /usr/local/nodejs/bin/:/usr/local/bin:/bin:/usr/bin
+            JVM_OPTS: -Xmx4g
+            NODE_OPTIONS: --max-old-space-size=4096
+
+      - run:
+          name: backend test
+          working_directory: "./backend"
+          command: |
+            clojure -X:dev:test :patterns '["backend-tests.*-test"]'
+
+          environment:
+            PENPOT_TEST_DATABASE_URI: "postgresql://localhost/penpot_test"
+            PENPOT_TEST_DATABASE_USERNAME: penpot_test
+            PENPOT_TEST_DATABASE_PASSWORD: penpot_test
+            PENPOT_TEST_REDIS_URI: "redis://localhost/1"
+            JVM_OPTS: -Xmx4g
+
+      - run:
+          name: frontend tests
+          working_directory: "./frontend"
+          command: |
+            yarn install
+            yarn test
+
+          environment:
+            PATH: /usr/local/nodejs/bin/:/usr/local/bin:/bin:/usr/bin
+            NODE_OPTIONS: --max-old-space-size=4096
 
       - save_cache:
          paths:
            - ~/.m2
-         key: v1-dependencies-{{ checksum "backend/deps.edn" }}-{{ checksum "frontend/deps.edn"}}
+         key: v1-dependencies-{{ checksum "backend/deps.edn" }}-{{ checksum "frontend/deps.edn"}}-{{ checksum "common/deps.edn"}}
 

.clj-kondo/config.edn

@@ -1,14 +1,37 @@
-{:lint-as {potok.core/reify clojure.core/reify
-           promesa.core/let clojure.core/let
-           rumext.alpha/defc clojure.core/defn
-           app.db/with-atomic clojure.core/with-open}
+{:lint-as
+ {promesa.core/let clojure.core/let
+  promesa.core/->> clojure.core/->>
+  promesa.core/-> clojure.core/->
+  rumext.v2/defc clojure.core/defn
+  rumext.v2/fnc clojure.core/fn
+  app.common.data/export clojure.core/def
+  app.db/with-atomic clojure.core/with-open
+  app.common.data.macros/get-in clojure.core/get-in
+  app.common.data.macros/with-open clojure.core/with-open
+  app.common.data.macros/select-keys clojure.core/select-keys
+  app.common.logging/with-context clojure.core/do}
+
+ :hooks
+ {:analyze-call
+  {app.common.data.macros/export hooks.export/export
+   potok.core/reify hooks.export/potok-reify
+   app.util.services/defmethod hooks.export/service-defmethod
+   }}
+
  :output
- {:exclude-files ["data_readers.clj"]}
+ {:exclude-files
+  ["data_readers.clj"
+   "app/util/perf.cljs"
+   "app/common/logging.cljc"
+   "app/common/exceptions.cljc"]}
 
  :linters
  {:unsorted-required-namespaces
   {:level :warning}
 
+  :potok/reify-type
+  {:level :error}
+
   :unresolved-namespace
   {:level :warning
    :exclude [data_readers]}
@@ -16,12 +39,15 @@
   :single-key-in
   {:level :warning}
 
+  :non-arg-vec-return-type-hint
+  {:level :off}
+
+  :redundant-do
+  {:level :off}
+
   :unused-binding
   {:exclude-destructured-as true
    :exclude-destructured-keys-in-fn-args false
    }
-
-  :unresolved-symbol
-  {:exclude ['(app.util.services/defmethod)
-             ]}}}
+  }}
 

.clj-kondo/hooks/export.clj

@@ -0,0 +1,89 @@
+(ns hooks.export
+  (:require [clj-kondo.hooks-api :as api]))
+
+(defn export
+  [{:keys [:node]}]
+  (let [[_ sname] (:children node)
+        result  (api/list-node
+                 [(api/token-node (symbol "def"))
+                  (api/token-node (symbol (name (:value sname))))
+                  sname])]
+    {:node result}))
+
+(def registry (atom {}))
+
+(defn potok-reify
+  [{:keys [:node :filename] :as params}]
+  (let [[rnode rtype & other] (:children node)
+        rsym (symbol (str "event-type-" (name (:k rtype))))
+        reg  (get @registry filename #{})]
+    (when-not (:namespaced? rtype)
+      (let [{:keys [:row :col]} (meta rtype)]
+        (api/reg-finding! {:message "ptk/reify type should be namespaced"
+                           :type :potok/reify-type
+                           :row row
+                           :col col})))
+
+    (if (contains? reg rsym)
+      (let [{:keys [:row :col]} (meta rtype)]
+        (api/reg-finding! {:message (str "duplicate type: " (name (:k rtype)))
+                           :type :potok/reify-type
+                           :row row
+                           :col col}))
+      (swap! registry update filename (fnil conj #{}) rsym))
+
+    (let [result  (api/list-node
+                   (into [(api/token-node (symbol "deftype"))
+                          (api/token-node rsym)
+                          (api/vector-node [])]
+                         other))]
+      {:node result})))
+
+(defn clojure-specify
+  [{:keys [:node]}]
+  (let [[rnode rtype & other] (:children node)
+        result  (api/list-node
+                 (into [(api/token-node (symbol "extend-type"))
+                        (api/token-node (gensym (:string-value rtype)))]
+                       other))]
+    {:node result}))
+
+
+(defn service-defmethod
+  [{:keys [:node]}]
+  (let [[rnode rtype ?meta & other] (:children node)
+        rsym    (gensym (name (:k rtype)))
+
+        [?docs other] (if (api/string-node? ?meta)
+                        [?meta other]
+                        [nil (cons ?meta other)])
+
+        [?meta other] (let [?meta (first other)]
+                        (if (api/map-node? ?meta)
+                          [?meta (rest other)]
+                          [nil   other]))
+
+        nodes         [(api/token-node (symbol "do"))
+                       (api/list-node
+                        [(api/token-node (symbol "declare"))
+                         (api/token-node rsym)])
+
+                       (when ?docs
+                         (api/list-node
+                          [(api/token-node (symbol "comment")) ?docs]))
+
+                       (when ?meta
+                         (api/list-node
+                          [(api/token-node (symbol "reset-meta!"))
+                           (api/token-node rsym)
+                           ?meta]))
+                       (api/list-node
+                        (into [(api/token-node (symbol "defmethod"))
+                               (api/token-node rsym)
+                               rtype]
+                              other))]
+        result  (api/list-node (filterv some? nodes))]
+
+    ;; (prn "=====>" rtype)
+    ;; (prn (api/sexpr result))
+    {:node result}))

.github/ISSUE_TEMPLATE/bug-report.yml

@@ -0,0 +1,89 @@
+description: Create a report to help us improve
+labels: ["bug"]
+name: Bug report
+title: "bug: "
+body:
+  - type: markdown
+    attributes:
+      value: |
+        ## Before you start
+
+        Please search our [existing issues](https://github.com/penpot/penpot/issues) and open [pull requests](https://github.com/penpot/penpot/pulls) to lessen the change of filing duplicate issues or feature requests. Thank you.
+
+        ---
+  - type: textarea
+    attributes:
+      label: Steps To Reproduce
+      description: Steps to reproduce the behavior.
+      placeholder: |
+        Steps to reproduce the behavior:
+        1.  Go to '...'
+        2.  Click on '....'
+        3.  Scroll down to '....'
+    validations:
+      required: true
+  - type: textarea
+    id: expected
+    attributes:
+      description: A clear and concise description of what you expected to happen.
+      label: Expected behavior
+    validations:
+      required: true
+  - type: textarea
+    id: actual
+    attributes:
+      description: A clear and concise description of what happens instead; what the bug is.
+      label: Actual behavior
+    validations:
+      required: true
+  - type: textarea
+    id: screenshots
+    attributes:
+      description: If applicable, add screenshots to help explain your problem.
+      label: Screenshots or video
+  - type: textarea
+    id: desktop
+    attributes:
+      label: Desktop (please complete the following information)
+      placeholder: |
+        - OS (e.g. iOS):
+        - Browser & version (e.g. Chrome 89.0):
+  - type: textarea
+    id: mobile
+    attributes:
+      label: Smartphone (please complete the following information)
+      placeholder: |
+        - Device & model (e.g. iPhone 6):
+        - OS & version (e.g. iOS 8.1):
+        - Browser & version (e.g. stock browser 22):
+  - type: textarea
+    id: environment
+    attributes:
+      label: Environment (please complete the following information)
+      placeholder: |
+        - Host (e.g. https://design.penpot.app, local instance):
+
+        *If self-hosted:*
+        - OS Version (e.g. Ubuntu 16.04):
+        - Docker / Docker-compose version (e.g. Docker version 18.03.0-ce, build 0520e24):
+        - Image version (e.g. Alpine):
+
+        Docker commands or docker-compose file (if possible and if proceed.x):
+        ```
+
+        ```
+  - type: textarea
+    id: frontend-trace
+    attributes:
+      label: Frontend Stack Trace
+      render: console
+  - type: textarea
+    id: backend-trace
+    attributes:
+      label: Backend Stack Trace
+      render: console
+  - type: textarea
+    id: additional-context
+    attributes:
+      label: Additional context
+      description: Any other context about the problem.

.github/ISSUE_TEMPLATE/bug_report.md

@@ -1,73 +0,0 @@
----
-
-name: Bug report
-about: Create a report to help us improve
-title: ''
-labels: bug
-assignees: ''
-
----
-
-**Describe the bug**
-A clear and concise description of what the bug is.
-
-**To Reproduce**
-Steps to reproduce the behavior:
-1.  Go to '...'
-2.  Click on '....'
-3.  Scroll down to '....'
-4.  See error
-
-**Expected behavior**
-A clear and concise description of what you expected to happen.
-
-**Screenshots**
-If applicable, add screenshots to help explain your problem.
-
-**Desktop (please complete the following information):**
-
--   OS: (e.g. iOS)
--   Browser (e.g. chrome, safari)
--   Version (e.g. 22)
-
-**Smartphone (please complete the following information):**
-
--   Device: (e.g. iPhone6)
--   OS: (e.g. iOS8.1)
--   Browser (e.g. stock browser, safari)
--   Version (e.g. 22)
-
-**Environment (please complete the following information):**
-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 and if proceed.x
-
--   Docker / Docker-compose Version: (e.g. Docker version 18.03.0-ce, build 0520e24)
--   Image (e.g. alpine)
-
-**Frontend Stack Trace (if self-hosted)**
-
-<details>
-
-```
-
-```
-
-</details>
-
-**Backend Stack Trace (if self-hosted)**
-
-<details>
-
-```
-
-```
-
-</details>
-
-**Additional context**
-Add any other context about the problem here.

.github/ISSUE_TEMPLATE/feature-request.yml

@@ -0,0 +1,37 @@
+description: Suggest an idea for this project.
+labels: ["needs triage", "enhancement"]
+name: "Feature request"
+title: "feature: "
+body:
+  - type: markdown
+    attributes:
+      value: |
+        ## Before you start
+
+        Please search our [existing issues](https://github.com/penpot/penpot/issues) and open [pull requests](https://github.com/penpot/penpot/pulls) to lessen the change of filing duplicate issues or feature requests. Thank you.
+
+        ---
+  - type: textarea
+    id: problem
+    attributes:
+      description: A clear and concise description of what the problem is. Ex. I'm always frustrated when (...)
+      label: Is your feature request related to a problem? Please describe.
+    validations:
+      required: true
+  - type: textarea
+    id: solution
+    attributes:
+      description: A clear and concise description of what you want to happen.
+      label: Describe the solution you'd like.
+    validations:
+      required: true
+  - type: textarea
+    id: alternatives
+    attributes:
+      label: Describe alternatives you've considered.
+      description: A clear and concise description of any alternative solutions or features you've considered.
+  - type: textarea
+    id: additional-context
+    attributes:
+      label: Additional context
+      description: Add any other context or screenshots about the feature request here.

.github/ISSUE_TEMPLATE/feature_request.md

@@ -1,21 +0,0 @@
----
-
-name: Feature request
-about: Suggest an idea for this project
-title: ''
-labels: enhancement
-assignees: ''
-
----
-
-**Is your feature request related to a problem? Please describe.**
-A clear and concise description of what the problem is. Ex. I'm always frustrated when (...)
-
-**Describe the solution you'd like**
-A clear and concise description of what you want to happen.
-
-**Describe alternatives you've considered**
-A clear and concise description of any alternative solutions or features you've considered.
-
-**Additional context**
-Add any other context or screenshots about the feature request here.

.gitignore

@@ -1,36 +1,59 @@
-figwheel_server.log
-*jar
 *-init.clj
-.lein-deps-sum
-.lein-failures
-.lein-repl-history
-.lein-plugins/
-.repl
-.nrepl-port
+*.jar
+*.orig
+*.penpot
+.calva
+.clj-kondo
 .cpcache
+.lsp
+.nrepl-port
+.nyc_output
 .rebel_readline_history
-/vendor/**/target
-/cd.md
-node_modules
-/backend/target/
-/backend/resources/public/media
-/backend/resources/public/assets
+.repl
+.shadow-cljs
+/*.jpg
+/*.md
+/*.png
+/*.sql
+/*.txt
+/*.yml
+/*.zip
+/.clj-kondo/.cache
+/_dump
+/backend/*.md
+/backend/*.sql
+/backend/*.txt
+/backend/assets/
+/backend/builtin-templates
 /backend/dist/
 /backend/logs/
-/backend/-
-/frontend/npm-debug.log
-/frontend/target/
-/frontend/dist/
-/frontend/out/
-/frontend/.shadow-cljs
-/frontend/resources/public/*
-/exporter/target
-/exporter/.shadow-cljs
-/docker/images/bundle
-/.clj-kondo/.cache
+/backend/resources/public/assets
+/backend/resources/public/media
+/backend/target/
 /bundle*
-/media
+/cd.md
+/clj-profiler/
+/common/coverage
+/common/target
 /deploy
+/docker/images/bundle*
+/exporter/target
+/frontend/cypress/fixtures/validuser.json
+/frontend/cypress/videos/*/
+/frontend/cypress/videos/*/
+/frontend/dist/
+/frontend/npm-debug.log
+/frontend/out/
+/frontend/package-lock.json
+/frontend/resources/fonts/experiments
+/frontend/resources/public/*
+/frontend/target/
+/other/
+/scripts/
+/telemetry/
+/tmp/
+/vendor/**/target
+/vendor/svgclean/bundle*.js
 /web
-/_dump
-/vendor/svgclean/bundle*.js
+clj-profiler/
+node_modules

.gitpod.yml

@@ -0,0 +1,105 @@
+image:
+  file: docker/gitpod/Dockerfile
+
+ports:
+  # nginx
+  - port: 3449
+    onOpen: open-preview
+
+  # frontend nREPL
+  - port: 3447
+    onOpen: ignore
+    visibility: private
+
+  # frontend shadow server
+  - port: 3448
+    onOpen: ignore
+    visibility: private
+
+  # backend
+  - port: 6060
+    onOpen: ignore
+
+  # exporter shadow server
+  - port: 9630
+    onOpen: ignore
+    visibility: private
+
+  # exporter http server
+  - port: 6061
+    onOpen: ignore
+
+  # mailhog web interface
+  - port: 8025
+    onOpen: ignore
+
+  # mailhog postfix
+  - port: 1025
+    onOpen: ignore
+
+  # postgres
+  - port: 5432
+    onOpen: ignore
+
+  # redis
+  - port: 6379
+    onOpen: ignore
+
+  # openldap
+  - port: 389
+    onOpen: ignore
+
+tasks:
+  # https://github.com/gitpod-io/gitpod/issues/666#issuecomment-534347856
+  - name: gulp
+    command: >
+      cd $GITPOD_REPO_ROOT/frontend/;
+      yarn && gp sync-done 'frontend-yarn';
+      npx gulp --theme=${PENPOT_THEME} watch
+
+  - name: frontend shadow watch
+    command: >
+      cd $GITPOD_REPO_ROOT/frontend/;
+      gp sync-await 'frontend-yarn';
+      npx shadow-cljs watch main
+
+  - init: gp await-port 5432 && psql -f $GITPOD_REPO_ROOT/docker/gitpod/files/postgresql_init.sql
+    name: backend
+    command: >
+      cd $GITPOD_REPO_ROOT/backend/;
+      ./scripts/start-dev
+
+  - name: exporter shadow watch
+    command:
+      cd $GITPOD_REPO_ROOT/exporter/;
+      gp sync-await 'frontend-yarn';
+      yarn && npx shadow-cljs watch main
+
+  - name: exporter web server
+    command: >
+      cd $GITPOD_REPO_ROOT/exporter/;
+      ./scripts/wait-and-start.sh
+
+  - name: signed terminal
+    before: >
+      [[ ! -z ${GNUGPG}  ]] &&
+      cd ~ &&
+      rm -rf .gnupg &&
+      echo ${GNUGPG} | base64 -d | tar --no-same-owner -xzvf -
+    init: >
+      [[ ! -z ${GNUGPG_KEY}  ]] &&
+      git config --global commit.gpgsign true &&
+      git config --global user.signingkey ${GNUGPG_KEY}
+    command: cd $GITPOD_REPO_ROOT
+
+  - name: redis
+    command: redis-server
+
+  - before: go get github.com/mailhog/MailHog
+    name: mailhog
+    command: MailHog
+
+  - name: Nginx
+    command: >
+      nginx &&
+      multitail /var/log/nginx/access.log -I /var/log/nginx/error.log

CONTRIBUTING.md

@@ -19,9 +19,9 @@ 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
+If you found a bug that you consider better discuss in private (for
 example: security bugs), consider first send an email to
-`info@penpot.app`.
+`support@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
@@ -54,7 +54,7 @@ We will use the `easy fix` mark for tag for indicate issues that are
 easy for beginners.
 
 
-## Commit Message Guidelines ##
+## Commit Guidelines ##
 
 We have very precise rules over how our git commit messages can be formatted.
 
@@ -78,7 +78,6 @@ Where type is:
 - :ambulance: `:ambulance:` a commit that fixes critical bug
 - :books: `:books:` a commit that improves or adds documentation
 - :construction: `:construction:`: a wip commit
-- :construction_worker: `:construction_worker:` a commit with CI related stuff
 - :boom: `:boom:` a commit with breaking changes
 - :wrench: `:wrench:` a commit for config updates
 - :zap: `:zap:` a commit with performance improvements
@@ -91,12 +90,25 @@ More info:
  - https://gist.github.com/parmentf/035de27d6ed1dce0b36a
  - https://gist.github.com/rxaviers/7360908
 
-The subject should be:
+Each commit should have:
 
-- Use the imperative mood.
-- Capitalize the first letter.
-- Don't put a period at the end of the subject line.
-- Put a blank line between the subject line and the body.
+- A concise subject using imperative mood.
+- The subject should have capitalized the first letter, without period
+  at the end and no larger than 65 characters.
+- A blank line between the subject line and the body.
+- An entry on the CHANGES.md file if applicable, referencing the
+  github or taiga issue/user-story using the these same rules.
+
+Examples of good commit messages:
+
+- :bug: Fix unexpected error on launching modal
+- :bug: Set proper error message on generic error
+- :sparkles: Enable new modal for profile
+- :zap: Improve performance of dashboard navigation
+- :wrench: Update default backend configuration
+- :books: Add more documentation for authentication process
+- :ambulance: Fix critical bug on user registration process
+- :tada: Add new approach for user registration
 
 
 ## Code of conduct ##

README.md

@@ -2,48 +2,131 @@
 [uri_license]: https://www.mozilla.org/en-US/MPL/2.0
 [uri_license_image]: https://img.shields.io/badge/MPL-2.0-blue.svg
 
-[![License: MPL-2.0][uri_license_image]][uri_license]
-[![Gitter](https://badges.gitter.im/sereno-xyz/community.svg)](https://gitter.im/penpot/community)
-[![Managed with Taiga.io](https://img.shields.io/badge/managed%20with-TAIGA.io-709f14.svg)](https://tree.taiga.io/project/penpot/ "Managed with Taiga.io")
+<h1 align="center">
+  <br>
+  <img src="https://penpot.app/images/readme/readme-logo.jpg" alt="PENPOT">
+</h1>
+
+<p align="center"><a href="https://www.mozilla.org/en-US/MPL/2.0" rel="nofollow"><img src="https://camo.githubusercontent.com/3fcf3d6b678ea15fde3cf7d6af0e242160366282d62a7c182d83a50bfee3f45e/68747470733a2f2f696d672e736869656c64732e696f2f62616467652f4d504c2d322e302d626c75652e737667" alt="License: MPL-2.0" data-canonical-src="https://img.shields.io/badge/MPL-2.0-blue.svg" style="max-width:100%;"></a>
+<a href="https://gitter.im/penpot/community" rel="nofollow"><img src="https://camo.githubusercontent.com/5b0aecb33434f82a7b158eab7247544235ada0cf7eeb9ce8e52562dd67f614b7/68747470733a2f2f6261646765732e6769747465722e696d2f736572656e6f2d78797a2f636f6d6d756e6974792e737667" alt="Gitter" data-canonical-src="https://badges.gitter.im/sereno-xyz/community.svg" style="max-width:100%;"></a>
+<a href="https://tree.taiga.io/project/penpot/" title="Managed with Taiga.io" rel="nofollow"><img src="https://camo.githubusercontent.com/4a1d1112f0272e3393b1e8da312ff4435418e9e2eb4c0964881e3680f90a653c/68747470733a2f2f696d672e736869656c64732e696f2f62616467652f6d616e61676564253230776974682d54414947412e696f2d3730396631342e737667" alt="Managed with Taiga.io" data-canonical-src="https://img.shields.io/badge/managed%20with-TAIGA.io-709f14.svg" style="max-width:100%;"></a>
+<a href="https://gitpod.io/#https://github.com/penpot/penpot" rel="nofollow"><img src="https://camo.githubusercontent.com/daadb4894128d1e19b72d80236f5959f1f2b47f9fe081373f3246131f0189f6c/68747470733a2f2f696d672e736869656c64732e696f2f62616467652f476974706f642d72656164792d2d746f2d2d636f64652d626c75653f6c6f676f3d676974706f64" alt="Gitpod ready-to-code" data-canonical-src="https://img.shields.io/badge/Gitpod-ready--to--code-blue?logo=gitpod" style="max-width:100%;"></a></p>
+
+<p align="center">
+    <a href="https://penpot.app/"><b>Website</b></a> •
+    <a href="https://help.penpot.app/technical-guide/getting-started/"><b>Getting Started</b></a> •
+    <a href="https://help.penpot.app/user-guide/"><b>User Guide</b></a> •
+    <a href="https://help.penpot.app/user-guide/introduction/info/"><b>Tutorials & Info</b></a> •
+    <a href="https://community.penpot.app/"><b>Community</b></a> •
+    <a href="https://twitter.com/penpotapp"><b>Twitter</b></a> •
+    <a href="https://instagram.com/penpot.app"><b>Instagram</b></a> •
+    <a href="https://fosstodon.org/@penpot/"><b>Mastodon</b></a> •
+    <a href="https://www.youtube.com/channel/UCAqS8G72uv9P5HG1IfgnQ9g"><b>Youtube</b></a>
+</p>
+
+![feature-readme](https://user-images.githubusercontent.com/1045247/189871786-0b44f7cf-3a0a-4445-a87b-9919ec398bf7.gif)
+
+Penpot is the first **Open Source** design and prototyping platform meant for cross-domain teams. Non dependent on operating systems, Penpot is web based and works with open standards (SVG). Penpot invites designers all over the world to fall in love with open source while getting developers excited about the design process in return.
+
+## Table of contents ##
+
+- [Why Penpot](#why-penpot)
+- [Getting Started](#getting-started)
+- [Community](#community)
+- [Resources](#resources)
+- [License](#license)
+
+## Why Penpot ##
+
+Penpot makes design and prototyping accessible to every team in the world.
+
+### For cross-domain teams ###
+We have a clear focus on design and code teams and our capabilities reflect exactly that. The less hand-off mindset, the more fun for everyone.
+
+### Multiplatform ###
+Being web based, Penpot is not dependent on operating systems or local installations, you will only need to run a modern browser.
+
+### Open Standards ###
+Using SVG as no other design and prototyping tool does, Penpot files sport compatibility with most of the vectorial tools, are tech friendly and extremely easy to use on the web. We make sure you will always own your work.
+
+<p align="center">
+  <img src="https://penpot.app/images/open-source.png" alt="Open Source">
+</p>
 
 
-# PENPOT #
+## Getting started ##
 
-We’re excited to share that Uxbox is now Penpot! We’re changing the name, but keeping the same project essence. Stay in the loop for more news coming early 2021. Alpha release is close!
+### Install with Elestio ###
+[Elestio](https://elest.io/) offers a fully managed service for on-premise instances of a selection of open-source software! This means you can deploy a dedicated instance of Penpot in just 3 minutes with no technical knowledge needed.
 
-![PENPOT](https://raw.githubusercontent.com/penpot/penpot/develop/docs/screenshot.png)
+You don’t need to worry about DNS configuration, SMTP, backups, SSL certificates, OS & Penpot upgrades, and much more.
 
+[Get started with Elestio.](https://help.penpot.app/technical-guide/getting-started/#install-with-elestio)
 
-## Introduction ##
+### Install with Docker ###
 
-The open-source solution for design and prototyping. PENPOT is
-currently at an early development stage but we are working hard to
-bring you the beta version as soon as possible. Follow the project
-progress in Twitter or Github and stay tuned!
+You can also get started with Penpot locally or self-host it with **docker** and **docker-compose**.
 
+Here’s a step-by-step guide on [getting started with Docker.](https://help.penpot.app/technical-guide/getting-started/#install-with-docker)
 
-## SVG based ##
+### Penpot cloud app ###
 
-Penpot works with SVG, a standard format, for all your designs and
-prototypes . This means that all your stuff in Penpot is portable and
-editable in many other vector tools and easy to use on the web.
+If you prefer not to install Penpot in a local environment, [login or register on our Penpot cloud app](https://design.penpot.app). Create a team to work together on projects and share design assets or jump right away into Penpot and **start designing** on your own.
 
-[See SVG specification](https://www.w3.org/Graphics/SVG/)
+<p align="center">
+  <img src="https://help.penpot.app/img/home-techguide.png" alt="Getting started">
+</p>
+
+## Community ##
+
+We love the open source software community. Contributing is our passion and if it’s yours too, [participate](https://community.penpot.app/) and [improve](https://community.penpot.app/c/help-us-improve-penpot/7) Penpot. All your ideas and code are welcome!
+
+If you need help or have any questions; if you’d like to share your experience using Penpot or get inspired; if you’d rather meet our community of developers and designers, [join our Community](https://community.penpot.app/)!
+
+You will find the following categories:
+- [Ask the Community](https://community.penpot.app/c/ask-for-help-using-penpot/6)
+- [Troubleshooting](https://community.penpot.app/c/technical/8)
+- [Help us Improve Penpot](https://community.penpot.app/c/help-us-improve-penpot/7)
+- [#MadeWithPenpot](https://community.penpot.app/c/madewithpenpot/9)
+- [Events and Announcements](https://community.penpot.app/c/announcements/5)
+- [Inside Penpot](https://community.penpot.app/c/inside-penpot/21)
+- [Penpot in your language](https://community.penpot.app/c/penpot-in-your-language/12)
+
+<p align="center">
+  <img src="https://penpot.app/images/cross-teams.webp" alt="Community">
+</p>
 
 ## Contributing ##
 
-**Open to you!**
+Every sort of contribution will be very helpful to enhance Penpot. How you’ll participate? All your ideas, designs and code are welcome:
 
-We love the open source software community. Contributing is our
-passion and because of this, we'll be glad if you want to participate
-and improve Penpot. All your awesome ideas and code are welcome!
+- Invite your [team to join](https://design.penpot.app/#/auth/register)
+- Star this repo and follow us on Social Media:  [Twitter](https://twitter.com/penpotapp), [Instagram](https://instagram.com/penpot.app), [Youtube](https://www.youtube.com/c/Penpot) or [Mastodon](https://fosstodon.org/@penpot/).
+- Participate in the [Community](https://community.penpot.app/) asking and answering questions, reacting to others’ articles or opening your own conversations.
+- Report bugs with our easy [guide for bugs hunting](https://help.penpot.app/contributing-guide/reporting-bugs/) or [GitHub issues](https://github.com/penpot/penpot/issues)
+- Create and [share Libraries & templates](https://penpot.app/libraries-templates.html) that will be helpful for the community
+- Become a [translator](https://help.penpot.app/contributing-guide/translations)
+- Give feedback: [Mail us](mailto:support@penpot.app)
 
-Please refer to the [Contributing Guide](./CONTRIBUTING.md)
+To find (almost) everything you need to know on how to contribute to Penpot, refer to the [contributing-guide](https://help.penpot.app/contributing-guide/).
 
+<p align="center">
+  <img src="https://help.penpot.app/img/home-contributing.png" alt="Contributing">
+</p>
 
-## Documentation ##
+## Resources ##
 
-Please refer to [docs/ directory](./docs/).
+You can ask and answer questions, have open-ended conversations, and follow along on decisions affecting the project.
+
+💾 [Documentation](https://help.penpot.app/technical-guide/)
+
+🚀 [Getting Started](https://help.penpot.app/technical-guide/getting-started/)
+
+✏️ [Tutorials](https://www.youtube.com/playlist?list=PLgcCPfOv5v54WpXhHmNO7T-YC7AE-SRsr)
+
+🏘️ [Architecture](https://help.penpot.app/technical-guide/architecture/)
+
+📚 [Dev Diaries](https://penpot.app/dev-diaries.html)
 
 
 ## License ##
@@ -52,4 +135,7 @@ Please refer to [docs/ directory](./docs/).
 This Source Code Form is subject to the terms of the Mozilla Public
 License, v. 2.0. If a copy of the MPL was not distributed with this
 file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+Copyright (c) KALEIDOS INC
 ```
+Penpot is a Kaleidos’ [open source project](https://kaleidos.net/products)

SECURITY.md

@@ -0,0 +1,5 @@
+# Security Policy
+
+## Reporting a Vulnerability
+
+Please report security issues to `support@penpot.app`

THANKYOU.md

@@ -0,0 +1,97 @@
+# THANK YOU
+
+We want to thank to the amazing people that help us! Thank you! You're the best!
+
+## Security
+* Husnain Iqbal (CEO OF ALPHA INFERNO PVT LTD)
+* [Shiraz Ali Khan](https://www.linkedin.com/in/shiraz-ali-khan-1ba508180/)
+
+## Internationalization
+* [00ff88](https://hosted.weblate.org/user/00ff88)
+* [AhmadHB](https://hosted.weblate.org/user/AhmadHB)
+* [Aimee](https://hosted.weblate.org/user/Aimee)
+* [alejandro.alonso](alejandro.https://hosted.weblate.org/user/alonso)
+* [alexpawlak](https://hosted.weblate.org/user/alexpawlak)
+* [allytiago](https://hosted.weblate.org/user/allytiago)
+* [alonso.torres](alonso.https://hosted.weblate.org/user/torres)
+* [andres.moya](andres.https://hosted.weblate.org/user/moya)
+* [antoniofsm](https://hosted.weblate.org/user/antoniofsm)
+* [ascarida](https://hosted.weblate.org/user/ascarida)
+* [Bechii](https://hosted.weblate.org/user/Bechii)
+* [Beeby](https://hosted.weblate.org/user/Beeby)
+* [bingling-sama](bingling-https://hosted.weblate.org/user/sama)
+* [devadarta](https://hosted.weblate.org/user/devadarta)
+* [diacritica](https://hosted.weblate.org/user/diacritica)
+* [dundzys.vincas](dundzys.https://hosted.weblate.org/user/vincas)
+* [Eranot](https://hosted.weblate.org/user/Eranot)
+* [erral](https://hosted.weblate.org/user/erral)
+* [ersen](https://hosted.weblate.org/user/ersen)
+* [filipepessanha](https://hosted.weblate.org/user/filipepessanha)
+* [fortx](https://hosted.weblate.org/user/fortx)
+* [foxbit](https://hosted.weblate.org/user/foxbit)
+* [georgelemon](https://hosted.weblate.org/user/georgelemon)
+* [girafic](https://hosted.weblate.org/user/girafic)
+* [gizemb](https://hosted.weblate.org/user/gizemb)
+* [greench](https://hosted.weblate.org/user/greench)
+* [guidimas](https://hosted.weblate.org/user/guidimas)
+* [hfigueira_1](https://hosted.weblate.org/user/hfigueira_1)
+* [hifiaz](https://hosted.weblate.org/user/hifiaz)
+* [httpsterio](https://hosted.weblate.org/user/httpsterio)
+* [humteus](https://hosted.weblate.org/user/humteus)
+* [iblueer](https://hosted.weblate.org/user/iblueer)
+* [insan](https://hosted.weblate.org/user/insan)
+* [Iphi](https://hosted.weblate.org/user/Iphi)
+* [iWangJiaxiang](https://hosted.weblate.org/user/iWangJiaxiang)
+* [jancborchardt](https://hosted.weblate.org/user/jancborchardt)
+* [jazz](https://hosted.weblate.org/user/jazz)
+* [johnterroa](https://hosted.weblate.org/user/johnterroa)
+* [jponsa](https://hosted.weblate.org/user/jponsa)
+* [kapler](https://hosted.weblate.org/user/kapler)
+* [kingu](https://hosted.weblate.org/user/kingu)
+* [KnahkAmath](https://hosted.weblate.org/user/KnahkAmath)
+* [laminne](https://hosted.weblate.org/user/laminne)
+* [lenildoleite](https://hosted.weblate.org/user/lenildoleite)
+* [liimee](https://hosted.weblate.org/user/liimee)
+* [lixeix](https://hosted.weblate.org/user/lixeix)
+* [locness3](https://hosted.weblate.org/user/locness3)
+* [maiwann](https://hosted.weblate.org/user/maiwann)
+* [MidooDj](https://hosted.weblate.org/user/MidooDj)
+* [Mohamed_amine_gdoura](https://hosted.weblate.org/user/Mohamed_amine_gdoura)
+* [myfunnyandy](https://hosted.weblate.org/user/myfunnyandy)
+* [NampoinaRal](https://hosted.weblate.org/user/NampoinaRal)
+* [nautilusx](https://hosted.weblate.org/user/nautilusx)
+* [niwinz](https://hosted.weblate.org/user/niwinz)
+* [pablo.alba](pablo.https://hosted.weblate.org/user/alba)
+* [PhilippeAccorsi](https://hosted.weblate.org/user/PhilippeAccorsi)
+* [rnarius](https://hosted.weblate.org/user/rnarius)
+* [rnd](https://hosted.weblate.org/user/rnd)
+* [RuanAragao](https://hosted.weblate.org/user/RuanAragao)
+* [ruben](https://hosted.weblate.org/user/ruben)
+* [semonxue](https://hosted.weblate.org/user/semonxue)
+* [shahab](https://hosted.weblate.org/user/shahab)
+* [shuaib85](https://hosted.weblate.org/user/shuaib85)
+* [SiderealArt](https://hosted.weblate.org/user/SiderealArt)
+* [swapnil.cx](swapnil.https://hosted.weblate.org/user/cx)
+* [syuza](https://hosted.weblate.org/user/syuza)
+* [th3ph4nt0m](https://hosted.weblate.org/user/th3ph4nt0m)
+* [tiwb](https://hosted.weblate.org/user/tiwb)
+* [tommi](https://hosted.weblate.org/user/tommi)
+* [val](https://hosted.weblate.org/user/val)
+* [vikt](https://hosted.weblate.org/user/vikt)
+* [VinLin](https://hosted.weblate.org/user/VinLin)
+* [vintprox](https://hosted.weblate.org/user/vintprox)
+* [Voxybuns](https://hosted.weblate.org/user/Voxybuns)
+* [winie](https://hosted.weblate.org/user/winie)
+* [Yaron](https://hosted.weblate.org/user/Yaron)
+* [yrd](https://hosted.weblate.org/user/yrd)
+* [YukiYuigishi](https://hosted.weblate.org/user/YukiYuigishi)
+* [zcraber](https://hosted.weblate.org/user/zcraber)
+
+## Libraries & templates
+* systxema
+* plumilla
+* victor crespo
+* xtech
+* candidexmedia
+* merih güz
+* klarr agency

backend/build.clj

@@ -0,0 +1,36 @@
+(ns build
+  (:refer-clojure :exclude [compile])
+  (:require
+   [clojure.tools.build.api :as b]
+   [clojure.java.io]))
+
+(def class-dir "target/classes")
+(def basis (b/create-basis {:project "deps.edn"}))
+(def jar-file "target/penpot.jar")
+
+(defn clean [_]
+  (b/delete {:path "target"}))
+
+(defn jar [_]
+  (b/copy-dir
+   {:src-dirs ["src" "resources"]
+    :target-dir class-dir})
+
+  (b/compile-clj
+   {:basis basis
+    :src-dirs ["src"]
+    :class-dir class-dir})
+
+  (b/uber
+   {:class-dir class-dir
+    :uber-file jar-file
+    :main 'clojure.main
+    :exclude [#"goog.*" #"^javasist.*"]
+    :basis basis}))
+
+(defn compile [_]
+  (b/javac
+   {:src-dirs ["dev/java"]
+    :class-dir class-dir
+    :basis basis
+    :javac-opts ["-source" "17" "-target" "17"]}))

backend/deps.edn

@@ -1,102 +1,88 @@
-{:mvn/repos
- {"central" {:url "https://repo1.maven.org/maven2/"}
-  "clojars" {:url "https://clojars.org/repo"}
-  "jcenter" {:url "https://jcenter.bintray.com/"}}
- :deps
- {org.clojure/clojure {:mvn/version "1.10.2"}
-  org.clojure/clojurescript {:mvn/version "1.10.773"}
-  org.clojure/data.json {:mvn/version "1.0.0"}
-  org.clojure/core.async {:mvn/version "1.3.610"}
-  org.clojure/tools.cli {:mvn/version "1.0.194"}
+{:deps
+ {penpot/common {:local/root "../common"}
+  org.clojure/clojure {:mvn/version "1.11.1"}
+  org.clojure/core.async {:mvn/version "1.5.648"}
 
   ;; Logging
-  org.clojure/tools.logging {:mvn/version "1.1.0"}
-  org.apache.logging.log4j/log4j-api {:mvn/version "2.14.0"}
-  org.apache.logging.log4j/log4j-core {:mvn/version "2.14.0"}
-  org.apache.logging.log4j/log4j-web {:mvn/version "2.14.0"}
-  org.apache.logging.log4j/log4j-jul {:mvn/version "2.14.0"}
-  org.apache.logging.log4j/log4j-slf4j-impl {:mvn/version "2.14.0"}
-  org.slf4j/slf4j-api {:mvn/version "1.7.30"}
   org.zeromq/jeromq {:mvn/version "0.5.2"}
 
+  com.github.luben/zstd-jni {:mvn/version "1.5.2-4"}
+  org.clojure/data.fressian {:mvn/version "1.0.0"}
 
-  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.16.0"}
+  io.prometheus/simpleclient_hotspot {:mvn/version "0.16.0"}
+  io.prometheus/simpleclient_jetty
+  {:mvn/version "0.16.0"
+   :exclusions [org.eclipse.jetty/jetty-server
+                org.eclipse.jetty/jetty-servlet]}
 
-  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"}
+  io.prometheus/simpleclient_httpserver {:mvn/version "0.16.0"}
 
-  selmer/selmer {:mvn/version "1.12.33"}
-  expound/expound {:mvn/version "0.8.7"}
-  com.cognitect/transit-clj {:mvn/version "1.0.324"}
+  io.lettuce/lettuce-core {:mvn/version "6.2.1.RELEASE"}
+  java-http-clj/java-http-clj {:mvn/version "0.4.3"}
 
-  io.lettuce/lettuce-core {:mvn/version "6.0.2.RELEASE"}
-  java-http-clj/java-http-clj {:mvn/version "0.4.1"}
+  funcool/yetti
+  {:git/tag "v9.11"
+   :git/sha "6f9197a"
+   :git/url "https://github.com/funcool/yetti.git"
+   :exclusions [org.slf4j/slf4j-api]}
 
-  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"}
+  com.github.seancorfield/next.jdbc {:mvn/version "1.3.834"}
+  metosin/reitit-core {:mvn/version "0.5.18"}
+  org.postgresql/postgresql {:mvn/version "42.5.0"}
+  com.zaxxer/HikariCP {:mvn/version "5.0.1"}
 
-  org.postgresql/postgresql {:mvn/version "42.2.18"}
-  com.zaxxer/HikariCP {:mvn/version "3.4.5"}
+  io.whitfin/siphash {:mvn/version "2.0.0"}
 
-  funcool/datoteka {:mvn/version "1.2.0"}
-  funcool/promesa {:mvn/version "6.0.0"}
-  funcool/cuerdas {:mvn/version "2020.03.26-3"}
+  buddy/buddy-hashers {:mvn/version "1.8.158"}
+  buddy/buddy-sign {:mvn/version "3.4.333"}
 
-  buddy/buddy-core {:mvn/version "1.9.0"}
-  buddy/buddy-hashers {:mvn/version "1.7.0"}
-  buddy/buddy-sign {:mvn/version "3.3.0"}
+  com.github.ben-manes.caffeine/caffeine {:mvn/version "3.1.1"}
 
-  lambdaisland/uri {:mvn/version "1.4.54"
-                    :exclusions [org.clojure/data.json]}
+  org.jsoup/jsoup {:mvn/version "1.15.1"}
+  org.im4java/im4java
+  {:git/tag "1.4.0-penpot-2"
+   :git/sha "e2b3e16"
+   :git/url "https://github.com/penpot/im4java"}
 
-  frankiesardo/linked {:mvn/version "1.3.0"}
-  danlentz/clj-uuid {:mvn/version "0.1.9"}
-  org.jsoup/jsoup {:mvn/version "1.13.1"}
-  org.im4java/im4java {:mvn/version "1.4.0"}
-  org.lz4/lz4-java {:mvn/version "1.7.1"}
-  commons-io/commons-io {:mvn/version "2.8.0"}
-  org.apache.commons/commons-pool2 {:mvn/version "2.9.0"}
-  com.sun.mail/jakarta.mail {:mvn/version "2.0.0"}
+  org.lz4/lz4-java {:mvn/version "1.8.0"}
 
-  puppetlabs/clj-ldap {:mvn/version"0.3.0"}
+  org.clojars.pntblnk/clj-ldap {:mvn/version "0.0.17"}
   integrant/integrant {:mvn/version "0.8.0"}
 
-  software.amazon.awssdk/s3 {:mvn/version "2.15.73"}
+  dawran6/emoji {:mvn/version "0.1.5"}
+  markdown-clj/markdown-clj {:mvn/version "1.11.3"}
 
-  ;; exception printing
-  io.aviso/pretty {:mvn/version "0.1.37"}
-  environ/environ {:mvn/version "1.2.0"}}
- :paths ["src" "resources" "../common" "common"]
+  ;; Pretty Print specs
+  pretty-spec/pretty-spec {:mvn/version "0.1.4"}
+  software.amazon.awssdk/s3 {:mvn/version "2.17.278"}}
+
+ :paths ["src" "resources" "target/classes"]
  :aliases
  {:dev
   {:extra-deps
-   {com.bhauman/rebel-readline {:mvn/version "0.1.4"}
-    org.clojure/tools.namespace {:mvn/version "1.1.0"}
-    org.clojure/test.check {:mvn/version "1.1.0"}
+   {com.bhauman/rebel-readline {:mvn/version "RELEASE"}
+    org.clojure/tools.namespace {:mvn/version "RELEASE"}
+    clojure-humanize/clojure-humanize {:mvn/version "0.2.2"}
+    org.clojure/data.csv {:mvn/version "RELEASE"}
+    com.clojure-goes-fast/clj-async-profiler {:mvn/version "RELEASE"}
+    mockery/mockery {:mvn/version "RELEASE"}}
+   :extra-paths ["test" "dev"]}
 
-    fipp/fipp {:mvn/version "0.6.23"}
-    criterium/criterium {:mvn/version "0.4.6"}
-    mockery/mockery {:mvn/version "0.1.4"}}
-   :extra-paths ["tests" "dev"]}
+  :build
+  {:extra-deps {io.github.clojure/tools.build {:git/tag "v0.8.3" :git/sha "0d20256"}}
+   :ns-default build}
 
-  :fn-fixtures
-  {:exec-fn app.cli.fixtures/run
-   :args {}}
-
-  :tests
-  {:extra-deps {lambdaisland/kaocha {:mvn/version "1.0.732"}}
-   :main-opts ["-m" "kaocha.runner"]}
+  :test
+  {:extra-paths ["test"]
+   :extra-deps
+   {io.github.cognitect-labs/test-runner
+    {:git/tag "v0.5.1" :git/sha "dfb30dd"}}
+   :main-opts ["-m" "cognitect.test-runner"]
+   :exec-fn cognitect.test-runner.api/test}
 
   :outdated
-  {:extra-deps {antq/antq {:mvn/version "RELEASE"}}
+  {:extra-deps {com.github.liquidz/antq {:mvn/version "RELEASE"}}
    :main-opts ["-m" "antq.core"]}
 
   :jmx-remote

backend/dev/script-fix-sobjects.clj

@@ -0,0 +1,114 @@
+;; 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) KALEIDOS INC
+
+;; This is an example on how it can be executed:
+;; clojure -Scp $(cat classpath) -M dev/script-fix-sobjects.clj
+
+(require
+ '[app.common.logging :as l]
+ '[app.common.data :as d]
+ '[app.common.pprint]
+ '[app.db :as db]
+ '[app.storage :as sto]
+ '[app.storage.impl :as impl]
+ '[app.util.time :as dt]
+ '[integrant.core :as ig])
+
+;; --- HELPERS
+
+(l/info :hint "initializing script" :args *command-line-args*)
+
+(def noop? (some #(= % "noop") *command-line-args*))
+(def chunk-size 10)
+
+(def sql:retrieve-sobjects-chunk
+  "SELECT * FROM storage_object
+    WHERE created_at < ? AND deleted_at is NULL
+    ORDER BY created_at desc LIMIT ?")
+
+(defn get-chunk
+  [conn cursor]
+  (let [rows (db/exec! conn [sql:retrieve-sobjects-chunk cursor chunk-size])]
+    [(some->> rows peek :created-at) (seq rows)]))
+
+(defn get-candidates
+  [conn]
+  (->> (d/iteration (partial get-chunk conn)
+                    :vf second
+                    :kf first
+                    :initk (dt/now))
+       (sequence cat)))
+
+(def modules
+  [:app.db/pool
+   :app.storage/storage
+   [:app.main/default :app.worker/executor]
+   [:app.main/assets :app.storage.s3/backend]
+   [:app.main/assets :app.storage.fs/backend]])
+
+(def system
+  (let [config (select-keys app.main/system-config modules)
+        config (-> config
+                   (assoc :app.migrations/all {})
+                   (assoc :app.metrics/metrics nil))]
+    (ig/load-namespaces config)
+    (-> config ig/prep ig/init)))
+
+(defn update-fn
+  [{:keys [conn] :as storage} {:keys [id backend] :as row}]
+  (cond
+    (= backend "s3")
+    (do
+      (l/info :hint "rename storage object backend"
+              :id id
+              :from-backend backend
+              :to-backend :assets-s3)
+      (assoc row :backend "assets-s3"))
+
+    (= backend "assets-s3")
+    (do
+      (l/info :hint "ignoring storage object" :id id :backend backend)
+      nil)
+
+    (or (= backend "fs")
+        (= backend "assets-fs"))
+    (let [sobj (sto/row->storage-object row)
+          path (-> (sto/get-object-path storage sobj) deref)]
+      (l/info :hint "change storage object backend"
+              :id id
+              :from-backend backend
+              :to-backend :assets-s3)
+      (when-not noop?
+        (-> (impl/resolve-backend storage :assets-s3)
+            (impl/put-object sobj (sto/content path))
+            (deref)))
+      (assoc row :backend "assets-s3"))
+
+    :else
+    (throw (IllegalArgumentException. "unexpected backend found"))))
+
+(try
+  (db/with-atomic [conn (:app.db/pool system)]
+    (let [storage (:app.storage/storage system)
+          storage (assoc storage :conn conn)]
+      (loop [items (get-candidates conn)]
+        (when-let [item (first items)]
+          (when-let [{:keys [id] :as row} (update-fn storage item)]
+          (db/update! conn :storage-object (dissoc row :id) {:id (:id item)}))
+          (recur (rest items))))
+      (when noop?
+        (throw (ex-info "explicit rollback" {})))))
+
+  (catch Throwable cause
+    (cond
+      (= "explicit rollback" (ex-message cause))
+      (l/warn :hint "transaction aborted")
+
+      :else
+      (l/error :hint "unexpected exception" :cause cause))))
+
+(ig/halt! system)
+(System/exit 0)

backend/dev/user.clj

@@ -2,33 +2,45 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2016-2020 Andrey Antukh <niwi@niwi.nz>
+;; Copyright (c) KALEIDOS INC
 
 (ns user
   (:require
+   [app.common.data :as d]
    [app.common.exceptions :as ex]
+   [app.common.geom.matrix :as gmt]
+   [app.common.logging :as l]
+   [app.common.perf :as perf]
+   [app.common.pprint :as pp]
+   [app.common.spec :as us]
+   [app.common.transit :as t]
+   [app.common.uuid :as uuid]
    [app.config :as cfg]
    [app.main :as main]
-   [app.util.time :as dt]
-   [app.util.transit :as t]
+   [app.srepl.helpers]
+   [app.srepl.main :as srepl]
+   [app.util.blob :as blob]
+   [app.util.fressian :as fres]
    [app.util.json :as json]
+   [app.util.time :as dt]
+   [clj-async-profiler.core :as prof]
+   [clojure.contrib.humanize :as hum]
    [clojure.java.io :as io]
-   [clojure.pprint :refer [pprint]]
+   [clojure.pprint :refer [pprint print-table]]
    [clojure.repl :refer :all]
    [clojure.spec.alpha :as s]
-   [clojure.spec.gen.alpha :as sgen]
-   [clojure.test :as test]
+   [clojure.stacktrace :as trace]
    [clojure.test :as test]
+   [clojure.test.check.generators :as gen]
    [clojure.tools.namespace.repl :as repl]
    [clojure.walk :refer [macroexpand-all]]
-   [criterium.core :refer [quick-bench bench with-progress-reporting]]
-   [integrant.core :as ig]
-   [taoensso.nippy :as nippy]))
+   [criterium.core  :as crit]
+   [cuerdas.core :as str]
+   [datoteka.core]
+   [integrant.core :as ig]))
 
 (repl/disable-reload! (find-ns 'integrant.core))
+(set! *warn-on-reflection* true)
 
 (defonce system nil)
 
@@ -36,24 +48,24 @@
 
 (defmacro run-quick-bench
   [& exprs]
-  `(with-progress-reporting (quick-bench (do ~@exprs) :verbose)))
+  `(crit/with-progress-reporting (crit/quick-bench (do ~@exprs) :verbose)))
 
 (defmacro run-quick-bench'
   [& exprs]
-  `(quick-bench (do ~@exprs)))
+  `(crit/quick-bench (do ~@exprs)))
 
 (defmacro run-bench
   [& exprs]
-  `(with-progress-reporting (bench (do ~@exprs) :verbose)))
+  `(crit/with-progress-reporting (crit/bench (do ~@exprs) :verbose)))
 
 (defmacro run-bench'
   [& exprs]
-  `(bench (do ~@exprs)))
+  `(crit/bench (do ~@exprs)))
 
 ;; --- Development Stuff
 
 (defn- run-tests
-  ([] (run-tests #"^app.tests.*"))
+  ([] (run-tests #"^backend-tests.*-test$"))
   ([o]
    (repl/refresh)
    (cond
@@ -68,19 +80,22 @@
 
 (defn- start
   []
-  (alter-var-root #'system (fn [sys]
-                             (when sys (ig/halt! sys))
-                             (-> (main/build-system-config cfg/config)
-                                 (ig/prep)
-                                 (ig/init))))
-  :started)
+  (try
+    (alter-var-root #'system (fn [sys]
+                               (when sys (ig/halt! sys))
+                               (-> (merge main/system-config main/worker-config)
+                                   (ig/prep)
+                                   (ig/init))))
+    :started
+    (catch Throwable cause
+      (ex/print-throwable cause))))
 
 (defn- stop
   []
   (alter-var-root #'system (fn [sys]
                              (when sys (ig/halt! sys))
                              nil))
-  :stoped)
+  :stopped)
 
 (defn restart
   []
@@ -91,3 +106,27 @@
   []
   (stop)
   (repl/refresh-all :after 'user/start))
+
+(defn compression-bench
+  [data]
+  (let [humanize (fn [v] (hum/filesize v :binary true :format " %.4f "))
+        v1 (time (humanize (alength (blob/encode data {:version 1}))))
+        v3 (time (humanize (alength (blob/encode data {:version 3}))))
+        v4 (time (humanize (alength (blob/encode data {:version 4}))))
+        v5 (time (humanize (alength (blob/encode data {:version 5}))))
+        v6 (time (humanize (alength (blob/encode data {:version 6}))))
+        ]
+    (print-table
+     [{
+       :v1 v1
+       :v3 v3
+       :v4 v4
+       :v5 v5
+       :v6 v6
+       }])))
+
+(defonce debug-tap
+  (do
+    (add-tap #(locking debug-tap
+                (prn "tap debug:" %)))
+    1))

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

@@ -37,7 +37,7 @@
     <mj-section padding="24px 0 0 0">
       <mj-column width="425px">
         <mj-text align="center" font-size="14px" color="#64666A">
-          Penpot is the first Open Source prototyping platform that will be embraced by multidisciplinary teams.
+          Penpot is the first Open Source design and prototyping platform meant for cross-domain teams.
         </mj-text>
       </mj-column>
     </mj-section>

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

@@ -30,7 +30,7 @@
     <mj-section padding="24px 0 0 0">
       <mj-column width="425px">
         <mj-text align="center" font-size="14px" color="#64666A">
-          Penpot is the first Open Source prototyping platform that will be embraced by multidisciplinary teams.
+          Penpot is the first Open Source design and prototyping platform meant for cross-domain teams.
         </mj-text>
       </mj-column>
     </mj-section>

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

@@ -39,7 +39,7 @@
     <mj-section padding="24px 0 0 0">
       <mj-column width="425px">
         <mj-text align="center" font-size="14px" color="#64666A">
-          Penpot is the first Open Source prototyping platform that will be embraced by multidisciplinary teams.
+          Penpot is the first Open Source design and prototyping platform meant for cross-domain teams.
         </mj-text>
       </mj-column>
     </mj-section>

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

@@ -22,7 +22,7 @@
         <mj-text font-size="24px" font-weight="600">Hello {{name}}!</mj-text>
         <mj-text>
           Thanks for signing up for your Penpot account! Please verify your
-          email using the link below adn get started building mockups and
+          email using the link below and get started building mockups and
           prototypes today!
         </mj-text>
         <mj-button href="{{ public-uri }}/#/auth/verify-token?token={{token}}">
@@ -36,7 +36,7 @@
     <mj-section padding="24px 0 0 0">
       <mj-column width="425px">
         <mj-text align="center" font-size="14px" color="#64666A">
-          Penpot is the first Open Source prototyping platform that will be embraced by multidisciplinary teams.
+          Penpot is the first Open Source design and prototyping platform meant for cross-domain teams.
         </mj-text>
       </mj-column>
     </mj-section>

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

@@ -250,7 +250,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 is the first Open Source prototyping platform that will be embraced by multidisciplinary teams.</div>
+                      <div style="font-family:Source Sans Pro, sans-serif;font-size:14px;line-height:150%;text-align:center;color:#64666A;">Penpot is the first Open Source design and prototyping platform meant for cross-domain teams.</div>
                     </td>
                   </tr>
                 </table>
@@ -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 @ 2021 | 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 | Made with &lt;3 and Open Source</div>
                     </td>
                   </tr>
                 </table>

backend/resources/app/emails/feedback/en.html

@@ -0,0 +1,45 @@
+<!doctype html>
+<html xmlns="http://www.w3.org/1999/xhtml">
+  <head>
+    <title></title>
+    <meta http-equiv="X-UA-Compatible" content="IE=edge">
+    <meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
+  </head>
+  <body>
+    <p>
+      <strong>Feedback from:</strong><br />
+      {% if profile %}
+        <span>
+          <span>Name: </span>
+          <span><code>{{profile.fullname}}</code></span>
+        </span>
+        <br />
+
+        <span>
+          <span>Email: </span>
+          <span>{{profile.email}}</span>
+        </span>
+        <br />
+
+        <span>
+          <span>ID: </span>
+          <span><code>{{profile.id}}</code></span>
+        </span>
+      {% else %}
+        <span>
+          <span>Email: </span>
+          <span>{{profile.email}}</span>
+        </span>
+      {% endif %}
+    </p>
+    <p>
+      <strong>Subject:</strong><br />
+      <span>{{subject}}</span>
+    </p>
+
+    <p>
+      <strong>Message:</strong><br />
+      {{content|linebreaks-br|safe}}
+    </p>
+  </body>
+</html>

backend/resources/app/emails/feedback/en.subj

@@ -0,0 +1 @@
+[PENPOT FEEDBACK]: {{subject}}

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

@@ -240,7 +240,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 is the first Open Source prototyping platform that will be embraced by multidisciplinary teams.</div>
+                      <div style="font-family:Source Sans Pro, sans-serif;font-size:14px;line-height:150%;text-align:center;color:#64666A;">Penpot is the first Open Source design and prototyping platform meant for cross-domain teams.</div>
                     </td>
                   </tr>
                 </table>
@@ -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 @ 2021 | 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 | Made with &lt;3 and Open Source</div>
                     </td>
                   </tr>
                 </table>

backend/resources/app/emails/invite-to-team/en.subj

@@ -0,0 +1 @@
+Invitation to join {{team}}

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

@@ -245,7 +245,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 is the first Open Source prototyping platform that will be embraced by multidisciplinary teams.</div>
+                      <div style="font-family:Source Sans Pro, sans-serif;font-size:14px;line-height:150%;text-align:center;color:#64666A;">Penpot is the first Open Source design and prototyping platform meant for cross-domain teams.</div>
                     </td>
                   </tr>
                 </table>
@@ -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 @ 2021 | 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 | Made with &lt;3 and Open Source</div>
                     </td>
                   </tr>
                 </table>

backend/resources/app/emails/register/en.html

@@ -173,7 +173,7 @@
                   </tr>
                   <tr>
                     <td align="left" style="font-size:0px;padding:10px 25px;word-break:break-word;">
-                      <div style="font-family:Source Sans Pro, sans-serif;font-size:16px;line-height:150%;text-align:left;color:#000000;">Thanks for signing up for your Penpot account! Please verify your email using the link below adn get started building mockups and prototypes today!</div>
+                      <div style="font-family:Source Sans Pro, sans-serif;font-size:16px;line-height:150%;text-align:left;color:#000000;">Thanks for signing up for your Penpot account! Please verify your email using the link below and get started building mockups and prototypes today!</div>
                     </td>
                   </tr>
                   <tr>
@@ -240,7 +240,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 is the first Open Source prototyping platform that will be embraced by multidisciplinary teams.</div>
+                      <div style="font-family:Source Sans Pro, sans-serif;font-size:14px;line-height:150%;text-align:center;color:#64666A;">Penpot is the first Open Source design and prototyping platform meant for cross-domain teams.</div>
                     </td>
                   </tr>
                 </table>
@@ -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 @ 2021 | 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 | Made with &lt;3 and Open Source</div>
                     </td>
                   </tr>
                 </table>
@@ -465,4 +465,4 @@
   </div>
 </body>
 
-</html>
+</html>

backend/resources/app/emails/register/en.txt

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

backend/resources/app/onboarding.edn

@@ -0,0 +1,36 @@
+[{:id "tutorial-for-beginners"
+  :name "Tutorial for beginners"
+  :thumbnail-uri "https://penpot.app/images/libraries/tutorial-for-beginners.jpg"
+  :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/tutorial-for-beginners.penpot"}
+ {:id "penpot-design-system"
+  :name "Penpot Design System"
+  :thumbnail-uri "https://penpot.app/images/libraries/cover-ds-penpot.jpg"
+  :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/Penpot-Design-system.penpot"}
+ {:id "wireframing-kit"
+  :name "Wireframing Kit"
+  :thumbnail-uri "https://penpot.app/images/libraries/cover-wireframes.jpg"
+  :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/wireframing-kit.penpot"}
+ {:id "ant-design"
+  :name "Ant Design UI Kit (lite)"
+  :thumbnail-uri "https://penpot.app/images/libraries/cover-ant-design.jpg"
+  :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/Ant-Design-UI-Kit-Lite.penpot"}
+ {:id "cocomaterial"
+  :name "Cocomaterial"
+  :thumbnail-uri "https://penpot.app/images/libraries/cover-cocomaterial.jpg"
+  :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/Cocomaterial.penpot"}
+ {:id "circum-icons"
+  :name "Circum Icons pack"
+  :thumbnail-uri "https://penpot.app/images/libraries/cover-circum.jpg"
+  :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/CircumIcons.penpot"}
+ {:id "coreui"
+  :name "CoreUI"
+  :thumbnail-uri "https://penpot.app/images/libraries/cover-coreui.jpg"
+  :file-uri "https://github.com/penpot/penpot-files/raw/main/CoreUI%20DesignSystem%20(DEMO).penpot"}
+ {:id "whiteboarding-kit"
+  :name "Whiteboarding Kit"
+  :thumbnail-uri "https://penpot.app/images/libraries/cover-whiteboards.jpg"
+  :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/Whiteboarding-mapping-kit.penpot"}
+ {:id "material-design-baseline"
+  :name "Material Design (baseline)"
+  :thumbnail-uri "https://penpot.app/images/libraries/cover-material.jpg"
+  :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/Material-Design-Kit.penpot"}]

backend/resources/app/templates/api-doc-entry.tmpl

@@ -0,0 +1,54 @@
+<li class="rpc-item">
+  <div class="rpc-row-info">
+    {# <div class="type">{{item.type}}</div> #}
+    <div class="module">{{item.module}}:</div>
+    <div class="name">{{item.name}}</div>
+    <div class="tags">
+      {% if item.deprecated %}
+        <span class="tag">
+          <span>Deprecated:</span>
+          <span>since v{{item.deprecated}}</span>,
+        </span>
+      {% endif %}
+      <span class="tag">
+        <span>Auth:</span>
+        <span>{% if item.auth %}YES{% else %}NO{% endif %}</span>
+      </span>
+    </div>
+  </div>
+  <div class="rpc-row-detail hidden">
+    <h3>DOCSTRING:</h3>
+
+    <section class="padded-section">
+
+      {% if item.added %}
+        <p class="small"><strong>Added:</strong> on v{{item.added}}</p>
+      {% endif %}
+
+      {% if item.deprecated %}
+        <p class="small"><strong>Deprecated:</strong> since v{{item.deprecated}}</p>
+      {% endif %}
+
+      {% if item.docs %}
+        <p class="docstring"> {{item.docs}}</p>
+      {% endif %}
+    </section>
+
+    {% if item.changes %}
+      <h3>CHANGES:</h3>
+      <section class="padded-section">
+
+        <ul class="changes">
+          {% for change in item.changes %}
+            <li><strong>{{change.0}}</strong> - {{change.1}}</li>
+          {% endfor %}
+        </ul>
+      </section>
+    {% endif %}
+
+    <h3>SPEC EXPLAIN:</h3>
+    <section class="padded-section">
+      <pre class="spec-explain">{{item.spec}}</pre>
+    </section>
+  </div>
+</li>

backend/resources/app/templates/api-doc.css

@@ -0,0 +1,145 @@
+* {
+  font-family: "JetBrains Mono", monospace;
+  font-size: 12px;
+}
+
+pre {
+  margin: 0px;
+}
+
+body {
+  margin: 0px;
+  padding: 0px;
+  padding-top: 20px;
+  padding-bottom: 20px;
+  display: flex;
+  justify-content: center;
+}
+
+main {
+  display: flex;
+  flex-direction: column;
+  align-items: center;
+  min-width: 900px;
+  width: 900px;
+}
+
+header {
+  border-bottom: 1px solid #c0c0c0;
+  display: flex;
+  justify-content: center;
+  width: 100%;
+}
+
+.rpc-doc-content {
+  margin-top: 20px;
+  width: 100%;
+  display: flex;
+  flex-direction: column;
+  /* border: 1px solid red; */
+  padding: 5px;
+}
+
+.rpc-doc-content > h2:not(:first-child) {
+  margin-top: 30px;
+}
+
+
+.rpc-items {
+  list-style: none;
+  padding: 0px;
+  margin: 0px;
+}
+
+.rpc-item {
+  /* border: 1px solid red; */
+  /* cursor: pointer; */
+  display: flex;
+  flex-direction: column;
+}
+
+.rpc-item:not(:last-child) {
+  margin-bottom: 3px;
+}
+
+.rpc-row-info {
+  cursor: pointer;
+  display: flex;
+  background-color: #eeeeee;
+  padding: 5px 10px;
+}
+
+.rpc-row-info > *:not(:last-child) {
+  margin-right: 10px;
+}
+
+.rpc-row-info > * {
+  /* border: 1px solid green; */
+}
+
+.rpc-row-info > .type {
+  font-weight: bold;
+  width: 70px;
+}
+
+.rpc-row-info > .name {
+  width: 280px;
+  /* font-weight: bold; */
+  border-right: 1px dotted #777;
+  padding-right: 10px;
+}
+
+.rpc-row-info > .module {
+  width: 120px;
+  font-weight: bold;
+  border-right: 1px dotted #777;
+  text-align: right;
+  padding-right: 10px;
+}
+
+.rpc-row-info > .tags > .tag > span:first-child {
+  font-weight: bold;
+}
+
+.hidden {
+  display: none;
+}
+
+.rpc-row-detail {
+  padding: 5px 10px;
+  padding-bottom: 20px;
+}
+
+.rpc-row-detail p {
+  font-weight: 200;
+}
+
+.rpc-row-detail p.small {
+  margin-top: 2px;
+  margin-bottom: 2px;
+  font-size: 10px;
+}
+
+.rpc-row-detail p.small {
+  margin-top: 2px;
+  margin-bottom: 2px;
+  font-size: 10px;
+}
+
+.rpc-row-detail strong {
+  font-weight: 500;
+}
+
+.rpc-row-detail .changes {
+  font-weight: 200;
+  list-style: none;
+  padding: 0px;
+}
+
+.rpc-row-detail .padded-section {
+  padding: 0px 10px;
+}
+
+p.small strong {
+  font-size: 10px;
+}

backend/resources/app/templates/api-doc.js

@@ -0,0 +1,27 @@
+(function() {
+  document.addEventListener("DOMContentLoaded", function(event) {
+    const rows = document.querySelectorAll(".rpc-row-info");
+
+    const onRowClick = (event) => {
+      const target = event.currentTarget;
+      for (let node of rows) {
+        if (node !== target) {
+          node.nextElementSibling.classList.add("hidden");
+        } else {
+          const sibling = target.nextElementSibling;
+
+          if (sibling.classList.contains("hidden")) {
+            sibling.classList.remove("hidden");
+          } else {
+            sibling.classList.add("hidden");
+          }
+        }
+      }
+    };
+
+    for (let node of rows) {
+      node.addEventListener("click", onRowClick);
+    }
+
+  });
+})();

backend/resources/app/templates/api-doc.tmpl

@@ -0,0 +1,50 @@
+<!DOCTYPE html>
+<html>
+  <head>
+    <meta charset="utf-8" />
+    <meta name="robots" content="noindex,nofollow">
+    <meta http-equiv="x-ua-compatible" content="ie=edge" />
+    <title>Builtin API Documentation - Penpot</title>
+
+    <link rel="preconnect" href="https://fonts.googleapis.com">
+    <link rel="preconnect" href="https://fonts.gstatic.com" crossorigin>
+    <link href="https://fonts.googleapis.com/css2?family=JetBrains+Mono:wght@200;300;400;500;700&display=swap" rel="stylesheet">
+    <style>
+      {% include "app/templates/api-doc.css" %}
+    </style>
+    <script>
+      {% include "app/templates/api-doc.js" %}
+    </script>
+  </head>
+  <body>
+    <main>
+      <header>
+        <h1>Penpot API Documentation (v{{version}})</h1>
+      </header>
+      <section class="rpc-doc-content">
+
+        <h2>RPC COMMAND METHODS:</h2>
+        <ul class="rpc-items">
+          {% for item in command-methods %}
+            {% include "app/templates/api-doc-entry.tmpl" with item=item %}
+          {% endfor %}
+        </ul>
+
+        <h2>RPC QUERY METHODS:</h2>
+        <ul class="rpc-items">
+          {% for item in query-methods %}
+            {% include "app/templates/api-doc-entry.tmpl" with item=item %}
+          {% endfor %}
+        </ul>
+
+        <h2>RPC MUTATION METHODS:</h2>
+        <ul class="rpc-items">
+          {% for item in mutation-methods %}
+            {% include "app/templates/api-doc-entry.tmpl" with item=item %}
+          {% endfor %}
+        </ul>
+      </section>
+    </main>
+  </body>
+</html>
+

backend/resources/app/templates/base.tmpl

@@ -0,0 +1,18 @@
+<!DOCTYPE html>
+<html>
+  <head>
+    <meta charset="utf-8" />
+    <meta name="robots" content="noindex,nofollow">
+    <meta http-equiv="x-ua-compatible" content="ie=edge" />
+    <title>{% block title %}{% endblock %}</title>
+    <link rel="stylesheet" href="https://fonts.googleapis.com/css2?family=JetBrains+Mono">
+    <style>
+      {% include "app/templates/styles.css"  %}
+    </style>
+  </head>
+  <body>
+    {% block content %}
+    {% endblock %}
+  </body>
+</html>
+

backend/resources/app/templates/debug.tmpl

@@ -0,0 +1,127 @@
+{% extends "app/templates/base.tmpl" %}
+
+{% block title %}
+Debug Main Page
+{% endblock %}
+
+{% block content %}
+<nav>
+  <h1>Debug INDEX:</h1>
+  <div>[<a href="/dbg/error">ERRORS</a>]</div>
+</nav>
+<main class="index">
+  <section class="widget">
+    <fieldset>
+      <legend>Download file data:</legend>
+      <desc>Given an FILE-ID, downloads the file data as file. The file data is encoded using transit.</desc>
+      <form method="get" action="/dbg/file/data">
+        <div class="row">
+          <input type="text" style="width:300px" name="file-id" placeholder="file-id" />
+        </div>
+        <div class="row">
+          <input type="submit" name="download" value="Download" />
+          <input type="submit" name="clone" value="Clone" />
+        </div>
+      </form>
+    </fieldset>
+
+    <fieldset>
+      <legend>Upload File Data:</legend>
+      <desc>Create a new file on your draft projects using the file downloaded from the previous section.</desc>
+      <form method="post" enctype="multipart/form-data" action="/dbg/file/data">
+        <div class="row">
+          <input type="file" name="file" value="" />
+        </div>
+        <div class="row">
+          <label>Import with same id?</label>
+          <input type="checkbox" name="reuseid" />
+        </div>
+
+        <input type="submit" value="Upload" />
+      </form>
+    </fieldset>
+  </section>
+
+  <section class="widget">
+    <fieldset>
+      <legend>Export binfile:</legend>
+      <desc>Given an FILE-ID, downloads the file and optionally all
+      the related libraries in a single custom formatted binary
+      file.</desc>
+
+      <form method="get" action="/dbg/file/export">
+        <div class="row set-of-inputs">
+          <input type="text" style="width:300px" name="file-ids" placeholder="file-id" />
+          <input type="text" style="width:300px" name="file-ids" placeholder="file-id" />
+          <input type="text" style="width:300px" name="file-ids" placeholder="file-id" />
+          <input type="text" style="width:300px" name="file-ids" placeholder="file-id" />
+        </div>
+
+        <div class="row">
+          <label>Include libraries?</label>
+          <input type="checkbox" name="includelibs" />
+        </div>
+
+        <div class="row">
+          <label>Embed assets?</label>
+          <input type="checkbox" name="embedassets" checked/>
+        </div>
+
+        <div class="row">
+          <input type="submit" name="download" value="Download" />
+          <input type="submit" name="clone" value="Clone" />
+        </div>
+      </form>
+    </fieldset>
+    <fieldset>
+      <legend>Import binfile:</legend>
+      <desc>Import penpot file in binary
+      format. If <strong>overwrite</strong> is checked, all files will
+      be overwritten using the same ids found in the file instead of
+      generating a new ones.</desc>
+
+      <form method="post" enctype="multipart/form-data" action="/dbg/file/import">
+        <div class="row">
+          <input type="file" name="file" value="" />
+        </div>
+
+        <div class="row">
+          <label>Overwrite?</label>
+          <input type="checkbox" name="overwrite" />
+          <br />
+          <small>
+            Instead of creating a new file with all relations remapped,
+            reuses all ids and updates/overwrites the objects that are
+            already exists on the database.
+            <strong>Warning, this operation should be used with caution.</strong>
+          </small>
+        </div>
+
+        <div class="row">
+          <label>Migrate?</label>
+          <input type="checkbox" name="migrate" />
+          <br />
+          <small>
+            Applies the file migrations on the importation process.
+          </small>
+        </div>
+
+        <div class="row">
+          <label>Ignore index errors?</label>
+          <input type="checkbox" name="ignore-index-errors" checked/>
+          <br />
+          <small>
+            Do not break on index lookup errors (remap operation).
+            Useful when importing a broken file that has broken
+            relations or missing pieces.
+          </small>
+        </div>
+
+        <div class="row">
+          <input type="submit" name="upload" value="Upload" />
+        </div>
+      </form>
+    </fieldset>
+  </section>
+</main>
+{% endblock %}

backend/resources/app/templates/error-list.tmpl

@@ -0,0 +1,19 @@
+{% extends "app/templates/base.tmpl" %}
+
+{% block title %}
+penpot - error list
+{% endblock %}
+
+{% block content %}
+<nav>
+  <h1>Latest error reports:</h1>
+</nav>
+<main class="horizontal-list">
+  <ul>
+    {% for item in items %}
+    <li><a class="date" href="/dbg/error/{{item.id}}">{{item.created-at}}</a> 
+        <span class="title">{{item.hint|abbreviate:150}}</span></li>
+    {% endfor %}
+  </ul>
+</main>
+{% endblock %}

backend/resources/app/templates/error-report.tmpl

@@ -0,0 +1,98 @@
+{% extends "app/templates/base.tmpl" %}
+
+{% block title %}
+penpot - error report {{id}}
+{% endblock %}
+
+{% block content %}
+<nav>
+  <div>[<a href="/dbg/error">⮜</a>]</div>
+  <div>[<a href="#context">context</a>]</div>
+  <div>[<a href="#params">request params</a>]</div>
+  {% if data %}
+  <div>[<a href="#edata">error data</a>]</div>
+  {% endif %}
+  {% if spec-explain %}
+  <div>[<a href="#spec-explain">spec explain</a>]</div>
+  {% endif %}
+  {% if spec-problems %}
+  <div>[<a href="#spec-problems">spec problems</a>]</div>
+  {% endif %}
+  {% if spec-value %}
+  <div>[<a href="#spec-value">spec value</a>]</div>
+  {% endif %}
+
+  {% if trace %}
+  <div>[<a href="#trace">error trace</a>]</div>
+  {% endif %}
+</nav>
+<main>
+  <div class="table">
+    <div class="table-row multiline">
+      <div id="context" class="table-key">CONTEXT: </div>
+
+      <div class="table-val">
+        <h1>{{hint}}</h1>
+      </div>
+
+      <div class="table-val">
+        <pre>{{context}}</pre>
+      </div>
+    </div>
+
+    {% if params %}
+    <div class="table-row multiline">
+      <div id="params" class="table-key">REQUEST PARAMS: </div>
+      <div class="table-val">
+        <pre>{{params}}</pre>
+      </div>
+    </div>
+    {% endif %}
+
+    {% if data %}
+    <div class="table-row multiline">
+      <div id="edata" class="table-key">ERROR DATA: </div>
+      <div class="table-val">
+        <pre>{{data}}</pre>
+      </div>
+    </div>
+    {% endif %}
+
+    {% if spec-explain %}
+    <div class="table-row multiline">
+      <div id="spec-explain" class="table-key">SPEC EXPLAIN: </div>
+      <div class="table-val">
+        <pre>{{spec-explain}}</pre>
+      </div>
+    </div>
+    {% endif %}
+
+    {% if spec-problems %}
+    <div class="table-row multiline">
+      <div id="spec-problems" class="table-key">SPEC PROBLEMS: </div>
+      <div class="table-val">
+        <pre>{{spec-problems}}</pre>
+      </div>
+    </div>
+    {% endif %}
+
+    {% if spec-value %}
+    <div class="table-row multiline">
+      <div id="spec-value" class="table-key">SPEC VALUE: </div>
+      <div class="table-val">
+        <pre>{{spec-value}}</pre>
+      </div>
+    </div>
+    {% endif %}
+
+    {% if trace %}
+    <div class="table-row multiline">
+      <div id="trace" class="table-key">TRACE:</div>
+      <div class="table-val">
+        <pre>{{trace}}</pre>
+      </div>
+    </div>
+    {% endif %}
+  </div>
+</main>
+{% endblock %}

backend/resources/app/templates/styles.css

@@ -0,0 +1,189 @@
+* {
+  font-family: "JetBrains Mono", monospace;
+  font-size: 12px;
+}
+
+body {
+  margin: 0px;
+  padding: 0px;
+}
+
+pre {
+  margin: 0px;
+  line-height: 16px;
+}
+
+desc {
+  margin-bottom: 10px;
+  font-size: 10px;
+  color: #666;
+}
+
+input[type=text], input[type=submit] {
+  padding: 3px;
+}
+
+main {
+  margin: 20px;
+}
+
+small {
+  font-size: 9px;
+  color: #888;
+}
+
+small > strong {
+  font-size: 9px;
+}
+
+nav {
+  position: fixed;
+  width: 100vw;
+  top: 0;
+  left: 0;
+  padding: 5px 20px;
+  display: flex;
+  background: #e3e3e3;
+}
+
+nav > h1 {
+  padding: 0px;
+  margin: 0px;
+  font-size: 11px;
+}
+
+nav > div {
+  text-transform: uppercase;
+  font-weight: bold;
+}
+
+nav > div:not(:last-child) {
+  margin-right: 10px;
+}
+
+.table {
+  margin-top: 25px;
+  display: flex;
+  flex-direction: column;
+}
+
+.table-row {
+  display: flex;
+  padding-bottom: 15px;
+  /* width: 100%; */
+  /* border: 1px solid red; */
+}
+
+.table-key {
+  font-weight: 600;
+  width: 60px;
+  padding: 4px;
+
+  padding-top: 40px;
+  margin-top: -40px;
+}
+
+.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;
+}
+
+.index {
+  margin-top: 40px;
+  display: flex;
+}
+
+.index > section {
+  padding: 10px;
+  background-color: #e3e3e3;
+  max-width: 400px;
+  margin: 5px;
+  height: fit-content;
+}
+
+.index fieldset:not(:first-child) {
+  margin-top: 15px;
+}
+
+/* .index > section:not(:last-child) { */
+/*   margin-bottom: 10px; */
+/* } */
+
+
+.index > section > h2 {
+  margin-top: 0px;
+}
+
+.horizontal-list {
+  margin: 20px;
+  margin-top: 40px;
+}
+
+.horizontal-list ul {
+  display: flex;
+  margin: 0px;
+  padding: 0px;
+  flex-direction: column;
+  justify-content: flex-start;
+}
+
+.horizontal-list li {
+  list-style: none;
+  padding: 0px;
+  margin: 0px;
+  line-height: 18px;
+  min-width: 210px;
+  margin: 0px 20px;
+  cursor: pointer;
+  display: flex;
+  border-radius: 3px;
+}
+
+
+
+.horizontal-list li:hover {
+  background-color: #e9e9e9;
+}
+
+.horizontal-list li > *:not(:last-child) {
+  margin-right: 10px;
+}
+
+.horizontal-list li > a {
+  text-decoration: none;
+  color: inherit;
+}
+
+.horizontal-list li > .date {
+  font-weight: 200;
+  color: #686868;
+  min-width: 210px;
+}
+
+
+form .row {
+  padding: 5px 0;
+}
+
+.set-of-inputs {
+  flex-direction: column;
+  display: flex;
+}
+
+.set-of-inputs input:not(:last-child) {
+  margin-bottom: 3px;
+}
+

backend/resources/builtin.edn

@@ -1,11 +0,0 @@
-{:icons
- [{:name "Material Design (Action)"
-   :path "./material/action/svg/production"
-   :regex #"^.*_48px\.svg$"}]
-
- :images
- [{:name "Generic Collection 1"
-   :path "./my-images/collection1/"
-   :regex #"^.*\.(png|jpg|webp)$"}]}
-
-

backend/resources/climit.edn

@@ -0,0 +1,9 @@
+;; Example climit.edn file
+;; Required: concurrency
+;; Optional: queue-size, ommited means Integer/MAX_VALUE
+{:update-file   {:concurrency 1 :queue-size 3}
+ :auth          {:concurrency 128}
+ :process-font  {:concurrency 4 :queue-size 32}
+ :process-image {:concurrency 8 :queue-size 32}
+ :push-audit-events
+ {:concurrency 1 :queue-size 3}}

backend/resources/config/default.edn

@@ -1,44 +0,0 @@
-{;; A secret key used for create tokens
- ;; WARNING: this is a default secret key and
- ;; it should be overwritten in production env.
- :secret "5qjiAn-QUpawUNqGP10UZKklSqbLKcdGY3sJpq0UUACpVXGg2HOFJCBejDWVHskhRyp7iHb4rjOLXX2ZjF-5cw"
- 
- :registration
- {
-  :enabled true}
- 
- :smtp
- {:host "localhost" ;; Hostname of the desired SMTP server.
-  :port 25          ;; Port of SMTP server.
-  :user nil         ;; Username to authenticate with (if authenticating).
-  :pass nil         ;; Password to authenticate with (if authenticating).
-  :ssl false        ;; Enables SSL encryption if value is truthy.
-  :tls false        ;; Enables TLS encryption if value is truthy.
-  :enabled false    ;; Enables SMTP if value is truthy.
-  :noop true}
-
- :auth-options {:alg :a256kw :enc :a128cbc-hs256}
-
- :email {:reply-to "no-reply@uxbox.io"
-         :from "no-reply@uxbox.io"
-         :support "support@uxbox.io"}
-
- :http {:port 6060
-        :max-body-size 52428800
-        :debug true}
-
- :media
- {:directory "resources/public/media"
-  :uri "http://localhost:6060/media/"}
-
- :static
- {:directory "resources/public/static"
-  :uri "http://localhost:6060/static/"}
-
- :database
- {:adapter "postgresql"
-  :username nil
-  :password nil
-  :database-name "uxbox"
-  :server-name "localhost"
-  :port-number 5432}}

backend/resources/config/test.edn

@@ -1,18 +0,0 @@
-{:migrations
- {:verbose false}
-
- :media
- {:directory "/tmp/uxbox/media"
-  :uri "http://localhost:6060/media/"}
-
- :static
- {:directory "/tmp/uxbox/static"
-  :uri "http://localhost:6060/static/"}
-
- :database
- {:adapter "postgresql"
-  :username nil
-  :password nil
-  :database-name "test"
-  :server-name "localhost"
-  :port-number 5432}}

backend/resources/emails/feedback/en.subj

@@ -1 +0,0 @@
-[PENPOT FEEDBACK]: {{subject|abbreviate:19}} (from {{email}})

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

@@ -1 +0,0 @@
-Inviation to join {{team}}

backend/resources/error-report.tmpl

@@ -1,194 +0,0 @@
-<!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

@@ -1,21 +0,0 @@
-<?xml version="1.0" encoding="UTF-8"?>
-<Configuration status="info" monitorInterval="60">
-  <Appenders>
-    <Console name="console" target="SYSTEM_OUT">
-      <PatternLayout pattern="[%t] %level{length=1} %logger{36} - %msg%n"/>
-    </Console>
-  </Appenders>
-
-  <Loggers>
-    <Logger name="com.zaxxer.hikari" level="error" />
-    <Logger name="org.eclipse.jetty" level="error" />
-
-    <Logger name="app" level="debug" additivity="false">
-      <AppenderRef ref="console" />
-    </Logger>
-
-    <Root level="info">
-      <AppenderRef ref="console" />
-    </Root>
-  </Loggers>
-</Configuration>

backend/resources/log4j2-devenv.xml

@@ -0,0 +1,61 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<Configuration status="info" monitorInterval="30">
+  <Appenders>
+    <Console name="console" target="SYSTEM_OUT">
+      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"
+                     alwaysWriteExceptions="false" />
+    </Console>
+
+    <RollingFile name="main" fileName="logs/main.log" filePattern="logs/main-%i.log">
+      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"
+                     alwaysWriteExceptions="false" />
+      <Policies>
+        <SizeBasedTriggeringPolicy size="50M"/>
+      </Policies>
+      <DefaultRolloverStrategy max="9"/>
+    </RollingFile>
+
+    <JeroMQ name="zmq">
+      <Property name="endpoint">tcp://localhost:45556</Property>
+      <JsonLayout complete="false" compact="true" includeTimeMillis="true" stacktraceAsString="true" properties="true" />
+    </JeroMQ>
+  </Appenders>
+
+  <Loggers>
+    <Logger name="io.lettuce" level="error" />
+    <Logger name="com.zaxxer.hikari" level="error"/>
+    <Logger name="org.postgresql" level="error" />
+
+    <Logger name="app.rpc.commands.binfile" level="debug" />
+    <Logger name="app.storage.tmp" level="debug" />
+    <Logger name="app.worker" level="info" />
+    <Logger name="app.msgbus" level="info" />
+    <Logger name="app.http.websocket" level="info" />
+    <Logger name="app.util.websocket" level="info" />
+    <Logger name="app.redis" level="info" />
+    <Logger name="app.rpc.rlimit" level="info" />
+    <Logger name="app.rpc.climit" level="info" />
+    <Logger name="app.rpc.mutations.files" level="info" />
+
+    <Logger name="app.cli" level="debug" additivity="false">
+      <AppenderRef ref="console"/>
+    </Logger>
+
+    <Logger name="app.loggers" level="debug" additivity="false">
+      <AppenderRef ref="main" level="debug" />
+    </Logger>
+
+    <Logger name="app" level="all" additivity="false">
+      <AppenderRef ref="main" level="trace" />
+      <AppenderRef ref="zmq" level="debug" />
+    </Logger>
+
+    <Logger name="user" level="trace" additivity="false">
+      <AppenderRef ref="main" level="trace" />
+    </Logger>
+
+    <Root level="info">
+      <AppenderRef ref="main" />
+    </Root>
+  </Loggers>
+</Configuration>

backend/resources/log4j2.xml

@@ -1,49 +1,23 @@
 <?xml version="1.0" encoding="UTF-8"?>
-<Configuration status="info" monitorInterval="30">
+<Configuration status="info" monitorInterval="60">
   <Appenders>
     <Console name="console" target="SYSTEM_OUT">
-      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] [%t] %level{length=1} %logger{36} - %msg%n"/>
+      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"
+                     alwaysWriteExceptions="false" />
     </Console>
-
-    <RollingFile name="main" fileName="logs/main.log" filePattern="logs/main-%i.log">
-      <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] [%t] %level{length=1} %logger{36} - %msg%n"/>
-      <Policies>
-        <SizeBasedTriggeringPolicy size="50M"/>
-      </Policies>
-      <DefaultRolloverStrategy max="9"/>
-    </RollingFile>
-
-    <JeroMQ name="zmq">
-      <Property name="endpoint">tcp://localhost:45556</Property>
-      <JsonLayout complete="false" compact="true" includeTimeMillis="true" stacktraceAsString="true" properties="true" />
-    </JeroMQ>
   </Appenders>
 
   <Loggers>
-    <Logger name="com.zaxxer.hikari" level="error"/>
     <Logger name="io.lettuce" level="error" />
-    <Logger name="org.eclipse.jetty" level="error" />
+    <Logger name="com.zaxxer.hikari" level="error" />
+    <Logger name="org.postgresql" level="error" />
 
-    <Logger name="app.cli" level="debug" additivity="false">
-      <AppenderRef ref="console"/>
-    </Logger>
-
-    <Logger name="app.loggers" level="debug" additivity="false">
-      <AppenderRef ref="main" level="debug" />
-    </Logger>
-
-    <Logger name="app" level="debug" additivity="false">
-      <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 name="app" level="info" additivity="false">
+      <AppenderRef ref="console" />
     </Logger>
 
     <Root level="info">
-      <AppenderRef ref="main" />
+      <AppenderRef ref="console" />
     </Root>
   </Loggers>
 </Configuration>

backend/resources/rlimit.edn

@@ -0,0 +1,10 @@
+;; Example rlimit.edn file
+^{:refresh "30s"}
+{:default
+ [[:default :window "200000/h"]]
+
+ #{:query/teams}
+ [[:burst :bucket "5/1/5s"]]
+
+ #{:query/profile}
+ [[:burst :bucket "100/60/1m"]]}

backend/scripts/build

@@ -0,0 +1,22 @@
+#!/usr/bin/env bash
+
+CURRENT_VERSION=$1;
+
+set -ex
+
+rm -rf target;
+mkdir -p target/classes;
+mkdir -p target/dist;
+echo "$CURRENT_VERSION" > target/classes/version.txt;
+cp ../CHANGES.md target/classes/changelog.md;
+
+clojure -T:build jar;
+mv target/penpot.jar target/dist/penpot.jar
+cp scripts/run.template.sh target/dist/run.sh;
+cp scripts/manage.template.sh target/dist/manage.sh;
+chmod +x target/dist/run.sh;
+chmod +x target/dist/manage.sh;
+
+# Prefetch
+bb ./scripts/prefetch-templates.clj resources/app/onboarding.edn builtin-templates/
+cp -r builtin-templates target/dist/

backend/scripts/build.sh

@@ -1,77 +0,0 @@
-#!/usr/bin/env bash
-
-CLASSPATH=`(clojure -Spath)`
-NEWCP="./main:./common"
-
-rm -rf ./target/dist
-mkdir -p ./target/dist/deps
-
-for item in $(echo $CLASSPATH | tr ":" "\n"); do
-    if [ "${item: -4}" == ".jar" ]; then
-        cp $item ./target/dist/deps/;
-        BN="$(basename -- $item)"
-        NEWCP+=":./deps/$BN"
-    fi
-done
-
-cp ./resources/log4j2-bundle.xml ./target/dist/log4j2.xml
-cp -r ./src ./target/dist/main
-cp -r ./resources/emails ./target/dist/main/
-cp -r ./resources/svgclean.js ./target/dist/main/
-cp -r ./resources/error-report.tmpl ./target/dist/main/
-cp -r ../common ./target/dist/common
-
-echo $NEWCP > ./target/dist/classpath;
-
-tee -a ./target/dist/run.sh  >> /dev/null <<EOF
-#!/usr/bin/env bash
-CP="$NEWCP"
-
-set +e
-JAVA_CMD=\$(type -p java)
-
-set -e
-if [[ ! -n "\$JAVA_CMD" ]]; then
-  if [[ -n "\$JAVA_HOME" ]] && [[ -x "\$JAVA_HOME/bin/java" ]]; then
-    JAVA_CMD="\$JAVA_HOME/bin/java"
-  else
-    >&2 echo "Couldn't find 'java'. Please set JAVA_HOME."
-    exit 1
-  fi
-fi
-
-if [ -f ./environ ]; then
-   source ./environ
-fi
-
-set -x
-exec \$JAVA_CMD \$JVM_OPTS -classpath \$CP -Dlog4j.configurationFile=./log4j2.xml "\$@" clojure.main -m app.main
-EOF
-
-tee -a ./target/dist/manage.sh  >> /dev/null <<EOF
-#!/usr/bin/env bash
-CP="$NEWCP"
-
-set +e
-JAVA_CMD=\$(type -p java)
-
-set -e
-if [[ ! -n "\$JAVA_CMD" ]]; then
-  if [[ -n "\$JAVA_HOME" ]] && [[ -x "\$JAVA_HOME/bin/java" ]]; then
-    JAVA_CMD="\$JAVA_HOME/bin/java"
-  else
-    >&2 echo "Couldn't find 'java'. Please set JAVA_HOME."
-    exit 1
-  fi
-fi
-
-if [ -f ./environ ]; then
-   source ./environ
-fi
-
-exec \$JAVA_CMD \$JVM_OPTS -classpath \$CP -Dlog4j.configurationFile=./log4j2.xml clojure.main -m app.cli.manage "\$@"
-EOF
-
-chmod +x ./target/dist/run.sh
-chmod +x ./target/dist/manage.sh
-

backend/scripts/import-generic-collections.sh

@@ -1,4 +0,0 @@
-#!/usr/bin/env bash
-
-clojure -Adev -m app.cli.collimp $@
-

backend/scripts/kill-repl.sh

@@ -0,0 +1,4 @@
+#!/usr/bin/env bash
+set -x
+
+jcmd |grep "rebel" |sed -nE 's/^([0-9]+).*$/\1/p' | xargs kill -9

backend/scripts/manage.template.sh

@@ -0,0 +1,19 @@
+#!/usr/bin/env bash
+set +e
+JAVA_CMD=$(type -p java)
+
+set -e
+if [[ ! -n "$JAVA_CMD" ]]; then
+  if [[ -n "$JAVA_HOME" ]] && [[ -x "$JAVA_HOME/bin/java" ]]; then
+    JAVA_CMD="$JAVA_HOME/bin/java"
+  else
+    >&2 echo "Couldn't find 'java'. Please set JAVA_HOME."
+    exit 1
+  fi
+fi
+
+if [ -f ./environ ]; then
+   source ./environ
+fi
+
+exec $JAVA_CMD $JVM_OPTS -jar penpot.jar -m app.cli.manage "$@"

backend/scripts/prefetch-templates.clj

@@ -0,0 +1,40 @@
+#!/usr/bin/env bb
+
+(require '[babashka.curl :as curl]
+         '[babashka.fs :as fs])
+
+(defn download-if-needed!
+  [dest data]
+  (doseq [{:keys [id file-uri] :as item} data]
+    (let [file (fs/file dest id)
+          rsp  (curl/get file-uri {:as :stream})]
+
+      (when (not= 200 (:status rsp))
+        (println (format "unable to download %s (uri: %s)" id file-uri))
+        (System/exit -1))
+
+      (when-not (fs/exists? (str file))
+        (println (format "=> downloading %s" id))
+        (with-open [output (io/output-stream file)]
+          (io/copy (:body rsp) output))))))
+
+(defn read-defs-file
+  [path]
+  (with-open [content (io/reader path)]
+    (edn/read-string (slurp content))))
+
+(let [[path dest] *command-line-args*]
+  (when (or (nil? path)
+            (nil? dest))
+    (println "invalid arguments")
+    (System/exit -1))
+
+  (when-not (fs/exists? path)
+    (println (format "file %s does not exists" path))
+    (System/exit -1))
+
+  (when-not (fs/exists? dest)
+    (fs/create-dirs dest))
+
+  (let [data (read-defs-file path)]
+    (download-if-needed! dest data)))

backend/scripts/prepare-release.sh

@@ -1,16 +0,0 @@
-#!/usr/bin/env bash
-
-if [ "$#" -e 0 ]; then
-    echo "Expecting parameters: 1=path to backend; 2=destination directory"
-    exit 1
-fi
-
-rm -rf $2 || exit 1;
-
-rsync -avr \
-      --exclude="/test" \
-      --exclude="/resources/public/media" \
-      --exclude="/target" \
-      --exclude="/scripts" \
-      --exclude="/.*" \
-      $1 $2;

backend/scripts/psql.sh

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

backend/scripts/repl

@@ -1,8 +1,47 @@
 #!/usr/bin/env bash
 
-export PENPOT_ASSERTS_ENABLED=true
+export PENPOT_HOST=devenv
+export PENPOT_TENANT=dev
+export PENPOT_FLAGS="$PENPOT_FLAGS enable-backend-asserts enable-audit-log enable-transit-readable-response enable-demo-users disable-secure-session-cookies enable-smtp"
+
+# export PENPOT_DATABASE_URI="postgresql://172.17.0.1:5432/penpot"
+# export PENPOT_DATABASE_USERNAME="penpot"
+# export PENPOT_DATABASE_PASSWORD="penpot"
+# export PENPOT_DATABASE_READONLY=true
+
+# export PENPOT_DATABASE_URI="postgresql://172.17.0.1:5432/penpot_pre"
+# export PENPOT_DATABASE_USERNAME="penpot_pre"
+# export PENPOT_DATABASE_PASSWORD="penpot_pre"
+
+# export PENPOT_LOGGERS_LOKI_URI="http://172.17.0.1:3100/loki/api/v1/push"
+# export PENPOT_AUDIT_LOG_ARCHIVE_URI="http://localhost:6070/api/audit"
+
+# Initialize MINIO config
+mc alias set penpot-s3/ http://minio:9000 minioadmin minioadmin
+mc admin user add penpot-s3 penpot-devenv penpot-devenv
+mc admin policy set penpot-s3 readwrite user=penpot-devenv
+mc mb penpot-s3/penpot -p
+
+export AWS_ACCESS_KEY_ID=penpot-devenv
+export AWS_SECRET_ACCESS_KEY=penpot-devenv
+export PENPOT_ASSETS_STORAGE_BACKEND=assets-s3
+export PENPOT_STORAGE_ASSETS_S3_ENDPOINT=http://minio:9000
+export PENPOT_STORAGE_ASSETS_S3_BUCKET=penpot
+
+export OPTIONS="
+       -A:jmx-remote -A:dev \
+       -J-Djava.util.logging.manager=org.apache.logging.log4j.jul.LogManager \
+       -J-Dlog4j2.configurationFile=log4j2-devenv.xml \
+       -J-XX:+UseG1GC \
+       -J-XX:-OmitStackTraceInFastThrow \
+       -J-Xms50m -J-Xmx1024m \
+       -J-Djdk.attach.allowAttachSelf \
+       -J-XX:+UnlockDiagnosticVMOptions \
+       -J-XX:+DebugNonSafepoints";
+
+# Uncomment for use the ImageMagick v7.x
+# export OPTIONS="-J-Dim4java.useV7=true $OPTIONS";
 
-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)"
 

backend/scripts/run-tests-in-docker.sh

@@ -1,4 +0,0 @@
-#!/usr/bin/env bash
-
-set -xe
-clojure -Adev -m app.tests.main;

backend/scripts/run.template.sh

@@ -0,0 +1,22 @@
+#!/usr/bin/env bash
+
+if [[ ! -n "$JAVA_CMD" ]]; then
+    if [[ -n "$JAVA_HOME" ]] && [[ -x "$JAVA_HOME/bin/java" ]]; then
+        JAVA_CMD="$JAVA_HOME/bin/java"
+    else
+        set +e
+        JAVA_CMD=$(type -p java)
+        set -e
+        if [[ ! -n "$JAVA_CMD" ]]; then
+            >&2 echo "Couldn't find 'java'. Please set JAVA_HOME."
+            exit 1
+        fi
+    fi
+fi
+
+if [ -f ./environ ]; then
+    source ./environ
+fi
+
+set -x
+exec $JAVA_CMD $JVM_OPTS "$@" -jar penpot.jar -m app.main

backend/scripts/smtpd.sh

@@ -1,2 +0,0 @@
-#!/usr/bin/env bash
-python -m smtpd -n -c DebuggingServer localhost:25

backend/scripts/start-dev

@@ -1,15 +1,25 @@
-#!/bin/sh
+#!/usr/bin/env bash
 
-export PENPOT_ASSERTS_ENABLED=true
+export PENPOT_HOST=devenv
+export PENPOT_TENANT=dev
+export PENPOT_FLAGS="$PENPOT_FLAGS enable-backend-asserts enable-audit-log enable-transit-readable-response enable-demo-users disable-secure-session-cookies enable-smtp"
 
 set -ex
 
-if [ ! -e ~/.fixtures-loaded ]; then
-    echo "Loading fixtures..."
-    clojure -Adev -X:fn-fixtures
-    touch ~/.fixtures-loaded
+if [ "$1" = "--watch" ]; then
+    echo "Start Watch..."
+
+    clojure -A:dev -M -m app.main &
+    PID=$!
+
+    npx nodemon \
+        --watch src \
+        --watch ../common \
+        --ext "clj" \
+        --signal SIGKILL \
+        --exec 'echo "(user/restart)" | nc -N localhost 6062'
+
+    kill -9 $PID
+else
+    clojure -A:dev -M -m app.main
 fi
-
-clojure -A:dev -M -m app.main
-
-

backend/scripts/tests.sh

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

backend/src/app/auth/ldap.clj

@@ -0,0 +1,137 @@
+;; 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) KALEIDOS INC
+
+(ns app.auth.ldap
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.logging :as l]
+   [app.common.spec :as us]
+   [app.config :as cf]
+   [clj-ldap.client :as ldap]
+   [clojure.spec.alpha :as s]
+   [clojure.string]
+   [integrant.core :as ig]))
+
+(defn- prepare-params
+  [cfg]
+  {:ssl?      (:ssl cfg)
+   :startTLS? (:tls cfg)
+   :bind-dn   (:bind-dn cfg)
+   :password  (:bind-password cfg)
+   :host      {:address (:host cfg)
+               :port    (:port cfg)}})
+
+(defn- connect
+  "Connects to the LDAP provider and returns a connection. An
+  exception is raised if no connection is possible."
+  ^java.lang.AutoCloseable
+  [cfg]
+  (try
+    (-> cfg prepare-params ldap/connect)
+    (catch Throwable cause
+      (ex/raise :type :restriction
+                :code :unable-to-connect-to-ldap
+                :hint "unable to connect to ldap server"
+                :cause cause))))
+
+(defn- replace-several [s & {:as replacements}]
+  (reduce-kv clojure.string/replace s replacements))
+
+(defn- search-user
+  [{:keys [conn attrs base-dn] :as cfg} email]
+  (let [query   (replace-several (:query cfg) ":username" email)
+        params  {:filter query
+                 :sizelimit 1
+                 :attributes attrs}]
+    (first (ldap/search conn base-dn params))))
+
+(defn- retrieve-user
+  [{:keys [conn] :as cfg} {:keys [email password]}]
+  (when-let [{:keys [dn] :as user} (search-user cfg email)]
+    (when (ldap/bind? conn dn password)
+      {:fullname (get user (-> cfg :attrs-fullname keyword))
+       :email    email
+       :backend  "ldap"})))
+
+(s/def ::fullname ::us/not-empty-string)
+(s/def ::email ::us/email)
+(s/def ::backend ::us/not-empty-string)
+
+(s/def ::info-data
+  (s/keys :req-un [::fullname ::email ::backend]))
+
+(defn authenticate
+  [cfg params]
+  (with-open [conn (connect cfg)]
+    (when-let [user (-> (assoc cfg :conn conn)
+                        (retrieve-user params))]
+      (when-not (s/valid? ::info-data user)
+        (let [explain (s/explain-str ::info-data user)]
+          (l/warn ::l/raw (str "invalid response from ldap, looks like ldap is not configured correctly\n" explain))
+          (ex/raise :type :restriction
+                    :code :wrong-ldap-response
+                    :explain explain)))
+      user)))
+
+(defn- try-connectivity
+  [cfg]
+  ;; If we have ldap parameters, try to establish connection
+  (when (and (:bind-dn cfg)
+             (:bind-password cfg)
+             (:host cfg)
+             (:port cfg))
+    (try
+      (with-open [_ (connect cfg)]
+        (l/info :hint "provider initialized"
+                :provider "ldap"
+                :host (:host cfg)
+                :port (:port cfg)
+                :tls? (:tls cfg)
+                :ssl? (:ssl cfg)
+                :bind-dn (:bind-dn cfg)
+                :base-dn (:base-dn cfg)
+                :query (:query cfg))
+        cfg)
+      (catch Throwable cause
+        (l/error :hint "unable to connect to LDAP server (LDAP auth provider disabled)"
+                 :host (:host cfg) :port (:port cfg) :cause cause)
+        nil))))
+
+(defn- prepare-attributes
+  [cfg]
+  (assoc cfg :attrs [(:attrs-username cfg)
+                     (:attrs-email cfg)
+                     (:attrs-fullname cfg)]))
+
+(defmethod ig/init-key ::provider
+  [_ cfg]
+  (when (:enabled? cfg)
+    (some-> cfg try-connectivity prepare-attributes)))
+
+(s/def ::enabled? ::us/boolean)
+(s/def ::host ::cf/ldap-host)
+(s/def ::port ::cf/ldap-port)
+(s/def ::ssl ::cf/ldap-ssl)
+(s/def ::tls ::cf/ldap-starttls)
+(s/def ::query ::cf/ldap-user-query)
+(s/def ::base-dn ::cf/ldap-base-dn)
+(s/def ::bind-dn ::cf/ldap-bind-dn)
+(s/def ::bind-password ::cf/ldap-bind-password)
+(s/def ::attrs-email ::cf/ldap-attrs-email)
+(s/def ::attrs-fullname ::cf/ldap-attrs-fullname)
+(s/def ::attrs-username ::cf/ldap-attrs-username)
+
+(defmethod ig/pre-init-spec ::provider
+  [_]
+  (s/keys :opt-un [::host ::port
+                   ::ssl ::tls
+                   ::enabled?
+                   ::bind-dn
+                   ::bind-password
+                   ::query
+                   ::attrs-email
+                   ::attrs-username
+                   ::attrs-fullname]))

backend/src/app/auth/oidc.clj

@@ -0,0 +1,551 @@
+;; 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) KALEIDOS INC
+
+(ns app.auth.oidc
+  "OIDC client implementation."
+  (:require
+   [app.auth.oidc.providers :as-alias providers]
+   [app.common.data :as d]
+   [app.common.data.macros :as dm]
+   [app.common.exceptions :as ex]
+   [app.common.logging :as l]
+   [app.common.spec :as us]
+   [app.common.uri :as u]
+   [app.config :as cf]
+   [app.db :as db]
+   [app.http.client :as http]
+   [app.http.middleware :as hmw]
+   [app.http.session :as session]
+   [app.loggers.audit :as audit]
+   [app.main :as-alias main]
+   [app.rpc.queries.profile :as profile]
+   [app.tokens :as tokens]
+   [app.util.json :as json]
+   [app.util.time :as dt]
+   [app.worker :as wrk]
+   [clojure.set :as set]
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [integrant.core :as ig]
+   [promesa.core :as p]
+   [promesa.exec :as px]
+   [yetti.response :as yrs]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; HELPERS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- obfuscate-string
+  [s]
+  (if (< (count s) 10)
+    (apply str (take (count s) (repeat "*")))
+    (str (subs s 0 5)
+         (apply str (take (- (count s) 5) (repeat "*"))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; OIDC PROVIDER (GENERIC)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- discover-oidc-config
+  [cfg {:keys [::base-uri] :as opts}]
+  (let [discovery-uri (u/join base-uri ".well-known/openid-configuration")
+        response      (ex/try! (http/req! cfg
+                                          {:method :get :uri (str discovery-uri)}
+                                          {:sync? true}))]
+    (cond
+      (ex/exception? response)
+      (do
+        (l/warn :hint "unable to discover oidc configuration"
+                :discover-uri (str discovery-uri)
+                :cause response)
+        nil)
+
+      (= 200 (:status response))
+      (let [data (json/decode (:body response))]
+        {:token-uri (get data :token_endpoint)
+         :auth-uri  (get data :authorization_endpoint)
+         :user-uri  (get data :userinfo_endpoint)})
+
+      :else
+      (do
+        (l/warn :hint "unable to discover OIDC configuration"
+                :uri (str discovery-uri)
+                :response-status-code (:status response))
+        nil))))
+
+(defn- prepare-oidc-opts
+  [cfg]
+  (let [opts {:base-uri      (cf/get :oidc-base-uri)
+              :client-id     (cf/get :oidc-client-id)
+              :client-secret (cf/get :oidc-client-secret)
+              :token-uri     (cf/get :oidc-token-uri)
+              :auth-uri      (cf/get :oidc-auth-uri)
+              :user-uri      (cf/get :oidc-user-uri)
+              :scopes        (cf/get :oidc-scopes #{"openid" "profile" "email"})
+              :roles-attr    (cf/get :oidc-roles-attr)
+              :roles         (cf/get :oidc-roles)
+              :name          "oidc"}
+
+        opts (d/without-nils opts)]
+
+    (when (and (string? (:base-uri opts))
+               (string? (:client-id opts))
+               (string? (:client-secret opts)))
+      (if (and (string? (:token-uri opts))
+               (string? (:user-uri opts))
+               (string? (:auth-uri opts)))
+        opts
+        (some-> (discover-oidc-config cfg opts)
+                (merge opts {:discover? true}))))))
+
+(defmethod ig/pre-init-spec ::providers/generic [_]
+  (s/keys :req [::http/client]))
+
+(defmethod ig/init-key ::providers/generic
+  [_ cfg]
+  (when (contains? cf/flags :login-with-oidc)
+    (if-let [opts (prepare-oidc-opts cfg)]
+      (do
+        (l/info :hint "provider initialized"
+                :provider :oidc
+                :method (if (:discover? opts) "discover" "manual")
+                :client-id (:client-id opts)
+                :client-secret (obfuscate-string (:client-secret opts))
+                :scopes     (str/join "," (:scopes opts))
+                :auth-uri   (:auth-uri opts)
+                :user-uri   (:user-uri opts)
+                :token-uri  (:token-uri opts)
+                :roles-attr (:roles-attr opts)
+                :roles      (:roles opts))
+        opts)
+      (do
+        (l/warn :hint "unable to initialize auth provider, missing configuration" :provider :oidc)
+        nil))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; GOOGLE AUTH PROVIDER
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmethod ig/init-key ::providers/google
+  [_ _]
+  (let [opts {:client-id     (cf/get :google-client-id)
+              :client-secret (cf/get :google-client-secret)
+              :scopes        #{"openid" "email" "profile"}
+              :auth-uri      "https://accounts.google.com/o/oauth2/v2/auth"
+              :token-uri     "https://oauth2.googleapis.com/token"
+              :user-uri      "https://openidconnect.googleapis.com/v1/userinfo"
+              :name          "google"}]
+
+    (when (contains? cf/flags :login-with-google)
+      (if (and (string? (:client-id opts))
+               (string? (:client-secret opts)))
+        (do
+          (l/info :hint "provider initialized"
+                  :provider :google
+                  :client-id (:client-id opts)
+                  :client-secret (obfuscate-string (:client-secret opts)))
+          opts)
+
+        (do
+          (l/warn :hint "unable to initialize auth provider, missing configuration" :provider :google)
+          nil)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; GITHUB AUTH PROVIDER
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- retrieve-github-email
+  [cfg tdata info]
+  (or (some-> info :email p/resolved)
+      (->> (http/req! cfg
+                      {:uri "https://api.github.com/user/emails"
+                       :headers {"Authorization" (dm/str (:type tdata) " " (:token tdata))}
+                       :timeout 6000
+                       :method :get})
+           (p/map (fn [{:keys [status body] :as response}]
+                    (when-not (s/int-in-range? 200 300 status)
+                      (ex/raise :type :internal
+                                :code :unable-to-retrieve-github-emails
+                                :hint "unable to retrieve github emails"
+                                :http-status status
+                                :http-body body))
+                    (->> response :body json/decode (filter :primary) first :email))))))
+
+(defmethod ig/pre-init-spec ::providers/github [_]
+  (s/keys :req [::http/client]))
+
+(defmethod ig/init-key ::providers/github
+  [_ cfg]
+  (let [opts {:client-id     (cf/get :github-client-id)
+              :client-secret (cf/get :github-client-secret)
+              :scopes        #{"read:user" "user:email"}
+              :auth-uri      "https://github.com/login/oauth/authorize"
+              :token-uri     "https://github.com/login/oauth/access_token"
+              :user-uri      "https://api.github.com/user"
+              :name          "github"
+
+              ;; Additional hooks for provider specific way of
+              ;; retrieve emails.
+              :get-email-fn           (partial retrieve-github-email cfg)}]
+
+    (when (contains? cf/flags :login-with-github)
+      (if (and (string? (:client-id opts))
+               (string? (:client-secret opts)))
+        (do
+          (l/info :hint "provider initialized"
+                  :provider :github
+                  :client-id (:client-id opts)
+                  :client-secret (obfuscate-string (:client-secret opts)))
+          opts)
+
+        (do
+          (l/warn :hint "unable to initialize auth provider, missing configuration" :provider :github)
+          nil)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; GITLAB AUTH PROVIDER
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmethod ig/init-key ::providers/gitlab
+  [_ _]
+  (let [base (cf/get :gitlab-base-uri "https://gitlab.com")
+        opts {:base-uri      base
+              :client-id     (cf/get :gitlab-client-id)
+              :client-secret (cf/get :gitlab-client-secret)
+              :scopes        #{"openid" "profile" "email"}
+              :auth-uri      (str base "/oauth/authorize")
+              :token-uri     (str base "/oauth/token")
+              :user-uri      (str base "/oauth/userinfo")
+              :name          "gitlab"}]
+    (when (contains? cf/flags :login-with-gitlab)
+      (if (and (string? (:client-id opts))
+               (string? (:client-secret opts)))
+        (do
+          (l/info :hint "provider initialized"
+                  :provider :gitlab
+                  :base-uri base
+                  :client-id (:client-id opts)
+                  :client-secret (obfuscate-string (:client-secret opts)))
+          opts)
+
+        (do
+          (l/warn :hint "unable to initialize auth provider, missing configuration" :provider :gitlab)
+          nil)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; HANDLERS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- build-redirect-uri
+  [{:keys [provider] :as cfg}]
+  (let [public (u/uri (cf/get :public-uri))]
+    (str (assoc public :path (str "/api/auth/oauth/" (:name provider) "/callback")))))
+
+(defn- build-auth-uri
+  [{:keys [provider] :as cfg} state]
+  (let [params {:client_id (:client-id provider)
+                :redirect_uri (build-redirect-uri cfg)
+                :response_type "code"
+                :state state
+                :scope (str/join " " (:scopes provider []))}
+        query  (u/map->query-string params)]
+    (-> (u/uri (:auth-uri provider))
+        (assoc :query query)
+        (str))))
+
+(defn- qualify-props
+  [provider props]
+  (reduce-kv (fn [result k v]
+               (assoc result (keyword (:name provider) (name k)) v))
+             {}
+             props))
+
+(defn retrieve-access-token
+  [{:keys [provider] :as cfg} code]
+  (let [params {:client_id (:client-id provider)
+                :client_secret (:client-secret provider)
+                :code code
+                :grant_type "authorization_code"
+                :redirect_uri (build-redirect-uri cfg)}
+        req    {:method :post
+                :headers {"content-type" "application/x-www-form-urlencoded"
+                          "accept" "application/json"}
+                :uri (:token-uri provider)
+                :body (u/map->query-string params)}]
+    (->> (http/req! cfg req)
+         (p/map (fn [{:keys [status body] :as res}]
+                  (if (= status 200)
+                    (let [data (json/decode body)]
+                      {:token (get data :access_token)
+                       :type (get data :token_type)})
+                    (ex/raise :type :internal
+                              :code :unable-to-retrieve-token
+                              :http-status status
+                              :http-body body)))))))
+
+(defn- retrieve-user-info
+  [{:keys [provider] :as cfg} tdata]
+  (letfn [(retrieve []
+            (http/req! cfg
+                       {:uri (:user-uri provider)
+                        :headers {"Authorization" (str (:type tdata) " " (:token tdata))}
+                        :timeout 6000
+                        :method :get}))
+          (validate-response [response]
+            (when-not (s/int-in-range? 200 300 (:status response))
+              (ex/raise :type :internal
+                        :code :unable-to-retrieve-user-info
+                        :hint "unable to retrieve user info"
+                        :http-status (:status response)
+                        :http-body (:body response)))
+            response)
+
+          (get-email [info]
+            ;; Allow providers hook into this for custom email
+            ;; retrieval method.
+            (if-let [get-email-fn (:get-email-fn provider)]
+              (get-email-fn tdata info)
+              (let [attr-kw (cf/get :oidc-email-attr :email)]
+                (get info attr-kw))))
+
+          (get-name [info]
+            (let [attr-kw (cf/get :oidc-name-attr :name)]
+              (get info attr-kw)))
+
+          (process-response [response]
+            (p/let [info  (-> response :body json/decode)
+                    email (get-email info)]
+              {:backend  (:name provider)
+               :email    email
+               :fullname (or (get-name info) email)
+               :props    (->> (dissoc info :name :email)
+                              (qualify-props provider))}))
+
+          (validate-info [info]
+            (when-not (s/valid? ::info info)
+              (l/warn :hint "received incomplete profile info object (please set correct scopes)"
+                      :info (pr-str info))
+              (ex/raise :type :internal
+                        :code :incomplete-user-info
+                        :hint "inconmplete user info"
+                        :info info))
+            info)]
+
+    (-> (retrieve)
+        (p/then validate-response)
+        (p/then process-response)
+        (p/then validate-info))))
+
+(s/def ::backend ::us/not-empty-string)
+(s/def ::email ::us/not-empty-string)
+(s/def ::fullname ::us/not-empty-string)
+(s/def ::props (s/map-of ::us/keyword any?))
+(s/def ::info
+  (s/keys :req-un [::backend
+                   ::email
+                   ::fullname
+                   ::props]))
+
+(defn retrieve-info
+  [{:keys [provider] :as cfg} {:keys [params] :as request}]
+  (letfn [(validate-oidc [info]
+            ;; If the provider is OIDC, we can proceed to check
+            ;; roles if they are defined.
+            (when (and (= "oidc" (:name provider))
+                       (seq (:roles provider)))
+              (let [provider-roles (into #{} (:roles provider))
+                    profile-roles  (let [attr  (cf/get :oidc-roles-attr :roles)
+                                         roles (get info attr)]
+                                     (cond
+                                       (string? roles) (into #{} (str/words roles))
+                                       (vector? roles) (into #{} roles)
+                                       :else #{}))]
+
+                ;; check if profile has a configured set of roles
+                (when-not (set/subset? provider-roles profile-roles)
+                  (ex/raise :type :internal
+                            :code :unable-to-auth
+                            :hint "not enough permissions"))))
+            info)
+
+          (post-process [state info]
+            (cond-> info
+              (some? (:invitation-token state))
+              (assoc :invitation-token (:invitation-token state))
+
+              ;; If state token comes with props, merge them. The state token
+              ;; props can contain pm_ and utm_ prefixed query params.
+              (map? (:props state))
+              (update :props merge (:props state))))]
+
+    (when-let [error (get params :error)]
+      (ex/raise :type :internal
+                :code :error-on-retrieving-code
+                :error-id error
+                :error-desc (get params :error_description)))
+
+    (let [state  (get params :state)
+          code   (get params :code)
+          state  (tokens/verify (::main/props cfg) {:token state :iss :oauth})]
+      (-> (p/resolved code)
+          (p/then #(retrieve-access-token cfg %))
+          (p/then #(retrieve-user-info cfg %))
+          (p/then' validate-oidc)
+          (p/then' (partial post-process state))))))
+
+(defn- retrieve-profile
+  [{:keys [::db/pool ::wrk/executor] :as cfg} info]
+  (px/with-dispatch executor
+    (with-open [conn (db/open pool)]
+      (some->> (:email info)
+               (profile/retrieve-profile-data-by-email conn)
+               (profile/populate-additional-data conn)
+               (profile/decode-profile-row)))))
+
+(defn- redirect-response
+  [uri]
+  (yrs/response :status 302 :headers {"location" (str uri)}))
+
+(defn- generate-error-redirect
+  [_ error]
+  (let [uri (-> (u/uri (cf/get :public-uri))
+                (assoc :path "/#/auth/login")
+                (assoc :query (u/map->query-string {:error "unable-to-auth" :hint (ex-message error)})))]
+    (redirect-response uri)))
+
+(defn- generate-redirect
+  [{:keys [::session/session] :as cfg} request info profile]
+  (if profile
+    (let [sxf    (session/create-fn session (:id profile))
+          token  (or (:invitation-token info)
+                     (tokens/generate (::main/props cfg)
+                                      {:iss :auth
+                                       :exp (dt/in-future "15m")
+                                       :profile-id (:id profile)}))
+          params {:token token}
+          uri    (-> (u/uri (cf/get :public-uri))
+                     (assoc :path "/#/auth/verify-token")
+                     (assoc :query (u/map->query-string params)))]
+
+      (when (:is-blocked profile)
+        (ex/raise :type :restriction
+                  :code :profile-blocked))
+
+      (when-let [collector (::audit/collector cfg)]
+        (audit/submit! collector {:type "command"
+                                  :name "login"
+                                  :profile-id (:id profile)
+                                  :ip-addr (audit/parse-client-ip request)
+                                  :props (audit/profile->props profile)}))
+
+      (->> (redirect-response uri)
+           (sxf request)))
+
+    (let [info   (assoc info
+                        :iss :prepared-register
+                        :is-active true
+                        :exp (dt/in-future {:hours 48}))
+          token  (tokens/generate (::main/props cfg) info)
+          params (d/without-nils
+                  {:token token
+                   :fullname (:fullname info)})
+          uri    (-> (u/uri (cf/get :public-uri))
+                     (assoc :path "/#/auth/register/validate")
+                     (assoc :query (u/map->query-string params)))]
+      (redirect-response uri))))
+
+(defn- auth-handler
+  [cfg {:keys [params] :as request}]
+  (let [props (audit/extract-utm-params params)
+        state (tokens/generate (::main/props cfg)
+                               {:iss :oauth
+                                :invitation-token (:invitation-token params)
+                                :props props
+                                :exp (dt/in-future "4h")})
+        uri   (build-auth-uri cfg state)]
+    (yrs/response 200 {:redirect-uri uri})))
+
+(defn- callback-handler
+  [cfg request]
+  (letfn [(process-request []
+            (p/let [info    (retrieve-info cfg request)
+                    profile (retrieve-profile cfg info)]
+              (generate-redirect cfg request info profile)))
+
+          (handle-error [cause]
+            (l/error :hint "error on oauth process" :cause cause)
+            (generate-error-redirect cfg cause))]
+
+    (-> (process-request)
+        (p/catch handle-error))))
+
+(def provider-lookup
+  {:compile
+   (fn [& _]
+     (fn [handler]
+       (fn [{:keys [::providers] :as cfg} request]
+         (let [provider (some-> request :path-params :provider keyword)]
+           (if-let [provider (get providers provider)]
+             (handler (assoc cfg :provider provider) request)
+             (ex/raise :type :restriction
+                       :code :provider-not-configured
+                       :provider provider
+                       :hint "provider not configured"))))))})
+
+
+(s/def ::client-id ::cf/oidc-client-id)
+(s/def ::client-secret ::cf/oidc-client-secret)
+(s/def ::base-uri ::cf/oidc-base-uri)
+(s/def ::token-uri ::cf/oidc-token-uri)
+(s/def ::auth-uri ::cf/oidc-auth-uri)
+(s/def ::user-uri ::cf/oidc-user-uri)
+(s/def ::scopes ::cf/oidc-scopes)
+(s/def ::roles ::cf/oidc-roles)
+(s/def ::roles-attr ::cf/oidc-roles-attr)
+(s/def ::email-attr ::cf/oidc-email-attr)
+(s/def ::name-attr ::cf/oidc-name-attr)
+
+;; FIXME: migrate to qualified-keywords
+(s/def ::provider
+  (s/keys :req-un [::client-id
+                   ::client-secret]
+          :opt-un [::base-uri
+                   ::token-uri
+                   ::auth-uri
+                   ::user-uri
+                   ::scopes
+                   ::roles
+                   ::roles-attr
+                   ::email-attr
+                   ::name-attr]))
+
+(s/def ::providers (s/map-of ::us/keyword (s/nilable ::provider)))
+
+(defmethod ig/pre-init-spec ::routes
+  [_]
+  (s/keys :req [::http/client
+                ::wrk/executor
+                ::main/props
+                ::db/pool
+                ::providers
+                ::session/session]))
+
+(defmethod ig/init-key ::routes
+  [_ {:keys [::wrk/executor ::session/session] :as cfg}]
+  (let [cfg (update cfg :provider d/without-nils)]
+    ["" {:middleware [[(:middleware session)]
+                      [hmw/with-dispatch executor]
+                      [hmw/with-config cfg]
+                      [provider-lookup]
+                      ]}
+     ["/auth/oauth"
+      ["/:provider"
+       {:handler auth-handler
+        :allowed-methods #{:post}}]
+      ["/:provider/callback"
+       {:handler callback-handler
+        :allowed-methods #{:get}}]]]))
+

backend/src/app/cli/fixtures.clj

@@ -1,242 +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.fixtures
-  "A initial fixtures."
-  (:require
-   [app.common.pages :as cp]
-   [app.common.uuid :as uuid]
-   [app.config :as cfg]
-   [app.db :as db]
-   [app.main :as main]
-   [app.rpc.mutations.profile :as profile]
-   [app.util.blob :as blob]
-   [buddy.hashers :as hashers]
-   [clojure.tools.logging :as log]
-   [integrant.core :as ig]))
-
-(defn- mk-uuid
-  [prefix & args]
-  (uuid/namespaced uuid/zero (apply str prefix (interpose "-" args))))
-
-;; --- Profiles creation
-
-(def password (hashers/derive "123123"))
-
-(def preset-small
-  {:num-teams 5
-   :num-profiles 5
-   :num-profiles-per-team 5
-   :num-projects-per-team 5
-   :num-files-per-project 5
-   :num-draft-files-per-profile 10})
-
-(defn- rng-ids
-  [rng n max]
-  (let [stream (->> (.longs rng 0 max)
-                    (.iterator)
-                    (iterator-seq))]
-    (reduce (fn [acc item]
-              (if (= (count acc) n)
-                (reduced acc)
-                (conj acc item)))
-            #{}
-            stream)))
-
-(defn- rng-vec
-  [rng vdata n]
-  (let [ids (rng-ids rng n (count vdata))]
-    (mapv #(nth vdata %) ids)))
-
-(defn- rng-nth
-  [rng vdata]
-  (let [stream (->> (.longs rng 0 (count vdata))
-                    (.iterator)
-                    (iterator-seq))]
-    (nth vdata (first stream))))
-
-(defn- collect
-  [f items]
-  (reduce #(conj %1 (f %2)) [] items))
-
-(defn- register-profile
-  [conn params]
-  (->> (#'profile/create-profile conn params)
-       (#'profile/create-profile-relations conn)))
-
-(defn impl-run
-  [pool opts]
-  (let [rng (java.util.Random. 1)]
-    (letfn [(create-profile [conn index]
-              (let [id   (mk-uuid "profile" index)
-                    _    (log/info "create profile" index id)
-
-                    prof (register-profile conn
-                                           {:id id
-                                            :fullname (str "Profile " index)
-                                            :password "123123"
-                                            :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)
-                                           (range (:num-projects-per-team opts)))]
-                  (run! (partial create-files conn owner-id) project-ids))
-                prof))
-
-            (create-profiles [conn]
-              (log/info "create profiles")
-              (collect (partial create-profile conn)
-                       (range (:num-profiles opts))))
-
-            (create-team [conn index]
-              (let [id (mk-uuid "team" index)
-                    name (str "Team" index)]
-                (log/info "create team" index id)
-                (db/insert! conn :team {:id id
-                                        :name name})
-                id))
-
-            (create-teams [conn]
-              (log/info "create teams")
-              (collect (partial create-team conn)
-                       (range (:num-teams opts))))
-
-            (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 id)]
-                (log/info "create file" index id)
-                (db/insert! conn :file
-                            {:id id
-                             :data (blob/encode data)
-                             :project-id project-id
-                             :name name})
-                (db/insert! conn :file-profile-rel
-                            {:file-id id
-                             :profile-id owner-id
-                             :is-owner true
-                             :is-admin true
-                             :can-edit true})
-                id))
-
-            (create-files [conn owner-id project-id]
-              (log/info "create files")
-              (run! (partial create-file conn owner-id project-id)
-                    (range (:num-files-per-project opts))))
-
-            (create-project [conn team-id owner-id index]
-              (let [id (mk-uuid "project" team-id index)
-                    name (str "project " index)]
-                (log/info "create project" index id)
-                (db/insert! conn :project
-                            {:id id
-                             :team-id team-id
-                             :name name})
-                (db/insert! conn :project-profile-rel
-                            {:project-id id
-                             :profile-id owner-id
-                             :is-owner true
-                             :is-admin true
-                             :can-edit true})
-                id))
-
-            (create-projects [conn team-id profile-ids]
-              (log/info "create projects")
-              (let [owner-id (rng-nth rng profile-ids)
-                    project-ids (collect (partial create-project conn team-id owner-id)
-                                         (range (:num-projects-per-team opts)))]
-                (run! (partial create-files conn owner-id) project-ids)))
-
-            (assign-profile-to-team [conn team-id owner? profile-id]
-              (db/insert! conn :team-profile-rel
-                          {:team-id team-id
-                           :profile-id profile-id
-                           :is-owner owner?
-                           :is-admin true
-                           :can-edit true}))
-
-            (setup-team [conn team-id profile-ids]
-              (log/info "setup team" team-id profile-ids)
-              (assign-profile-to-team conn team-id true (first profile-ids))
-              (run! (partial assign-profile-to-team conn team-id false)
-                    (rest profile-ids))
-              (create-projects conn team-id profile-ids))
-
-            (assign-teams-and-profiles [conn teams profiles]
-              (log/info "assign teams and profiles")
-              (loop [team-id (first teams)
-                     teams (rest teams)]
-                (when-not (nil? team-id)
-                  (let [n-profiles-team (:num-profiles-per-team opts)
-                        selected-profiles (rng-vec rng profiles n-profiles-team)]
-                    (setup-team conn team-id selected-profiles)
-                    (recur (first teams)
-                           (rest teams))))))
-
-            (create-draft-file [conn owner index]
-              (let [owner-id   (:id owner)
-                    id         (mk-uuid "file" "draft" owner-id index)
-                    name       (str "file" index)
-                    project-id (:default-project-id owner)
-                    data       (cp/make-file-data id)]
-
-                (log/info "create draft file" index id)
-                (db/insert! conn :file
-                            {:id id
-                             :data (blob/encode data)
-                             :project-id project-id
-                             :name name})
-                (db/insert! conn :file-profile-rel
-                            {:file-id id
-                             :profile-id owner-id
-                             :is-owner true
-                             :is-admin true
-                             :can-edit true})
-                id))
-
-            (create-draft-files [conn profile]
-              (run! (partial create-draft-file conn profile)
-                    (range (:num-draft-files-per-profile opts))))
-            ]
-      (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-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 pool preset)))
-
-(defn run
-  [{: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

@@ -2,22 +2,19 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2021 UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.cli.manage
   "A manage cli api."
   (:require
-   [app.config :as cfg]
+   [app.common.logging :as l]
    [app.db :as db]
    [app.main :as main]
+   [app.rpc.commands.auth :as cmd.auth]
    [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))
@@ -26,7 +23,7 @@
 
 (defn init-system
   []
-  (let [data (-> (main/build-system-config cfg/config)
+  (let [data (-> main/system-config
                  (select-keys [:app.db/pool :app.metrics/metrics])
                  (assoc :app.migrations/all {}))]
     (-> data ig/prep ig/init)))
@@ -35,7 +32,7 @@
   [{:keys [label type] :or {type :text}}]
   (let [^Console console (System/console)]
     (when-not console
-      (log/error "no console found, can proceed")
+      (l/error :hint "no console found, can proceed")
       (System/exit 1))
 
     (binding [*out* (.writer console)]
@@ -58,13 +55,13 @@
                                          :type :password}))]
     (try
       (db/with-atomic [conn (:app.db/pool system)]
-        (->> (profile/create-profile conn
+        (->> (cmd.auth/create-profile conn
                                      {:fullname fullname
                                       :email email
                                       :password password
                                       :is-active true
                                       :is-demo false})
-             (profile/create-profile-relations conn)))
+             (cmd.auth/create-profile-relations conn)))
 
       (when (pos? (:verbosity options))
         (println "User created successfully."))
@@ -114,7 +111,7 @@
     :id :verbosity
     :default 1
     :update-fn inc]
-   ["-q" nil "Dont' print to console"
+   ["-q" nil "Don't print to console"
     :id :verbosity
     :update-fn (constantly 0)]
    ["-h" "--help"]])
@@ -144,7 +141,6 @@
   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}

backend/src/app/cli/migrate_media.clj

@@ -1,132 +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.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

@@ -2,58 +2,75 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020-2021 UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.config
   "A configuration management."
   (:refer-clojure :exclude [get])
   (:require
+   [app.common.data :as d]
+   [app.common.exceptions :as ex]
+   [app.common.flags :as flags]
    [app.common.spec :as us]
    [app.common.version :as v]
    [app.util.time :as dt]
    [clojure.core :as c]
+   [clojure.java.io :as io]
+   [clojure.pprint :as pprint]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
-   [environ.core :refer [env]]))
+   [datoteka.fs :as fs]
+   [environ.core :refer [env]]
+   [integrant.core :as ig]))
+
+(prefer-method print-method
+               clojure.lang.IRecord
+               clojure.lang.IDeref)
+
+(prefer-method print-method
+               clojure.lang.IPersistentMap
+               clojure.lang.IDeref)
+
+(prefer-method pprint/simple-dispatch
+               clojure.lang.IPersistentMap
+               clojure.lang.IDeref)
+
+(defmethod ig/init-key :default
+  [_ data]
+  (d/without-nils data))
+
+(defmethod ig/prep-key :default
+  [_ data]
+  (if (map? data)
+    (d/without-nils data)
+    data))
 
 (def defaults
-  {:http-server-port 6060
-   :host "devenv"
-   :tenant "dev"
-   :database-uri "postgresql://127.0.0.1/penpot"
+  {:database-uri "postgresql://postgres/penpot"
    :database-username "penpot"
    :database-password "penpot"
 
-   :default-blob-version 1
-
+   :default-blob-version 5
    :loggers-zmq-uri "tcp://localhost:45556"
 
-   :asserts-enabled false
+   :rpc-rlimit-config (fs/path "resources/rlimit.edn")
+   :rpc-climit-config (fs/path "resources/climit.edn")
+
+   :file-change-snapshot-every 5
+   :file-change-snapshot-timeout "3h"
 
    :public-uri "http://localhost:3449"
-   :redis-uri "redis://localhost/0"
+   :host "localhost"
+   :tenant "main"
 
+   :redis-uri "redis://redis/0"
    :srepl-host "127.0.0.1"
    :srepl-port 6062
 
-   :storage-backend :fs
-
-   :storage-fs-directory "resources/public/assets"
-   :storage-s3-region :eu-central-1
-   :storage-s3-bucket "penpot-devenv-assets-pre"
-
-   :feedback-destination "info@example.com"
-   :feedback-enabled false
+   :assets-storage-backend :assets-fs
+   :storage-assets-fs-directory "assets"
 
    :assets-path "/internal/assets/"
-
-   :rlimits-password 10
-   :rlimits-image 2
-
-   :smtp-enabled false
    :smtp-default-reply-to "Penpot <no-reply@example.com>"
    :smtp-default-from "Penpot <no-reply@example.com>"
 
@@ -63,35 +80,56 @@
    :profile-bounce-max-age (dt/duration {:days 7})
    :profile-bounce-threshold 10
 
-   :allow-demo-users true
-   :registration-enabled true
-   :registration-domain-whitelist ""
-
-   :telemetry-enabled false
    :telemetry-uri "https://telemetry.penpot.app/"
 
-   :ldap-user-query "(|(uid=$username)(mail=$username))"
+   :ldap-user-query "(|(uid=:username)(mail=:username))"
    :ldap-attrs-username "uid"
    :ldap-attrs-email "mail"
    :ldap-attrs-fullname "cn"
-   :ldap-attrs-photo "jpegPhoto"
 
    ;; a server prop key where initial project is stored.
-   :initial-project-skey "initial-project"
-   })
+   :initial-project-skey "initial-project"})
 
+(s/def ::default-rpc-rlimit ::us/vector-of-strings)
+(s/def ::rpc-rlimit-config ::fs/path)
+(s/def ::rpc-climit-config ::fs/path)
+
+(s/def ::media-max-file-size ::us/integer)
+
+(s/def ::flags ::us/vector-of-keywords)
+(s/def ::telemetry-enabled ::us/boolean)
+
+(s/def ::audit-log-archive-uri ::us/string)
+(s/def ::audit-log-http-handler-concurrency ::us/integer)
+
+(s/def ::admins ::us/set-of-strings)
+(s/def ::file-change-snapshot-every ::us/integer)
+(s/def ::file-change-snapshot-timeout ::dt/duration)
+
+(s/def ::default-executor-parallelism ::us/integer)
+(s/def ::scheduled-executor-parallelism ::us/integer)
+
+(s/def ::worker-default-parallelism ::us/integer)
+(s/def ::worker-webhook-parallelism ::us/integer)
+
+(s/def ::authenticated-cookie-domain ::us/string)
+(s/def ::authenticated-cookie-name ::us/string)
+(s/def ::auth-token-cookie-name ::us/string)
+(s/def ::auth-token-cookie-max-age ::dt/duration)
+
+(s/def ::secret-key ::us/string)
 (s/def ::allow-demo-users ::us/boolean)
-(s/def ::asserts-enabled ::us/boolean)
 (s/def ::assets-path ::us/string)
 (s/def ::database-password (s/nilable ::us/string))
 (s/def ::database-uri ::us/string)
 (s/def ::database-username (s/nilable ::us/string))
+(s/def ::database-readonly ::us/boolean)
+(s/def ::database-min-pool-size ::us/integer)
+(s/def ::database-max-pool-size ::us/integer)
+
 (s/def ::default-blob-version ::us/integer)
 (s/def ::error-report-webhook ::us/string)
-(s/def ::feedback-destination ::us/string)
-(s/def ::feedback-enabled ::us/boolean)
-(s/def ::feedback-reply-to ::us/email)
-(s/def ::feedback-token ::us/string)
+(s/def ::user-feedback-destination ::us/string)
 (s/def ::github-client-id ::us/string)
 (s/def ::github-client-secret ::us/string)
 (s/def ::gitlab-base-uri ::us/string)
@@ -99,16 +137,26 @@
 (s/def ::gitlab-client-secret ::us/string)
 (s/def ::google-client-id ::us/string)
 (s/def ::google-client-secret ::us/string)
+(s/def ::oidc-client-id ::us/string)
+(s/def ::oidc-client-secret ::us/string)
+(s/def ::oidc-base-uri ::us/string)
+(s/def ::oidc-token-uri ::us/string)
+(s/def ::oidc-auth-uri ::us/string)
+(s/def ::oidc-user-uri ::us/string)
+(s/def ::oidc-scopes ::us/set-of-strings)
+(s/def ::oidc-roles ::us/set-of-strings)
+(s/def ::oidc-roles-attr ::us/keyword)
+(s/def ::oidc-email-attr ::us/keyword)
+(s/def ::oidc-name-attr ::us/keyword)
 (s/def ::host ::us/string)
 (s/def ::http-server-port ::us/integer)
-(s/def ::http-session-cookie-name ::us/string)
-(s/def ::http-session-idle-max-age ::dt/duration)
-(s/def ::http-session-updater-batch-max-age ::dt/duration)
-(s/def ::http-session-updater-batch-max-size ::us/integer)
-(s/def ::initial-project-skey ::us/string)
+(s/def ::http-server-host ::us/string)
+(s/def ::http-server-max-body-size ::us/integer)
+(s/def ::http-server-max-multipart-body-size ::us/integer)
+(s/def ::http-server-io-threads ::us/integer)
+(s/def ::http-server-worker-threads ::us/integer)
 (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)
@@ -128,13 +176,10 @@
 (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 ::registration-domain-whitelist ::us/set-of-strings)
+
 (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)
@@ -143,29 +188,47 @@
 (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 ::assets-storage-backend ::us/keyword)
+(s/def ::fdata-storage-backend ::us/keyword)
+(s/def ::storage-assets-fs-directory ::us/string)
+(s/def ::storage-assets-s3-bucket ::us/string)
+(s/def ::storage-assets-s3-region ::us/keyword)
+(s/def ::storage-assets-s3-endpoint ::us/string)
+(s/def ::storage-fdata-s3-bucket ::us/string)
+(s/def ::storage-fdata-s3-region ::us/keyword)
+(s/def ::storage-fdata-s3-prefix ::us/string)
+(s/def ::storage-fdata-s3-endpoint ::us/string)
 (s/def ::telemetry-uri ::us/string)
 (s/def ::telemetry-with-taiga ::us/boolean)
 (s/def ::tenant ::us/string)
 
 (s/def ::config
-  (s/keys :opt-un [::allow-demo-users
-                   ::asserts-enabled
+  (s/keys :opt-un [::secret-key
+                   ::flags
+                   ::admins
+                   ::allow-demo-users
+                   ::audit-log-archive-uri
+                   ::audit-log-http-handler-concurrency
+                   ::auth-token-cookie-name
+                   ::auth-token-cookie-max-age
+                   ::authenticated-cookie-name
+                   ::authenticated-cookie-domain
                    ::database-password
                    ::database-uri
                    ::database-username
+                   ::database-readonly
+                   ::database-min-pool-size
+                   ::database-max-pool-size
                    ::default-blob-version
+                   ::default-rpc-rlimit
                    ::error-report-webhook
-                   ::feedback-destination
-                   ::feedback-enabled
-                   ::feedback-reply-to
-                   ::feedback-token
+                   ::default-executor-parallelism
+                   ::scheduled-executor-parallelism
+                   ::worker-default-parallelism
+                   ::worker-webhook-parallelism
+                   ::file-change-snapshot-every
+                   ::file-change-snapshot-timeout
+                   ::user-feedback-destination
                    ::github-client-id
                    ::github-client-secret
                    ::gitlab-base-uri
@@ -173,15 +236,26 @@
                    ::gitlab-client-secret
                    ::google-client-id
                    ::google-client-secret
+                   ::oidc-client-id
+                   ::oidc-client-secret
+                   ::oidc-base-uri
+                   ::oidc-token-uri
+                   ::oidc-auth-uri
+                   ::oidc-user-uri
+                   ::oidc-scopes
+                   ::oidc-roles-attr
+                   ::oidc-email-attr
+                   ::oidc-name-attr
+                   ::oidc-roles
                    ::host
+                   ::http-server-host
                    ::http-server-port
-                   ::http-session-idle-max-age
-                   ::http-session-updater-batch-max-age
-                   ::http-session-updater-batch-max-size
-                   ::initial-project-skey
+                   ::http-server-max-body-size
+                   ::http-server-max-multipart-body-size
+                   ::http-server-io-threads
+                   ::http-server-worker-threads
                    ::ldap-attrs-email
                    ::ldap-attrs-fullname
-                   ::ldap-attrs-photo
                    ::ldap-attrs-username
                    ::ldap-base-dn
                    ::ldap-bind-dn
@@ -194,6 +268,7 @@
                    ::local-assets-uri
                    ::loggers-loki-uri
                    ::loggers-zmq-uri
+                   ::media-max-file-size
                    ::profile-bounce-max-age
                    ::profile-bounce-threshold
                    ::profile-complaint-max-age
@@ -201,61 +276,88 @@
                    ::public-uri
                    ::redis-uri
                    ::registration-domain-whitelist
-                   ::registration-enabled
-                   ::rlimits-image
-                   ::rlimits-password
+                   ::rpc-rlimit-config
+
+                   ::semaphore-process-font
+                   ::semaphore-process-image
+                   ::semaphore-update-file
+                   ::semaphore-auth
+
                    ::smtp-default-from
                    ::smtp-default-reply-to
-                   ::smtp-enabled
                    ::smtp-host
                    ::smtp-password
                    ::smtp-port
                    ::smtp-ssl
                    ::smtp-tls
                    ::smtp-username
+
                    ::srepl-host
                    ::srepl-port
-                   ::storage-backend
-                   ::storage-fs-directory
-                   ::storage-s3-bucket
-                   ::storage-s3-region
+
+                   ::assets-storage-backend
+                   ::storage-assets-fs-directory
+                   ::storage-assets-s3-bucket
+                   ::storage-assets-s3-region
+                   ::storage-assets-s3-endpoint
+                   ::fdata-storage-backend
+                   ::storage-fdata-s3-bucket
+                   ::storage-fdata-s3-region
+                   ::storage-fdata-s3-prefix
+                   ::storage-fdata-s3-endpoint
                    ::telemetry-enabled
-                   ::telemetry-server-enabled
-                   ::telemetry-server-port
                    ::telemetry-uri
+                   ::telemetry-referer
                    ::telemetry-with-taiga
                    ::tenant]))
 
-(defn- env->config
-  [env]
-  (reduce-kv
-   (fn [acc k v]
-     (cond-> acc
-       (str/starts-with? (name k) "penpot-")
-       (assoc (keyword (subs (name k) 7)) v)
+(def default-flags
+  [:enable-backend-api-doc
+   :enable-backend-worker
+   :enable-secure-session-cookies
+   :enable-email-verification])
 
-       (str/starts-with? (name k) "app-")
-       (assoc (keyword (subs (name k) 4)) v)))
-   {}
-   env))
+(defn- parse-flags
+  [config]
+  (flags/parse flags/default
+               default-flags
+               (:flags config)))
+
+(defn read-env
+  [prefix]
+  (let [prefix (str prefix "-")
+        len    (count prefix)]
+    (reduce-kv
+     (fn [acc k v]
+       (cond-> acc
+         (str/starts-with? (name k) prefix)
+         (assoc (keyword (subs (name k) len)) v)))
+     {}
+     env)))
 
 (defn- read-config
-  [env]
-  (->> (env->config env)
-       (merge defaults)
-       (us/conform ::config)))
+  []
+  (try
+    (->> (read-env "penpot")
+         (merge defaults)
+         (us/conform ::config))
+    (catch Throwable e
+      (when (ex/ex-info? e)
+        (println ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")
+        (println "Error on validating configuration:")
+        (println (some-> e ex-data ex/explain))
+        (println (ex/explain (ex-data e)))
+        (println ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;"))
+      (throw e))))
 
-(defn- read-test-config
-  [env]
-  (merge {:redis-uri "redis://redis/1"
-          :database-uri "postgresql://postgres/penpot_test"
-          :storage-fs-directory "/tmp/app/storage"
-          :migrations-verbose false}
-         (read-config env)))
+(def version
+  (v/parse (or (some-> (io/resource "version.txt")
+                       (slurp)
+                       (str/trim))
+               "%version%")))
 
-(def version (v/parse "%version%"))
-(def config (read-config env))
-(def test-config (read-test-config env))
+(defonce ^:dynamic config (read-config))
+(defonce ^:dynamic flags (parse-flags config))
 
 (def deletion-delay
   (dt/duration {:days 7}))
@@ -266,3 +368,6 @@
    (c/get config key))
   ([key default]
    (c/get config key default)))
+
+;; Set value for all new threads bindings.
+(alter-var-root #'*assert* (constantly (contains? flags :backend-asserts)))

backend/src/app/db.clj

@@ -2,25 +2,25 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.db
+  (:refer-clojure :exclude [get])
   (:require
+   [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.geom.point :as gpt]
+   [app.common.logging :as l]
    [app.common.spec :as us]
+   [app.common.transit :as t]
+   [app.common.uuid :as uuid]
    [app.db.sql :as sql]
    [app.metrics :as mtx]
    [app.util.json :as json]
    [app.util.migrations :as mg]
    [app.util.time :as dt]
-   [app.util.transit :as t]
    [clojure.java.io :as io]
    [clojure.spec.alpha :as s]
-   [clojure.tools.logging :as log]
    [integrant.core :as ig]
    [next.jdbc :as jdbc]
    [next.jdbc.date-time :as jdbc-dt])
@@ -28,14 +28,18 @@
    com.zaxxer.hikari.HikariConfig
    com.zaxxer.hikari.HikariDataSource
    com.zaxxer.hikari.metrics.prometheus.PrometheusMetricsTrackerFactory
+   io.whitfin.siphash.SipHasher
+   io.whitfin.siphash.SipHasherContainer
+   java.io.InputStream
+   java.io.OutputStream
    java.lang.AutoCloseable
    java.sql.Connection
    java.sql.Savepoint
    org.postgresql.PGConnection
    org.postgresql.geometric.PGpoint
+   org.postgresql.jdbc.PgArray
    org.postgresql.largeobject.LargeObject
    org.postgresql.largeobject.LargeObjectManager
-   org.postgresql.jdbc.PgArray
    org.postgresql.util.PGInterval
    org.postgresql.util.PGobject))
 
@@ -46,74 +50,116 @@
 ;; Initialization
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(declare instrument-jdbc!)
+(declare apply-migrations!)
 
-(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 ::connection-timeout ::us/integer)
+(s/def ::max-size ::us/integer)
+(s/def ::min-size ::us/integer)
 (s/def ::migrations map?)
+(s/def ::name keyword?)
+(s/def ::password ::us/string)
+(s/def ::uri ::us/not-empty-string)
+(s/def ::username ::us/string)
+(s/def ::validation-timeout ::us/integer)
+(s/def ::read-only? ::us/boolean)
 
-(defmethod ig/pre-init-spec ::pool [_]
-  (s/keys :req-un [::uri ::name ::min-pool-size ::max-pool-size ::migrations ::mtx/metrics]))
+(s/def ::pool-options
+  (s/keys :opt-un [::uri ::name
+                   ::min-size
+                   ::max-size
+                   ::connection-timeout
+                   ::validation-timeout
+                   ::migrations
+                   ::username
+                   ::password
+                   ::mtx/metrics
+                   ::read-only?]))
+
+(def defaults
+  {:name :main
+   :min-size 0
+   :max-size 60
+   :connection-timeout 10000
+   :validation-timeout 10000
+   :idle-timeout 120000 ; 2min
+   :max-lifetime 1800000 ; 30m
+   :read-only? false})
+
+(defmethod ig/prep-key ::pool
+  [_ cfg]
+  (merge defaults (d/without-nils cfg)))
+
+;; Don't validate here, just validate that a map is received.
+(defmethod ig/pre-init-spec ::pool [_] ::pool-options)
 
 (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))
+  [_ {:keys [migrations read-only? uri] :as cfg}]
+  (if uri
+    (let [pool (create-pool cfg)]
+      (l/info :hint "initialize connection pool"
+              :name (d/name (:name cfg))
+              :uri uri
+              :read-only read-only?
+              :with-credentials (and (contains? cfg :username)
+                                     (contains? cfg :password))
+              :min-size (:min-size cfg)
+              :max-size (:max-size cfg))
+      (when-not read-only?
+        (some->> (seq migrations) (apply-migrations! pool)))
+      pool)
+
+    (do
+      (l/warn :hint "unable to initialize pool, missing url"
+              :name (d/name (:name cfg))
+              :read-only read-only?)
+      nil)))
 
 (defmethod ig/halt-key! ::pool
   [_ pool]
-  (.close ^HikariDataSource pool))
+  (when 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."}))
+(defn- apply-migrations!
+  [pool migrations]
+  (with-open [conn ^AutoCloseable (open pool)]
+    (mg/setup! conn)
+    (doseq [[name steps] migrations]
+      (mg/migrate! conn {:name (d/name name) :steps steps}))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; API & Impl
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (def initsql
-  (str "SET statement_timeout = 120000;\n"
-       "SET idle_in_transaction_session_timeout = 120000;"))
+  (str "SET statement_timeout = 300000;\n"
+       "SET idle_in_transaction_session_timeout = 300000;"))
 
 (defn- create-datasource-config
-  [{:keys [metrics] :as cfg}]
-  (let [dburi    (:uri cfg)
-        username (:username cfg)
-        password (:password cfg)
-        config   (HikariConfig.)
-        mtf      (PrometheusMetricsTrackerFactory. (:registry metrics))]
+  [{:keys [metrics uri] :as cfg}]
+  (let [config (HikariConfig.)]
     (doto config
-      (.setJdbcUrl (str "jdbc:" dburi))
-      (.setPoolName (:name cfg "default"))
+      (.setJdbcUrl           (str "jdbc:" uri))
+      (.setPoolName          (d/name (:name cfg)))
       (.setAutoCommit true)
-      (.setReadOnly false)
-      (.setConnectionTimeout 8000)  ;; 8seg
-      (.setValidationTimeout 8000)  ;; 8seg
-      (.setIdleTimeout 120000)      ;; 2min
-      (.setMaxLifetime 1800000)     ;; 30min
-      (.setMinimumIdle (:min-pool-size cfg 0))
-      (.setMaximumPoolSize (:max-pool-size cfg 30))
-      (.setMetricsTrackerFactory mtf)
+      (.setReadOnly          (:read-only? cfg))
+      (.setConnectionTimeout (:connection-timeout cfg))
+      (.setValidationTimeout (:validation-timeout cfg))
+      (.setIdleTimeout       (:idle-timeout cfg))
+      (.setMaxLifetime       (:max-lifetime cfg))
+      (.setMinimumIdle       (:min-size cfg))
+      (.setMaximumPoolSize   (:max-size cfg))
       (.setConnectionInitSql initsql)
       (.setInitializationFailTimeout -1))
-    (when username (.setUsername config username))
-    (when password (.setPassword config password))
+
+    ;; When metrics namespace is provided
+    (when metrics
+      (->> (::mtx/registry metrics)
+           (PrometheusMetricsTrackerFactory.)
+           (.setMetricsTrackerFactory config)))
+
+    (some->> ^String (:username cfg) (.setUsername config))
+    (some->> ^String (:password cfg) (.setPassword config))
+
     config))
 
 (defn pool?
@@ -122,11 +168,15 @@
 
 (s/def ::pool pool?)
 
-(defn pool-closed?
+(defn closed?
   [pool]
   (.isClosed ^HikariDataSource pool))
 
-(defn- create-pool
+(defn read-only?
+  [pool]
+  (.isReadOnly ^HikariDataSource pool))
+
+(defn create-pool
   [cfg]
   (let [dsc (create-datasource-config cfg)]
     (jdbc-dt/read-as-instant)
@@ -178,7 +228,7 @@
   [& args]
   `(jdbc/with-transaction ~@args))
 
-(defn ^Connection open
+(defn open
   [pool]
   (jdbc/get-connection pool))
 
@@ -198,14 +248,21 @@
   ([ds table params opts]
    (exec-one! ds
               (sql/insert table params opts)
-              (assoc opts :return-keys true))))
+              (merge {:return-keys true} opts))))
+
+(defn insert-multi!
+  ([ds table cols rows] (insert-multi! ds table cols rows nil))
+  ([ds table cols rows opts]
+   (exec! ds
+          (sql/insert-multi table cols rows opts)
+          (merge {:return-keys true} opts))))
 
 (defn update!
   ([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))))
+              (merge {:return-keys true} opts))))
 
 (defn delete!
   ([ds table params] (delete! ds table params nil))
@@ -214,21 +271,57 @@
               (sql/delete table params opts)
               (assoc opts :return-keys true))))
 
+(defn is-row-deleted?
+  [{:keys [deleted-at]}]
+  (and (dt/instant? deleted-at)
+       (< (inst-ms deleted-at)
+          (inst-ms (dt/now)))))
+
+(defn get*
+  "Internal function for retrieve a single row from database that
+  matches a simple filters."
+  ([ds table params]
+   (get* ds table params nil))
+  ([ds table params {:keys [check-deleted?] :or {check-deleted? true} :as opts}]
+   (let [rows (exec! ds (sql/select table params opts))
+         rows (cond->> rows
+                check-deleted?
+                (remove is-row-deleted?))]
+     (first rows))))
+
+(defn get
+  ([ds table params]
+   (get ds table params nil))
+  ([ds table params {:keys [check-deleted?] :or {check-deleted? true} :as opts}]
+   (let [row (get* ds table params opts)]
+     (when (and (not row) check-deleted?)
+       (ex/raise :type :not-found
+                 :code :object-not-found
+                 :table table
+                 :hint "database object not found"))
+     row)))
+
 (defn get-by-params
+  "DEPRECATED"
   ([ds table params]
    (get-by-params ds table params nil))
-  ([ds table params opts]
-   (let [res (exec-one! ds (sql/select table params opts))]
-     (when (or (:deleted-at res) (not res))
+  ([ds table params {:keys [check-not-found] :or {check-not-found true} :as opts}]
+   (let [row (get* ds table params (assoc opts :check-deleted? check-not-found))]
+     (when (and (not row) check-not-found)
        (ex/raise :type :not-found
+                 :code :object-not-found
+                 :table table
                  :hint "database object not found"))
-     res)))
+     row)))
 
 (defn get-by-id
   ([ds table id]
-   (get-by-params ds table {:id id} nil))
+   (get ds table {:id id} nil))
   ([ds table id opts]
-   (get-by-params ds table {:id id} opts)))
+   (let [opts (cond-> opts
+                (contains? opts :check-not-found)
+                (assoc :check-deleted? (:check-not-found opts)))]
+     (get ds table {:id id} opts))))
 
 (defn query
   ([ds table params]
@@ -237,8 +330,11 @@
    (exec! ds (sql/select table params opts))))
 
 (defn pgobject?
-  [v]
-  (instance? PGobject v))
+  ([v]
+   (instance? PGobject v))
+  ([v type]
+   (and (instance? PGobject v)
+        (= type (.getType ^PGobject v)))))
 
 (defn pginterval?
   [v]
@@ -249,21 +345,41 @@
   (instance? PGpoint v))
 
 (defn pgarray?
-  [v]
-  (instance? PgArray v))
+  ([v] (instance? PgArray v))
+  ([v type]
+   (and (instance? PgArray v)
+        (= type (.getBaseTypeName ^PgArray v)))))
 
 (defn pgarray-of-uuid?
   [v]
   (and (pgarray? v) (= "uuid" (.getBaseTypeName ^PgArray v))))
 
+;; TODO rename to decode-pgarray-into
+(defn decode-pgarray
+  ([v] (decode-pgarray v []))
+  ([v in]
+   (into in (some-> ^PgArray v .getArray)))
+  ([v in xf]
+   (into in xf (some-> ^PgArray v .getArray))))
+
+(defn pgarray->set
+  [v]
+  (set (.getArray ^PgArray v)))
+
+(defn pgarray->vector
+  [v]
+  (vec (.getArray ^PgArray v)))
+
 (defn pgpoint
   [p]
   (PGpoint. (:x p) (:y p)))
 
 (defn create-array
-  [conn type aobjects]
+  [conn type objects]
   (let [^PGConnection conn (unwrap conn org.postgresql.PGConnection)]
-    (.createArrayOf conn ^String type aobjects)))
+    (if (coll? objects)
+      (.createArrayOf conn ^String type (into-array Object objects))
+      (.createArrayOf conn ^String type objects))))
 
 (defn decode-pgpoint
   [^PGpoint v]
@@ -286,60 +402,115 @@
    (.rollback conn sp)))
 
 (defn interval
-  [data]
+  [o]
   (cond
-    (integer? data)
-    (->> (/ data 1000.0)
+    (or (integer? o)
+        (float? o))
+    (->> (/ o 1000.0)
          (format "%s seconds")
          (pginterval))
 
-    (string? data)
-    (pginterval data)
+    (string? o)
+    (pginterval o)
 
-    (dt/duration? data)
-    (->> (/ (.toMillis ^java.time.Duration data) 1000.0)
-         (format "%s seconds")
-         (pginterval))
+    (dt/duration? o)
+    (interval (inst-ms o))
 
     :else
-    (ex/raise :type :not-implemented)))
+    (ex/raise :type :not-implemented
+              :hint (format "no implementation found for value %s" (pr-str o)))))
 
 (defn decode-json-pgobject
   [^PGobject o]
-  (let [typ (.getType o)
-        val (.getValue o)]
-    (if (or (= typ "json")
-            (= typ "jsonb"))
-      (json/decode-str val)
-      val)))
+  (when o
+    (let [typ (.getType o)
+          val (.getValue o)]
+      (if (or (= typ "json")
+              (= typ "jsonb"))
+        (json/decode val)
+        val))))
 
 (defn decode-transit-pgobject
   [^PGobject o]
-  (let [typ (.getType o)
-        val (.getValue o)]
-    (if (or (= typ "json")
-            (= typ "jsonb"))
-      (t/decode-str val)
-      val)))
+  (when o
+    (let [typ (.getType o)
+          val (.getValue o)]
+      (if (or (= typ "json")
+              (= typ "jsonb"))
+        (t/decode-str val)
+        val))))
+
+(defn inet
+  [ip-addr]
+  (when ip-addr
+    (doto (org.postgresql.util.PGobject.)
+      (.setType "inet")
+      (.setValue (str ip-addr)))))
+
+(defn decode-inet
+  [^PGobject o]
+  (when o
+    (if (= "inet" (.getType o))
+      (.getValue o)
+      nil)))
 
 (defn tjson
   "Encode as transit json."
   [data]
-  (doto (org.postgresql.util.PGobject.)
-    (.setType "jsonb")
-    (.setValue (t/encode-verbose-str data))))
+  (when data
+    (doto (org.postgresql.util.PGobject.)
+      (.setType "jsonb")
+      (.setValue (t/encode-str data {:type :json-verbose})))))
 
 (defn json
   "Encode as plain json."
   [data]
-  (doto (org.postgresql.util.PGobject.)
-    (.setType "jsonb")
-    (.setValue (json/encode-str data))))
+  (when data
+    (doto (org.postgresql.util.PGobject.)
+      (.setType "jsonb")
+      (.setValue (json/encode-str data)))))
 
-(defn pgarray->set
-  [v]
-  (set (.getArray ^PgArray v)))
+;; --- Locks
 
-(defn pgarray->vector
-  [v]
-  (vec (.getArray ^PgArray v)))
+(def ^:private siphash-state
+  (SipHasher/container
+   (uuid/get-bytes uuid/zero)))
+
+(defn uuid->hash-code
+  [o]
+  (.hash ^SipHasherContainer siphash-state
+         ^bytes (uuid/get-bytes o)))
+
+(defn- xact-check-param
+  [n]
+  (cond
+    (uuid? n) (uuid->hash-code n)
+    (int? n)  n
+    :else (throw (IllegalArgumentException. "uuid or number allowed"))))
+
+(defn xact-lock!
+  [conn n]
+  (let [n (xact-check-param n)]
+    (exec-one! conn ["select pg_advisory_xact_lock(?::bigint) as lock" n])
+    true))
+
+(defn xact-try-lock!
+  [conn n]
+  (let [n   (xact-check-param n)
+        row (exec-one! conn ["select pg_try_advisory_xact_lock(?::bigint) as lock" n])]
+    (:lock row)))
+
+(defn sql-exception?
+  [cause]
+  (instance? java.sql.SQLException cause))
+
+(defn connection-error?
+  [cause]
+  (and (sql-exception? cause)
+       (contains? #{"08003" "08006" "08001" "08004"}
+                  (.getSQLState ^java.sql.SQLException cause))))
+
+(defn serialization-error?
+  [cause]
+  (and (sql-exception? cause)
+       (= "40001" (.getSQLState ^java.sql.SQLException cause))))

backend/src/app/db/sql.clj

@@ -2,10 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.db.sql
   (:refer-clojure :exclude [update])
@@ -35,14 +32,19 @@
                 (assoc :suffix "ON CONFLICT DO NOTHING"))]
      (sql/for-insert table key-map opts))))
 
+(defn insert-multi
+  [table cols rows opts]
+  (let [opts (merge default-opts opts)]
+    (sql/for-insert-multi table cols rows opts)))
+
 (defn select
   ([table where-params]
    (select table where-params nil))
   ([table where-params opts]
    (let [opts (merge default-opts opts)
          opts (cond-> opts
-                (:for-update opts)
-                (assoc :suffix "FOR UPDATE"))]
+                (:for-update opts)    (assoc :suffix "FOR UPDATE")
+                (:for-key-share opts) (assoc :suffix "FOR KEY SHARE"))]
      (sql/for-query table where-params opts))))
 
 (defn update
@@ -58,4 +60,3 @@
   ([table where-params opts]
    (let [opts (merge default-opts opts)]
      (sql/for-delete table where-params opts))))
-

backend/src/app/emails.clj

@@ -2,47 +2,398 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020-2021 UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.emails
   "Main api for send emails."
   (:require
+   [app.common.exceptions :as ex]
+   [app.common.logging :as l]
+   [app.common.pprint :as pp]
    [app.common.spec :as us]
-   [app.config :as cfg]
+   [app.config :as cf]
    [app.db :as db]
    [app.db.sql :as sql]
-   [app.tasks :as tasks]
-   [app.util.emails :as emails]
-   [clojure.spec.alpha :as s]))
+   [app.emails.invite-to-team :as-alias emails.invite-to-team]
+   [app.metrics :as mtx]
+   [app.util.template :as tmpl]
+   [app.worker :as wrk]
+   [clojure.java.io :as io]
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [integrant.core :as ig])
+  (:import
+   jakarta.mail.Message$RecipientType
+   jakarta.mail.Session
+   jakarta.mail.Transport
+   jakarta.mail.internet.InternetAddress
+   jakarta.mail.internet.MimeBodyPart
+   jakarta.mail.internet.MimeMessage
+   jakarta.mail.internet.MimeMultipart
+   java.util.Properties))
 
-;; --- Defaults
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; EMAIL IMPL
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defn default-context
-  []
-  {:assets-uri (:assets-uri cfg/config)
-   :public-uri (:public-uri cfg/config)})
+(defn- parse-address
+  [v]
+  (InternetAddress/parse ^String v))
 
-;; --- Public API
+(defn- resolve-recipient-type
+  ^Message$RecipientType
+  [type]
+  (case type
+    :to  Message$RecipientType/TO
+    :cc  Message$RecipientType/CC
+    :bcc Message$RecipientType/BCC))
+
+(defn- assign-recipient
+  [^MimeMessage mmsg type address]
+  (if (sequential? address)
+    (reduce #(assign-recipient %1 type %2) mmsg address)
+    (let [address (parse-address address)
+          type    (resolve-recipient-type type)]
+      (.addRecipients mmsg type address)
+      mmsg)))
+(defn- assign-recipients
+  [mmsg {:keys [to cc bcc] :as params}]
+  (cond-> mmsg
+    (some? to)  (assign-recipient :to to)
+    (some? cc)  (assign-recipient :cc cc)
+    (some? bcc) (assign-recipient :bcc bcc)))
+
+(defn- assign-from
+  [mmsg {:keys [default-from]} {:keys [from] :as props}]
+  (let [from (or from default-from)]
+    (when from
+      (let [from (parse-address from)]
+        (.addFrom ^MimeMessage mmsg from)))))
+
+(defn- assign-reply-to
+  [mmsg {:keys [default-reply-to] :as cfg} {:keys [reply-to] :as params}]
+  (let [reply-to (or reply-to default-reply-to)]
+    (when reply-to
+      (let [reply-to (parse-address reply-to)]
+        (.setReplyTo ^MimeMessage mmsg reply-to)))))
+
+(defn- assign-subject
+  [mmsg {:keys [subject charset] :or {charset "utf-8"} :as params}]
+  (assert (string? subject) "subject is mandatory")
+  (.setSubject ^MimeMessage mmsg
+               ^String subject
+               ^String charset))
+
+(defn- assign-extra-headers
+  [^MimeMessage mmsg {:keys [headers extra-data] :as params}]
+  (let [headers (assoc headers "X-Penpot-Data" extra-data)]
+    (reduce-kv (fn [^MimeMessage mmsg k v]
+                 (doto mmsg
+                   (.addHeader (name k) (str v))))
+               mmsg
+               headers)))
+
+(defn- assign-body
+  [^MimeMessage mmsg {:keys [body charset] :or {charset "utf-8"}}]
+  (let [mpart (MimeMultipart. "mixed")]
+    (cond
+      (string? body)
+      (let [bpart (MimeBodyPart.)]
+        (.setContent bpart ^String body (str "text/plain; charset=" charset))
+        (.addBodyPart mpart bpart))
+
+      (vector? body)
+      (let [mmp (MimeMultipart. "alternative")
+            mbp (MimeBodyPart.)]
+        (.addBodyPart mpart mbp)
+        (.setContent mbp mmp)
+        (doseq [item body]
+          (let [mbp (MimeBodyPart.)]
+            (.setContent mbp
+                         ^String (:content item)
+                         ^String (str (:type item "text/plain") "; charset=" charset))
+            (.addBodyPart mmp mbp))))
+
+      (map? body)
+      (let [bpart (MimeBodyPart.)]
+        (.setContent bpart
+                     ^String (:content body)
+                     ^String (str (:type body "text/plain") "; charset=" charset))
+        (.addBodyPart mpart bpart))
+
+      :else
+      (throw (ex-info "Unsupported type" {:body body})))
+    (.setContent mmsg mpart)
+    mmsg))
+
+(defn- opts->props
+  [{:keys [username tls host port timeout default-from]
+    :or {timeout 30000}
+    :as opts}]
+  (reduce-kv
+   (fn [^Properties props k v]
+     (if (nil? v)
+       props
+       (doto props (.put ^String k  ^String (str v)))))
+   (Properties.)
+   {"mail.user" username
+    "mail.host" host
+    "mail.debug" (contains? cf/flags :smtp-debug)
+    "mail.from" default-from
+    "mail.smtp.auth" (boolean username)
+    "mail.smtp.starttls.enable" tls
+    "mail.smtp.starttls.required" tls
+    "mail.smtp.host" host
+    "mail.smtp.port" port
+    "mail.smtp.user" username
+    "mail.smtp.timeout" timeout
+    "mail.smtp.connectiontimeout" timeout}))
+
+(defn- create-smtp-session
+  [opts]
+  (let [props (opts->props opts)]
+    (Session/getInstance props)))
+
+(defn- create-smtp-message
+  ^MimeMessage
+  [cfg session params]
+  (let [mmsg (MimeMessage. ^Session session)]
+    (assign-recipients mmsg params)
+    (assign-from mmsg cfg params)
+    (assign-reply-to mmsg cfg params)
+    (assign-subject mmsg params)
+    (assign-extra-headers mmsg params)
+    (assign-body mmsg params)
+    (.saveChanges ^MimeMessage mmsg)
+    mmsg))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; TEMPLATE EMAIL IMPL
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def ^:private email-path "app/emails/%(id)s/%(lang)s.%(type)s")
+
+(defn- render-email-template-part
+  [type id context]
+  (let [lang (:lang context :en)
+        path (str/format email-path {:id (name id)
+                                     :lang (name lang)
+                                     :type (name type)})]
+    (some-> (io/resource path)
+            (tmpl/render context))))
+
+(defn- build-email-template
+  [id context]
+  (let [subj (render-email-template-part :subj id context)
+        text (render-email-template-part :txt id context)
+        html (render-email-template-part :html id context)]
+    (when (or (not subj)
+              (and (not text)
+                   (not html)))
+      (ex/raise :type :internal
+                :code :missing-email-templates))
+    {:subject subj
+     :body (into
+            [{:type "text/plain"
+              :content text}]
+            (when html
+              [{:type "text/html"
+                :content html}]))}))
+
+(s/def ::priority #{:high :low})
+(s/def ::to (s/or :single ::us/email
+                  :multi (s/coll-of ::us/email)))
+(s/def ::from ::us/email)
+(s/def ::reply-to ::us/email)
+(s/def ::lang string?)
+(s/def ::extra-data ::us/string)
+
+(s/def ::context
+  (s/keys :req-un [::to]
+          :opt-un [::reply-to ::from ::lang ::priority ::extra-data]))
+
+(defn template-factory
+  ([id] (template-factory id {}))
+  ([id extra-context]
+   (s/assert keyword? id)
+   (fn [context]
+     (us/verify ::context context)
+     (when-let [spec (s/get-spec id)]
+       (s/assert spec context))
+
+     (let [context (merge (if (fn? extra-context)
+                            (extra-context)
+                            extra-context)
+                          context)
+           email   (build-email-template id context)]
+       (when-not email
+         (ex/raise :type :internal
+                   :code :email-template-does-not-exists
+                   :hint "seems like the template is wrong or does not exists."
+                   :context {:id id}))
+       (cond-> (assoc email :id (name id))
+         (:extra-data context)
+         (assoc :extra-data (:extra-data context))
+
+         (:from context)
+         (assoc :from (:from context))
+
+         (:reply-to context)
+         (assoc :reply-to (:reply-to context))
+
+         (:to context)
+         (assoc :to (:to context)))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; PUBLIC HIGH-LEVEL API
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn render
   [email-factory context]
   (email-factory context))
 
 (defn send!
-  "Schedule the email for sending."
-  [conn email-factory context]
-  (us/verify fn? email-factory)
-  (us/verify map? context)
-  (let [email (email-factory context)]
-    (tasks/submit! conn {:name "sendmail"
-                         :delay 0
-                         :max-retries 1
-                         :priority 200
-                         :props email})))
+  "Schedule an already defined email to be sent using asynchronously
+  using worker task."
+  [{:keys [::conn ::factory] :as context}]
+  (us/verify fn? factory)
+  (us/verify some? conn)
+  (let [email (factory context)]
+    (wrk/submit! (assoc email
+                        ::wrk/task :sendmail
+                        ::wrk/delay 0
+                        ::wrk/max-retries 4
+                        ::wrk/priority 200
+                        ::wrk/conn conn))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; SENDMAIL FN / TASK HANDLER
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(s/def ::username ::cf/smtp-username)
+(s/def ::password ::cf/smtp-password)
+(s/def ::tls ::cf/smtp-tls)
+(s/def ::ssl ::cf/smtp-ssl)
+(s/def ::host ::cf/smtp-host)
+(s/def ::port ::cf/smtp-port)
+(s/def ::default-reply-to ::cf/smtp-default-reply-to)
+(s/def ::default-from ::cf/smtp-default-from)
+
+(s/def ::smtp-config
+  (s/keys :opt-un [::username
+                   ::password
+                   ::tls
+                   ::ssl
+                   ::host
+                   ::port
+                   ::default-from
+                   ::default-reply-to]))
+
+(declare send-to-logger!)
+
+(s/def ::sendmail fn?)
+
+(defmethod ig/pre-init-spec ::sendmail [_]
+  (s/spec ::smtp-config))
+
+(defmethod ig/init-key ::sendmail
+  [_ cfg]
+  (fn [params]
+    (when (contains? cf/flags :smtp)
+      (let [session (create-smtp-session cfg)]
+        (with-open [transport (.getTransport session (if (:ssl cfg) "smtps" "smtp"))]
+          (.connect ^Transport transport
+                    ^String (:username cfg)
+                    ^String (:password cfg))
+
+          (let [^MimeMessage message (create-smtp-message cfg session params)]
+            (.sendMessage ^Transport transport
+                          ^MimeMessage message
+                          (.getAllRecipients message))))))
+
+    (when (or (contains? cf/flags :log-emails)
+              (not (contains? cf/flags :smtp)))
+      (send-to-logger! cfg params))))
+
+(defmethod ig/pre-init-spec ::handler [_]
+  (s/keys :req-un [::sendmail ::mtx/metrics]))
+
+(defmethod ig/init-key ::handler
+  [_ {:keys [sendmail]}]
+  (fn [{:keys [props] :as task}]
+    (sendmail props)))
+
+(defn- send-to-logger!
+  [_ email]
+  (let [body (:body email)
+        out  (with-out-str
+               (println "email console dump:")
+               (println "******** start email" (:id email) "**********")
+               (pp/pprint (dissoc email :body))
+               (if (string? body)
+                 (println body)
+                 (println (->> body
+                               (filter #(= "text/plain" (:type %)))
+                               (map :content)
+                               first)))
+               (println "******** end email" (:id email) "**********"))]
+    (l/info ::l/raw out)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; EMAIL FACTORIES
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(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."
+  (template-factory ::feedback))
+
+(s/def ::name ::us/string)
+(s/def ::register
+  (s/keys :req-un [::name]))
+
+(def register
+  "A new profile registration welcome email."
+  (template-factory ::register))
+
+(s/def ::token ::us/string)
+(s/def ::password-recovery
+  (s/keys :req-un [::name ::token]))
+
+(def password-recovery
+  "A password recovery notification email."
+  (template-factory ::password-recovery))
+
+(s/def ::pending-email ::us/email)
+(s/def ::change-email
+  (s/keys :req-un [::name ::pending-email ::token]))
+
+(def change-email
+  "Password change confirmation email"
+  (template-factory ::change-email))
+
+(s/def ::emails.invite-to-team/invited-by ::us/string)
+(s/def ::emails.invite-to-team/team ::us/string)
+(s/def ::emails.invite-to-team/token ::us/string)
+
+(s/def ::invite-to-team
+  (s/keys :req-un [::emails.invite-to-team/invited-by
+                   ::emails.invite-to-team/token
+                   ::emails.invite-to-team/team]))
+
+(def invite-to-team
+  "Teams member invitation email."
+  (template-factory ::invite-to-team))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; BOUNCE/COMPLAINS HELPERS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (def sql:profile-complaint-report
   "select (select count(*)
@@ -59,10 +410,10 @@
 (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)
+    (let [complaint-threshold (cf/get :profile-complaint-threshold)
+          complaint-max-age   (cf/get :profile-complaint-max-age)
+          bounce-threshold    (cf/get :profile-bounce-threshold)
+          bounce-max-age      (cf/get :profile-bounce-max-age)
 
           {:keys [complaints bounces] :as result}
           (db/exec-one! conn [sql:profile-complaint-report
@@ -71,8 +422,8 @@
                               (:id profile)
                               (db/interval bounce-max-age)])]
 
-      (and (< complaints complaint-threshold)
-           (< bounces bounce-threshold)))))
+      (and (< (or complaints 0) complaint-threshold)
+           (< (or bounces 0) bounce-threshold)))))
 
 (defn has-complaint-reports?
   ([conn email] (has-complaint-reports? conn email nil))
@@ -89,53 +440,3 @@
                                             {: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]))
-
-(def register
-  "A new profile registration welcome email."
-  (emails/template-factory ::register default-context))
-
-(s/def ::token ::us/string)
-(s/def ::password-recovery
-  (s/keys :req-un [::name ::token]))
-
-(def password-recovery
-  "A password recovery notification email."
-  (emails/template-factory ::password-recovery default-context))
-
-(s/def ::pending-email ::us/email)
-(s/def ::change-email
-  (s/keys :req-un [::name ::pending-email ::token]))
-
-(def change-email
-  "Password change confirmation email"
-  (emails/template-factory ::change-email default-context))
-
-(s/def :internal.emails.invite-to-team/invited-by ::us/string)
-(s/def :internal.emails.invite-to-team/team ::us/string)
-(s/def :internal.emails.invite-to-team/token ::us/string)
-
-(s/def ::invite-to-team
-  (s/keys :keys [:internal.emails.invite-to-team/invited-by
-                 :internal.emails.invite-to-team/token
-                 :internal.emails.invite-to-team/team]))
-
-(def invite-to-team
-  "Teams member invitation email."
-  (emails/template-factory ::invite-to-team default-context))

backend/src/app/http.clj

@@ -2,154 +2,177 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020-2021 UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http
   (:require
    [app.common.data :as d]
-   [app.common.spec :as us]
-   [app.config :as cfg]
+   [app.common.logging :as l]
+   [app.common.transit :as t]
    [app.http.errors :as errors]
-   [app.http.middleware :as middleware]
+   [app.http.middleware :as mw]
+   [app.http.session :as session]
    [app.metrics :as mtx]
-   [app.util.log4j :refer [update-thread-context!]]
+   [app.worker :as wrk]
    [clojure.spec.alpha :as s]
-   [clojure.tools.logging :as log]
    [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))
+   [reitit.core :as r]
+   [reitit.middleware :as rr]
+   [yetti.adapter :as yt]
+   [yetti.request :as yrq]
+   [yetti.response :as yrs]))
+
+(declare wrap-router)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; HTTP SERVER
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (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)
+(s/def ::router some?)
+(s/def ::port integer?)
+(s/def ::host string?)
+(s/def ::name string?)
 
-(defmethod ig/pre-init-spec ::server [_]
-  (s/keys :req-un [::handler ::port]
-          :opt-un [::ws ::name ::mtx/metrics]))
+(s/def ::max-body-size integer?)
+(s/def ::max-multipart-body-size integer?)
+(s/def ::io-threads integer?)
+(s/def ::worker-threads integer?)
 
 (defmethod ig/prep-key ::server
   [_ cfg]
-  (merge {:name "http"}
+  (merge {:name "http"
+          :port 6060
+          :host "0.0.0.0"
+          :max-body-size (* 1024 1024 30)             ; 30 MiB
+          :max-multipart-body-size (* 1024 1024 120)} ; 120 MiB
          (d/without-nils cfg)))
 
+(defmethod ig/pre-init-spec ::server [_]
+  (s/and
+   (s/keys :req-un [::port ::host ::name ::max-body-size ::max-multipart-body-size]
+           :opt-un [::router ::handler ::io-threads ::worker-threads ::wrk/executor])
+   (fn [cfg]
+     (or (contains? cfg :router)
+         (contains? cfg :handler)))))
+
 (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)))))
+  [_ {:keys [handler router port name host] :as cfg}]
+  (l/info :hint "starting http server" :port port :host host :name name)
+  (let [options {:http/port port
+                 :http/host host
+                 :http/max-body-size (:max-body-size cfg)
+                 :http/max-multipart-body-size (:max-multipart-body-size cfg)
+                 :xnio/io-threads (:io-threads cfg)
+                 :xnio/worker-threads (:worker-threads cfg)
+                 :xnio/dispatch (:executor cfg)
+                 :ring/async true}
 
-        options   (merge
-                   {:port port
-                    :h2c? true
-                    :join? false
-                    :allow-null-path-info true
-                    :configurator pre-start}
-                   (when (seq ws)
-                     {:websockets ws}))
+        handler (if (some? router)
+                  (wrap-router router)
 
-        server    (jetty/run-jetty handler options)]
-    (assoc opts :server server)))
+                  handler)
+        server  (yt/server handler (d/without-nils options))]
+    (assoc cfg :server (yt/start! 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))
+  [_ {:keys [server name port] :as cfg}]
+  (l/info :msg "stopping http server" :name name :port port)
+  (yt/stop! server))
+
+(defn- not-found-handler
+  [_ respond _]
+  (respond (yrs/response 404)))
+
+(defn- wrap-router
+  [router]
+  (letfn [(handler [request respond raise]
+            (if-let [match (r/match-by-path router (yrq/path request))]
+              (let [params  (:path-params match)
+                    result  (:result match)
+                    handler (or (:handler result) not-found-handler)
+                    request (-> request
+                                (assoc :path-params params)
+                                (update :params merge params))]
+                (handler request respond raise))
+              (not-found-handler request respond raise)))
+
+          (on-error [cause request respond]
+            (let [{:keys [body] :as response} (errors/handle cause request)]
+              (respond
+               (cond-> response
+                 (map? body)
+                 (-> (update :headers assoc "content-type" "application/transit+json")
+                     (assoc :body (t/encode-str body {:type :json-verbose})))))))]
+
+    (fn [request respond _]
+      (try
+        (handler request respond #(on-error % request respond))
+        (catch Throwable cause
+          (on-error cause request respond))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Http Main Handler (Router)
+;; HTTP 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 ::awsns-handler fn?)
+(s/def ::debug-routes (s/nilable vector?))
+(s/def ::doc-routes (s/nilable vector?))
 (s/def ::feedback fn?)
+(s/def ::oauth map?)
+(s/def ::oidc-routes (s/nilable vector?))
+(s/def ::rpc-routes (s/nilable vector?))
+(s/def ::session ::session/session)
+(s/def ::storage map?)
+(s/def ::ws fn?)
 
 (defmethod ig/pre-init-spec ::router [_]
-  (s/keys :req-un [::rpc ::session ::metrics ::oauth ::storage ::assets ::feedback]))
+  (s/keys :req-un [::mtx/metrics
+                   ::ws
+                   ::storage
+                   ::assets
+                   ::session
+                   ::feedback
+                   ::awsns-handler
+                   ::debug-routes
+                   ::oidc-routes
+                   ::rpc-routes
+                   ::doc-routes]))
 
 (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
-  [{:keys [session rpc oauth metrics svgparse assets feedback] :as cfg}]
+  [_ {:keys [ws session metrics assets feedback] :as cfg}]
   (rr/router
-   [["/metrics" {:get (:handler metrics)}]
+   [["" {:middleware [[mw/server-timing]
+                      [mw/format-response]
+                      [mw/params]
+                      [mw/parse-request]
+                      [session/middleware-1 session]
+                      [mw/errors errors/handle]
+                      [mw/restrict-methods]]}
 
-    ["/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)}]]
+     ["/metrics" {:handler (::mtx/handler metrics)
+                  :allowed-methods #{:get}}]
 
-    ["/dbg"
-     ["/error-by-id/:id" {:get (:error-report-handler cfg)}]]
+     ["/assets" {:middleware [[session/middleware-2 session]]}
+      ["/by-id/:id" {:handler (:objects-handler assets)}]
+      ["/by-file-media-id/:id" {:handler (:file-objects-handler assets)}]
+      ["/by-file-media-id/:id/thumbnail" {:handler (:file-thumbnails-handler assets)}]]
 
-    ["/webhooks"
-     ["/sns" {:post (:sns-webhook cfg)}]]
+     (:debug-routes cfg)
 
-    ["/api" {:middleware [[middleware/format-response-body]
-                          [middleware/params]
-                          [middleware/multipart-params]
-                          [middleware/keyword-params]
-                          [middleware/parse-request-body]
-                          [middleware/errors errors/handle]
-                          [middleware/cookies]]}
+     ["/webhooks"
+      ["/sns" {:handler (:awsns-handler cfg)
+               :allowed-methods #{:post}}]]
 
-     ["/svg" {:post svgparse}]
-     ["/feedback" {:middleware [(:middleware session)]
-                   :post feedback}]
+     ["/ws/notifications" {:middleware [[session/middleware-2 session]]
+                           :handler ws
+                           :allowed-methods #{:get}}]
 
-     ["/oauth"
-      ["/google" {:post (get-in oauth [:google :handler])}]
-      ["/google/callback" {:get (get-in oauth [:google :callback-handler])}]
-
-      ["/gitlab" {:post (get-in oauth [:gitlab :handler])}]
-      ["/gitlab/callback" {:get (get-in oauth [:gitlab :callback-handler])}]
-
-      ["/github" {:post (get-in oauth [:github :handler])}]
-      ["/github/callback" {:get (get-in oauth [:github :callback-handler])}]]
-
-     ["/rpc" {:middleware [(:middleware session)]}
-      ["/query/:type" {:get (:query-handler rpc)}]
-      ["/mutation/:type" {:post (:mutation-handler rpc)}]]]]))
+     ["/api" {:middleware [[mw/cors]
+                           [session/middleware-2 session]]}
+      ["/feedback" {:handler feedback
+                    :allowed-methods #{:post}}]
+      (:doc-routes cfg)
+      (:oidc-routes cfg)
+      (:rpc-routes cfg)]]]))

backend/src/app/http/assets.clj

@@ -2,23 +2,24 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020-2021 UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.assets
   "Assets related handlers."
   (:require
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
+   [app.common.uri :as u]
    [app.db :as db]
    [app.metrics :as mtx]
    [app.storage :as sto]
    [app.util.time :as dt]
+   [app.worker :as wrk]
    [clojure.spec.alpha :as s]
    [integrant.core :as ig]
-   [lambdaisland.uri :as u]))
+   [promesa.core :as p]
+   [promesa.exec :as px]
+   [yetti.response :as yrs]))
 
 (def ^:private cache-max-age
   (dt/duration {:hours 24}))
@@ -28,73 +29,84 @@
 
 (defn coerce-id
   [id]
-  (let [res (us/uuid-conformer id)]
+  (let [res (parse-uuid 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))
+  [{:keys [pool executor] :as storage} id]
+  (px/with-dispatch executor
+    (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
+  "Helper function that returns the appropriate response depending on
+  the storage object backend type."
   [{: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 ""})
+      (p/let [{:keys [host port] :as url} (sto/get-object-url storage obj {:max-age signature-max-age})]
+        (yrs/response :status  307
+                      :headers {"location" (str url)
+                                "x-host"   (cond-> host port (str ":" port))
+                                "x-mtype"  (:content-type mdata)
+                                "cache-control" (str "max-age=" (inst-ms cache-max-age))}))
 
       :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 ""})))
+      (p/let [purl (u/uri (:assets-path cfg))
+              purl (u/join purl (sto/object->relative-path obj))]
+        (yrs/response :status  204
+                      :headers {"x-accel-redirect" (:path purl)
+                                "content-type" (:content-type mdata)
+                                "cache-control" (str "max-age=" (inst-ms cache-max-age))})))))
 
 (defn objects-handler
-  [cfg request]
-  (let [id (get-in request [:path-params :id])]
-    (generic-handler cfg request (coerce-id id))))
+  "Handler that servers storage objects by id."
+  [{:keys [storage executor] :as cfg} request respond raise]
+  (-> (px/with-dispatch executor
+        (p/let [id  (get-in request [:path-params :id])
+                id  (coerce-id id)
+                obj (sto/get-object storage id)]
+          (if obj
+            (serve-object cfg obj)
+            (yrs/response 404))))
+
+      (p/bind p/wrap)
+      (p/then' respond)
+      (p/catch raise)))
+
+(defn- generic-handler
+  "A generic handler helper/common code for file-media based handlers."
+  [{:keys [storage] :as cfg} request kf]
+  (p/let [id   (get-in request [:path-params :id])
+          mobj (get-file-media-object storage id)
+          obj  (sto/get-object storage (kf mobj))]
+    (if obj
+      (serve-object cfg obj)
+      (yrs/response 404))))
 
 (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))))
+  "Handler that serves storage objects by file media id."
+  [cfg request respond raise]
+  (-> (generic-handler cfg request :media-id)
+      (p/then respond)
+      (p/catch raise)))
 
 (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)))))
-
+  "Handler that serves storage objects by thumbnail-id and quick
+  fallback to file-media-id if no thumbnail is available."
+  [cfg request respond raise]
+  (-> (generic-handler cfg request #(or (:thumbnail-id %) (:media-id %)))
+      (p/then respond)
+      (p/catch raise)))
 
 ;; --- Initialization
 
@@ -104,10 +116,16 @@
 (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]))
+  (s/keys :req-un [::storage
+                   ::wrk/executor
+                   ::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 %)})
+  {:objects-handler (partial objects-handler cfg)
+   :file-objects-handler (partial file-objects-handler cfg)
+   :file-thumbnails-handler (partial file-thumbnails-handler cfg)})
+

backend/src/app/http/awsns.clj

@@ -2,60 +2,69 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 Andrey Antukh <niwi@niwi.nz>
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.awsns
   "AWS SNS webhook handler for bounces."
   (:require
    [app.common.exceptions :as ex]
+   [app.common.logging :as l]
    [app.db :as db]
    [app.db.sql :as sql]
-   [app.util.http :as http]
-   [clojure.pprint :refer [pprint]]
+   [app.http.client :as http]
+   [app.main :as-alias main]
+   [app.tokens :as tokens]
+   [app.worker :as-alias wrk]
    [clojure.spec.alpha :as s]
-   [clojure.tools.logging :as log]
    [cuerdas.core :as str]
    [integrant.core :as ig]
-   [jsonista.core :as j]))
+   [jsonista.core :as j]
+   [promesa.exec :as px]
+   [yetti.request :as yrq]
+   [yetti.response :as yrs]))
 
 (declare parse-json)
+(declare handle-request)
 (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]))
+  (s/keys :req [::http/client
+                ::main/props
+                ::db/pool
+                ::wrk/executor]))
 
 (defmethod ig/init-key ::handler
-  [_ cfg]
-  (fn [request]
-    (let [body  (parse-json (slurp (:body request)))
+  [_ {:keys [::wrk/executor] :as cfg}]
+  (fn [request respond _]
+    (let [data (-> request yrq/body slurp)]
+      (px/run! executor #(handle-request cfg data)))
+    (respond (yrs/response 200))))
+
+(defn handle-request
+  [cfg data]
+  (try
+    (let [body  (parse-json data)
           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}))
+          (l/info :action "subscription received" :topic stopic :url surl)
+          (http/req! cfg {:uri surl :method :post :timeout 10000} {:sync? true}))
 
         (= mtype "Notification")
         (when-let [message (parse-json (get body "Message"))]
-          ;; (log/infof "Received: %s" (pr-str message))
           (let [notification (parse-notification cfg message)]
             (process-report cfg notification)))
 
         :else
-        (log/warn (str "unexpected data received\n"
-                       (pprint-report body))))
+        (l/warn :hint "unexpected data received"
+                :report (pr-str body))))
 
-      {:status 200 :body ""})))
+    (catch Throwable cause
+      (l/error :hint "unexpected exception on awsns"
+               :cause cause))))
 
 (defn- parse-bounce
   [data]
@@ -93,10 +102,11 @@
           (get mail "headers")))
 
 (defn- extract-identity
-  [{:keys [tokens] :as cfg} headers]
+  [cfg headers]
   (let [tdata (get headers "x-penpot-data")]
     (when-not (str/empty? tdata)
-      (let [result (tokens :verify {:token tdata :iss :profile-identity})]
+      (let [sprops (::main/props cfg)
+            result (tokens/verify sprops {:token tdata :iss :profile-identity})]
         (:profile-id result)))))
 
 (defn- parse-notification
@@ -129,7 +139,7 @@
    (j/read-value v)))
 
 (defn- register-bounce-for-profile
-  [{:keys [pool]} {:keys [type kind profile-id] :as report}]
+  [{:keys [::db/pool]} {:keys [type kind profile-id] :as report}]
   (when (= kind "permanent")
     (db/with-atomic [conn pool]
       (db/insert! conn :profile-complaint-report
@@ -158,7 +168,7 @@
                       {:id profile-id}))))))
 
 (defn- register-complaint-for-profile
-  [{:keys [pool]} {:keys [type profile-id] :as report}]
+  [{:keys [::db/pool]} {:keys [type profile-id] :as report}]
   (db/with-atomic [conn pool]
     (db/insert! conn :profile-complaint-report
                 {:profile-id profile-id
@@ -184,15 +194,15 @@
 
 (defn- process-report
   [cfg {:keys [type profile-id] :as report}]
-  (log/trace (str "procesing report:\n" (pprint-report report)))
+  (l/trace :action "processing report" :report (pr-str report))
   (cond
     ;; In this case we receive a bounce/complaint notification without
     ;; confirmed identity, we just emit a warning but do nothing about
     ;; it because this is not a normal case. All notifications should
     ;; come with profile identity.
     (nil? profile-id)
-    (log/warn (str "a notification without identity recevied from AWS\n"
-                   (pprint-report report)))
+    (l/warn :msg "a notification without identity received from AWS"
+            :report (pr-str report))
 
     (= "bounce" type)
     (register-bounce-for-profile cfg report)
@@ -201,7 +211,7 @@
     (register-complaint-for-profile cfg report)
 
     :else
-    (log/warn (str "unrecognized report received from AWS\n"
-                   (pprint-report report)))))
+    (l/warn :msg "unrecognized report received from AWS"
+            :report (pr-str report))))
 
 

backend/src/app/http/client.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/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.http.client
+  "Http client abstraction layer."
+  (:require
+   [app.common.spec :as us]
+   [app.worker :as wrk]
+   [clojure.spec.alpha :as s]
+   [integrant.core :as ig]
+   [java-http-clj.core :as http])
+  (:import
+   java.net.http.HttpClient))
+
+(s/def ::client #(instance? HttpClient %))
+(s/def ::client-holder
+  (s/keys :req [::client]))
+
+(defmethod ig/pre-init-spec ::client [_]
+  (s/keys :req [::wrk/executor]))
+
+(defmethod ig/init-key ::client
+  [_ {:keys [::wrk/executor] :as cfg}]
+  (http/build-client {:executor executor
+                      :connect-timeout 30000 ;; 10s
+                      :follow-redirects :always}))
+
+(defn send!
+  ([client req] (send! client req {}))
+  ([client req {:keys [response-type sync?] :or {response-type :string sync? false}}]
+   (us/assert! ::client client)
+   (if sync?
+     (http/send req {:client client :as response-type})
+     (http/send-async req {:client client :as response-type}))))
+
+(defn req!
+  "A convencience toplevel function for gradual migration to a new API
+  convention."
+  ([{:keys [::client] :as holder} request]
+   (us/assert! ::client-holder holder)
+   (send! client request {}))
+  ([{:keys [::client] :as holder} request options]
+   (us/assert! ::client-holder holder)
+   (send! client request options)))

backend/src/app/http/debug.clj

@@ -0,0 +1,406 @@
+;; 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) KALEIDOS INC
+
+(ns app.http.debug
+  (:refer-clojure :exclude [error-handler])
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.logging :as l]
+   [app.common.pprint :as pp]
+   [app.common.uuid :as uuid]
+   [app.config :as cf]
+   [app.db :as db]
+   [app.http.middleware :as mw]
+   [app.http.session :as session]
+   [app.rpc.commands.binfile :as binf]
+   [app.rpc.commands.files.create :refer [create-file]]
+   [app.rpc.queries.profile :as profile]
+   [app.util.blob :as blob]
+   [app.util.template :as tmpl]
+   [app.util.time :as dt]
+   [app.worker :as wrk]
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [datoteka.io :as io]
+   [emoji.core :as emj]
+   [integrant.core :as ig]
+   [markdown.core :as md]
+   [markdown.transformers :as mdt]
+   [yetti.request :as yrq]
+   [yetti.response :as yrs]))
+
+;; (selmer.parser/cache-off!)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; HELPERS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn authorized?
+  [pool {:keys [profile-id]}]
+  (or (= "devenv" (cf/get :host))
+      (let [profile (ex/ignoring (profile/retrieve-profile-data pool profile-id))
+            admins  (or (cf/get :admins) #{})]
+        (contains? admins (:email profile)))))
+
+(defn prepare-response
+  [body]
+  (let [headers {"content-type" "application/transit+json"}]
+    (yrs/response :status 200 :body body :headers headers)))
+
+(defn prepare-download-response
+  [body filename]
+  (let [headers {"content-disposition" (str "attachment; filename=" filename)
+                 "content-type" "application/octet-stream"}]
+    (yrs/response :status 200 :body body :headers headers)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; INDEX
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn index-handler
+  [{:keys [pool]} request]
+  (when-not (authorized? pool request)
+    (ex/raise :type :authentication
+              :code :only-admins-allowed))
+  (yrs/response :status  200
+                :headers {"content-type" "text/html"}
+                :body    (-> (io/resource "app/templates/debug.tmpl")
+                             (tmpl/render {}))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; FILE CHANGES
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def sql:retrieve-range-of-changes
+  "select revn, changes from file_change where file_id=? and revn >= ? and revn <= ? order by revn")
+
+(def sql:retrieve-single-change
+  "select revn, changes, data from file_change where file_id=? and revn = ?")
+
+(defn- retrieve-file-data
+  [{:keys [pool]} {:keys [params profile-id] :as request}]
+  (when-not (authorized? pool request)
+    (ex/raise :type :authentication
+              :code :only-admins-allowed))
+
+  (let [file-id  (some-> params :file-id parse-uuid)
+        revn     (some-> params :revn parse-long)
+        filename (str file-id)]
+
+    (when-not file-id
+      (ex/raise :type :validation
+                :code :missing-arguments))
+
+    (let [data (if (integer? revn)
+                 (some-> (db/exec-one! pool [sql:retrieve-single-change file-id revn]) :data)
+                 (some-> (db/get-by-id pool :file file-id) :data))]
+
+      (when-not data
+        (ex/raise :type :not-found
+                  :code :enpty-data
+                  :hint "empty response"))
+      (cond
+        (contains? params :download)
+        (prepare-download-response data filename)
+
+        (contains? params :clone)
+        (let [project-id (some-> (profile/retrieve-additional-data pool profile-id) :default-project-id)
+              data       (some-> data blob/decode)]
+          (create-file pool {:id (uuid/next)
+                             :name (str "Cloned file: " filename)
+                             :project-id project-id
+                             :profile-id profile-id
+                             :data data})
+          (yrs/response 201 "OK CREATED"))
+
+        :else
+        (prepare-response (some-> data blob/decode))))))
+
+(defn- is-file-exists?
+  [pool id]
+  (let [sql "select exists (select 1 from file where id=?) as exists;"]
+    (-> (db/exec-one! pool [sql id]) :exists)))
+
+(defn- upload-file-data
+  [{:keys [pool]} {:keys [profile-id params] :as request}]
+  (let [project-id (some-> (profile/retrieve-additional-data pool profile-id) :default-project-id)
+        data       (some-> params :file :path io/read-as-bytes blob/decode)]
+
+    (if (and data project-id)
+      (let [fname      (str "Imported file *: " (dt/now))
+            overwrite? (contains? params :overwrite?)
+            file-id    (or (and overwrite? (ex/ignoring (-> params :file :filename parse-uuid)))
+                           (uuid/next))]
+
+        (if (and overwrite? file-id
+                 (is-file-exists? pool file-id))
+          (do
+            (db/update! pool :file
+                        {:data (blob/encode data)}
+                        {:id file-id})
+            (yrs/response 200 "OK UPDATED"))
+
+          (do
+            (create-file pool {:id file-id
+                               :name fname
+                               :project-id project-id
+                               :profile-id profile-id
+                               :data data})
+            (yrs/response 201 "OK CREATED"))))
+
+      (yrs/response 500 "ERROR"))))
+
+(defn file-data-handler
+  [cfg request]
+  (case (yrq/method request)
+    :get (retrieve-file-data cfg request)
+    :post (upload-file-data cfg request)
+    (ex/raise :type :http
+              :code :method-not-found)))
+
+(defn file-changes-handler
+  [{:keys [pool]} {:keys [params] :as request}]
+  (when-not (authorized? pool request)
+    (ex/raise :type :authentication
+              :code :only-admins-allowed))
+
+  (letfn [(retrieve-changes [file-id revn]
+            (if (str/includes? revn ":")
+              (let [[start end] (->> (str/split revn #":")
+                                     (map str/trim)
+                                     (map parse-long))]
+                (some->> (db/exec! pool [sql:retrieve-range-of-changes file-id start end])
+                         (map :changes)
+                         (map blob/decode)
+                         (mapcat identity)
+                         (vec)))
+
+              (if-let [revn (parse-long revn)]
+                (let [item (db/exec-one! pool [sql:retrieve-single-change file-id revn])]
+                  (some-> item :changes blob/decode vec))
+                (ex/raise :type :validation :code :invalid-arguments))))]
+
+    (let [file-id  (some-> params :id parse-uuid)
+          revn     (or (some-> params :revn parse-long) "latest")
+          filename (str file-id)]
+
+      (when (or (not file-id) (not revn))
+        (ex/raise :type :validation
+                  :code :invalid-arguments
+                  :hint "missing arguments"))
+
+      (let [data (retrieve-changes file-id revn)]
+        (if (contains? params :download)
+          (prepare-download-response data filename)
+          (prepare-response data))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ERROR BROWSER
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn error-handler
+  [{:keys [pool]} request]
+  (letfn [(parse-id [request]
+            (let [id (get-in request [:path-params :id])
+                  id (parse-uuid id)]
+              (when (uuid? id)
+                id)))
+
+          (retrieve-report [id]
+            (ex/ignoring
+             (some-> (db/get-by-id pool :server-error-report id) :content db/decode-transit-pgobject)))
+
+          (render-template [report]
+            (let [context (dissoc report
+                                  :trace :cause :params :data :spec-problems :message
+                                  :spec-explain :spec-value :error :explain :hint)
+                  params  {:context       (pp/pprint-str context :width 200)
+                           :hint          (:hint report)
+                           :spec-explain  (:spec-explain report)
+                           :spec-problems (:spec-problems report)
+                           :spec-value    (:spec-value report)
+                           :data          (:data report)
+                           :trace         (or (:trace report)
+                                              (some-> report :error :trace))
+                           :params        (:params report)}]
+              (-> (io/resource "app/templates/error-report.tmpl")
+                  (tmpl/render params))))]
+
+    (when-not (authorized? pool request)
+      (ex/raise :type :authentication
+                :code :only-admins-allowed))
+
+    (let [result (some-> (parse-id request)
+                         (retrieve-report)
+                         (render-template))]
+      (if result
+        (yrs/response :status 200
+                      :body result
+                      :headers {"content-type" "text/html; charset=utf-8"
+                                "x-robots-tag" "noindex"})
+        (yrs/response 404 "not found")))))
+
+(def sql:error-reports
+  "SELECT id, created_at,
+          content->>'~:hint' AS hint
+     FROM server_error_report
+    ORDER BY created_at DESC
+    LIMIT 100")
+
+(defn error-list-handler
+  [{:keys [pool]} request]
+  (when-not (authorized? pool request)
+    (ex/raise :type :authentication
+              :code :only-admins-allowed))
+  (let [items (->> (db/exec! pool [sql:error-reports])
+                   (map #(update % :created-at dt/format-instant :rfc1123)))]
+    (yrs/response :status 200
+                  :body (-> (io/resource "app/templates/error-list.tmpl")
+                            (tmpl/render {:items items}))
+                  :headers {"content-type" "text/html; charset=utf-8"
+                            "x-robots-tag" "noindex"})))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; EXPORT/IMPORT
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn export-handler
+  [{:keys [pool] :as cfg} {:keys [params profile-id] :as request}]
+
+  (let [file-ids (->> (:file-ids params)
+                      (remove empty?)
+                      (mapv parse-uuid))
+        libs?    (contains? params :includelibs)
+        clone?   (contains? params :clone)
+        embed?   (contains? params :embedassets)]
+
+    (when-not (seq file-ids)
+      (ex/raise :type :validation
+                :code :missing-arguments))
+
+    (let [path (-> cfg
+                   (assoc ::binf/file-ids file-ids)
+                   (assoc ::binf/embed-assets? embed?)
+                   (assoc ::binf/include-libraries? libs?)
+                   (binf/export-to-tmpfile!))]
+      (if clone?
+        (let [project-id (some-> (profile/retrieve-additional-data pool profile-id) :default-project-id)]
+          (binf/import!
+           (assoc cfg
+                  ::binf/input path
+                  ::binf/overwrite? false
+                  ::binf/ignore-index-errors? true
+                  ::binf/profile-id profile-id
+                  ::binf/project-id project-id))
+
+          (yrs/response
+           :status  200
+           :headers {"content-type" "text/plain"}
+           :body    "OK CLONED"))
+
+        (yrs/response
+         :status  200
+         :headers {"content-type" "application/octet-stream"
+                   "content-disposition" (str "attachmen; filename=" (first file-ids) ".penpot")}
+         :body    (io/input-stream path))))))
+
+
+(defn import-handler
+  [{:keys [pool] :as cfg} {:keys [params profile-id] :as request}]
+  (when-not (contains? params :file)
+    (ex/raise :type :validation
+              :code :missing-upload-file
+              :hint "missing upload file"))
+
+  (let [project-id (some-> (profile/retrieve-additional-data pool profile-id) :default-project-id)
+        overwrite? (contains? params :overwrite)
+        migrate? (contains? params :migrate)
+        ignore-index-errors? (contains? params :ignore-index-errors)]
+
+    (when-not project-id
+      (ex/raise :type :validation
+                :code :missing-project
+                :hint "project not found"))
+
+    (binf/import!
+     (assoc cfg
+            ::binf/input (-> params :file :path)
+            ::binf/overwrite? overwrite?
+            ::binf/migrate? migrate?
+            ::binf/ignore-index-errors? ignore-index-errors?
+            ::binf/profile-id profile-id
+            ::binf/project-id project-id))
+
+    (yrs/response
+     :status  200
+     :headers {"content-type" "text/plain"}
+     :body    "OK")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; OTHER SMALL VIEWS/HANDLERS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn health-handler
+  "Mainly a task that performs a health check."
+  [{:keys [pool]} _]
+  (db/with-atomic [conn pool]
+    (try
+      (db/exec-one! conn ["select count(*) as count from server_prop;"])
+      (yrs/response 200 "OK")
+      (catch Throwable cause
+        (l/warn :hint "unable to execute query on health handler"
+                :cause cause)
+        (yrs/response 503 "KO")))))
+
+(defn changelog-handler
+  [_ _]
+  (letfn [(transform-emoji [text state]
+            [(emj/emojify text) state])
+          (md->html [text]
+            (md/md-to-html-string text :replacement-transformers (into [transform-emoji] mdt/transformer-vector)))]
+    (if-let [clog (io/resource "changelog.md")]
+      (yrs/response :status 200
+                    :headers {"content-type" "text/html; charset=utf-8"}
+                    :body (-> clog slurp md->html))
+      (yrs/response :status 404 :body "NOT FOUND"))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; INIT
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def with-authorization
+  {:compile
+   (fn [& _]
+     (fn [handler pool]
+       (fn [request respond raise]
+         (if (authorized? pool request)
+           (handler request respond raise)
+           (raise (ex/error :type :authentication
+                            :code :only-admins-allowed))))))})
+
+
+(defmethod ig/pre-init-spec ::routes [_]
+  (s/keys :req-un [::db/pool ::wrk/executor ::session/session]))
+
+(defmethod ig/init-key ::routes
+  [_ {:keys [session pool executor] :as cfg}]
+  [["/readyz" {:middleware [[mw/with-dispatch executor]
+                            [mw/with-config cfg]]
+               :handler health-handler}]
+   ["/dbg" {:middleware [[session/middleware-2 session]
+                         [with-authorization pool]
+                         [mw/with-dispatch executor]
+                         [mw/with-config cfg]]}
+    ["" {:handler index-handler}]
+    ["/health" {:handler health-handler}]
+    ["/changelog" {:handler changelog-handler}]
+    ;; ["/error-by-id/:id" {:handler error-handler}]
+    ["/error/:id" {:handler error-handler}]
+    ["/error" {:handler error-list-handler}]
+    ["/file/export" {:handler export-handler}]
+    ["/file/import" {:handler import-handler}]
+    ["/file/data" {:handler file-data-handler}]
+    ["/file/changes" {:handler file-changes-handler}]]])

backend/src/app/http/errors.clj

@@ -2,39 +2,42 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.errors
   "A errors handling for the http server."
   (:require
-   [app.common.uuid :as uuid]
-   [app.util.log4j :refer [update-thread-context!]]
-   [clojure.tools.logging :as log]
+   [app.common.data :as d]
+   [app.common.exceptions :as ex]
+   [app.common.logging :as l]
+   [app.http :as-alias http]
+   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
-   [expound.alpha :as expound]))
+   [yetti.request :as yrq]
+   [yetti.response :as yrs]))
 
-(defn- explain-error
-  [error]
-  (with-out-str
-    (expound/printer (:data error))))
+(def ^:dynamic *context* {})
 
-(defn get-error-context
-  [request error]
-  (let [edata (ex-data error)]
+(defn- parse-client-ip
+  [request]
+  (or (some-> (yrq/get-header request "x-forwarded-for") (str/split ",") first)
+      (yrq/get-header request "x-real-ip")
+      (yrq/remote-addr request)))
+
+(defn get-context
+  [request]
+  (let [claims (:session-token-claims request)]
     (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)}))))
+     *context*
+     {:path          (:path request)
+      :method        (:method request)
+      :params        (:params request)
+      :ip-addr       (parse-client-ip request)}
+     (d/without-nils
+      {:user-agent (yrq/get-header request "user-agent")
+       :frontend-version (or (yrq/get-header request "x-frontend-version")
+                             "unknown")
+       :profile-id   (:uid claims)}))))
 
 (defmulti handle-exception
   (fn [err & _rest]
@@ -44,61 +47,137 @@
 
 (defmethod handle-exception :authentication
   [err _]
-  {:status 401 :body (ex-data err)})
-
+  (yrs/response 401 (ex-data err)))
 
 (defmethod handle-exception :restriction
   [err _]
-  {:status 400 :body (ex-data err)})
+  (yrs/response 400 (ex-data err)))
+
+(defmethod handle-exception :rate-limit
+  [err _]
+  (let [headers (-> err ex-data ::http/headers)]
+    (yrs/response :status 429 :body "" :headers headers)))
 
 (defmethod handle-exception :validation
-  [err req]
-  (let [header (get-in req [:headers "accept"])
-        edata  (ex-data err)]
-    (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'>"
-                  (explain-error edata)
-                  "</pre>\n")}
-      {:status 400
-       :body   (cond-> edata
-                 (map? (:data edata))
-                 (-> (assoc :explain (explain-error edata))
-                     (dissoc :data)))})))
+  [err _]
+  (let [{:keys [code] :as data} (ex-data err)]
+    (cond
+      (= code :spec-validation)
+      (let [explain (ex/explain data)]
+        (yrs/response :status 400
+                      :body   (-> data
+                                  (dissoc ::s/problems ::s/value)
+                                  (cond-> explain (assoc :explain explain)))))
+
+      (= code :request-body-too-large)
+      (yrs/response :status 413 :body data)
+
+      :else
+      (yrs/response :status 400 :body data))))
 
 (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))}}))
+  (let [edata   (ex-data error)
+        explain (ex/explain edata)]
+    (l/error :hint (ex-message error)
+             :cause error
+             ::l/context (get-context request))
+    (yrs/response :status 500
+                  :body   {:type :server-error
+                           :code :assertion
+                           :data (-> edata
+                                     (dissoc ::s/problems ::s/value ::s/spec)
+                                     (cond-> explain (assoc :explain explain)))})))
 
 (defmethod handle-exception :not-found
   [err _]
-  {:status 404 :body (ex-data err)})
+  (yrs/response 404 (ex-data err)))
+
+(defmethod handle-exception :internal
+  [error request]
+  (let [{:keys [code] :as edata} (ex-data error)]
+    (cond
+      (= :concurrency-limit-reached code)
+      (yrs/response 429)
+
+      :else
+      (do
+        (l/error :hint (ex-message error)
+                 :cause error
+                 ::l/context (get-context request))
+        (yrs/response 500 {:type :server-error
+                           :code :unhandled
+                           :hint (ex-message error)
+                           :data edata})))))
+
+(defmethod handle-exception org.postgresql.util.PSQLException
+  [error request]
+  (let [state (.getSQLState ^java.sql.SQLException error)]
+    (l/error :hint (ex-message error)
+             :cause error
+             ::l/context (get-context request))
+    (cond
+      (= state "57014")
+      (yrs/response 504 {:type :server-error
+                         :code :statement-timeout
+                         :hint (ex-message error)})
+
+      (= state "25P03")
+      (yrs/response 504 {:type :server-error
+                         :code :idle-in-transaction-timeout
+                         :hint (ex-message error)})
+
+      :else
+      (yrs/response 500 {:type :server-error
+                         :code :unexpected
+                         :hint (ex-message error)
+                         :state state}))))
 
 (defmethod handle-exception :default
   [error request]
-  (let [cdata (get-error-context request error)]
-    (update-thread-context! cdata)
-    (log/errorf error "internal error: %s (id: %s)"
-                (ex-message error)
-                (str (:id cdata)))
-    {:status 500
-     :body {:type :server-error
-            :hint (ex-message error)
-            :data (ex-data error)}}))
+  (let [edata (ex-data error)]
+    (cond
+      ;; This means that exception is not a controlled exception.
+      (nil? edata)
+      (do
+        (l/error :hint (ex-message error)
+                 :cause error
+                 ::l/context (get-context request))
+        (yrs/response 500 {:type :server-error
+                           :code :unexpected
+                           :hint (ex-message error)}))
+
+      ;; This is a special case for the idle-in-transaction error;
+      ;; when it happens, the connection is automatically closed and
+      ;; next-jdbc combines the two errors in a single ex-info. We
+      ;; only need the :handling error, because the :rollback error
+      ;; will be always "connection closed".
+      (and (ex/exception? (:rollback edata))
+           (ex/exception? (:handling edata)))
+      (handle-exception (:handling edata) request)
+
+      :else
+      (do
+        (l/error :hint (ex-message error)
+                 :cause error
+                 ::l/context (get-context request))
+        (yrs/response 500 {:type :server-error
+                           :code :unhandled
+                           :hint (ex-message error)
+                           :data edata})))))
 
 (defn handle
-  [error req]
-  (if (or (instance? java.util.concurrent.CompletionException error)
-          (instance? java.util.concurrent.ExecutionException error))
-    (handle-exception (.getCause ^Throwable error) req)
-    (handle-exception error req)))
+  [cause request]
+  (cond
+    (or (instance? java.util.concurrent.CompletionException cause)
+        (instance? java.util.concurrent.ExecutionException cause))
+    (handle-exception (.getCause ^Throwable cause) request)
+
+    (ex/wrapped? cause)
+    (let [context (meta cause)
+          cause   (deref cause)]
+      (binding [*context* context]
+        (handle-exception cause request)))
+
+    :else
+    (handle-exception cause request)))

backend/src/app/http/feedback.clj

@@ -2,10 +2,7 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2021 UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.feedback
   "A general purpose feedback module."
@@ -13,61 +10,71 @@
    [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.spec :as us]
-   [app.config :as cfg]
+   [app.config :as cf]
    [app.db :as db]
-   [app.emails :as emails]
+   [app.emails :as eml]
    [app.rpc.queries.profile :as profile]
+   [app.worker :as wrk]
    [clojure.spec.alpha :as s]
-   [integrant.core :as ig]))
+   [integrant.core :as ig]
+   [promesa.core :as p]
+   [promesa.exec :as px]
+   [yetti.request :as yrq]
+   [yetti.response :as yrs]))
 
-(declare send-feedback)
+(declare ^:private send-feedback)
+(declare ^:private handler)
 
 (defmethod ig/pre-init-spec ::handler [_]
-  (s/keys :req-un [::db/pool]))
+  (s/keys :req-un [::db/pool ::wrk/executor]))
 
 (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))]
+  [_ {:keys [executor] :as cfg}]
+  (let [enabled? (contains? cf/flags :user-feedback)]
+    (if enabled?
+      (fn [request respond raise]
+        (-> (px/submit! executor #(handler cfg request))
+            (p/then' respond)
+            (p/catch raise)))
+      (fn [_ _ raise]
+        (raise (ex/error :type :validation
+                         :code :feedback-disabled
+                         :hint "feedback module is disabled"))))))
 
-        (when-not enabled
-          (ex/raise :type :validation
-                    :code :feedback-disabled
-                    :hint "feedback module is disabled"))
+(defn- handler
+  [{:keys [pool] :as cfg} {:keys [profile-id] :as request}]
+  (let [ftoken (cf/get :feedback-token ::no-token)
+        token  (yrq/get-header request "x-feedback-token")
+        params (d/merge (:params request)
+                        (:body-params request))]
+    (cond
+      (uuid? profile-id)
+      (let [profile (profile/retrieve-profile-data pool profile-id)
+            params  (assoc params :from (:email profile))]
+        (send-feedback pool profile params))
 
-        (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 cfg nil params))
 
-          (= token ftoken)
-          (send-feedback scfg nil params))
-
-        {:status 204 :body ""}))))
+    (yrs/response 204)))
 
 (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
+(defn- send-feedback
   [pool profile params]
   (let [params      (us/conform ::feedback params)
-        destination (cfg/get :feedback-destination)
-        reply-to    (cfg/get :feedback-reply-to)]
-    (emails/send! pool emails/feedback
-                  {:to       destination
-                   :profile  profile
-                   :reply-to (:from params)
-                   :email    (:from params)
-                   :subject  (:subject params)
-                   :content  (:content params)})
+        destination (cf/get :feedback-destination)]
+    (eml/send! {::eml/conn pool
+                ::eml/factory eml/feedback
+                :from     destination
+                :to       destination
+                :profile  profile
+                :reply-to (:from params)
+                :email    (:from params)
+                :subject  (:subject params)
+                :content  (:content params)})
     nil))

backend/src/app/http/middleware.clj

@@ -2,141 +2,264 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020-2021 UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.middleware
   (:require
-   [app.metrics :as mtx]
+   [app.common.exceptions :as ex]
+   [app.common.logging :as l]
+   [app.common.transit :as t]
+   [app.config :as cf]
    [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]]))
+   [cuerdas.core :as str]
+   [promesa.core :as p]
+   [promesa.exec :as px]
+   [yetti.adapter :as yt]
+   [yetti.middleware :as ymw]
+   [yetti.request :as yrq]
+   [yetti.response :as yrs])
+  (:import
+   com.fasterxml.jackson.core.JsonParseException
+   com.fasterxml.jackson.core.io.JsonEOFException
+   io.undertow.server.RequestTooBigException
+   java.io.OutputStream))
 
-(defn wrap-server-timing
+(def server-timing
+  {:name ::server-timing
+   :compile (constantly ymw/wrap-server-timing)})
+
+(def params
+  {:name ::params
+   :compile (constantly ymw/wrap-params)})
+
+(def ^:private json-mapper
+  (json/mapper
+   {:encode-key-fn str/camel
+    :decode-key-fn (comp keyword str/kebab)
+    :pretty true}))
+
+(defn wrap-parse-request
   [handler]
-  (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)))))))))
+  (letfn [(process-request [request]
+            (let [header (yrq/get-header request "content-type")]
+              (cond
+                (str/starts-with? header "application/transit+json")
+                (with-open [is (yrq/body request)]
+                  (let [params (t/read! (t/reader is))]
+                    (-> request
+                        (assoc :body-params params)
+                        (update :params merge params))))
 
-(defn wrap-parse-request-body
+                (str/starts-with? header "application/json")
+                (with-open [is (yrq/body request)]
+                  (let [params (json/decode is json-mapper)]
+                    (-> request
+                        (assoc :body-params params)
+                        (update :params merge params))))
+
+                :else
+                request)))
+
+          (handle-error [raise cause]
+            (cond
+              (instance? RequestTooBigException cause)
+              (raise (ex/error :type :validation
+                               :code :request-body-too-large
+                               :hint (ex-message cause)))
+
+
+              (or (instance? JsonEOFException cause)
+                  (instance? JsonParseException cause))
+              (raise (ex/error :type :validation
+                               :code :malformed-json
+                               :hint (ex-message cause)
+                               :cause cause))
+              :else
+              (raise cause)))]
+
+    (fn [request respond raise]
+      (when-let [request (try
+                           (process-request request)
+                           (catch RuntimeException cause
+                             (handle-error raise (or (.getCause cause) cause)))
+                           (catch Throwable cause
+                             (handle-error raise cause)))]
+        (handler request respond raise)))))
+
+(def parse-request
+  {:name ::parse-request
+   :compile (constantly wrap-parse-request)})
+
+(defn buffered-output-stream
+  "Returns a buffered output stream that ignores flush calls. This is
+  needed because transit-java calls flush very aggresivelly on each
+  object write."
+  [^java.io.OutputStream os ^long chunk-size]
+  (proxy [java.io.BufferedOutputStream] [os (int chunk-size)]
+    ;; Explicitly do not forward flush
+    (flush [])
+    (close []
+      (proxy-super flush)
+      (proxy-super close))))
+
+(def ^:const buffer-size (:xnio/buffer-size yt/defaults))
+
+(defn wrap-format-response
   [handler]
-  (letfn [(parse-transit [body]
-            (let [reader (t/reader body)]
-              (t/read! reader)))
+  (letfn [(transit-streamable-body [data opts]
+            (reify yrs/StreamableResponseBody
+              (-write-body-to-stream [_ _ output-stream]
+                (try
+                  (with-open [bos (buffered-output-stream output-stream buffer-size)]
+                    (let [tw (t/writer bos opts)]
+                      (t/write! tw data)))
 
-          (parse-json [body]
-            (let [reader (io/reader body)]
-              (json/read reader)))
+                  (catch java.io.IOException _cause
+                    ;; Do nothing, EOF means client closes connection abruptly
+                    nil)
+                  (catch Throwable cause
+                    (l/warn :hint "unexpected error on encoding response"
+                            :cause cause))
+                  (finally
+                    (.close ^OutputStream output-stream))))))
 
-          (parse [type body]
-            (try
-              (case type
-                :json (parse-json body)
-                :transit (parse-transit body))
-              (catch Exception e
-                (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})}))))]
+          (json-streamable-body [data]
+            (reify yrs/StreamableResponseBody
+              (-write-body-to-stream [_ _ output-stream]
+                (try
 
-    (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)))
+                  (with-open [bos (buffered-output-stream output-stream buffer-size)]
+                    (json/write! bos data json-mapper))
 
-           "application/json"
-           (let [params (parse :json body)]
-             (-> request
-                 (assoc :body-params params)
-                 (update :params merge params)))
+                  (catch java.io.IOException _cause
+                    ;; Do nothing, EOF means client closes connection abruptly
+                    nil)
+                  (catch Throwable cause
+                    (l/warn :hint "unexpected error on encoding response"
+                            :cause cause))
+                  (finally
+                    (.close ^OutputStream output-stream))))))
 
-           request))))))
+          (format-response-with-json [response _]
+            (let [body (yrs/body response)]
+              (if (or (boolean? body) (coll? body))
+                (-> response
+                    (update :headers assoc "content-type" "application/json")
+                    (assoc :body (json-streamable-body body)))
+                response)))
 
-(def parse-request-body
-  {:name ::parse-request-body
-   :compile (constantly wrap-parse-request-body)})
+          (format-response-with-transit [response request]
+            (let [body (yrs/body response)]
+              (if (or (boolean? body) (coll? body))
+                (let [qs   (yrq/query request)
+                      opts (if (or (contains? cf/flags :transit-readable-response)
+                                   (str/includes? qs "transit_verbose"))
+                             {:type :json-verbose}
+                             {:type :json})]
+                  (-> response
+                      (update :headers assoc "content-type" "application/transit+json")
+                      (assoc :body (transit-streamable-body body opts))))
+                response)))
 
-(defn- impl-format-response-body
-  [response]
-  (let [body (:body response)
-        type :json-verbose]
-    (cond
-      (coll? body)
-      (-> response
-          (assoc :body (t/encode body {:type type}))
-          (update :headers assoc
-                  "content-type"
-                  "application/transit+json"))
+          (format-response [response request]
+            (let [accept (yrq/get-header request "accept")]
+              (cond
+                (or (= accept "application/transit+json")
+                    (str/includes? accept "application/transit+json"))
+                (format-response-with-transit response request)
 
-      (nil? body)
-      (assoc response :status 204 :body "")
+                (or (= accept "application/json")
+                    (str/includes? accept "application/json"))
+                (format-response-with-json response request)
 
-      :else
-      response)))
+                :else
+                (format-response-with-transit response request))))
 
-(defn- wrap-format-response-body
-  [handler]
-  (fn [request]
-    (let [response (handler request)]
-      (cond-> response
-        (map? response) (impl-format-response-body)))))
+          (process-response [response request]
+            (cond-> response
+              (map? response) (format-response request)))]
 
-(def format-response-body
-  {:name ::format-response-body
-   :compile (constantly wrap-format-response-body)})
+    (fn [request respond raise]
+      (handler request
+               (fn [response]
+                 (let [response (process-response response request)]
+                   (respond response)))
+               raise))))
+
+(def format-response
+  {:name ::format-response
+   :compile (constantly wrap-format-response)})
 
 (defn wrap-errors
   [handler on-error]
-  (fn [request]
-    (try
-      (handler request)
-      (catch Throwable e
-        (on-error e request)))))
+  (fn [request respond _]
+    (handler request respond (fn [cause]
+                               (-> cause (on-error request) respond)))))
 
 (def errors
   {:name ::errors
    :compile (constantly wrap-errors)})
 
-(def metrics
-  {:name ::metrics
-   :wrap (fn [handler]
-           (mtx/wrap-counter handler {:id "http__requests_counter"
-                                      :help "Absolute http requests counter."}))})
+(defn wrap-cors
+  [handler]
+  (if-not (contains? cf/flags :cors)
+    handler
+    (letfn [(add-headers [headers request]
+              (let [origin (yrq/get-header request "origin")]
+                (-> headers
+                    (assoc "access-control-allow-origin" origin)
+                    (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" "x-frontend-version, content-type, accept, x-requested-width"))))
 
+            (update-response [response request]
+              (update response :headers add-headers request))]
 
-(def cookies
-  {:name ::cookies
-   :compile (constantly wrap-cookies)})
+      (fn [request respond raise]
+        (if (= (yrq/method request) :options)
+          (-> (yrs/response 200)
+              (update-response request)
+              (respond))
+          (handler request
+                   (fn [response]
+                     (respond (update-response response request)))
+                   raise))))))
 
-(def params
-  {:name ::params
-   :compile (constantly wrap-params)})
+(def cors
+  {:name ::cors
+   :compile (constantly wrap-cors)})
 
-(def multipart-params
-  {:name ::multipart-params
-   :compile (constantly wrap-multipart-params)})
+(defn compile-restrict-methods
+  [data _]
+  (when-let [allowed (:allowed-methods data)]
+    (fn [handler]
+      (fn [request respond raise]
+        (let [method (yrq/method request)]
+          (if (contains? allowed method)
+            (handler request respond raise)
+            (respond (yrs/response 405))))))))
 
-(def keyword-params
-  {:name ::keyword-params
-   :compile (constantly wrap-keyword-params)})
+(def restrict-methods
+  {:name ::restrict-methods
+   :compile compile-restrict-methods})
 
-(def server-timing
-  {:name ::server-timing
-   :compile (constantly wrap-server-timing)})
+(def with-dispatch
+  {:name ::with-dispatch
+   :compile
+   (fn [& _]
+     (fn [handler executor]
+       (fn [request respond raise]
+         (-> (px/submit! executor #(handler request))
+             (p/bind p/wrap)
+             (p/then respond)
+             (p/catch raise)))))})
+
+(def with-config
+  {:name ::with-config
+   :compile
+   (fn [& _]
+     (fn [handler config]
+       (fn
+         ([request] (handler config request))
+         ([request respond raise] (handler config request respond raise)))))})

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

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

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

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

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

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

backend/src/app/http/session.clj

@@ -2,192 +2,302 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020 UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (ns app.http.session
+  (:refer-clojure :exclude [read])
   (:require
    [app.common.data :as d]
-   [app.common.exceptions :as ex]
-   [app.config :as cfg]
+   [app.common.logging :as l]
+   [app.config :as cf]
    [app.db :as db]
-   [app.metrics :as mtx]
-   [app.util.async :as aa]
-   [app.util.log4j :refer [update-thread-context!]]
+   [app.db.sql :as sql]
+   [app.tokens :as tokens]
    [app.util.time :as dt]
    [app.worker :as wrk]
-   [buddy.core.codecs :as bc]
-   [buddy.core.nonce :as bn]
-   [clojure.core.async :as a]
    [clojure.spec.alpha :as s]
-   [clojure.tools.logging :as log]
-   [integrant.core :as ig]))
+   [integrant.core :as ig]
+   [promesa.core :as p]
+   [promesa.exec :as px]
+   [yetti.request :as yrq]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; DEFAULTS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; A default cookie name for storing the session.
+(def default-auth-token-cookie-name "auth-token")
+
+;; A cookie that we can use to check from other sites of the same
+;; domain if a user is authenticated.
+(def default-authenticated-cookie-name "authenticated")
+
+;; Default value for cookie max-age
+(def default-cookie-max-age (dt/duration {:days 7}))
+
+;; Default age for automatic session renewal
+(def default-renewal-max-age (dt/duration {:hours 6}))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; PROTOCOLS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defprotocol ISessionManager
+  (read [_ key])
+  (decode [_ key])
+  (write! [_ key data])
+  (update! [_ data])
+  (delete! [_ key]))
+
+(s/def ::session #(satisfies? ISessionManager %))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; STORAGE IMPL
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn- prepare-session-params
+  [sprops data]
+  (let [profile-id (:profile-id data)
+        user-agent (:user-agent data)
+        created-at (or (:created-at data) (dt/now))
+        token      (tokens/generate sprops {:iss "authentication"
+                                            :iat created-at
+                                            :uid profile-id})]
+    {:user-agent user-agent
+     :profile-id profile-id
+     :created-at created-at
+     :updated-at created-at
+     :id token}))
+
+(defn- database-manager
+  [{:keys [pool sprops executor]}]
+  (reify ISessionManager
+    (read [_ token]
+      (px/with-dispatch executor
+        (db/exec-one! pool (sql/select :http-session {:id token}))))
+
+    (decode [_ token]
+      (px/with-dispatch executor
+        (tokens/verify sprops {:token token :iss "authentication"})))
+
+    (write! [_ _ data]
+      (px/with-dispatch executor
+        (let [params (prepare-session-params sprops data)]
+          (db/insert! pool :http-session params)
+          params)))
+
+    (update! [_ data]
+      (let [updated-at (dt/now)]
+        (px/with-dispatch executor
+          (db/update! pool :http-session
+                      {:updated-at updated-at}
+                      {:id (:id data)})
+          (assoc data :updated-at updated-at))))
+
+    (delete! [_ token]
+      (px/with-dispatch executor
+        (db/delete! pool :http-session {:id token})
+        nil))))
+
+(defn inmemory-manager
+  [{:keys [sprops executor]}]
+  (let [cache (atom {})]
+    (reify ISessionManager
+      (read [_ token]
+        (p/do (get @cache token)))
+
+      (decode [_ token]
+        (px/with-dispatch executor
+          (tokens/verify sprops {:token token :iss "authentication"})))
+
+      (write! [_ _ data]
+        (p/do
+          (let [{:keys [token] :as params} (prepare-session-params sprops data)]
+            (swap! cache assoc token params)
+            params)))
+
+      (update! [_ data]
+        (p/do
+          (let [updated-at (dt/now)]
+            (swap! cache update (:id data) assoc :updated-at updated-at)
+            (assoc data :updated-at updated-at))))
+
+      (delete! [_ token]
+        (p/do
+          (swap! cache dissoc token)
+          nil)))))
+
+(s/def ::sprops map?)
+(defmethod ig/pre-init-spec ::manager [_]
+  (s/keys :req-un [::db/pool ::wrk/executor ::sprops]))
+
+(defmethod ig/init-key ::manager
+  [_ {:keys [pool] :as cfg}]
+  (if (db/read-only? pool)
+    (inmemory-manager cfg)
+    (database-manager cfg)))
+
+(defmethod ig/halt-key! ::manager
+  [_ _])
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; MANAGER IMPL
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare assign-auth-token-cookie)
+(declare assign-authenticated-cookie)
+(declare clear-auth-token-cookie)
+(declare clear-authenticated-cookie)
+
+(defn create-fn
+  [manager profile-id]
+  (fn [request response]
+    (let [uagent  (yrq/get-header request "user-agent")
+          params  {:profile-id profile-id
+                   :user-agent uagent}]
+      (-> (write! manager nil params)
+          (p/then (fn [session]
+                    (l/trace :hint "create" :profile-id profile-id)
+                    (-> response
+                        (assign-auth-token-cookie session)
+                        (assign-authenticated-cookie session))))))))
+(defn delete-fn
+  [manager]
+  (letfn [(delete [{:keys [profile-id] :as request}]
+            (let [cname   (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
+                  cookie  (yrq/get-cookie request cname)]
+              (l/trace :hint "delete" :profile-id profile-id)
+              (some->> (:value cookie) (delete! manager))))]
+    (fn [request response]
+      (p/do
+        (delete request)
+        (-> response
+            (assoc :status 204)
+            (assoc :body nil)
+            (clear-auth-token-cookie)
+            (clear-authenticated-cookie))))))
+
+(def middleware-1
+  (letfn [(wrap-handler [manager handler request respond raise]
+            (try
+              (let [claims  (some->> (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
+                                     (yrq/get-cookie request)
+                                     (decode manager))
+                    request (cond-> request
+                              (some? claims)
+                              (assoc :session-token-claims claims))]
+                (handler request respond raise))
+              (catch Throwable _
+                (handler request respond raise))))]
+
+    {:name :session-1
+     :compile (fn [& _]
+                (fn [handler manager]
+                  (partial wrap-handler manager handler)))}))
+
+(def middleware-2
+  (letfn [(wrap-handler [manager handler request respond raise]
+            (-> (retrieve-session manager request)
+                (p/finally (fn [session cause]
+                             (cond
+                               (some? cause)
+                               (raise cause)
+
+                               (nil? session)
+                               (handler request respond raise)
+
+                               :else
+                               (let [request (-> request
+                                                 (assoc :profile-id (:profile-id session))
+                                                 (assoc :session-id (:id session)))
+                                     respond (cond-> respond
+                                               (renew-session? session)
+                                               (wrap-respond manager session))]
+                                 (handler request respond raise)))))))
+
+          (retrieve-session [manager request]
+            (let [cname  (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
+                  cookie (yrq/get-cookie request cname)]
+              (some->> (:value cookie) (read manager))))
+
+          (renew-session? [{:keys [updated-at] :as session}]
+            (and (dt/instant? updated-at)
+                 (let [elapsed (dt/diff updated-at (dt/now))]
+                   (neg? (compare default-renewal-max-age elapsed)))))
+
+          ;; Wrap respond with session renewal code
+          (wrap-respond [respond manager session]
+            (fn [response]
+              (p/let [session (update! manager session)]
+                (-> response
+                    (assign-auth-token-cookie session)
+                    (assign-authenticated-cookie session)
+                    (respond)))))]
+
+    {:name :session-2
+     :compile (fn [& _]
+                (fn [handler manager]
+                  (partial wrap-handler manager handler)))}))
 
 ;; --- IMPL
 
-(defn- next-session-id
-  ([] (next-session-id 96))
-  ([n]
-   (-> (bn/random-nonce n)
-       (bc/bytes->b64u)
-       (bc/bytes->str))))
+(defn- assign-auth-token-cookie
+  [response {token :id updated-at :updated-at}]
+  (let [max-age    (cf/get :auth-token-cookie-max-age default-cookie-max-age)
+        created-at (or updated-at (dt/now))
+        renewal    (dt/plus created-at default-renewal-max-age)
+        expires    (dt/plus created-at max-age)
+        secure?    (contains? cf/flags :secure-session-cookies)
+        cors?      (contains? cf/flags :cors)
+        name       (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
+        comment    (str "Renewal at: " (dt/format-instant renewal :rfc1123))
+        cookie     {:path "/"
+                    :http-only true
+                    :expires expires
+                    :value token
+                    :comment comment
+                    :same-site (if cors? :none :lax)
+                    :secure secure?}]
+    (update response :cookies assoc name cookie)))
 
-(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- assign-authenticated-cookie
+  [response {updated-at :updated-at}]
+  (let [max-age    (cf/get :auth-token-cookie-max-age default-cookie-max-age)
+        created-at (or updated-at (dt/now))
+        renewal    (dt/plus created-at default-renewal-max-age)
+        expires    (dt/plus created-at max-age)
+        comment    (str "Renewal at: " (dt/format-instant renewal :rfc1123))
+        secure?    (contains? cf/flags :secure-session-cookies)
+        domain     (cf/get :authenticated-cookie-domain)
+        name       (cf/get :authenticated-cookie-name "authenticated")
+        cookie     {:domain domain
+                    :expires expires
+                    :path "/"
+                    :comment comment
+                    :value true
+                    :same-site :strict
+                    :secure secure?}]
+    (cond-> response
+      (string? domain)
+      (update :cookies assoc name cookie))))
 
-(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- clear-auth-token-cookie
+  [response]
+  (let [cname (cf/get :auth-token-cookie-name default-auth-token-cookie-name)]
+    (update response :cookies assoc cname {:path "/" :value "" :max-age -1})))
 
-(defn- retrieve
-  [{:keys [conn] :as cfg} token]
-  (when token
-    (db/exec-one! conn ["select id, profile_id from http_session where id = ?" token])))
+(defn- clear-authenticated-cookie
+  [response]
+  (let [cname   (cf/get :authenticated-cookie-name default-authenticated-cookie-name)
+        domain (cf/get :authenticated-cookie-domain)]
+    (cond-> response
+      (string? domain)
+      (update :cookies assoc cname {:domain domain :path "/" :value "" :max-age -1}))))
 
-(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 [{: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))))
-
-;; --- 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
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; TASK: SESSION GC
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (declare sql:delete-expired)
 
@@ -199,20 +309,25 @@
 
 (defmethod ig/prep-key ::gc-task
   [_ cfg]
-  (merge {:max-age (dt/duration {:days 2})}
+  (merge {:max-age default-cookie-max-age}
          (d/without-nils cfg)))
 
 (defmethod ig/init-key ::gc-task
   [_ {:keys [pool max-age] :as cfg}]
+  (l/debug :hint "initializing session gc task" :max-age max-age)
   (fn [_]
     (db/with-atomic [conn pool]
       (let [interval (db/interval max-age)
-            result   (db/exec-one! conn [sql:delete-expired interval])
+            result   (db/exec-one! conn [sql:delete-expired interval interval])
             result   (:next.jdbc/update-count result)]
-        (log/debugf "gc-task: removed %s rows from http-session table" result)
+        (l/debug :task "gc"
+                 :hint "clean http sessions"
+                 :deleted result)
         result))))
 
 (def ^:private
   sql:delete-expired
   "delete from http_session
-    where updated_at < now() - ?::interval")
+    where updated_at < now() - ?::interval
+       or (updated_at is null and
+           created_at < now() - ?::interval)")

backend/src/app/http/websocket.clj

@@ -0,0 +1,351 @@
+;; 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) KALEIDOS INC
+
+(ns app.http.websocket
+  "A penpot notification service for file cooperative edition."
+  (:require
+   [app.common.exceptions :as ex]
+   [app.common.logging :as l]
+   [app.common.pprint :as pp]
+   [app.common.spec :as us]
+   [app.db :as db]
+   [app.metrics :as mtx]
+   [app.msgbus :as mbus]
+   [app.util.time :as dt]
+   [app.util.websocket :as ws]
+   [clojure.core.async :as a]
+   [clojure.spec.alpha :as s]
+   [integrant.core :as ig]
+   [yetti.websocket :as yws]))
+
+(def recv-labels
+  (into-array String ["recv"]))
+
+(def send-labels
+  (into-array String ["send"]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; WEBSOCKET HOOKS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def state (atom {}))
+
+(defn- on-connect
+  [{:keys [metrics]} wsp]
+  (let [created-at (dt/now)]
+    (swap! state assoc (::ws/id @wsp) wsp)
+    (mtx/run! metrics
+              :id :websocket-active-connections
+              :inc 1)
+    (fn []
+      (swap! state dissoc (::ws/id @wsp))
+      (mtx/run! metrics :id :websocket-active-connections :dec 1)
+      (mtx/run! metrics
+                :id :websocket-session-timing
+                :val (/ (inst-ms (dt/diff created-at (dt/now))) 1000.0)))))
+
+(defn- on-rcv-message
+  [{:keys [metrics]} _ message]
+  (mtx/run! metrics
+            :id :websocket-messages-total
+            :labels recv-labels
+            :inc 1)
+  message)
+
+(defn- on-snd-message
+  [{:keys [metrics]} _ message]
+  (mtx/run! metrics
+            :id :websocket-messages-total
+            :labels send-labels
+            :inc 1)
+  message)
+
+;; REPL HELPERS
+
+(defn repl-get-connections-for-file
+  [file-id]
+  (->> (vals @state)
+       (filter #(= file-id (-> % deref ::file-subscription :file-id)))
+       (map deref)
+       (map ::ws/id)))
+
+(defn repl-get-connections-for-team
+  [team-id]
+  (->> (vals @state)
+       (filter #(= team-id (-> % deref ::team-subscription :team-id)))
+       (map deref)
+       (map ::ws/id)))
+
+(defn repl-close-connection
+  [id]
+  (when-let [wsp (get @state id)]
+    (a/>!! (::ws/close-ch @wsp) [8899 "closed from server"])
+    (a/close! (::ws/close-ch @wsp))))
+
+(defn repl-get-connection-info
+  [id]
+  (when-let [wsp (get @state id)]
+    {:id               id
+     :created-at       (::created-at @wsp)
+     :profile-id       (::profile-id @wsp)
+     :session-id       (::session-id @wsp)
+     :user-agent       (::ws/user-agent @wsp)
+     :ip-addr          (::ws/remote-addr @wsp)
+     :last-activity-at (::ws/last-activity-at @wsp)
+     :http-session-id  (::ws/http-session-id @wsp)
+     :subscribed-file  (-> wsp deref ::file-subscription :file-id)
+     :subscribed-team  (-> wsp deref ::team-subscription :team-id)}))
+
+(defn repl-print-connection-info
+  [id]
+  (some-> id repl-get-connection-info pp/pprint))
+
+(defn repl-print-connection-info-for-file
+  [file-id]
+  (some->> (repl-get-connections-for-file file-id)
+           (map repl-get-connection-info)
+           (pp/pprint)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; WEBSOCKET HANDLER
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defmulti handle-message
+  (fn [_ _ message]
+    (:type message)))
+
+(defmethod handle-message :connect
+  [cfg wsp _]
+
+  (let [msgbus     (:msgbus cfg)
+        conn-id    (::ws/id @wsp)
+        profile-id (::profile-id @wsp)
+        session-id (::session-id @wsp)
+        output-ch  (::ws/output-ch @wsp)
+
+        xform      (remove #(= (:session-id %) session-id))
+        channel    (a/chan (a/dropping-buffer 16) xform)]
+
+    (l/trace :fn "handle-message" :event "connect" :conn-id conn-id)
+
+    ;; Subscribe to the profile channel and forward all messages to
+    ;; websocket output channel (send them to the client).
+    (swap! wsp assoc ::profile-subscription channel)
+    (a/pipe channel output-ch false)
+    (mbus/sub! msgbus :topic profile-id :chan channel)))
+
+(defmethod handle-message :disconnect
+  [cfg wsp _]
+  (let [msgbus     (:msgbus cfg)
+        conn-id    (::ws/id @wsp)
+        profile-id (::profile-id @wsp)
+        session-id (::session-id @wsp)
+        profile-ch (::profile-subscription @wsp)
+        fsub       (::file-subscription @wsp)
+        tsub       (::team-subscription @wsp)
+
+        message    {:type :disconnect
+                    :subs-id profile-id
+                    :profile-id profile-id
+                    :session-id session-id}]
+
+    (l/trace :fn "handle-message"
+             :event :disconnect
+             :conn-id conn-id)
+
+    (a/go
+      ;; Close the main profile subscription
+      (a/close! profile-ch)
+      (a/<! (mbus/purge! msgbus [profile-ch]))
+
+      ;; Close tram subscription if exists
+      (when-let [channel (:channel tsub)]
+        (a/close! channel)
+        (a/<! (mbus/purge! msgbus channel)))
+
+      (when-let [{:keys [topic channel]} fsub]
+        (a/close! channel)
+        (a/<! (mbus/purge! msgbus channel))
+        (a/<! (mbus/pub! msgbus :topic topic :message message))))))
+
+(defmethod handle-message :subscribe-team
+  [cfg wsp {:keys [team-id] :as params}]
+  (let [msgbus     (:msgbus cfg)
+        conn-id    (::ws/id @wsp)
+        session-id (::session-id @wsp)
+        output-ch  (::ws/output-ch @wsp)
+        prev-subs  (get @wsp ::team-subscription)
+        xform      (comp
+                    (remove #(= (:session-id %) session-id))
+                    (map #(assoc % :subs-id team-id)))
+
+        channel    (a/chan (a/dropping-buffer 64) xform)]
+
+    (l/trace :fn "handle-message"
+             :event :subscribe-team
+             :team-id team-id
+             :conn-id conn-id)
+
+    (a/pipe channel output-ch false)
+
+    (let [state {:team-id team-id :channel channel :topic team-id}]
+      (swap! wsp assoc ::team-subscription state))
+
+    (a/go
+      ;; Close previous subscription if exists
+      (when-let [channel (:channel prev-subs)]
+        (a/close! channel)
+        (a/<! (mbus/purge! msgbus channel))))
+
+    (a/go
+      (a/<! (mbus/sub! msgbus :topic team-id :chan channel)))))
+
+(defmethod handle-message :subscribe-file
+  [cfg wsp {:keys [file-id] :as params}]
+  (let [msgbus     (:msgbus cfg)
+        conn-id    (::ws/id @wsp)
+        profile-id (::profile-id @wsp)
+        session-id (::session-id @wsp)
+        output-ch  (::ws/output-ch @wsp)
+        prev-subs  (::file-subscription @wsp)
+        xform      (comp (remove #(= (:session-id %) session-id))
+                         (map #(assoc % :subs-id file-id)))
+        channel    (a/chan (a/dropping-buffer 64) xform)]
+
+    (l/trace :fn "handle-message"
+             :event :subscribe-file
+             :file-id file-id
+             :conn-id conn-id)
+
+    (let [state {:file-id file-id :channel channel :topic file-id}]
+      (swap! wsp assoc ::file-subscription state))
+
+    (a/go
+      ;; Close previous subscription if exists
+      (when-let [channel (:channel prev-subs)]
+        (a/close! channel)
+        (a/<! (mbus/purge! msgbus channel))))
+
+    ;; Message forwarding
+    (a/go
+      (loop []
+        (when-let [{:keys [type] :as message} (a/<! channel)]
+          (when (or (= :join-file type)
+                    (= :leave-file type)
+                    (= :disconnect type))
+            (let [message {:type :presence
+                           :file-id file-id
+                           :session-id session-id
+                           :profile-id profile-id}]
+              (a/<! (mbus/pub! msgbus :topic file-id :message message))))
+          (a/>! output-ch message)
+          (recur))))
+
+    (a/go
+      ;; Subscribe to file topic
+      (a/<! (mbus/sub! msgbus :topic file-id :chan channel))
+
+      ;; Notifify the rest of participants of the new connection.
+      (let [message {:type :join-file
+                     :file-id file-id
+                     :subs-id file-id
+                     :session-id session-id
+                     :profile-id profile-id}]
+        (a/<! (mbus/pub! msgbus :topic file-id :message message))))))
+
+(defmethod handle-message :unsubscribe-file
+  [cfg wsp {:keys [file-id] :as params}]
+  (let [msgbus     (:msgbus cfg)
+        conn-id    (::ws/id @wsp)
+        session-id (::session-id @wsp)
+        profile-id (::profile-id @wsp)
+        subs       (::file-subscription @wsp)
+
+        message    {:type :leave-file
+                    :file-id file-id
+                    :session-id session-id
+                    :profile-id profile-id}]
+
+    (l/trace :fn "handle-message"
+             :event :unsubscribe-file
+             :file-id file-id
+             :conn-id conn-id)
+
+    (a/go
+      (when (= (:file-id subs) file-id)
+        (let [channel (:channel subs)]
+          (a/close! channel)
+          (a/<! (mbus/purge! msgbus channel))
+          (a/<! (mbus/pub! msgbus :topic file-id :message message)))))))
+
+(defmethod handle-message :keepalive
+  [_ _ _]
+  (l/trace :fn "handle-message" :event :keepalive)
+  (a/go :nothing))
+
+(defmethod handle-message :pointer-update
+  [cfg wsp {:keys [file-id] :as message}]
+  (let [msgbus     (:msgbus cfg)
+        profile-id (::profile-id @wsp)
+        session-id (::session-id @wsp)
+        subs       (::file-subscription @wsp)
+        message    (-> message
+                       (assoc :subs-id file-id)
+                       (assoc :profile-id profile-id)
+                       (assoc :session-id session-id))]
+    (a/go
+      ;; Only allow receive pointer updates when active subscription
+      (when subs
+        (a/<! (mbus/pub! msgbus :topic file-id :message message))))))
+
+(defmethod handle-message :default
+  [_ wsp message]
+  (let [conn-id (::ws/id @wsp)]
+    (l/warn :hint "received unexpected message"
+            :message message
+            :conn-id conn-id)
+    (a/go :none)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; HTTP HANDLER
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(s/def ::msgbus ::mbus/msgbus)
+(s/def ::session-id ::us/uuid)
+
+(s/def ::handler-params
+  (s/keys :req-un [::session-id]))
+
+(defmethod ig/pre-init-spec ::handler [_]
+  (s/keys :req-un [::msgbus ::db/pool ::mtx/metrics]))
+
+(defmethod ig/init-key ::handler
+  [_ cfg]
+  (fn [{:keys [profile-id params] :as req} respond raise]
+    (let [{:keys [session-id]} (us/conform ::handler-params params)]
+      (cond
+        (not profile-id)
+        (raise (ex/error :type :authentication
+                         :hint "Authentication required."))
+
+        (not (yws/upgrade-request? req))
+        (raise (ex/error :type :validation
+                         :code :websocket-request-expected
+                         :hint "this endpoint only accepts websocket connections"))
+
+        :else
+        (do
+          (l/trace :hint "websocket request" :profile-id profile-id :session-id session-id)
+
+          (->> (ws/handler
+                ::ws/on-rcv-message (partial on-rcv-message cfg)
+                ::ws/on-snd-message (partial on-snd-message cfg)
+                ::ws/on-connect (partial on-connect cfg)
+                ::ws/handler (partial handle-message cfg)
+                ::profile-id profile-id
+                ::session-id session-id)
+               (yws/upgrade req)
+               (respond)))))))

backend/src/app/loggers/audit.clj

@@ -0,0 +1,322 @@
+;; 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) KALEIDOS INC
+
+(ns app.loggers.audit
+  "Services related to the user activity (audit log)."
+  (:require
+   [app.common.data :as d]
+   [app.common.exceptions :as ex]
+   [app.common.logging :as l]
+   [app.common.spec :as us]
+   [app.common.transit :as t]
+   [app.common.uuid :as uuid]
+   [app.config :as cf]
+   [app.db :as db]
+   [app.http.client :as http]
+   [app.loggers.audit.tasks :as-alias tasks]
+   [app.loggers.webhooks :as-alias webhooks]
+   [app.main :as-alias main]
+   [app.metrics :as mtx]
+   [app.tokens :as tokens]
+   [app.util.time :as dt]
+   [app.worker :as wrk]
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [integrant.core :as ig]
+   [lambdaisland.uri :as u]
+   [promesa.core :as p]
+   [promesa.exec :as px]
+   [yetti.request :as yrq]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; HELPERS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn parse-client-ip
+  [request]
+  (or (some-> (yrq/get-header request "x-forwarded-for") (str/split ",") first)
+      (yrq/get-header request "x-real-ip")
+      (some-> (yrq/remote-addr request) str)))
+
+(defn extract-utm-params
+  "Extracts additional data from params and namespace them under
+  `penpot` ns."
+  [params]
+  (letfn [(process-param [params k v]
+            (let [sk (d/name k)]
+              (cond-> params
+                (str/starts-with? sk "utm_")
+                (assoc (->> sk str/kebab (keyword "penpot")) v)
+
+                (str/starts-with? sk "mtm_")
+                (assoc (->> sk str/kebab (keyword "penpot")) v))))]
+    (reduce-kv process-param {} params)))
+
+(def ^:private
+  profile-props
+  [:id
+   :is-active
+   :is-muted
+   :auth-backend
+   :email
+   :default-team-id
+   :default-project-id
+   :fullname
+   :lang])
+
+(defn profile->props
+  [profile]
+  (-> profile
+      (select-keys profile-props)
+      (merge (:props profile))
+      (d/without-nils)))
+
+(defn clean-props
+  [{:keys [profile-id] :as event}]
+  (let [invalid-keys #{:session-id
+                       :password
+                       :old-password
+                       :token}
+        xform (comp
+               (remove (fn [kv]
+                         (qualified-keyword? (first kv))))
+               (remove (fn [kv]
+                         (contains? invalid-keys (first kv))))
+               (remove (fn [[k v]]
+                         (and (= k :profile-id)
+                              (= v profile-id))))
+               (filter (fn [[_ v]]
+                         (or (string? v)
+                             (keyword? v)
+                             (uuid? v)
+                             (boolean? v)
+                             (number? v)))))]
+
+    (update event :props #(into {} xform %))))
+
+;; --- SPECS
+
+(s/def ::profile-id ::us/uuid)
+(s/def ::name ::us/string)
+(s/def ::type ::us/string)
+(s/def ::props (s/map-of ::us/keyword any?))
+(s/def ::ip-addr ::us/string)
+
+(s/def ::webhooks/event? ::us/boolean)
+(s/def ::webhooks/batch-timeout ::dt/duration)
+(s/def ::webhooks/batch-key
+  (s/or :fn fn? :str string? :kw keyword?))
+
+(s/def ::event
+  (s/keys :req-un [::type ::name ::profile-id]
+          :opt-un [::ip-addr ::props]
+          :opt [::webhooks/event?
+                ::webhooks/batch-timeout
+                ::webhooks/batch-key]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; COLLECTOR
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Defines a service that collects the audit/activity log using
+;; internal database. Later this audit log can be transferred to
+;; an external storage and data cleared.
+
+(s/def ::collector
+  (s/keys :req [::wrk/executor ::db/pool]))
+
+(defmethod ig/pre-init-spec ::collector [_]
+  (s/keys :req [::db/pool ::wrk/executor ::mtx/metrics]))
+
+(defmethod ig/init-key ::collector
+  [_ {:keys [::db/pool] :as cfg}]
+  (cond
+    (db/read-only? pool)
+    (l/warn :hint "audit: disabled (db is read-only)")
+
+    :else
+    cfg))
+
+(defn- persist-event!
+  [pool event]
+  (us/verify! ::event event)
+  (let [params {:id (uuid/next)
+                :name (:name event)
+                :type (:type event)
+                :profile-id (:profile-id event)
+                :tracked-at (dt/now)
+                :ip-addr (:ip-addr event)
+                :props (:props event)}]
+
+    (when (contains? cf/flags :audit-log)
+      (db/insert! pool :audit-log
+                  (-> params
+                      (update :props db/tjson)
+                      (update :ip-addr db/inet)
+                      (assoc :source "backend"))))
+
+    (when (and (contains? cf/flags :webhooks)
+               (::webhooks/event? event))
+      (let [batch-key     (::webhooks/batch-key event)
+            batch-timeout (::webhooks/batch-timeout event)]
+        (wrk/submit! ::wrk/conn pool
+                     ::wrk/task :process-webhook-event
+                     ::wrk/queue :webhooks
+                     ::wrk/max-retries 0
+                     ::wrk/delay (or batch-timeout 0)
+                     ::wrk/label (cond
+                                   (fn? batch-key)        (batch-key (:props event))
+                                   (keyword? batch-key)   (name batch-key)
+                                   (string? batch-key)    batch-key
+                                   :else                  "default")
+                     ::wrk/dedupe true
+                     ::webhooks/event (-> params
+                                          (dissoc :ip-addr)
+                                          (dissoc :type)))))))
+
+(defn submit!
+  "Submit audit event to the collector."
+  [{:keys [::wrk/executor ::db/pool] :as collector} params]
+  (us/assert! ::collector collector)
+  (->> (px/submit! executor (partial persist-event! pool (d/without-nils params)))
+       (p/merr (fn [cause]
+                 (l/error :hint "audit: unexpected error processing event" :cause cause)
+                 (p/resolved nil)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; TASK: ARCHIVE
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; This is a task responsible to send the accumulated events to
+;; external service for archival.
+
+(declare archive-events)
+
+(s/def ::tasks/uri ::us/string)
+
+(defmethod ig/pre-init-spec ::tasks/archive-task [_]
+  (s/keys :req [::db/pool ::main/props ::http/client]))
+
+(defmethod ig/init-key ::tasks/archive
+  [_ cfg]
+  (fn [params]
+    ;; NOTE: this let allows overwrite default configured values from
+    ;; the repl, when manually invoking the task.
+    (let [enabled (or (contains? cf/flags :audit-log-archive)
+                      (:enabled params false))
+          uri     (cf/get :audit-log-archive-uri)
+          uri     (or uri (:uri params))
+          cfg     (assoc cfg ::uri uri)]
+
+      (when (and enabled (not uri))
+        (ex/raise :type :internal
+                  :code :task-not-configured
+                  :hint "archive task not configured, missing uri"))
+
+      (when enabled
+        (loop [total 0]
+          (let [n (archive-events cfg)]
+            (if n
+              (do
+                (px/sleep 100)
+                (recur (+ total n)))
+              (when (pos? total)
+                (l/debug :hint "events archived" :total total)))))))))
+
+(def ^:private sql:retrieve-batch-of-audit-log
+  "select *
+     from audit_log
+    where archived_at is null
+    order by created_at asc
+    limit 256
+      for update skip locked;")
+
+(defn archive-events
+  [{:keys [::db/pool ::uri] :as cfg}]
+  (letfn [(decode-row [{:keys [props ip-addr context] :as row}]
+            (cond-> row
+              (db/pgobject? props)
+              (assoc :props (db/decode-transit-pgobject props))
+
+              (db/pgobject? context)
+              (assoc :context (db/decode-transit-pgobject context))
+
+              (db/pgobject? ip-addr "inet")
+              (assoc :ip-addr (db/decode-inet ip-addr))))
+
+          (row->event [row]
+            (select-keys row [:type
+                              :name
+                              :source
+                              :created-at
+                              :tracked-at
+                              :profile-id
+                              :ip-addr
+                              :props
+                              :context]))
+
+          (send [events]
+            (let [token   (tokens/generate (::main/props cfg)
+                                           {:iss "authentication"
+                                            :iat (dt/now)
+                                            :uid uuid/zero})
+                  body    (t/encode {:events events})
+                  headers {"content-type" "application/transit+json"
+                           "origin" (cf/get :public-uri)
+                           "cookie" (u/map->query-string {:auth-token token})}
+                  params  {:uri uri
+                           :timeout 6000
+                           :method :post
+                           :headers headers
+                           :body body}
+                  resp    (http/req! cfg params {:sync? true})]
+              (if (= (:status resp) 204)
+                true
+                (do
+                  (l/error :hint "unable to archive events"
+                           :resp-status (:status resp)
+                           :resp-body (:body resp))
+                  false))))
+
+          (mark-as-archived [conn rows]
+            (db/exec-one! conn ["update audit_log set archived_at=now() where id = ANY(?)"
+                                (->> (map :id rows)
+                                     (into-array java.util.UUID)
+                                     (db/create-array conn "uuid"))]))]
+
+    (db/with-atomic [conn pool]
+      (let [rows   (db/exec! conn [sql:retrieve-batch-of-audit-log])
+            xform  (comp (map decode-row)
+                         (map row->event))
+            events (into [] xform rows)]
+        (when-not (empty? events)
+          (l/trace :hint "archive events chunk" :uri uri :events (count events))
+          (when (send events)
+            (mark-as-archived conn rows)
+            (count events)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; GC Task
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(def ^:private sql:clean-archived
+  "delete from audit_log
+    where archived_at is not null")
+
+(defn- clean-archived
+  [{:keys [pool]}]
+  (let [result (db/exec-one! pool [sql:clean-archived])
+        result (:next.jdbc/update-count result)]
+    (l/debug :hint "delete archived audit log entries" :deleted result)
+    result))
+
+(defmethod ig/pre-init-spec ::tasks/gc [_]
+  (s/keys :req [::db/pool]))
+
+(defmethod ig/init-key ::tasks/gc
+  [_ cfg]
+  (fn [_]
+    (clean-archived cfg)))

backend/src/app/loggers/database.clj

@@ -0,0 +1,93 @@
+;; 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) KALEIDOS INC
+
+(ns app.loggers.database
+  "A specific logger impl that persists errors on the database."
+  (:require
+   [app.common.logging :as l]
+   [app.common.uuid :as uuid]
+   [app.config :as cf]
+   [app.db :as db]
+   [app.util.async :as aa]
+   [app.worker :as wrk]
+   [clojure.core.async :as a]
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [integrant.core :as ig]))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Error Listener
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(declare handle-event)
+
+(defonce enabled (atom true))
+
+(defn- persist-on-database!
+  [{:keys [pool] :as cfg} {:keys [id] :as event}]
+  (when-not (db/read-only? pool)
+    (db/insert! pool :server-error-report {:id id :content (db/tjson event)})))
+
+(defn- parse-event-data
+  [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)))
+   {}
+   event))
+
+(defn parse-event
+  [event]
+  (-> (parse-event-data event)
+      (assoc :hint (or (:hint event) (:message event)))
+      (assoc :tenant (cf/get :tenant))
+      (assoc :host (cf/get :host))
+      (assoc :public-uri (cf/get :public-uri))
+      (assoc :version (:full cf/version))
+      (update :id #(or % (uuid/next)))))
+
+(defn handle-event
+  [{:keys [executor] :as cfg} event]
+  (aa/with-thread executor
+    (try
+      (let [event (parse-event event)
+            uri   (cf/get :public-uri)]
+
+        (l/debug :hint "registering error on database" :id (:id event)
+                 :uri (str uri "/dbg/error/" (:id event)))
+
+        (persist-on-database! cfg event))
+      (catch Exception cause
+        (l/warn :hint "unexpected exception on database error logger" :cause cause)))))
+
+(defmethod ig/pre-init-spec ::reporter [_]
+  (s/keys :req-un [::wrk/executor ::db/pool ::receiver]))
+
+(defn error-event?
+  [event]
+  (= "error" (:logger/level event)))
+
+(defmethod ig/init-key ::reporter
+  [_ {:keys [receiver] :as cfg}]
+  (l/info :msg "initializing database error persistence")
+  (let [output (a/chan (a/sliding-buffer 5) (filter error-event?))]
+    (receiver :sub output)
+    (a/go-loop []
+      (let [msg (a/<! output)]
+        (if (nil? msg)
+          (l/info :msg "stopping error reporting loop")
+          (do
+            (a/<! (handle-event cfg msg))
+            (recur)))))
+    output))
+
+(defmethod ig/halt-key! ::reporter
+  [_ output]
+  (a/close! output))

backend/src/app/loggers/loki.clj

@@ -2,91 +2,88 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020-2021 UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (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.common.logging :as l]
+   [app.config :as cf]
+   [app.http.client :as http]
+   [app.loggers.zmq :as lzmq]
    [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]))
+   [integrant.core :as ig]
+   [promesa.exec :as px]))
 
-(declare handle-event)
-
-(s/def ::uri ::us/string)
-(s/def ::receiver fn?)
+(declare ^:private handle-event)
 
 (defmethod ig/pre-init-spec ::reporter [_]
-  (s/keys :req-un [::wrk/executor ::receiver]
-          :opt-un [::uri]))
+  (s/keys :req [::http/client
+                ::lzmq/receiver]))
 
 (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)))
+  [_ cfg]
+  (when-let [uri (cf/get :loggers-loki-uri)]
+    (px/thread
+      {:name "penpot/loki-reporter"}
+      (l/info :hint "reporter started" :uri uri)
+      (let [input (a/chan (a/dropping-buffer 2048))
+            cfg   (assoc cfg ::uri uri)]
+
+        (try
+          (lzmq/sub! (::lzmq/receiver cfg) input)
+          (loop []
+            (when-let [msg (a/<!! input)]
+              (handle-event cfg msg)
+              (recur)))
+
+          (catch InterruptedException _
+            (l/debug :hint "reporter interrupted"))
+          (catch Throwable cause
+            (l/error :hint "unexpected exception"
+                     :cause cause))
+          (finally
+            (a/close! input)
+            (l/info :hint "reporter terminated")))))))
 
 (defmethod ig/halt-key! ::reporter
-  [_ output]
-  (when output
-    (a/close! output)))
+  [_ thread]
+  (some-> thread px/interrupt!))
 
 (defn- prepare-payload
   [event]
-  (let [labels {:host    (cfg/get :host)
-                :tenant  (cfg/get :tenant)
-                :version (:full cfg/version)
-                :logger  (:logger event)
-                :level   (:level event)}]
+  (let [labels {:host    (cf/get :host)
+                :tenant  (cf/get :tenant)
+                :version (:full cf/version)
+                :logger  (:logger/name event)
+                :level   (:logger/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))))]]}]}))
+                      (when-let [error (:trace event)]
+                        (str "\n" 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- make-request
+  [{:keys [::uri] :as cfg} payload]
+  (http/req! cfg
+             {:uri uri
+              :timeout 3000
+              :method :post
+              :headers {"content-type" "application/json"}
+              :body (json/encode payload)}
+             {:sync? true}))
 
 (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)))))))
-
+  [cfg event]
+  (try
+    (let [payload  (prepare-payload event)
+          response (make-request cfg payload)]
+      (when-not (= 204 (:status response))
+        (l/error :hint "error on sending log to loki (unexpected response)"
+                 :response (pr-str response))))
+    (catch Throwable cause
+      (l/error :hint "error on sending log to loki (unexpected exception)"
+               :cause cause))))

backend/src/app/loggers/mattermost.clj

@@ -2,153 +2,76 @@
 ;; License, v. 2.0. If a copy of the MPL was not distributed with this
 ;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
 ;;
-;; This Source Code Form is "Incompatible With Secondary Licenses", as
-;; defined by the Mozilla Public License, v. 2.0.
-;;
-;; Copyright (c) 2020-2021 UXBOX Labs SL
+;; Copyright (c) KALEIDOS INC
 
 (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.common.logging :as l]
+   [app.config :as cf]
+   [app.http.client :as http]
+   [app.loggers.database :as ldb]
+   [app.loggers.zmq :as lzmq]
    [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]))
+   [integrant.core :as ig]
+   [promesa.exec :as px]))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; 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))
+(defonce enabled (atom true))
 
 (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))))
+  [cfg {:keys [host id public-uri] :as event}]
+  (let [text (str "Exception on (host: " host ", url: " public-uri "/dbg/error/" id ")\n"
+             (when-let [pid (:profile-id event)]
+               (str "- profile-id: #uuid-" pid "\n")))
+        resp (http/req! cfg
+                        {:uri (cf/get :error-report-webhook)
+                         :method :post
+                         :headers {"content-type" "application/json"}
+                         :body (json/encode-str {:text text})}
+                        {:sync? true})]
 
-    (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))))
+    (when (not= 200 (:status resp))
+      (l/warn :hint "error on sending data"
+              :response (pr-str resp)))))
 
 (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")))))
+  [cfg event]
+  (try
+    (let [event (ldb/parse-event event)]
+      (when @enabled
+        (send-mattermost-notification! cfg event)))
+    (catch Throwable cause
+      (l/warn :hint "unhandled error"
+              :cause cause))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Http Handler
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defmethod ig/pre-init-spec ::reporter [_]
+  (s/keys :req [::http/client
+                ::lzmq/receiver]))
 
-(defmethod ig/pre-init-spec ::handler [_]
-  (s/keys :req-un [::db/pool]))
+(defmethod ig/init-key ::reporter
+  [_ cfg]
+  (when-let [uri (cf/get :error-report-webhook)]
+    (px/thread
+      {:name "penpot/mattermost-reporter"}
+      (l/info :msg "initializing error reporter" :uri uri)
+      (let [input (a/chan (a/sliding-buffer 128)
+                          (filter #(= (:logger/level %) "error")))]
+        (try
+          (lzmq/sub! (::lzmq/receiver cfg) input)
+          (loop []
+            (when-let [msg (a/<!! input)]
+              (handle-event cfg msg)
+              (recur)))
+          (catch InterruptedException _
+            (l/debug :hint "reporter interrupted"))
+          (catch Throwable cause
+            (l/error :hint "unexpected error" :cause cause))
+          (finally
+            (a/close! input)
+            (l/info :hint "reporter terminated")))))))
 
-(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"})))))
+(defmethod ig/halt-key! ::reporter
+  [_ thread]
+  (some-> thread px/interrupt!))

backend/src/app/loggers/webhooks.clj

@@ -0,0 +1,174 @@
+;; 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) KALEIDOS INC
+
+(ns app.loggers.webhooks
+  "A mattermost integration for error reporting."
+  (:require
+   [app.common.data :as d]
+   [app.common.logging :as l]
+   [app.common.transit :as t]
+   [app.common.uri :as uri]
+   [app.config :as cf]
+   [app.db :as db]
+   [app.http.client :as http]
+   [app.util.json :as json]
+   [app.util.time :as dt]
+   [app.worker :as wrk]
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [integrant.core :as ig]))
+
+;; --- PROC
+
+(defn- lookup-webhooks-by-team
+  [pool team-id]
+  (db/exec! pool ["select * from webhook where team_id=? and is_active=true" team-id]))
+
+(defn- lookup-webhooks-by-project
+  [pool project-id]
+  (let [sql [(str "select * from webhook as w"
+                  "  join project as p on (p.team_id = w.team_id)"
+                  " where p.id = ? and w.is_active = true")
+             project-id]]
+    (db/exec! pool sql)))
+
+(defn- lookup-webhooks-by-file
+  [pool file-id]
+  (let [sql [(str "select * from webhook as w"
+                  "  join project as p on (p.team_id = w.team_id)"
+                  "  join file as f on (f.project_id = p.id)"
+                  " where f.id = ? and w.is_active = true")
+             file-id]]
+    (db/exec! pool sql)))
+
+(defn- lookup-webhooks
+  [{:keys [::db/pool]} {:keys [props] :as event}]
+  (or (some->> (:team-id props) (lookup-webhooks-by-team pool))
+      (some->> (:project-id props) (lookup-webhooks-by-project pool))
+      (some->> (:file-id props) (lookup-webhooks-by-file pool))))
+
+(defmethod ig/pre-init-spec ::process-event-handler [_]
+  (s/keys :req [::db/pool]))
+
+(defmethod ig/init-key ::process-event-handler
+  [_ {:keys [::db/pool] :as cfg}]
+  (fn [{:keys [props] :as task}]
+    (let [event (::event props)]
+
+      (l/debug :hint "process webhook event"
+               :name (:name event))
+
+      (when-let [items (lookup-webhooks cfg event)]
+        ;; (app.common.pprint/pprint items)
+        (l/trace :hint "webhooks found for event" :total (count items))
+
+        (db/with-atomic [conn pool]
+          (doseq [item items]
+            (wrk/submit! ::wrk/conn conn
+                         ::wrk/task :run-webhook
+                         ::wrk/queue :webhooks
+                         ::wrk/max-retries 3
+                         ::event event
+                         ::config item)))))))
+
+;; --- RUN
+
+(declare interpret-exception)
+(declare interpret-response)
+
+(def ^:private json-mapper
+  (json/mapper
+   {:encode-key-fn str/camel
+    :decode-key-fn (comp keyword str/kebab)
+    :pretty true}))
+
+(defmethod ig/pre-init-spec ::run-webhook-handler [_]
+  (s/keys :req [::http/client ::db/pool]))
+
+(defmethod ig/prep-key ::run-webhook-handler
+  [_ cfg]
+  (merge {::max-errors 3} (d/without-nils cfg)))
+
+(defmethod ig/init-key ::run-webhook-handler
+  [_ {:keys [::db/pool ::max-errors] :as cfg}]
+  (letfn [(update-webhook! [whook err]
+            (if err
+              (let [sql [(str "update webhook "
+                              "   set error_code=?, "
+                              "       error_count=error_count+1 "
+                              " where id=?")
+                         err
+                         (:id whook)]
+                    res (db/exec-one! pool sql {:return-keys true})]
+                (when (>= (:error-count res) max-errors)
+                  (db/update! pool :webhook {:is-active false} {:id (:id whook)})))
+
+              (db/update! pool :webhook
+                          {:updated-at (dt/now)
+                           :error-code nil
+                           :error-count 0}
+                          {:id (:id whook)})))
+
+          (report-delivery! [whook req rsp err]
+            (db/insert! pool :webhook-delivery
+                        {:webhook-id (:id whook)
+                         :created-at (dt/now)
+                         :error-code err
+                         :req-data (db/tjson req)
+                         :rsp-data (db/tjson rsp)}))]
+
+    (fn [{:keys [props] :as task}]
+      (let [event (::event props)
+            whook (::config props)
+
+            body  (case (:mtype whook)
+                    "application/json" (json/encode-str event json-mapper)
+                    "application/transit+json" (t/encode-str event)
+                    "application/x-www-form-urlencoded" (uri/map->query-string event))]
+
+        (l/debug :hint "run webhook"
+                 :event-name (:name event)
+                 :webhook-id (:id whook)
+                 :webhook-uri (:uri whook)
+                 :webhook-mtype (:mtype whook))
+
+        (let [req {:uri (:uri whook)
+                   :headers {"content-type" (:mtype whook)
+                             "user-agent" (str/ffmt "penpot/%" (:main cf/version))}
+                   :timeout (dt/duration "4s")
+                   :method :post
+                   :body body}]
+          (try
+            (let [rsp (http/req! cfg req {:response-type :input-stream :sync? true})
+                  err (interpret-response rsp)]
+              (report-delivery! whook req rsp err)
+              (update-webhook! whook err))
+            (catch Throwable cause
+              (let [err (interpret-exception cause)]
+                (report-delivery! whook req nil err)
+                (update-webhook! whook err)
+                (when (= err "unknown")
+                  (l/error :hint "unknown error on webhook request"
+                           :cause cause))))))))))
+
+(defn interpret-response
+  [{:keys [status] :as response}]
+  (when-not (or (= 200 status)
+                (= 204 status))
+    (str/ffmt "unexpected-status:%" status)))
+
+(defn interpret-exception
+  [cause]
+  (cond
+    (instance? javax.net.ssl.SSLHandshakeException cause)
+    "ssl-validation-error"
+
+    (instance? java.net.ConnectException cause)
+    "connection-error"
+
+    (instance? java.net.http.HttpConnectTimeoutException cause)
+    "timeout"
+    ))