Merge pull request #241 from tokens-studio/sync-master

Sync penpot master

.circleci/config.yml

@@ -58,6 +58,7 @@ jobs:
           command: |
             yarn install
             yarn run fmt:clj:check
+            yarn run fmt:js:check
 
       - run:
           name: "common linter check"
@@ -107,8 +108,8 @@ jobs:
           working_directory: "./frontend"
           command: |
             yarn install
-            yarn run compile
+            yarn run build:app:assets
-            yarn run compile:cljs
+            clojure -M:dev:shadow-cljs release main
             yarn playwright install --with-deps chromium
             yarn e2e:test
 
@@ -128,4 +129,3 @@ jobs:
           paths:
             - ~/.m2
           key: v1-dependencies-{{ checksum "backend/deps.edn" }}-{{ checksum "frontend/deps.edn"}}-{{ checksum "common/deps.edn"}}
-

.clj-kondo/config.edn

@@ -3,7 +3,6 @@
   promesa.core/->> clojure.core/->>
   promesa.core/-> clojure.core/->
   promesa.exec.csp/go-loop clojure.core/loop
-  rumext.v2/defc clojure.core/defn
   promesa.util/with-open clojure.core/with-open
   app.common.schema.generators/let clojure.core/let
   app.common.data/export clojure.core/def
@@ -20,6 +19,7 @@
    app.db/with-atomic hooks.export/penpot-with-atomic
    potok.v2.core/reify hooks.export/potok-reify
    rumext.v2/fnc hooks.export/rumext-fnc
+   rumext.v2/defc hooks.export/rumext-defc
    rumext.v2/lazy-component hooks.export/rumext-lazycomponent
    shadow.lazy/loadable hooks.export/rumext-lazycomponent
    }}

.clj-kondo/hooks/export.clj

@@ -12,6 +12,7 @@
 
 (def registry (atom {}))
 
+
 (defn potok-reify
   [{:keys [:node :filename] :as params}]
   (let [[rnode rtype & other] (:children node)
@@ -66,12 +67,86 @@
   (let [[cname mdata params & body] (rest (:children node))
         [params body] (if (api/vector-node? mdata)
                         [mdata (cons params body)]
-                        [params body])]
+                        [params body])
-    (let [result (api/list-node
+
-                  (into [(api/token-node 'fn)
+        result (api/list-node
-                         params]
+                (into [(api/token-node 'fn) params]
                       (cons mdata body)))]
-      {:node result})))
+
+    {:node result}))
+
+
+(defn- parse-defc
+  [{:keys [children] :as node}]
+  (let [args (rest children)
+
+        [cname args]
+        (if (api/token-node? (first args))
+          [(first args) (rest args)]
+          (throw (ex-info "unexpected1" {})))
+
+        [docs args]
+        (if (api/string-node? (first args))
+          [(first args) (rest args)]
+          ["" args])
+
+        [mdata args]
+        (if (api/map-node? (first args))
+          [(first args) (rest args)]
+          [(api/map-node []) args])
+
+        [params body]
+        (if (api/vector-node? (first args))
+          [(first args) (rest args)]
+          (throw (ex-info "unexpected2" {})))]
+
+    [cname docs mdata params body]))
+
+(defn rumext-defc
+  [{:keys [node]}]
+  (let [[cname docs mdata params body] (parse-defc node)
+
+        param1        (first (:children params))
+        paramN        (rest (:children params))
+
+        param1        (if (api/map-node? param1)
+                        (let [param1    (into {} (comp
+                                                  (partition-all 2)
+                                                  (map (fn [[k v]]
+                                                         [(if (api/keyword-node? k)
+                                                            (:k k)
+                                                            k)
+                                                          (if (api/vector-node? v)
+                                                            (vec (:children v))
+                                                            v)])))
+                                              (:children param1))
+
+                              binding   (:rest param1)
+                              param1    (if binding
+                                          (if (contains? param1 :as)
+                                            (update param1 :keys (fnil conj []) binding)
+                                            (assoc param1 :as binding))
+                                          param1)]
+                          (->> (dissoc param1 :rest)
+                               (mapcat (fn [[k v]]
+                                         [(if (keyword? k)
+                                            (api/keyword-node k)
+                                            k)
+                                          (if (vector? v)
+                                            (api/vector-node v)
+                                            v)]))
+                               (api/map-node)))
+                        param1)
+
+        result (api/list-node
+                (into [(api/token-node 'defn)
+                       cname
+                       (api/vector-node (filter some? (cons param1 paramN)))]
+                      (cons mdata body)))]
+
+    ;; (prn (api/sexpr result))
+
+    {:node result}))
 
 
 (defn rumext-lazycomponent

.cljfmt.edn

@@ -4,6 +4,7 @@
  :remove-consecutive-blank-lines? false
  :extra-indents {rumext.v2/fnc [[:inner 0]]
                  cljs.test/async [[:inner 0]]
+                 app.common.schema/register! [[:inner 0] [:inner 1]]
                  promesa.exec/thread [[:inner 0]]
                  specify! [[:inner 0] [:inner 1]]}
  }

.gitignore

@@ -48,6 +48,8 @@
 /deploy
 /docker/images/bundle*
 /exporter/target
+/frontend/.storybook/preview-body.html
+/frontend/.storybook/preview-head.html
 /frontend/cypress/fixtures/validuser.json
 /frontend/cypress/videos/*/
 /frontend/cypress/videos/*/
@@ -68,7 +70,6 @@
 /web
 clj-profiler/
 node_modules
-frontend/.storybook/preview-body.html
 /test-results/
 /playwright-report/
 /blob-report/

CHANGES.md

@@ -1,6 +1,6 @@
 # CHANGELOG
 
-## 2.1.0
+## 2.2.0
 
 ### :rocket: Epics and highlights
 
@@ -9,18 +9,87 @@
 ### :heart: Community contributions (Thank you!)
 
 ### :sparkles: New features
-- Improve auth process [Taiga #Change Auth Process](https://tree.taiga.io/project/penpot/us/7094)
 
 ### :bug: Bugs fixed
 
+- Fix components are not dragged from the group to the assets tab [Taiga #8273](https://tree.taiga.io/project/penpot/issue/8273)
+
+## 2.1.1
+
+### :sparkles: New features
+
+- Consolidate templates new order and naming  [Taiga #8392](https://tree.taiga.io/project/penpot/task/8392)
+
+### :bug: Bugs fixed
+
+- Fix the “search” label in translations [Taiga #8402](https://tree.taiga.io/project/penpot/issue/8402)
+- Fix pencil loader [Taiga #8348](https://tree.taiga.io/project/penpot/issue/8348)
+- Fix several issues on the OIDC.
+- Fix regression on the `email-verification` flag [Taiga #8398](https://tree.taiga.io/project/penpot/issue/8398)
+
+## 2.1.0 - Things can only get better!
+
+### :rocket: Epics and highlights
+
+### :boom: Breaking changes & Deprecations
+
+### :heart: Community contributions (Thank you!)
+
+### :sparkles: New features
+
+- Improve auth process [Taiga #7094](https://tree.taiga.io/project/penpot/us/7094)
+- Add locking degrees increment (hold shift) on path edition [Taiga #7761](https://tree.taiga.io/project/penpot/issue/7761)
+- Persistence & Concurrent Edition Enhancements [Taiga #5657](https://tree.taiga.io/project/penpot/us/5657)
+- Allow library colors as recent colors [Taiga #7640](https://tree.taiga.io/project/penpot/issue/7640)
+- Missing scroll in viewmode comments [Taiga #7427](https://tree.taiga.io/project/penpot/issue/7427)
+- Comments in View mode should mimic the positioning behavior of the Workspace [Taiga #7346](https://tree.taiga.io/project/penpot/issue/7346)
+- Misaligned input on comments [Taiga #7461](https://tree.taiga.io/project/penpot/issue/7461)
+
+### :bug: Bugs fixed
+
+- Fix selection rectangle appears on scroll [Taiga #7525](https://tree.taiga.io/project/penpot/issue/7525)
+- Fix layer tree not expanding to the bottom edge [Taiga #7466](https://tree.taiga.io/project/penpot/issue/7466)
+- Fix guides move when board is moved by inputs [Taiga #8010](https://tree.taiga.io/project/penpot/issue/8010)
+- Fix clickable area of Penptot logo in the viewer [Taiga #7988](https://tree.taiga.io/project/penpot/issue/7988)
+- Fix constraints dropdown when selecting multiple shapes [Taiga #7686](https://tree.taiga.io/project/penpot/issue/7686)
+- Layout and scrollign fixes for the bottom palette [Taiga #7559](https://tree.taiga.io/project/penpot/issue/7559)
+- Fix expand libraries when search results are present [Taiga #7876](https://tree.taiga.io/project/penpot/issue/7876)
+- Fix color palette default library [Taiga #8029](https://tree.taiga.io/project/penpot/issue/8029)
+- Component Library is lost after exporting/importing in .zip format [Github #4672](https://github.com/penpot/penpot/issues/4672)
+- Fix problem with moving+selection not working properly [Taiga #7943](https://tree.taiga.io/project/penpot/issue/7943)
+- Fix problem with flex layout fit to content not positioning correctly children [Taiga #7537](https://tree.taiga.io/project/penpot/issue/7537)
+- Fix black line is displaying after show main [Taiga #7653](https://tree.taiga.io/project/penpot/issue/7653)
+- Fix "Share prototypes" modal remains open [Taiga #7442](https://tree.taiga.io/project/penpot/issue/7442)
+- Fix "Components visibility and opacity" [#4694](https://github.com/penpot/penpot/issues/4694)
+- Fix "Attribute overrides in copies are not exported in zip file" [Taiga #8072](https://tree.taiga.io/project/penpot/issue/8072)
+- Fix group not automatically selected in the Layers panel after creation [Taiga #8078](https://tree.taiga.io/project/penpot/issue/8078)
+- Fix export boards loses opacity [Taiga #7592](https://tree.taiga.io/project/penpot/issue/7592)
+- Fix change color on imported svg also changes the stroke alignment[Taiga #7673](https://github.com/penpot/penpot/pull/7673)
+- Fix show in view mode and interactions workflow [Taiga #4711](https://github.com/penpot/penpot/pull/4711)
+- Fix internal error when I set up a stroke for some objects without and with stroke [Taiga #7558](https://tree.taiga.io/project/penpot/issue/7558)
+- Toolbar keeps toggling on and off on spacebar press [Taiga #7654](https://github.com/penpot/penpot/pull/7654)
+- Fix toolbar keeps hiding when click outside workspace [Taiga #7776](https://tree.taiga.io/project/penpot/issue/7776)
+- Fix open overlay relative to a frame [Taiga #7563](https://tree.taiga.io/project/penpot/issue/7563)
+- Workspace-palette items stay hidden when opening with keyboard-shortcut [Taiga #7489](https://tree.taiga.io/project/penpot/issue/7489)
+- Fix SVG attrs are not handled correctly when exporting/importing in .zip [Taiga #7920](https://tree.taiga.io/project/penpot/issue/7920)
+- Fix validation error when detaching with two nested copies and a swap [Taiga #8095](https://tree.taiga.io/project/penpot/issue/8095)
+- Export shapes that are rotated act a bit strange when reimported [Taiga #7585](https://tree.taiga.io/project/penpot/issue/7585)
+- Penpot crashes when a new colorpicker is created while uploading an image to another instance [Taiga #8119](https://tree.taiga.io/project/penpot/issue/8119)
+- Removing Underline and Strikethrough Affects the Previous Text Object [Taiga #8103](https://tree.taiga.io/project/penpot/issue/8103)
+- Color library loses association with shapes when exporting/importing the document [Taiga #8132](https://tree.taiga.io/project/penpot/issue/8132)
+- Fix can't collapse groups when searching in the assets tab [Taiga #8125](https://tree.taiga.io/project/penpot/issue/8125)
+- Fix 'Detach instance' shortcut is not working [Taiga #8102](https://tree.taiga.io/project/penpot/issue/8102)
+- Fix import file message does not detect 0 as error [Taiga #6824](https://tree.taiga.io/project/penpot/issue/6824)
+- Image Color Library is not persisted when exporting/importing in .zip [Taiga #8131](https://tree.taiga.io/project/penpot/issue/8131)
+- Fix export files including libraries [Taiga #8266](https://tree.taiga.io/project/penpot/issue/8266)
+
 ## 2.0.3
 
 ### :bug: Bugs fixed
 
-- Fix chrome scrollbar styling [Taiga Issue #7852](https://tree.taiga.io/project/penpot/issue/7852)
+- Fix chrome scrollbar styling [Taiga #7852](https://tree.taiga.io/project/penpot/issue/7852)
 - Fix incorrect password encoding on create-profile manage scritp [Github #3651](https://github.com/penpot/penpot/issues/3651)
 
-
 ## 2.0.2
 
 ### :sparkles: Enhancements
@@ -30,7 +99,7 @@
 
 ### :bug: Bugs fixed
 
-- Fix color palette sorting [Taiga Issue #7458](https://tree.taiga.io/project/penpot/issue/7458)
+- Fix color palette sorting [Taiga #7458](https://tree.taiga.io/project/penpot/issue/7458)
 - Fix style scoping problem with imported SVG [Taiga #7671](https://tree.taiga.io/project/penpot/issue/7671)
 
 
@@ -175,7 +244,7 @@
 - Fix problem when changing typography assets [Github #3683](https://github.com/penpot/penpot/issues/3683)
 - Internal error when you copy and paste some main components between files [Taiga #7397](https://tree.taiga.io/project/penpot/issue/7397)
 - Fix toolbar disappearing [Taiga #7411](https://tree.taiga.io/project/penpot/issue/7411)
-- Fix long text on tab breaks UI [Taiga Issue #7421](https://tree.taiga.io/project/penpot/issue/7421)
+- Fix long text on tab breaks UI [Taiga #7421](https://tree.taiga.io/project/penpot/issue/7421)
 
 ## 1.19.5
 

README.md

@@ -50,6 +50,7 @@ Penpot’s latest [huge release 2.0](https://penpot.app/dev-diaries), takes the
 - [Why Penpot](#why-penpot)
 - [Getting Started](#getting-started)
 - [Community](#community)
+- [Contributing](#contributing)
 - [Resources](#resources)
 - [License](#license)
 

THANKYOU.md

@@ -2,12 +2,19 @@
 
 We want to thank to the amazing people that help us! Thank you! You're the best!
 
+Feel free you make a PR updating this file if you miss you in the
+list.
+
 ## Security
+
 * Husnain Iqbal (CEO OF ALPHA INFERNO PVT LTD)
 * [Shiraz Ali Khan](https://www.linkedin.com/in/shiraz-ali-khan-1ba508180/)
 * Vaibhav Shukla
+* Hassan Ahmed (Alias Xen Lee)
+* Michal Biesiada (@mbiesiad)
 
 ## Internationalization
+
 * [00ff88](https://hosted.weblate.org/user/00ff88)
 * [AhmadHB](https://hosted.weblate.org/user/AhmadHB)
 * [Aimee](https://hosted.weblate.org/user/Aimee)
@@ -89,6 +96,7 @@ We want to thank to the amazing people that help us! Thank you! You're the best!
 * [zcraber](https://hosted.weblate.org/user/zcraber)
 
 ## Libraries & templates
+
 * systxema
 * plumilla
 * victor crespo

backend/deps.edn

@@ -3,10 +3,10 @@
 
  :deps
  {penpot/common {:local/root "../common"}
-  org.clojure/clojure {:mvn/version "1.12.0-alpha9"}
+  org.clojure/clojure {:mvn/version "1.12.0-alpha12"}
   org.clojure/tools.namespace {:mvn/version "1.5.0"}
 
-  com.github.luben/zstd-jni {:mvn/version "1.5.5-11"}
+  com.github.luben/zstd-jni {:mvn/version "1.5.6-3"}
 
   io.prometheus/simpleclient {:mvn/version "0.16.0"}
   io.prometheus/simpleclient_hotspot {:mvn/version "0.16.0"}
@@ -26,13 +26,13 @@
    :git/url "https://github.com/funcool/yetti.git"
    :exclusions [org.slf4j/slf4j-api]}
 
-  com.github.seancorfield/next.jdbc {:mvn/version "1.3.925"}
+  com.github.seancorfield/next.jdbc {:mvn/version "1.3.939"}
-  metosin/reitit-core {:mvn/version "0.6.0"}
+  metosin/reitit-core {:mvn/version "0.7.0"}
-  nrepl/nrepl {:mvn/version "1.1.1"}
+  nrepl/nrepl {:mvn/version "1.1.2"}
-  cider/cider-nrepl {:mvn/version "0.47.1"}
+  cider/cider-nrepl {:mvn/version "0.48.0"}
 
   org.postgresql/postgresql {:mvn/version "42.7.3"}
-  org.xerial/sqlite-jdbc {:mvn/version "3.45.2.0"}
+  org.xerial/sqlite-jdbc {:mvn/version "3.46.0.0"}
 
   com.zaxxer/HikariCP {:mvn/version "5.1.0"}
 
@@ -58,7 +58,7 @@
 
   ;; Pretty Print specs
   pretty-spec/pretty-spec {:mvn/version "0.1.4"}
-  software.amazon.awssdk/s3 {:mvn/version "2.22.12"}
+  software.amazon.awssdk/s3 {:mvn/version "2.25.63"}
   }
 
  :paths ["src" "resources" "target/classes"]
@@ -74,13 +74,13 @@
 
   :build
   {:extra-deps
-   {io.github.clojure/tools.build {:git/tag "v0.10.0" :git/sha "3a2c484"}}
+   {io.github.clojure/tools.build {:git/tag "v0.10.3" :git/sha "15ead66"}}
    :ns-default build}
 
   :test
   {:main-opts ["-m" "kaocha.runner"]
    :jvm-opts ["-Dlog4j2.configurationFile=log4j2-devenv-repl.xml"]
-   :extra-deps {lambdaisland/kaocha {:mvn/version "1.88.1376"}}}
+   :extra-deps {lambdaisland/kaocha {:mvn/version "1.91.1392"}}}
 
   :outdated
   {:extra-deps {com.github.liquidz/antq {:mvn/version "RELEASE"}}

backend/package.json

@@ -4,19 +4,19 @@
   "license": "MPL-2.0",
   "author": "Kaleidos INC",
   "private": true,
-  "packageManager": "yarn@4.2.2",
+  "packageManager": "yarn@4.3.1",
   "repository": {
     "type": "git",
     "url": "https://github.com/penpot/penpot"
   },
   "dependencies": {
-    "luxon": "^3.4.2",
+    "luxon": "^3.4.4",
-    "sax": "^1.2.4"
+    "sax": "^1.4.1"
   },
   "devDependencies": {
-    "nodemon": "^3.0.1",
+    "nodemon": "^3.1.2",
     "source-map-support": "^0.5.21",
-    "ws": "^8.13.0"
+    "ws": "^8.17.0"
   },
   "scripts": {
     "fmt:clj:check": "cljfmt check --parallel=false src/ test/",

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

@@ -168,7 +168,7 @@
                 <table border="0" cellpadding="0" cellspacing="0" role="presentation" style="vertical-align:top;" width="100%">
                   <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:24px;font-weight:600;line-height:150%;text-align:left;color:#000000;">Hello {{name}}!</div>
+                      <div style="font-family:Source Sans Pro, sans-serif;font-size:24px;font-weight:600;line-height:150%;text-align:left;color:#000000;">Hello {{name|abbreviate:25}}!</div>
                     </td>
                   </tr>
                   <tr>

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

@@ -1,4 +1,4 @@
-Hello {{name}}!
+Hello {{name|abbreviate:25}}!
 
 We received a request to change your current email to {{ pending-email }}.
 

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

@@ -11,7 +11,7 @@
       {% if profile %}
         <span>
           <span>Name: </span>
-          <span><code>{{profile.fullname}}</code></span>
+          <span><code>{{profile.fullname|abbreviate:25}}</code></span>
         </span>
         <br />
 
@@ -34,7 +34,7 @@
     </p>
     <p>
       <strong>Subject:</strong><br />
-      <span>{{subject}}</span>
+      <span>{{subject|abbreviate:300}}</span>
     </p>
 
     <p>

backend/resources/app/email/invite-to-team/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;">{{invited-by}} has invited you to join the team “{{ team }}”.</div>
+                      <div style="font-family:Source Sans Pro, sans-serif;font-size:16px;line-height:150%;text-align:left;color:#000000;">{{invited-by|abbreviate:25}} has invited you to join the team “{{ team|abbreviate:25 }}”.</div>
                     </td>
                   </tr>
                   <tr>

backend/resources/app/email/invite-to-team/en.txt

@@ -1,6 +1,6 @@
 Hello!
 
-{{invited-by}} has invited you to join the team “{{ team }}”.
+{{invited-by|abbreviate:25}} has invited you to join the team “{{ team|abbreviate:25 }}”.
 
 Accept invitation using this link:
 

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

@@ -168,7 +168,7 @@
                 <table border="0" cellpadding="0" cellspacing="0" role="presentation" style="vertical-align:top;" width="100%">
                   <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:24px;font-weight:600;line-height:150%;text-align:left;color:#000000;">Hello {{name}}!</div>
+                      <div style="font-family:Source Sans Pro, sans-serif;font-size:24px;font-weight:600;line-height:150%;text-align:left;color:#000000;">Hello {{name|abbreviate:25}}!</div>
                     </td>
                   </tr>
                   <tr>

backend/resources/app/email/password-recovery/en.txt

@@ -1,4 +1,4 @@
-Hello {{name}}!
+Hello {{name|abbreviate:25}}!
 
 We received a request to reset your password. Click the link below to choose a
 new one:

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

@@ -168,7 +168,7 @@
                 <table border="0" cellpadding="0" cellspacing="0" role="presentation" style="vertical-align:top;" width="100%">
                   <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:24px;font-weight:600;line-height:150%;text-align:left;color:#000000;">Hello {{name}}!</div>
+                      <div style="font-family:Source Sans Pro, sans-serif;font-size:24px;font-weight:600;line-height:150%;text-align:left;color:#000000;">Hello {{name|abbreviate:25}}!</div>
                     </td>
                   </tr>
                   <tr>

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

@@ -1,4 +1,4 @@
-Hello {{name}}!
+Hello {{name|abbreviate:25}}!
 
 Thanks for signing up for your Penpot account! Please verify your email using the
 link below and get started building mockups and prototypes today!

backend/resources/app/onboarding.edn

@@ -1,4 +1,16 @@
-[{:id "tutorial-for-beginners"
+[{:id "wireframing-kit"
+  :name "Wireframe library"
+  :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/wireframing-kit.penpot"}
+ {:id "prototype-examples"
+  :name "Prototype template"
+  :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/prototype-examples.penpot"}
+ {:id "plants-app"
+  :name "UI mockup example"
+  :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/Plants-app.penpot"}
+ {:id "penpot-design-system"
+  :name "Design system example"
+  :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/Penpot-Design-system.penpot"}
+ {:id "tutorial-for-beginners"
   :name "Tutorial for beginners"
   :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/tutorial-for-beginners.penpot"}
  {:id "lucide-icons"
@@ -7,12 +19,6 @@
  {:id "font-awesome"
   :name "Font Awesome"
   :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/Font-Awesome.penpot"}
- {:id "plants-app"
-  :name "Plants app"
-  :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/Plants-app.penpot"}
- {:id "wireframing-kit"
-  :name "Wireframing Kit"
-  :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/wireframing-kit.penpot"}
  {:id "black-white-mobile-templates"
   :name "Black & White Mobile Templates"
   :file-uri "https://github.com/penpot/penpot-files/raw/binary-files/Black-White-Mobile-Templates.penpot"}

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

@@ -20,12 +20,19 @@
           <span>WEBHOOK</span>
         </span>
       {% endif %}
+
       {% if item.params-schema-js %}
         <span class="tag">
           <span>SCHEMA</span>
         </span>
       {% endif %}
 
+      {% if item.spec %}
+        <span class="tag">
+          <span>SPEC</span>
+        </span>
+      {% endif %}
+
       {% if item.sse %}
         <span class="tag">
           <span>SSE</span>

backend/scripts/repl

@@ -24,6 +24,7 @@ export PENPOT_FLAGS="\
        enable-rpc-climit \
        enable-rpc-rlimit \
        enable-soft-rpc-rlimit \
+       enable-file-snapshot \
        enable-webhooks \
        enable-access-tokens \
        enable-file-validation \

backend/scripts/start-dev

@@ -17,6 +17,7 @@ export PENPOT_FLAGS="\
        disable-secure-session-cookies \
        enable-rpc-climit \
        enable-smtp \
+       enable-file-snapshot \
        enable-access-tokens \
        enable-file-validation \
        enable-file-schema-validation";

backend/src/app/auth.clj

@@ -6,9 +6,7 @@
 
 (ns app.auth
   (:require
-   [app.config :as cf]
+   [buddy.hashers :as hashers]))
-   [buddy.hashers :as hashers]
-   [cuerdas.core :as str]))
 
 (def default-params
   {:alg :argon2id
@@ -27,17 +25,3 @@
     (catch Throwable _
       {:update false
        :valid false})))
-
-(defn email-domain-in-whitelist?
-  "Returns true if email's domain is in the given whitelist or if
-  given whitelist is an empty string."
-  ([email]
-   (let [domains (cf/get :registration-domain-whitelist)]
-     (email-domain-in-whitelist? domains email)))
-  ([domains email]
-   (if (or (nil? domains) (empty? domains))
-     true
-     (let [[_ candidate] (-> (str/lower email)
-                             (str/split #"@" 2))]
-       (contains? domains candidate)))))
-

backend/src/app/auth/ldap.clj

@@ -9,7 +9,6 @@
    [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]
@@ -104,17 +103,17 @@
         nil))))
 
 (s/def ::enabled? ::us/boolean)
-(s/def ::host ::cf/ldap-host)
+(s/def ::host ::us/string)
-(s/def ::port ::cf/ldap-port)
+(s/def ::port ::us/integer)
-(s/def ::ssl ::cf/ldap-ssl)
+(s/def ::ssl ::us/boolean)
-(s/def ::tls ::cf/ldap-starttls)
+(s/def ::tls ::us/boolean)
-(s/def ::query ::cf/ldap-user-query)
+(s/def ::query ::us/string)
-(s/def ::base-dn ::cf/ldap-base-dn)
+(s/def ::base-dn ::us/string)
-(s/def ::bind-dn ::cf/ldap-bind-dn)
+(s/def ::bind-dn ::us/string)
-(s/def ::bind-password ::cf/ldap-bind-password)
+(s/def ::bind-password ::us/string)
-(s/def ::attrs-email ::cf/ldap-attrs-email)
+(s/def ::attrs-email ::us/string)
-(s/def ::attrs-fullname ::cf/ldap-attrs-fullname)
+(s/def ::attrs-fullname ::us/string)
-(s/def ::attrs-username ::cf/ldap-attrs-username)
+(s/def ::attrs-username ::us/string)
 
 (s/def ::provider-params
   (s/keys :opt-un [::host ::port
@@ -126,6 +125,7 @@
                    ::attrs-email
                    ::attrs-username
                    ::attrs-fullname]))
+
 (s/def ::provider
   (s/nilable ::provider-params))
 

backend/src/app/auth/oidc.clj

@@ -7,7 +7,6 @@
 (ns app.auth.oidc
   "OIDC client implementation."
   (:require
-   [app.auth :as auth]
    [app.auth.oidc.providers :as-alias providers]
    [app.common.data :as d]
    [app.common.data.macros :as dm]
@@ -17,12 +16,17 @@
    [app.common.uri :as u]
    [app.config :as cf]
    [app.db :as db]
+   [app.email.blacklist :as email.blacklist]
+   [app.email.whitelist :as email.whitelist]
    [app.http.client :as http]
+   [app.http.errors :as errors]
    [app.http.session :as session]
    [app.loggers.audit :as audit]
+   [app.rpc :as rpc]
    [app.rpc.commands.profile :as profile]
    [app.setup :as-alias setup]
    [app.tokens :as tokens]
+   [app.util.inet :as inet]
    [app.util.json :as json]
    [app.util.time :as dt]
    [buddy.sign.jwk :as jwk]
@@ -31,6 +35,7 @@
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig]
+   [ring.request :as rreq]
    [ring.response :as-alias rres]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -128,8 +133,8 @@
           (-> body json/decode :keys process-oidc-jwks)
           (do
             (l/warn :hint "unable to retrieve JWKs (unexpected response status code)"
-                    :http-status status
+                    :response-status status
-                    :http-body  body)
+                    :response-body  body)
             nil)))
       (catch Throwable cause
         (l/warn :hint "unable to retrieve JWKs (unexpected exception)"
@@ -143,7 +148,7 @@
   (when (contains? cf/flags :login-with-oidc)
     (if-let [opts (prepare-oidc-opts cfg)]
       (let [jwks (fetch-oidc-jwks cfg opts)]
-        (l/info :hint "provider initialized"
+        (l/inf :hint "provider initialized"
                :provider "oidc"
                :method (if (:discover? opts) "discover" "manual")
                :client-id (:client-id opts)
@@ -178,7 +183,7 @@
       (if (and (string? (:client-id opts))
                (string? (:client-secret opts)))
         (do
-          (l/info :hint "provider initialized"
+          (l/inf :hint "provider initialized"
                  :provider "google"
                  :client-id (:client-id opts)
                  :client-secret (obfuscate-string (:client-secret opts)))
@@ -206,8 +211,9 @@
           (ex/raise :type :internal
                     :code :unable-to-retrieve-github-emails
                     :hint "unable to retrieve github emails"
-                    :http-status status
+                    :request-uri (:uri params)
-                    :http-body body))
+                    :response-status status
+                    :response-body body))
 
         (->> body json/decode (filter :primary) first :email))))
 
@@ -232,7 +238,7 @@
       (if (and (string? (:client-id opts))
                (string? (:client-secret opts)))
         (do
-          (l/info :hint "provider initialized"
+          (l/inf :hint "provider initialized"
                  :provider "github"
                  :client-id (:client-id opts)
                  :client-secret (obfuscate-string (:client-secret opts)))
@@ -247,7 +253,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defmethod ig/init-key ::providers/gitlab
-  [_ _]
+  [_ cfg]
   (let [base (cf/get :gitlab-base-uri "https://gitlab.com")
         opts {:base-uri      base
               :client-id     (cf/get :gitlab-client-id)
@@ -256,17 +262,18 @@
               :auth-uri      (str base "/oauth/authorize")
               :token-uri     (str base "/oauth/token")
               :user-uri      (str base "/oauth/userinfo")
+              :jwks-uri      (str base "/oauth/discovery/keys")
               :name          "gitlab"}]
     (when (contains? cf/flags :login-with-gitlab)
       (if (and (string? (:client-id opts))
                (string? (:client-secret opts)))
-        (do
+        (let [jwks (fetch-oidc-jwks cfg opts)]
-          (l/info :hint "provider initialized"
+          (l/inf :hint "provider initialized"
                  :provider "gitlab"
                  :base-uri base
                  :client-id (:client-id opts)
                  :client-secret (obfuscate-string (:client-secret opts)))
-          opts)
+          (assoc opts :jwks jwks))
 
         (do
           (l/warn :hint "unable to initialize auth provider, missing configuration" :provider "gitlab")
@@ -322,7 +329,7 @@
                 :uri (:token-uri provider)
                 :body (u/map->query-string params)}]
 
-    (l/trace :hint "request access token"
+    (l/trc :hint "fetch access token"
            :provider (:name provider)
            :client-id (:client-id provider)
            :client-secret (obfuscate-string (:client-secret provider))
@@ -330,18 +337,23 @@
            :redirect-uri (:redirect_uri params))
 
     (let [{:keys [status body]} (http/req! cfg req {:sync? true})]
-      (l/trace :hint "access token response" :status status :body body)
+      (l/trc :hint "access token fetched" :status status :body body)
       (if (= status 200)
-        (let [data (json/decode body)]
+        (let [data (json/decode body)
-          {:token/access (get data :access_token)
+              data {:token/access (get data :access_token)
                     :token/id     (get data :id_token)
-           :token/type   (get data :token_type)})
+                    :token/type   (get data :token_type)}]
-
+          (l/trc :hint "access token fetched"
+                 :token-id (:token/id data)
+                 :token-type (:token/type data)
+                 :token (:token/access data))
+          data)
         (ex/raise :type :internal
-                  :code :unable-to-retrieve-token
+                  :code :unable-to-fetch-access-token
-                  :hint "unable to retrieve token"
+                  :hint "unable to fetch access token"
-                  :http-status status
+                  :request-uri (:uri req)
-                  :http-body body)))))
+                  :response-status status
+                  :response-body body)))))
 
 (defn- process-user-info
   [provider tdata info]
@@ -368,7 +380,7 @@
 
 (defn- fetch-user-info
   [{:keys [::provider] :as cfg} tdata]
-  (l/trace :hint "fetch user info"
+  (l/trc :hint "fetch user info"
          :uri (:user-uri provider)
          :token (obfuscate-string (:token/access tdata)))
 
@@ -378,7 +390,7 @@
                   :method :get}
         response (http/req! cfg params {:sync? true})]
 
-    (l/trace :hint "user info response"
+    (l/trc :hint "user info response"
            :status (:status response)
            :body   (:body response))
 
@@ -418,12 +430,6 @@
 
 (defn- get-info
   [{:keys [::provider ::setup/props] :as cfg} {:keys [params] :as request}]
-  (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 props {:token state :iss :oauth})
@@ -436,7 +442,7 @@
 
         info   (process-user-info provider tdata info)]
 
-    (l/trace :hint "user info" :info info)
+    (l/trc :hint "user info" :info info)
 
     (when-not (s/valid? ::info info)
       (l/warn :hint "received incomplete profile info object (please set correct scopes)" :info info)
@@ -469,6 +475,9 @@
       (some? (:invitation-token state))
       (assoc :invitation-token (:invitation-token state))
 
+      (some? (:external-session-id state))
+      (assoc :external-session-id (:external-session-id state))
+
       ;; If state token comes with props, merge them. The state token
       ;; props can contain pm_ and utm_ prefixed query params.
       (map? (:props state))
@@ -559,18 +568,26 @@
                                          {:iss :auth
                                           :exp (dt/in-future "15m")
                                           :props (:props info)
-                                        :profile-id (:id profile)}))]
+                                          :profile-id (:id profile)}))
+            props   (audit/profile->props profile)
+            context (d/without-nils {:external-session-id (:external-session-id info)})]
 
-        (audit/submit! cfg {::audit/type "command"
+        (audit/submit! cfg {::audit/type "action"
                             ::audit/name "login-with-oidc"
                             ::audit/profile-id (:id profile)
-                            ::audit/ip-addr (audit/parse-client-ip request)
+                            ::audit/ip-addr (inet/parse-request request)
-                            ::audit/props (audit/profile->props profile)})
+                            ::audit/props props
+                            ::audit/context context})
 
         (->> (redirect-to-verify-token token)
              (sxf request))))
 
-    (not (auth/email-domain-in-whitelist? (:email info)))
+    (and (email.blacklist/enabled? cfg)
+         (email.blacklist/contains? cfg (:email info)))
+    (redirect-with-error "email-domain-not-allowed")
+
+    (and (email.whitelist/enabled? cfg)
+         (not (email.whitelist/contains? cfg (:email info))))
     (redirect-with-error "email-domain-not-allowed")
 
     :else
@@ -579,26 +596,50 @@
         (redirect-to-register cfg info request)
         (redirect-with-error "registration-disabled")))))
 
+(defn- get-external-session-id
+  [request]
+  (let [session-id (rreq/get-header request "x-external-session-id")]
+    (when (string? session-id)
+      (if (or (> (count session-id) 256)
+              (= session-id "null")
+              (str/blank? session-id))
+        nil
+        session-id))))
+
 (defn- auth-handler
   [cfg {:keys [params] :as request}]
   (let [props  (audit/extract-utm-params params)
-        state (tokens/generate (::setup/props cfg)
+        esid   (rpc/get-external-session-id request)
-                               {:iss :oauth
+        params {:iss :oauth
                 :invitation-token (:invitation-token params)
+                :external-session-id esid
                 :props props
-                                :exp (dt/in-future "4h")})
+                :exp (dt/in-future "4h")}
+        state  (tokens/generate (::setup/props cfg)
+                                (d/without-nils params))
         uri    (build-auth-uri cfg state)]
     {::rres/status 200
      ::rres/body {:redirect-uri uri}}))
 
 (defn- callback-handler
-  [cfg request]
+  [{:keys [::provider] :as cfg} request]
   (try
+    (if-let [error (dm/get-in request [:params :error])]
+      (redirect-with-error "unable-to-auth" error)
       (let [info    (get-info cfg request)
             profile (get-profile cfg info)]
-      (process-callback cfg request info profile))
+        (process-callback cfg request info profile)))
     (catch Throwable cause
-      (l/err :hint "error on oauth process" :cause cause)
+      (binding [l/*context* (-> (errors/request->context request)
+                                (assoc :auth/provider (:name provider)))]
+        (let [edata (ex-data cause)]
+          (cond
+            (= :validation (:type edata))
+            (l/wrn :hint "invalid token received" :cause cause)
+
+            :else
+            (l/err :hint "error on oauth process" :cause cause))))
+
       (redirect-with-error "unable-to-auth" (ex-message cause)))))
 
 (def provider-lookup
@@ -614,17 +655,17 @@
                        :provider provider
                        :hint "provider not configured"))))))})
 
-(s/def ::client-id ::cf/oidc-client-id)
+(s/def ::client-id ::us/string)
-(s/def ::client-secret ::cf/oidc-client-secret)
+(s/def ::client-secret ::us/string)
-(s/def ::base-uri ::cf/oidc-base-uri)
+(s/def ::base-uri ::us/string)
-(s/def ::token-uri ::cf/oidc-token-uri)
+(s/def ::token-uri ::us/string)
-(s/def ::auth-uri ::cf/oidc-auth-uri)
+(s/def ::auth-uri ::us/string)
-(s/def ::user-uri ::cf/oidc-user-uri)
+(s/def ::user-uri ::us/string)
-(s/def ::scopes ::cf/oidc-scopes)
+(s/def ::scopes ::us/set-of-strings)
-(s/def ::roles ::cf/oidc-roles)
+(s/def ::roles ::us/set-of-strings)
-(s/def ::roles-attr ::cf/oidc-roles-attr)
+(s/def ::roles-attr ::us/string)
-(s/def ::email-attr ::cf/oidc-email-attr)
+(s/def ::email-attr ::us/string)
-(s/def ::name-attr ::cf/oidc-name-attr)
+(s/def ::name-attr ::us/string)
 
 (s/def ::provider
   (s/keys :req-un [::client-id

backend/src/app/binfile/common.clj

@@ -15,6 +15,7 @@
    [app.common.files.migrations :as fmg]
    [app.common.files.validate :as fval]
    [app.common.logging :as l]
+   [app.common.types.file :as ctf]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
@@ -331,54 +332,12 @@
 
 (defn embed-assets
   [cfg data file-id]
-  (letfn [(walk-map-form [form state]
+  (let [library-ids (get-libraries cfg [file-id])]
-            (cond
+    (reduce (fn [data library-id]
-              (uuid? (:fill-color-ref-file form))
+              (let [library (get-file cfg library-id)]
-              (do
+                (ctf/absorb-assets data (:data library))))
-                (vswap! state conj [(:fill-color-ref-file form) :colors (:fill-color-ref-id form)])
+            data
-                (assoc form :fill-color-ref-file file-id))
+            library-ids)))
-
-              (uuid? (:stroke-color-ref-file form))
-              (do
-                (vswap! state conj [(:stroke-color-ref-file form) :colors (:stroke-color-ref-id form)])
-                (assoc form :stroke-color-ref-file file-id))
-
-              (uuid? (:typography-ref-file form))
-              (do
-                (vswap! state conj [(:typography-ref-file form) :typographies (:typography-ref-id form)])
-                (assoc form :typography-ref-file file-id))
-
-              (uuid? (:component-file form))
-              (do
-                (vswap! state conj [(:component-file form) :components (:component-id form)])
-                (assoc form :component-file file-id))
-
-              :else
-              form))
-
-          (process-group-of-assets [data [lib-id items]]
-            ;; NOTE: there is a possibility that shape refers to an
-            ;; non-existant file because the file was removed. In this
-            ;; case we just ignore the asset.
-            (if-let [lib (get-file cfg lib-id)]
-              (reduce (partial process-asset lib) data items)
-              data))
-
-          (process-asset [lib data [bucket asset-id]]
-            (let [asset (get-in lib [:data bucket asset-id])
-                  ;; Add a special case for colors that need to have
-                  ;; correctly set the :file-id prop (pending of the
-                  ;; refactor that will remove it).
-                  asset (cond-> asset
-                          (= bucket :colors) (assoc :file-id file-id))]
-              (update data bucket assoc asset-id asset)))]
-
-    (let [assets (volatile! [])]
-      (walk/postwalk #(cond-> % (map? %) (walk-map-form assets)) data)
-      (->> (deref assets)
-           (filter #(as-> (first %) $ (and (uuid? $) (not= $ file-id))))
-           (d/group-by first rest)
-           (reduce (partial process-group-of-assets) data)))))
 
 (defn- fix-version
   [file]

backend/src/app/binfile/v1.clj

@@ -130,7 +130,6 @@
   (.writeLong output (long data))
   (swap! *position* + 8))
 
-
 (defn read-long!
   [^DataInputStream input]
   (let [v (.readLong input)]

backend/src/app/config.clj

@@ -11,30 +11,17 @@
    [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.flags :as flags]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.common.version :as v]
+   [app.util.overrides]
    [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]
    [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))
@@ -45,18 +32,19 @@
     (d/without-nils data)
     data))
 
-(def defaults
+(def default
   {:database-uri "postgresql://postgres/penpot"
    :database-username "penpot"
    :database-password "penpot"
 
-   :default-blob-version 5
+   :default-blob-version 4
 
-   :rpc-rlimit-config (fs/path "resources/rlimit.edn")
+   :rpc-rlimit-config "resources/rlimit.edn"
-   :rpc-climit-config (fs/path "resources/climit.edn")
+   :rpc-climit-config "resources/climit.edn"
 
-   :file-change-snapshot-every 5
+   :file-snapshot-total 10
-   :file-change-snapshot-timeout "3h"
+   :file-snapshot-every 5
+   :file-snapshot-timeout "3h"
 
    :public-uri "http://localhost:3449"
    :host "localhost"
@@ -87,249 +75,148 @@
    :ldap-attrs-fullname "cn"
 
    ;; 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)
+   ;; time to avoid email sending after profile modification
-(s/def ::rpc-rlimit-config ::fs/path)
+   :email-verify-threshold "15m"})
-(s/def ::rpc-climit-config ::fs/path)
 
-(s/def ::media-max-file-size ::us/integer)
+(def schema:config
+  (do #_sm/optional-keys
+   [:map {:title "config"}
+    [:flags {:optional true} [::sm/set :string]]
+    [:admins {:optional true} [::sm/set ::sm/email]]
+    [:secret-key {:optional true} :string]
 
-(s/def ::flags ::us/vector-of-keywords)
+    [:tenant {:optional false} :string]
-(s/def ::telemetry-enabled ::us/boolean)
+    [:public-uri {:optional false} :string]
+    [:host {:optional false} :string]
 
-(s/def ::audit-log-archive-uri ::us/string)
+    [:http-server-port {:optional true} :int]
-(s/def ::audit-log-http-handler-concurrency ::us/integer)
+    [:http-server-host {:optional true} :string]
+    [:http-server-max-body-size {:optional true} :int]
+    [:http-server-max-multipart-body-size {:optional true} :int]
+    [:http-server-io-threads {:optional true} :int]
+    [:http-server-worker-threads {:optional true} :int]
 
-(s/def ::deletion-delay ::dt/duration)
+    [:telemetry-uri {:optional true} :string]
+    [:telemetry-with-taiga {:optional true} :boolean] ;; DELETE
 
-(s/def ::admins ::us/set-of-valid-emails)
+    [:file-snapshot-total {:optional true} :int]
-(s/def ::file-change-snapshot-every ::us/integer)
+    [:file-snapshot-every {:optional true} :int]
-(s/def ::file-change-snapshot-timeout ::dt/duration)
+    [:file-snapshot-timeout {:optional true} ::dt/duration]
 
-(s/def ::default-executor-parallelism ::us/integer)
+    [:media-max-file-size {:optional true} :int]
-(s/def ::scheduled-executor-parallelism ::us/integer)
+    [:deletion-delay {:optional true} ::dt/duration] ;; REVIEW
+    [:telemetry-enabled {:optional true} :boolean]
+    [:default-blob-version {:optional true} :int]
+    [:allow-demo-users {:optional true} :boolean]
+    [:error-report-webhook {:optional true} :string]
+    [:user-feedback-destination {:optional true} :string]
 
-(s/def ::worker-default-parallelism ::us/integer)
+    [:default-rpc-rlimit {:optional true} [::sm/vec :string]]
-(s/def ::worker-webhook-parallelism ::us/integer)
+    [:rpc-rlimit-config {:optional true} ::fs/path]
+    [:rpc-climit-config {:optional true} ::fs/path]
 
-(s/def ::auth-data-cookie-domain ::us/string)
+    [:audit-log-archive-uri {:optional true} :string]
-(s/def ::auth-token-cookie-name ::us/string)
+    [:audit-log-http-handler-concurrency {:optional true} :int]
-(s/def ::auth-token-cookie-max-age ::dt/duration)
 
-(s/def ::secret-key ::us/string)
+    [:default-executor-parallelism {:optional true} :int] ;; REVIEW
-(s/def ::allow-demo-users ::us/boolean)
+    [:scheduled-executor-parallelism {:optional true} :int] ;; REVIEW
-(s/def ::assets-path ::us/string)
+    [:worker-default-parallelism {:optional true} :int]
-(s/def ::database-password (s/nilable ::us/string))
+    [:worker-webhook-parallelism {:optional true} :int]
-(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 ::quotes-teams-per-profile ::us/integer)
+    [:database-password {:optional true} [:maybe :string]]
-(s/def ::quotes-access-tokens-per-profile ::us/integer)
+    [:database-uri {:optional true} :string]
-(s/def ::quotes-projects-per-team ::us/integer)
+    [:database-username {:optional true} [:maybe :string]]
-(s/def ::quotes-invitations-per-team ::us/integer)
+    [:database-readonly {:optional true} :boolean]
-(s/def ::quotes-profiles-per-team ::us/integer)
+    [:database-min-pool-size {:optional true} :int]
-(s/def ::quotes-files-per-project ::us/integer)
+    [:database-max-pool-size {:optional true} :int]
-(s/def ::quotes-files-per-team ::us/integer)
-(s/def ::quotes-font-variants-per-team ::us/integer)
-(s/def ::quotes-comment-threads-per-file ::us/integer)
-(s/def ::quotes-comments-per-file ::us/integer)
 
-(s/def ::default-blob-version ::us/integer)
+    [:quotes-teams-per-profile {:optional true} :int]
-(s/def ::error-report-webhook ::us/string)
+    [:quotes-access-tokens-per-profile {:optional true} :int]
-(s/def ::user-feedback-destination ::us/string)
+    [:quotes-projects-per-team {:optional true} :int]
-(s/def ::github-client-id ::us/string)
+    [:quotes-invitations-per-team {:optional true} :int]
-(s/def ::github-client-secret ::us/string)
+    [:quotes-profiles-per-team {:optional true} :int]
-(s/def ::gitlab-base-uri ::us/string)
+    [:quotes-files-per-project {:optional true} :int]
-(s/def ::gitlab-client-id ::us/string)
+    [:quotes-files-per-team {:optional true} :int]
-(s/def ::gitlab-client-secret ::us/string)
+    [:quotes-font-variants-per-team {:optional true} :int]
-(s/def ::google-client-id ::us/string)
+    [:quotes-comment-threads-per-file {:optional true} :int]
-(s/def ::google-client-secret ::us/string)
+    [:quotes-comments-per-file {:optional true} :int]
-(s/def ::oidc-client-id ::us/string)
-(s/def ::oidc-user-info-source ::us/keyword)
-(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-jwks-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/string)
-(s/def ::oidc-email-attr ::us/string)
-(s/def ::oidc-name-attr ::us/string)
-(s/def ::host ::us/string)
-(s/def ::http-server-port ::us/integer)
-(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-username ::us/string)
-(s/def ::ldap-base-dn ::us/string)
-(s/def ::ldap-bind-dn ::us/string)
-(s/def ::ldap-bind-password ::us/string)
-(s/def ::ldap-host ::us/string)
-(s/def ::ldap-port ::us/integer)
-(s/def ::ldap-ssl ::us/boolean)
-(s/def ::ldap-starttls ::us/boolean)
-(s/def ::ldap-user-query ::us/string)
-(s/def ::media-directory ::us/string)
-(s/def ::media-uri ::us/string)
-(s/def ::profile-bounce-max-age ::dt/duration)
-(s/def ::profile-bounce-threshold ::us/integer)
-(s/def ::profile-complaint-max-age ::dt/duration)
-(s/def ::profile-complaint-threshold ::us/integer)
-(s/def ::public-uri ::us/string)
-(s/def ::redis-uri ::us/string)
-(s/def ::registration-domain-whitelist ::us/set-of-strings)
 
-(s/def ::smtp-default-from ::us/string)
+    [:auth-data-cookie-domain {:optional true} :string]
-(s/def ::smtp-default-reply-to ::us/string)
+    [:auth-token-cookie-name {:optional true} :string]
-(s/def ::smtp-host ::us/string)
+    [:auth-token-cookie-max-age {:optional true} ::dt/duration]
-(s/def ::smtp-password (s/nilable ::us/string))
-(s/def ::smtp-port ::us/integer)
-(s/def ::smtp-ssl ::us/boolean)
-(s/def ::smtp-tls ::us/boolean)
-(s/def ::smtp-username (s/nilable ::us/string))
-(s/def ::urepl-host ::us/string)
-(s/def ::urepl-port ::us/integer)
-(s/def ::prepl-host ::us/string)
-(s/def ::prepl-port ::us/integer)
-(s/def ::assets-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-assets-s3-io-threads ::us/integer)
-(s/def ::telemetry-uri ::us/string)
-(s/def ::telemetry-with-taiga ::us/boolean)
-(s/def ::tenant ::us/string)
 
-(s/def ::config
+    [:registration-domain-whitelist {:optional true} [::sm/set :string]]
-  (s/keys :opt-un [::secret-key
+    [:email-verify-threshold {:optional true} ::dt/duration]
-                   ::flags
-                   ::admins
-                   ::deletion-delay
-                   ::allow-demo-users
-                   ::audit-log-archive-uri
-                   ::audit-log-http-handler-concurrency
-                   ::auth-token-cookie-name
-                   ::auth-token-cookie-max-age
-                   ::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
-                   ::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
-                   ::gitlab-client-id
-                   ::gitlab-client-secret
-                   ::google-client-id
-                   ::google-client-secret
-                   ::oidc-client-id
-                   ::oidc-client-secret
-                   ::oidc-user-info-source
-                   ::oidc-base-uri
-                   ::oidc-token-uri
-                   ::oidc-auth-uri
-                   ::oidc-user-uri
-                   ::oidc-jwks-uri
-                   ::oidc-scopes
-                   ::oidc-roles-attr
-                   ::oidc-email-attr
-                   ::oidc-name-attr
-                   ::oidc-roles
-                   ::host
-                   ::http-server-host
-                   ::http-server-port
-                   ::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-username
-                   ::ldap-base-dn
-                   ::ldap-bind-dn
-                   ::ldap-bind-password
-                   ::ldap-host
-                   ::ldap-port
-                   ::ldap-ssl
-                   ::ldap-starttls
-                   ::ldap-user-query
-                   ::local-assets-uri
-                   ::media-max-file-size
-                   ::profile-bounce-max-age
-                   ::profile-bounce-threshold
-                   ::profile-complaint-max-age
-                   ::profile-complaint-threshold
-                   ::public-uri
 
-                   ::quotes-teams-per-profile
+    [:github-client-id {:optional true} :string]
-                   ::quotes-access-tokens-per-profile
+    [:github-client-secret {:optional true} :string]
-                   ::quotes-projects-per-team
+    [:gitlab-base-uri {:optional true} :string]
-                   ::quotes-invitations-per-team
+    [:gitlab-client-id {:optional true} :string]
-                   ::quotes-profiles-per-team
+    [:gitlab-client-secret {:optional true} :string]
-                   ::quotes-files-per-project
+    [:google-client-id {:optional true} :string]
-                   ::quotes-files-per-team
+    [:google-client-secret {:optional true} :string]
-                   ::quotes-font-variants-per-team
+    [:oidc-client-id {:optional true} :string]
-                   ::quotes-comment-threads-per-file
+    [:oidc-user-info-source {:optional true} :keyword]
-                   ::quotes-comments-per-file
+    [:oidc-client-secret {:optional true} :string]
+    [:oidc-base-uri {:optional true} :string]
+    [:oidc-token-uri {:optional true} :string]
+    [:oidc-auth-uri {:optional true} :string]
+    [:oidc-user-uri {:optional true} :string]
+    [:oidc-jwks-uri {:optional true} :string]
+    [:oidc-scopes {:optional true} [::sm/set :string]]
+    [:oidc-roles {:optional true} [::sm/set :string]]
+    [:oidc-roles-attr {:optional true} :string]
+    [:oidc-email-attr {:optional true} :string]
+    [:oidc-name-attr {:optional true} :string]
 
-                   ::redis-uri
+    [:ldap-attrs-email {:optional true} :string]
-                   ::registration-domain-whitelist
+    [:ldap-attrs-fullname {:optional true} :string]
-                   ::rpc-rlimit-config
+    [:ldap-attrs-username {:optional true} :string]
-                   ::rpc-climit-config
+    [:ldap-base-dn {:optional true} :string]
+    [:ldap-bind-dn {:optional true} :string]
+    [:ldap-bind-password {:optional true} :string]
+    [:ldap-host {:optional true} :string]
+    [:ldap-port {:optional true} :int]
+    [:ldap-ssl {:optional true} :boolean]
+    [:ldap-starttls {:optional true} :boolean]
+    [:ldap-user-query {:optional true} :string]
 
-                   ::semaphore-process-font
+    [:profile-bounce-max-age {:optional true} ::dt/duration]
-                   ::semaphore-process-image
+    [:profile-bounce-threshold {:optional true} :int]
-                   ::semaphore-update-file
+    [:profile-complaint-max-age {:optional true} ::dt/duration]
-                   ::semaphore-auth
+    [:profile-complaint-threshold {:optional true} :int]
 
-                   ::smtp-default-from
+    [:redis-uri {:optional true} :string]
-                   ::smtp-default-reply-to
-                   ::smtp-host
-                   ::smtp-password
-                   ::smtp-port
-                   ::smtp-ssl
-                   ::smtp-tls
-                   ::smtp-username
 
-                   ::urepl-host
+    [:email-domain-blacklist {:optional true} ::fs/path]
-                   ::urepl-port
+    [:email-domain-whitelist {:optional true} ::fs/path]
-                   ::prepl-host
-                   ::prepl-port
 
-                   ::assets-storage-backend
+    [:smtp-default-from {:optional true} :string]
-                   ::storage-assets-fs-directory
+    [:smtp-default-reply-to {:optional true} :string]
-                   ::storage-assets-s3-bucket
+    [:smtp-host {:optional true} :string]
-                   ::storage-assets-s3-region
+    [:smtp-password {:optional true} [:maybe :string]]
-                   ::storage-assets-s3-endpoint
+    [:smtp-port {:optional true} :int]
-                   ::storage-assets-s3-io-threads
+    [:smtp-ssl {:optional true} :boolean]
-                   ::telemetry-enabled
+    [:smtp-tls {:optional true} :boolean]
-                   ::telemetry-uri
+    [:smtp-username {:optional true} [:maybe :string]]
-                   ::telemetry-referer
+
-                   ::telemetry-with-taiga
+    [:urepl-host {:optional true} :string]
-                   ::tenant]))
+    [:urepl-port {:optional true} :int]
+    [:prepl-host {:optional true} :string]
+    [:prepl-port {:optional true} :int]
+
+    [:assets-storage-backend {:optional true} :keyword]
+    [:media-directory {:optional true} :string] ;; REVIEW
+    [:media-uri {:optional true} :string]
+    [:assets-path {:optional true} :string]
+
+    [:storage-assets-fs-directory {:optional true} :string]
+    [:storage-assets-s3-bucket {:optional true} :string]
+    [:storage-assets-s3-region {:optional true} :keyword]
+    [:storage-assets-s3-endpoint {:optional true} :string]
+    [:storage-assets-s3-io-threads {:optional true} :int]]))
 
 (def default-flags
   [:enable-backend-api-doc
@@ -357,20 +244,22 @@
      {}
      env)))
 
-(defn- read-config
+(def decode-config
-  []
+  (sm/decoder schema:config sm/default-transformer))
-  (try
+
-    (->> (read-env "penpot")
+(def validate-config
-         (merge defaults)
+  (sm/validator schema:config))
-         (us/conform ::config))
+
-    (catch Throwable e
+(def explain-config
-      (when (ex/error? e)
+  (sm/explainer schema:config))
-        (println ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;")
+
-        (println "Error on validating configuration:")
+(defn read-config
-        (println (some-> e ex-data ex/explain))
+  "Reads the configuration from enviroment variables and decodes all
-        (println (ex/explain (ex-data e)))
+  known values."
-        (println ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;"))
+  [& {:keys [prefix default] :or {prefix "penpot"}}]
-      (throw e))))
+  (->> (read-env prefix)
+       (merge default)
+       (decode-config)))
 
 (def version
   (v/parse (or (some-> (io/resource "version.txt")
@@ -378,10 +267,28 @@
                        (str/trim))
                "%version%")))
 
-(defonce ^:dynamic config (read-config))
+(defonce ^:dynamic config (read-config :default default))
 (defonce ^:dynamic flags (parse-flags config))
 
-(def deletion-delay
+(defn validate!
+  "Validate the currently loaded configuration data."
+  [& {:keys [exit-on-error?] :or {exit-on-error? true}}]
+  (if (validate-config config)
+    true
+    (let [explain (explain-config config)]
+      (println "Error on validating configuration:")
+      (sm/pretty-explain explain
+                         :variant ::sm/schemaless-explain
+                         :message "Configuration Validation Error")
+      (flush)
+      (if exit-on-error?
+        (System/exit -1)
+        (ex/raise :type :validation
+                  :code :config-validaton
+                  ::sm/explain explain)))))
+
+(defn get-deletion-delay
+  []
   (or (c/get config :deletion-delay)
       (dt/duration {:days 7})))
 

backend/src/app/email.clj

@@ -7,9 +7,11 @@
 (ns app.email
   "Main api for send emails."
   (:require
+   [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [app.common.pprint :as pp]
+   [app.common.schema :as sm]
    [app.common.spec :as us]
    [app.config :as cf]
    [app.db :as db]
@@ -149,9 +151,27 @@
     "mail.smtp.timeout" timeout
     "mail.smtp.connectiontimeout" timeout}))
 
+(def ^:private schema:smtp-config
+  [:map
+   [::username {:optional true} :string]
+   [::password {:optional true} :string]
+   [::tls {:optional true} :boolean]
+   [::ssl {:optional true} :boolean]
+   [::host {:optional true} :string]
+   [::port {:optional true} :int]
+   [::default-from {:optional true} :string]
+   [::default-reply-to {:optional true} :string]])
+
+(def valid-smtp-config?
+  (sm/check-fn schema:smtp-config))
+
 (defn- create-smtp-session
   ^Session
   [cfg]
+  (dm/assert!
+   "expected valid smtp config"
+   (valid-smtp-config? cfg))
+
   (let [props (opts->props cfg)]
     (Session/getInstance props)))
 
@@ -262,44 +282,21 @@
   (let [email (if factory
                 (factory context)
                 (dissoc context ::conn))]
-    (wrk/submit! (merge
+    (wrk/submit! {::wrk/task :sendmail
-                  {::wrk/task :sendmail
                   ::wrk/delay 0
                   ::wrk/max-retries 4
                   ::wrk/priority 200
-                   ::wrk/conn conn}
+                  ::db/conn conn
-                  email))))
+                  ::wrk/params email})))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; 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 [::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]
@@ -449,3 +446,11 @@
                                             {:email email :type "bounce"}
                                             {:limit 10}))]
      (>= (count reports) threshold))))
+
+(defn has-reports?
+  ([conn email] (has-reports? conn email nil))
+  ([conn email {:keys [threshold] :or {threshold 1}}]
+   (let [reports (db/exec! conn (sql/select :global-complaint-report
+                                            {:email email}
+                                            {:limit 10}))]
+     (>= (count reports) threshold))))

backend/src/app/email/blacklist.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.email.blacklist
+  "Email blacklist provider"
+  (:refer-clojure :exclude [contains?])
+  (:require
+   [app.common.logging :as l]
+   [app.config :as cf]
+   [app.email :as-alias email]
+   [clojure.core :as c]
+   [clojure.java.io :as io]
+   [cuerdas.core :as str]
+   [integrant.core :as ig]))
+
+(defmethod ig/init-key ::email/blacklist
+  [_ _]
+  (when (c/contains? cf/flags :email-blacklist)
+    (try
+      (let [path   (cf/get :email-domain-blacklist)
+            result (with-open [reader (io/reader path)]
+                     (reduce (fn [result line]
+                               (if (str/starts-with? line "#")
+                                 result
+                                 (conj result (-> line str/trim str/lower))))
+                             #{}
+                             (line-seq reader)))]
+        (l/inf :hint "initializing email blacklist" :domains (count result))
+        (not-empty result))
+
+      (catch Throwable cause
+        (l/wrn :hint "unexpected exception on initializing email blacklist"
+               :cause cause)))))
+
+(defn contains?
+  "Check if email is in the blacklist."
+  [{:keys [::email/blacklist]} email]
+  (let [[_ domain] (str/split email "@" 2)]
+    (c/contains? blacklist (str/lower domain))))
+
+(defn enabled?
+  "Check if the blacklist is enabled"
+  [{:keys [::email/blacklist]}]
+  (some? blacklist))

backend/src/app/email/whitelist.clj

@@ -0,0 +1,59 @@
+;; 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.email.whitelist
+  "Email whitelist provider"
+  (:refer-clojure :exclude [contains?])
+  (:require
+   [app.common.logging :as l]
+   [app.config :as cf]
+   [app.email :as-alias email]
+   [clojure.core :as c]
+   [clojure.java.io :as io]
+   [cuerdas.core :as str]
+   [datoteka.fs :as fs]
+   [integrant.core :as ig]))
+
+(defn- read-whitelist
+  [path]
+  (when (and path (fs/exists? path))
+    (try
+      (with-open [reader (io/reader path)]
+        (reduce (fn [result line]
+                  (if (str/starts-with? line "#")
+                    result
+                    (conj result (-> line str/trim str/lower))))
+                #{}
+                (line-seq reader)))
+
+      (catch Throwable cause
+        (l/wrn :hint "unexpected exception on reading email whitelist"
+               :cause cause)))))
+
+(defmethod ig/init-key ::email/whitelist
+  [_ _]
+  (let [whitelist (or (cf/get :registration-domain-whitelist) #{})
+        whitelist (if (c/contains? cf/flags :email-whitelist)
+                    (into whitelist (read-whitelist (cf/get :email-domain-whitelist)))
+                    whitelist)
+        whitelist (not-empty whitelist)]
+
+
+    (when whitelist
+      (l/inf :hint "initializing email whitelist" :domains (count whitelist)))
+
+    whitelist))
+
+(defn contains?
+  "Check if email is in the whitelist."
+  [{:keys [::email/whitelist]} email]
+  (let [[_ domain] (str/split email "@" 2)]
+    (c/contains? whitelist (str/lower domain))))
+
+(defn enabled?
+  "Check if the whitelist is enabled"
+  [{:keys [::email/whitelist]}]
+  (some? whitelist))

backend/src/app/http.clj

@@ -114,7 +114,7 @@
               (partial not-found-handler request)))
 
           (on-error [cause request]
-            (let [{:keys [body] :as response} (errors/handle cause request)]
+            (let [{:keys [::rres/body] :as response} (errors/handle cause request)]
               (cond-> response
                 (map? body)
                 (-> (update ::rres/headers assoc "content-type" "application/transit+json")
@@ -151,9 +151,9 @@
                       [mw/params]
                       [mw/format-response]
                       [mw/parse-request]
+                      [mw/errors errors/handle]
                       [session/soft-auth cfg]
                       [actoken/soft-auth cfg]
-                      [mw/errors errors/handle]
                       [mw/restrict-methods]]}
 
      (::mtx/routes cfg)

backend/src/app/http/awsns.clj

@@ -9,6 +9,7 @@
   (:require
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
+   [app.common.pprint :as pp]
    [app.db :as db]
    [app.db.sql :as sql]
    [app.http.client :as http]
@@ -16,10 +17,10 @@
    [app.setup :as-alias setup]
    [app.tokens :as tokens]
    [app.worker :as-alias wrk]
+   [clojure.data.json :as j]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig]
-   [jsonista.core :as j]
    [promesa.exec :as px]
    [ring.request :as rreq]
    [ring.response :as-alias rres]))
@@ -136,27 +137,32 @@
 
 (defn- parse-json
   [v]
-  (ex/ignoring
+  (try
-   (j/read-value v)))
+    (j/read-str v)
+    (catch Throwable cause
+      (l/wrn :hint "unable to decode request body"
+             :cause cause))))
 
 (defn- register-bounce-for-profile
   [{:keys [::db/pool]} {:keys [type kind profile-id] :as report}]
   (when (= kind "permanent")
-    (db/with-atomic [conn pool]
+    (try
-      (db/insert! conn :profile-complaint-report
+      (db/insert! pool :profile-complaint-report
                   {:profile-id profile-id
                    :type (name type)
                    :content (db/tjson report)})
 
-      ;; TODO: maybe also try to find profiles by mail and if exists
+      (catch Throwable cause
-      ;; register profile reports for them?
+        (l/warn :hint "unable to persist profile complaint"
+                :cause cause)))
+
     (doseq [recipient (:recipients report)]
-        (db/insert! conn :global-complaint-report
+      (db/insert! pool :global-complaint-report
                   {:email (:email recipient)
                    :type (name type)
                    :content (db/tjson report)}))
 
-      (let [profile (db/exec-one! conn (sql/select :profile {:id profile-id}))]
+    (let [profile (db/exec-one! pool (sql/select :profile {:id profile-id}))]
       (when (some #(= (:email profile) (:email %)) (:recipients report))
         ;; If the report matches the profile email, this means that
         ;; the report is for itself, can be caused when a user
@@ -164,55 +170,77 @@
         ;; permanently rejecting receiving the email. In this case we
         ;; have no option to mark the user as muted (and in this case
         ;; the profile will be also inactive.
-          (db/update! conn :profile
+
+        (l/inf :hint "mark profile: muted"
+               :profile-id (str (:id profile))
+               :email (:email profile)
+               :reason "bounce report"
+               :report-id (:feedback-id report))
+
+        (db/update! pool :profile
                     {:is-muted true}
-                      {:id profile-id}))))))
+                    {:id profile-id}
+                    {::db/return-keys false})))))
 
 (defn- register-complaint-for-profile
   [{:keys [::db/pool]} {:keys [type profile-id] :as report}]
-  (db/with-atomic [conn pool]
+
-    (db/insert! conn :profile-complaint-report
+  (try
+    (db/insert! pool :profile-complaint-report
                 {:profile-id profile-id
                  :type (name type)
                  :content (db/tjson report)})
+    (catch Throwable cause
+      (l/warn :hint "unable to persist profile complaint"
+              :cause cause)))
 
   ;; TODO: maybe also try to find profiles by email and if exists
   ;; register profile reports for them?
   (doseq [email (:recipients report)]
-      (db/insert! conn :global-complaint-report
+    (db/insert! pool :global-complaint-report
                 {:email email
                  :type (name type)
                  :content (db/tjson report)}))
 
-    (let [profile (db/exec-one! conn (sql/select :profile {:id profile-id}))]
+  (let [profile (db/exec-one! pool (sql/select :profile {:id profile-id}))]
     (when (some #(= % (:email profile)) (:recipients report))
       ;; If the report matches the profile email, this means that
       ;; the report is for itself, rare case but can happen; In this
       ;; case just mark profile as muted (very rare case).
-        (db/update! conn :profile
+      (l/inf :hint "mark profile: muted"
+             :profile-id (str (:id profile))
+             :email (:email profile)
+             :reason "complaint report"
+             :report-id (:feedback-id report))
+
+      (db/update! pool :profile
                   {:is-muted true}
-                    {:id profile-id})))))
+                  {:id profile-id}
+                  {::db/return-keys false}))))
 
 (defn- process-report
   [cfg {:keys [type profile-id] :as 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)
-    (l/warn :msg "a notification without identity received from AWS"
+    (l/wrn :hint "not-identified report"
-            :report (pr-str report))
+           ::l/body (pp/pprint-str report {:length 40 :level 6}))
 
     (= "bounce" type)
-    (register-bounce-for-profile cfg report)
+    (do
+      (l/trc :hint "bounce report"
+             ::l/body (pp/pprint-str report {:length 40 :level 6}))
+      (register-bounce-for-profile cfg report))
 
     (= "complaint" type)
-    (register-complaint-for-profile cfg report)
+    (do
+      (l/trc :hint "complaint report"
+             ::l/body (pp/pprint-str report {:length 40 :level 6}))
+      (register-complaint-for-profile cfg report))
 
     :else
-    (l/warn :msg "unrecognized report received from AWS"
+    (l/wrn :hint "unrecognized report"
-            :report (pr-str report))))
+           ::l/body (pp/pprint-str report {:length 20 :level 4}))))
-
-

backend/src/app/http/client.clj

@@ -54,9 +54,10 @@
   "A convencience toplevel function for gradual migration to a new API
   convention."
   ([cfg-or-client request]
-   (let [client (resolve-client cfg-or-client)]
+   (let [client  (resolve-client cfg-or-client)
+         request (update request :uri str)]
      (send! client request {:sync? true})))
   ([cfg-or-client request options]
-   (let [client (resolve-client cfg-or-client)]
+   (let [client  (resolve-client cfg-or-client)
+         request (update request :uri str)]
      (send! client request (merge {:sync? true} options)))))
-

backend/src/app/http/errors.clj

@@ -14,32 +14,28 @@
    [app.http :as-alias http]
    [app.http.access-token :as-alias actoken]
    [app.http.session :as-alias session]
+   [app.util.inet :as inet]
    [clojure.spec.alpha :as s]
-   [cuerdas.core :as str]
    [ring.request :as rreq]
    [ring.response :as rres]))
 
-(defn- parse-client-ip
-  [request]
-  (or (some-> (rreq/get-header request "x-forwarded-for") (str/split ",") first)
-      (rreq/get-header request "x-real-ip")
-      (rreq/remote-addr request)))
-
 (defn request->context
   "Extracts error report relevant context data from request."
   [request]
   (let [claims (-> {}
                    (into (::session/token-claims request))
                    (into (::actoken/token-claims request)))]
+
     {:request/path       (:path request)
      :request/method     (:method request)
      :request/params     (:params request)
      :request/user-agent (rreq/get-header request "user-agent")
-     :request/ip-addr    (parse-client-ip request)
+     :request/ip-addr    (inet/parse-request request)
      :request/profile-id (:uid claims)
      :version/frontend   (or (rreq/get-header request "x-frontend-version") "unknown")
      :version/backend    (:full cf/version)}))
 
+
 (defmulti handle-error
   (fn [cause _ _]
     (-> cause ex-data :type)))

backend/src/app/http/middleware.clj

@@ -10,16 +10,14 @@
    [app.common.logging :as l]
    [app.common.transit :as t]
    [app.config :as cf]
-   [app.util.json :as json]
+   [app.http.errors :as errors]
+   [clojure.data.json :as json]
    [cuerdas.core :as str]
    [ring.request :as rreq]
    [ring.response :as rres]
    [yetti.adapter :as yt]
    [yetti.middleware :as ymw])
   (:import
-   com.fasterxml.jackson.core.JsonParseException
-   com.fasterxml.jackson.core.io.JsonEOFException
-   com.fasterxml.jackson.databind.exc.MismatchedInputException
    io.undertow.server.RequestTooBigException
    java.io.InputStream
    java.io.OutputStream))
@@ -34,11 +32,22 @@
   {:name ::params
    :compile (constantly ymw/wrap-params)})
 
-(def ^:private json-mapper
+(defn- get-reader
-  (json/mapper
+  ^java.io.BufferedReader
-   {:encode-key-fn str/camel
+  [request]
-    :decode-key-fn (comp keyword str/kebab)
+  (let [^InputStream body (rreq/body request)]
-    :pretty true}))
+    (java.io.BufferedReader.
+     (java.io.InputStreamReader. body))))
+
+(defn- read-json-key
+  [k]
+  (-> k str/kebab keyword))
+
+(defn- write-json-key
+  [k]
+  (if (or (keyword? k) (symbol? k))
+    (str/camel k)
+    (str k)))
 
 (defn wrap-parse-request
   [handler]
@@ -53,8 +62,8 @@
                         (update :params merge params))))
 
                 (str/starts-with? header "application/json")
-                (with-open [^InputStream is (rreq/body request)]
+                (with-open [reader (get-reader request)]
-                  (let [params (json/decode is json-mapper)]
+                  (let [params (json/read reader :key-fn read-json-key)]
                     (-> request
                         (assoc :body-params params)
                         (update :params merge params))))
@@ -62,35 +71,33 @@
                 :else
                 request)))
 
-          (handle-error [cause]
+          (handle-error [cause request]
             (cond
               (instance? RuntimeException cause)
               (if-let [cause (ex-cause cause)]
-                (handle-error cause)
+                (handle-error cause request)
-                (throw cause))
+                (errors/handle cause request))
 
               (instance? RequestTooBigException cause)
               (ex/raise :type :validation
                         :code :request-body-too-large
                         :hint (ex-message cause))
 
-              (or (instance? JsonEOFException cause)
+              (instance? java.io.EOFException cause)
-                  (instance? JsonParseException cause)
-                  (instance? MismatchedInputException cause))
               (ex/raise :type :validation
                         :code :malformed-json
                         :hint (ex-message cause)
                         :cause cause)
 
               :else
-              (throw cause)))]
+              (errors/handle cause request)))]
 
     (fn [request]
       (if (= (rreq/method request) :post)
-        (let [request (ex/try! (process-request request))]
+        (try
-          (if (ex/exception? request)
+          (-> request process-request handler)
-            (handle-error request)
+          (catch Throwable cause
-            (handler request)))
+            (handle-error cause request)))
         (handler request)))))
 
 (def parse-request
@@ -128,7 +135,8 @@
               (-write-body-to-stream [_ _ output-stream]
                 (try
                   (with-open [^OutputStream bos (buffered-output-stream output-stream buffer-size)]
-                    (json/write! bos data json-mapper))
+                    (with-open [^java.io.OutputStreamWriter writer (java.io.OutputStreamWriter. bos)]
+                      (json/write data writer :key-fn write-json-key)))
 
                   (catch java.io.IOException _)
                   (catch Throwable cause

backend/src/app/http/sse.clj

@@ -61,6 +61,8 @@
                            (let [result (handler)]
                              (events/tap :end result))
                            (catch Throwable cause
+                             (l/err :hint "unexpected error on processing sse response"
+                                    :cause cause)
                              (events/tap :error (errors/handle' cause request)))
                            (finally
                              (sp/close! events/*channel*)

backend/src/app/loggers/audit.clj

@@ -21,24 +21,18 @@
    [app.rpc :as-alias rpc]
    [app.rpc.retry :as rtry]
    [app.setup :as-alias setup]
+   [app.util.inet :as inet]
    [app.util.services :as-alias sv]
    [app.util.time :as dt]
    [app.worker :as wrk]
    [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
-   [integrant.core :as ig]
+   [integrant.core :as ig]))
-   [ring.request :as rreq]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; HELPERS
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defn parse-client-ip
-  [request]
-  (or (some-> (rreq/get-header request "x-forwarded-for") (str/split ",") first)
-      (rreq/get-header request "x-real-ip")
-      (some-> (rreq/remote-addr request) str)))
-
 (defn extract-utm-params
   "Extracts additional data from params and namespace them under
   `penpot` ns."
@@ -86,8 +80,19 @@
          (remove #(contains? reserved-props (key %))))
         props))
 
-;; --- SPECS
+(defn event-from-rpc-params
+  "Create a base event skeleton with pre-filled some important
+  data that can be extracted from RPC params object"
+  [params]
+  (let [context {:external-session-id (::rpc/external-session-id params)
+                 :external-event-origin (::rpc/external-event-origin params)
+                 :triggered-by (::rpc/handler-name params)}]
+    {::type "action"
+     ::profile-id (::rpc/profile-id params)
+     ::ip-addr (::rpc/ip-addr params)
+     ::context (d/without-nils context)}))
 
+;; --- SPECS
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; COLLECTOR
@@ -140,6 +145,8 @@
                        (::rpc/profile-id params)
                        uuid/zero)
 
+        session-id   (get params ::rpc/external-session-id)
+        event-origin (get params ::rpc/external-event-origin)
         props        (-> (or (::replace-props resultm)
                              (-> params
                                  (merge (::props resultm))
@@ -150,15 +157,19 @@
 
         token-id  (::actoken/id request)
         context   (-> (::context resultm)
+                      (assoc :external-session-id session-id)
+                      (assoc :external-event-origin event-origin)
                       (assoc :access-token-id (some-> token-id str))
-                      (d/without-nils))]
+                      (d/without-nils))
+
+        ip-addr   (inet/parse-request request)]
 
     {::type (or (::type resultm)
                 (::rpc/type cfg))
      ::name (or (::name resultm)
                 (::sv/name mdata))
      ::profile-id profile-id
-     ::ip-addr (some-> request parse-client-ip)
+     ::ip-addr ip-addr
      ::props props
      ::context context
 
@@ -180,15 +191,33 @@
          (::webhooks/event? resultm)
          false)}))
 
-(defn- handle-event!
+(defn- event->params
-  [cfg event]
+  [event]
   (let [params {:id (uuid/next)
                 :name (::name event)
                 :type (::type event)
                 :profile-id (::profile-id event)
                 :ip-addr (::ip-addr event)
-                :context (::context event)
+                :context (::context event {})
-                :props (::props event)}
+                :props (::props event {})
+                :source "backend"}
+        tnow   (::tracked-at event)]
+
+    (cond-> params
+      (some? tnow)
+      (assoc :tracked-at tnow))))
+
+(defn- append-audit-entry!
+  [cfg params]
+  (let [params (-> params
+                   (update :props db/tjson)
+                   (update :context db/tjson)
+                   (update :ip-addr db/inet))]
+    (db/insert! cfg :audit-log params)))
+
+(defn- handle-event!
+  [cfg event]
+  (let [params (event->params event)
         tnow   (dt/now)]
 
     (when (contains? cf/flags :audit-log)
@@ -197,12 +226,8 @@
       ;; this case we just retry the operation.
       (let [params (-> params
                        (assoc :created-at tnow)
-                       (assoc :tracked-at tnow)
+                       (update :tracked-at #(or % tnow)))]
-                       (update :props db/tjson)
+        (append-audit-entry! cfg params)))
-                       (update :context db/tjson)
-                       (update :ip-addr db/inet)
-                       (assoc :source "backend"))]
-        (db/insert! cfg :audit-log params)))
 
     (when (and (or (contains? cf/flags :telemetry)
                    (cf/get :telemetry-enabled))
@@ -214,12 +239,10 @@
       ;; NOTE: this is only executed when general audit log is disabled
       (let [params (-> params
                        (assoc :created-at tnow)
-                       (assoc :tracked-at tnow)
+                       (update :tracked-at #(or % tnow))
-                       (assoc :props (db/tjson {}))
+                       (assoc :props {})
-                       (assoc :context (db/tjson {}))
+                       (assoc :context {}))]
-                       (assoc :ip-addr (db/inet "0.0.0.0"))
+        (append-audit-entry! cfg params)))
-                       (assoc :source "backend"))]
-        (db/insert! cfg :audit-log params)))
 
     (when (and (contains? cf/flags :webhooks)
                (::webhooks/event? event))
@@ -232,25 +255,23 @@
                             :else               label)
             dedupe?       (boolean (and batch-key batch-timeout))]
 
-        (wrk/submit! ::wrk/conn (::db/conn cfg)
+        (wrk/submit! (-> cfg
-                     ::wrk/task :process-webhook-event
+                         (assoc ::wrk/task :process-webhook-event)
-                     ::wrk/queue :webhooks
+                         (assoc ::wrk/queue :webhooks)
-                     ::wrk/max-retries 0
+                         (assoc ::wrk/max-retries 0)
-                     ::wrk/delay (or batch-timeout 0)
+                         (assoc ::wrk/delay (or batch-timeout 0))
-                     ::wrk/dedupe dedupe?
+                         (assoc ::wrk/dedupe dedupe?)
-                     ::wrk/label label
+                         (assoc ::wrk/label label)
-
+                         (assoc ::wrk/params (-> params
-                     ::webhooks/event
-                     (-> params
                                                  (dissoc :ip-addr)
-                         (dissoc :type)))))
+                                                 (dissoc :type)))))))
     params))
 
 (defn submit!
   "Submit audit event to the collector."
-  [cfg params]
+  [cfg event]
   (try
-    (let [event (d/without-nils params)
+    (let [event (d/without-nils event)
           cfg   (-> cfg
                     (assoc ::rtry/when rtry/conflict-exception?)
                     (assoc ::rtry/max-retries 6)
@@ -259,3 +280,18 @@
       (rtry/invoke! cfg db/tx-run! handle-event! event))
     (catch Throwable cause
       (l/error :hint "unexpected error processing event" :cause cause))))
+
+(defn insert!
+  "Submit audit event to the collector, intended to be used only from
+  command line helpers because this skips all webhooks and telemetry
+  logic."
+  [cfg event]
+  (when (contains? cf/flags :audit-log)
+    (let [event (d/without-nils event)]
+      (us/verify! ::event event)
+      (db/run! cfg (fn [cfg]
+                     (let [tnow   (dt/now)
+                           params (-> (event->params event)
+                                      (assoc :created-at tnow)
+                                      (update :tracked-at #(or % tnow)))]
+                       (append-audit-entry! cfg params)))))))

backend/src/app/loggers/webhooks.clj

@@ -64,22 +64,22 @@
   (s/keys :req [::db/pool]))
 
 (defmethod ig/init-key ::process-event-handler
-  [_ {:keys [::db/pool] :as cfg}]
+  [_ cfg]
   (fn [{:keys [props] :as task}]
-    (let [event (::event props)]
+    (let [event (:event props)]
       (l/dbg :hint "process webhook event" :name (:name event))
 
       (when-let [items (lookup-webhooks cfg event)]
         (l/trc :hint "webhooks found for event" :total (count items))
 
-        (db/with-atomic [conn pool]
+        (db/tx-run! cfg (fn [cfg]
                           (doseq [item items]
-            (wrk/submit! ::wrk/conn conn
+                            (wrk/submit! (-> cfg
-                         ::wrk/task :run-webhook
+                                             (assoc ::wrk/task :run-webhook)
-                         ::wrk/queue :webhooks
+                                             (assoc ::wrk/queue :webhooks)
-                         ::wrk/max-retries 3
+                                             (assoc ::wrk/max-retries 3)
-                         ::event event
+                                             (assoc ::wrk/params {:event event
-                         ::config item)))))))
+                                                                  :config item}))))))))))
 
 ;; --- RUN
 
@@ -128,8 +128,8 @@
                          :rsp-data (db/tjson rsp)}))]
 
     (fn [{:keys [props] :as task}]
-      (let [event (::event props)
+      (let [event (:event props)
-            whook (::config props)
+            whook (:config props)
 
             body  (case (:mtype whook)
                     "application/json" (json/write-str event json-write-opts)

backend/src/app/main.clj

@@ -102,13 +102,13 @@
    {::mdef/name "penpot_tasks_timing"
     ::mdef/help "Background tasks timing (milliseconds)."
     ::mdef/labels ["name"]
-    ::mdef/type :summary}
+    ::mdef/type :histogram}
 
    :redis-eval-timing
    {::mdef/name "penpot_redis_eval_timing"
     ::mdef/help "Redis EVAL commands execution timings (ms)"
     ::mdef/labels ["name"]
-    ::mdef/type :summary}
+    ::mdef/type :histogram}
 
    :rpc-climit-queue
    {::mdef/name "penpot_rpc_climit_queue"
@@ -126,7 +126,7 @@
    {::mdef/name "penpot_rpc_climit_timing"
     ::mdef/help "Summary of the time between queuing and executing on the CLIMIT"
     ::mdef/labels ["name"]
-    ::mdef/type :summary}
+    ::mdef/type :histogram}
 
    :audit-http-handler-queue-size
    {::mdef/name "penpot_audit_http_handler_queue_size"
@@ -144,7 +144,7 @@
    {::mdef/name "penpot_audit_http_handler_timing"
     ::mdef/help "Summary of the time between queuing and executing on the audit log http handler"
     ::mdef/labels []
-    ::mdef/type :summary}
+    ::mdef/type :histogram}
 
    :executors-active-threads
    {::mdef/name "penpot_executors_active_threads"
@@ -254,7 +254,7 @@
    {::http.client/client (ig/ref ::http.client/client)}
 
    ::oidc.providers/gitlab
-   {}
+   {::http.client/client (ig/ref ::http.client/client)}
 
    ::oidc.providers/generic
    {::http.client/client (ig/ref ::http.client/client)}
@@ -267,7 +267,9 @@
                           :github (ig/ref ::oidc.providers/github)
                           :gitlab (ig/ref ::oidc.providers/gitlab)
                           :oidc   (ig/ref ::oidc.providers/generic)}
-    ::session/manager    (ig/ref ::session/manager)}
+    ::session/manager    (ig/ref ::session/manager)
+    ::email/blacklist    (ig/ref ::email/blacklist)
+    ::email/whitelist    (ig/ref ::email/whitelist)}
 
    :app.http/router
    {::session/manager    (ig/ref ::session/manager)
@@ -322,7 +324,10 @@
     ::rpc/climit         (ig/ref ::rpc/climit)
     ::rpc/rlimit         (ig/ref ::rpc/rlimit)
     ::setup/templates    (ig/ref ::setup/templates)
-    ::setup/props        (ig/ref ::setup/props)}
+    ::setup/props        (ig/ref ::setup/props)
+
+    ::email/blacklist    (ig/ref ::email/blacklist)
+    ::email/whitelist    (ig/ref ::email/whitelist)}
 
    :app.rpc.doc/routes
    {:methods (ig/ref :app.rpc/methods)}
@@ -338,7 +343,6 @@
     ::wrk/tasks
     {:sendmail           (ig/ref ::email/handler)
      :objects-gc         (ig/ref :app.tasks.objects-gc/handler)
-     :orphan-teams-gc    (ig/ref :app.tasks.orphan-teams-gc/handler)
      :file-gc            (ig/ref :app.tasks.file-gc/handler)
      :file-xlog-gc       (ig/ref :app.tasks.file-xlog-gc/handler)
      :tasks-gc           (ig/ref :app.tasks.tasks-gc/handler)
@@ -356,6 +360,12 @@
      :run-webhook
      (ig/ref ::webhooks/run-webhook-handler)}}
 
+   ::email/blacklist
+   {}
+
+   ::email/whitelist
+   {}
+
    ::email/sendmail
    {::email/host             (cf/get :smtp-host)
     ::email/port             (cf/get :smtp-port)
@@ -377,9 +387,6 @@
    {::db/pool     (ig/ref ::db/pool)
     ::sto/storage (ig/ref ::sto/storage)}
 
-   :app.tasks.orphan-teams-gc/handler
-   {::db/pool (ig/ref ::db/pool)}
-
    :app.tasks.delete-object/handler
    {::db/pool (ig/ref ::db/pool)}
 
@@ -468,9 +475,6 @@
      {:cron #app/cron "0 0 0 * * ?" ;; daily
       :task :objects-gc}
 
-     {:cron #app/cron "0 0 0 * * ?" ;; daily
-      :task :orphan-teams-gc}
-
      {:cron #app/cron "0 0 0 * * ?" ;; daily
       :task :storage-gc-deleted}
 
@@ -520,6 +524,7 @@
 
 (defn start
   []
+  (cf/validate!)
   (ig/load-namespaces (merge system-config worker-config))
   (alter-var-root #'system (fn [sys]
                              (when sys (ig/halt! sys))

backend/src/app/media.clj

@@ -11,7 +11,6 @@
    [app.common.exceptions :as ex]
    [app.common.media :as cm]
    [app.common.schema :as sm]
-   [app.common.schema.generators :as sg]
    [app.common.schema.openapi :as-alias oapi]
    [app.common.spec :as us]
    [app.common.svg :as csvg]
@@ -47,19 +46,7 @@
   (s/keys :req-un [::path]
           :opt-un [::mtype]))
 
-(sm/def! ::fs/path
+(sm/register! ::upload
-  {:type ::fs/path
-   :pred fs/path?
-   :type-properties
-   {:title "path"
-    :description "filesystem path"
-    :error/message "expected a valid fs path instance"
-    :gen/gen (sg/generator :string)
-    ::oapi/type "string"
-    ::oapi/format "unix-path"
-    ::oapi/decode fs/path}})
-
-(sm/def! ::upload
   [:map {:title "Upload"}
    [:filename :string]
    [:size :int]

backend/src/app/rpc.clj

@@ -29,6 +29,7 @@
    [app.rpc.rlimit :as rlimit]
    [app.setup :as-alias setup]
    [app.storage :as-alias sto]
+   [app.util.inet :as inet]
    [app.util.services :as sv]
    [app.util.time :as dt]
    [clojure.spec.alpha :as s]
@@ -70,6 +71,22 @@
         (handle-response-transformation request mdata)
         (handle-before-comple-hook mdata))))
 
+(defn get-external-session-id
+  [request]
+  (when-let [session-id (rreq/get-header request "x-external-session-id")]
+    (when-not (or (> (count session-id) 256)
+                  (= session-id "null")
+                  (str/blank? session-id))
+      session-id)))
+
+(defn- get-external-event-origin
+  [request]
+  (when-let [origin (rreq/get-header request "x-event-origin")]
+    (when-not (or (> (count origin) 256)
+                  (= origin "null")
+                  (str/blank? origin))
+      origin)))
+
 (defn- rpc-handler
   "Ring handler that dispatches cmd requests and convert between
   internal async flow into ring async flow."
@@ -79,8 +96,16 @@
         profile-id   (or (::session/profile-id request)
                          (::actoken/profile-id request))
 
+        ip-addr      (inet/parse-request request)
+        session-id   (get-external-session-id request)
+        event-origin (get-external-event-origin request)
+
         data         (-> params
+                         (assoc ::handler-name handler-name)
+                         (assoc ::ip-addr ip-addr)
                          (assoc ::request-at (dt/now))
+                         (assoc ::external-session-id session-id)
+                         (assoc ::external-event-origin event-origin)
                          (assoc ::session/id (::session/id request))
                          (assoc ::cond/key etag)
                          (cond-> (uuid? profile-id)
@@ -188,10 +213,10 @@
 (defn- wrap-all
   [cfg f mdata]
   (as-> f $
-    (wrap-metrics cfg $ mdata)
     (cond/wrap cfg $ mdata)
     (retry/wrap-retry cfg $ mdata)
     (climit/wrap cfg $ mdata)
+    (wrap-metrics cfg $ mdata)
     (rlimit/wrap cfg $ mdata)
     (wrap-audit cfg $ mdata)
     (wrap-spec-conform cfg $ mdata)

backend/src/app/rpc/commands/access_token.clj

@@ -6,7 +6,7 @@
 
 (ns app.rpc.commands.access-token
   (:require
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.common.uuid :as uuid]
    [app.db :as db]
    [app.main :as-alias main]
@@ -16,8 +16,7 @@
    [app.setup :as-alias setup]
    [app.tokens :as tokens]
    [app.util.services :as sv]
-   [app.util.time :as dt]
+   [app.util.time :as dt]))
-   [clojure.spec.alpha :as s]))
 
 (defn- decode-row
   [row]
@@ -44,7 +43,7 @@
                  :perms (db/create-array conn "text" [])})))
 
 
-(defn repl-create-access-token
+(defn repl:create-access-token
   [{:keys [::db/pool] :as system} profile-id name expiration]
   (db/with-atomic [conn pool]
     (let [props (:app.setup/props system)]
@@ -53,16 +52,14 @@
                            name
                            expiration))))
 
-(s/def ::name ::us/not-empty-string)
+(def ^:private schema:create-access-token
-(s/def ::expiration ::dt/duration)
+  [:map {:title "create-access-token"}
-
+   [:name [:string {:max 250 :min 1}]]
-(s/def ::create-access-token
+   [:expiration {:optional true} ::dt/duration]])
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::name]
-          :opt-un [::expiration]))
 
 (sv/defmethod ::create-access-token
-  {::doc/added "1.18"}
+  {::doc/added "1.18"
+   ::sm/params schema:create-access-token}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id name expiration]}]
   (db/with-atomic [conn pool]
     (let [cfg (assoc cfg ::db/conn conn)]
@@ -72,21 +69,23 @@
       (-> (create-access-token cfg profile-id name expiration)
           (decode-row)))))
 
-(s/def ::delete-access-token
+(def ^:private schema:delete-access-token
-  (s/keys :req [::rpc/profile-id]
+  [:map {:title "delete-access-token"}
-          :req-un [::us/id]))
+   [:id ::sm/uuid]])
 
 (sv/defmethod ::delete-access-token
-  {::doc/added "1.18"}
+  {::doc/added "1.18"
+   ::sm/params schema:delete-access-token}
   [{:keys [::db/pool]} {:keys [::rpc/profile-id id]}]
   (db/delete! pool :access-token {:id id :profile-id profile-id})
   nil)
 
-(s/def ::get-access-tokens
+(def ^:private schema:get-access-tokens
-  (s/keys :req [::rpc/profile-id]))
+  [:map {:title "get-access-tokens"}])
 
 (sv/defmethod ::get-access-tokens
-  {::doc/added "1.18"}
+  {::doc/added "1.18"
+   ::sm/params schema:get-access-tokens}
   [{:keys [::db/pool]} {:keys [::rpc/profile-id]}]
   (->> (db/query pool :access-token
                  {:profile-id profile-id}

backend/src/app/rpc/commands/audit.clj

@@ -14,11 +14,12 @@
    [app.config :as cf]
    [app.db :as db]
    [app.http :as-alias http]
-   [app.loggers.audit :as audit]
+   [app.loggers.audit :as-alias audit]
    [app.rpc :as-alias rpc]
    [app.rpc.climit :as-alias climit]
    [app.rpc.doc :as-alias doc]
    [app.rpc.helpers :as rph]
+   [app.util.inet :as inet]
    [app.util.services :as sv]
    [app.util.time :as dt]))
 
@@ -61,7 +62,7 @@
 (defn- handle-events
   [{:keys [::db/pool]} {:keys [::rpc/profile-id events] :as params}]
   (let [request (-> params meta ::http/request)
-        ip-addr (audit/parse-client-ip request)
+        ip-addr (inet/parse-request request)
         tnow    (dt/now)
         xform   (comp
                  (map (fn [event]
@@ -77,10 +78,19 @@
     (when (seq events)
       (db/insert-many! pool :audit-log event-columns events))))
 
+(def valid-event-types
+  #{"action" "identify"})
+
 (def schema:event
   [:map {:title "Event"}
-   [:name [:string {:max 250}]]
+   [:name
-   [:type [:string {:max 250}]]
+    [:and {:gen/elements ["update-file", "get-profile"]}
+     [:string {:max 250}]
+     [:re #"[\d\w-]{1,50}"]]]
+   [:type
+    [:and {:gen/elements valid-event-types}
+     [:string {:max 250}]
+     [::sm/one-of {:format "string"} valid-event-types]]]
    [:props
     [:map-of :keyword :any]]
    [:context {:optional true}

backend/src/app/rpc/commands/auth.clj

@@ -6,7 +6,6 @@
 
 (ns app.rpc.commands.auth
   (:require
-   [app.auth :as auth]
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
@@ -17,6 +16,8 @@
    [app.config :as cf]
    [app.db :as db]
    [app.email :as eml]
+   [app.email.blacklist :as email.blacklist]
+   [app.email.whitelist :as email.whitelist]
    [app.http.session :as session]
    [app.loggers.audit :as audit]
    [app.rpc :as-alias rpc]
@@ -37,13 +38,11 @@
 (def schema:token
   [::sm/word-string {:max 6000}])
 
-(def ^:private default-verify-threshold
-  (dt/duration "15m"))
-
 (defn- elapsed-verify-threshold?
   [profile]
-  (let [elapsed (dt/diff (:modified-at profile) (dt/now))]
+  (let [elapsed (dt/diff (:modified-at profile) (dt/now))
-    (pos? (compare elapsed default-verify-threshold))))
+        verify-threshold (cf/get :email-verify-threshold)]
+    (pos? (compare elapsed verify-threshold))))
 
 ;; ---- COMMAND: login with password
 
@@ -129,12 +128,21 @@
 
 ;; ---- COMMAND: Logout
 
+(def ^:private schema:logout
+  [:map {:title "logoug"}
+   [:profile-id {:optional true} ::sm/uuid]])
+
 (sv/defmethod ::logout
   "Clears the authentication cookie and logout the current session."
   {::rpc/auth false
-   ::doc/added "1.15"}
+   ::doc/changes [["2.1" "Now requires profile-id passed in the body"]]
-  [cfg _]
+   ::doc/added "1.0"
-  (rph/with-transform {} (session/delete-fn cfg)))
+   ::sm/params schema:logout}
+  [cfg params]
+  (if (= (:profile-id params)
+         (::rpc/profile-id params))
+    (rph/with-transform {} (session/delete-fn cfg))
+    {}))
 
 ;; ---- COMMAND: Recover Profile
 
@@ -186,8 +194,14 @@
                   :code :email-does-not-match-invitation
                   :hint "email should match the invitation"))))
 
-  (when-not (auth/email-domain-in-whitelist? (:email params))
+  (when (and (email.blacklist/enabled? cfg)
-    (ex/raise :type :validation
+             (email.blacklist/contains? cfg (:email params)))
+    (ex/raise :type :restriction
+              :code :email-domain-is-not-allowed))
+
+  (when (and (email.whitelist/enabled? cfg)
+             (not (email.whitelist/contains? cfg (:email params))))
+    (ex/raise :type :restriction
               :code :email-domain-is-not-allowed))
 
   ;; Perform a basic validation of email & password
@@ -195,7 +209,19 @@
            (str/lower (:password params)))
     (ex/raise :type :validation
               :code :email-as-password
-              :hint "you can't use your email as password")))
+              :hint "you can't use your email as password"))
+
+  (when (eml/has-bounce-reports? cfg (:email params))
+    (ex/raise :type :restriction
+              :code :email-has-permanent-bounces
+              :email (:email params)
+              :hint "looks like the email has bounce reports"))
+
+  (when (eml/has-complaint-reports? cfg (:email params))
+    (ex/raise :type :restriction
+              :code :email-has-complaints
+              :email (:email params)
+              :hint "looks like the email has complaint reports")))
 
 (defn prepare-register
   [{:keys [::db/pool] :as cfg} {:keys [email] :as params}]
@@ -272,14 +298,17 @@
     (try
       (-> (db/insert! conn :profile params)
           (profile/decode-row))
-      (catch org.postgresql.util.PSQLException e
+      (catch org.postgresql.util.PSQLException cause
-        (let [state (.getSQLState e)]
+        (let [state (.getSQLState cause)]
           (if (not= state "23505")
-            (throw e)
+            (throw cause)
+
+            (do
+              (l/error :hint "not an error" :cause cause)
               (ex/raise :type :validation
                         :code :email-already-exists
                         :hint "email already exists"
-                      :cause e)))))))
+                        :cause cause))))))))
 
 (defn create-profile-rels!
   [conn {:keys [id] :as profile}]
@@ -326,7 +355,7 @@
 
         profile    (if-let [profile-id (:profile-id claims)]
                      (profile/get-profile conn profile-id)
-                     (let [is-active (or (boolean (:is-active params))
+                     (let [is-active (or (boolean (:is-active claims))
                                          (not (contains? cf/flags :email-verification)))
                            params    (-> params
                                          (assoc :is-active is-active)
@@ -334,6 +363,9 @@
                        (->> (create-profile! conn params)
                             (create-profile-rels! conn))))
 
+        ;; When no profile-id comes on claims means a new register
+        created?   (not (:profile-id claims))
+
         invitation (when-let [token (:invitation-token params)]
                      (tokens/verify (::setup/props cfg) {:token token :iss :team-invitation}))
 
@@ -371,8 +403,8 @@
       ;; When a new user is created and it is already activated by
       ;; configuration or specified by OIDC, we just mark the profile
       ;; as logged-in
-      (not (:profile-id claims))
+      created?
-      (if (:is-active claims)
+      (if (:is-active profile)
         (-> (profile/strip-private-attrs profile)
             (rph/with-transform (session/create-fn cfg (:id profile)))
             (rph/with-meta
@@ -381,7 +413,9 @@
                ::audit/profile-id (:id profile)}))
 
         (do
-          (send-email-verification! cfg profile)
+          (when-not (eml/has-reports? conn (:email profile))
+            (send-email-verification! cfg profile))
+
           (rph/with-meta {:email (:email profile)}
             {::audit/replace-props props
              ::audit/context {:action "email-verification"}
@@ -389,9 +423,9 @@
 
       :else
       (let [elapsed?    (elapsed-verify-threshold? profile)
-            bounce?  (eml/has-bounce-reports? conn (:email profile))
+            complaints? (eml/has-reports? conn (:email profile))
-            action   (if bounce?
+            action      (if complaints?
-                       "ignore-because-bounce"
+                          "ignore-because-complaints"
                           (if elapsed?
                             "resend-email-verification"
                             "ignore"))]
@@ -423,15 +457,13 @@
    ::doc/added "1.15"
    ::sm/params schema:register-profile
    ::climit/id :auth/global}
-  [{:keys [::db/pool] :as cfg} params]
+  [cfg params]
-  (db/with-atomic [conn pool]
+  (db/tx-run! cfg register-profile params))
-    (-> (assoc cfg ::db/conn conn)
-        (register-profile params))))
 
 ;; ---- COMMAND: Request Profile Recovery
 
 (defn- request-profile-recovery
-  [{:keys [::db/pool] :as cfg} {:keys [email] :as params}]
+  [{:keys [::db/conn] :as cfg} {:keys [email] :as params}]
   (letfn [(create-recovery-token [{:keys [id] :as profile}]
             (let [token (tokens/generate (::setup/props cfg)
                                          {:iss :password-recovery
@@ -453,7 +485,6 @@
                           :extra-data ptoken})
               nil))]
 
-    (db/with-atomic [conn pool]
     (let [profile (->> (profile/clean-email email)
                        (profile/get-profile-by-email conn))]
 
@@ -472,12 +503,16 @@
                :profile-id (str (:id profile))
                :profile-email (:email profile))
 
+        (eml/has-complaint-reports? conn (:email profile))
+        (l/wrn :hint "attempt of profile recovery: email has complaints"
+               :profile-id (str (:id profile))
+               :profile-email (:email profile))
+
         (not (elapsed-verify-threshold? profile))
         (l/wrn :hint "attempt of profile recovery: retry attempt threshold not elapsed"
                :profile-id (str (:id profile))
                :profile-email (:email profile))
 
-
         :else
         (do
           (db/update! conn :profile
@@ -485,7 +520,7 @@
                       {:id (:id profile)})
           (->> profile
                (create-recovery-token)
-                 (send-email-notification conn))))))))
+               (send-email-notification conn)))))))
 
 
 (def schema:request-profile-recovery
@@ -497,6 +532,6 @@
    ::doc/added "1.15"
    ::sm/params schema:request-profile-recovery}
   [cfg params]
-  (request-profile-recovery cfg params))
+  (db/tx-run! cfg request-profile-recovery params))
 
 

backend/src/app/rpc/commands/binfile.clj

@@ -32,12 +32,11 @@
 
 (def ^:private
   schema:export-binfile
-  (sm/define
   [:map {:title "export-binfile"}
-     [:name :string]
+   [:name [:string {:max 250}]]
    [:file-id ::sm/uuid]
    [:include-libraries :boolean]
-     [:embed-assets :boolean]]))
+   [:embed-assets :boolean]])
 
 (sv/defmethod ::export-binfile
   "Export a penpot file in a binary format."
@@ -78,11 +77,10 @@
 
 (def ^:private
   schema:import-binfile
-  (sm/define
   [:map {:title "import-binfile"}
-     [:name :string]
+   [:name [:string {:max 250}]]
    [:project-id ::sm/uuid]
-     [:file ::media/upload]]))
+   [:file ::media/upload]])
 
 (sv/defmethod ::import-binfile
   "Import a penpot file in a binary format."

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

@@ -292,7 +292,7 @@
   [:map {:title "create-comment-thread"}
    [:file-id ::sm/uuid]
    [:position ::gpt/point]
-   [:content :string]
+   [:content [:string {:max 250}]]
    [:page-id ::sm/uuid]
    [:frame-id ::sm/uuid]
    [:share-id {:optional true} [:maybe ::sm/uuid]]])
@@ -418,7 +418,7 @@
   schema:create-comment
   [:map {:title "create-comment"}
    [:thread-id ::sm/uuid]
-   [:content :string]
+   [:content [:string {:max 250}]]
    [:share-id {:optional true} [:maybe ::sm/uuid]]])
 
 (sv/defmethod ::create-comment
@@ -477,7 +477,7 @@
   schema:update-comment
   [:map {:title "update-comment"}
    [:id ::sm/uuid]
-   [:content :string]
+   [:content [:string {:max 250}]]
    [:share-id {:optional true} [:maybe ::sm/uuid]]])
 
 (sv/defmethod ::update-comment

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

@@ -18,10 +18,7 @@
    [app.util.services :as sv]
    [app.util.time :as dt]
    [buddy.core.codecs :as bc]
-   [buddy.core.nonce :as bn]
+   [buddy.core.nonce :as bn]))
-   [clojure.spec.alpha :as s]))
-
-(s/def ::create-demo-profile any?)
 
 (sv/defmethod ::create-demo-profile
   "A command that is responsible of creating a demo purpose
@@ -48,7 +45,7 @@
         params   {:email email
                   :fullname fullname
                   :is-active true
-                  :deleted-at (dt/in-future cf/deletion-delay)
+                  :deleted-at (dt/in-future (cf/get-deletion-delay))
                   :password (profile/derive-password cfg password)
                   :props {}}]
 

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

@@ -8,29 +8,25 @@
   "A general purpose feedback module."
   (:require
    [app.common.exceptions :as ex]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.config :as cf]
    [app.db :as db]
    [app.email :as eml]
    [app.rpc :as-alias rpc]
    [app.rpc.commands.profile :as profile]
    [app.rpc.doc :as-alias doc]
-   [app.util.services :as sv]
+   [app.util.services :as sv]))
-   [clojure.spec.alpha :as s]))
 
 (declare ^:private send-feedback!)
 
-(s/def ::content ::us/string)
+(def ^:private schema:send-user-feedback
-(s/def ::from    ::us/email)
+  [:map {:title "send-user-feedback"}
-(s/def ::subject ::us/string)
+   [:subject [:string {:max 250}]]
-
+   [:content [:string {:max 250}]]])
-(s/def ::send-user-feedback
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::subject
-                   ::content]))
 
 (sv/defmethod ::send-user-feedback
-  {::doc/added "1.18"}
+  {::doc/added "1.18"
+   ::sm/params schema:send-user-feedback}
   [{:keys [::db/pool]} {:keys [::rpc/profile-id] :as params}]
   (when-not (contains? cf/flags :user-feedback)
     (ex/raise :type :restriction

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

@@ -15,7 +15,6 @@
    [app.common.logging :as l]
    [app.common.schema :as sm]
    [app.common.schema.desc-js-like :as-alias smdj]
-   [app.common.spec :as us]
    [app.common.types.components-list :as ctkl]
    [app.common.types.file :as ctf]
    [app.config :as cf]
@@ -36,7 +35,6 @@
    [app.util.services :as sv]
    [app.util.time :as dt]
    [app.worker :as wrk]
-   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]))
 
 ;; --- FEATURES
@@ -46,18 +44,6 @@
   (when media-id
     (str (cf/get :public-uri) "/assets/by-id/" media-id)))
 
-;; --- SPECS
-
-(s/def ::features ::us/set-of-strings)
-(s/def ::file-id ::us/uuid)
-(s/def ::frame-id ::us/uuid)
-(s/def ::id ::us/uuid)
-(s/def ::is-shared ::us/boolean)
-(s/def ::name ::us/string)
-(s/def ::project-id ::us/uuid)
-(s/def ::search-term ::us/string)
-(s/def ::team-id ::us/uuid)
-
 ;; --- HELPERS
 
 (def long-cache-duration
@@ -191,7 +177,7 @@
      [:features ::cfeat/features]
      [:has-media-trimmed :boolean]
      [:comment-thread-seqn {:min 0} :int]
-     [:name :string]
+     [:name [:string {:max 250}]]
      [:revn {:min 0} :int]
      [:modified-at ::dt/instant]
      [:is-shared :boolean]
@@ -671,7 +657,7 @@
             f.modified_at,
             f.name,
             f.is_shared,
-            ft.media_id,
+            ft.media_id AS thumbnail_id,
             row_number() over w as row_num
        from file as f
       inner join project as p on (p.id = f.project_id)
@@ -690,10 +676,8 @@
   [conn team-id]
   (->> (db/exec! conn [sql:team-recent-files team-id])
        (mapv (fn [row]
-               (if-let [media-id (:media-id row)]
+               (if-let [media-id (:thumbnail-id row)]
-                 (-> row
+                 (assoc row :thumbnail-uri (resolve-public-uri media-id))
-                     (dissoc :media-id)
-                     (assoc :thumbnail-uri (resolve-public-uri media-id)))
                  (dissoc row :media-id))))))
 
 (def ^:private schema:get-team-recent-files
@@ -761,19 +745,19 @@
    [:map {:title "RenameFileEvent"}
     [:id ::sm/uuid]
     [:project-id ::sm/uuid]
-    [:name :string]
+    [:name [:string {:max 250}]]
     [:created-at ::dt/instant]
     [:modified-at ::dt/instant]]
 
    ::sm/params
    [:map {:title "RenameFileParams"}
-    [:name {:min 1} :string]
+    [:name [:string {:min 1 :max 250}]]
     [:id ::sm/uuid]]
 
    ::sm/result
    [:map {:title "SimplifiedFile"}
     [:id ::sm/uuid]
-    [:name :string]
+    [:name [:string {:max 250}]]
     [:created-at ::dt/instant]
     [:modified-at ::dt/instant]]}
 
@@ -927,11 +911,11 @@
                          {:id file-id}
                          {::db/return-keys [:id :name :is-shared :deleted-at
                                             :project-id :created-at :modified-at]})]
-    (wrk/submit! {::wrk/task :delete-object
+    (wrk/submit! {::db/conn conn
-                  ::wrk/conn conn
+                  ::wrk/task :delete-object
-                  :object :file
+                  ::wrk/params {:object :file
                                 :deleted-at (:deleted-at file)
-                  :id file-id})
+                                :id file-id}})
     file))
 
 (def ^:private
@@ -1047,14 +1031,16 @@
               {:id file-id}
               {::db/return-keys true}))
 
-(s/def ::ignore-file-library-sync-status
+(def ^:private schema:ignore-file-library-sync-status
-  (s/keys :req [::rpc/profile-id]
+  [:map {:title "ignore-file-library-sync-status"}
-          :req-un [::file-id ::date]))
+   [:file-id ::sm/uuid]
+   [:date ::dt/duration]])
 
 ;; TODO: improve naming
 (sv/defmethod ::ignore-file-library-sync-status
   "Ignore updates in linked files"
-  {::doc/added "1.17"}
+  {::doc/added "1.17"
+   ::sm/params schema:ignore-file-library-sync-status}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id file-id)

backend/src/app/rpc/commands/files_create.clj

@@ -88,7 +88,7 @@
 
 (def ^:private schema:create-file
   [:map {:title "create-file"}
-   [:name :string]
+   [:name [:string {:max 250}]]
    [:project-id ::sm/uuid]
    [:id {:optional true} ::sm/uuid]
    [:is-shared {:optional true} :boolean]

backend/src/app/rpc/commands/files_share.clj

@@ -7,29 +7,24 @@
 (ns app.rpc.commands.files-share
   "Share link related rpc mutation methods."
   (:require
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.common.uuid :as uuid]
    [app.db :as db]
    [app.rpc :as-alias rpc]
    [app.rpc.commands.files :as files]
    [app.rpc.doc :as-alias doc]
-   [app.util.services :as sv]
+   [app.util.services :as sv]))
-   [clojure.spec.alpha :as s]))
-
-;; --- Helpers & Specs
-
-(s/def ::file-id ::us/uuid)
-(s/def ::who-comment ::us/string)
-(s/def ::who-inspect ::us/string)
-(s/def ::pages (s/every ::us/uuid :kind set?))
 
 ;; --- MUTATION: Create Share Link
 
 (declare create-share-link)
 
-(s/def ::create-share-link
+(def ^:private schema:create-share-link
-  (s/keys :req [::rpc/profile-id]
+  [:map {:title "create-share-link"}
-          :req-un [::file-id ::who-comment ::who-inspect ::pages]))
+   [:file-id ::sm/uuid]
+   [:who-comment [:string {:max 250}]]
+   [:who-inspect [:string {:max 250}]]
+   [:pages [:set ::sm/uuid]]])
 
 (sv/defmethod ::create-share-link
   "Creates a share-link object.
@@ -37,7 +32,8 @@
   Share links are resources that allows external users access to specific
   pages of a file with specific permissions (who-comment and who-inspect)."
   {::doc/added "1.18"
-   ::doc/module :files}
+   ::doc/module :files
+   ::sm/params schema:create-share-link}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id file-id)
@@ -58,13 +54,14 @@
 
 ;; --- MUTATION: Delete Share Link
 
-(s/def ::delete-share-link
+(def ^:private schema:delete-share-link
-  (s/keys :req [::rpc/profile-id]
+  [:map {:title "delete-share-link"}
-          :req-un [::us/id]))
+   [:id ::sm/uuid]])
 
 (sv/defmethod ::delete-share-link
   {::doc/added "1.18"
-   ::doc/module ::files}
+   ::doc/module ::files
+   ::sm/params schema:delete-share-link}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
   (db/with-atomic [conn pool]
     (let [slink (db/get-by-id conn :share-link id)]

backend/src/app/rpc/commands/files_temp.clj

@@ -35,7 +35,7 @@
 
 (def ^:private schema:create-temp-file
   [:map {:title "create-temp-file"}
-   [:name :string]
+   [:name [:string {:max 250}]]
    [:project-id ::sm/uuid]
    [:id {:optional true} ::sm/uuid]
    [:is-shared :boolean]

backend/src/app/rpc/commands/files_thumbnails.clj

@@ -33,7 +33,6 @@
    [app.util.pointer-map :as pmap]
    [app.util.services :as sv]
    [app.util.time :as dt]
-   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]))
 
 ;; --- FEATURES
@@ -86,11 +85,8 @@
    ::doc/module :files
    ::sm/params [:map {:title "get-file-object-thumbnails"}
                 [:file-id ::sm/uuid]
-                [:tag {:optional true} :string]]
+                [:tag {:optional true} [:string {:max 50}]]]
-   ::sm/result [:map-of :string :string]
+   ::sm/result [:map-of [:string {:max 250}] [:string {:max 250}]]}
-   ::cond/get-object #(files/get-minimal-file %1 (:file-id %2))
-   ::cond/reuse-key? true
-   ::cond/key-fn files/get-file-etag}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id tag] :as params}]
   (dm/with-open [conn (db/open pool)]
     (files/check-read-permissions! conn profile-id file-id)
@@ -279,9 +275,9 @@
   schema:create-file-object-thumbnail
   [:map {:title "create-file-object-thumbnail"}
    [:file-id ::sm/uuid]
-   [:object-id :string]
+   [:object-id [:string {:max 250}]]
    [:media ::media/upload]
-   [:tag {:optional true} :string]])
+   [:tag {:optional true} [:string {:max 50}]]])
 
 (sv/defmethod ::create-file-object-thumbnail
   {::doc/added "1.19"
@@ -317,25 +313,23 @@
                  :object-id object-id
                  :tag tag})))
 
-(s/def ::delete-file-object-thumbnail
+(def ^:private schema:delete-file-object-thumbnail
-  (s/keys :req [::rpc/profile-id]
+  [:map {:title "delete-file-object-thumbnail"}
-          :req-un [::file-id ::object-id]))
+   [:file-id ::sm/uuid]
+   [:object-id [:string {:max 250}]]])
 
 (sv/defmethod ::delete-file-object-thumbnail
   {::doc/added "1.19"
    ::doc/module :files
-   ::doc/deprecated "1.20"
+   ::sm/params schema:delete-file-object-thumbnail
-   ::climit/id [[:file-thumbnail-ops/by-profile ::rpc/profile-id]
-                [:file-thumbnail-ops/global]]
    ::audit/skip true}
   [cfg {:keys [::rpc/profile-id file-id object-id]}]
+  (files/check-edition-permissions! cfg profile-id file-id)
   (db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
-                    (files/check-edition-permissions! conn profile-id file-id)
-                    (when-not (db/read-only? conn)
                     (-> cfg
                         (update ::sto/storage media/configure-assets-storage conn)
                         (delete-file-object-thumbnail! file-id object-id))
-                      nil))))
+                    nil)))
 
 ;; --- MUTATION COMMAND: create-file-thumbnail
 
@@ -413,4 +407,5 @@
                     (when-not (db/read-only? conn)
                       (let [cfg   (update cfg ::sto/storage media/configure-assets-storage)
                             media (create-file-thumbnail! cfg params)]
-                        {:uri (files/resolve-public-uri (:id media))})))))
+                        {:uri (files/resolve-public-uri (:id media))
+                         :id (:id media)})))))

backend/src/app/rpc/commands/files_update.clj

@@ -51,7 +51,7 @@
     [:vector [:map
               [:changes [:vector ::cpc/change]]
               [:hint-origin {:optional true} :keyword]
-              [:hint-events {:optional true} [:vector :string]]]]]
+              [:hint-events {:optional true} [:vector [:string {:max 250}]]]]]]
    [:skip-validate {:optional true} :boolean]])
 
 (def ^:private
@@ -123,12 +123,13 @@
         (feat.fdata/persist-pointers! cfg id)
         result))))
 
-(declare get-lagged-changes)
+(declare ^:private delete-old-snapshots!)
-(declare send-notifications!)
+(declare ^:private get-lagged-changes)
-(declare update-file)
+(declare ^:private send-notifications!)
-(declare update-file*)
+(declare ^:private take-snapshot?)
-(declare update-file-data)
+(declare ^:private update-file)
-(declare take-snapshot?)
+(declare ^:private update-file*)
+(declare ^:private update-file-data)
 
 ;; If features are specified from params and the final feature
 ;; set is different than the persisted one, update it on the
@@ -238,12 +239,15 @@
                  :created-at created-at
                  :file-id (:id file)
                  :revn (:revn file)
+                 :label (::snapshot-label file)
+                 :data (::snapshot-data file)
                  :features (db/create-array conn "text" (:features file))
-                 :data (when (take-snapshot? file)
-                         (:data file))
                  :changes (blob/encode changes)}
                 {::db/return-keys false})
 
+    (when (::snapshot-data file)
+      (delete-old-snapshots! cfg file))
+
     (db/update! conn :file
                 {:revn (:revn file)
                  :data (:data file)
@@ -262,8 +266,8 @@
       ;; Send asynchronous notifications
       (send-notifications! cfg params)
 
-      ;; Retrieve and return lagged data
+      {:revn (:revn file)
-      (get-lagged-changes conn params))))
+       :lagged (get-lagged-changes conn params)})))
 
 (defn- soft-validate-file-schema!
   [file]
@@ -286,7 +290,6 @@
                                   (-> data
                                       (blob/decode)
                                       (assoc :id (:id file)))))
-
         ;; For avoid unnecesary overhead of creating multiple pointers
         ;; and handly internally with objects map in their worst
         ;; case (when probably all shapes and all pointers will be
@@ -322,8 +325,29 @@
         file (-> (files/check-version! file)
                  (update :revn inc)
                  (update :data cpc/process-changes changes)
-                 (update :data d/without-nils))]
+                 (update :data d/without-nils))
 
+        file (if (take-snapshot? file)
+               (let [tpoint   (dt/tpoint)
+                     snapshot (-> (:data file)
+                                  (feat.fdata/process-pointers deref)
+                                  (feat.fdata/process-objects (partial into {}))
+                                  (blob/encode))
+                     elapsed (tpoint)
+                     label   (str "internal/snapshot/" (:revn file))]
+
+                 (l/trc :hint "take snapshot"
+                        :file-id (str (:id file))
+                        :revn (:revn file)
+                        :label label
+                        :elapsed (dt/format-duration elapsed))
+
+                 (-> file
+                     (assoc ::snapshot-data snapshot)
+                     (assoc ::snapshot-label label)))
+               file)]
+
+    (binding [pmap/*tracked* nil]
       (when (contains? cf/flags :soft-file-validation)
         (soft-validate-file! file libs))
 
@@ -336,7 +360,7 @@
 
       (when (and (contains? cf/flags :file-schema-validation)
                  (not skip-validate))
-      (val/validate-file-schema! file))
+        (val/validate-file-schema! file)))
 
     (cond-> file
       (contains? cfeat/*current* "fdata/objects-map")
@@ -351,13 +375,42 @@
 (defn- take-snapshot?
   "Defines the rule when file `data` snapshot should be saved."
   [{:keys [revn modified-at] :as file}]
-  (let [freq    (or (cf/get :file-change-snapshot-every) 20)
+  (when (contains? cf/flags :file-snapshot)
-        timeout (or (cf/get :file-change-snapshot-timeout)
+    (let [freq    (or (cf/get :file-snapshot-every) 20)
+          timeout (or (cf/get :file-snapshot-timeout)
                       (dt/duration {:hours 1}))]
+
       (or (= 1 freq)
           (zero? (mod revn freq))
           (> (inst-ms (dt/diff modified-at (dt/now)))
-           (inst-ms timeout)))))
+             (inst-ms timeout))))))
+
+;; Get the latest available snapshots without exceeding the total
+;; snapshot limit.
+(def ^:private sql:get-latest-snapshots
+  "SELECT fch.id, fch.created_at
+     FROM file_change AS fch
+    WHERE fch.file_id = ?
+      AND fch.label LIKE 'internal/%'
+    ORDER BY fch.created_at DESC
+    LIMIT ?")
+
+;; Mark all snapshots that are outside the allowed total threshold
+;; available for the GC.
+(def ^:private sql:delete-snapshots
+  "UPDATE file_change
+      SET label = NULL
+    WHERE file_id = ?
+      AND label IS NOT NULL
+      AND created_at < ?")
+
+(defn- delete-old-snapshots!
+  [{:keys [::db/conn] :as cfg} {:keys [id] :as file}]
+  (when-let [snapshots (not-empty (db/exec! conn [sql:get-latest-snapshots id
+                                                  (cf/get :file-snapshot-total 10)]))]
+    (let [last-date (-> snapshots peek :created-at)
+          result    (db/exec-one! conn [sql:delete-snapshots id last-date])]
+      (l/trc :hint "delete old snapshots" :file-id (str id) :total (db/get-update-count result)))))
 
 (def ^:private
   sql:lagged-changes

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

@@ -8,7 +8,7 @@
   (:require
    [app.auth.ldap :as ldap]
    [app.common.exceptions :as ex]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.db :as db]
    [app.http.session :as session]
    [app.loggers.audit :as-alias audit]
@@ -19,27 +19,25 @@
    [app.rpc.helpers :as rph]
    [app.setup :as-alias setup]
    [app.tokens :as tokens]
-   [app.util.services :as sv]
+   [app.util.services :as sv]))
-   [clojure.spec.alpha :as s]))
 
 ;; --- COMMAND: login-with-ldap
 
 (declare login-or-register)
 
-(s/def ::email ::us/email)
+(def schema:login-with-ldap
-(s/def ::password ::us/string)
+  [:map {:title "login-with-ldap"}
-(s/def ::invitation-token ::us/string)
+   [:email ::sm/email]
-
+   [:password auth/schema:password]
-(s/def ::login-with-ldap
+   [:invitation-token {:optional true} auth/schema:token]])
-  (s/keys :req-un [::email ::password]
-          :opt-un [::invitation-token]))
 
 (sv/defmethod ::login-with-ldap
   "Performs the authentication using LDAP backend. Only works if LDAP
   is properly configured and enabled with `login-with-ldap` flag."
   {::rpc/auth false
    ::doc/added "1.15"
-   ::doc/module :auth}
+   ::doc/module :auth
+   ::sm/params schema:login-with-ldap}
   [{:keys [::setup/props ::ldap/provider] :as cfg} params]
   (when-not provider
     (ex/raise :type :restriction

backend/src/app/rpc/commands/management.clj

@@ -16,6 +16,7 @@
    [app.config :as cf]
    [app.db :as db]
    [app.http.sse :as sse]
+   [app.loggers.audit :as audit]
    [app.loggers.webhooks :as-alias webhooks]
    [app.rpc :as-alias rpc]
    [app.rpc.commands.files :as files]
@@ -90,7 +91,7 @@
   (sm/define
     [:map {:title "duplicate-file"}
      [:file-id ::sm/uuid]
-     [:name {:optional true} :string]]))
+     [:name {:optional true} [:string {:max 250}]]]))
 
 (sv/defmethod ::duplicate-file
   "Duplicate a single file in the same team."
@@ -152,7 +153,7 @@
   (sm/define
     [:map {:title "duplicate-project"}
      [:project-id ::sm/uuid]
-     [:name {:optional true} :string]]))
+     [:name {:optional true} [:string {:max 250}]]]))
 
 (sv/defmethod ::duplicate-project
   "Duplicate an entire project with all the files"
@@ -397,17 +398,30 @@
 ;; --- COMMAND: Clone Template
 
 (defn- clone-template
-  [{:keys [::wrk/executor ::bf.v1/project-id] :as cfg} template]
+  [cfg {:keys [project-id ::rpc/profile-id] :as params} template]
-  (db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
+  (db/tx-run! cfg (fn [{:keys [::db/conn ::wrk/executor] :as cfg}]
                     ;; NOTE: the importation process performs some operations that
                     ;; are not very friendly with virtual threads, and for avoid
                     ;; unexpected blocking of other concurrent operations we
                     ;; dispatch that operation to a dedicated executor.
-                    (let [result (px/submit! executor (partial bf.v1/import-files! cfg template))]
+                    (let [cfg    (-> cfg
+                                     (assoc ::bf.v1/project-id project-id)
+                                     (assoc ::bf.v1/profile-id profile-id))
+                          result (px/invoke! executor (partial bf.v1/import-files! cfg template))]
+
                       (db/update! conn :project
                                   {:modified-at (dt/now)}
                                   {:id project-id})
-                      (deref result)))))
+
+                      (let [props (audit/clean-props params)]
+                        (doseq [file-id result]
+                          (let [props (assoc props :id file-id)
+                                event (-> (audit/event-from-rpc-params params)
+                                          (assoc ::audit/name "create-file")
+                                          (assoc ::audit/props props))]
+                            (audit/submit! cfg event))))
+
+                      result))))
 
 (def ^:private
   schema:clone-template
@@ -425,16 +439,14 @@
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id project-id template-id] :as params}]
   (let [project   (db/get-by-id pool :project project-id {:columns [:id :team-id]})
         _         (teams/check-edition-permissions! pool profile-id (:team-id project))
-        template  (tmpl/get-template-stream cfg template-id)
+        template  (tmpl/get-template-stream cfg template-id)]
-        params    (-> cfg
+
-                      (assoc ::bf.v1/project-id (:id project))
-                      (assoc ::bf.v1/profile-id profile-id))]
     (when-not template
       (ex/raise :type :not-found
                 :code :template-not-found
                 :hint "template not found"))
 
-    (sse/response #(clone-template params template))))
+    (sse/response #(clone-template cfg params template))))
 
 ;; --- COMMAND: Get list of builtin templates
 

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

@@ -9,7 +9,7 @@
    [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.media :as cm]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
@@ -25,7 +25,6 @@
    [app.util.services :as sv]
    [app.util.time :as dt]
    [app.worker :as-alias wrk]
-   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [datoteka.io :as io]
    [promesa.exec :as px]))
@@ -39,25 +38,21 @@
    :quality 85
    :format :jpeg})
 
-(s/def ::id ::us/uuid)
-(s/def ::name ::us/string)
-(s/def ::file-id ::us/uuid)
-(s/def ::team-id ::us/uuid)
-
 ;; --- Create File Media object (upload)
 
 (declare create-file-media-object)
 
-(s/def ::content ::media/upload)
+(def ^:private schema:upload-file-media-object
-(s/def ::is-local ::us/boolean)
+  [:map {:title "upload-file-media-object"}
-
+   [:id {:optional true} ::sm/uuid]
-(s/def ::upload-file-media-object
+   [:file-id ::sm/uuid]
-  (s/keys :req [::rpc/profile-id]
+   [:is-local :boolean]
-          :req-un [::file-id ::is-local ::name ::content]
+   [:name [:string {:max 250}]]
-          :opt-un [::id]))
+   [:content ::media/upload]])
 
 (sv/defmethod ::upload-file-media-object
   {::doc/added "1.17"
+   ::sm/params schema:upload-file-media-object
    ::climit/id [[:process-image/by-profile ::rpc/profile-id]
                 [:process-image/global]]}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id content] :as params}]
@@ -176,14 +171,17 @@
 
 (declare ^:private create-file-media-object-from-url)
 
-(s/def ::create-file-media-object-from-url
+(def ^:private schema:create-file-media-object-from-url
-  (s/keys :req [::rpc/profile-id]
+  [:map {:title "create-file-media-object-from-url"}
-          :req-un [::file-id ::is-local ::url]
+   [:file-id ::sm/uuid]
-          :opt-un [::id ::name]))
+   [:is-local :boolean]
+   [:url ::sm/uri]
+   [:id {:optional true} ::sm/uuid]
+   [:name {:optional true} [:string {:max 250}]]])
 
 (sv/defmethod ::create-file-media-object-from-url
   {::doc/added "1.17"
-   ::doc/deprecated "1.19"}
+   ::sm/params schema:create-file-media-object-from-url}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
   (let [cfg (update cfg ::sto/storage media/configure-assets-storage)]
     (files/check-edition-permissions! pool profile-id file-id)
@@ -255,12 +253,15 @@
 
 (declare clone-file-media-object)
 
-(s/def ::clone-file-media-object
+(def ^:private schema:clone-file-media-object
-  (s/keys :req [::rpc/profile-id]
+  [:map {:title "clone-file-media-object"}
-          :req-un [::file-id ::is-local ::id]))
+   [:file-id ::sm/uuid]
+   [:is-local :boolean]
+   [:id ::sm/uuid]])
 
 (sv/defmethod ::clone-file-media-object
-  {::doc/added "1.17"}
+  {::doc/added "1.17"
+   ::sm/params schema:clone-file-media-object}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
   (db/with-atomic [conn pool]
     (files/check-edition-permissions! conn profile-id file-id)

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

@@ -28,7 +28,7 @@
    [app.tokens :as tokens]
    [app.util.services :as sv]
    [app.util.time :as dt]
-   [app.worker :as-alias wrk]
+   [app.worker :as wrk]
    [cuerdas.core :as str]
    [promesa.exec :as px]))
 
@@ -276,19 +276,19 @@
 (sv/defmethod ::request-email-change
   {::doc/added "1.0"
    ::sm/params schema:request-email-change}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id email] :as params}]
+  [cfg {:keys [::rpc/profile-id email] :as params}]
-  (db/with-atomic [conn pool]
+  (db/tx-run! cfg
-    (let [profile (db/get-by-id conn :profile profile-id)
+              (fn [cfg]
-          cfg     (assoc cfg ::conn conn)
+                (let [profile (db/get-by-id cfg :profile profile-id)
                       params  (assoc params
                                      :profile profile
                                      :email (clean-email email))]
                   (if (contains? cf/flags :smtp)
                     (request-email-change! cfg params)
-        (change-email-immediately! cfg params)))))
+                    (change-email-immediately! cfg params))))))
 
 (defn- change-email-immediately!
-  [{:keys [::conn]} {:keys [profile email] :as params}]
+  [{:keys [::db/conn]} {:keys [profile email] :as params}]
   (when (not= email (:email profile))
     (check-profile-existence! conn params))
 
@@ -299,7 +299,7 @@
   {:changed true})
 
 (defn- request-email-change!
-  [{:keys [::conn] :as cfg} {:keys [profile email] :as params}]
+  [{:keys [::db/conn] :as cfg} {:keys [profile email] :as params}]
   (let [token   (tokens/generate (::setup/props cfg)
                                  {:iss :change-email
                                   :exp (dt/in-future "15m")
@@ -319,9 +319,28 @@
                 :hint "looks like the profile has reported repeatedly as spam or has permanent bounces."))
 
     (when (eml/has-bounce-reports? conn email)
-      (ex/raise :type :validation
+      (ex/raise :type :restriction
                 :code :email-has-permanent-bounces
-                :hint "looks like the email you invite has been repeatedly reported as spam or permanent bounce"))
+                :email email
+                :hint "looks like the email has bounce reports"))
+
+    (when (eml/has-complaint-reports? conn email)
+      (ex/raise :type :restriction
+                :code :email-has-complaints
+                :email email
+                :hint "looks like the email has spam complaint reports"))
+
+    (when (eml/has-bounce-reports? conn (:email profile))
+      (ex/raise :type :restriction
+                :code :email-has-permanent-bounces
+                :email (:email profile)
+                :hint "looks like the email has bounce reports"))
+
+    (when (eml/has-complaint-reports? conn (:email profile))
+      (ex/raise :type :restriction
+                :code :email-has-complaints
+                :email (:email profile)
+                :hint "looks like the email has spam complaint reports"))
 
     (eml/send! {::eml/conn conn
                 ::eml/factory eml/change-email
@@ -366,13 +385,13 @@
 
 ;; --- MUTATION: Delete Profile
 
-(declare ^:private get-owned-teams-with-participants)
+(declare ^:private get-owned-teams)
 
 (sv/defmethod ::delete-profile
   {::doc/added "1.0"}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
   (db/with-atomic [conn pool]
-    (let [teams      (get-owned-teams-with-participants conn profile-id)
+    (let [teams      (get-owned-teams conn profile-id)
           deleted-at (dt/now)]
 
       ;; If we found owned teams with participants, we don't allow
@@ -384,37 +403,39 @@
                   :hint "The user need to transfer ownership of owned teams."
                   :context {:teams (mapv :id teams)}))
 
-      (doseq [{:keys [id]} teams]
+      ;; Mark profile deleted immediatelly
-        (db/update! conn :team
-                    {:deleted-at deleted-at}
-                    {:id id}))
-
       (db/update! conn :profile
                   {:deleted-at deleted-at}
                   {:id profile-id})
 
+      ;; Schedule cascade deletion to a worker
+      (wrk/submit! {::db/conn conn
+                    ::wrk/task :delete-object
+                    ::wrk/params {:object :profile
+                                  :deleted-at deleted-at
+                                  :id profile-id}})
+
       (rph/with-transform {} (session/delete-fn cfg)))))
 
 
 ;; --- HELPERS
 
 (def sql:owned-teams
-  "with owner_teams as (
+  "WITH owner_teams AS (
-      select tpr.team_id as id
+      SELECT tpr.team_id AS id
-        from team_profile_rel as tpr
+        FROM team_profile_rel AS tpr
-       where tpr.is_owner is true
+       WHERE tpr.is_owner IS TRUE
-         and tpr.profile_id = ?
+         AND tpr.profile_id = ?
    )
-   select tpr.team_id as id,
+   SELECT tpr.team_id AS id,
-          count(tpr.profile_id) - 1 as participants
+          count(tpr.profile_id) - 1 AS participants
-     from team_profile_rel as tpr
+     FROM team_profile_rel AS tpr
-    where tpr.team_id in (select id from owner_teams)
+    WHERE tpr.team_id IN (SELECT id from owner_teams)
-      and tpr.profile_id != ?
+    GROUP BY 1")
-    group by 1")
 
-(defn- get-owned-teams-with-participants
+(defn get-owned-teams
   [conn profile-id]
-  (db/exec! conn [sql:owned-teams profile-id profile-id]))
+  (db/exec! conn [sql:owned-teams profile-id]))
 
 (def ^:private sql:profile-existence
   "select exists (select * from profile

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

@@ -8,7 +8,7 @@
   (:require
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.db :as db]
    [app.db.sql :as-alias sql]
    [app.loggers.audit :as-alias audit]
@@ -21,11 +21,7 @@
    [app.rpc.quotes :as quotes]
    [app.util.services :as sv]
    [app.util.time :as dt]
-   [app.worker :as wrk]
+   [app.worker :as wrk]))
-   [clojure.spec.alpha :as s]))
-
-(s/def ::id ::us/uuid)
-(s/def ::name ::us/string)
 
 ;; --- Check Project Permissions
 
@@ -75,13 +71,13 @@
 
 (declare get-projects)
 
-(s/def ::team-id ::us/uuid)
+(def ^:private schema:get-projects
-(s/def ::get-projects
+  [:map {:title "get-projects"}
-  (s/keys :req [::rpc/profile-id]
+   [:team-id ::sm/uuid]])
-          :req-un [::team-id]))
 
 (sv/defmethod ::get-projects
-  {::doc/added "1.18"}
+  {::doc/added "1.18"
+   ::sm/params schema:get-projects}
   [{:keys [::db/pool]} {:keys [::rpc/profile-id team-id]}]
   (dm/with-open [conn (db/open pool)]
     (teams/check-read-permissions! conn profile-id team-id)
@@ -112,11 +108,12 @@
 
 (declare get-all-projects)
 
-(s/def ::get-all-projects
+(def ^:private schema:get-all-projects
-  (s/keys :req [::rpc/profile-id]))
+  [:map {:title "get-all-projects"}])
 
 (sv/defmethod ::get-all-projects
-  {::doc/added "1.18"}
+  {::doc/added "1.18"
+   ::sm/params schema:get-all-projects}
   [{:keys [::db/pool]} {:keys [::rpc/profile-id]}]
   (dm/with-open [conn (db/open pool)]
     (get-all-projects conn profile-id)))
@@ -154,12 +151,13 @@
 
 ;; --- QUERY: Get project
 
-(s/def ::get-project
+(def ^:private schema:get-project
-  (s/keys :req [::rpc/profile-id]
+  [:map {:title "get-project"}
-          :req-un [::id]))
+   [:id ::sm/uuid]])
 
 (sv/defmethod ::get-project
-  {::doc/added "1.18"}
+  {::doc/added "1.18"
+   ::sm/params schema:get-project}
   [{:keys [::db/pool]} {:keys [::rpc/profile-id id]}]
   (dm/with-open [conn (db/open pool)]
     (let [project (db/get-by-id conn :project id)]
@@ -170,14 +168,16 @@
 
 ;; --- MUTATION: Create Project
 
-(s/def ::create-project
+(def ^:private schema:create-project
-  (s/keys :req [::rpc/profile-id]
+  [:map {:title "create-project"}
-          :req-un [::team-id ::name]
+   [:team-id ::sm/uuid]
-          :opt-un [::id]))
+   [:name [:string {:max 250 :min 1}]]
+   [:id {:optional true} ::sm/uuid]])
 
 (sv/defmethod ::create-project
   {::doc/added "1.18"
-   ::webhooks/event? true}
+   ::webhooks/event? true
+   ::sm/params schema:create-project}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id] :as params}]
   (db/with-atomic [conn pool]
     (teams/check-edition-permissions! conn profile-id team-id)
@@ -205,14 +205,15 @@
        on conflict (team_id, project_id, profile_id)
        do update set is_pinned=?")
 
-(s/def ::is-pinned ::us/boolean)
+(def ^:private schema:update-project-pin
-(s/def ::project-id ::us/uuid)
+  [:map {:title "update-project-pin"}
-(s/def ::update-project-pin
+   [:team-id ::sm/uuid]
-  (s/keys :req [::rpc/profile-id]
+   [:is-pinned :boolean]
-          :req-un [::id ::team-id ::is-pinned]))
+   [:id ::sm/uuid]])
 
 (sv/defmethod ::update-project-pin
   {::doc/added "1.18"
+   ::sm/params schema:update-project-pin
    ::webhooks/batch-timeout (dt/duration "5s")
    ::webhooks/batch-key (webhooks/key-fn ::rpc/profile-id :id)
    ::webhooks/event? true}
@@ -226,12 +227,14 @@
 
 (declare rename-project)
 
-(s/def ::rename-project
+(def ^:private schema:rename-project
-  (s/keys :req [::rpc/profile-id]
+  [:map {:title "rename-project"}
-          :req-un [::name ::id]))
+   [:name [:string {:max 250 :min 1}]]
+   [:id ::sm/uuid]])
 
 (sv/defmethod ::rename-project
   {::doc/added "1.18"
+   ::sm/params schema:rename-project
    ::webhooks/event? true}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id name] :as params}]
   (db/with-atomic [conn pool]
@@ -258,20 +261,22 @@
                 :code :non-deletable-project
                 :hint "impossible to delete default project"))
 
-    (wrk/submit! {::wrk/task :delete-object
+    (wrk/submit! {::db/conn conn
-                  ::wrk/conn conn
+                  ::wrk/task :delete-object
-                  :object :project
+                  ::wrk/params {:object :project
                                 :deleted-at (:deleted-at project)
-                  :id project-id})
+                                :id project-id}})
 
     project))
 
-(s/def ::delete-project
+
-  (s/keys :req [::rpc/profile-id]
+(def ^:private schema:delete-project
-          :req-un [::id]))
+  [:map {:title "delete-project"}
+   [:id ::sm/uuid]])
 
 (sv/defmethod ::delete-project
   {::doc/added "1.18"
+   ::sm/params schema:delete-project
    ::webhooks/event? true}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
   (db/with-atomic [conn pool]

backend/src/app/rpc/commands/search.clj

@@ -6,13 +6,12 @@
 
 (ns app.rpc.commands.search
   (:require
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.db :as db]
    [app.rpc :as-alias rpc]
    [app.rpc.commands.files :refer [resolve-public-uri]]
    [app.rpc.doc :as-alias doc]
-   [app.util.services :as sv]
+   [app.util.services :as sv]))
-   [clojure.spec.alpha :as s]))
 
 (def ^:private sql:search-files
   "with projects as (
@@ -65,16 +64,14 @@
                      (assoc :thumbnail-uri (resolve-public-uri media-id)))
                  (dissoc row :media-id))))))
 
-(s/def ::team-id ::us/uuid)
+(def ^:private schema:search-files
-(s/def ::search-files ::us/string)
+  [:map {:title "search-files"}
-
+   [:team-id ::sm/uuid]
-(s/def ::search-files
+   [:search-term {:optional true} :string]])
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id]
-          :opt-un [::search-term]))
 
 (sv/defmethod ::search-files
   {::doc/added "1.17"
-   ::doc/module :files}
+   ::doc/module :files
+   ::sm/params schema:search-files}
   [{:keys [::db/pool]} {:keys [::rpc/profile-id team-id search-term]}]
   (some->> search-term (search-files pool profile-id team-id)))

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

@@ -12,7 +12,6 @@
    [app.common.features :as cfeat]
    [app.common.logging :as l]
    [app.common.schema :as sm]
-   [app.common.spec :as us]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
@@ -32,16 +31,10 @@
    [app.util.services :as sv]
    [app.util.time :as dt]
    [app.worker :as wrk]
-   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]))
 
 ;; --- Helpers & Specs
 
-(s/def ::id ::us/uuid)
-(s/def ::name ::us/string)
-(s/def ::file-id ::us/uuid)
-(s/def ::team-id ::us/uuid)
-
 (def ^:private sql:team-permissions
   "select tpr.is_owner,
           tpr.is_admin,
@@ -351,7 +344,7 @@
 
 (def ^:private schema:create-team
   [:map {:title "create-team"}
-   [:name :string]
+   [:name [:string {:max 250}]]
    [:features {:optional true} ::cfeat/features]
    [:id {:optional true} ::sm/uuid]])
 
@@ -364,10 +357,12 @@
                                                ::quotes/profile-id profile-id})
 
                     (let [features (-> (cfeat/get-enabled-features cf/flags)
-                                       (cfeat/check-client-features! (:features params)))]
+                                       (cfeat/check-client-features! (:features params)))
-                      (create-team cfg (assoc params
+                          team (create-team cfg (assoc params
                                                        :profile-id profile-id
-                                              :features features))))))
+                                                       :features features))]
+                      (with-meta team
+                        {::audit/props {:id (:id team)}})))))
 
 (defn create-team
   "This is a complete team creation process, it creates the team
@@ -438,12 +433,14 @@
 
 ;; --- Mutation: Update Team
 
-(s/def ::update-team
+(def ^:private schema:update-team
-  (s/keys :req [::rpc/profile-id]
+  [:map {:title "update-team"}
-          :req-un [::name ::id]))
+   [:name [:string {:max 250}]]
+   [:id ::sm/uuid]])
 
 (sv/defmethod ::update-team
-  {::doc/added "1.17"}
+  {::doc/added "1.17"
+   ::sm/params schema:update-team}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id name] :as params}]
   (db/with-atomic [conn pool]
     (check-edition-permissions! conn profile-id id)
@@ -503,14 +500,14 @@
 
     nil))
 
-(s/def ::reassign-to ::us/uuid)
+(def ^:private schema:leave-team
-(s/def ::leave-team
+  [:map {:title "leave-team"}
-  (s/keys :req [::rpc/profile-id]
+   [:id ::sm/uuid]
-          :req-un [::id]
+   [:reassign-to {:optional true} ::sm/uuid]])
-          :opt-un [::reassign-to]))
 
 (sv/defmethod ::leave-team
-  {::doc/added "1.17"}
+  {::doc/added "1.17"
+   ::sm/params schema:leave-team}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
   (db/with-atomic [conn pool]
     (leave-team conn (assoc params :profile-id profile-id))))
@@ -532,19 +529,20 @@
                 :code :non-deletable-team
                 :hint "impossible to delete default team"))
 
-    (wrk/submit! {::wrk/task :delete-object
+    (wrk/submit! {::db/conn conn
-                  ::wrk/conn conn
+                  ::wrk/task :delete-object
-                  :object :team
+                  ::wrk/params {:object :team
                                 :deleted-at deleted-at
-                  :id team-id})
+                                :id team-id}})
     team))
 
-(s/def ::delete-team
+(def ^:private schema:delete-team
-  (s/keys :req [::rpc/profile-id]
+  [:map {:title "delete-team"}
-          :req-un [::id]))
+   [:id ::sm/uuid]])
 
 (sv/defmethod ::delete-team
-  {::doc/added "1.17"}
+  {::doc/added "1.17"
+   ::sm/params schema:delete-team}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
   (db/with-atomic [conn pool]
     (let [perms (get-permissions conn profile-id id)]
@@ -557,10 +555,6 @@
 
 ;; --- Mutation: Team Update Role
 
-(s/def ::team-id ::us/uuid)
-(s/def ::member-id ::us/uuid)
-(s/def ::role #{:owner :admin :editor})
-
 ;; Temporarily disabled viewer role
 ;; https://tree.taiga.io/project/penpot/issue/1083
 (def valid-roles
@@ -624,25 +618,29 @@
                    :profile-id member-id})
       nil)))
 
-(s/def ::update-team-member-role
+(def ^:private schema:update-team-member-role
-  (s/keys :req [::rpc/profile-id]
+  [:map {:title "update-team-member-role"}
-          :req-un [::team-id ::member-id ::role]))
+   [:team-id ::sm/uuid]
+   [:member-id ::sm/uuid]
+   [:role schema:role]])
 
 (sv/defmethod ::update-team-member-role
-  {::doc/added "1.17"}
+  {::doc/added "1.17"
+   ::sm/params schema:update-team-member-role}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id] :as params}]
   (db/with-atomic [conn pool]
     (update-team-member-role conn (assoc params :profile-id profile-id))))
 
-
 ;; --- Mutation: Delete Team Member
 
-(s/def ::delete-team-member
+(def ^:private schema:delete-team-member
-  (s/keys :req [::rpc/profile-id]
+  [:map {:title "delete-team-member"}
-          :req-un [::team-id ::member-id]))
+   [:team-id ::sm/uuid]
+   [:member-id ::sm/uuid]])
 
 (sv/defmethod ::delete-team-member
-  {::doc/added "1.17"}
+  {::doc/added "1.17"
+   ::sm/params schema:delete-team-member}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id member-id] :as params}]
   (db/with-atomic [conn pool]
     (let [perms (get-permissions conn profile-id team-id)]
@@ -665,13 +663,14 @@
 (declare upload-photo)
 (declare ^:private update-team-photo)
 
-(s/def ::file ::media/upload)
+(def ^:private schema:update-team-photo
-(s/def ::update-team-photo
+  [:map {:title "update-team-photo"}
-  (s/keys :req [::rpc/profile-id]
+   [:team-id ::sm/uuid]
-          :req-un [::team-id ::file]))
+   [:file ::media/upload]])
 
 (sv/defmethod ::update-team-photo
-  {::doc/added "1.17"}
+  {::doc/added "1.17"
+   ::sm/params schema:update-team-photo}
   [cfg {:keys [::rpc/profile-id file] :as params}]
   ;; Validate incoming mime type
   (media/validate-media-type! file #{"image/jpeg" "image/png" "image/webp"})
@@ -735,12 +734,19 @@
                 :email email
                 :hint "the profile has reported repeatedly as spam or has bounces"))
 
-    ;; Secondly check if the invited member email is part of the global spam/bounce report.
+    ;; Secondly check if the invited member email is part of the global bounce report.
     (when (eml/has-bounce-reports? conn email)
-      (ex/raise :type :validation
+      (ex/raise :type :restriction
                 :code :email-has-permanent-bounces
                 :email email
-                :hint "the email you invite has been repeatedly reported as spam or bounce"))
+                :hint "the email you invite has been repeatedly reported as bounce"))
+
+    ;; Secondly check if the invited member email is part of the global complain report.
+    (when (eml/has-complaint-reports? conn email)
+      (ex/raise :type :restriction
+                :code :email-has-complaints
+                :email email
+                :hint "the email you invite has been repeatedly reported as spam"))
 
     ;; When we have email verification disabled and invitation user is
     ;; already present in the database, we proceed to add it to the
@@ -766,6 +772,7 @@
                       {:id (:id member)}))
 
         nil)
+
       (let [id         (uuid/next)
             expire     (dt/in-future "168h") ;; 7 days
             invitation (db/exec-one! conn [sql:upsert-team-invitation id
@@ -786,14 +793,16 @@
         (when (contains? cf/flags :log-invitation-tokens)
           (l/info :hint "invitation token" :token itoken))
 
-        (audit/submit! cfg
+
-                       {::audit/type "action"
+        (let [props  (-> (dissoc tprops :profile-id)
-                        ::audit/name (if updated?
+                         (audit/clean-props))
+              evname (if updated?
                        "update-team-invitation"
                        "create-team-invitation")
-                        ::audit/profile-id (:id profile)
+              event (-> (audit/event-from-rpc-params params)
-                        ::audit/props (-> (dissoc tprops :profile-id)
+                        (assoc ::audit/name evname)
-                                          (d/without-nils))})
+                        (assoc ::audit/props props))]
+          (audit/submit! cfg event))
 
         (eml/send! {::eml/conn conn
                     ::eml/factory eml/invite-to-team
@@ -809,7 +818,7 @@
 (def ^:private schema:create-team-invitations
   [:map {:title "create-team-invitations"}
    [:team-id ::sm/uuid]
-   [:role [::sm/one-of #{:owner :admin :editor}]]
+   [:role schema:role]
    [:emails ::sm/set-of-emails]])
 
 (sv/defmethod ::create-team-invitations
@@ -853,28 +862,22 @@
                                ;;  We don't re-send inviation to already existing members
                                (remove (partial contains? members))
                                (map (fn [email]
-                                      {:email email
+                                      (-> params
-                                       :team team
+                                          (assoc :email email)
-                                       :profile profile
+                                          (assoc :team team)
-                                       :role role}))
+                                          (assoc :profile profile)
+                                          (assoc :role role))))
                                (keep (partial create-invitation cfg)))
                               emails)]
         (with-meta {:total (count invitations)
                     :invitations invitations}
           {::audit/props {:invitations (count invitations)}})))))
 
-
 ;; --- Mutation: Create Team & Invite Members
 
-(s/def ::emails ::us/set-of-valid-emails)
-(s/def ::create-team-with-invitations
-  (s/merge ::create-team
-           (s/keys :req-un [::emails ::role])))
-
-
 (def ^:private schema:create-team-with-invitations
   [:map {:title "create-team-with-invitations"}
-   [:name :string]
+   [:name [:string {:max 250}]]
    [:features {:optional true} ::cfeat/features]
    [:id {:optional true} ::sm/uuid]
    [:emails ::sm/set-of-emails]
@@ -883,26 +886,36 @@
 (sv/defmethod ::create-team-with-invitations
   {::doc/added "1.17"
    ::sm/params schema:create-team-with-invitations}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id emails role] :as params}]
+  [cfg {:keys [::rpc/profile-id emails role name] :as params}]
-  (db/with-atomic [conn pool]
 
+  (db/tx-run! cfg
+              (fn [{:keys [::db/conn] :as cfg}]
                 (let [features (-> (cfeat/get-enabled-features cf/flags)
                                    (cfeat/check-client-features! (:features params)))
-          params   (assoc params
+
-                          :profile-id profile-id
+                      params   (-> params
-                          :features features)
+                                   (assoc :profile-id profile-id)
+                                   (assoc :features features))
+
                       cfg      (assoc cfg ::db/conn conn)
                       team     (create-team cfg params)
                       profile  (db/get-by-id conn :profile profile-id)
                       emails   (into #{} (map profile/clean-email) emails)]
 
+                  (let [props {:name name :features features}
+                        event (-> (audit/event-from-rpc-params params)
+                                  (assoc ::audit/name "create-team")
+                                  (assoc ::audit/props props))]
+                    (audit/submit! cfg event))
+
                   ;; Create invitations for all provided emails.
                   (->> emails
                        (map (fn [email]
-                  {:team team
+                              (-> params
-                   :profile profile
+                                  (assoc :team team)
-                   :email email
+                                  (assoc :profile profile)
-                   :role role}))
+                                  (assoc :email email)
+                                  (assoc :role role))))
                        (run! (partial create-invitation cfg)))
 
                   (run! (partial quotes/check-quote! conn)
@@ -917,25 +930,18 @@
                                ::quotes/team-id (:id team)
                                ::quotes/incr (count emails)}))
 
-      (audit/submit! cfg
+                  (vary-meta team assoc ::audit/props {:invitations (count emails)})))))
-                     {::audit/type "command"
-                      ::audit/name "create-team-invitations"
-                      ::audit/profile-id profile-id
-                      ::audit/props {:emails emails
-                                     :role role
-                                     :profile-id profile-id
-                                     :invitations (count emails)}})
-
-      (vary-meta team assoc ::audit/props {:invitations (count emails)}))))
 
 ;; --- Query: get-team-invitation-token
 
-(s/def ::get-team-invitation-token
+(def ^:private schema:get-team-invitation-token
-  (s/keys :req [::rpc/profile-id]
+  [:map {:title "get-team-invitation-token"}
-          :req-un [::team-id ::email]))
+   [:team-id ::sm/uuid]
+   [:email ::sm/email]])
 
 (sv/defmethod ::get-team-invitation-token
-  {::doc/added "1.17"}
+  {::doc/added "1.17"
+   ::sm/params schema:get-team-invitation-token}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email] :as params}]
   (check-read-permissions! pool profile-id team-id)
   (let [email (profile/clean-email email)
@@ -956,12 +962,15 @@
 
 ;; --- Mutation: Update invitation role
 
-(s/def ::update-team-invitation-role
+(def ^:private schema:update-team-invitation-role
-  (s/keys :req [::rpc/profile-id]
+  [:map {:title "update-team-invitation-role"}
-          :req-un [::team-id ::email ::role]))
+   [:team-id ::sm/uuid]
+   [:email ::sm/email]
+   [:role schema:role]])
 
 (sv/defmethod ::update-team-invitation-role
-  {::doc/added "1.17"}
+  {::doc/added "1.17"
+   ::sm/params schema:update-team-invitation-role}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email role] :as params}]
   (db/with-atomic [conn pool]
     (let [perms    (get-permissions conn profile-id team-id)]
@@ -977,12 +986,14 @@
 
 ;; --- Mutation: Delete invitation
 
-(s/def ::delete-team-invitation
+(def ^:private schema:delete-team-invition
-  (s/keys :req [::rpc/profile-id]
+  [:map {:title "delete-team-invitation"}
-          :req-un [::team-id ::email]))
+   [:team-id ::sm/uuid]
+   [:email ::sm/email]])
 
 (sv/defmethod ::delete-team-invitation
-  {::doc/added "1.17"}
+  {::doc/added "1.17"
+   ::sm/params schema:delete-team-invition}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email] :as params}]
   (db/with-atomic [conn pool]
     (let [perms (get-permissions conn profile-id team-id)]

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

@@ -7,7 +7,7 @@
 (ns app.rpc.commands.verify-token
   (:require
    [app.common.exceptions :as ex]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.db :as db]
    [app.db.sql :as-alias sql]
    [app.http.session :as session]
@@ -23,21 +23,19 @@
    [app.tokens :as tokens]
    [app.tokens.spec.team-invitation :as-alias spec.team-invitation]
    [app.util.services :as sv]
-   [clojure.spec.alpha :as s]))
+   [app.util.time :as dt]))
-
-(s/def ::iss keyword?)
-(s/def ::exp ::us/inst)
 
 (defmulti process-token (fn [_ _ claims] (:iss claims)))
 
-(s/def ::verify-token
+(def ^:private schema:verify-token
-  (s/keys :req-un [::token]
+  [:map {:title "verify-token"}
-          :opt [::rpc/profile-id]))
+   [:token [:string {:max 1000}]]])
 
 (sv/defmethod ::verify-token
   {::rpc/auth false
    ::doc/added "1.15"
-   ::doc/module :auth}
+   ::doc/module :auth
+   ::sm/params schema:verify-token}
   [{:keys [::db/pool] :as cfg} {:keys [token] :as params}]
   (db/with-atomic [conn pool]
     (let [claims (tokens/verify (::setup/props cfg) {:token token})
@@ -131,26 +129,28 @@
 
     (assoc member :is-active true)))
 
-(s/def ::spec.team-invitation/profile-id ::us/uuid)
+(def schema:team-invitation-claims
-(s/def ::spec.team-invitation/role ::us/keyword)
+  [:map {:title "TeamInvitationClaims"}
-(s/def ::spec.team-invitation/team-id ::us/uuid)
+   [:iss :keyword]
-(s/def ::spec.team-invitation/member-email ::us/email)
+   [:exp ::dt/instant]
-(s/def ::spec.team-invitation/member-id (s/nilable ::us/uuid))
+   [:profile-id ::sm/uuid]
+   [:role teams/schema:role]
+   [:team-id ::sm/uuid]
+   [:member-email ::sm/email]
+   [:member-id {:optional true} ::sm/uuid]])
 
-(s/def ::team-invitation-claims
+(def valid-team-invitation-claims?
-  (s/keys :req-un [::iss ::exp
+  (sm/lazy-validator schema:team-invitation-claims))
-                   ::spec.team-invitation/profile-id
-                   ::spec.team-invitation/role
-                   ::spec.team-invitation/team-id
-                   ::spec.team-invitation/member-email]
-          :opt-un [::spec.team-invitation/member-id]))
 
 (defmethod process-token :team-invitation
   [{:keys [conn] :as cfg}
-   {:keys [::rpc/profile-id token]}
+   {:keys [::rpc/profile-id token] :as params}
    {:keys [member-id team-id member-email] :as claims}]
 
-  (us/verify! ::team-invitation-claims claims)
+  (when-not (valid-team-invitation-claims? claims)
+    (ex/raise :type :validation
+              :code :invalid-invitation-token
+              :hint "invitation token contains unexpected data"))
 
   (let [invitation (db/get* conn :team-invitation
                             {:team-id team-id :email-to member-email})
@@ -169,13 +169,16 @@
         ;; if we have logged-in user and it matches the invitation we proceed
         ;; with accepting the invitation and joining the current profile to the
         ;; invited team.
-        (let [profile (accept-invitation cfg claims invitation profile)]
+        (let [props {:team-id (:team-id claims)
-          (-> (assoc claims :state :created)
-              (rph/with-meta {::audit/name "accept-team-invitation"
-                              ::audit/profile-id (:id profile)
-                              ::audit/props {:team-id (:team-id claims)
                      :role (:role claims)
-                                             :invitation-id (:id invitation)}})))
+                     :invitation-id (:id invitation)}
+              event (-> (audit/event-from-rpc-params params)
+                        (assoc ::audit/name "accept-team-invitation")
+                        (assoc ::audit/props props))]
+
+          (accept-invitation cfg claims invitation profile)
+          (audit/submit! cfg event)
+          (assoc claims :state :created))
 
         (ex/raise :type :validation
                   :code :invalid-token

backend/src/app/rpc/commands/webhooks.clj

@@ -8,7 +8,7 @@
   (:require
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
-   [app.common.spec :as us]
+   [app.common.schema :as sm]
    [app.common.uri :as u]
    [app.common.uuid :as uuid]
    [app.db :as db]
@@ -19,7 +19,6 @@
    [app.rpc.doc :as-alias doc]
    [app.util.services :as sv]
    [app.util.time :as dt]
-   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]))
 
 (defn decode-row
@@ -29,18 +28,6 @@
 
 ;; --- Mutation: Create Webhook
 
-(s/def ::team-id ::us/uuid)
-(s/def ::uri ::us/uri)
-(s/def ::is-active ::us/boolean)
-(s/def ::mtype
-  #{"application/json"
-    "application/transit+json"})
-
-(s/def ::create-webhook
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id ::uri ::mtype]
-          :opt-un [::is-active]))
-
 ;; NOTE: for now the quote is hardcoded but this need to be solved in
 ;; a more universal way for handling properly object quotes
 (def max-hooks-for-team 8)
@@ -99,31 +86,49 @@
                   {::db/return-keys true})
       (decode-row)))
 
+
+(def valid-mtypes
+  #{"application/json"
+    "application/transit+json"})
+
+(def ^:private schema:create-webhook
+  [:map {:title "create-webhook"}
+   [:team-id ::sm/uuid]
+   [:uri ::sm/uri]
+   [:mtype [::sm/one-of {:format "string"} valid-mtypes]]])
+
 (sv/defmethod ::create-webhook
-  {::doc/added "1.17"}
+  {::doc/added "1.17"
+   ::sm/params schema:create-webhook}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id] :as params}]
   (check-edition-permissions! pool profile-id team-id)
   (validate-quotes! cfg params)
   (validate-webhook! cfg nil params)
   (insert-webhook! cfg params))
 
-(s/def ::update-webhook
+(def ^:private schema:update-webhook
-  (s/keys :req-un [::id ::uri ::mtype ::is-active]))
+  [:map {:title "update-webhook"}
+   [:id ::sm/uuid]
+   [:uri ::sm/uri]
+   [:mtype [::sm/one-of {:format "string"} valid-mtypes]]
+   [:is-active :boolean]])
 
 (sv/defmethod ::update-webhook
-  {::doc/added "1.17"}
+  {::doc/added "1.17"
+   ::sm/params schema:update-webhook}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id] :as params}]
   (let [whook (-> (db/get pool :webhook {:id id}) (decode-row))]
     (check-edition-permissions! pool profile-id (:team-id whook))
     (validate-webhook! cfg whook params)
     (update-webhook! cfg whook params)))
 
-(s/def ::delete-webhook
+(def ^:private schema:delete-webhook
-  (s/keys :req [::rpc/profile-id]
+  [:map {:title "delete-webhook"}
-          :req-un [::id]))
+   [:id ::sm/uuid]])
 
 (sv/defmethod ::delete-webhook
-  {::doc/added "1.17"}
+  {::doc/added "1.17"
+   ::sm/params schema:delete-webhook}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id]}]
   (db/with-atomic [conn pool]
     (let [whook (-> (db/get conn :webhook {:id id}) decode-row)]
@@ -133,16 +138,17 @@
 
 ;; --- Query: Webhooks
 
-(s/def ::team-id ::us/uuid)
-(s/def ::get-webhooks
-  (s/keys :req [::rpc/profile-id]
-          :req-un [::team-id]))
-
 (def sql:get-webhooks
   "select id, uri, mtype, is_active, error_code, error_count
    from webhook where team_id = ? order by uri")
 
+(def ^:private schema:get-webhooks
+  [:map {:title "get-webhooks"}
+   [:team-id ::sm/uuid]])
+
 (sv/defmethod ::get-webhooks
+  {::doc/added "1.17"
+   ::sm/params schema:get-webhooks}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id]}]
   (dm/with-open [conn (db/open pool)]
     (check-read-permissions! conn profile-id team-id)

backend/src/app/rpc/permissions.clj

@@ -12,7 +12,7 @@
    [app.common.spec :as us]
    [clojure.spec.alpha :as s]))
 
-(sm/def! ::permissions
+(sm/register! ::permissions
   [:map {:title "Permissions"}
    [:type {:gen/elements [:membership :share-link]} :keyword]
    [:is-owner :boolean]

backend/src/app/rpc/quotes.clj

@@ -83,17 +83,17 @@
                             "- Quote ID: '~(::target params)'\n"
                             "- Max: ~(::quote params)\n"
                             "- Total: ~(::total params) (INCR ~(::incr params 1))\n")]
-      (wrk/submit! {::wrk/task :sendmail
+      (wrk/submit! {::db/conn conn
+                    ::wrk/task :sendmail
                     ::wrk/delay (dt/duration "30s")
                     ::wrk/max-retries 4
                     ::wrk/priority 200
-                    ::wrk/conn conn
                     ::wrk/dedupe true
                     ::wrk/label "quotes-notification"
-                    :to (vec admins)
+                    ::wrk/params {:to (vec admins)
                                   :subject subject
                                   :body [{:type "text/plain"
-                            :content content}]}))))
+                                          :content content}]}}))))
 
 (defn- generic-check!
   [{:keys [::db/conn ::incr ::quote-sql ::count-sql ::default ::target] :or {incr 1} :as params}]

backend/src/app/rpc/rlimit.clj

@@ -51,12 +51,12 @@
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.http :as-alias http]
-   [app.loggers.audit :refer [parse-client-ip]]
    [app.redis :as rds]
    [app.redis.script :as-alias rscript]
    [app.rpc :as-alias rpc]
    [app.rpc.helpers :as rph]
    [app.rpc.rlimit.result :as-alias lresult]
+   [app.util.inet :as inet]
    [app.util.services :as-alias sv]
    [app.util.time :as dt]
    [app.worker :as wrk]
@@ -215,7 +215,7 @@
   [{:keys [::rpc/profile-id] :as params}]
   (let [request (-> params meta ::http/request)]
     (or profile-id
-        (some-> request parse-client-ip)
+        (some-> request inet/parse-request)
         uuid/zero)))
 
 (defn process-request!

backend/src/app/srepl/fixes.clj

@@ -184,10 +184,7 @@
                                              (ctk/instance-head? child))
                                       (let [slot (guess-swap-slot component-child component-container)]
                                         (l/dbg :hint "child" :id (:id child) :name (:name child) :slot slot)
-                                        (ctn/update-shape container (:id child)
+                                        (ctn/update-shape container (:id child) #(ctk/set-swap-slot % slot)))
-                                                          #(update % :touched
-                                                                   cfh/set-touched-group
-                                                                   (ctk/build-swap-slot-group slot))))
                                       container)]
                       (recur (process-copy-head container child)
                              (rest children)
@@ -237,3 +234,44 @@
 
     file  (-> file
               (update :data process-fdata))))
+
+
+
+(defn fix-find-duplicated-slots
+  [file _]
+  ;; Find the shapes whose children have duplicated slots
+  (let [check-duplicate-swap-slot
+        (fn [shape page]
+          (let [shapes   (map #(get (:objects page) %) (:shapes shape))
+                slots    (->> (map #(ctk/get-swap-slot %) shapes)
+                              (remove nil?))
+                counts   (frequencies slots)]
+            #_(when (some (fn [[_ count]] (> count 1)) counts)
+                (l/trc :info "This shape has children with the same swap slot" :id (:id shape) :file-id (str (:id file))))
+            (some (fn [[_ count]] (> count 1)) counts)))
+
+        count-slots-shape
+        (fn [page shape]
+          (if (ctk/instance-root? shape)
+            (check-duplicate-swap-slot shape page)
+            false))
+
+        count-slots-page
+        (fn [page]
+          (->> (:objects page)
+               (vals)
+               (mapv #(count-slots-shape page %))
+               (filter true?)
+               count))
+
+        count-slots-data
+        (fn [data]
+          (->> (:pages-index data)
+               (vals)
+               (mapv count-slots-page)
+               (reduce +)))
+
+        num-missing-slots (count-slots-data (:data file))]
+    (when (pos? num-missing-slots)
+      (l/trc :info (str "Shapes with children with the same swap slot: " num-missing-slots) :file-id (str (:id file))))
+    file))

backend/src/app/srepl/main.clj

@@ -21,8 +21,10 @@
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
+   [app.db.sql :as-alias sql]
    [app.features.components-v2 :as feat.comp-v2]
    [app.features.fdata :as feat.fdata]
+   [app.loggers.audit :as audit]
    [app.main :as main]
    [app.msgbus :as mbus]
    [app.rpc.commands.auth :as auth]
@@ -38,10 +40,12 @@
    [app.util.pointer-map :as pmap]
    [app.util.time :as dt]
    [app.worker :as wrk]
+   [clojure.java.io :as io]
    [clojure.pprint :refer [print-table]]
    [clojure.stacktrace :as strace]
    [clojure.tools.namespace.repl :as repl]
    [cuerdas.core :as str]
+   [datoteka.fs :as fs]
    [promesa.exec :as px]
    [promesa.exec.semaphore :as ps]
    [promesa.util :as pu]))
@@ -59,32 +63,27 @@
   ([tname]
    (run-task! tname {}))
   ([tname params]
-   (let [tasks (:app.worker/registry main/system)
+   (wrk/invoke! (-> main/system
-         tname (if (keyword? tname) (name tname) name)]
+                    (assoc ::wrk/task tname)
-     (if-let [task-fn (get tasks tname)]
+                    (assoc ::wrk/params params)))))
-       (task-fn params)
-       (println (format "no task '%s' found" tname))))))
 
 (defn schedule-task!
   ([name]
    (schedule-task! name {}))
-  ([name props]
+  ([name params]
-   (let [pool (:app.db/pool main/system)]
+   (wrk/submit! (-> main/system
-     (wrk/submit!
+                    (assoc ::wrk/task name)
-      ::wrk/conn pool
+                    (assoc ::wrk/params params)))))
-      ::wrk/task name
-      ::wrk/props props))))
 
 (defn send-test-email!
   [destination]
-  (us/verify!
+  (assert (string? destination) "destination should be provided")
-   :expr (string? destination)
+  (-> main/system
-   :hint "destination should be provided")
+      (assoc ::wrk/task :sendmail)
-
+      (assoc ::wrk/params {:body "test email"
-  (let [handler (:app.email/sendmail main/system)]
-    (handler {:body "test email"
                            :subject "test email"
-              :to [destination]})))
+                           :to [destination]})
+      (wrk/invoke!)))
 
 (defn resend-email-verification-email!
   [email]
@@ -195,6 +194,12 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn notify!
+  "Send flash notifications.
+
+  This method allows send flash notifications to specified target destinations.
+  The message can be a free text or a preconfigured one.
+
+  The destination can be: all, profile-id, team-id, or a coll of them."
   [{:keys [::mbus/msgbus ::db/pool]} & {:keys [dest code message level]
                                         :or {code :generic level :info}
                                         :as params}]
@@ -202,10 +207,6 @@
    ["invalid level %" level]
    (contains? #{:success :error :info :warning} level))
 
-  (dm/verify!
-   ["invalid code: %" code]
-   (contains? #{:generic :upgrade-version} code))
-
   (letfn [(send [dest]
             (l/inf :hint "sending notification" :dest (str dest))
             (let [message {:type :notification
@@ -231,6 +232,9 @@
 
           (resolve-dest [dest]
             (cond
+              (= :all dest)
+              [uuid/zero]
+
               (uuid? dest)
               [dest]
 
@@ -246,14 +250,15 @@
                          (mapcat resolve-dest))
                         dest)
 
-              (and (coll? dest)
+              (and (vector? dest)
-                   (every? coll? dest))
+                   (every? vector? dest))
               (sequence (comp
                          (map vec)
                          (mapcat resolve-dest))
                         dest)
 
-              (vector? dest)
+              (and (vector? dest)
+                   (keyword? (first dest)))
               (let [[op param] dest]
                 (cond
                   (= op :email)
@@ -480,6 +485,27 @@
 ;; DELETE/RESTORE OBJECTS (WITH CASCADE, SOFT)
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(defn delete-file!
+  "Mark a project for deletion"
+  [file-id]
+  (let [file-id (h/parse-uuid file-id)
+        tnow    (dt/now)]
+
+    (audit/insert! main/system
+                   {::audit/name "delete-file"
+                    ::audit/type "action"
+                    ::audit/profile-id uuid/zero
+                    ::audit/props {:id file-id}
+                    ::audit/context {:triggered-by "srepl"
+                                     :cause "explicit call to delete-file!"}
+                    ::audit/tracked-at tnow})
+    (wrk/invoke! (-> main/system
+                     (assoc ::wrk/task :delete-object)
+                     (assoc ::wrk/params {:object :file
+                                          :deleted-at tnow
+                                          :id file-id})))
+    :deleted))
+
 (defn- restore-file*
   [{:keys [::db/conn]} file-id]
   (db/update! conn :file
@@ -507,22 +533,105 @@
 
   :restored)
 
+(defn restore-file!
+  "Mark a file and all related objects as not deleted"
+  [file-id]
+  (let [file-id (h/parse-uuid file-id)]
+    (db/tx-run! main/system
+                (fn [system]
+                  (when-let [file (some-> (db/get* system :file
+                                                   {:id file-id}
+                                                   {::db/remove-deleted false
+                                                    ::sql/columns [:id :name]})
+                                          (files/decode-row))]
+                    (audit/insert! system
+                                   {::audit/name "restore-file"
+                                    ::audit/type "action"
+                                    ::audit/profile-id uuid/zero
+                                    ::audit/props file
+                                    ::audit/context {:triggered-by "srepl"
+                                                     :cause "explicit call to restore-file!"}
+                                    ::audit/tracked-at (dt/now)})
 
+                    (restore-file* system file-id))))))
+
+(defn delete-project!
+  "Mark a project for deletion"
+  [project-id]
+  (let [project-id (h/parse-uuid project-id)
+        tnow       (dt/now)]
+
+    (audit/insert! main/system
+                   {::audit/name "delete-project"
+                    ::audit/type "action"
+                    ::audit/profile-id uuid/zero
+                    ::audit/props {:id project-id}
+                    ::audit/context {:triggered-by "srepl"
+                                     :cause "explicit call to delete-project!"}
+                    ::audit/tracked-at tnow})
+
+    (wrk/invoke! (-> main/system
+                     (assoc ::wrk/task :delete-object)
+                     (assoc ::wrk/params {:object :project
+                                          :deleted-at tnow
+                                          :id project-id})))
+    :deleted))
 
 (defn- restore-project*
   [{:keys [::db/conn] :as cfg} project-id]
-
   (db/update! conn :project
               {:deleted-at nil}
               {:id project-id})
 
   (doseq [{:keys [id]} (db/query conn :file
                                  {:project-id project-id}
-                                 {::db/columns [:id]})]
+                                 {::sql/columns [:id]})]
     (restore-file* cfg id))
 
   :restored)
 
+(defn restore-project!
+  "Mark a project and all related objects as not deleted"
+  [project-id]
+  (let [project-id (h/parse-uuid project-id)]
+    (db/tx-run! main/system
+                (fn [system]
+                  (when-let [project (db/get* system :project
+                                              {:id project-id}
+                                              {::db/remove-deleted false})]
+                    (audit/insert! system
+                                   {::audit/name "restore-project"
+                                    ::audit/type "action"
+                                    ::audit/profile-id uuid/zero
+                                    ::audit/props project
+                                    ::audit/context {:triggered-by "srepl"
+                                                     :cause "explicit call to restore-team!"}
+                                    ::audit/tracked-at (dt/now)})
+
+                    (restore-project* system project-id))))))
+
+(defn delete-team!
+  "Mark a team for deletion"
+  [team-id]
+  (let [team-id (h/parse-uuid team-id)
+        tnow    (dt/now)]
+
+    (audit/insert! main/system
+                   {::audit/name "delete-team"
+                    ::audit/type "action"
+                    ::audit/profile-id uuid/zero
+                    ::audit/props {:id team-id}
+                    ::audit/context {:triggered-by "srepl"
+                                     :cause "explicit call to delete-profile!"}
+                    ::audit/tracked-at tnow})
+
+    (wrk/invoke! (-> main/system
+                     (assoc ::wrk/task :delete-object)
+                     (assoc ::wrk/params {:object :team
+                                          :deleted-at tnow
+                                          :id team-id})))
+    :deleted))
+
 (defn- restore-team*
   [{:keys [::db/conn] :as cfg} team-id]
   (db/update! conn :team
@@ -535,49 +644,167 @@
 
   (doseq [{:keys [id]} (db/query conn :project
                                  {:team-id team-id}
-                                 {::db/columns [:id]})]
+                                 {::sql/columns [:id]})]
     (restore-project* cfg id))
 
   :restored)
 
-(defn restore-deleted-team!
+(defn restore-team!
   "Mark a team and all related objects as not deleted"
   [team-id]
   (let [team-id (h/parse-uuid team-id)]
-    (db/tx-run! main/system restore-team* team-id)))
+    (db/tx-run! main/system
+                (fn [system]
+                  (when-let [team (some-> (db/get* system :team
+                                                   {:id team-id}
+                                                   {::db/remove-deleted false})
+                                          (teams/decode-row))]
+                    (audit/insert! system
+                                   {::audit/name "restore-team"
+                                    ::audit/type "action"
+                                    ::audit/profile-id uuid/zero
+                                    ::audit/props team
+                                    ::audit/context {:triggered-by "srepl"
+                                                     :cause "explicit call to restore-team!"}
+                                    ::audit/tracked-at (dt/now)})
 
-(defn restore-deleted-project!
+                    (restore-team* system team-id))))))
-  "Mark a project and all related objects as not deleted"
-  [project-id]
-  (let [project-id (h/parse-uuid project-id)]
-    (db/tx-run! main/system restore-project* project-id)))
 
-(defn restore-deleted-file!
+(defn delete-profile!
-  "Mark a file and all related objects as not deleted"
+  "Mark a profile for deletion."
-  [file-id]
+  [profile-id]
-  (let [file-id (h/parse-uuid file-id)]
+  (let [profile-id (h/parse-uuid profile-id)
-    (db/tx-run! main/system restore-file* file-id)))
+        tnow       (dt/now)]
 
-(defn delete-team!
+    (audit/insert! main/system
-  "Mark a team for deletion"
+                   {::audit/name "delete-profile"
-  [team-id]
+                    ::audit/type "action"
-  (let [team-id (h/parse-uuid team-id)]
+                    ::audit/profile-id uuid/zero
-    (db/tx-run! main/system (fn [{:keys [::db/conn]}]
+                    ::audit/context {:triggered-by "srepl"
-                              (#'teams/delete-team conn team-id)))))
+                                     :cause "explicit call to delete-profile!"}
+                    ::audit/tracked-at tnow})
 
-(defn delete-project!
+    (wrk/invoke! (-> main/system
-  "Mark a project for deletion"
+                     (assoc ::wrk/task :delete-object)
-  [project-id]
+                     (assoc ::wrk/params {:object :profile
-  (let [project-id (h/parse-uuid project-id)]
+                                          :deleted-at tnow
-    (db/tx-run! main/system (fn [{:keys [::db/conn]}]
+                                          :id profile-id})))
-                              (#'projects/delete-project conn project-id)))))
+    :deleted))
 
-(defn delete-file!
+(defn restore-profile!
-  "Mark a project for deletion"
+  "Mark a team and all related objects as not deleted"
-  [file-id]
+  [profile-id]
-  (let [file-id (h/parse-uuid file-id)]
+  (let [profile-id (h/parse-uuid profile-id)]
-    (db/tx-run! main/system (fn [{:keys [::db/conn]}]
+    (db/tx-run! main/system
-                              (#'files/mark-file-deleted conn file-id)))))
+                (fn [system]
+                  (when-let [profile (some-> (db/get* system :profile
+                                                      {:id profile-id}
+                                                      {::db/remove-deleted false})
+                                             (profile/decode-row))]
+                    (audit/insert! system
+                                   {::audit/name "restore-profile"
+                                    ::audit/type "action"
+                                    ::audit/profile-id uuid/zero
+                                    ::audit/props (audit/profile->props profile)
+                                    ::audit/context {:triggered-by "srepl"
+                                                     :cause "explicit call to restore-profile!"}
+                                    ::audit/tracked-at (dt/now)})
+
+                    (db/update! system :profile
+                                {:deleted-at nil}
+                                {:id profile-id}
+                                {::db/return-keys false})
+
+                    (doseq [{:keys [id]} (profile/get-owned-teams system profile-id)]
+                      (restore-team* system id))
+
+                    :restored)))))
+
+(defn delete-profiles-in-bulk!
+  [system path]
+  (letfn [(process-data! [system deleted-at emails]
+            (loop [emails  emails
+                   deleted 0
+                   total   0]
+              (if-let [email (first emails)]
+                (if-let [profile (db/get* system :profile
+                                          {:email (str/lower email)}
+                                          {::db/remove-deleted false})]
+                  (do
+                    (audit/insert! system
+                                   {::audit/name "delete-profile"
+                                    ::audit/type "action"
+                                    ::audit/tracked-at deleted-at
+                                    ::audit/props (audit/profile->props profile)
+                                    ::audit/context {:triggered-by "srepl"
+                                                     :cause "explicit call to delete-profiles-in-bulk!"}})
+                    (wrk/invoke! (-> system
+                                     (assoc ::wrk/task :delete-object)
+                                     (assoc ::wrk/params {:object :profile
+                                                          :deleted-at deleted-at
+                                                          :id (:id profile)})))
+                    (recur (rest emails)
+                           (inc deleted)
+                           (inc total)))
+                  (recur (rest emails)
+                         deleted
+                         (inc total)))
+                {:deleted deleted :total total})))]
+
+    (let [path       (fs/path path)
+          deleted-at (dt/minus (dt/now) (cf/get-deletion-delay))]
+
+      (when-not (fs/exists? path)
+        (throw (ex-info "path does not exists" {:path path})))
+
+      (db/tx-run! system
+                  (fn [system]
+                    (with-open [reader (io/reader path)]
+                      (process-data! system deleted-at (line-seq reader))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; CASCADE FIXING
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defn process-deleted-profiles-cascade
+  []
+  (->> (db/exec! main/system ["select id, deleted_at from profile where deleted_at is not null"])
+       (run! (fn [{:keys [id deleted-at]}]
+               (wrk/invoke! (-> main/system
+                                (assoc ::wrk/task :delete-object)
+                                (assoc ::wrk/params {:object :profile
+                                                     :deleted-at deleted-at
+                                                     :id id})))))))
+
+(defn process-deleted-teams-cascade
+  []
+  (->> (db/exec! main/system ["select id, deleted_at from team where deleted_at is not null"])
+       (run! (fn [{:keys [id deleted-at]}]
+               (wrk/invoke! (-> main/system
+                                (assoc ::wrk/task :delete-object)
+                                (assoc ::wrk/params {:object :team
+                                                     :deleted-at deleted-at
+                                                     :id id})))))))
+
+(defn process-deleted-projects-cascade
+  []
+  (->> (db/exec! main/system ["select id, deleted_at from project where deleted_at is not null"])
+       (run! (fn [{:keys [id deleted-at]}]
+               (wrk/invoke! (-> main/system
+                                (assoc ::wrk/task :delete-object)
+                                (assoc ::wrk/params {:object :project
+                                                     :deleted-at deleted-at
+                                                     :id id})))))))
+
+(defn process-deleted-files-cascade
+  []
+  (->> (db/exec! main/system ["select id, deleted_at from file where deleted_at is not null"])
+       (run! (fn [{:keys [id deleted-at]}]
+               (wrk/invoke! (-> main/system
+                                (assoc ::wrk/task :delete-object)
+                                (assoc ::wrk/params {:object :file
+                                                     :deleted-at deleted-at
+                                                     :id id})))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; MISC

backend/src/app/storage/gc_deleted.clj

@@ -110,8 +110,8 @@
 
 (defmethod ig/init-key ::handler
   [_ {:keys [::min-age] :as cfg}]
-  (fn [params]
+  (fn [{:keys [props] :as task}]
-    (let [min-age (dt/duration (or (:min-age params) min-age))]
+    (let [min-age (dt/duration (or (:min-age props) min-age))]
       (db/tx-run! cfg (fn [cfg]
                         (let [cfg   (assoc cfg ::min-age min-age)
                               total (clean-deleted! cfg)]

backend/src/app/tasks/delete_object.clj

@@ -10,6 +10,8 @@
    [app.common.logging :as l]
    [app.db :as db]
    [app.rpc.commands.files :as files]
+   [app.rpc.commands.profile :as profile]
+   [app.util.time :as dt]
    [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
@@ -20,8 +22,15 @@
 
 (defmethod delete-object :file
   [{:keys [::db/conn] :as cfg} {:keys [id deleted-at]}]
-  (l/trc :hint "marking for deletion" :rel "file" :id (str id))
   (when-let [file (db/get* conn :file {:id id} {::db/remove-deleted false})]
+    (l/trc :hint "marking for deletion" :rel "file" :id (str id)
+           :deleted-at (dt/format-instant deleted-at))
+
+    (db/update! conn :file
+                {:deleted-at deleted-at}
+                {:id id}
+                {::db/return-keys false})
+
     (when (and (:is-shared file)
                (not *team-deletion*))
       ;; NOTE: we don't prevent file deletion on absorb operation failure
@@ -48,28 +57,57 @@
 
 (defmethod delete-object :project
   [{:keys [::db/conn] :as cfg} {:keys [id deleted-at]}]
-  (l/trc :hint "marking for deletion" :rel "project" :id (str id))
+  (l/trc :hint "marking for deletion" :rel "project" :id (str id)
-  (doseq [file (db/update! conn :file
+         :deleted-at (dt/format-instant deleted-at))
+
+  (db/update! conn :project
               {:deleted-at deleted-at}
+              {:id id}
+              {::db/return-keys false})
+
+  (doseq [file (db/query conn :file
                          {:project-id id}
-                           {::db/return-keys [:id :deleted-at]
+                         {::db/columns [:id :deleted-at]})]
-                            ::db/many true})]
+    (delete-object cfg (assoc file
-    (delete-object cfg (assoc file :object :file))))
+                              :object :file
+                              :deleted-at deleted-at))))
 
 (defmethod delete-object :team
   [{:keys [::db/conn] :as cfg} {:keys [id deleted-at]}]
-  (l/trc :hint "marking for deletion" :rel "team" :id (str id))
+  (l/trc :hint "marking for deletion" :rel "team" :id (str id)
+         :deleted-at (dt/format-instant deleted-at))
+  (db/update! conn :team
+              {:deleted-at deleted-at}
+              {:id id}
+              {::db/return-keys false})
+
   (db/update! conn :team-font-variant
               {:deleted-at deleted-at}
-              {:team-id id})
+              {:team-id id}
+              {::db/return-keys false})
 
   (binding [*team-deletion* true]
-    (doseq [project (db/update! conn :project
+    (doseq [project (db/query conn :project
-                                {:deleted-at deleted-at}
                               {:team-id id}
-                                {::db/return-keys [:id :deleted-at]
+                              {::db/columns [:id :deleted-at]})]
-                                 ::db/many true})]
+      (delete-object cfg (assoc project
-      (delete-object cfg (assoc project :object :project)))))
+                                :object :project
+                                :deleted-at deleted-at)))))
+
+(defmethod delete-object :profile
+  [{:keys [::db/conn] :as cfg} {:keys [id deleted-at]}]
+  (l/trc :hint "marking for deletion" :rel "profile" :id (str id)
+         :deleted-at (dt/format-instant deleted-at))
+
+  (db/update! conn :profile
+              {:deleted-at deleted-at}
+              {:id id}
+              {::db/return-keys false})
+
+  (doseq [team (profile/get-owned-teams conn id)]
+    (delete-object cfg (assoc team
+                              :object :team
+                              :deleted-at deleted-at))))
 
 (defmethod delete-object :default
   [_cfg props]
@@ -80,5 +118,5 @@
 
 (defmethod ig/init-key ::handler
   [_ cfg]
-  (fn [{:keys [props] :as params}]
+  (fn [{:keys [props] :as task}]
     (db/tx-run! cfg delete-object props)))

backend/src/app/tasks/file_gc.clj

@@ -295,17 +295,17 @@
 
 (defmethod ig/prep-key ::handler
   [_ cfg]
-  (assoc cfg ::min-age cf/deletion-delay))
+  (assoc cfg ::min-age (cf/get-deletion-delay)))
 
 (defmethod ig/init-key ::handler
   [_ cfg]
-  (fn [{:keys [file-id] :as params}]
+  (fn [{:keys [props] :as task}]
     (db/tx-run! cfg
                 (fn [{:keys [::db/conn] :as cfg}]
-                  (let [min-age (dt/duration (or (:min-age params) (::min-age cfg)))
+                  (let [min-age (dt/duration (or (:min-age props) (::min-age cfg)))
                         cfg     (-> cfg
                                     (update ::sto/storage media/configure-assets-storage conn)
-                                    (assoc ::file-id file-id)
+                                    (assoc ::file-id (:file-id props))
                                     (assoc ::min-age min-age))
 
                         total   (reduce (fn [total file]
@@ -314,12 +314,12 @@
                                         0
                                         (get-candidates cfg))]
 
-                    (l/inf :hint "task finished"
+                    (l/inf :hint "finished"
                            :min-age (dt/format-duration min-age)
                            :processed total)
 
                     ;; Allow optional rollback passed by params
-                    (when (:rollback? params)
+                    (when (:rollback? props)
                       (db/rollback! conn))
 
                     {:processed total})))))

backend/src/app/tasks/file_xlog_gc.clj

@@ -29,8 +29,8 @@
 
 (defmethod ig/init-key ::handler
   [_ {:keys [::db/pool] :as cfg}]
-  (fn [params]
+  (fn [{:keys [props] :as task}]
-    (let [min-age (or (:min-age params) (::min-age cfg))]
+    (let [min-age (or (:min-age props) (::min-age cfg))]
       (db/with-atomic [conn pool]
         (let [interval (db/interval min-age)
               result   (db/exec-one! conn [sql:delete-files-xlog interval])
@@ -38,7 +38,7 @@
 
           (l/info :hint "task finished" :min-age (dt/format-duration min-age) :total result)
 
-          (when (:rollback? params)
+          (when (:rollback? props)
             (db/rollback! conn))
 
           result)))))

backend/src/app/tasks/objects_gc.clj

@@ -35,11 +35,6 @@
                  ;; Mark as deleted the storage object
                  (some->> photo-id (sto/touch-object! storage))
 
-                 ;; And finally, permanently delete the profile. The
-                 ;; relevant objects will be deleted using DELETE
-                 ;; CASCADE database triggers. This may leave orphan
-                 ;; teams, but there is a special task for deleting
-                 ;; orphaned teams.
                  (db/delete! conn :profile {:id id})
 
                  (inc total))
@@ -269,15 +264,15 @@
                0)))
 
 (def ^:private deletion-proc-vars
-  [#'delete-file-media-objects!
+  [#'delete-profiles!
+   #'delete-file-media-objects!
    #'delete-file-data-fragments!
    #'delete-file-object-thumbnails!
    #'delete-file-thumbnails!
    #'delete-files!
    #'delete-projects!
    #'delete-fonts!
-   #'delete-teams!
+   #'delete-teams!])
-   #'delete-profiles!])
 
 (defn- execute-proc!
   "A generic function that executes the specified proc iterativelly
@@ -297,13 +292,13 @@
 (defmethod ig/prep-key ::handler
   [_ cfg]
   (assoc cfg
-         ::min-age cf/deletion-delay
+         ::min-age (cf/get-deletion-delay)
          ::chunk-size 10))
 
 (defmethod ig/init-key ::handler
   [_ cfg]
-  (fn [params]
+  (fn [{:keys [props] :as task}]
-    (let [min-age (dt/duration (or (:min-age params) (::min-age cfg)))
+    (let [min-age (dt/duration (or (:min-age props) (::min-age cfg)))
           cfg     (-> cfg
                       (assoc ::min-age (db/interval min-age))
                       (update ::sto/storage media/configure-assets-storage))]

backend/src/app/tasks/orphan_teams_gc.clj

@@ -1,67 +0,0 @@
-;; This Source Code Form is subject to the terms of the Mozilla Public
-;; License, v. 2.0. If a copy of the MPL was not distributed with this
-;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
-;;
-;; Copyright (c) KALEIDOS INC
-
-(ns app.tasks.orphan-teams-gc
-  "A maintenance task that performs orphan teams GC."
-  (:require
-   [app.common.logging :as l]
-   [app.db :as db]
-   [app.util.time :as dt]
-   [app.worker :as wrk]
-   [clojure.spec.alpha :as s]
-   [integrant.core :as ig]))
-
-(def ^:private sql:get-orphan-teams
-  "SELECT t.id
-     FROM team AS t
-     LEFT JOIN team_profile_rel AS tpr
-            ON (t.id = tpr.team_id)
-    WHERE tpr.profile_id IS NULL
-      AND t.deleted_at IS NULL
-    ORDER BY t.created_at ASC
-      FOR UPDATE OF t
-     SKIP LOCKED")
-
-(defn- delete-orphan-teams
-  "Find all orphan teams (with no members) and mark them for
-  deletion (soft delete)."
-  [{:keys [::db/conn] :as cfg}]
-  (let [deleted-at (dt/now)]
-    (->> (db/cursor conn sql:get-orphan-teams)
-         (map :id)
-         (reduce (fn [total team-id]
-                   (l/trc :hint "mark orphan team for deletion" :id (str team-id))
-
-                   (db/update! conn :team
-                               {:deleted-at deleted-at}
-                               {:id team-id})
-
-                   (wrk/submit! {::wrk/task :delete-object
-                                 ::wrk/conn conn
-                                 :object :team
-                                 :deleted-at deleted-at
-                                 :id team-id})
-
-                   (inc total))
-                 0))))
-
-(defmethod ig/pre-init-spec ::handler [_]
-  (s/keys :req [::db/pool]))
-
-(defmethod ig/init-key ::handler
-  [_ cfg]
-  (fn [params]
-    (db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
-                      (l/inf :hint "gc started" :rollback? (boolean (:rollback? params)))
-                      (let [total (delete-orphan-teams cfg)]
-                        (l/inf :hint "task finished"
-                               :teams total
-                               :rollback? (boolean (:rollback? params)))
-
-                        (when (:rollback? params)
-                          (db/rollback! conn))
-
-                        {:processed total})))))

backend/src/app/tasks/tasks_gc.clj

@@ -23,12 +23,12 @@
 
 (defmethod ig/prep-key ::handler
   [_ cfg]
-  (assoc cfg ::min-age cf/deletion-delay))
+  (assoc cfg ::min-age (cf/get-deletion-delay)))
 
 (defmethod ig/init-key ::handler
   [_ {:keys [::db/pool ::min-age] :as cfg}]
-  (fn [params]
+  (fn [{:keys [props] :as task}]
-    (let [min-age (or (:min-age params) min-age)]
+    (let [min-age (or (:min-age props) min-age)]
       (db/with-atomic [conn pool]
         (let [interval (db/interval min-age)
               result   (db/exec-one! conn [sql:delete-completed-tasks interval])
@@ -36,7 +36,7 @@
 
           (l/debug :hint "task finished" :total result)
 
-          (when (:rollback? params)
+          (when (:rollback? props)
             (db/rollback! conn))
 
           result)))))

backend/src/app/tasks/telemetry.clj

@@ -206,14 +206,16 @@
 
 (defmethod ig/init-key ::handler
   [_ {:keys [::db/pool ::setup/props] :as cfg}]
-  (fn [{:keys [send? enabled?] :or {send? true enabled? false}}]
+  (fn [task]
-    (let [subs     {:newsletter-updates (get-subscriptions-newsletter-updates pool)
+    (let [params   (:props task)
-                    :newsletter-news (get-subscriptions-newsletter-news pool)}
+          send?    (get params :send? true)
-
+          enabled? (or (get params :enabled? false)
-          enabled? (or enabled?
                        (contains? cf/flags :telemetry)
                        (cf/get :telemetry-enabled))
 
+          subs     {:newsletter-updates (get-subscriptions-newsletter-updates pool)
+                    :newsletter-news (get-subscriptions-newsletter-news pool)}
+
           data     {:subscriptions subs
                     :version (:full cf/version)
                     :instance-id (:instance-id props)}]

backend/src/app/tokens.clj

@@ -8,18 +8,19 @@
   "Tokens generation API."
   (:require
    [app.common.data :as d]
+   [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
-   [app.common.spec :as us]
    [app.common.transit :as t]
    [app.util.time :as dt]
-   [buddy.sign.jwe :as jwe]
+   [buddy.sign.jwe :as jwe]))
-   [clojure.spec.alpha :as s]))
-
-(s/def ::tokens-key bytes?)
 
 (defn generate
   [{:keys [tokens-key]} claims]
-  (us/assert! ::tokens-key tokens-key)
+
+  (dm/assert!
+   "expexted token-key to be bytes instance"
+   (bytes? tokens-key))
+
   (let [payload (-> claims
                     (assoc :iat (dt/now))
                     (d/without-nils)
@@ -39,15 +40,13 @@
       (ex/raise :type :validation
                 :code :invalid-token
                 :reason :token-expired
-                :params params
+                :params params))
-                :claims claims))
     (when (and (contains? params :iss)
                (not= (:iss claims)
                      (:iss params)))
       (ex/raise :type :validation
                 :code :invalid-token
                 :reason :invalid-issuer
-                :claims claims
                 :params params))
     claims))
 

backend/src/app/util/inet.clj

@@ -0,0 +1,37 @@
+;; 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.util.inet
+  "INET addr parsing and validation helpers"
+  (:require
+   [cuerdas.core :as str]
+   [ring.request :as rreq])
+  (:import
+   com.google.common.net.InetAddresses
+   java.net.InetAddress))
+
+(defn valid?
+  [s]
+  (InetAddresses/isInetAddress s))
+
+(defn normalize
+  [s]
+  (try
+    (let [addr (InetAddresses/forString s)]
+      (.getHostAddress ^InetAddress addr))
+    (catch Throwable _cause
+      nil)))
+
+(defn parse-request
+  [request]
+  (or (some-> (rreq/get-header request "x-real-ip")
+              (normalize))
+      (some-> (rreq/get-header request "x-forwarded-for")
+              (str/split #"\s*,\s*")
+              (first)
+              (normalize))
+      (some-> (rreq/remote-addr request)
+              (normalize))))

backend/src/app/util/objects_map.clj

@@ -19,7 +19,8 @@
    [app.common.fressian :as fres]
    [app.common.transit :as t]
    [app.common.uuid :as uuid]
-   [clojure.core :as c])
+   [clojure.core :as c]
+   [clojure.data.json :as json])
   (:import
    clojure.lang.Counted
    clojure.lang.IHashEq
@@ -83,6 +84,10 @@
                      ^:unsynchronized-mutable loaded?
                      ^:unsynchronized-mutable modified?]
 
+  json/JSONWriter
+  (-write [this writter options]
+    (json/-write (into {} this) writter options))
+
   IHashEq
   (hasheq [this]
     (when-not hash

backend/src/app/util/overrides.clj

@@ -0,0 +1,41 @@
+;; This Source Code Form is subject to the terms of the Mozilla Public
+;; License, v. 2.0. If a copy of the MPL was not distributed with this
+;; file, You can obtain one at http://mozilla.org/MPL/2.0/.
+;;
+;; Copyright (c) KALEIDOS INC
+
+(ns app.util.overrides
+  "A utility ns for declare default overrides over clojure runtime"
+  (:require
+   [app.common.schema :as sm]
+   [app.common.schema.generators :as sg]
+   [app.common.schema.openapi :as-alias oapi]
+   [clojure.pprint :as pprint]
+   [datoteka.fs :as fs]))
+
+
+(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)
+
+
+(sm/register! ::fs/path
+  {:type ::fs/path
+   :pred fs/path?
+   :type-properties
+   {:title "path"
+    :description "filesystem path"
+    :error/message "expected a valid fs path instance"
+    :error/code "errors.invalid-path"
+    :gen/gen (sg/generator :string)
+    ::oapi/type "string"
+    ::oapi/format "unix-path"
+    ::oapi/decode fs/path}})

backend/src/app/util/pointer_map.clj

@@ -40,7 +40,8 @@
    [app.common.transit :as t]
    [app.common.uuid :as uuid]
    [app.util.time :as dt]
-   [clojure.core :as c])
+   [clojure.core :as c]
+   [clojure.data.json :as json])
   (:import
    clojure.lang.Counted
    clojure.lang.IDeref
@@ -75,6 +76,14 @@
                      ^:unsynchronized-mutable modified?
                      ^:unsynchronized-mutable loaded?]
 
+  json/JSONWriter
+  (-write [this writter options]
+    (json/-write {:type "pointer"
+                  :id (get-id this)
+                  :meta (meta this)}
+                 writter
+                 options))
+
   IPointerMap
   (load! [_]
     (when-not *load-fn*

backend/src/app/util/time.clj

@@ -368,7 +368,7 @@
   (let [p1 (System/nanoTime)]
     #(duration {:nanos (- (System/nanoTime) p1)})))
 
-(sm/def! ::instant
+(sm/register! ::instant
   {:type ::instant
    :pred instant?
    :type-properties
@@ -379,7 +379,7 @@
     ::oapi/type "string"
     ::oapi/format "iso"}})
 
-(sm/def! ::duration
+(sm/register! ::duration
   {:type :durations
    :pred duration?
    :type-properties

backend/src/app/util/websocket.clj

@@ -11,7 +11,7 @@
    [app.common.logging :as l]
    [app.common.transit :as t]
    [app.common.uuid :as uuid]
-   [app.loggers.audit :refer [parse-client-ip]]
+   [app.util.inet :as inet]
    [app.util.time :as dt]
    [promesa.exec :as px]
    [promesa.exec.csp :as sp]
@@ -84,7 +84,7 @@
         output-ch  (sp/chan :buf output-buff-size)
         hbeat-ch   (sp/chan :buf (sp/sliding-buffer 6))
         close-ch   (sp/chan)
-        ip-addr    (parse-client-ip request)
+        ip-addr    (inet/parse-request request)
         uagent     (rreq/get-header request "user-agent")
         id         (uuid/next)
         state      (atom {})

backend/src/app/worker.clj

@@ -8,6 +8,7 @@
   "Async tasks abstraction (impl)."
   (:require
    [app.common.data :as d]
+   [app.common.data.macros :as dm]
    [app.common.logging :as l]
    [app.common.spec :as us]
    [app.common.uuid :as uuid]
@@ -58,17 +59,6 @@
 ;; SUBMIT API
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defn- extract-props
-  [options]
-  (let [cns (namespace ::sample)]
-    (persistent!
-     (reduce-kv (fn [res k v]
-                  (cond-> res
-                    (not= (namespace k) cns)
-                    (assoc! k v)))
-                (transient {})
-                options))))
-
 (def ^:private sql:insert-new-task
   "insert into task (id, name, props, queue, label, priority, max_retries, scheduled_at)
    values (?, ?, ?, ?, ?, ?, ?, now() + ?)
@@ -87,14 +77,13 @@
 (s/def ::task (s/or :kw keyword? :str string?))
 (s/def ::queue (s/or :kw keyword? :str string?))
 (s/def ::delay (s/or :int integer? :duration dt/duration?))
-(s/def ::conn (s/or :pool ::db/pool :connection some?))
 (s/def ::priority integer?)
 (s/def ::max-retries integer?)
 (s/def ::dedupe boolean?)
 
 (s/def ::submit-options
   (s/and
-   (s/keys :req [::task ::conn]
+   (s/keys :req [::task]
            :opt [::label ::delay ::queue ::priority ::max-retries ::dedupe])
    (fn [{:keys [::dedupe ::label] :or {label ""}}]
      (if dedupe
@@ -102,21 +91,23 @@
        true))))
 
 (defn submit!
-  [& {:keys [::task ::delay ::queue ::priority ::max-retries ::conn ::dedupe ::label]
+  [& {:keys [::params ::task ::delay ::queue ::priority ::max-retries ::dedupe ::label]
       :or {delay 0 queue :default priority 100 max-retries 3 label ""}
       :as options}]
 
   (us/verify! ::submit-options options)
   (let [duration  (dt/duration delay)
         interval  (db/interval duration)
-        props     (-> options extract-props db/tjson)
+        props     (db/tjson params)
         id        (uuid/next)
         tenant    (cf/get :tenant)
         task      (d/name task)
         queue     (str/ffmt "%:%" tenant (d/name queue))
+        conn      (db/get-connectable options)
         deleted   (when dedupe
                     (-> (db/exec-one! conn [sql:remove-not-started-tasks task queue label])
                         :next.jdbc/update-count))]
+
     (l/trc :hint "submit task"
            :name task
            :task-id (str id)
@@ -126,7 +117,13 @@
            :delay (dt/format-duration duration)
            :replace (or deleted 0))
 
-
     (db/exec-one! conn [sql:insert-new-task id task props queue
                         label priority max-retries interval])
     id))
+
+(defn invoke!
+  [{:keys [::task ::params] :as cfg}]
+  (assert (contains? cfg :app.worker/registry)
+          "missing worker registry on `cfg`")
+  (let [task-fn (dm/get-in cfg [:app.worker/registry (name task)])]
+    (task-fn {:props params})))

backend/test/backend_tests/helpers.clj

@@ -34,6 +34,7 @@
    [app.util.blob :as blob]
    [app.util.services :as sv]
    [app.util.time :as dt]
+   [app.worker :as wrk]
    [app.worker.runner]
    [clojure.java.io :as io]
    [clojure.spec.alpha :as s]
@@ -57,15 +58,14 @@
 (def ^:dynamic *system* nil)
 (def ^:dynamic *pool* nil)
 
-(def defaults
+(def default
   {:database-uri "postgresql://postgres/penpot_test"
    :redis-uri "redis://redis/1"
-   :file-change-snapshot-every 1})
+   :file-snapshot-every 1})
 
 (def config
-  (->> (cf/read-env "penpot-test")
+  (cf/read-config :prefix "penpot-test"
-       (merge cf/defaults defaults)
+                  :default (merge cf/default default)))
-       (us/conform ::cf/config)))
 
 (def default-flags
   [:enable-secure-session-cookies
@@ -76,6 +76,7 @@
    :enable-feature-fdata-pointer-map
    :enable-feature-fdata-objets-map
    :enable-feature-components-v2
+   :enable-file-snapshot
    :disable-file-validation])
 
 (defn state-init
@@ -87,6 +88,8 @@
                 app.auth/verify-password (fn [a b] {:valid (= a b)})
                 app.common.features/get-enabled-features (fn [& _] app.common.features/supported-features)]
 
+    (cf/validate! :exit-on-error? false)
+
     (fs/create-dir "/tmp/penpot")
 
     (let [templates [{:id "test"
@@ -103,10 +106,10 @@
                      (dissoc :app.srepl/server
                              :app.http/server
                              :app.http/router
-                             :app.auth.oidc/google-provider
+                             :app.auth.oidc.providers/google
-                             :app.auth.oidc/gitlab-provider
+                             :app.auth.oidc.providers/gitlab
-                             :app.auth.oidc/github-provider
+                             :app.auth.oidc.providers/github
-                             :app.auth.oidc/generic-provider
+                             :app.auth.oidc.providers/generic
                              :app.setup/templates
                              :app.auth.oidc/routes
                              :app.worker/monitor
@@ -377,9 +380,9 @@
   ([name]
    (run-task! name {}))
   ([name params]
-   (let [tasks (:app.worker/registry *system*)]
+   (wrk/invoke! (-> *system*
-     (let [task-fn (get tasks (d/name name))]
+                    (assoc ::wrk/task name)
-       (task-fn params)))))
+                    (assoc ::wrk/params params)))))
 
 (def sql:pending-tasks
   "select t.* from task as t
@@ -523,7 +526,6 @@
     ([key default]
      (get data key (get cf/config key default)))))
 
-
 (defn reset-mock!
   [m]
   (swap! m (fn [m]

backend/test/backend_tests/loggers_webhooks_test.clj

@@ -21,11 +21,10 @@
   (with-mocks [submit-mock {:target 'app.worker/submit! :return nil}]
     (let [prof (th/create-profile* 1 {:is-active true})
           res  (th/run-task! :process-webhook-event
-                             {:props
+                             {:event
-                              {:app.loggers.webhooks/event
                               {:type "command"
                                :name "create-project"
-                                :props {:team-id (:default-team-id prof)}}}})]
+                               :props {:team-id (:default-team-id prof)}}})]
 
       (t/is (= 0 (:call-count @submit-mock)))
       (t/is (nil? res)))))
@@ -35,11 +34,10 @@
     (let [prof (th/create-profile* 1 {:is-active true})
           whk  (th/create-webhook* {:team-id (:default-team-id prof)})
           res  (th/run-task! :process-webhook-event
-                             {:props
+                             {:event
-                              {:app.loggers.webhooks/event
                               {:type "command"
                                :name "create-project"
-                                :props {:team-id (:default-team-id prof)}}}})]
+                               :props {:team-id (:default-team-id prof)}}})]
 
       (t/is (= 1 (:call-count @submit-mock)))
       (t/is (nil? res)))))
@@ -52,9 +50,8 @@
                 :name "create-project"
                 :props {:team-id (:default-team-id prof)}}
           res  (th/run-task! :run-webhook
-                             {:props
+                             {:event evt
-                              {:app.loggers.webhooks/event evt
+                              :config whk})]
-                               :app.loggers.webhooks/config whk}})]
 
       (t/is (= 1 (:call-count @http-mock)))
 
@@ -75,9 +72,8 @@
                 :name "create-project"
                 :props {:team-id (:default-team-id prof)}}
           res  (th/run-task! :run-webhook
-                             {:props
+                             {:event evt
-                              {:app.loggers.webhooks/event evt
+                              :config whk})]
-                               :app.loggers.webhooks/config whk}})]
 
       (t/is (= 1 (:call-count @http-mock)))
 
@@ -94,14 +90,12 @@
       ;; RUN 2 times more
 
       (th/run-task! :run-webhook
-                    {:props
+                    {:event evt
-                     {:app.loggers.webhooks/event evt
+                     :config whk})
-                      :app.loggers.webhooks/config whk}})
 
       (th/run-task! :run-webhook
-                    {:props
+                    {:event evt
-                     {:app.loggers.webhooks/event evt
+                     :config whk})
-                      :app.loggers.webhooks/config whk}})
 
 
       (let [rows (th/db-query :webhook-delivery {:webhook-id (:id whk)})]

backend/test/backend_tests/rpc_audit_test.clj

@@ -28,7 +28,8 @@
     ring.request/Request
     (get-header [_ name]
       (case name
-        "x-forwarded-for" "127.0.0.44"))))
+        "x-forwarded-for" "127.0.0.44"
+        "x-real-ip" "127.0.0.43"))))
 
 (t/deftest push-events-1
   (with-redefs [app.config/flags #{:audit-log}]
@@ -46,6 +47,7 @@
                              :profile-id (:id prof)
                              :timestamp (dt/now)
                              :type "action"}]}
+
           params  (with-meta params
                     {:app.http/request http-request})
 

backend/test/backend_tests/rpc_file_test.clj

@@ -166,6 +166,10 @@
          :name "test"
          :id page-id}])
 
+      ;; Check the number of fragments before adding the page
+      (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
+        (t/is (= 3 (count rows))))
+
       ;; The file-gc should mark for remove unused fragments
       (let [res (th/run-task! :file-gc {:min-age 0})]
         (t/is (= 1 (:processed res))))
@@ -176,11 +180,11 @@
 
       ;; The objects-gc should remove unused fragments
       (let [res (th/run-task! :objects-gc {:min-age 0})]
-        (t/is (= 1 (:processed res))))
+        (t/is (= 3 (:processed res))))
 
       ;; Check the number of fragments
       (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
-        (t/is (= 4 (count rows))))
+        (t/is (= 2 (count rows))))
 
       ;; Add shape to page that should add a new fragment
       (update-file!
@@ -203,7 +207,7 @@
 
       ;; Check the number of fragments
       (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
-        (t/is (= 5 (count rows))))
+        (t/is (= 3 (count rows))))
 
       ;; The file-gc should mark for remove unused fragments
       (let [res (th/run-task! :file-gc {:min-age 0})]
@@ -211,13 +215,13 @@
 
       ;; The objects-gc should remove unused fragments
       (let [res (th/run-task! :objects-gc {:min-age 0})]
-        (t/is (= 1 (:processed res))))
+        (t/is (= 3 (:processed res))))
 
       ;; Check the number of fragments; should be 3 because changes
       ;; are also holding pointers to fragments;
       (let [rows (th/db-query :file-data-fragment {:file-id (:id file)
                                                    :deleted-at nil})]
-        (t/is (= 6 (count rows))))
+        (t/is (= 2 (count rows))))
 
       ;; Lets proceed to delete all changes
       (th/db-delete! :file-change {:file-id (:id file)})
@@ -233,11 +237,11 @@
       ;; Check the number of fragments;
       (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
         ;; (pp/pprint rows)
-        (t/is (= 8 (count rows)))
+        (t/is (= 4 (count rows)))
         (t/is (= 2 (count (remove (comp some? :deleted-at) rows)))))
 
       (let [res (th/run-task! :objects-gc {:min-age 0})]
-        (t/is (= 6 (:processed res))))
+        (t/is (= 2 (:processed res))))
 
       (let [rows (th/db-query :file-data-fragment {:file-id (:id file)})]
         (t/is (= 2 (count rows)))))))
@@ -338,7 +342,7 @@
         (t/is (= 1 (count (remove (comp some? :deleted-at) rows)))))
 
       (let [res (th/run-task! :objects-gc {:min-age 0})]
-        (t/is (= 2 (:processed res))))
+        (t/is (= 3 (:processed res))))
 
       ;; check file media objects
       (let [rows (th/db-query :file-media-object {:file-id (:id file)})]
@@ -367,7 +371,7 @@
         (t/is (= 1 (:processed res))))
 
       (let [res (th/run-task! :objects-gc {:min-age 0})]
-        (t/is (= 2 (:processed res))))
+        (t/is (= 3 (:processed res))))
 
       ;; Now that file-gc have deleted the file-media-object usage,
       ;; lets execute the touched-gc task, we should see that two of
@@ -494,11 +498,11 @@
         (t/is (= 1 (:processed res))))
 
       (let [res (th/run-task! :objects-gc {:min-age 0})]
-        (t/is (= 1 (:processed res))))
+        (t/is (= 2 (:processed res))))
 
       (let [rows (th/db-query :file-data-fragment {:file-id (:id file)
                                                    :deleted-at nil})]
-        (t/is (= (count rows) 2)))
+        (t/is (= (count rows) 1)))
 
       ;; retrieve file and check trimmed attribute
       (let [row (th/db-get :file {:id (:id file)})]
@@ -535,11 +539,11 @@
         (t/is (= 1 (:processed res))))
 
       (let [res (th/run-task! :objects-gc {:min-age 0})]
-        (t/is (= 6 (:processed res))))
+        (t/is (= 7 (:processed res))))
 
       (let [rows (th/db-query :file-data-fragment {:file-id (:id file)
                                                    :deleted-at nil})]
-        (t/is (= (count rows) 3)))
+        (t/is (= (count rows) 1)))
 
       ;; Now that file-gc have deleted the file-media-object usage,
       ;; lets execute the touched-gc task, we should see that two of
@@ -702,7 +706,7 @@
       ;; thumbnail lets execute the objects-gc task which remove
       ;; the rows and mark as touched the storage object rows
       (let [res (th/run-task! :objects-gc {:min-age 0})]
-        (t/is (= 3 (:processed res))))
+        (t/is (= 5 (:processed res))))
 
       ;; Now that objects-gc have deleted the object thumbnail lets
       ;; execute the touched-gc task
@@ -732,7 +736,7 @@
 
       (let [res (th/run-task! :objects-gc {:min-age 0})]
         ;; (pp/pprint res)
-        (t/is (= 2 (:processed res))))
+        (t/is (= 3 (:processed res))))
 
       ;; We still have th storage objects in the table
       (let [rows (th/db-query :storage-object {:deleted-at nil})]
@@ -1127,9 +1131,9 @@
         (t/is (= 1 (:processed res))))
 
       ;; check that object thumbnails are still here
-      (let [res (th/db-exec! ["select * from file_tagged_object_thumbnail"])]
+      (let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
-        ;; (th/print-result! res)
+        ;; (app.common.pprint/pprint rows)
-        (t/is (= 1 (count res))))
+        (t/is (= 1 (count rows))))
 
       ;; insert object snapshot for for unknown frame
       (let [data {::th/type :create-file-object-thumbnail
@@ -1148,22 +1152,30 @@
       (th/db-exec! ["update file set has_media_trimmed=false where id=?" (:id file)])
 
       ;; check that we have all object thumbnails
-      (let [res (th/db-exec! ["select * from file_tagged_object_thumbnail"])]
+      (let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
-        (t/is (= 2 (count res))))
+        ;; (app.common.pprint/pprint rows)
+        (t/is (= 2 (count rows))))
 
       ;; run the task again
       (let [res (th/run-task! :file-gc {:min-age 0})]
         (t/is (= 1 (:processed res))))
 
+      ;; check that we have all object thumbnails
+      (let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
+        ;; (app.common.pprint/pprint rows)
+        (t/is (= 2 (count rows))))
+
+
       ;; check that the unknown frame thumbnail is deleted
       (let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
         (t/is (= 2 (count rows)))
         (t/is (= 1 (count (remove :deleted-at rows)))))
 
       (let [res (th/run-task! :objects-gc {:min-age 0})]
-        (t/is (= 3 (:processed res))))
+        (t/is (= 4 (:processed res))))
 
       (let [rows (th/db-query :file-tagged-object-thumbnail {:file-id (:id file)})]
+        ;; (app.common.pprint/pprint rows)
         (t/is (= 1 (count rows)))))))
 
 (t/deftest file-thumbnail-ops
@@ -1220,7 +1232,3 @@
 
       (let [rows (th/db-query :file-thumbnail {:file-id (:id file)})]
         (t/is (= 1 (count rows)))))))
-
-
-
-

backend/test/backend_tests/rpc_file_thumbnails_test.clj

@@ -118,7 +118,7 @@
         (t/is (= 1 (:processed result))))
 
       (let [result (th/run-task! :objects-gc {:min-age 0})]
-        (t/is (= 2 (:processed result))))
+        (t/is (= 3 (:processed result))))
 
       ;; check if row2 related thumbnail row still exists
       (let [[row :as rows] (th/db-query :file-tagged-object-thumbnail

backend/test/backend_tests/rpc_profile_test.clj

@@ -6,10 +6,11 @@
 
 (ns backend-tests.rpc-profile-test
   (:require
-   [app.auth :as auth]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
+   [app.email.blacklist :as email.blacklist]
+   [app.email.whitelist :as email.whitelist]
    [app.rpc :as-alias rpc]
    [app.rpc.commands.profile :as profile]
    [app.tokens :as tokens]
@@ -126,7 +127,7 @@
         ;; (th/print-result! out)
         (t/is (nil? (:error out)))))))
 
-(t/deftest profile-deletion-simple
+(t/deftest profile-deletion-1
   (let [prof (th/create-profile* 1)
         file (th/create-file* 1 {:profile-id (:id prof)
                                  :project-id (:default-project-id prof)
@@ -152,23 +153,22 @@
       (t/is (nil? (:error out)))
       (t/is (= 1 (count (:result out)))))
 
-    ;; execute permanent deletion task
+    (th/run-pending-tasks!)
-    (let [result (th/run-task! :objects-gc {:min-age 0})]
-      (t/is (= 1 (:processed result))))
-
-    (let [row (th/db-get :team
-                         {:id (:default-team-id prof)}
-                         {::db/remove-deleted false})]
-      (t/is (nil? (:deleted-at row))))
-
-    (let [result (th/run-task! :orphan-teams-gc {:min-age 0})]
-      (t/is (= 1 (:processed result))))
 
     (let [row (th/db-get :team
                          {:id (:default-team-id prof)}
                          {::db/remove-deleted false})]
       (t/is (dt/instant? (:deleted-at row))))
 
+    ;; execute permanent deletion task
+    (let [result (th/run-task! :objects-gc {:min-age 0})]
+      (t/is (= 4 (:processed result))))
+
+    (let [row (th/db-get :team
+                         {:id (:default-team-id prof)}
+                         {::db/remove-deleted false})]
+      (t/is (nil? row)))
+
     ;; query profile after delete
     (let [params {::th/type :get-profile
                   ::rpc/profile-id (:id prof)}
@@ -177,14 +177,187 @@
       (let [result (:result out)]
         (t/is (= uuid/zero (:id result)))))))
 
-(t/deftest registration-domain-whitelist
+(t/deftest profile-deletion-2
-  (let [whitelist #{"gmail.com" "hey.com" "ya.ru"}]
+  (let [prof1 (th/create-profile* 1)
-    (t/testing "allowed email domain"
+        prof2 (th/create-profile* 2)
-      (t/is (true? (auth/email-domain-in-whitelist? whitelist "username@ya.ru")))
+        file1 (th/create-file* 1 {:profile-id (:id prof1)
-      (t/is (true? (auth/email-domain-in-whitelist? #{} "username@somedomain.com"))))
+                                  :project-id (:default-project-id prof1)
+                                  :is-shared false})
+        team1 (th/create-team* 1 {:profile-id (:id prof1)})
 
-    (t/testing "not allowed email domain"
+        role1 (th/create-team-role* {:team-id (:id team1)
-      (t/is (false? (auth/email-domain-in-whitelist? whitelist "username@somedomain.com"))))))
+                                     :profile-id (:id prof2)
+
+                                     :role :editor})]
+    ;; Assert all roles for team
+    (let [roles (th/db-query :team-profile-rel {:team-id (:id team1)})]
+      (t/is (= 2 (count roles))))
+
+    ;; Request profile to be deleted
+    (let [params {::th/type :delete-profile
+                  ::rpc/profile-id (:id prof1)}
+          out    (th/command! params)]
+      ;; (th/print-result! out)
+
+      (let [error (:error out)
+            edata (ex-data error)]
+        (t/is (th/ex-info? error))
+        (t/is (= (:type edata) :validation))
+        (t/is (= (:code edata) :owner-teams-with-people))))))
+
+(t/deftest profile-deletion-3
+  (let [prof1 (th/create-profile* 1)
+        prof2 (th/create-profile* 2)
+        prof3 (th/create-profile* 3)
+        file1 (th/create-file* 1 {:profile-id (:id prof1)
+                                  :project-id (:default-project-id prof1)
+                                  :is-shared false})
+        team1 (th/create-team* 1 {:profile-id (:id prof1)})
+
+        role1 (th/create-team-role* {:team-id (:id team1)
+                                     :profile-id (:id prof2)
+                                     :role :editor})
+        role2 (th/create-team-role* {:team-id (:id team1)
+                                     :profile-id (:id prof3)
+                                     :role :editor})]
+
+    ;; Assert all roles for team
+    (let [roles (th/db-query :team-profile-rel {:team-id (:id team1)})]
+      (t/is (= 3 (count roles))))
+
+    ;; Request profile to be deleted (it should fail)
+    (let [params {::th/type :delete-profile
+                  ::rpc/profile-id (:id prof1)}
+          out    (th/command! params)]
+      ;; (th/print-result! out)
+
+      (let [error (:error out)
+            edata (ex-data error)]
+        (t/is (th/ex-info? error))
+        (t/is (= (:type edata) :validation))
+        (t/is (= (:code edata) :owner-teams-with-people))))
+
+    ;; Leave team by role 1
+    (let [params {::th/type :leave-team
+                  ::rpc/profile-id (:id prof2)
+                  :id (:id team1)}
+          out    (th/command! params)]
+
+      ;; (th/print-result! out)
+      (t/is (nil? (:result out)))
+      (t/is (nil? (:error out))))
+
+    ;; Request profile to be deleted (it should fail)
+    (let [params {::th/type :delete-profile
+                  ::rpc/profile-id (:id prof1)}
+          out    (th/command! params)]
+      ;; (th/print-result! out)
+      (let [error (:error out)
+            edata (ex-data error)]
+        (t/is (th/ex-info? error))
+        (t/is (= (:type edata) :validation))
+        (t/is (= (:code edata) :owner-teams-with-people))))
+
+    ;; Leave team by role 0 (the default) and reassing owner to role 3
+    ;; without reassinging it (should fail)
+    (let [params {::th/type :leave-team
+                  ::rpc/profile-id (:id prof1)
+                  ;; :reassign-to (:id prof3)
+                  :id (:id team1)}
+          out    (th/command! params)]
+
+      ;; (th/print-result! out)
+
+      (let [error (:error out)
+            edata (ex-data error)]
+        (t/is (th/ex-info? error))
+        (t/is (= (:type edata) :validation))
+        (t/is (= (:code edata) :owner-cant-leave-team))))
+
+    ;; Leave team by role 0 (the default) and reassing owner to role 3
+    (let [params {::th/type :leave-team
+                  ::rpc/profile-id (:id prof1)
+                  :reassign-to (:id prof3)
+                  :id (:id team1)}
+          out    (th/command! params)]
+
+      ;; (th/print-result! out)
+      (t/is (nil? (:result out)))
+      (t/is (nil? (:error out))))
+
+    ;; Request profile to be deleted
+    (let [params {::th/type :delete-profile
+                  ::rpc/profile-id (:id prof1)}
+          out    (th/command! params)]
+      ;; (th/print-result! out)
+
+      (t/is (= {} (:result out)))
+      (t/is (nil? (:error out))))
+
+    ;; query files after profile soft deletion
+    (let [params {::th/type :get-project-files
+                  ::rpc/profile-id (:id prof1)
+                  :project-id (:default-project-id prof1)}
+          out    (th/command! params)]
+      ;; (th/print-result! out)
+      (t/is (nil? (:error out)))
+      (t/is (= 1 (count (:result out)))))
+
+    (th/run-pending-tasks!)
+
+    ;; execute permanent deletion task
+    (let [result (th/run-task! :objects-gc {:min-age 0})]
+      (t/is (= 4 (:processed result))))
+
+    (let [row (th/db-get :team
+                         {:id (:default-team-id prof1)}
+                         {::db/remove-deleted false})]
+      (t/is (nil? row)))
+
+    ;; query profile after delete
+    (let [params {::th/type :get-profile
+                  ::rpc/profile-id (:id prof1)}
+          out    (th/command! params)]
+      ;; (th/print-result! out)
+      (let [result (:result out)]
+        (t/is (= uuid/zero (:id result)))))))
+
+
+(t/deftest profile-deletion-4
+  (let [prof1 (th/create-profile* 1)
+        file1 (th/create-file* 1 {:profile-id (:id prof1)
+                                  :project-id (:default-project-id prof1)
+                                  :is-shared false})
+        team1 (th/create-team* 1 {:profile-id (:id prof1)})
+        team2 (th/create-team* 2 {:profile-id (:id prof1)})]
+
+    ;; Request profile to be deleted
+    (let [params {::th/type :delete-profile
+                  ::rpc/profile-id (:id prof1)}
+          out    (th/command! params)]
+      ;; (th/print-result! out)
+      (t/is (= {} (:result out)))
+      (t/is (nil? (:error out))))
+
+    (th/run-pending-tasks!)
+
+    (let [rows (th/db-exec! ["select id,name,deleted_at from team where deleted_at is not null"])]
+      (t/is (= 3 (count rows))))
+
+    ;; execute permanent deletion task
+    (let [result (th/run-task! :objects-gc {:min-age 0})]
+      (t/is (= 8 (:processed result))))))
+
+
+(t/deftest email-blacklist-1
+  (t/is (false? (email.blacklist/enabled? th/*system*)))
+  (t/is (true? (email.blacklist/enabled? (assoc th/*system* :app.email/blacklist []))))
+  (t/is (true? (email.blacklist/contains? (assoc th/*system* :app.email/blacklist #{"foo.com"}) "AA@FOO.COM"))))
+
+(t/deftest email-whitelist-1
+  (t/is (false? (email.whitelist/enabled? th/*system*)))
+  (t/is (true? (email.whitelist/enabled? (assoc th/*system* :app.email/whitelist []))))
+  (t/is (true? (email.whitelist/contains? (assoc th/*system* :app.email/whitelist #{"foo.com"}) "AA@FOO.COM"))))
 
 (t/deftest prepare-register-and-register-profile-1
   (let [data  {::th/type :prepare-register-profile
@@ -417,9 +590,10 @@
     (th/create-global-complaint-for pool {:type :bounce :email "user@example.com"})
 
     (let [out (th/command! data)]
-      (t/is (th/success? out))
+      (t/is (not (th/success? out)))
-      (let [result (:result out)]
+      (let [edata (-> out :error ex-data)]
-        (t/is (contains? result :token))))))
+        (t/is (= :restriction (:type edata)))
+        (t/is (= :email-has-permanent-bounces (:code edata)))))))
 
 (t/deftest register-profile-with-complained-email
   (let [pool  (:app.db/pool th/*system*)
@@ -430,9 +604,11 @@
     (th/create-global-complaint-for pool {:type :complaint :email "user@example.com"})
 
     (let [out (th/command! data)]
-      (t/is (th/success? out))
+      (t/is (not (th/success? out)))
-      (let [result (:result out)]
+
-        (t/is (contains? result :token))))))
+      (let [edata (-> out :error ex-data)]
+        (t/is (= :restriction (:type edata)))
+        (t/is (= :email-has-complaints (:code edata)))))))
 
 (t/deftest register-profile-with-email-as-password
   (let [data {::th/type :prepare-register-profile
@@ -466,17 +642,23 @@
       (let [out   (th/command! data)]
         ;; (th/print-result! out)
         (t/is (nil? (:result out)))
-        (t/is (= 2 (:call-count @mock))))
+
+        (let [edata (-> out :error ex-data)]
+          (t/is (= :restriction (:type edata)))
+          (t/is (= :email-has-complaints (:code edata))))
+
+        (t/is (= 1 (:call-count @mock))))
 
       ;; with bounces
       (th/create-global-complaint-for pool {:type :bounce :email (:email data)})
-      (let [out   (th/command! data)
+      (let [out   (th/command! data)]
-            error (:error out)]
         ;; (th/print-result! out)
-        (t/is (th/ex-info? error))
+
-        (t/is (th/ex-of-type? error :validation))
+        (let [edata (-> out :error ex-data)]
-        (t/is (th/ex-of-code? error :email-has-permanent-bounces))
+          (t/is (= :restriction (:type edata)))
-        (t/is (= 2 (:call-count @mock)))))))
+          (t/is (= :email-has-permanent-bounces (:code edata))))
+
+        (t/is (= 1 (:call-count @mock)))))))
 
 
 (t/deftest email-change-request-without-smtp
@@ -541,7 +723,7 @@
               out   (th/command! data)]
           ;; (th/print-result! out)
           (t/is (nil? (:result out)))
-          (t/is (= 2 (:call-count @mock))))
+          (t/is (= 1 (:call-count @mock))))
 
         ;; with valid email and active user with global bounce
         (th/create-global-complaint-for pool {:type :bounce :email (:email profile2)})
@@ -550,7 +732,7 @@
           (t/is (nil? (:result out)))
           (t/is (nil? (:error out)))
           ;; (th/print-result! out)
-          (t/is (= 2 (:call-count @mock))))))))
+          (t/is (= 1 (:call-count @mock))))))))
 
 
 (t/deftest update-profile-password

backend/test/backend_tests/rpc_team_test.clj

@@ -62,8 +62,8 @@
       (th/reset-mock! mock)
       (let [data (assoc data :emails ["foo@bar.com"])
             out  (th/command! data)]
-        (t/is (th/success? out))
+        (t/is (not (th/success? out)))
-        (t/is (= 1 (:call-count (deref mock)))))
+        (t/is (= 0 (:call-count (deref mock)))))
 
       ;; get invitation token
       (let [params {::th/type :get-team-invitation-token
@@ -86,7 +86,7 @@
         (t/is (= 0 (:call-count @mock)))
 
         (let [edata (-> out :error ex-data)]
-          (t/is (= :validation (:type edata)))
+          (t/is (= :restriction (:type edata)))
           (t/is (= :email-has-permanent-bounces (:code edata)))))
 
       ;; invite internal user that is muted

backend/test/backend_tests/rpc_webhooks_test.clj

@@ -39,6 +39,8 @@
           (t/is (nil? (:error out)))
           (t/is (= 1 (:call-count @http-mock)))
 
+          ;; (th/print-result! out)
+
           (let [result (:result out)]
             (t/is (contains? result :id))
             (t/is (contains? result :team-id))

backend/yarn.lock

@@ -118,11 +118,11 @@ __metadata:
   version: 0.0.0-use.local
   resolution: "backend@workspace:."
   dependencies:
-    luxon: "npm:^3.4.2"
+    luxon: "npm:^3.4.4"
-    nodemon: "npm:^3.0.1"
+    nodemon: "npm:^3.1.2"
-    sax: "npm:^1.2.4"
+    sax: "npm:^1.4.1"
     source-map-support: "npm:^0.5.21"
-    ws: "npm:^8.13.0"
+    ws: "npm:^8.17.0"
   languageName: unknown
   linkType: soft
 
@@ -573,7 +573,7 @@ __metadata:
   languageName: node
   linkType: hard
 
-"luxon@npm:^3.4.2":
+"luxon@npm:^3.4.4":
   version: 3.4.4
   resolution: "luxon@npm:3.4.4"
   checksum: 10c0/02e26a0b039c11fd5b75e1d734c8f0332c95510f6a514a9a0991023e43fb233884da02d7f966823ffb230632a733fc86d4a4b1e63c3fbe00058b8ee0f8c728af
@@ -745,9 +745,9 @@ __metadata:
   languageName: node
   linkType: hard
 
-"nodemon@npm:^3.0.1":
+"nodemon@npm:^3.1.2":
-  version: 3.1.0
+  version: 3.1.2
-  resolution: "nodemon@npm:3.1.0"
+  resolution: "nodemon@npm:3.1.2"
   dependencies:
     chokidar: "npm:^3.5.2"
     debug: "npm:^4"
@@ -761,7 +761,7 @@ __metadata:
     undefsafe: "npm:^2.0.5"
   bin:
     nodemon: bin/nodemon.js
-  checksum: 10c0/3aeb50105ecae31ce4d0a5cd464011d4aa0dc15419e39ac0fd203d784e38940e1436f4ed96adbaa0f9614ee0644f91e3cf38f2afae8d3918ae7afc51c7e2116b
+  checksum: 10c0/7a091067d766768fb6660b796194b01748bba5dc3f1e3ed3dd5f804bfa305e207d24635755078ee5e7cc53848cea35204901e0a6e51ac64483bb8e9ecb237c95
   languageName: node
   linkType: hard
 
@@ -870,10 +870,10 @@ __metadata:
   languageName: node
   linkType: hard
 
-"sax@npm:^1.2.4":
+"sax@npm:^1.4.1":
-  version: 1.3.0
+  version: 1.4.1
-  resolution: "sax@npm:1.3.0"
+  resolution: "sax@npm:1.4.1"
-  checksum: 10c0/599dbe0ba9d8bd55e92d920239b21d101823a6cedff71e542589303fa0fa8f3ece6cf608baca0c51be846a2e88365fac94a9101a9c341d94b98e30c4deea5bea
+  checksum: 10c0/6bf86318a254c5d898ede6bd3ded15daf68ae08a5495a2739564eb265cd13bcc64a07ab466fb204f67ce472bb534eb8612dac587435515169593f4fffa11de7c
   languageName: node
   linkType: hard
 
@@ -1129,7 +1129,7 @@ __metadata:
   languageName: node
   linkType: hard
 
-"ws@npm:^8.13.0":
+"ws@npm:^8.17.0":
   version: 8.17.0
   resolution: "ws@npm:8.17.0"
   peerDependencies:

common/deps.edn

@@ -1,10 +1,10 @@
 {:deps
  {org.clojure/clojure {:mvn/version "1.11.2"}
   org.clojure/data.json {:mvn/version "2.5.0"}
-  org.clojure/tools.cli {:mvn/version "1.0.219"}
+  org.clojure/tools.cli {:mvn/version "1.1.230"}
   org.clojure/clojurescript {:mvn/version "1.11.132"}
   org.clojure/test.check {:mvn/version "1.1.1"}
-  org.clojure/data.fressian {:mvn/version "1.0.0"}
+  org.clojure/data.fressian {:mvn/version "1.1.0"}
 
   ;; Logging
   org.apache.logging.log4j/log4j-api {:mvn/version "2.23.1"}
@@ -12,14 +12,14 @@
   org.apache.logging.log4j/log4j-web {:mvn/version "2.23.1"}
   org.apache.logging.log4j/log4j-jul {:mvn/version "2.23.1"}
   org.apache.logging.log4j/log4j-slf4j2-impl {:mvn/version "2.23.1"}
-  org.slf4j/slf4j-api {:mvn/version "2.0.12"}
+  org.slf4j/slf4j-api {:mvn/version "2.0.13"}
   pl.tkowalcz.tjahzi/log4j2-appender {:mvn/version "0.9.32"}
 
-  selmer/selmer {:mvn/version "1.12.59"}
+  selmer/selmer {:mvn/version "1.12.61"}
   criterium/criterium {:mvn/version "0.4.6"}
 
   metosin/jsonista {:mvn/version "0.3.8"}
-  metosin/malli {:mvn/version "0.14.0"}
+  metosin/malli {:mvn/version "0.16.1"}
 
   expound/expound {:mvn/version "0.9.0"}
   com.cognitect/transit-clj {:mvn/version "1.0.333"}
@@ -28,7 +28,7 @@
   integrant/integrant {:mvn/version "0.8.1"}
 
   org.apache.commons/commons-pool2 {:mvn/version "2.12.0"}
-  org.graalvm.js/js {:mvn/version "23.0.3"}
+  org.graalvm.js/js {:mvn/version "23.0.4"}
 
   funcool/tubax {:mvn/version "2021.05.20-0"}
   funcool/cuerdas {:mvn/version "2023.11.09-407"}
@@ -63,7 +63,7 @@
  {:dev
   {:extra-deps
    {org.clojure/tools.namespace {:mvn/version "RELEASE"}
-    thheller/shadow-cljs {:mvn/version "2.27.4"}
+    thheller/shadow-cljs {:mvn/version "2.28.8"}
     com.clojure-goes-fast/clj-async-profiler {:mvn/version "RELEASE"}
     com.bhauman/rebel-readline {:mvn/version "RELEASE"}
     criterium/criterium {:mvn/version "RELEASE"}
@@ -72,12 +72,12 @@
 
   :build
   {:extra-deps
-   {io.github.clojure/tools.build {:git/tag "v0.10.0" :git/sha "3a2c484"}}
+   {io.github.clojure/tools.build {:git/tag "v0.10.3" :git/sha "15ead66"}}
    :ns-default build}
 
   :test
   {:main-opts ["-m" "kaocha.runner"]
-   :extra-deps {lambdaisland/kaocha {:mvn/version "1.88.1376"}}}
+   :extra-deps {lambdaisland/kaocha {:mvn/version "1.91.1392"}}}
 
   :shadow-cljs
   {:main-opts ["-m" "shadow.cljs.devtools.cli"]}

common/package.json

@@ -5,19 +5,19 @@
   "license": "MPL-2.0",
   "author": "Kaleidos INC",
   "private": true,
-  "packageManager": "yarn@4.2.2",
+  "packageManager": "yarn@4.3.1",
   "repository": {
     "type": "git",
     "url": "https://github.com/penpot/penpot"
   },
   "dependencies": {
-    "luxon": "^3.4.2",
+    "luxon": "^3.4.4",
-    "sax": "^1.2.4"
+    "sax": "^1.4.1"
   },
   "devDependencies": {
-    "shadow-cljs": "2.27.4",
+    "shadow-cljs": "2.28.11",
     "source-map-support": "^0.5.21",
-    "ws": "^8.13.0"
+    "ws": "^8.17.0"
   },
   "scripts": {
     "fmt:clj:check": "cljfmt check --parallel=false src/ test/",

common/src/app/common/data.cljc

@@ -9,7 +9,7 @@
   data resources."
   (:refer-clojure :exclude [read-string hash-map merge name update-vals
                             parse-double group-by iteration concat mapcat
-                            parse-uuid max min])
+                            parse-uuid max min regexp?])
   #?(:cljs
      (:require-macros [app.common.data]))
 
@@ -224,7 +224,6 @@
   [coll]
   (into [] (remove nil?) coll))
 
-
 (defn without-nils
   "Given a map, return a map removing key-value
   pairs when value is `nil`."
@@ -642,6 +641,13 @@
 ;; Utilities
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(defn regexp?
+  "Return `true` if `x` is a regexp pattern
+  instance."
+  [x]
+  #?(:cljs (cljs.core/regexp? x)
+     :clj (instance? java.util.regex.Pattern x)))
+
 (defn nilf
   "Returns a new function that if you pass nil as any argument will
   return nil"

common/src/app/common/features.cljc

@@ -84,7 +84,7 @@
         "plugins/runtime"}
       (into frontend-only-features)))
 
-(sm/def! ::features
+(sm/register! ::features
   [:schema
    {:title "FileFeatures"
     ::smdj/inline true

common/src/app/common/files/builder.cljc

@@ -38,18 +38,22 @@
                         fail-on-spec?]
                  :or   {add-container? false
                         fail-on-spec? false}}]
-   (let [component-id (:current-component-id file)
+   (let [components-v2 (dm/get-in file [:data :options :components-v2])
+         component-id  (:current-component-id file)
          change        (cond-> change
-                        (and add-container? (some? component-id))
+                         (and add-container? (some? component-id) (not components-v2))
                          (-> (assoc :component-id component-id)
                              (cond-> (some? (:current-frame-id file))
                                (assoc :frame-id (:current-frame-id file))))
 
-                        (and add-container? (nil? component-id))
+                         (and add-container? (or (nil? component-id) components-v2))
                          (assoc :page-id  (:current-page-id file)
                                 :frame-id (:current-frame-id file)))
 
-         valid? (ch/check-change! change)]
+         valid? (or (and components-v2
+                         (nil? (:component-id change))
+                         (nil? (:page-id change)))
+                    (ch/check-change! change))]
 
      (when-not valid?
        (let [explain (sm/explain ::ch/change change)]
@@ -61,12 +65,12 @@
                      ::sm/explain explain))))
 
      (cond-> file
-       valid?
+       (and valid? (or (not add-container?) (some? (:component-id change)) (some? (:page-id change))))
-       (-> (update :changes conjv change)
+       (-> (update :changes conjv change)                      ;; In components-v2 we do not add shapes
-           (update :data ch/process-changes [change] false))
+           (update :data ch/process-changes [change] false))   ;; inside a component
 
        (not valid?)
-       (update :errors conjv change)))))
+       (update :errors conjv change)))));)
 
 (defn- lookup-objects
   ([file]
@@ -181,10 +185,11 @@
         (update :parent-stack conjv (:id obj)))))
 
 (defn close-artboard [file]
-  (let [parent-id (-> file :parent-stack peek)
+  (let [components-v2 (dm/get-in file [:data :options :components-v2])
+        parent-id (-> file :parent-stack peek)
         parent (lookup-shape file parent-id)
         current-frame-id (or (:frame-id parent)
-                             (when (nil? (:current-component-id file))
+                             (when (or (nil? (:current-component-id file)) components-v2)
                                root-id))]
     (-> file
         (assoc :current-frame-id current-frame-id)
@@ -515,12 +520,18 @@
 
   ([file data root-type]
    ;; FIXME: data probably can be a shape instance, then we can use gsh/shape->rect
-   (let [selrect (or (grc/make-rect (:x data) (:y data) (:width data) (:height data))
+   (let [components-v2 (dm/get-in file [:data :options :components-v2])
+         selrect (or (grc/make-rect (:x data) (:y data) (:width data) (:height data))
                      grc/empty-rect)
          name               (:name data)
          path               (:path data)
          main-instance-id   (:main-instance-id data)
          main-instance-page (:main-instance-page data)
+
+         ;; In components v1 we must create the root shape and set it inside
+         ;; the :objects attribute of the component. When in components-v2,
+         ;; this will be ignored as the root shape has already been created
+         ;; in its page, by the normal page import.
          attrs (-> data
                    (assoc :type root-type)
                    (assoc :x (:x selrect))
@@ -542,19 +553,43 @@
 
      (-> file
          (commit-change
-          {:type :add-component
+          (cond-> {:type :add-component
                    :id (:id obj)
                    :name name
                    :path path
                    :main-instance-id main-instance-id
-           :main-instance-page main-instance-page
+                   :main-instance-page main-instance-page}
-           :shapes [obj]})
+            (not components-v2)
+            (assoc :shapes [obj])))
 
          (assoc :last-id (:id obj))
          (assoc :parent-stack [(:id obj)])
          (assoc :current-component-id (:id obj))
          (assoc :current-frame-id (if (= (:type obj) :frame) (:id obj) uuid/zero))))))
 
+(defn start-deleted-component
+  [file data]
+  (let [attrs (-> data
+                  (assoc :id (:main-instance-id data))
+                  (assoc :component-file (:id file))
+                  (assoc :component-id (:id data))
+                  (assoc :x (:main-instance-x data))
+                  (assoc :y (:main-instance-y data))
+                  (dissoc :path)
+                  (dissoc :main-instance-id)
+                  (dissoc :main-instance-page)
+                  (dissoc :main-instance-x)
+                  (dissoc :main-instance-y)
+                  (dissoc :main-instance-parent)
+                  (dissoc :main-instance-frame))]
+    ;; To create a deleted component, first we add all shapes of the main instance
+    ;; in the main instance page, and in the finish event we delete it.
+    (-> file
+        (update :parent-stack conjv (:main-instance-parent data))
+        (assoc :current-page-id (:main-instance-page data))
+        (assoc :current-frame-id (:main-instance-frame data))
+        (add-artboard attrs))))
+
 (defn finish-component
   [file]
   (let [component-id (:current-component-id file)
@@ -619,43 +654,18 @@
         (update :parent-stack pop))))
 
 (defn finish-deleted-component
-  [component-id page-id main-instance-x main-instance-y file]
+  [component-id file]
   (let [file             (assoc file :current-component-id component-id)
-        page             (ctpl/get-page (:data file) page-id)
+        component        (ctkl/get-component (:data file) component-id)]
-        component        (ctkl/get-component (:data file) component-id)
+    (-> file
-        main-instance-id (:main-instance-id component)
+        (close-artboard)
-
+        (commit-change {:type :del-component
-        ; To obtain a deleted component, we first create the component
-        ; and the main instance in the workspace, and then delete them.
-        [_ shapes]
-        (ctn/make-component-instance page
-                                     component
-                                     (:data file)
-                                     (gpt/point main-instance-x
-                                                main-instance-y)
-                                     true
-                                     {:main-instance true
-                                      :force-id main-instance-id})]
-    (as-> file $
-      (reduce #(commit-change %1
-                              {:type :add-obj
-                               :id (:id %2)
-                               :page-id (:id page)
-                               :parent-id (:parent-id %2)
-                               :frame-id (:frame-id %2)
-                               :ignore-touched true
-                               :obj %2})
-              $
-              shapes)
-      (commit-change $ {:type :del-component
                         :id component-id})
-      (reduce #(commit-change %1 {:type :del-obj
+        (commit-change {:type :del-obj
-                                  :page-id page-id
+                        :page-id (:main-instance-page component)
-                                  :ignore-touched true
+                        :id (:main-instance-id component)
-                                  :id (:id %2)})
+                        :ignore-touched true})
-              $
+        (dissoc :current-page-id))))
-              shapes)
-      (dissoc $ :current-component-id))))
 
 (defn create-component-instance
   [file data]
@@ -666,7 +676,6 @@
         page-id          (:current-page-id file)
         page             (ctpl/get-page (:data file) page-id)
         component        (ctkl/get-component (:data file) component-id)
-        ;; main-instance-id (:main-instance-id component)
 
         components-v2    (dm/get-in file [:options :components-v2])