further adjustments to record video

.circleci/config.yml

@@ -1,130 +1,6 @@
-version: 2.1
+version: 2
 jobs:
-  test-common:
-    docker:
-      - image: penpotapp/devenv:latest
-
-    working_directory: ~/repo
-    resource_class: medium+
-
-    environment:
-      JAVA_OPTS: -Xmx4g -Xms100m -XX:+UseSerialGC
-      NODE_OPTIONS: --max-old-space-size=4096
-
-    steps:
-      - checkout
-
-      # Download and cache dependencies
-      - restore_cache:
-          keys:
-            - v1-dependencies-{{ checksum "common/deps.edn"}}
-
-      - run:
-          name: "fmt check & linter"
-          working_directory: "./common"
-          command: |
-            yarn install
-            yarn run fmt:clj:check
-            yarn run lint:clj
-
-      - run:
-          name: "JVM tests"
-          working_directory: "./common"
-          command: |
-            clojure -M:dev:test
-
-      - run:
-          name: "NODE tests"
-          working_directory: "./common"
-          command: |
-            yarn run test
-
-      - save_cache:
-          paths:
-            - ~/.m2
-          key: v1-dependencies-{{ checksum "common/deps.edn"}}
-
-
-  test-frontend:
-    docker:
-      - image: penpotapp/devenv:latest
-
-    working_directory: ~/repo
-    resource_class: medium+
-
-    environment:
-      JAVA_OPTS: -Xmx4g -Xms100m -XX:+UseSerialGC
-      NODE_OPTIONS: --max-old-space-size=4096
-
-    steps:
-      - checkout
-
-      # Download and cache dependencies
-      - restore_cache:
-          keys:
-            - v1-dependencies-{{ checksum "frontend/deps.edn"}}
-
-      - run:
-          name: "prepopulate linter cache"
-          working_directory: "./common"
-          command: |
-            yarn install
-            yarn run lint:clj
-
-      - run:
-          name: "fmt check & linter"
-          working_directory: "./frontend"
-          command: |
-            yarn install
-            yarn run fmt:clj:check
-            yarn run fmt:js:check
-            yarn run lint:scss
-            yarn run lint:clj
-
-      - run:
-          name: "unit tests"
-          working_directory: "./frontend"
-          command: |
-            yarn install
-            yarn run test
-
-      - save_cache:
-          paths:
-            - ~/.m2
-          key: v1-dependencies-{{ checksum "frontend/deps.edn"}}
-
-
-  test-integration:
-    docker:
-      - image: penpotapp/devenv:latest
-
-    working_directory: ~/repo
-    resource_class: large
-
-    environment:
-      JAVA_OPTS: -Xmx6g -Xms2g
-      NODE_OPTIONS: --max-old-space-size=4096
-
-    steps:
-      - checkout
-
-      # Download and cache dependencies
-      - restore_cache:
-          keys:
-            - v1-dependencies-{{ checksum "frontend/deps.edn"}}
-
-      - run:
-          name: "integration tests"
-          working_directory: "./frontend"
-          command: |
-            yarn install
-            yarn run build:app:assets
-            yarn run build:app
-            yarn run build:app:libs
-            yarn run playwright install --with-deps chromium
-            yarn run test:e2e -x --workers=4
-
-  test-backend:
+  build:
     docker:
       - image: penpotapp/devenv:latest
       - image: cimg/postgres:14.5
@@ -144,30 +20,104 @@ jobs:
     steps:
       - checkout
 
+      # Download and cache dependencies
       - restore_cache:
           keys:
-            - v1-dependencies-{{ checksum "backend/deps.edn" }}
+            - v1-dependencies-{{ checksum "backend/deps.edn" }}-{{ checksum "frontend/deps.edn"}}-{{ checksum "common/deps.edn"}}
+            # fallback to using the latest cache if no exact match is found
+            - v1-dependencies-
+
+      - run: cd .clj-kondo && cat config.edn
+      - run: cat .cljfmt.edn
+      - run: clj-kondo --version
 
       - run:
-          name: "prepopulate linter cache"
+          name: "backend fmt check"
+          working_directory: "./backend"
+          command: |
+            yarn install
+            yarn run fmt:clj:check
+
+      - run:
+          name: "exporter fmt check"
+          working_directory: "./exporter"
+          command: |
+            yarn install
+            yarn run fmt:clj:check
+
+      - run:
+          name: "common fmt check"
+          working_directory: "./common"
+          command: |
+            yarn install
+            yarn run fmt:clj:check
+
+      - run:
+          name: "frontend fmt check"
+          working_directory: "./frontend"
+          command: |
+            yarn install
+            yarn run fmt:clj:check
+            yarn run fmt:js:check
+
+      - run:
+          name: "common linter check"
           working_directory: "./common"
           command: |
             yarn install
             yarn run lint:clj
 
       - run:
-          name: "fmt check & linter"
-          working_directory: "./backend"
+          name: "frontend linter check"
+          working_directory: "./frontend"
           command: |
             yarn install
-            yarn run fmt:clj:check
+            yarn run lint:scss
             yarn run lint:clj
 
       - run:
-          name: "tests"
+          name: "backend linter check"
           working_directory: "./backend"
           command: |
-            clojure -M:dev:test --reporter kaocha.report/documentation
+            yarn install
+            yarn run lint:clj
+
+      - run:
+          name: "exporter linter check"
+          working_directory: "./exporter"
+          command: |
+            yarn install
+            yarn run lint:clj
+
+      - run:
+          name: "common tests"
+          working_directory: "./common"
+          command: |
+            yarn test
+            clojure -M:dev:test
+
+      - run:
+          name: "frontend tests"
+          working_directory: "./frontend"
+          command: |
+            yarn install
+            yarn test
+
+      - run:
+          name: "frontend integration tests"
+          working_directory: "./frontend"
+          command: |
+            yarn install
+            yarn run build:app:assets
+            clojure -M:dev:shadow-cljs release main
+            yarn playwright install --with-deps chromium
+            yarn e2e:test
+
+      - run:
+          name: "backend tests"
+          working_directory: "./backend"
+          command: |
+            clojure -M:dev:test
 
           environment:
             PENPOT_TEST_DATABASE_URI: "postgresql://localhost/penpot_test"
@@ -178,43 +128,4 @@ jobs:
       - save_cache:
           paths:
             - ~/.m2
-          key: v1-dependencies-{{ checksum "backend/deps.edn" }}
-
-
-  test-exporter:
-    docker:
-      - image: penpotapp/devenv:latest
-
-    working_directory: ~/repo
-    resource_class: medium+
-
-    environment:
-      JAVA_OPTS: -Xmx4g -Xms100m -XX:+UseSerialGC
-      NODE_OPTIONS: --max-old-space-size=4096
-
-    steps:
-      - checkout
-
-      - run:
-          name: "prepopulate linter cache"
-          working_directory: "./common"
-          command: |
-            yarn install
-            yarn run lint:clj
-
-      - run:
-          name: "fmt check & linter"
-          working_directory: "./exporter"
-          command: |
-            yarn install
-            yarn run fmt:clj:check
-            yarn run lint:clj
-
-workflows:
-  penpot:
-    jobs:
-      - test-frontend
-      - test-integration
-      - test-backend
-      - test-common
-      - test-exporter
+          key: v1-dependencies-{{ checksum "backend/deps.edn" }}-{{ checksum "frontend/deps.edn"}}-{{ checksum "common/deps.edn"}}

.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

@@ -74,5 +74,3 @@ node_modules
 /playwright-report/
 /blob-report/
 /playwright/.cache/
-/render-wasm/target/
-/**/.yarn/*

.nvmrc

@@ -1 +0,0 @@
-v20.11.1

CHANGES.md

@@ -1,125 +1,17 @@
 # CHANGELOG
 
-## 2.4.0
-
-### :rocket: Epics and highlights
-
-### :boom: Breaking changes & Deprecations
-
-- Use [nginx-unprivileged](https://hub.docker.com/r/nginxinc/nginx-unprivileged) as base image for
-  Penpot's frontend docker image. Now all the docker images runs with the same unprivileged user
-  (penpot). Because of that, the default NGINX listen port is now 8080 instead of 80, so
-  you will have to modify your infrastructure to apply this change.
-
-- Redis 7.2 is explicitly pinned in our example docker-compose.yml file. This is done because, 
-  starting with the next versions, Redis is no longer distributed under an open-source license. 
-  On-premise users are obviously free to upgrade to the version they are using or a more modern one. 
-  Keep in mind that if you were using a version other than 7.2, you may have to recreate the volume 
-  associated with the Redis container because the 7.2 storage format may not be compatible with what 
-  you already have stored on the volume, and Redis may not start. In the near future, we will evaluate 
-  whether to move to an open-source version of Redis (such as https://valkey.io/).
-
-### :heart: Community contributions (Thank you!)
-
-### :sparkles: New features
-
-- Viewer role for team members [Taiga #1056](https://tree.taiga.io/project/penpot/us/1056) & [Taiga #6590](https://tree.taiga.io/project/penpot/us/6590)
-- File history versions management [Taiga #187](https://tree.taiga.io/project/penpot/us/187?milestone=411120)
-- Rename selected layer via keyboard shortcut and context menu option [Taiga #8882](https://tree.taiga.io/project/penpot/us/8882)
-- New .penpot file format [Taiga #8657](https://tree.taiga.io/project/penpot/us/8657)
-
-### :bug: Bugs fixed
-
-- Fix problem with some texts desynchronization [Taiga #9379](https://tree.taiga.io/project/penpot/issue/9379)
-- Fix problem with reoder grid layers [#5446](https://github.com/penpot/penpot/issues/5446)
-- Fix problem with swap component style [#9542](https://tree.taiga.io/project/penpot/issue/9542)
-
-## 2.3.3
-
-### :bug: Bugs fixed
-
-- Fix problem creating manual overlay interactions [Taiga #9146](https://tree.taiga.io/project/penpot/issue/9146)
-- Fix plugins list default URL
-- Activate plugins feature by default
-
-## 2.3.2
-
-### :bug: Bugs fixed
-
-- Fix null pointer exception on number checking functions
-- Fix problem with grid layout ordering after moving [Taiga #9179](https://tree.taiga.io/project/penpot/issue/9179)
-
-### :books: Documentation
-
-- Add initial documentation for Kubernetes
-
-
-## 2.3.1
-
-### :bug: Bugs fixed
-
-- Fix unexpected issue on interaction between plugins sandbox and
-  internal impl of promise
-
-
 ## 2.3.0
 
 ### :rocket: Epics and highlights
 
-- **New plugin system.**
-
-  Penpot now supports custom plugins. Read everything about developing your plugins [HERE](https://help.penpot.app/plugins/)
-
 ### :boom: Breaking changes & Deprecations
 
 ### :heart: Community contributions (Thank you!)
 
-- All our plugins beta testers :heart:.
-- Fix problem when translating multiple path points by @eeropic [#4459](https://github.com/penpot/penpot/issues/4459)
-
 ### :sparkles: New features
 
-- **Replace Draft.js completely with a custom editor** [Taiga #7706](https://tree.taiga.io/project/penpot/us/7706)
-
-  This refactor adds better IME support, more performant text editing
-  experience and a better clipboard support while keeping full
-  retrocompatibility with previous editor.
-
-  You can enable it with the `enable-feature-text-editor-v2` configuration flag.
-
-
 ### :bug: Bugs fixed
 
-- Fix problem with constraints buttons [Taiga #8465](https://tree.taiga.io/project/penpot/issue/8465)
-- Fix problem with go back button on error page [Taiga #8887](https://tree.taiga.io/project/penpot/issue/8887)
-- Fix problem with shadows in text for Safari [Taiga #8770](https://tree.taiga.io/project/penpot/issue/8770)
-- Fix a regression with feedback form subject and content limits [Taiga #8908](https://tree.taiga.io/project/penpot/issue/8908)
-- Fix problem with stroke and filter ordering in frames [Github #5058](https://github.com/penpot/penpot/issues/5058)
-- Fix problem with hover layers when hidden/blocked [Github #5074](https://github.com/penpot/penpot/issues/5074)
-- Fix problem with precision on boolean calculation [Taiga #8482](https://tree.taiga.io/project/penpot/issue/8482)
-- Fix problem when translating multiple path points [Github #4459](https://github.com/penpot/penpot/issues/4459)
-- Fix problem on importing (and exporting) files with flows [Taiga #8914](https://tree.taiga.io/project/penpot/issue/8914)
-- Fix Internal Error page: "go to your penpot" wrong design [Taiga #8922](https://tree.taiga.io/project/penpot/issue/8922)
-- Fix problem updating layout when toggle visibility in component copy [Github #5143](https://github.com/penpot/penpot/issues/5143)
-- Fix "Done" button on toolbar on inspect mode should go to design mode [Taiga #8933](https://tree.taiga.io/project/penpot/issue/8933)
-- Fix problem with shortcuts in text editor [Github #5078](https://github.com/penpot/penpot/issues/5078)
-- Fix problems with show in viewer and interactions [Github #4868](https://github.com/penpot/penpot/issues/4868)
-- Add visual feedback when moving an element into a board [Github #3210](https://github.com/penpot/penpot/issues/3210)
-- Fix percent calculation on grid layout tracks [Github #4688](https://github.com/penpot/penpot/issues/4688)
-- Fix problem with caps and inner shadows [Github #4517](https://github.com/penpot/penpot/issues/4517)
-- Fix problem with horizontal/vertical lines and shadows [Github #4516](https://github.com/penpot/penpot/issues/4516)
-- Fix problem with layers overflowing panel [Taiga #9021](https://tree.taiga.io/project/penpot/issue/9021)
-- Fix in workspace you can manage rulers on view mode [Taiga #8966](https://tree.taiga.io/project/penpot/issue/8966)
-- Fix problem with swap components in grid layout [Taiga #9066](https://tree.taiga.io/project/penpot/issue/9066)
-
-## 2.2.1
-
-### :bug: Bugs fixed
-
-- Fix problem with Ctrl+F shortcut on the dashboard [Taiga #8876](https://tree.taiga.io/project/penpot/issue/8876)
-- Fix visual problem with the font-size dropdown in assets [Taiga #8872](https://tree.taiga.io/project/penpot/issue/8872)
-- Add limits for invitation RPC methods (hard limit 25 emails per request)
-
 ## 2.2.0
 
 ### :rocket: Epics and highlights
@@ -210,7 +102,6 @@ time being.
 - Fix problem with comments max length [Taiga #8778](https://tree.taiga.io/project/penpot/issue/8778)
 - Fix copy/paste images in Safari [Taiga #8771](https://tree.taiga.io/project/penpot/issue/8771)
 - Fix swap when the copy is the only child of a group [#5075](https://github.com/penpot/penpot/issues/5075)
-- Fix file builder hangs when exporting [#5099](https://github.com/penpot/penpot/issues/5099)
 
 ## 2.1.5
 
@@ -257,7 +148,7 @@ time being.
 
 ### :boom: Breaking changes & Deprecations
 
-### :heart: Communityq contributions (Thank you!)
+### :heart: Community contributions (Thank you!)
 
 ### :sparkles: New features
 

README.md

@@ -8,12 +8,10 @@
   <img alt="penpot header image" src="https://penpot.app/images/readme/github-light-mode.png">
 </picture>
 
-<p align="center">
-<a href="https://www.mozilla.org/en-US/MPL/2.0" rel="nofollow"><img alt="License: MPL-2.0" src="https://img.shields.io/badge/MPL-2.0-blue.svg" style="max-width:100%;"></a>
-<a href="https://community.penpot.app" rel="nofollow"><img alt="Penpot Community" src="https://img.shields.io/discourse/posts?server=https%3A%2F%2Fcommunity.penpot.app" style="max-width:100%;"></a>
-<a href="https://tree.taiga.io/project/penpot/" title="Managed with Taiga.io" rel="nofollow"><img alt="Managed with Taiga.io" src="https://img.shields.io/badge/managed%20with-TAIGA.io-709f14.svg" style="max-width:100%;"></a>
-<a href="https://gitpod.io/#https://github.com/penpot/penpot" rel="nofollow"><img alt="Gitpod ready-to-code" src="https://img.shields.io/badge/Gitpod-ready--to--code-blue?logo=gitpod" style="max-width:100%;"></a>
-</p>
+<p align="center"><a href="https://www.mozilla.org/en-US/MPL/2.0" rel="nofollow"><img src="https://camo.githubusercontent.com/3fcf3d6b678ea15fde3cf7d6af0e242160366282d62a7c182d83a50bfee3f45e/68747470733a2f2f696d672e736869656c64732e696f2f62616467652f4d504c2d322e302d626c75652e737667" alt="License: MPL-2.0" data-canonical-src="https://img.shields.io/badge/MPL-2.0-blue.svg" style="max-width:100%;"></a>
+<a href="https://gitter.im/penpot/community" rel="nofollow"><img src="https://camo.githubusercontent.com/5b0aecb33434f82a7b158eab7247544235ada0cf7eeb9ce8e52562dd67f614b7/68747470733a2f2f6261646765732e6769747465722e696d2f736572656e6f2d78797a2f636f6d6d756e6974792e737667" alt="Gitter" data-canonical-src="https://badges.gitter.im/sereno-xyz/community.svg" style="max-width:100%;"></a>
+<a href="https://tree.taiga.io/project/penpot/" title="Managed with Taiga.io" rel="nofollow"><img src="https://camo.githubusercontent.com/4a1d1112f0272e3393b1e8da312ff4435418e9e2eb4c0964881e3680f90a653c/68747470733a2f2f696d672e736869656c64732e696f2f62616467652f6d616e61676564253230776974682d54414947412e696f2d3730396631342e737667" alt="Managed with Taiga.io" data-canonical-src="https://img.shields.io/badge/managed%20with-TAIGA.io-709f14.svg" style="max-width:100%;"></a>
+<a href="https://gitpod.io/#https://github.com/penpot/penpot" rel="nofollow"><img src="https://camo.githubusercontent.com/daadb4894128d1e19b72d80236f5959f1f2b47f9fe081373f3246131f0189f6c/68747470733a2f2f696d672e736869656c64732e696f2f62616467652f476974706f642d72656164792d2d746f2d2d636f64652d626c75653f6c6f676f3d676974706f64" alt="Gitpod ready-to-code" data-canonical-src="https://img.shields.io/badge/Gitpod-ready--to--code-blue?logo=gitpod" style="max-width:100%;"></a></p>
 
 <p align="center">
     <a href="https://penpot.app/"><b>Website</b></a>  •  
@@ -60,9 +58,6 @@ Penpot’s latest [huge release 2.0](https://penpot.app/dev-diaries), takes the
 
 Penpot expresses designs as code. Designers can do their best work and see it will be beautifully implemented by developers in a two-way collaboration.
 
-### Plugin system ###
-[Penpot plugins](https://penpot.app/penpothub/plugins) let you expand the platform's capabilities, give you the flexibility to integrate it with other apps, and design custom solutions. 
-
 ### Designed for developers ###
 Penpot was built to serve both designers and developers and create a fluid design-code process. You have the choice to enjoy real-time collaboration or play "solo".
 

backend/deps.edn

@@ -3,10 +3,10 @@
 
  :deps
  {penpot/common {:local/root "../common"}
-  org.clojure/clojure {:mvn/version "1.12.0"}
+  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.6-6"}
+  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"}
@@ -17,33 +17,33 @@
 
   io.prometheus/simpleclient_httpserver {:mvn/version "0.16.0"}
 
-  io.lettuce/lettuce-core {:mvn/version "6.4.0.RELEASE"}
+  io.lettuce/lettuce-core {:mvn/version "6.3.2.RELEASE"}
   java-http-clj/java-http-clj {:mvn/version "0.4.3"}
 
   funcool/yetti
-  {:git/tag "v11.4"
-   :git/sha "ce50d42"
+  {:git/tag "v10.0"
+   :git/sha "520613f"
    :git/url "https://github.com/funcool/yetti.git"
    :exclusions [org.slf4j/slf4j-api]}
 
-  com.github.seancorfield/next.jdbc {:mvn/version "1.3.955"}
-  metosin/reitit-core {:mvn/version "0.7.2"}
-  nrepl/nrepl {:mvn/version "1.3.0"}
-  cider/cider-nrepl {:mvn/version "0.50.2"}
+  com.github.seancorfield/next.jdbc {:mvn/version "1.3.939"}
+  metosin/reitit-core {:mvn/version "0.7.0"}
+  nrepl/nrepl {:mvn/version "1.1.2"}
+  cider/cider-nrepl {:mvn/version "0.48.0"}
 
-  org.postgresql/postgresql {:mvn/version "42.7.4"}
-  org.xerial/sqlite-jdbc {:mvn/version "3.46.1.3"}
+  org.postgresql/postgresql {:mvn/version "42.7.3"}
+  org.xerial/sqlite-jdbc {:mvn/version "3.46.0.0"}
 
-  com.zaxxer/HikariCP {:mvn/version "6.0.0"}
+  com.zaxxer/HikariCP {:mvn/version "5.1.0"}
 
   io.whitfin/siphash {:mvn/version "2.0.0"}
 
   buddy/buddy-hashers {:mvn/version "2.0.167"}
-  buddy/buddy-sign {:mvn/version "3.6.1-359"}
+  buddy/buddy-sign {:mvn/version "3.5.351"}
 
   com.github.ben-manes.caffeine/caffeine {:mvn/version "3.1.8"}
 
-  org.jsoup/jsoup {:mvn/version "1.18.1"}
+  org.jsoup/jsoup {:mvn/version "1.17.2"}
   org.im4java/im4java
   {:git/tag "1.4.0-penpot-2"
    :git/sha "e2b3e16"
@@ -58,7 +58,7 @@
 
   ;; Pretty Print specs
   pretty-spec/pretty-spec {:mvn/version "0.1.4"}
-  software.amazon.awssdk/s3 {:mvn/version "2.28.26"}
+  software.amazon.awssdk/s3 {:mvn/version "2.25.63"}
   }
 
  :paths ["src" "resources" "target/classes"]
@@ -74,7 +74,7 @@
 
   :build
   {:extra-deps
-   {io.github.clojure/tools.build {:git/tag "v0.10.5" :git/sha "2a21b7a"}}
+   {io.github.clojure/tools.build {:git/tag "v0.10.3" :git/sha "15ead66"}}
    :ns-default build}
 
   :test

backend/dev/user.clj

@@ -137,6 +137,7 @@
 ;;        :v6 v6
 ;;        }])))
 
+
 (defn calculate-frames
   [{:keys [data]}]
   (->> (vals (:pages-index data))

backend/resources/app/onboarding.edn

@@ -1,15 +1,15 @@
 [{:id "wireframing-kit"
   :name "Wireframe library"
-  :file-uri "https://github.com/penpot/penpot-files/raw/refs/heads/main/Wireframing%20kit%20v1.1.penpot"}
+  :file-uri "https://github.com/penpot/penpot-files/raw/main/wireframing-kit.penpot"}
  {:id "prototype-examples"
   :name "Prototype template"
-  :file-uri "https://github.com/penpot/penpot-files/raw/refs/heads/main/Prototype%20examples%20v1.1.penpot"}
+  :file-uri "https://github.com/penpot/penpot-files/raw/main/prototype-examples.penpot"}
  {:id "plants-app"
   :name "UI mockup example"
   :file-uri "https://github.com/penpot/penpot-files/raw/main/Plants-app.penpot"}
  {:id "penpot-design-system"
   :name "Design system example"
-  :file-uri "https://github.com/penpot/penpot-files/raw/refs/heads/main/Penpot%20-%20Design%20System%20v2.1.penpot"}
+  :file-uri "https://github.com/penpot/penpot-files/raw/main/Penpot-Design-system.penpot"}
  {:id "tutorial-for-beginners"
   :name "Tutorial for beginners"
   :file-uri "https://github.com/penpot/penpot-files/raw/main/tutorial-for-beginners.penpot"}
@@ -36,7 +36,7 @@
   :file-uri "https://github.com/penpot/penpot-files/raw/main/Open%20Color%20Scheme%20(v1.9.1).penpot"}
  {:id "flex-layout-playground"
   :name "Flex Layout Playground"
-  :file-uri "https://github.com/penpot/penpot-files/raw/refs/heads/main/Flex%20Layout%20Playground%20v2.0.penpot"}
+  :file-uri "https://github.com/penpot/penpot-files/raw/main/Flex%20Layout%20Playground.penpot"}
  {:id "welcome"
   :name "Welcome"
   :file-uri "https://github.com/penpot/penpot-files/raw/main/welcome.penpot"}]

backend/resources/app/templates/debug.tmpl

@@ -7,7 +7,7 @@ Debug Main Page
 {% block content %}
 <nav>
   <div class="title">
-    <h1>ADMIN DEBUG INTERFACE (VERSION: {{version}})</h1>
+    <h1>ADMIN DEBUG INTERFACE</h1>
   </div>
 </nav>
 <main class="dashboard">

backend/resources/log4j2-devenv-repl.xml

@@ -1,5 +1,5 @@
 <?xml version="1.0" encoding="UTF-8"?>
-<Configuration status="fatal" monitorInterval="30">
+<Configuration status="info" monitorInterval="30">
   <Appenders>
     <Console name="console" target="SYSTEM_OUT">
       <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"

backend/resources/log4j2-devenv.xml

@@ -1,5 +1,5 @@
 <?xml version="1.0" encoding="UTF-8"?>
-<Configuration status="fatal" monitorInterval="30">
+<Configuration status="info" monitorInterval="30">
   <Appenders>
     <Console name="console" target="SYSTEM_OUT">
       <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"

backend/resources/log4j2-experiments.xml

@@ -1,5 +1,5 @@
 <?xml version="1.0" encoding="UTF-8"?>
-<Configuration status="fatal" monitorInterval="30">
+<Configuration status="info" monitorInterval="30">
   <Appenders>
     <Console name="console" target="SYSTEM_OUT">
       <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"

backend/resources/log4j2.xml

@@ -1,5 +1,5 @@
 <?xml version="1.0" encoding="UTF-8"?>
-<Configuration status="fatal" monitorInterval="60">
+<Configuration status="info" monitorInterval="60">
   <Appenders>
     <Console name="console" target="SYSTEM_OUT">
       <PatternLayout pattern="[%d{YYYY-MM-dd HH:mm:ss.SSS}] %level{length=1} %logger{36} - %msg%n"

backend/scripts/build

@@ -7,8 +7,6 @@ set -ex
 rm -rf target;
 mkdir -p target/classes;
 mkdir -p target/dist;
-mkdir -p target/dist/scripts;
-
 echo "$CURRENT_VERSION" > target/classes/version.txt;
 cp ../CHANGES.md target/classes/changelog.md;
 
@@ -17,7 +15,6 @@ mv target/penpot.jar target/dist/penpot.jar
 cp resources/log4j2.xml target/dist/log4j2.xml
 cp scripts/run.template.sh target/dist/run.sh;
 cp scripts/manage.py target/dist/manage.py
-cp scripts/svgo-cli.js target/dist/scripts/;
 chmod +x target/dist/run.sh;
 chmod +x target/dist/manage.py
 

backend/scripts/repl

@@ -1,6 +1,7 @@
 #!/usr/bin/env bash
 
 export PENPOT_HOST=devenv
+export PENPOT_TENANT=dev
 export PENPOT_FLAGS="\
        $PENPOT_FLAGS \
        enable-login-with-ldap \
@@ -22,7 +23,6 @@ export PENPOT_FLAGS="\
        enable-urepl-server \
        enable-rpc-climit \
        enable-rpc-rlimit \
-       enable-quotes \
        enable-soft-rpc-rlimit \
        enable-auto-file-snapshot \
        enable-webhooks \
@@ -67,7 +67,6 @@ export AWS_SECRET_ACCESS_KEY=penpot-devenv
 export PENPOT_OBJECTS_STORAGE_BACKEND=s3
 export PENPOT_OBJECTS_STORAGE_S3_ENDPOINT=http://minio:9000
 export PENPOT_OBJECTS_STORAGE_S3_BUCKET=penpot
-export PENPOT_OBJECTS_STORAGE_FS_DIRECTORY="assets"
 
 export OPTIONS="
        -A:jmx-remote -A:dev \

backend/scripts/start-dev

@@ -1,6 +1,7 @@
 #!/usr/bin/env bash
 
 export PENPOT_HOST=devenv
+export PENPOT_TENANT=dev
 export PENPOT_FLAGS="\
        $PENPOT_FLAGS \
        enable-prepl-server \
@@ -9,7 +10,6 @@ export PENPOT_FLAGS="\
        enable-webhooks \
        enable-backend-asserts \
        enable-audit-log \
-       enable-login-with-ldap \
        enable-transit-readable-response \
        enable-demo-users \
        enable-feature-fdata-pointer-map \
@@ -17,7 +17,6 @@ export PENPOT_FLAGS="\
        disable-secure-session-cookies \
        enable-rpc-climit \
        enable-smtp \
-       enable-quotes \
        enable-file-snapshot \
        enable-access-tokens \
        enable-tiered-file-data-storage \

backend/src/app/auth/ldap.clj

@@ -8,8 +8,9 @@
   (:require
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
-   [app.common.schema :as sm]
+   [app.common.spec :as us]
    [clj-ldap.client :as ldap]
+   [clojure.spec.alpha :as s]
    [clojure.string]
    [integrant.core :as ig]))
 
@@ -57,26 +58,21 @@
        :email    email
        :backend  "ldap"})))
 
-(def ^:private schema:info-data
-  [:map
-   [:fullname ::sm/text]
-   [:email ::sm/email]
-   [:backend ::sm/text]])
+(s/def ::fullname ::us/not-empty-string)
+(s/def ::email ::us/email)
+(s/def ::backend ::us/not-empty-string)
 
-(def ^:private valid-info-data?
-  (sm/lazy-validator schema:info-data))
-
-(def ^:private explain-info-data
-  (sm/lazy-explainer schema:info-data))
+(s/def ::info-data
+  (s/keys :req-un [::fullname ::email ::backend]))
 
 (defn authenticate
   [cfg params]
   (with-open [conn (connect cfg)]
     (when-let [user (-> (assoc cfg ::conn conn)
                         (retrieve-user params))]
-      (when-not (valid-info-data? user)
-        (let [explain (explain-info-data user)]
-          (l/warn :hint "invalid response from ldap, looks like ldap is not configured correctly" :data user)
+      (when-not (s/valid? ::info-data user)
+        (let [explain (s/explain-str ::info-data user)]
+          (l/warn ::l/raw (str "invalid response from ldap, looks like ldap is not configured correctly\n" explain))
           (ex/raise :type :restriction
                     :code :wrong-ldap-response
                     :explain explain)))
@@ -106,31 +102,38 @@
                  :host (:host cfg) :port (:port cfg) :cause cause)
         nil))))
 
-(def ^:private schema:params
-  [:map
-   [:host {:optional true} :string]
-   [:port {:optional true} ::sm/int]
-   [:bind-dn {:optional true} :string]
-   [:bind-passwor {:optional true} :string]
-   [:query {:optional true} :string]
-   [:base-dn {:optional true} :string]
-   [:attrs-email {:optional true} :string]
-   [:attrs-username {:optional true} :string]
-   [:attrs-fullname {:optional true} :string]
-   [:ssl {:optional true} ::sm/boolean]
-   [:tls {:optional true} ::sm/boolean]])
+(s/def ::enabled? ::us/boolean)
+(s/def ::host ::us/string)
+(s/def ::port ::us/integer)
+(s/def ::ssl ::us/boolean)
+(s/def ::tls ::us/boolean)
+(s/def ::query ::us/string)
+(s/def ::base-dn ::us/string)
+(s/def ::bind-dn ::us/string)
+(s/def ::bind-password ::us/string)
+(s/def ::attrs-email ::us/string)
+(s/def ::attrs-fullname ::us/string)
+(s/def ::attrs-username ::us/string)
 
-(def ^:private check-params
-  (sm/check-fn schema:params :hint "Invalid LDAP provider parameters"))
+(s/def ::provider-params
+  (s/keys :opt-un [::host ::port
+                   ::ssl ::tls
+                   ::enabled?
+                   ::bind-dn
+                   ::bind-password
+                   ::query
+                   ::attrs-email
+                   ::attrs-username
+                   ::attrs-fullname]))
 
-(defmethod ig/assert-key ::provider
-  [_ params]
-  (when (:enabled params)
-    (some->> params check-params)))
+(s/def ::provider
+  (s/nilable ::provider-params))
+
+(defmethod ig/pre-init-spec ::provider
+  [_]
+  (s/spec ::provider))
 
 (defmethod ig/init-key ::provider
   [_ cfg]
-  (when (:enabled cfg)
+  (when (:enabled? cfg)
     (try-connectivity cfg)))
-
-(sm/register! ::provider schema:params)

backend/src/app/auth/oidc.clj

@@ -12,7 +12,7 @@
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
-   [app.common.schema :as sm]
+   [app.common.spec :as us]
    [app.common.uri :as u]
    [app.config :as cf]
    [app.db :as db]
@@ -32,10 +32,11 @@
    [buddy.sign.jwk :as jwk]
    [buddy.sign.jwt :as jwt]
    [clojure.set :as set]
+   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig]
-   [yetti.request :as yreq]
-   [yetti.response :as-alias yres]))
+   [ring.request :as rreq]
+   [ring.response :as-alias rres]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; HELPERS
@@ -139,9 +140,8 @@
         (l/warn :hint "unable to retrieve JWKs (unexpected exception)"
                 :cause cause)))))
 
-(defmethod ig/assert-key ::providers/generic
-  [_ params]
-  (assert (http/client? (::http/client params)) "expected a valid http client"))
+(defmethod ig/pre-init-spec ::providers/generic [_]
+  (s/keys :req [::http/client]))
 
 (defmethod ig/init-key ::providers/generic
   [_ cfg]
@@ -197,10 +197,6 @@
 ;; GITHUB AUTH PROVIDER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defn- int-in-range?
-  [val start end]
-  (and (<= start val) (< val end)))
-
 (defn- retrieve-github-email
   [cfg tdata props]
   (or (some-> props :github/email)
@@ -211,7 +207,7 @@
 
             {:keys [status body]} (http/req! cfg params {:sync? true})]
 
-        (when-not (int-in-range? status 200 300)
+        (when-not (s/int-in-range? 200 300 status)
           (ex/raise :type :internal
                     :code :unable-to-retrieve-github-emails
                     :hint "unable to retrieve github emails"
@@ -221,9 +217,8 @@
 
         (->> body json/decode (filter :primary) first :email))))
 
-(defmethod ig/assert-key ::providers/github
-  [_ params]
-  (assert (http/client? (::http/client params)) "expected a valid http client"))
+(defmethod ig/pre-init-spec ::providers/github [_]
+  (s/keys :req [::http/client]))
 
 (defmethod ig/init-key ::providers/github
   [_ cfg]
@@ -399,7 +394,7 @@
            :status (:status response)
            :body   (:body response))
 
-    (when-not (int-in-range? (:status response) 200 300)
+    (when-not (s/int-in-range? 200 300 (:status response))
       (ex/raise :type :internal
                 :code :unable-to-retrieve-user-info
                 :hint "unable to retrieve user info"
@@ -423,15 +418,15 @@
       (l/warn :hint "unable to get user info from JWT token (unexpected exception)"
               :cause cause))))
 
-(def ^:private schema:info
-  [:map
-   [:backend ::sm/text]
-   [:email ::sm/email]
-   [:fullname ::sm/text]
-   [:props [:map-of :keyword :any]]])
-
-(def ^:private valid-info?
-  (sm/validator schema:info))
+(s/def ::backend ::us/not-empty-string)
+(s/def ::email ::us/not-empty-string)
+(s/def ::fullname ::us/not-empty-string)
+(s/def ::props (s/map-of ::us/keyword any?))
+(s/def ::info
+  (s/keys :req-un [::backend
+                   ::email
+                   ::fullname
+                   ::props]))
 
 (defn- get-info
   [{:keys [::provider ::setup/props] :as cfg} {:keys [params] :as request}]
@@ -449,7 +444,7 @@
 
     (l/trc :hint "user info" :info info)
 
-    (when-not (valid-info? info)
+    (when-not (s/valid? ::info info)
       (l/warn :hint "received incomplete profile info object (please set correct scopes)" :info info)
       (ex/raise :type :internal
                 :code :incomplete-user-info
@@ -497,8 +492,8 @@
 
 (defn- redirect-response
   [uri]
-  {::yres/status 302
-   ::yres/headers {"location" (str uri)}})
+  {::rres/status 302
+   ::rres/headers {"location" (str uri)}})
 
 (defn- redirect-with-error
   ([error] (redirect-with-error error nil))
@@ -603,7 +598,7 @@
 
 (defn- get-external-session-id
   [request]
-  (let [session-id (yreq/get-header request "x-external-session-id")]
+  (let [session-id (rreq/get-header request "x-external-session-id")]
     (when (string? session-id)
       (if (or (> (count session-id) 256)
               (= session-id "null")
@@ -623,8 +618,8 @@
         state  (tokens/generate (::setup/props cfg)
                                 (d/without-nils params))
         uri    (build-auth-uri cfg state)]
-    {::yres/status 200
-     ::yres/body {:redirect-uri uri}}))
+    {::rres/status 200
+     ::rres/body {:redirect-uri uri}}))
 
 (defn- callback-handler
   [{:keys [::provider] :as cfg} request]
@@ -660,37 +655,46 @@
                        :provider provider
                        :hint "provider not configured"))))))})
 
-(def ^:private schema:provider
-  [:map {:title "provider"}
-   [:client-id ::sm/text]
-   [:client-secret ::sm/text]
-   [:base-uri {:optional true} ::sm/text]
-   [:token-uri {:optional true} ::sm/text]
-   [:auth-uri {:optional true} ::sm/text]
-   [:user-uri {:optional true} ::sm/text]
-   [:scopes {:optional true}
-    [::sm/set ::sm/text]]
-   [:roles {:optional true}
-    [::sm/set ::sm/text]]
-   [:roles-attr {:optional true} ::sm/text]
-   [:email-attr {:optional true} ::sm/text]
-   [:name-attr {:optional true} ::sm/text]])
+(s/def ::client-id ::us/string)
+(s/def ::client-secret ::us/string)
+(s/def ::base-uri ::us/string)
+(s/def ::token-uri ::us/string)
+(s/def ::auth-uri ::us/string)
+(s/def ::user-uri ::us/string)
+(s/def ::scopes ::us/set-of-strings)
+(s/def ::roles ::us/set-of-strings)
+(s/def ::roles-attr ::us/string)
+(s/def ::email-attr ::us/string)
+(s/def ::name-attr ::us/string)
 
-(def ^:private schema:routes-params
-  [:map
-   ::session/manager
-   ::http/client
-   ::setup/props
-   ::db/pool
-   [::providers [:map-of :keyword [:maybe schema:provider]]]])
+(s/def ::provider
+  (s/keys :req-un [::client-id
+                   ::client-secret]
+          :opt-un [::base-uri
+                   ::token-uri
+                   ::auth-uri
+                   ::user-uri
+                   ::scopes
+                   ::roles
+                   ::roles-attr
+                   ::email-attr
+                   ::name-attr]))
 
-(defmethod ig/assert-key ::routes
-  [_ params]
-  (assert (sm/check schema:routes-params params)))
+(s/def ::providers (s/map-of ::us/keyword (s/nilable ::provider)))
+
+(s/def ::routes vector?)
+
+(defmethod ig/pre-init-spec ::routes
+  [_]
+  (s/keys :req [::session/manager
+                ::http/client
+                ::setup/props
+                ::db/pool
+                ::providers]))
 
 (defmethod ig/init-key ::routes
   [_ cfg]
-  (let [cfg (update cfg :providers d/without-nils)]
+  (let [cfg (update cfg :provider d/without-nils)]
     ["" {:middleware [[session/authz cfg]
                       [provider-lookup cfg]]}
      ["/auth/oauth"

backend/src/app/binfile/common.clj

@@ -37,21 +37,6 @@
 (def ^:dynamic *state* nil)
 (def ^:dynamic *options* nil)
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; DEFAULTS
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Threshold in MiB when we pass from using
-;; in-memory byte-array's to use temporal files.
-(def temp-file-threshold
-  (* 1024 1024 2))
-
-;; A maximum (storage) object size allowed: 100MiB
-(def ^:const max-object-size
-  (* 1024 1024 100))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
 (def xf-map-id
   (map :id))
 
@@ -71,13 +56,6 @@
 (def conj-vec
   (fnil conj []))
 
-(defn initial-state
-  []
-  {:storage-objects #{}
-   :files #{}
-   :teams #{}
-   :projects #{}})
-
 (defn collect-storage-objects
   [state items]
   (update state :storage-objects into xf-map-media-id items))
@@ -109,8 +87,6 @@
           attrs))
 
 (defn update-index
-  ([coll]
-   (update-index {} coll identity))
   ([index coll]
    (update-index index coll identity))
   ([index coll attr]
@@ -134,30 +110,10 @@
                          (update :data feat.fdata/process-pointers deref)
                          (update :data feat.fdata/process-objects (partial into {}))))))))
 
-(defn clean-file-features
-  [file]
-  (update file :features (fn [features]
-                           (if (set? features)
-                             (-> features
-                                 (cfeat/migrate-legacy-features)
-                                 (set/difference cfeat/frontend-only-features)
-                                 (set/difference cfeat/backend-only-features))
-                             #{}))))
-
 (defn get-project
   [cfg project-id]
   (db/get cfg :project {:id project-id}))
 
-(def ^:private sql:get-teams
-  "SELECT t.* FROM team WHERE id = ANY(?)")
-
-(defn get-teams
-  [cfg ids]
-  (let [conn (db/get-connection cfg)
-        ids  (db/create-array conn "uuid" ids)]
-    (->> (db/exec! conn [sql:get-teams ids])
-         (map decode-row))))
-
 (defn get-team
   [cfg team-id]
   (-> (db/get cfg :team {:id team-id})
@@ -211,10 +167,9 @@
 (defn get-file-object-thumbnails
   "Return all file object thumbnails for a given file."
   [cfg file-id]
-  (->> (db/query cfg :file-tagged-object-thumbnail
-                 {:file-id file-id
-                  :deleted-at nil})
-       (not-empty)))
+  (db/query cfg :file-tagged-object-thumbnail
+            {:file-id file-id
+             :deleted-at nil}))
 
 (defn get-file-thumbnail
   "Return the thumbnail for the specified file-id"
@@ -269,26 +224,26 @@
                    (->> (db/exec! conn [sql ids])
                         (mapv #(assoc % :file-id id)))))))
 
-(def ^:private sql:get-team-files-ids
+(def ^:private sql:get-team-files
   "SELECT f.id FROM file AS f
      JOIN project AS p ON (p.id = f.project_id)
     WHERE p.team_id = ?")
 
-(defn get-team-files-ids
+(defn get-team-files
   "Get a set of file ids for the specified team-id"
   [{:keys [::db/conn]} team-id]
-  (->> (db/exec! conn [sql:get-team-files-ids team-id])
+  (->> (db/exec! conn [sql:get-team-files team-id])
        (into #{} xf-map-id)))
 
 (def ^:private sql:get-team-projects
-  "SELECT p.* FROM project AS p
+  "SELECT p.id FROM project AS p
     WHERE p.team_id = ?
       AND p.deleted_at IS NULL")
 
 (defn get-team-projects
   "Get a set of project ids for the team"
-  [cfg team-id]
-  (->> (db/exec! cfg [sql:get-team-projects team-id])
+  [{:keys [::db/conn]} team-id]
+  (->> (db/exec! conn [sql:get-team-projects team-id])
        (into #{} xf-map-id)))
 
 (def ^:private sql:get-project-files
@@ -302,10 +257,6 @@
   (->> (db/exec! conn [sql:get-project-files project-id])
        (into #{} xf-map-id)))
 
-(defn remap-thumbnail-object-id
-  [object-id file-id]
-  (str/replace-first object-id #"^(.*?)/" (str file-id "/")))
-
 (defn- relink-shapes
   "A function responsible to analyze all file data and
   replace the old :component-file reference with the new
@@ -388,12 +339,6 @@
             data
             library-ids)))
 
-(defn disable-database-timeouts!
-  [cfg]
-  (let [conn (db/get-connection cfg)]
-    (db/exec-one! conn ["SET LOCAL idle_in_transaction_session_timeout = 0"])
-    (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])))
-
 (defn- fix-version
   [file]
   (let [file (fmg/fix-version file)]
@@ -455,11 +400,8 @@
                            (fn [features]
                              (let [features (cfeat/check-supported-features! features)]
                                (-> (::features cfg #{})
-                                   (set/union features)
-                                   ;; We never want to store
-                                   ;; frontend-only features on file
-                                   (set/difference cfeat/frontend-only-features))))))
-
+                                   (set/difference cfeat/frontend-only-features)
+                                   (set/union features))))))
 
         _      (when (contains? cf/flags :file-schema-validation)
                  (fval/validate-file-schema! file))
@@ -490,20 +432,6 @@
 
     file))
 
-
-(defn register-pending-migrations
-  "All features that are enabled and requires explicit migration are
-  added to the state for a posterior migration step."
-  [cfg {:keys [id features] :as file}]
-  (doseq [feature (-> (::features cfg)
-                      (set/difference cfeat/no-migration-features)
-                      (set/difference cfeat/backend-only-features)
-                      (set/difference features))]
-    (vswap! *state* update :pending-to-migrate (fnil conj []) [feature id]))
-
-  file)
-
-
 (defn apply-pending-migrations!
   "Apply alredy registered pending migrations to files"
   [cfg]

backend/src/app/binfile/v1.clj

@@ -49,6 +49,15 @@
 
 (set! *warn-on-reflection* true)
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; DEFAULTS
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Threshold in MiB when we pass from using
+;; in-memory byte-array's to use temporal files.
+(def temp-file-threshold
+  (* 1024 1024 2))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; LOW LEVEL STREAM IO API
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -56,6 +65,11 @@
 (def ^:const buffer-size (:xnio/buffer-size yt/defaults))
 (def ^:const penpot-magic-number 800099563638710213)
 
+
+;; A maximum (storage) object size allowed: 100MiB
+(def ^:const max-object-size
+  (* 1024 1024 100))
+
 (def ^:dynamic *position* nil)
 
 (defn get-mark
@@ -222,7 +236,7 @@
 
 (defn copy-stream!
   [^OutputStream output ^InputStream input ^long size]
-  (let [written (io/copy input output :size size)]
+  (let [written (io/copy! input output :size size)]
     (l/trace :fn "copy-stream!" :position @*position* :size size :written written ::l/sync? true)
     (swap! *position* + written)
     written))
@@ -244,18 +258,18 @@
         p (tmp/tempfile :prefix "penpot.binfile.")]
     (assert-mark m :stream)
 
-    (when (> s bfc/max-object-size)
+    (when (> s max-object-size)
       (ex/raise :type :validation
                 :code :max-file-size-reached
                 :hint (str/ffmt "unable to import storage object with size % bytes" s)))
 
-    (if (> s bfc/temp-file-threshold)
+    (if (> s temp-file-threshold)
       (with-open [^OutputStream output (io/output-stream p)]
-        (let [readed (io/copy input output :offset 0 :size s)]
+        (let [readed (io/copy! input output :offset 0 :size s)]
           (l/trace :fn "read-stream*!" :expected s :readed readed :position @*position* ::l/sync? true)
           (swap! *position* + readed)
           [s p]))
-      [s (io/read input :size s)])))
+      [s (io/read-as-bytes input :size s)])))
 
 (defmacro assert-read-label!
   [input expected-label]
@@ -367,12 +381,10 @@
              ::l/sync? true)
 
       (doseq [item media]
-        (l/dbg :hint "write penpot file media object"
-               :id (:id item) ::l/sync? true))
+        (l/dbg :hint "write penpot file media object" :id (:id item) ::l/sync? true))
 
       (doseq [item thumbnails]
-        (l/dbg :hint "write penpot file object thumbnail"
-               :media-id (str (:media-id item)) ::l/sync? true))
+        (l/dbg :hint "write penpot file object thumbnail" :media-id (str (:media-id item)) ::l/sync? true))
 
       (doto output
         (write-obj! file)
@@ -454,8 +466,8 @@
 
 (defn- read-import-v1
   [{:keys [::db/conn ::project-id ::profile-id ::input] :as cfg}]
-
-  (bfc/disable-database-timeouts! cfg)
+  (db/exec-one! conn ["SET LOCAL idle_in_transaction_session_timeout = 0"])
+  (db/exec-one! conn ["SET CONSTRAINTS ALL DEFERRED"])
 
   (pu/with-open [input (zstd-input-stream input)
                  input (io/data-input-stream input)]
@@ -508,6 +520,15 @@
               (update :object-id #(str/replace-first % #"^(.*?)/" (str file-id "/")))))
         thumbnails))
 
+(defn- clean-features
+  [file]
+  (update file :features (fn [features]
+                           (if (set? features)
+                             (-> features
+                                 (cfeat/migrate-legacy-features)
+                                 (set/difference cfeat/backend-only-features))
+                             #{}))))
+
 (defmethod read-section :v1/files
   [{:keys [::db/conn ::input ::project-id ::bfc/overwrite ::name] :as system}]
 
@@ -518,7 +539,7 @@
           file-id    (:id file)
           file-id'   (bfc/lookup-index file-id)
 
-          file       (bfc/clean-file-features file)
+          file       (clean-features file)
           thumbnails (:thumbnails file)]
 
       (when (not= file-id expected-file-id)
@@ -538,9 +559,7 @@
 
       (when (seq thumbnails)
         (let [thumbnails (remap-thumbnails thumbnails file-id')]
-          (l/dbg :hint "updated index with thumbnails"
-                 :total (count thumbnails)
-                 ::l/sync? true)
+          (l/dbg :hint "updated index with thumbnails" :total (count thumbnails) ::l/sync? true)
           (vswap! bfc/*state* update :thumbnails bfc/into-vec thumbnails)))
 
       (when (seq media)
@@ -690,7 +709,7 @@
 
   (dm/assert!
    "expected instance of jio/IOFactory for `input`"
-   (io/coercible? output))
+   (satisfies? jio/IOFactory output))
 
   (let [id (uuid/next)
         tp (dt/tpoint)
@@ -719,7 +738,7 @@
                 :cause @cs)))))
 
 (defn import-files!
-  [{:keys [::input] :as cfg}]
+  [cfg input]
 
   (dm/assert!
    "expected valid profile-id and project-id on `cfg`"

backend/src/app/binfile/v2.clj

@@ -141,15 +141,16 @@
       (write! cfg :team-font-variant id font))))
 
 (defn- write-project!
-  [cfg project]
-  (events/tap :progress
-              {:op :export
-               :section :write-project
-               :id (:id project)
-               :name (:name project)})
-  (l/trc :hint "write" :obj "project" :id (str (:id project)))
-  (write! cfg :project (str (:id project)) project)
-  (vswap! bfc/*state* update :projects conj (:id project)))
+  [cfg project-id]
+  (let [project (bfc/get-project cfg project-id)]
+    (events/tap :progress
+                {:op :export
+                 :section :write-project
+                 :id project-id
+                 :name (:name project)})
+    (l/trc :hint "write" :obj "project" :id (str project-id))
+    (write! cfg :project (str project-id) project)
+    (vswap! bfc/*state* update :projects conj project-id)))
 
 (defn- write-file!
   [cfg file-id]
@@ -190,7 +191,7 @@
   [{:keys [::sto/storage] :as cfg} id]
   (let [sobj (sto/get-object storage id)
         data (with-open [input (sto/get-object-data storage sobj)]
-               (io/read input))]
+               (io/read-as-bytes input))]
 
     (l/trc :hint "write" :obj "storage-object" :id (str id) :size (:size sobj))
     (write! cfg :storage-object id (meta sobj) data)))
@@ -362,7 +363,7 @@
                                 (bfc/get-team-projects cfg team-id))
 
                           (run! (partial write-file! cfg)
-                                (bfc/get-team-files-ids cfg team-id))
+                                (bfc/get-team-files cfg team-id))
 
                           (run! (partial write-storage-object! cfg)
                                 (-> bfc/*state* deref :storage-objects))

backend/src/app/binfile/v3.clj

@@ -1,963 +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.binfile.v3
-  "A ZIP based binary file exportation"
-  (:refer-clojure :exclude [read])
-  (:require
-   [app.binfile.common :as bfc]
-   [app.common.data :as d]
-   [app.common.data.macros :as dm]
-   [app.common.exceptions :as ex]
-   [app.common.features :as cfeat]
-   [app.common.json :as json]
-   [app.common.logging :as l]
-   [app.common.schema :as sm]
-   [app.common.thumbnails :as cth]
-   [app.common.types.color :as ctcl]
-   [app.common.types.component :as ctc]
-   [app.common.types.file :as ctf]
-   [app.common.types.page :as ctp]
-   [app.common.types.plugins :as ctpg]
-   [app.common.types.shape :as cts]
-   [app.common.types.typography :as cty]
-   [app.common.uuid :as uuid]
-   [app.config :as cf]
-   [app.db :as db]
-   [app.storage :as sto]
-   [app.storage.impl :as sto.impl]
-   [app.util.events :as events]
-   [app.util.time :as dt]
-   [clojure.java.io :as jio]
-   [cuerdas.core :as str]
-   [datoteka.fs :as fs]
-   [datoteka.io :as io])
-  (:import
-   java.io.InputStream
-   java.io.OutputStreamWriter
-   java.util.zip.ZipEntry
-   java.util.zip.ZipFile
-   java.util.zip.ZipOutputStream))
-
-;; --- SCHEMA
-
-(def ^:private schema:manifest
-  [:map {:title "Manifest"}
-   [:version ::sm/int]
-   [:type :string]
-
-   [:generated-by {:optional true} :string]
-
-   [:files
-    [:vector
-     [:map
-      [:id ::sm/uuid]
-      [:name :string]
-      [:project-id ::sm/uuid]
-      [:features ::cfeat/features]]]]
-
-   [:relations {:optional true}
-    [:vector
-     [:tuple ::sm/uuid ::sm/uuid]]]])
-
-(def ^:private schema:storage-object
-  [:map {:title "StorageObject"}
-   [:id ::sm/uuid]
-   [:size ::sm/int]
-   [:content-type :string]
-   [:bucket [::sm/one-of {:format :string} sto/valid-buckets]]
-   [:hash :string]])
-
-(def ^:private schema:file-thumbnail
-  [:map {:title "FileThumbnail"}
-   [:file-id ::sm/uuid]
-   [:page-id ::sm/uuid]
-   [:frame-id ::sm/uuid]
-   [:tag :string]
-   [:media-id ::sm/uuid]])
-
-;; --- ENCODERS
-
-(def encode-file
-  (sm/encoder ::ctf/file sm/json-transformer))
-
-(def encode-page
-  (sm/encoder ::ctp/page sm/json-transformer))
-
-(def encode-shape
-  (sm/encoder ::cts/shape sm/json-transformer))
-
-(def encode-media
-  (sm/encoder ::ctf/media sm/json-transformer))
-
-(def encode-component
-  (sm/encoder ::ctc/component sm/json-transformer))
-
-(def encode-color
-  (sm/encoder ::ctcl/color sm/json-transformer))
-
-(def encode-typography
-  (sm/encoder ::cty/typography sm/json-transformer))
-
-(def encode-plugin-data
-  (sm/encoder ::ctpg/plugin-data sm/json-transformer))
-
-(def encode-storage-object
-  (sm/encoder schema:storage-object sm/json-transformer))
-
-(def encode-file-thumbnail
-  (sm/encoder schema:file-thumbnail sm/json-transformer))
-
-;; --- DECODERS
-
-(def decode-manifest
-  (sm/decoder schema:manifest sm/json-transformer))
-
-(def decode-media
-  (sm/decoder ::ctf/media sm/json-transformer))
-
-(def decode-component
-  (sm/decoder ::ctc/component sm/json-transformer))
-
-(def decode-color
-  (sm/decoder ::ctcl/color sm/json-transformer))
-
-(def decode-file
-  (sm/decoder ::ctf/file sm/json-transformer))
-
-(def decode-page
-  (sm/decoder ::ctp/page sm/json-transformer))
-
-(def decode-shape
-  (sm/decoder ::cts/shape sm/json-transformer))
-
-(def decode-typography
-  (sm/decoder ::cty/typography sm/json-transformer))
-
-(def decode-plugin-data
-  (sm/decoder ::ctpg/plugin-data sm/json-transformer))
-
-(def decode-storage-object
-  (sm/decoder schema:storage-object sm/json-transformer))
-
-(def decode-file-thumbnail
-  (sm/decoder schema:file-thumbnail sm/json-transformer))
-
-;; --- VALIDATORS
-
-(def validate-manifest
-  (sm/check-fn schema:manifest))
-
-(def validate-file
-  (sm/check-fn ::ctf/file))
-
-(def validate-page
-  (sm/check-fn ::ctp/page))
-
-(def validate-shape
-  (sm/check-fn ::cts/shape))
-
-(def validate-media
-  (sm/check-fn ::ctf/media))
-
-(def validate-color
-  (sm/check-fn ::ctcl/color))
-
-(def validate-component
-  (sm/check-fn ::ctc/component))
-
-(def validate-typography
-  (sm/check-fn ::cty/typography))
-
-(def validate-plugin-data
-  (sm/check-fn ::ctpg/plugin-data))
-
-(def validate-storage-object
-  (sm/check-fn schema:storage-object))
-
-(def validate-file-thumbnail
-  (sm/check-fn schema:file-thumbnail))
-
-;; --- EXPORT IMPL
-
-(defn- write-entry!
-  [^ZipOutputStream output ^String path data]
-  (.putNextEntry output (ZipEntry. path))
-  (let [writer (OutputStreamWriter. output "UTF-8")]
-    (json/write writer data :indent true :key-fn json/write-camel-key)
-    (.flush writer))
-  (.closeEntry output))
-
-(defn- get-file
-  [{:keys [::embed-assets ::include-libraries] :as cfg} file-id]
-
-  (when (and include-libraries embed-assets)
-    (throw (IllegalArgumentException.
-            "the `include-libraries` and `embed-assets` are mutally excluding options")))
-
-  (let [detach?  (and (not embed-assets) (not include-libraries))]
-    (cond-> (bfc/get-file cfg file-id)
-      detach?
-      (-> (ctf/detach-external-references file-id)
-          (dissoc :libraries))
-
-      embed-assets
-      (update :data #(bfc/embed-assets cfg % file-id))
-
-      :always
-      (bfc/clean-file-features))))
-
-(defn- resolve-extension
-  [mtype]
-  (case mtype
-    "image/png"     ".png"
-    "image/jpeg"    ".jpg"
-    "image/gif"     ".gif"
-    "image/svg+xml" ".svg"
-    "image/webp"    ".webp"
-    "font/woff"     ".woff"
-    "font/woff2"    ".woff2"
-    "font/ttf"      ".ttf"
-    "font/otf"      ".otf"
-    "application/octet-stream" ".bin"))
-
-(defn- export-storage-objects
-  [{:keys [::output] :as cfg}]
-  (let [storage (sto/resolve cfg)]
-    (doseq [id (-> bfc/*state* deref :storage-objects not-empty)]
-      (let [sobject (sto/get-object storage id)
-            smeta   (meta sobject)
-            ext     (resolve-extension (:content-type smeta))
-            path    (str "objects/" id ".json")
-            params  (-> (meta sobject)
-                        (assoc :id (:id sobject))
-                        (assoc :size (:size sobject))
-                        (encode-storage-object))]
-
-        (write-entry! output path params)
-
-        (with-open [input (sto/get-object-data storage sobject)]
-          (.putNextEntry output (ZipEntry. (str "objects/" id ext)))
-          (io/copy input output :size (:size sobject))
-          (.closeEntry output))))))
-
-(defn- export-file
-  [{:keys [::file-id ::output] :as cfg}]
-  (let [file         (get-file cfg file-id)
-        media        (->> (bfc/get-file-media cfg file)
-                          (map (fn [media]
-                                 (dissoc media :file-id))))
-
-        data         (:data file)
-        typographies (:typographies data)
-        components   (:components data)
-        colors       (:colors data)
-
-        pages        (:pages data)
-        pages-index  (:pages-index data)
-
-        thumbnails   (bfc/get-file-object-thumbnails cfg file-id)]
-
-    (vswap! bfc/*state* update :files assoc file-id
-            {:id file-id
-             :project-id (:project-id file)
-             :name (:name file)
-             :features (:features file)})
-
-    (let [file (cond-> (dissoc file :data)
-                 (:options data)
-                 (assoc :options (:options data))
-                 :always
-                 (encode-file))
-          path (str "files/" file-id ".json")]
-      (write-entry! output path file))
-
-    (doseq [[index page-id] (d/enumerate pages)]
-      (let [path    (str "files/" file-id "/pages/" page-id ".json")
-            page    (get pages-index page-id)
-            objects (:objects page)
-            page    (-> page
-                        (dissoc :objects)
-                        (assoc :index index))
-            page    (encode-page page)]
-
-        (write-entry! output path page)
-
-        (doseq [[shape-id shape] objects]
-          (let [path  (str "files/" file-id "/pages/" page-id "/" shape-id ".json")
-                shape (assoc shape :page-id page-id)
-                shape (encode-shape shape)]
-            (write-entry! output path shape)))))
-
-    (vswap! bfc/*state* bfc/collect-storage-objects media)
-    (vswap! bfc/*state* bfc/collect-storage-objects thumbnails)
-
-    (doseq [{:keys [id] :as media} media]
-      (let [path  (str "files/" file-id "/media/" id ".json")
-            media (encode-media media)]
-        (write-entry! output path media)))
-
-    (doseq [thumbnail thumbnails]
-      (let [data (cth/parse-object-id (:object-id thumbnail))
-            path (str "files/" file-id "/thumbnails/" (:tag data) "/" (:page-id data)
-                      "/" (:frame-id data) ".json")
-            data (-> data
-                     (assoc :media-id (:media-id thumbnail))
-                     (encode-file-thumbnail))]
-        (write-entry! output path data)))
-
-    (doseq [[id component] components]
-      (let [path      (str "files/" file-id "/components/" id ".json")
-            component (encode-component component)]
-        (write-entry! output path component)))
-
-    (doseq [[id color] colors]
-      (let [path  (str "files/" file-id "/colors/" id ".json")
-            color (-> (encode-color color)
-                      (dissoc :file-id))
-            color (cond-> color
-                    (and (contains? color :path)
-                         (str/empty? (:path color)))
-                    (dissoc :path))]
-        (write-entry! output path color)))
-
-    (doseq [[id object] typographies]
-      (let [path  (str "files/" file-id "/typographies/" id ".json")
-            color (encode-typography object)]
-        (write-entry! output path color)))))
-
-(defn- export-files
-  [{:keys [::ids ::include-libraries ::output] :as cfg}]
-  (let [ids  (into ids (when include-libraries (bfc/get-libraries cfg ids)))
-        rels (if include-libraries
-               (->> (bfc/get-files-rels cfg ids)
-                    (mapv (juxt :file-id :library-file-id)))
-               [])]
-
-    (vswap! bfc/*state* assoc :files (d/ordered-map))
-
-    ;; Write all the exporting files
-    (doseq [[index file-id] (d/enumerate ids)]
-      (-> cfg
-          (assoc ::file-id file-id)
-          (assoc ::file-seqn index)
-          (export-file)))
-
-    ;; Write manifest file
-    (let [files  (:files @bfc/*state*)
-          params {:type "penpot/export-files"
-                  :version 1
-                  :generated-by (str "penpot/" (:full cf/version))
-                  :files (vec (vals files))
-                  :relations rels}]
-      (write-entry! output "manifest.json" params))))
-
-;; --- IMPORT IMPL
-
-(defn- read-zip-entries
-  [^ZipFile input]
-  (into #{} (iterator-seq (.entries input))))
-
-(defn- get-zip-entry*
-  [^ZipFile input ^String path]
-  (.getEntry input path))
-
-(defn- get-zip-entry
-  [input path]
-  (let [entry (get-zip-entry* input path)]
-    (when-not entry
-      (ex/raise :type :validation
-                :code :inconsistent-penpot-file
-                :hint "the penpot file seems corrupt, missing underlying zip entry"
-                :path path))
-    entry))
-
-(defn- get-zip-entry-size
-  [^ZipEntry entry]
-  (.getSize entry))
-
-(defn- zip-entry-name
-  [^ZipEntry entry]
-  (.getName entry))
-
-(defn- zip-entry-stream
-  ^InputStream
-  [^ZipFile input ^ZipEntry entry]
-  (.getInputStream input entry))
-
-(defn- zip-entry-reader
-  [^ZipFile input ^ZipEntry entry]
-  (-> (zip-entry-stream input entry)
-      (io/reader :encoding "UTF-8")))
-
-(defn- zip-entry-storage-content
-  "Wraps a ZipFile and ZipEntry into a penpot storage compatible
-  object and avoid creating temporal objects"
-  [input entry]
-  (let [hash  (delay (->> entry
-                          (zip-entry-stream input)
-                          (sto.impl/calculate-hash)))]
-    (reify
-      sto.impl/IContentObject
-      (get-size [_]
-        (get-zip-entry-size entry))
-
-      sto.impl/IContentHash
-      (get-hash [_]
-        (deref hash))
-
-      jio/IOFactory
-      (make-reader [this opts]
-        (jio/make-reader this opts))
-      (make-writer [_ _]
-        (throw (UnsupportedOperationException. "not implemented")))
-
-      (make-input-stream [_ _]
-        (zip-entry-stream input entry))
-      (make-output-stream [_ _]
-        (throw (UnsupportedOperationException. "not implemented"))))))
-
-(defn- read-manifest
-  [^ZipFile input]
-  (let [entry (get-zip-entry input "manifest.json")]
-    (with-open [reader (zip-entry-reader input entry)]
-      (let [manifest (json/read reader :key-fn json/read-kebab-key)]
-        (decode-manifest manifest)))))
-
-(defn- match-media-entry-fn
-  [file-id]
-  (let [pattern (str "^files/" file-id "/media/([^/]+).json$")
-        pattern (re-pattern pattern)]
-    (fn [entry]
-      (when-let [[_ id] (re-matches pattern (zip-entry-name entry))]
-        {:entry entry
-         :id (parse-uuid id)}))))
-
-(defn- match-color-entry-fn
-  [file-id]
-  (let [pattern (str "^files/" file-id "/colors/([^/]+).json$")
-        pattern (re-pattern pattern)]
-    (fn [entry]
-      (when-let [[_ id] (re-matches pattern (zip-entry-name entry))]
-        {:entry entry
-         :id (parse-uuid id)}))))
-
-(defn- match-component-entry-fn
-  [file-id]
-  (let [pattern (str "^files/" file-id "/components/([^/]+).json$")
-        pattern (re-pattern pattern)]
-    (fn [entry]
-      (when-let [[_ id] (re-matches pattern (zip-entry-name entry))]
-        {:entry entry
-         :id (parse-uuid id)}))))
-
-(defn- match-typography-entry-fn
-  [file-id]
-  (let [pattern (str "^files/" file-id "/typographies/([^/]+).json$")
-        pattern (re-pattern pattern)]
-    (fn [entry]
-      (when-let [[_ id] (re-matches pattern (zip-entry-name entry))]
-        {:entry entry
-         :id (parse-uuid id)}))))
-
-(defn- match-thumbnail-entry-fn
-  [file-id]
-  (let [pattern (str "^files/" file-id "/thumbnails/([^/]+)/([^/]+)/([^/]+).json$")
-        pattern (re-pattern pattern)]
-    (fn [entry]
-      (when-let [[_ tag page-id frame-id] (re-matches pattern (zip-entry-name entry))]
-        {:entry entry
-         :tag tag
-         :page-id (parse-uuid page-id)
-         :frame-id (parse-uuid frame-id)
-         :file-id file-id}))))
-
-(defn- match-page-entry-fn
-  [file-id]
-  (let [pattern (str "^files/" file-id "/pages/([^/]+).json$")
-        pattern (re-pattern pattern)]
-    (fn [entry]
-      (when-let [[_ id] (re-matches pattern (zip-entry-name entry))]
-        {:entry entry
-         :id (parse-uuid id)}))))
-
-(defn- match-shape-entry-fn
-  [file-id page-id]
-  (let [pattern (str "^files/" file-id "/pages/" page-id "/([^/]+).json$")
-        pattern (re-pattern pattern)]
-    (fn [entry]
-      (when-let [[_ id] (re-matches pattern (zip-entry-name entry))]
-        {:entry entry
-         :page-id page-id
-         :id (parse-uuid id)}))))
-
-(defn- match-storage-entry-fn
-  []
-  (let [pattern (str "^objects/([^/]+).json$")
-        pattern (re-pattern pattern)]
-    (fn [entry]
-      (when-let [[_ id] (re-matches pattern (zip-entry-name entry))]
-        {:entry entry
-         :id (parse-uuid id)}))))
-
-(defn- read-entry
-  [^ZipFile input entry]
-  (with-open [reader (zip-entry-reader input entry)]
-    (json/read reader :key-fn json/read-kebab-key)))
-
-(defn- read-file
-  [{:keys [::input ::file-id]}]
-  (let [path  (str "files/" file-id ".json")
-        entry (get-zip-entry input path)]
-    (-> (read-entry input entry)
-        (decode-file)
-        (validate-file))))
-
-(defn- read-file-plugin-data
-  [{:keys [::input ::file-id]}]
-  (let [path  (str "files/" file-id "/plugin-data.json")
-        entry (get-zip-entry* input path)]
-    (some->> entry
-             (read-entry input)
-             (decode-plugin-data)
-             (validate-plugin-data))))
-
-(defn- read-file-media
-  [{:keys [::input ::file-id ::entries]}]
-  (->> (keep (match-media-entry-fn file-id) entries)
-       (reduce (fn [result {:keys [id entry]}]
-                 (let [object (->> (read-entry input entry)
-                                   (decode-media)
-                                   (validate-media))
-                       object (assoc object :file-id file-id)]
-                   (if (= id (:id object))
-                     (conj result object)
-                     result)))
-               [])
-       (not-empty)))
-
-(defn- read-file-colors
-  [{:keys [::input ::file-id ::entries]}]
-  (->> (keep (match-color-entry-fn file-id) entries)
-       (reduce (fn [result {:keys [id entry]}]
-                 (let [object (->> (read-entry input entry)
-                                   (decode-color)
-                                   (validate-color))]
-                   (if (= id (:id object))
-                     (assoc result id object)
-                     result)))
-               {})
-       (not-empty)))
-
-(defn- read-file-components
-  [{:keys [::input ::file-id ::entries]}]
-  (->> (keep (match-component-entry-fn file-id) entries)
-       (reduce (fn [result {:keys [id entry]}]
-                 (let [object (->> (read-entry input entry)
-                                   (decode-component)
-                                   (validate-component))]
-                   (if (= id (:id object))
-                     (assoc result id object)
-                     result)))
-               {})
-       (not-empty)))
-
-(defn- read-file-typographies
-  [{:keys [::input ::file-id ::entries]}]
-  (->> (keep (match-typography-entry-fn file-id) entries)
-       (reduce (fn [result {:keys [id entry]}]
-                 (let [object (->> (read-entry input entry)
-                                   (decode-typography)
-                                   (validate-typography))]
-                   (if (= id (:id object))
-                     (assoc result id object)
-                     result)))
-               {})
-       (not-empty)))
-
-(defn- read-file-shapes
-  [{:keys [::input ::file-id ::page-id ::entries] :as cfg}]
-  (->> (keep (match-shape-entry-fn file-id page-id) entries)
-       (reduce (fn [result {:keys [id entry]}]
-                 (let [object (->> (read-entry input entry)
-                                   (decode-shape)
-                                   (validate-shape))]
-                   (if (= id (:id object))
-                     (assoc result id object)
-                     result)))
-               {})
-       (not-empty)))
-
-(defn- read-file-pages
-  [{:keys [::input ::file-id ::entries] :as cfg}]
-  (->> (keep (match-page-entry-fn file-id) entries)
-       (keep (fn [{:keys [id entry]}]
-               (let [page (->> (read-entry input entry)
-                               (decode-page))
-                     page (dissoc page :options)]
-                 (when (= id (:id page))
-                   (let [objects (-> (assoc cfg ::page-id id)
-                                     (read-file-shapes))]
-                     (assoc page :objects objects))))))
-       (sort-by :index)
-       (reduce (fn [result {:keys [id] :as page}]
-                 (assoc result id (dissoc page :index)))
-               (d/ordered-map))))
-
-(defn- read-file-thumbnails
-  [{:keys [::input ::file-id ::entries] :as cfg}]
-  (->> (keep (match-thumbnail-entry-fn file-id) entries)
-       (reduce (fn [result {:keys [page-id frame-id tag entry]}]
-                 (let [object (->> (read-entry input entry)
-                                   (decode-file-thumbnail)
-                                   (validate-file-thumbnail))]
-                   (if (and (= frame-id (:frame-id object))
-                            (= page-id (:page-id object))
-                            (= tag (:tag object)))
-                     (conj result object)
-                     result)))
-               [])
-       (not-empty)))
-
-(defn- read-file-data
-  [{:keys [] :as cfg}]
-  (let [colors       (read-file-colors cfg)
-        typographies (read-file-typographies cfg)
-        components   (read-file-components cfg)
-        plugin-data  (read-file-plugin-data cfg)
-        pages        (read-file-pages cfg)]
-
-    {:pages (-> pages keys vec)
-     :pages-index (into {} pages)
-     :colors colors
-     :typographies typographies
-     :components components
-     :plugin-data plugin-data}))
-
-(defn- import-file
-  [{:keys [::db/conn ::project-id ::file-id ::file-name] :as cfg}]
-  (let [file-id'   (bfc/lookup-index file-id)
-        file       (read-file cfg)
-        media      (read-file-media cfg)
-        thumbnails (read-file-thumbnails cfg)]
-
-    (l/dbg :hint "processing file"
-           :id (str file-id')
-           :prev-id (str file-id)
-           :features (str/join "," (:features file))
-           :version (:version file)
-           ::l/sync? true)
-
-    (events/tap :progress {:section :file :name file-name})
-
-    (when media
-      ;; Update index with media
-      (l/dbg :hint "update media index"
-             :file-id (str file-id')
-             :total (count media)
-             ::l/sync? true)
-
-      (vswap! bfc/*state* update :index bfc/update-index (map :id media))
-      (vswap! bfc/*state* update :media into media))
-
-    (when thumbnails
-      (l/dbg :hint "update thumbnails index"
-             :file-id (str file-id')
-             :total (count thumbnails)
-             ::l/sync? true)
-
-      (vswap! bfc/*state* update :index bfc/update-index (map :media-id thumbnails))
-      (vswap! bfc/*state* update :thumbnails into thumbnails))
-
-    (let [data (-> (read-file-data cfg)
-                   (d/without-nils)
-                   (assoc :id file-id')
-                   (cond-> (:options file)
-                     (assoc :options (:options file))))
-
-          file (-> file
-                   (assoc :id file-id')
-                   (assoc :data data)
-                   (assoc :name file-name)
-                   (assoc :project-id project-id)
-                   (dissoc :options)
-                   (bfc/process-file))]
-
-      (->> file
-           (bfc/register-pending-migrations cfg)
-           (bfc/persist-file! cfg))
-
-      (when (::bfc/overwrite cfg)
-        (db/delete! conn :file-thumbnail {:file-id file-id'}))
-
-      file-id')))
-
-(defn- import-file-relations
-  [{:keys [::db/conn ::manifest ::bfc/timestamp] :as cfg}]
-  (events/tap :progress {:section :relations})
-  (doseq [[file-id libr-id] (:relations manifest)]
-
-    (let [file-id (bfc/lookup-index file-id)
-          libr-id (bfc/lookup-index libr-id)]
-
-      (when (and file-id libr-id)
-        (l/dbg :hint "create file library link"
-               :file-id (str file-id)
-               :lib-id (str libr-id)
-               ::l/sync? true)
-        (db/insert! conn :file-library-rel
-                    {:synced-at timestamp
-                     :file-id file-id
-                     :library-file-id libr-id})))))
-
-(defn- import-storage-objects
-  [{:keys [::input ::entries ::bfc/timestamp] :as cfg}]
-  (events/tap :progress {:section :storage-objects})
-
-  (let [storage (sto/resolve cfg)
-        entries (keep (match-storage-entry-fn) entries)]
-
-    (doseq [{:keys [id entry]} entries]
-      (let [object (->> (read-entry input entry)
-                        (decode-storage-object)
-                        (validate-storage-object))]
-
-        (when (not= id (:id object))
-          (ex/raise :type :validation
-                    :code :inconsistent-penpot-file
-                    :hint "the penpot file seems corrupt, found unexpected uuid (storage-object-id)"
-                    :expected-id (str id)
-                    :found-id (str (:id object))))
-
-        (let [ext     (resolve-extension (:content-type object))
-              path    (str "objects/" id ext)
-              content (->> path
-                           (get-zip-entry input)
-                           (zip-entry-storage-content input))]
-
-          (when (not= (:size object) (sto/get-size content))
-            (ex/raise :type :validation
-                      :code :inconsistent-penpot-file
-                      :hint "found corrupted storage object: size does not match"
-                      :path path
-                      :expected-size (:size object)
-                      :found-size (sto/get-size content)))
-
-          (when (not= (:hash object) (sto/get-hash content))
-            (ex/raise :type :validation
-                      :code :inconsistent-penpot-file
-                      :hint "found corrupted storage object: hash does not match"
-                      :path path
-                      :expected-hash (:hash object)
-                      :found-hash (sto/get-hash content)))
-
-          (let [params  (-> object
-                            (dissoc :id :size)
-                            (assoc ::sto/content content)
-                            (assoc ::sto/deduplicate? true)
-                            (assoc ::sto/touched-at timestamp))
-                sobject (sto/put-object! storage params)]
-
-            (l/dbg :hint "persisted storage object"
-                   :id (str (:id sobject))
-                   :prev-id (str id)
-                   :bucket (:bucket params)
-                   ::l/sync? true)
-
-            (vswap! bfc/*state* update :index assoc id (:id sobject))))))))
-
-(defn- import-file-media
-  [{:keys [::db/conn] :as cfg}]
-  (events/tap :progress {:section :media})
-
-  (doseq [item (:media @bfc/*state*)]
-    (let [params (-> item
-                     (update :id bfc/lookup-index)
-                     (update :file-id bfc/lookup-index)
-                     (d/update-when :media-id bfc/lookup-index)
-                     (d/update-when :thumbnail-id bfc/lookup-index))]
-
-      (l/dbg :hint "inserting file media object"
-             :id (str (:id params))
-             :file-id (str (:file-id params))
-             ::l/sync? true)
-
-      (db/insert! conn :file-media-object params
-                  {::db/on-conflict-do-nothing? (::bfc/overwrite cfg)}))))
-
-(defn- import-file-thumbnails
-  [{:keys [::db/conn] :as cfg}]
-  (events/tap :progress {:section :thumbnails})
-  (doseq [item (:thumbnails @bfc/*state*)]
-    (let [file-id   (bfc/lookup-index (:file-id item))
-          media-id  (bfc/lookup-index (:media-id item))
-          object-id (-> (assoc item :file-id file-id)
-                        (cth/fmt-object-id))
-          params    {:file-id file-id
-                     :object-id object-id
-                     :tag (:tag item)
-                     :media-id media-id}]
-
-      (l/dbg :hint "inserting file object thumbnail"
-             :file-id (str file-id)
-             :media-id (str media-id)
-             ::l/sync? true)
-
-      (db/insert! conn :file-tagged-object-thumbnail params
-                  {::db/on-conflict-do-nothing? (::bfc/overwrite cfg)}))))
-
-(defn- import-files
-  [{:keys [::bfc/timestamp ::input ::name] :or {timestamp (dt/now)} :as cfg}]
-
-  (dm/assert!
-   "expected zip file"
-   (instance? ZipFile input))
-
-  (dm/assert!
-   "expected valid instant"
-   (dt/instant? timestamp))
-
-  (let [manifest (-> (read-manifest input)
-                     (validate-manifest))
-        entries  (read-zip-entries input)]
-
-    (when-not (= "penpot/export-files" (:type manifest))
-      (ex/raise :type :validation
-                :code :invalid-binfile-v3-manifest
-                :hint "unexpected type on manifest"
-                :manifest manifest))
-
-    ;; Check if all files referenced on manifest are present
-    (doseq [{file-id :id} (:files manifest)]
-      (let [path (str "files/" file-id ".json")]
-        (when-not (get-zip-entry input path)
-          (ex/raise :type :validation
-                    :code :invalid-binfile-v3
-                    :hint "some files referenced on manifest not found"
-                    :path path
-                    :file-id file-id))))
-
-    (events/tap :progress {:section :manifest})
-
-    (let [index (bfc/update-index (map :id (:files manifest)))
-          state {:media [] :index index}
-          cfg   (-> cfg
-                    (assoc ::entries entries)
-                    (assoc ::manifest manifest)
-                    (assoc ::bfc/timestamp timestamp))]
-
-      (binding [bfc/*state* (volatile! state)]
-        (db/tx-run! cfg (fn [cfg]
-                          (bfc/disable-database-timeouts! cfg)
-                          (let [ids (->> (:files manifest)
-                                         (reduce (fn [result {:keys [id] :as file}]
-                                                   (let [name' (get file :name)
-                                                         name' (if (map? name)
-                                                                 (get name id)
-                                                                 name')]
-                                                     (conj result (-> cfg
-                                                                      (assoc ::file-id id)
-                                                                      (assoc ::file-name name')
-                                                                      (import-file)))))
-                                                 []))]
-                            (import-file-relations cfg)
-                            (import-storage-objects cfg)
-                            (import-file-media cfg)
-                            (import-file-thumbnails cfg)
-
-                            (bfc/apply-pending-migrations! cfg)
-
-                            ids)))))))
-
-;; --- PUBLIC API
-
-(defn export-files!
-  "Do the exportation of a specified file in custom penpot binary
-  format. There are some options available for customize the output:
-
-  `::include-libraries`: additionally to the specified file, all the
-  linked libraries also will be included (including transitive
-  dependencies).
-
-  `::embed-assets`: instead of including the libraries, embed in the
-  same file library all assets used from external libraries."
-
-  [{:keys [::ids] :as cfg} output]
-
-  (dm/assert!
-   "expected a set of uuid's for `::ids` parameter"
-   (and (set? ids)
-        (every? uuid? ids)))
-
-  (dm/assert!
-   "expected instance of jio/IOFactory for `input`"
-   (satisfies? jio/IOFactory output))
-
-  (let [id (uuid/next)
-        tp (dt/tpoint)
-        ab (volatile! false)
-        cs (volatile! nil)]
-    (try
-      (l/info :hint "start exportation" :export-id (str id))
-      (binding [bfc/*state* (volatile! (bfc/initial-state))]
-        (with-open [output (io/output-stream output)]
-          (with-open [output (ZipOutputStream. output)]
-            (let [cfg (assoc cfg ::output output)]
-              (export-files cfg)
-              (export-storage-objects cfg)))))
-
-      (catch java.util.zip.ZipException cause
-        (vreset! cs cause)
-        (vreset! ab true)
-        (throw cause))
-
-      (catch java.io.IOException _cause
-        ;; Do nothing, EOF means client closes connection abruptly
-        (vreset! ab true)
-        nil)
-
-      (catch Throwable cause
-        (vreset! cs cause)
-        (vreset! ab true)
-        (throw cause))
-
-      (finally
-        (l/info :hint "exportation finished" :export-id (str id)
-                :elapsed (str (inst-ms (tp)) "ms")
-                :aborted @ab
-                :cause @cs)))))
-
-
-(defn import-files!
-  [{:keys [::input] :as cfg}]
-
-  (dm/assert!
-   "expected valid profile-id and project-id on `cfg`"
-   (and (uuid? (::profile-id cfg))
-        (uuid? (::project-id cfg))))
-
-  (dm/assert!
-   "expected instance of jio/IOFactory for `input`"
-   (io/coercible? input))
-
-  (let [id (uuid/next)
-        tp (dt/tpoint)
-        cs (volatile! nil)]
-
-    (l/info :hint "import: started" :id (str id))
-    (try
-      (with-open [input (ZipFile. (fs/file input))]
-        (import-files (assoc cfg ::input input)))
-
-      (catch Throwable cause
-        (vreset! cs cause)
-        (throw cause))
-
-      (finally
-        (l/info :hint "import: terminated"
-                :id (str id)
-                :elapsed (dt/format-duration (tp))
-                :error? (some? @cs))))))

backend/src/app/config.clj

@@ -26,11 +26,11 @@
   [_ data]
   (d/without-nils data))
 
-(defmethod ig/expand-key :default
-  [k v]
-  {k (if (map? v)
-       (d/without-nils v)
-       v)})
+(defmethod ig/prep-key :default
+  [_ data]
+  (if (map? data)
+    (d/without-nils data)
+    data))
 
 (def default
   {:database-uri "postgresql://postgres/penpot"
@@ -42,6 +42,7 @@
    :rpc-rlimit-config "resources/rlimit.edn"
    :rpc-climit-config "resources/climit.edn"
 
+   :auto-file-snapshot-total 10
    :auto-file-snapshot-every 5
    :auto-file-snapshot-timeout "3h"
 
@@ -100,6 +101,7 @@
     [:telemetry-uri {:optional true} :string]
     [:telemetry-with-taiga {:optional true} ::sm/boolean] ;; DELETE
 
+    [:auto-file-snapshot-total {:optional true} ::sm/int]
     [:auto-file-snapshot-every {:optional true} ::sm/int]
     [:auto-file-snapshot-timeout {:optional true} ::dt/duration]
 
@@ -124,7 +126,7 @@
     [:worker-webhook-parallelism {:optional true} ::sm/int]
 
     [:database-password {:optional true} [:maybe :string]]
-    [:database-uri {:optional true} ::sm/uri]
+    [:database-uri {:optional true} :string]
     [:database-username {:optional true} [:maybe :string]]
     [:database-readonly {:optional true} ::sm/boolean]
     [:database-min-pool-size {:optional true} ::sm/int]
@@ -140,10 +142,6 @@
     [:quotes-font-variants-per-team {:optional true} ::sm/int]
     [:quotes-comment-threads-per-file {:optional true} ::sm/int]
     [:quotes-comments-per-file {:optional true} ::sm/int]
-    [:quotes-snapshots-per-file {:optional true} ::sm/int]
-    [:quotes-snapshots-per-team {:optional true} ::sm/int]
-    [:quotes-team-access-requests-per-team {:optional true} ::sm/int]
-    [:quotes-team-access-requests-per-requester {:optional true} ::sm/int]
 
     [:auth-data-cookie-domain {:optional true} :string]
     [:auth-token-cookie-name {:optional true} :string]
@@ -190,7 +188,7 @@
     [:profile-complaint-max-age {:optional true} ::dt/duration]
     [:profile-complaint-threshold {:optional true} ::sm/int]
 
-    [:redis-uri {:optional true} ::sm/uri]
+    [:redis-uri {:optional true} :string]
 
     [:email-domain-blacklist {:optional true} ::fs/path]
     [:email-domain-whitelist {:optional true} ::fs/path]
@@ -218,14 +216,14 @@
     [: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} ::sm/uri]
+    [:storage-assets-s3-endpoint {:optional true} :string]
     [:storage-assets-s3-io-threads {:optional true} ::sm/int]
 
     [:objects-storage-backend {:optional true} :keyword]
     [:objects-storage-fs-directory {:optional true} :string]
     [:objects-storage-s3-bucket {:optional true} :string]
     [:objects-storage-s3-region {:optional true} :keyword]
-    [:objects-storage-s3-endpoint {:optional true} ::sm/uri]
+    [:objects-storage-s3-endpoint {:optional true} :string]
     [:objects-storage-s3-io-threads {:optional true} ::sm/int]]))
 
 (def default-flags

backend/src/app/db.clj

@@ -11,7 +11,7 @@
    [app.common.exceptions :as ex]
    [app.common.geom.point :as gpt]
    [app.common.logging :as l]
-   [app.common.schema :as sm]
+   [app.common.spec :as us]
    [app.common.transit :as t]
    [app.common.uuid :as uuid]
    [app.db.sql :as sql]
@@ -20,6 +20,7 @@
    [app.util.time :as dt]
    [clojure.java.io :as io]
    [clojure.set :as set]
+   [clojure.spec.alpha :as s]
    [integrant.core :as ig]
    [next.jdbc :as jdbc]
    [next.jdbc.date-time :as jdbc-dt])
@@ -48,17 +49,27 @@
 ;; Initialization
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(def ^:private schema:pool-options
-  [:map {:title "pool-options"}
-   [::connect-timeout {:optional true} ::sm/int]
-   [::max-size {:optional true} ::sm/int]
-   [::min-size {:optional true} ::sm/int]
-   [::name {:optional true} :keyword]
-   [::uri {:optional true} ::sm/uri]
-   [::password {:optional true} :string]
-   [::username {:optional true} :string]
-   [::validation-timeout {:optional true} ::sm/int]
-   [::read-only {:optional true} ::sm/boolean]])
+(s/def ::connection-timeout ::us/integer)
+(s/def ::max-size ::us/integer)
+(s/def ::min-size ::us/integer)
+(s/def ::name keyword?)
+(s/def ::password ::us/string)
+(s/def ::uri ::us/not-empty-string)
+(s/def ::username ::us/string)
+(s/def ::validation-timeout ::us/integer)
+(s/def ::read-only? ::us/boolean)
+
+(s/def ::pool-options
+  (s/keys :opt [::uri
+                ::name
+                ::min-size
+                ::max-size
+                ::connection-timeout
+                ::validation-timeout
+                ::username
+                ::password
+                ::mtx/metrics
+                ::read-only?]))
 
 (def defaults
   {::name :main
@@ -68,26 +79,27 @@
    ::validation-timeout 10000
    ::idle-timeout 120000 ; 2min
    ::max-lifetime 1800000 ; 30m
-   ::read-only false})
+   ::read-only? false})
 
-(defmethod ig/assert-key ::pool
-  [_ options]
-  (assert (sm/check schema:pool-options options)))
+(defmethod ig/prep-key ::pool
+  [_ cfg]
+  (merge defaults (d/without-nils cfg)))
+
+;; Don't validate here, just validate that a map is received.
+(defmethod ig/pre-init-spec ::pool [_] ::pool-options)
 
 (defmethod ig/init-key ::pool
-  [_ cfg]
-  (let [{:keys [::uri ::read-only] :as cfg}
-        (merge defaults cfg)]
-    (when uri
-      (l/info :hint "initialize connection pool"
-              :name (d/name (::name cfg))
-              :uri (str uri)
-              :read-only read-only
-              :credentials (and (contains? cfg ::username)
-                                (contains? cfg ::password))
-              :min-size (::min-size cfg)
-              :max-size (::max-size cfg))
-      (create-pool cfg))))
+  [_ {:keys [::uri ::read-only?] :as cfg}]
+  (when uri
+    (l/info :hint "initialize connection pool"
+            :name (d/name (::name cfg))
+            :uri uri
+            :read-only read-only?
+            :with-credentials (and (contains? cfg ::username)
+                                   (contains? cfg ::password))
+            :min-size (::min-size cfg)
+            :max-size (::max-size cfg))
+    (create-pool cfg)))
 
 (defmethod ig/halt-key! ::pool
   [_ pool]
@@ -103,15 +115,13 @@
        "SET idle_in_transaction_session_timeout = 300000;"))
 
 (defn- create-datasource-config
-  [{:keys [::uri] :as cfg}]
-
-  ;; (app.common.pprint/pprint cfg)
+  [{:keys [::mtx/metrics ::uri] :as cfg}]
   (let [config (HikariConfig.)]
     (doto config
       (.setJdbcUrl           (str "jdbc:" uri))
       (.setPoolName          (d/name (::name cfg)))
       (.setAutoCommit true)
-      (.setReadOnly          (::read-only cfg))
+      (.setReadOnly          (::read-only? cfg))
       (.setConnectionTimeout (::connection-timeout cfg))
       (.setValidationTimeout (::validation-timeout cfg))
       (.setIdleTimeout       (::idle-timeout cfg))
@@ -122,8 +132,8 @@
       (.setInitializationFailTimeout -1))
 
     ;; When metrics namespace is provided
-    (when-let [instance (::mtx/metrics cfg)]
-      (->> (mtx/get-registry instance)
+    (when metrics
+      (->> (::mtx/registry metrics)
            (PrometheusMetricsTrackerFactory.)
            (.setMetricsTrackerFactory config)))
 
@@ -140,22 +150,10 @@
   [conn]
   (instance? Connection conn))
 
-(defn connectable?
-  [o]
-  (or (connection? o)
-      (pool? o)))
-
-(sm/register!
- {:type ::conn
-  :pred connection?})
-
-(sm/register!
- {:type ::connectable
-  :pred connectable?})
-
-(sm/register!
- {:type ::pool
-  :pred pool?})
+(s/def ::conn some?)
+(s/def ::nilable-pool (s/nilable ::pool))
+(s/def ::pool pool?)
+(s/def ::connectable some?)
 
 (defn closed?
   [pool]

backend/src/app/email.clj

@@ -12,12 +12,18 @@
    [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]
    [app.db.sql :as sql]
+   [app.email.invite-to-team :as-alias email.invite-to-team]
+   [app.email.join-team :as-alias email.join-team]
+   [app.email.request-team-access :as-alias email.request-team-access]
+   [app.metrics :as mtx]
    [app.util.template :as tmpl]
    [app.worker :as wrk]
    [clojure.java.io :as io]
+   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig])
   (:import
@@ -217,45 +223,50 @@
               [{:type "text/html"
                 :content html}]))}))
 
-(def ^:private schema:context
-  [:map
-   [:to [:or ::sm/email [::sm/vec ::sm/email]]]
-   [:reply-to {:optional true} ::sm/email]
-   [:from {:optional true} ::sm/email]
-   [:lang {:optional true} ::sm/text]
-   [:priority {:optional true} [:enum :high :low]]
-   [:extra-data {:optional true} ::sm/text]])
+(s/def ::priority #{:high :low})
+(s/def ::to (s/or :single ::us/email
+                  :multi (s/coll-of ::us/email)))
+(s/def ::from ::us/email)
+(s/def ::reply-to ::us/email)
+(s/def ::lang string?)
+(s/def ::extra-data ::us/string)
 
-(def ^:private check-context
-  (sm/check-fn schema:context))
+(s/def ::context
+  (s/keys :req-un [::to]
+          :opt-un [::reply-to ::from ::lang ::priority ::extra-data]))
 
 (defn template-factory
-  [& {:keys [id schema]}]
-  (assert (keyword? id) "id should be provided and it should be a keyword")
-  (let [check-fn (if schema
-                   (sm/check-fn schema)
-                   (constantly nil))]
-    (fn [context]
-      (let [context (-> context check-context check-fn)
-            email   (build-email-template id context)]
-        (when-not email
-          (ex/raise :type :internal
-                    :code :email-template-does-not-exists
-                    :hint "seems like the template is wrong or does not exists."
-                    :template-id id))
+  ([id] (template-factory id {}))
+  ([id extra-context]
+   (s/assert keyword? id)
+   (fn [context]
+     (us/verify ::context context)
+     (when-let [spec (s/get-spec id)]
+       (s/assert spec context))
 
-        (cond-> (assoc email :id (name id))
-          (:extra-data context)
-          (assoc :extra-data (:extra-data context))
+     (let [context (merge (if (fn? extra-context)
+                            (extra-context)
+                            extra-context)
+                          context)
+           email   (build-email-template id context)]
+       (when-not email
+         (ex/raise :type :internal
+                   :code :email-template-does-not-exists
+                   :hint "seems like the template is wrong or does not exists."
+                   :context {:id id}))
+       (cond-> (assoc email :id (name id))
+         (:extra-data context)
+         (assoc :extra-data (:extra-data context))
 
-          (:from context)
-          (assoc :from (:from context))
+         (:from context)
+         (assoc :from (:from context))
 
-          (:reply-to context)
-          (assoc :reply-to (:reply-to context))
+         (:reply-to context)
+         (assoc :reply-to (:reply-to context))
+
+         (:to context)
+         (assoc :to (:to context)))))))
 
-          (:to context)
-          (assoc :to (:to context)))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; PUBLIC HIGH-LEVEL API
@@ -269,8 +280,7 @@
   "Schedule an already defined email to be sent using asynchronously
   using worker task."
   [{:keys [::conn ::factory] :as context}]
-  (assert (db/connectable? conn) "expected a valid database connection or pool")
-
+  (us/verify some? conn)
   (let [email (if factory
                 (factory context)
                 (dissoc context ::conn))]
@@ -287,6 +297,8 @@
 
 (declare send-to-logger!)
 
+(s/def ::sendmail fn?)
+
 (defmethod ig/init-key ::sendmail
   [_ cfg]
   (fn [params]
@@ -303,18 +315,19 @@
             (l/dbg :hint "sendmail"
                    :id (:id params)
                    :to (:to params)
-                   :subject (str/trim (:subject params)))
+                   :subject (str/trim (:subject params))
+                   :body (str/join "," (map :type (:body params))))
 
             (.sendMessage ^Transport transport
                           ^MimeMessage message
                           (.getAllRecipients message))))))
 
-    (when (contains? cf/flags :log-emails)
+    (when (or (contains? cf/flags :log-emails)
+              (not (contains? cf/flags :smtp)))
       (send-to-logger! cfg params))))
 
-(defmethod ig/assert-key ::handler
-  [_ params]
-  (assert (fn? (::sendmail params)) "expected valid sendmail handler"))
+(defmethod ig/pre-init-spec ::handler [_]
+  (s/keys :req [::sendmail ::mtx/metrics]))
 
 (defmethod ig/init-key ::handler
   [_ {:keys [::sendmail]}]
@@ -341,113 +354,125 @@
 ;; EMAIL FACTORIES
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(def ^:private schema:feedback
-  [:map
-   [:subject ::sm/text]
-   [:content ::sm/text]])
+(s/def ::subject ::us/string)
+(s/def ::content ::us/string)
 
-(def user-feedback
+(s/def ::feedback
+  (s/keys :req-un [::subject ::content]))
+
+(def feedback
   "A profile feedback email."
-  (template-factory
-   :id ::feedback
-   :schema schema:feedback))
+  (template-factory ::feedback))
 
-(def ^:private schema:register
-  [:map [:name ::sm/text]])
+(s/def ::name ::us/string)
+(s/def ::register
+  (s/keys :req-un [::name]))
 
 (def register
   "A new profile registration welcome email."
-  (template-factory
-   :id ::register
-   :schema schema:register))
+  (template-factory ::register))
 
-(def ^:private schema:password-recovery
-  [:map
-   [:name ::sm/text]
-   [:token ::sm/text]])
+(s/def ::token ::us/string)
+(s/def ::password-recovery
+  (s/keys :req-un [::name ::token]))
 
 (def password-recovery
   "A password recovery notification email."
-  (template-factory
-   :id ::password-recovery
-   :schema schema:password-recovery))
+  (template-factory ::password-recovery))
 
-(def ^:private schema:change-email
-  [:map
-   [:name ::sm/text]
-   [:pending-email ::sm/email]
-   [:token ::sm/text]])
+(s/def ::pending-email ::us/email)
+(s/def ::change-email
+  (s/keys :req-un [::name ::pending-email ::token]))
 
 (def change-email
   "Password change confirmation email"
-  (template-factory
-   :id ::change-email
-   :schema schema:change-email))
+  (template-factory ::change-email))
 
-(def ^:private schema:invite-to-team
-  [:map
-   [:invited-by ::sm/text]
-   [:team ::sm/text]
-   [:token ::sm/text]])
+(s/def ::email.invite-to-team/invited-by ::us/string)
+(s/def ::email.invite-to-team/team ::us/string)
+(s/def ::email.invite-to-team/token ::us/string)
+
+(s/def ::invite-to-team
+  (s/keys :req-un [::email.invite-to-team/invited-by
+                   ::email.invite-to-team/token
+                   ::email.invite-to-team/team]))
 
 (def invite-to-team
   "Teams member invitation email."
-  (template-factory
-   :id ::invite-to-team
-   :schema schema:invite-to-team))
+  (template-factory ::invite-to-team))
 
-(def ^:private schema:join-team
-  [:map
-   [:invited-by ::sm/text]
-   [:team ::sm/text]
-   [:team-id ::sm/uuid]])
+
+(s/def ::email.join-team/invited-by ::us/string)
+(s/def ::email.join-team/team ::us/string)
+(s/def ::email.join-team/team-id ::us/uuid)
+
+(s/def ::join-team
+  (s/keys :req-un [::email.join-team/invited-by
+                   ::email.join-team/team-id
+                   ::email.join-team/team]))
 
 (def join-team
   "Teams member joined after request email."
-  (template-factory
-   :id ::join-team
-   :schema schema:join-team))
+  (template-factory ::join-team))
 
-(def ^:private schema:request-file-access
-  [:map
-   [:requested-by ::sm/text]
-   [:requested-by-email ::sm/text]
-   [:team-name ::sm/text]
-   [:team-id ::sm/uuid]
-   [:file-name ::sm/text]
-   [:file-id ::sm/uuid]
-   [:page-id ::sm/uuid]])
+(s/def ::email.request-team-access/requested-by ::us/string)
+(s/def ::email.request-team-access/requested-by-email ::us/string)
+(s/def ::email.request-team-access/team-name ::us/string)
+(s/def ::email.request-team-access/team-id ::us/uuid)
+(s/def ::email.request-team-access/file-name ::us/string)
+(s/def ::email.request-team-access/file-id ::us/uuid)
+(s/def ::email.request-team-access/page-id ::us/uuid)
+
+(s/def ::request-file-access
+  (s/keys :req-un [::email.request-team-access/requested-by
+                   ::email.request-team-access/requested-by-email
+                   ::email.request-team-access/team-name
+                   ::email.request-team-access/team-id
+                   ::email.request-team-access/file-name
+                   ::email.request-team-access/file-id
+                   ::email.request-team-access/page-id]))
 
 (def request-file-access
   "File access request email."
-  (template-factory
-   :id ::request-file-access
-   :schema schema:request-file-access))
+  (template-factory ::request-file-access))
+
+
+(s/def ::request-file-access-yourpenpot
+  (s/keys :req-un [::email.request-team-access/requested-by
+                   ::email.request-team-access/requested-by-email
+                   ::email.request-team-access/team-name
+                   ::email.request-team-access/team-id
+                   ::email.request-team-access/file-name
+                   ::email.request-team-access/file-id
+                   ::email.request-team-access/page-id]))
 
 (def request-file-access-yourpenpot
   "File access on Your Penpot request email."
-  (template-factory
-   :id ::request-file-access-yourpenpot
-   :schema schema:request-file-access))
+  (template-factory ::request-file-access-yourpenpot))
+
+(s/def ::request-file-access-yourpenpot-view
+  (s/keys :req-un [::email.request-team-access/requested-by
+                   ::email.request-team-access/requested-by-email
+                   ::email.request-team-access/team-name
+                   ::email.request-team-access/team-id
+                   ::email.request-team-access/file-name
+                   ::email.request-team-access/file-id
+                   ::email.request-team-access/page-id]))
 
 (def request-file-access-yourpenpot-view
   "File access on Your Penpot view mode request email."
-  (template-factory
-   :id ::request-file-access-yourpenpot-view
-   :schema schema:request-file-access))
+  (template-factory ::request-file-access-yourpenpot-view))
 
-(def ^:private schema:request-team-access
-  [:map
-   [:requested-by ::sm/text]
-   [:requested-by-email ::sm/text]
-   [:team-name ::sm/text]
-   [:team-id ::sm/uuid]])
+(s/def ::request-team-access
+  (s/keys :req-un [::email.request-team-access/requested-by
+                   ::email.request-team-access/requested-by-email
+                   ::email.request-team-access/team-name
+                   ::email.request-team-access/team-id]))
 
 (def request-team-access
   "Team access request email."
-  (template-factory
-   :id ::request-team-access
-   :schema schema:request-team-access))
+  (template-factory ::request-team-access))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; BOUNCE/COMPLAINS HELPERS

backend/src/app/features/components_v2.clj

@@ -41,7 +41,6 @@
    [app.common.types.shape.path :as ctsp]
    [app.common.types.shape.text :as ctsx]
    [app.common.uuid :as uuid]
-   [app.config :as cf]
    [app.db :as db]
    [app.db.sql :as sql]
    [app.features.fdata :as fdata]
@@ -1299,7 +1298,7 @@
                            (let [[mtype data] (parse-datauri href)
                                  size         (alength ^bytes data)
                                  path         (tmp/tempfile :prefix "penpot.media.download.")
-                                 written      (io/write* path data :size size)]
+                                 written      (io/write-to-file! data path :size size)]
 
                              (when (not= written size)
                                (ex/raise :type :internal
@@ -1382,9 +1381,7 @@
 (defn get-optimized-svg
   [sid]
   (let [svg-text (get-sobject-content sid)
-        svg-text (if (contains? cf/flags :backend-svgo)
-                   (svgo/optimize *system* svg-text)
-                   svg-text)]
+        svg-text (svgo/optimize *system* svg-text)]
     (csvg/parse svg-text)))
 
 (def base-path "/data/cache")
@@ -1487,6 +1484,11 @@
                              :file-id (str (:id fdata))
                              :id (str (:id mobj)))
 
+                      (instance? org.graalvm.polyglot.PolyglotException cause)
+                      (l/inf :hint "skip processing media object: invalid svg found"
+                             :file-id (str (:id fdata))
+                             :id (str (:id mobj)))
+
                       (= (:type edata) :not-found)
                       (l/inf :hint "skip processing media object: underlying object does not exist"
                              :file-id (str (:id fdata))
@@ -1745,8 +1747,8 @@
                     (fn [system]
                       (binding [*system* system]
                         (when (string? label)
-                          (fsnap/create-file-snapshot! system nil file-id (str "migration/" label)))
-
+                          (fsnap/take-file-snapshot! system {:file-id file-id
+                                                             :label (str "migration/" label)}))
                         (let [file (get-file system file-id)
                               file (process-file! system file :validate? validate?)]
 

backend/src/app/http.clj

@@ -9,7 +9,6 @@
    [app.auth.oidc :as-alias oidc]
    [app.common.data :as d]
    [app.common.logging :as l]
-   [app.common.schema :as sm]
    [app.common.transit :as t]
    [app.db :as-alias db]
    [app.http.access-token :as actoken]
@@ -25,13 +24,14 @@
    [app.rpc :as-alias rpc]
    [app.rpc.doc :as-alias rpc.doc]
    [app.setup :as-alias setup]
+   [clojure.spec.alpha :as s]
    [integrant.core :as ig]
    [promesa.exec :as px]
    [reitit.core :as r]
    [reitit.middleware :as rr]
-   [yetti.adapter :as yt]
-   [yetti.request :as yreq]
-   [yetti.response :as-alias yres]))
+   [ring.request :as rreq]
+   [ring.response :as-alias rres]
+   [yetti.adapter :as yt]))
 
 (declare router-handler)
 
@@ -39,28 +39,31 @@
 ;; HTTP SERVER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(def default-params
-  {::port 6060
-   ::host "0.0.0.0"
-   ::max-body-size (* 1024 1024 30)             ; default 30 MiB
-   ::max-multipart-body-size (* 1024 1024 120)}) ; default 120 MiB
+(s/def ::handler fn?)
+(s/def ::router some?)
+(s/def ::port integer?)
+(s/def ::host string?)
+(s/def ::name string?)
 
-(defmethod ig/expand-key ::server
-  [k v]
-  {k (merge default-params (d/without-nils v))})
+(s/def ::max-body-size integer?)
+(s/def ::max-multipart-body-size integer?)
+(s/def ::io-threads integer?)
 
-(def ^:private schema:server-params
-  [:map
-   [::port ::sm/int]
-   [::host ::sm/text]
-   [::max-body-size {:optional true} ::sm/int]
-   [::max-multipart-body-size {:optional true} ::sm/int]
-   [::router {:optional true} [:fn r/router?]]
-   [::handler {:optional true} ::sm/fn]])
+(defmethod ig/prep-key ::server
+  [_ cfg]
+  (merge {::port 6060
+          ::host "0.0.0.0"
+          ::max-body-size (* 1024 1024 30)             ; default 30 MiB
+          ::max-multipart-body-size (* 1024 1024 120)} ; default 120 MiB
+         (d/without-nils cfg)))
 
-(defmethod ig/assert-key ::server
-  [_ params]
-  (assert (sm/check schema:server-params params)))
+(defmethod ig/pre-init-spec ::server [_]
+  (s/keys :req [::port ::host]
+          :opt [::max-body-size
+                ::max-multipart-body-size
+                ::router
+                ::handler
+                ::io-threads]))
 
 (defmethod ig/init-key ::server
   [_ {:keys [::handler ::router ::host ::port] :as cfg}]
@@ -97,12 +100,12 @@
 
 (defn- not-found-handler
   [_]
-  {::yres/status 404})
+  {::rres/status 404})
 
 (defn- router-handler
   [router]
   (letfn [(resolve-handler [request]
-            (if-let [match (r/match-by-path router (yreq/path request))]
+            (if-let [match (r/match-by-path router (rreq/path request))]
               (let [params  (:path-params match)
                     result  (:result match)
                     handler (or (:handler result) not-found-handler)
@@ -111,11 +114,11 @@
               (partial not-found-handler request)))
 
           (on-error [cause request]
-            (let [{:keys [::yres/body] :as response} (errors/handle cause request)]
+            (let [{:keys [::rres/body] :as response} (errors/handle cause request)]
               (cond-> response
                 (map? body)
-                (-> (update ::yres/headers assoc "content-type" "application/transit+json")
-                    (assoc ::yres/body (t/encode-str body {:type :json-verbose}))))))]
+                (-> (update ::rres/headers assoc "content-type" "application/transit+json")
+                    (assoc ::rres/body (t/encode-str body {:type :json-verbose}))))))]
 
     (fn [request]
       (let [handler (resolve-handler request)]
@@ -128,26 +131,18 @@
 ;; HTTP ROUTER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(def ^:private schema:routes
-  [:vector :any])
-
-(def ^:private schema:router-params
-  [:map
-   [::ws/routes schema:routes]
-   [::rpc/routes schema:routes]
-   [::rpc.doc/routes schema:routes]
-   [::oidc/routes schema:routes]
-   [::assets/routes schema:routes]
-   [::debug/routes schema:routes]
-   [::mtx/routes schema:routes]
-   [::awsns/routes schema:routes]
-   ::session/manager
-   ::setup/props
-   ::db/pool])
-
-(defmethod ig/assert-key ::router
-  [_ params]
-  (assert (sm/check schema:router-params params)))
+(defmethod ig/pre-init-spec ::router [_]
+  (s/keys :req [::session/manager
+                ::ws/routes
+                ::rpc/routes
+                ::rpc.doc/routes
+                ::oidc/routes
+                ::setup/props
+                ::assets/routes
+                ::debug/routes
+                ::db/pool
+                ::mtx/routes
+                ::awsns/routes]))
 
 (defmethod ig/init-key ::router
   [_ cfg]

backend/src/app/http/access_token.clj

@@ -12,13 +12,13 @@
    [app.main :as-alias main]
    [app.setup :as-alias setup]
    [app.tokens :as tokens]
-   [yetti.request :as yreq]))
+   [ring.request :as rreq]))
 
 (def header-re #"^Token\s+(.*)")
 
 (defn- get-token
   [request]
-  (some->> (yreq/get-header request "authorization")
+  (some->> (rreq/get-header request "authorization")
            (re-matches header-re)
            (second)))
 

backend/src/app/http/assets.clj

@@ -9,12 +9,14 @@
   (:require
    [app.common.data :as d]
    [app.common.exceptions :as ex]
+   [app.common.spec :as us]
    [app.common.uri :as u]
    [app.db :as db]
    [app.storage :as sto]
    [app.util.time :as dt]
+   [clojure.spec.alpha :as s]
    [integrant.core :as ig]
-   [yetti.response :as-alias yres]))
+   [ring.response :as-alias rres]))
 
 (def ^:private cache-max-age
   (dt/duration {:hours 24}))
@@ -35,8 +37,8 @@
 (defn- serve-object-from-s3
   [{:keys [::sto/storage] :as cfg} obj]
   (let [{:keys [host port] :as url} (sto/get-object-url storage obj {:max-age signature-max-age})]
-    {::yres/status  307
-     ::yres/headers {"location" (str url)
+    {::rres/status  307
+     ::rres/headers {"location" (str url)
                      "x-host"   (cond-> host port (str ":" port))
                      "x-mtype"  (-> obj meta :content-type)
                      "cache-control" (str "max-age=" (inst-ms cache-max-age))}}))
@@ -49,8 +51,8 @@
         headers {"x-accel-redirect" (:path purl)
                  "content-type" (:content-type mdata)
                  "cache-control" (str "max-age=" (inst-ms cache-max-age))}]
-    {::yres/status 204
-     ::yres/headers headers}))
+    {::rres/status 204
+     ::rres/headers headers}))
 
 (defn- serve-object
   "Helper function that returns the appropriate response depending on
@@ -67,7 +69,7 @@
         obj (sto/get-object storage id)]
     (if obj
       (serve-object cfg obj)
-      {::yres/status 404})))
+      {::rres/status 404})))
 
 (defn- generic-handler
   "A generic handler helper/common code for file-media based handlers."
@@ -78,7 +80,7 @@
         sobj (sto/get-object storage (kf mobj))]
     (if sobj
       (serve-object cfg sobj)
-      {::yres/status 404})))
+      {::rres/status 404})))
 
 (defn file-objects-handler
   "Handler that serves storage objects by file media id."
@@ -93,10 +95,11 @@
 
 ;; --- Initialization
 
-(defmethod ig/assert-key ::routes
-  [_ params]
-  (assert (sto/valid-storage? (::sto/storage params)) "expected valid storage instance")
-  (assert (string? (::path params))))
+(s/def ::path ::us/string)
+(s/def ::routes vector?)
+
+(defmethod ig/pre-init-spec ::routes [_]
+  (s/keys :req [::sto/storage  ::path]))
 
 (defmethod ig/init-key ::routes
   [_ cfg]

backend/src/app/http/awsns.clj

@@ -10,7 +10,6 @@
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [app.common.pprint :as pp]
-   [app.common.schema :as sm]
    [app.db :as db]
    [app.db.sql :as sql]
    [app.http.client :as http]
@@ -19,29 +18,29 @@
    [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]
    [promesa.exec :as px]
-   [yetti.request :as yreq]
-   [yetti.response :as-alias yres]))
+   [ring.request :as rreq]
+   [ring.response :as-alias rres]))
 
 (declare parse-json)
 (declare handle-request)
 (declare parse-notification)
 (declare process-report)
 
-(defmethod ig/assert-key ::routes
-  [_ params]
-  (assert (http/client? (::http/client params)) "expect a valid http client")
-  (assert (sm/valid? ::setup/props (::setup/props params)) "expected valid setup props")
-  (assert (db/pool? (::db/pool params)) "expect valid database pool"))
+(defmethod ig/pre-init-spec ::routes [_]
+  (s/keys :req [::http/client
+                ::setup/props
+                ::db/pool]))
 
 (defmethod ig/init-key ::routes
   [_ cfg]
   (letfn [(handler [request]
-            (let [data (-> request yreq/body slurp)]
+            (let [data (-> request rreq/body slurp)]
               (px/run! :vthread (partial handle-request cfg data)))
-            {::yres/status 200})]
+            {::rres/status 200})]
     ["/sns" {:handler handler
              :allowed-methods #{:post}}]))
 

backend/src/app/http/client.clj

@@ -7,20 +7,20 @@
 (ns app.http.client
   "Http client abstraction layer."
   (:require
-   [app.common.schema :as sm]
+   [app.common.spec :as us]
+   [clojure.spec.alpha :as s]
    [integrant.core :as ig]
    [java-http-clj.core :as http]
    [promesa.core :as p])
   (:import
    java.net.http.HttpClient))
 
-(defn client?
-  [o]
-  (instance? HttpClient o))
+(s/def ::client #(instance? HttpClient %))
+(s/def ::client-holder
+  (s/keys :req [::client]))
 
-(sm/register!
- {:type ::client
-  :pred client?})
+(defmethod ig/pre-init-spec ::client [_]
+  (s/keys :req []))
 
 (defmethod ig/init-key ::client
   [_ _]
@@ -30,7 +30,7 @@
 (defn send!
   ([client req] (send! client req {}))
   ([client req {:keys [response-type sync?] :or {response-type :string sync? false}}]
-   (assert (client? client) "expected valid http client")
+   (us/assert! ::client client)
    (if sync?
      (http/send req {:client client :as response-type})
      (try

backend/src/app/http/debug.clj

@@ -26,14 +26,15 @@
    [app.util.blob :as blob]
    [app.util.template :as tmpl]
    [app.util.time :as dt]
+   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [datoteka.io :as io]
    [emoji.core :as emj]
    [integrant.core :as ig]
    [markdown.core :as md]
    [markdown.transformers :as mdt]
-   [yetti.request :as yreq]
-   [yetti.response :as yres]))
+   [ring.request :as rreq]
+   [ring.response :as rres]))
 
 ;; (selmer.parser/cache-off!)
 
@@ -43,10 +44,10 @@
 
 (defn index-handler
   [_cfg _request]
-  {::yres/status  200
-   ::yres/headers {"content-type" "text/html"}
-   ::yres/body    (-> (io/resource "app/templates/debug.tmpl")
-                      (tmpl/render {:version (:full cf/version)}))})
+  {::rres/status  200
+   ::rres/headers {"content-type" "text/html"}
+   ::rres/body    (-> (io/resource "app/templates/debug.tmpl")
+                      (tmpl/render {}))})
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; FILE CHANGES
@@ -55,17 +56,17 @@
 (defn prepare-response
   [body]
   (let [headers {"content-type" "application/transit+json"}]
-    {::yres/status 200
-     ::yres/body body
-     ::yres/headers headers}))
+    {::rres/status 200
+     ::rres/body body
+     ::rres/headers headers}))
 
 (defn prepare-download-response
   [body filename]
   (let [headers {"content-disposition" (str "attachment; filename=" filename)
                  "content-type" "application/octet-stream"}]
-    {::yres/status 200
-     ::yres/body body
-     ::yres/headers headers}))
+    {::rres/status 200
+     ::rres/body body
+     ::rres/headers headers}))
 
 (def sql:retrieve-range-of-changes
   "select revn, changes from file_change where file_id=? and revn >= ? and revn <= ? order by revn")
@@ -107,8 +108,8 @@
                           (db/update! conn :file
                                       {:data data}
                                       {:id file-id})
-                          {::yres/status 201
-                           ::yres/body "OK CREATED"})))
+                          {::rres/status 201
+                           ::rres/body "OK CREATED"})))
 
         :else
         (prepare-response (blob/decode data))))))
@@ -122,7 +123,7 @@
   [{:keys [::db/pool]} {:keys [::session/profile-id params] :as request}]
   (let [profile    (profile/get-profile pool profile-id)
         project-id (:default-project-id profile)
-        data       (some-> params :file :path io/read*)]
+        data       (some-> params :file :path io/read-as-bytes)]
 
     (if (and data project-id)
       (let [fname     (str "Imported file *: " (dt/now))
@@ -137,8 +138,8 @@
                         {:data data
                          :deleted-at nil}
                         {:id file-id})
-            {::yres/status 200
-             ::yres/body "OK UPDATED"})
+            {::rres/status 200
+             ::rres/body "OK UPDATED"})
 
           (db/run! pool (fn [{:keys [::db/conn] :as cfg}]
                           (create-file cfg {:id file-id
@@ -148,15 +149,15 @@
                           (db/update! conn :file
                                       {:data data}
                                       {:id file-id})
-                          {::yres/status 201
-                           ::yres/body "OK CREATED"}))))
+                          {::rres/status 201
+                           ::rres/body "OK CREATED"}))))
 
-      {::yres/status 500
-       ::yres/body "ERROR"})))
+      {::rres/status 500
+       ::rres/body "ERROR"})))
 
 (defn file-data-handler
   [cfg request]
-  (case (yreq/method request)
+  (case (rreq/method request)
     :get (retrieve-file-data cfg request)
     :post (upload-file-data cfg request)
     (ex/raise :type :http
@@ -237,12 +238,12 @@
                      1 (render-template-v1 report)
                      2 (render-template-v2 report)
                      3 (render-template-v3 report))]
-        {::yres/status 200
-         ::yres/body result
-         ::yres/headers {"content-type" "text/html; charset=utf-8"
+        {::rres/status 200
+         ::rres/body result
+         ::rres/headers {"content-type" "text/html; charset=utf-8"
                          "x-robots-tag" "noindex"}})
-      {::yres/status 404
-       ::yres/body "not found"})))
+      {::rres/status 404
+       ::rres/body "not found"})))
 
 (def sql:error-reports
   "SELECT id, created_at,
@@ -255,10 +256,10 @@
   [{:keys [::db/pool]} _request]
   (let [items (->> (db/exec! pool [sql:error-reports])
                    (map #(update % :created-at dt/format-instant :rfc1123)))]
-    {::yres/status 200
-     ::yres/body (-> (io/resource "app/templates/error-list.tmpl")
+    {::rres/status 200
+     ::rres/body (-> (io/resource "app/templates/error-list.tmpl")
                      (tmpl/render {:items items}))
-     ::yres/headers {"content-type" "text/html; charset=utf-8"
+     ::rres/headers {"content-type" "text/html; charset=utf-8"
                      "x-robots-tag" "noindex"}}))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -294,16 +295,15 @@
               cfg        (assoc cfg
                                 ::bf.v1/overwrite false
                                 ::bf.v1/profile-id profile-id
-                                ::bf.v1/project-id project-id
-                                ::bf.v1/input path)]
-          (bf.v1/import-files! cfg)
-          {::yres/status  200
-           ::yres/headers {"content-type" "text/plain"}
-           ::yres/body    "OK CLONED"})
+                                ::bf.v1/project-id project-id)]
+          (bf.v1/import-files! cfg path)
+          {::rres/status  200
+           ::rres/headers {"content-type" "text/plain"}
+           ::rres/body    "OK CLONED"})
 
-        {::yres/status  200
-         ::yres/body    (io/input-stream path)
-         ::yres/headers {"content-type" "application/octet-stream"
+        {::rres/status  200
+         ::rres/body    (io/input-stream path)
+         ::rres/headers {"content-type" "application/octet-stream"
                          "content-disposition" (str "attachmen; filename=" (first file-ids) ".penpot")}}))))
 
 
@@ -329,12 +329,11 @@
                       ::bf.v1/overwrite overwrite?
                       ::bf.v1/migrate migrate?
                       ::bf.v1/profile-id profile-id
-                      ::bf.v1/project-id project-id
-                      ::bf.v1/input path)]
-      (bf.v1/import-files! cfg)
-      {::yres/status  200
-       ::yres/headers {"content-type" "text/plain"}
-       ::yres/body    "OK"})))
+                      ::bf.v1/project-id project-id)]
+      (bf.v1/import-files! cfg path)
+      {::rres/status  200
+       ::rres/headers {"content-type" "text/plain"}
+       ::rres/body    "OK"})))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; ACTIONS
@@ -364,34 +363,34 @@
                           (db/update! conn :profile {:is-blocked true} {:id (:id profile)})
                           (db/delete! conn :http-session {:profile-id (:id profile)})
 
-                          {::yres/status  200
-                           ::yres/headers {"content-type" "text/plain"}
-                           ::yres/body    (str/ffmt "PROFILE '%' BLOCKED" (:email profile))})
+                          {::rres/status  200
+                           ::rres/headers {"content-type" "text/plain"}
+                           ::rres/body    (str/ffmt "PROFILE '%' BLOCKED" (:email profile))})
 
                         (contains? params :unblock)
                         (do
                           (db/update! conn :profile {:is-blocked false} {:id (:id profile)})
-                          {::yres/status  200
-                           ::yres/headers {"content-type" "text/plain"}
-                           ::yres/body    (str/ffmt "PROFILE '%' UNBLOCKED" (:email profile))})
+                          {::rres/status  200
+                           ::rres/headers {"content-type" "text/plain"}
+                           ::rres/body    (str/ffmt "PROFILE '%' UNBLOCKED" (:email profile))})
 
                         (contains? params :resend)
                         (if (:is-blocked profile)
-                          {::yres/status  200
-                           ::yres/headers {"content-type" "text/plain"}
-                           ::yres/body    "PROFILE ALREADY BLOCKED"}
+                          {::rres/status  200
+                           ::rres/headers {"content-type" "text/plain"}
+                           ::rres/body    "PROFILE ALREADY BLOCKED"}
                           (do
                             (#'auth/send-email-verification! cfg profile)
-                            {::yres/status  200
-                             ::yres/headers {"content-type" "text/plain"}
-                             ::yres/body    (str/ffmt "RESENDED FOR '%'" (:email profile))}))
+                            {::rres/status  200
+                             ::rres/headers {"content-type" "text/plain"}
+                             ::rres/body    (str/ffmt "RESENDED FOR '%'" (:email profile))}))
 
                         :else
                         (do
                           (db/update! conn :profile {:is-active true} {:id (:id profile)})
-                          {::yres/status  200
-                           ::yres/headers {"content-type" "text/plain"}
-                           ::yres/body    (str/ffmt "PROFILE '%' ACTIVATED" (:email profile))}))))))
+                          {::rres/status  200
+                           ::rres/headers {"content-type" "text/plain"}
+                           ::rres/body    (str/ffmt "PROFILE '%' ACTIVATED" (:email profile))}))))))
 
 
 (defn- reset-file-version
@@ -416,9 +415,9 @@
 
     (db/tx-run! cfg srepl/process-file! file-id #(assoc % :version version))
 
-    {::yres/status  200
-     ::yres/headers {"content-type" "text/plain"}
-     ::yres/body    "OK"}))
+    {::rres/status  200
+     ::rres/headers {"content-type" "text/plain"}
+     ::rres/body    "OK"}))
 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -430,13 +429,13 @@
   [{:keys [::db/pool]} _]
   (try
     (db/exec-one! pool ["select count(*) as count from server_prop;"])
-    {::yres/status 200
-     ::yres/body "OK"}
+    {::rres/status 200
+     ::rres/body "OK"}
     (catch Throwable cause
       (l/warn :hint "unable to execute query on health handler"
               :cause cause)
-      {::yres/status 503
-       ::yres/body "KO"})))
+      {::rres/status 503
+       ::rres/body "KO"})))
 
 (defn changelog-handler
   [_ _]
@@ -445,11 +444,11 @@
           (md->html [text]
             (md/md-to-html-string text :replacement-transformers (into [transform-emoji] mdt/transformer-vector)))]
     (if-let [clog (io/resource "changelog.md")]
-      {::yres/status 200
-       ::yres/headers {"content-type" "text/html; charset=utf-8"}
-       ::yres/body (-> clog slurp md->html)}
-      {::yres/status 404
-       ::yres/body "NOT FOUND"})))
+      {::rres/status 200
+       ::rres/headers {"content-type" "text/html; charset=utf-8"}
+       ::rres/body (-> clog slurp md->html)}
+      {::rres/status 404
+       ::rres/body "NOT FOUND"})))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; INIT
@@ -472,10 +471,8 @@
            (ex/raise :type :authentication
                      :code :only-admins-allowed)))))})
 
-(defmethod ig/assert-key ::routes
-  [_ params]
-  (assert (db/pool? (::db/pool params)) "expected a valid database pool")
-  (assert (session/manager? (::session/manager params)) "expected a valid session manager"))
+(defmethod ig/pre-init-spec ::routes [_]
+  (s/keys :req [::db/pool ::session/manager]))
 
 (defmethod ig/init-key ::routes
   [_ {:keys [::db/pool] :as cfg}]

backend/src/app/http/errors.clj

@@ -16,8 +16,8 @@
    [app.http.session :as-alias session]
    [app.util.inet :as inet]
    [clojure.spec.alpha :as s]
-   [yetti.request :as yreq]
-   [yetti.response :as yres]))
+   [ring.request :as rreq]
+   [ring.response :as rres]))
 
 (defn request->context
   "Extracts error report relevant context data from request."
@@ -29,10 +29,10 @@
     {:request/path       (:path request)
      :request/method     (:method request)
      :request/params     (:params request)
-     :request/user-agent (yreq/get-header request "user-agent")
+     :request/user-agent (rreq/get-header request "user-agent")
      :request/ip-addr    (inet/parse-request request)
      :request/profile-id (:uid claims)
-     :version/frontend   (or (yreq/get-header request "x-frontend-version") "unknown")
+     :version/frontend   (or (rreq/get-header request "x-frontend-version") "unknown")
      :version/backend    (:full cf/version)}))
 
 
@@ -46,34 +46,34 @@
 
 (defmethod handle-error :authentication
   [err _ _]
-  {::yres/status 401
-   ::yres/body (ex-data err)})
+  {::rres/status 401
+   ::rres/body (ex-data err)})
 
 (defmethod handle-error :authorization
   [err _ _]
-  {::yres/status 403
-   ::yres/body (ex-data err)})
+  {::rres/status 403
+   ::rres/body (ex-data err)})
 
 (defmethod handle-error :restriction
   [err _ _]
   (let [{:keys [code] :as data} (ex-data err)]
     (if (= code :method-not-allowed)
-      {::yres/status 405
-       ::yres/body data}
-      {::yres/status 400
-       ::yres/body data})))
+      {::rres/status 405
+       ::rres/body data}
+      {::rres/status 400
+       ::rres/body data})))
 
 (defmethod handle-error :rate-limit
   [err _ _]
   (let [headers (-> err ex-data ::http/headers)]
-    {::yres/status 429
-     ::yres/headers headers}))
+    {::rres/status 429
+     ::rres/headers headers}))
 
 (defmethod handle-error :concurrency-limit
   [err _ _]
   (let [headers (-> err ex-data ::http/headers)]
-    {::yres/status 429
-     ::yres/headers headers}))
+    {::rres/status 429
+     ::rres/headers headers}))
 
 (defmethod handle-error :validation
   [err request parent-cause]
@@ -84,26 +84,22 @@
           (= code :schema-validation)
           (= code :data-validation))
       (let [explain (ex/explain data)]
-        {::yres/status 400
-         ::yres/body   (-> data
+        {::rres/status 400
+         ::rres/body   (-> data
                            (dissoc ::s/problems ::s/value ::s/spec ::sm/explain)
                            (cond-> explain (assoc :explain explain)))})
 
-      (= code :vern-conflict)
-      {::yres/status 409 ;; 409 - Conflict
-       ::yres/body data}
-
       (= code :request-body-too-large)
-      {::yres/status 413 ::yres/body data}
+      {::rres/status 413 ::rres/body data}
 
       (= code :invalid-image)
       (binding [l/*context* (request->context request)]
         (let [cause (or parent-cause err)]
           (l/warn :hint "unexpected error on processing image" :cause cause)
-          {::yres/status 400 ::yres/body data}))
+          {::rres/status 400 ::rres/body data}))
 
       :else
-      {::yres/status 400 ::yres/body data})))
+      {::rres/status 400 ::rres/body data})))
 
 (defmethod handle-error :assertion
   [error request parent-cause]
@@ -114,47 +110,46 @@
         (= code :data-validation)
         (let [explain (ex/explain data)]
           (l/error :hint "data assertion error" :cause cause)
-          {::yres/status 500
-           ::yres/body   (-> data
-                             (dissoc ::sm/explain)
-                             (cond-> explain (assoc :explain explain))
-                             (assoc :type :server-error)
-                             (assoc :code :assertion))})
+          {::rres/status 500
+           ::rres/body   {:type :server-error
+                          :code :assertion
+                          :data (-> data
+                                    (dissoc ::sm/explain)
+                                    (cond-> explain (assoc :explain explain)))}})
 
         (= code :spec-validation)
         (let [explain (ex/explain data)]
           (l/error :hint "spec assertion error" :cause cause)
-          {::yres/status 500
-           ::yres/body   (-> data
-                             (dissoc ::s/problems ::s/value ::s/spec)
-                             (cond-> explain (assoc :explain explain))
-                             (assoc :type :server-error)
-                             (assoc :code :assertion))})
+          {::rres/status 500
+           ::rres/body   {:type :server-error
+                          :code :assertion
+                          :data (-> data
+                                    (dissoc ::s/problems ::s/value ::s/spec)
+                                    (cond-> explain (assoc :explain explain)))}})
 
         :else
         (do
           (l/error :hint "assertion error" :cause cause)
-          {::yres/status 500
-           ::yres/body   (-> data
-                             (assoc :type :server-error)
-                             (assoc :code :assertion))})))))
+          {::rres/status 500
+           ::rres/body   {:type :server-error
+                          :code :assertion
+                          :data data}})))))
 
 (defmethod handle-error :not-found
   [err _ _]
-  {::yres/status 404
-   ::yres/body (ex-data err)})
+  {::rres/status 404
+   ::rres/body (ex-data err)})
 
 (defmethod handle-error :internal
   [error request parent-cause]
   (binding [l/*context* (request->context request)]
-    (let [cause (or parent-cause error)
-          data  (ex-data error)]
+    (let [cause (or parent-cause error)]
       (l/error :hint "internal error" :cause cause)
-      {::yres/status 500
-       ::yres/body (-> data
-                       (assoc :type :server-error)
-                       (update :code #(or % :unhandled))
-                       (assoc :hint (ex-message error)))})))
+      {::rres/status 500
+       ::rres/body {:type :server-error
+                    :code :unhandled
+                    :hint (ex-message error)
+                    :data (ex-data error)}})))
 
 (defmethod handle-error :default
   [error request parent-cause]
@@ -178,20 +173,20 @@
                :cause cause)
       (cond
         (= state "57014")
-        {::yres/status 504
-         ::yres/body {:type :server-error
+        {::rres/status 504
+         ::rres/body {:type :server-error
                       :code :statement-timeout
                       :hint (ex-message error)}}
 
         (= state "25P03")
-        {::yres/status 504
-         ::yres/body {:type :server-error
+        {::rres/status 504
+         ::rres/body {:type :server-error
                       :code :idle-in-transaction-timeout
                       :hint (ex-message error)}}
 
         :else
-        {::yres/status 500
-         ::yres/body {:type :server-error
+        {::rres/status 500
+         ::rres/body {:type :server-error
                       :code :unexpected
                       :hint (ex-message error)
                       :state state}}))))
@@ -205,25 +200,25 @@
       (nil? edata)
       (binding [l/*context* (request->context request)]
         (l/error :hint "unexpected error" :cause cause)
-        {::yres/status 500
-         ::yres/body {:type :server-error
+        {::rres/status 500
+         ::rres/body {:type :server-error
                       :code :unexpected
                       :hint (ex-message error)}})
 
       :else
       (binding [l/*context* (request->context request)]
         (l/error :hint "unhandled error" :cause cause)
-        {::yres/status 500
-         ::yres/body (-> edata
-                         (assoc :type :server-error)
-                         (update :code #(or % :unhandled))
-                         (assoc :hint (ex-message error)))}))))
+        {::rres/status 500
+         ::rres/body {:type :server-error
+                      :code :unhandled
+                      :hint (ex-message error)
+                      :data edata}}))))
 
 (defmethod handle-exception java.io.IOException
   [cause _ _]
   (l/wrn :hint "io exception" :cause cause)
-  {::yres/status 500
-   ::yres/body {:type :server-error
+  {::rres/status 500
+   ::rres/body {:type :server-error
                 :code :io-exception
                 :hint (ex-message cause)}})
 
@@ -249,4 +244,4 @@
 
 (defn handle'
   [cause request]
-  (::yres/body (handle cause request)))
+  (::rres/body (handle cause request)))

backend/src/app/http/middleware.clj

@@ -15,10 +15,10 @@
    [app.http.errors :as errors]
    [app.util.pointer-map :as pmap]
    [cuerdas.core :as str]
+   [ring.request :as rreq]
+   [ring.response :as rres]
    [yetti.adapter :as yt]
-   [yetti.middleware :as ymw]
-   [yetti.request :as yreq]
-   [yetti.response :as yres])
+   [yetti.middleware :as ymw])
   (:import
    io.undertow.server.RequestTooBigException
    java.io.InputStream
@@ -37,17 +37,17 @@
 (defn- get-reader
   ^java.io.BufferedReader
   [request]
-  (let [^InputStream body (yreq/body request)]
+  (let [^InputStream body (rreq/body request)]
     (java.io.BufferedReader.
      (java.io.InputStreamReader. body))))
 
 (defn wrap-parse-request
   [handler]
   (letfn [(process-request [request]
-            (let [header (yreq/get-header request "content-type")]
+            (let [header (rreq/get-header request "content-type")]
               (cond
                 (str/starts-with? header "application/transit+json")
-                (with-open [^InputStream is (yreq/body request)]
+                (with-open [^InputStream is (rreq/body request)]
                   (let [params (t/read! (t/reader is))]
                     (-> request
                         (assoc :body-params params)
@@ -85,7 +85,7 @@
               (errors/handle cause request)))]
 
     (fn [request]
-      (if (= (yreq/method request) :post)
+      (if (= (rreq/method request) :post)
         (try
           (-> request process-request handler)
           (catch Throwable cause
@@ -113,53 +113,57 @@
 
 (defn wrap-format-response
   [handler]
-  (letfn [(transit-streamable-body [data opts _ output-stream]
-            (try
-              (with-open [^OutputStream bos (buffered-output-stream output-stream buffer-size)]
-                (let [tw (t/writer bos opts)]
-                  (t/write! tw data)))
-              (catch java.io.IOException _)
-              (catch Throwable cause
-                (binding [l/*context* {:value data}]
-                  (l/error :hint "unexpected error on encoding response"
-                           :cause cause)))
-              (finally
-                (.close ^OutputStream output-stream))))
+  (letfn [(transit-streamable-body [data opts]
+            (reify rres/StreamableResponseBody
+              (-write-body-to-stream [_ _ output-stream]
+                (try
+                  (with-open [^OutputStream bos (buffered-output-stream output-stream buffer-size)]
+                    (let [tw (t/writer bos opts)]
+                      (t/write! tw data)))
+                  (catch java.io.IOException _)
+                  (catch Throwable cause
+                    (binding [l/*context* {:value data}]
+                      (l/error :hint "unexpected error on encoding response"
+                               :cause cause)))
+                  (finally
+                    (.close ^OutputStream output-stream))))))
 
-          (json-streamable-body [data _ output-stream]
-            (try
-              (let [encode (or (-> data meta :encode/json) identity)
-                    data   (encode data)]
-                (with-open [^OutputStream bos (buffered-output-stream output-stream buffer-size)]
-                  (with-open [^java.io.OutputStreamWriter writer (java.io.OutputStreamWriter. bos)]
-                    (json/write writer data :key-fn json/write-camel-key :value-fn write-json-value))))
-              (catch java.io.IOException _)
-              (catch Throwable cause
-                (binding [l/*context* {:value data}]
-                  (l/error :hint "unexpected error on encoding response"
-                           :cause cause)))
-              (finally
-                (.close ^OutputStream output-stream))))
+          (json-streamable-body [data]
+            (reify rres/StreamableResponseBody
+              (-write-body-to-stream [_ _ output-stream]
+                (try
+                  (let [encode (or (-> data meta :encode/json) identity)
+                        data   (encode data)]
+                    (with-open [^OutputStream bos (buffered-output-stream output-stream buffer-size)]
+                      (with-open [^java.io.OutputStreamWriter writer (java.io.OutputStreamWriter. bos)]
+                        (json/write writer data :key-fn json/write-camel-key :value-fn write-json-value))))
+                  (catch java.io.IOException _)
+                  (catch Throwable cause
+                    (binding [l/*context* {:value data}]
+                      (l/error :hint "unexpected error on encoding response"
+                               :cause cause)))
+                  (finally
+                    (.close ^OutputStream output-stream))))))
 
           (format-response-with-json [response _]
-            (let [body (::yres/body response)]
+            (let [body (::rres/body response)]
               (if (or (boolean? body) (coll? body))
                 (-> response
-                    (update ::yres/headers assoc "content-type" "application/json")
-                    (assoc ::yres/body (yres/stream-body (partial json-streamable-body body))))
+                    (update ::rres/headers assoc "content-type" "application/json")
+                    (assoc ::rres/body (json-streamable-body body)))
                 response)))
 
           (format-response-with-transit [response request]
-            (let [body (::yres/body response)]
+            (let [body (::rres/body response)]
               (if (or (boolean? body) (coll? body))
-                (let [qs   (yreq/query request)
+                (let [qs   (rreq/query request)
                       opts (if (or (contains? cf/flags :transit-readable-response)
                                    (str/includes? qs "transit_verbose"))
                              {:type :json-verbose}
                              {:type :json})]
                   (-> response
-                      (update ::yres/headers assoc "content-type" "application/transit+json")
-                      (assoc ::yres/body (yres/stream-body (partial transit-streamable-body body opts)))))
+                      (update ::rres/headers assoc "content-type" "application/transit+json")
+                      (assoc ::rres/body (transit-streamable-body body opts))))
                 response)))
 
           (format-from-params [{:keys [query-params] :as request}]
@@ -168,7 +172,7 @@
 
           (format-response [response request]
             (let [accept (or (format-from-params request)
-                             (yreq/get-header request "accept"))]
+                             (rreq/get-header request "accept"))]
               (cond
                 (or (= accept "application/transit+json")
                     (str/includes? accept "application/transit+json"))
@@ -217,11 +221,11 @@
 (defn wrap-cors
   [handler]
   (fn [request]
-    (let [response (if (= (yreq/method request) :options)
-                     {::yres/status 200}
+    (let [response (if (= (rreq/method request) :options)
+                     {::rres/status 200}
                      (handler request))
-          origin   (yreq/get-header request "origin")]
-      (update response ::yres/headers with-cors-headers origin))))
+          origin   (rreq/get-header request "origin")]
+      (update response ::rres/headers with-cors-headers origin))))
 
 (def cors
   {:name ::cors
@@ -236,7 +240,7 @@
      (when-let [allowed (:allowed-methods data)]
        (fn [handler]
          (fn [request]
-           (let [method (yreq/method request)]
+           (let [method (rreq/method request)]
              (if (contains? allowed method)
                (handler request)
-               {::yres/status 405}))))))})
+               {::rres/status 405}))))))})

backend/src/app/http/session.clj

@@ -9,7 +9,7 @@
   (:require
    [app.common.data :as d]
    [app.common.logging :as l]
-   [app.common.schema :as sm]
+   [app.common.spec :as us]
    [app.common.uri :as u]
    [app.config :as cf]
    [app.db :as db]
@@ -19,9 +19,11 @@
    [app.setup :as-alias setup]
    [app.tokens :as tokens]
    [app.util.time :as dt]
+   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig]
-   [yetti.request :as yreq]))
+   [ring.request :as rreq]
+   [yetti.request :as yrq]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; DEFAULTS
@@ -50,32 +52,21 @@
   (update! [_ data])
   (delete! [_ key]))
 
-(defn manager?
-  [o]
-  (satisfies? ISessionManager o))
-
-(sm/register!
- {:type ::manager
-  :pred manager?})
+(s/def ::manager #(satisfies? ISessionManager %))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; STORAGE IMPL
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(def ^:private schema:params
-  [:map {:title "session-params"}
-   [:user-agent ::sm/text]
-   [:profile-id ::sm/uuid]
-   [:created-at ::sm/inst]])
-
-(def ^:private valid-params?
-  (sm/validator schema:params))
+(s/def ::session-params
+  (s/keys :req-un [::user-agent
+                   ::profile-id
+                   ::created-at]))
 
 (defn- prepare-session-params
   [key params]
-  (assert (string? key) "expected key to be a string")
-  (assert (not (str/blank? key)) "expected key to be not empty")
-  (assert (valid-params? params) "expected valid params")
+  (us/assert! ::us/not-empty-string key)
+  (us/assert! ::session-params params)
 
   {:user-agent (:user-agent params)
    :profile-id (:profile-id params)
@@ -126,9 +117,8 @@
         (swap! cache dissoc token)
         nil))))
 
-(defmethod ig/assert-key ::manager
-  [_ params]
-  (assert (db/pool? (::db/pool params)) "expect valid database pool"))
+(defmethod ig/pre-init-spec ::manager [_]
+  (s/keys :req [::db/pool]))
 
 (defmethod ig/init-key ::manager
   [_ {:keys [::db/pool]}]
@@ -151,11 +141,11 @@
 
 (defn create-fn
   [{:keys [::manager ::setup/props]} profile-id]
-  (assert (manager? manager) "expected valid session manager")
-  (assert (uuid? profile-id) "expected valid uuid for profile-id")
+  (us/assert! ::manager manager)
+  (us/assert! ::us/uuid profile-id)
 
   (fn [request response]
-    (let [uagent  (yreq/get-header request "user-agent")
+    (let [uagent  (rreq/get-header request "user-agent")
           params  {:profile-id profile-id
                    :user-agent uagent
                    :created-at (dt/now)}
@@ -168,10 +158,10 @@
 
 (defn delete-fn
   [{:keys [::manager]}]
-  (assert (manager? manager) "expected valid session manager")
+  (us/assert! ::manager manager)
   (fn [request response]
     (let [cname   (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
-          cookie  (yreq/get-cookie request cname)]
+          cookie  (yrq/get-cookie request cname)]
       (l/trace :hint "delete" :profile-id (:profile-id request))
       (some->> (:value cookie) (delete! manager))
       (-> response
@@ -193,7 +183,7 @@
 (defn- get-token
   [request]
   (let [cname  (cf/get :auth-token-cookie-name default-auth-token-cookie-name)
-        cookie (some-> (yreq/get-cookie request cname) :value)]
+        cookie (some-> (yrq/get-cookie request cname) :value)]
     (when-not (str/empty? cookie)
       cookie)))
 
@@ -209,7 +199,7 @@
 
 (defn- wrap-soft-auth
   [handler {:keys [::manager ::setup/props]}]
-  (assert (manager? manager) "expected valid session manager")
+  (us/assert! ::manager manager)
   (letfn [(handle-request [request]
             (try
               (let [token  (get-token request)
@@ -227,7 +217,7 @@
 
 (defn- wrap-authz
   [handler {:keys [::manager]}]
-  (assert (manager? manager) "expected valid session manager")
+  (us/assert! ::manager manager)
   (fn [request]
     (let [session  (get-session manager (::token request))
           request  (cond-> request
@@ -318,17 +308,16 @@
 ;; TASK: SESSION GC
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-;; FIXME: MOVE
+(s/def ::tasks/max-age ::dt/duration)
 
-(defmethod ig/assert-key ::tasks/gc
-  [_ params]
-  (assert (db/pool? (::db/pool params)) "expected valid database pool")
-  (assert (dt/duration? (::tasks/max-age params))))
+(defmethod ig/pre-init-spec ::tasks/gc [_]
+  (s/keys :req [::db/pool]
+          :opt [::tasks/max-age]))
 
-(defmethod ig/expand-key ::tasks/gc
-  [k v]
+(defmethod ig/prep-key ::tasks/gc
+  [_ cfg]
   (let [max-age (cf/get :auth-token-cookie-max-age default-cookie-max-age)]
-    {k (merge {::tasks/max-age max-age} (d/without-nils v))}))
+    (merge {::tasks/max-age max-age} (d/without-nils cfg))))
 
 (def ^:private
   sql:delete-expired

backend/src/app/http/sse.clj

@@ -9,7 +9,6 @@
   (:refer-clojure :exclude [tap])
   (:require
    [app.common.data :as d]
-   [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [app.common.transit :as t]
    [app.http.errors :as errors]
@@ -17,7 +16,7 @@
    [promesa.exec :as px]
    [promesa.exec.csp :as sp]
    [promesa.util :as pu]
-   [yetti.response :as yres])
+   [ring.response :as rres])
   (:import
    java.io.OutputStream))
 
@@ -50,21 +49,21 @@
 (defn response
   [handler & {:keys [buf] :or {buf 32} :as opts}]
   (fn [request]
-    {::yres/headers default-headers
-     ::yres/status 200
-     ::yres/body (yres/stream-body
-                  (fn [_ output]
-                    (binding [events/*channel* (sp/chan :buf buf :xf (keep encode))]
-                      (let [listener (events/start-listener
-                                      (partial write! output)
-                                      (partial pu/close! output))]
-                        (try
-                          (let [result (handler)]
-                            (events/tap :end result))
-                          (catch Throwable cause
-                            (events/tap :error (errors/handle' cause request))
-                            (when-not (ex/instance? java.io.EOFException cause)
-                              (l/err :hint "unexpected error on processing sse response" :cause cause)))
-                          (finally
-                            (sp/close! events/*channel*)
-                            (px/await! listener)))))))}))
+    {::rres/headers default-headers
+     ::rres/status 200
+     ::rres/body (reify rres/StreamableResponseBody
+                   (-write-body-to-stream [_ _ output]
+                     (binding [events/*channel* (sp/chan :buf buf :xf (keep encode))]
+                       (let [listener (events/start-listener
+                                       (partial write! output)
+                                       (partial pu/close! output))]
+                         (try
+                           (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*)
+                             (px/await! listener)))))))}))

backend/src/app/http/websocket.clj

@@ -18,8 +18,10 @@
    [app.msgbus :as mbus]
    [app.util.time :as dt]
    [app.util.websocket :as ws]
+   [clojure.spec.alpha :as s]
    [integrant.core :as ig]
    [promesa.exec.csp :as sp]
+   [ring.websocket :as rws]
    [yetti.websocket :as yws]))
 
 (def recv-labels
@@ -111,6 +113,7 @@
         fsub (::file-subscription @state)
         tsub (::team-subscription @state)
         msg  {:type :disconnect
+              :subs-id profile-id
               :profile-id profile-id
               :session-id session-id}]
 
@@ -135,7 +138,9 @@
   (l/trace :fn "handle-message" :event "subscribe-team" :team-id team-id :conn-id id)
   (let [prev-subs (get @state ::team-subscription)
         channel   (sp/chan :buf (sp/dropping-buffer 64)
-                           :xf  (remove #(= (:session-id %) session-id)))]
+                           :xf  (comp
+                                 (remove #(= (:session-id %) session-id))
+                                 (map #(assoc % :subs-id team-id))))]
 
     (sp/pipe channel output-ch false)
     (mbus/sub! msgbus :topic team-id :chan channel)
@@ -154,7 +159,8 @@
   (l/trace :fn "handle-message" :event "subscribe-file" :file-id file-id :conn-id id)
   (let [psub (::file-subscription @state)
         fch  (sp/chan :buf (sp/dropping-buffer 64)
-                      :xf  (remove #(= (:session-id %) session-id)))]
+                      :xf  (comp (remove #(= (:session-id %) session-id))
+                                 (map #(assoc % :subs-id file-id))))]
 
     (let [subs {:file-id file-id :channel fch :topic file-id}]
       (swap! state assoc ::file-subscription subs))
@@ -185,6 +191,7 @@
     ;; Notifify the rest of participants of the new connection.
     (let [message {:type :join-file
                    :file-id file-id
+                   :subs-id file-id
                    :session-id session-id
                    :profile-id profile-id}]
       (mbus/pub! msgbus :topic file-id :message message))))
@@ -271,18 +278,25 @@
             :inc 1)
   message)
 
+(def ^:private schema:params
+  [:map {:title "params"}
+   [:session-id ::sm/uuid]])
+
+(def ^:private decode-params
+  (sm/decoder schema:params sm/json-transformer))
+
+(def ^:private validate-params!
+  (sm/validate-fn schema:params))
+
 (defn- http-handler
   [cfg {:keys [params ::session/profile-id] :as request}]
-  (let [session-id (some-> params :session-id sm/parse-uuid)]
-    (when-not (uuid? session-id)
-      (ex/raise :type :validation
-                :code :missing-session-id
-                :hint "missing or invalid session-id found"))
-
+  (let [{:keys [session-id]} (-> params
+                                 decode-params
+                                 validate-params!)]
     (cond
       (not profile-id)
       (ex/raise :type :authentication
-                :hint "authentication required")
+                :hint "Authentication required.")
 
       ;; WORKAROUND: we use the adapter specific predicate for
       ;; performance reasons; for now, the ring default impl for
@@ -296,7 +310,7 @@
       :else
       (do
         (l/trace :hint "websocket request" :profile-id profile-id :session-id session-id)
-        {::yws/listener (ws/listener request
+        {::rws/listener (ws/listener request
                                      ::ws/on-rcv-message (partial on-rcv-message cfg)
                                      ::ws/on-snd-message (partial on-snd-message cfg)
                                      ::ws/on-connect (partial on-connect cfg)
@@ -304,17 +318,13 @@
                                      ::profile-id profile-id
                                      ::session-id session-id)}))))
 
+(defmethod ig/pre-init-spec ::routes [_]
+  (s/keys :req [::mbus/msgbus
+                ::mtx/metrics
+                ::db/pool
+                ::session/manager]))
 
-(def ^:private schema:routes-params
-  [:map
-   ::mbus/msgbus
-   ::mtx/metrics
-   ::db/pool
-   ::session/manager])
-
-(defmethod ig/assert-key ::routes
-  [_ params]
-  (assert (sm/valid? schema:routes-params params)))
+(s/def ::routes vector?)
 
 (defmethod ig/init-key ::routes
   [_ cfg]

backend/src/app/loggers/audit.clj

@@ -10,7 +10,7 @@
    [app.common.data :as d]
    [app.common.data.macros :as dm]
    [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]
@@ -25,7 +25,9 @@
    [app.util.services :as-alias sv]
    [app.util.time :as dt]
    [app.worker :as wrk]
-   [cuerdas.core :as str]))
+   [clojure.spec.alpha :as s]
+   [cuerdas.core :as str]
+   [integrant.core :as ig]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; HELPERS
@@ -93,28 +95,46 @@
 ;; --- SPECS
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; COLLECTOR API
+;; COLLECTOR
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;; Defines a service that collects the audit/activity log using
 ;; internal database. Later this audit log can be transferred to
 ;; an external storage and data cleared.
 
-(def ^:private schema:event
-  [:map {:title "event"}
-   [::type ::sm/text]
-   [::name ::sm/text]
-   [::profile-id ::sm/uuid]
-   [::ip-addr {:optional true} ::sm/text]
-   [::props {:optional true} [:map-of :keyword :any]]
-   [::context {:optional true} [:map-of :keyword :any]]
-   [::webhooks/event? {:optional true} ::sm/boolean]
-   [::webhooks/batch-timeout {:optional true} ::dt/duration]
-   [::webhooks/batch-key {:optional true}
-    [:or ::sm/fn ::sm/text :keyword]]])
+(s/def ::profile-id ::us/uuid)
+(s/def ::name ::us/string)
+(s/def ::type ::us/string)
+(s/def ::props (s/map-of ::us/keyword any?))
+(s/def ::ip-addr ::us/string)
 
-(def ^:private check-event
-  (sm/check-fn schema:event))
+(s/def ::webhooks/event? ::us/boolean)
+(s/def ::webhooks/batch-timeout ::dt/duration)
+(s/def ::webhooks/batch-key
+  (s/or :fn fn? :str string? :kw keyword?))
+
+(s/def ::event
+  (s/keys :req [::type ::name ::profile-id]
+          :opt [::ip-addr
+                ::props
+                ::webhooks/event?
+                ::webhooks/batch-timeout
+                ::webhooks/batch-key]))
+
+(s/def ::collector
+  (s/keys :req [::wrk/executor ::db/pool]))
+
+(defmethod ig/pre-init-spec ::collector [_]
+  (s/keys :req [::db/pool ::wrk/executor]))
+
+(defmethod ig/init-key ::collector
+  [_ {:keys [::db/pool] :as cfg}]
+  (cond
+    (db/read-only? pool)
+    (l/warn :hint "audit disabled (db is read-only)")
+
+    :else
+    cfg))
 
 (defn prepare-event
   [cfg mdata params result]
@@ -253,12 +273,12 @@
   "Submit audit event to the collector."
   [cfg event]
   (try
-    (let [event (-> (d/without-nils event)
-                    (check-event))
+    (let [event (d/without-nils event)
           cfg   (-> cfg
                     (assoc ::rtry/when rtry/conflict-exception?)
                     (assoc ::rtry/max-retries 6)
                     (assoc ::rtry/label "persist-audit-log"))]
+      (us/verify! ::event event)
       (rtry/invoke! cfg db/tx-run! handle-event! event))
     (catch Throwable cause
       (l/error :hint "unexpected error processing event" :cause cause))))
@@ -269,8 +289,8 @@
   logic."
   [cfg event]
   (when (contains? cf/flags :audit-log)
-    (let [event (-> (d/without-nils event)
-                    (check-event))]
+    (let [event (d/without-nils event)]
+      (us/verify! ::event event)
       (db/run! cfg (fn [cfg]
                      (let [tnow   (dt/now)
                            params (-> (event->params event)

backend/src/app/loggers/audit/archive_task.clj

@@ -8,7 +8,6 @@
   (:require
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
-   [app.common.schema :as sm]
    [app.common.transit :as t]
    [app.common.uuid :as uuid]
    [app.config :as cf]
@@ -17,6 +16,7 @@
    [app.setup :as-alias setup]
    [app.tokens :as tokens]
    [app.util.time :as dt]
+   [clojure.spec.alpha :as s]
    [integrant.core :as ig]
    [lambdaisland.uri :as u]
    [promesa.exec :as px]))
@@ -108,15 +108,8 @@
                           (mark-archived! cfg rows)
                           (count events)))))))
 
-(def ^:private schema:handler-params
-  [:map
-   ::db/pool
-   ::setup/props
-   ::http/client])
-
-(defmethod ig/assert-key ::handler
-  [_ params]
-  (assert (sm/valid? schema:handler-params params) "valid params expected for handler"))
+(defmethod ig/pre-init-spec ::handler [_]
+  (s/keys :req [::db/pool ::setup/props ::http/client]))
 
 (defmethod ig/init-key ::handler
   [_ cfg]

backend/src/app/loggers/audit/gc_task.clj

@@ -8,6 +8,7 @@
   (:require
    [app.common.logging :as l]
    [app.db :as db]
+   [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
 (def ^:private sql:clean-archived
@@ -21,9 +22,8 @@
     (l/debug :hint "delete archived audit log entries" :deleted result)
     result))
 
-(defmethod ig/assert-key ::handler
-  [_ params]
-  (assert (db/pool? (::db/pool params)) "valid database pool expected"))
+(defmethod ig/pre-init-spec ::handler [_]
+  (s/keys :req [::db/pool]))
 
 (defmethod ig/init-key ::handler
   [_ cfg]

backend/src/app/loggers/database.clj

@@ -12,6 +12,7 @@
    [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]
    [clojure.spec.alpha :as s]
@@ -37,7 +38,7 @@
 
 (defn record->report
   [{:keys [::l/context ::l/message ::l/props ::l/logger ::l/level ::l/cause] :as record}]
-  (assert (l/valid-record? record) "expectd valid log record")
+  (us/assert! ::l/record record)
   (if (or (instance? java.util.concurrent.CompletionException cause)
           (instance? java.util.concurrent.ExecutionException cause))
     (-> record
@@ -62,7 +63,7 @@
                      (ex/format-throwable cause :data? false :explain? false :header? false :summary? false))}
 
        (when-let [params (or (:request/params context) (:params context))]
-         {:params (pp/pprint-str params :length 30 :level 13)})
+         {:params (pp/pprint-str params :length 30 :level 12)})
 
        (when-let [value (:value context)]
          {:value (pp/pprint-str value :length 30 :level 12)})
@@ -90,9 +91,8 @@
     (catch Throwable cause
       (l/warn :hint "unexpected exception on database error logger" :cause cause))))
 
-(defmethod ig/assert-key ::reporter
-  [_ params]
-  (assert (db/pool? (::db/pool params)) "expect valid database pool"))
+(defmethod ig/pre-init-spec ::reporter [_]
+  (s/keys :req [::db/pool]))
 
 (defmethod ig/init-key ::reporter
   [_ cfg]

backend/src/app/loggers/mattermost.clj

@@ -9,10 +9,12 @@
   (:require
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
+   [app.common.spec :as us]
    [app.config :as cf]
    [app.http.client :as http]
    [app.loggers.database :as ldb]
    [app.util.json :as json]
+   [clojure.spec.alpha :as s]
    [integrant.core :as ig]
    [promesa.exec :as px]
    [promesa.exec.csp :as sp]))
@@ -52,7 +54,7 @@
 
 (defn record->report
   [{:keys [::l/context ::l/id ::l/cause] :as record}]
-  (assert (l/valid-record? record) "expectd valid log record")
+  (us/assert! ::l/record record)
   {:id               id
    :tenant           (cf/get :tenant)
    :host             (cf/get :host)
@@ -73,9 +75,8 @@
       (catch Throwable cause
         (l/warn :hint "unhandled error" :cause cause)))))
 
-(defmethod ig/assert-key ::reporter
-  [_ params]
-  (assert (http/client? (::http/client params)) "expect valid http client"))
+(defmethod ig/pre-init-spec ::reporter [_]
+  (s/keys :req [::http/client]))
 
 (defmethod ig/init-key ::reporter
   [_ cfg]

backend/src/app/loggers/webhooks.clj

@@ -18,6 +18,7 @@
    [app.util.time :as dt]
    [app.worker :as wrk]
    [clojure.data.json :as json]
+   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig]))
 
@@ -59,10 +60,8 @@
       (some->> (:project-id props) (lookup-webhooks-by-project pool))
       (some->> (:file-id props) (lookup-webhooks-by-file pool))))
 
-(defmethod ig/assert-key ::process-event-handler
-  [_ params]
-  (assert (db/pool? (::db/pool params)) "expect valid database pool")
-  (assert (http/client? (::http/client params)) "expect valid http client"))
+(defmethod ig/pre-init-spec ::process-event-handler [_]
+  (s/keys :req [::db/pool]))
 
 (defmethod ig/init-key ::process-event-handler
   [_ cfg]
@@ -88,14 +87,12 @@
   {:key-fn str/camel
    :indent true})
 
-(defmethod ig/assert-key ::run-webhook-handler
-  [_ params]
-  (assert (db/pool? (::db/pool params)) "expect valid database pool")
-  (assert (http/client? (::http/client params)) "expect valid http client"))
+(defmethod ig/pre-init-spec ::run-webhook-handler [_]
+  (s/keys :req [::http/client ::db/pool]))
 
-(defmethod ig/expand-key ::run-webhook-handler
-  [k v]
-  {k (merge {::max-errors 3} (d/without-nils v))})
+(defmethod ig/prep-key ::run-webhook-handler
+  [_ cfg]
+  (merge {::max-errors 3} (d/without-nils cfg)))
 
 (defmethod ig/init-key ::run-webhook-handler
   [_ {:keys [::db/pool ::max-errors] :as cfg}]
@@ -138,7 +135,7 @@
 
         (l/dbg :hint "run webhook"
                :event-name (:name event)
-               :webhook-id (str (:id whook))
+               :webhook-id (:id whook)
                :webhook-uri (:uri whook)
                :webhook-mtype (:mtype whook))
 

backend/src/app/main.clj

@@ -9,7 +9,6 @@
    [app.auth.ldap :as-alias ldap]
    [app.auth.oidc :as-alias oidc]
    [app.auth.oidc.providers :as-alias oidc.providers]
-   [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [app.config :as cf]
    [app.db :as-alias db]
@@ -29,7 +28,6 @@
    [app.msgbus :as-alias mbus]
    [app.redis :as-alias rds]
    [app.rpc :as-alias rpc]
-   [app.rpc.climit :as-alias climit]
    [app.rpc.doc :as-alias rpc.doc]
    [app.setup :as-alias setup]
    [app.srepl :as-alias srepl]
@@ -171,7 +169,7 @@
    {::db/uri        (cf/get :database-uri)
     ::db/username   (cf/get :database-username)
     ::db/password   (cf/get :database-password)
-    ::db/read-only  (cf/get :database-readonly false)
+    ::db/read-only? (cf/get :database-readonly false)
     ::db/min-size   (cf/get :database-min-pool-size 0)
     ::db/max-size   (cf/get :database-max-pool-size 60)
     ::mtx/metrics   (ig/ref ::mtx/metrics)}
@@ -247,7 +245,7 @@
     :base-dn        (cf/get :ldap-base-dn)
     :bind-dn        (cf/get :ldap-bind-dn)
     :bind-password  (cf/get :ldap-bind-password)
-    :enabled        (contains? cf/flags :login-with-ldap)}
+    :enabled?       (contains? cf/flags :login-with-ldap)}
 
    ::oidc.providers/google
    {}
@@ -304,11 +302,9 @@
     ::http.assets/cache-max-agesignature-max-age (dt/duration {:hours 24 :minutes 5})
     ::sto/storage  (ig/ref ::sto/storage)}
 
-   ::rpc/climit
-   {::mtx/metrics        (ig/ref ::mtx/metrics)
-    ::wrk/executor       (ig/ref ::wrk/executor)
-    ::climit/config      (cf/get :rpc-climit-config)
-    ::climit/enabled     (contains? cf/flags :rpc-climit)}
+   :app.rpc/climit
+   {::mtx/metrics  (ig/ref ::mtx/metrics)
+    ::wrk/executor (ig/ref ::wrk/executor)}
 
    :app.rpc/rlimit
    {::wrk/executor (ig/ref ::wrk/executor)}
@@ -323,6 +319,7 @@
     ::mtx/metrics        (ig/ref ::mtx/metrics)
     ::mbus/msgbus        (ig/ref ::mbus/msgbus)
     ::rds/redis          (ig/ref ::rds/redis)
+    ::svgo/optimizer     (ig/ref ::svgo/optimizer)
 
     ::rpc/climit         (ig/ref ::rpc/climit)
     ::rpc/rlimit         (ig/ref ::rpc/rlimit)
@@ -333,7 +330,7 @@
     ::email/whitelist    (ig/ref ::email/whitelist)}
 
    :app.rpc.doc/routes
-   {:app.rpc/methods (ig/ref :app.rpc/methods)}
+   {:methods (ig/ref :app.rpc/methods)}
 
    :app.rpc/routes
    {::rpc/methods     (ig/ref :app.rpc/methods)
@@ -349,6 +346,7 @@
      :file-gc            (ig/ref :app.tasks.file-gc/handler)
      :file-gc-scheduler  (ig/ref :app.tasks.file-gc-scheduler/handler)
      :offload-file-data  (ig/ref :app.tasks.offload-file-data/handler)
+     :file-xlog-gc       (ig/ref :app.tasks.file-xlog-gc/handler)
      :tasks-gc           (ig/ref :app.tasks.tasks-gc/handler)
      :telemetry          (ig/ref :app.tasks.telemetry/handler)
      :storage-gc-deleted (ig/ref ::sto.gc-deleted/handler)
@@ -381,7 +379,8 @@
     ::email/default-from     (cf/get :smtp-default-from)}
 
    ::email/handler
-   {::email/sendmail (ig/ref ::email/sendmail)}
+   {::email/sendmail (ig/ref ::email/sendmail)
+    ::mtx/metrics    (ig/ref ::mtx/metrics)}
 
    :app.tasks.tasks-gc/handler
    {::db/pool (ig/ref ::db/pool)}
@@ -404,6 +403,10 @@
    {::db/pool     (ig/ref ::db/pool)
     ::sto/storage (ig/ref ::sto/storage)}
 
+   :app.tasks.file-xlog-gc/handler
+   {::db/pool     (ig/ref ::db/pool)
+    ::sto/storage (ig/ref ::sto/storage)}
+
    :app.tasks.telemetry/handler
    {::db/pool            (ig/ref ::db/pool)
     ::http.client/client (ig/ref ::http.client/client)
@@ -427,6 +430,9 @@
     ;; module requires the migrations to run before initialize.
     ::migrations (ig/ref :app.migrations/migrations)}
 
+   ::svgo/optimizer
+   {}
+
    :app.loggers.audit.archive-task/handler
    {::setup/props        (ig/ref ::setup/props)
     ::db/pool            (ig/ref ::db/pool)
@@ -469,8 +475,7 @@
     ::sto.s3/bucket     (or (cf/get :storage-assets-s3-bucket)
                             (cf/get :objects-storage-s3-bucket))
     ::sto.s3/io-threads (or (cf/get :storage-assets-s3-io-threads)
-                            (cf/get :objects-storage-s3-io-threads))
-    ::wrk/executor      (ig/ref ::wrk/executor)}
+                            (cf/get :objects-storage-s3-io-threads))}
 
    :app.storage.fs/backend
    {::sto.fs/directory (or (cf/get :storage-assets-fs-directory)
@@ -482,7 +487,10 @@
    {::wrk/registry            (ig/ref ::wrk/registry)
     ::db/pool                 (ig/ref ::db/pool)
     ::wrk/entries
-    [{:cron #app/cron "0 0 0 * * ?" ;; daily
+    [{:cron #app/cron "0 0 * * * ?" ;; hourly
+      :task :file-xlog-gc}
+
+     {:cron #app/cron "0 0 0 * * ?" ;; daily
       :task :session-gc}
 
      {:cron #app/cron "0 0 0 * * ?" ;; daily
@@ -514,13 +522,11 @@
    ::wrk/dispatcher
    {::rds/redis   (ig/ref ::rds/redis)
     ::mtx/metrics (ig/ref ::mtx/metrics)
-    ::db/pool     (ig/ref ::db/pool)
-    ::wrk/tenant  (cf/get :tenant)}
+    ::db/pool     (ig/ref ::db/pool)}
 
    [::default ::wrk/runner]
    {::wrk/parallelism (cf/get ::worker-default-parallelism 1)
     ::wrk/queue       :default
-    ::wrk/tenant      (cf/get :tenant)
     ::rds/redis       (ig/ref ::rds/redis)
     ::wrk/registry    (ig/ref ::wrk/registry)
     ::mtx/metrics     (ig/ref ::mtx/metrics)
@@ -529,7 +535,6 @@
    [::webhook ::wrk/runner]
    {::wrk/parallelism (cf/get ::worker-webhook-parallelism 1)
     ::wrk/queue       :webhooks
-    ::wrk/tenant      (cf/get :tenant)
     ::rds/redis       (ig/ref ::rds/redis)
     ::wrk/registry    (ig/ref ::wrk/registry)
     ::mtx/metrics     (ig/ref ::mtx/metrics)
@@ -547,7 +552,7 @@
                              (-> system-config
                                  (cond-> (contains? cf/flags :backend-worker)
                                    (merge worker-config))
-                                 (ig/expand)
+                                 (ig/prep)
                                  (ig/init))))
   (l/inf :hint "welcome to penpot"
          :flags (str/join "," (map name cf/flags))
@@ -560,7 +565,7 @@
   (alter-var-root #'system (fn [sys]
                              (when sys (ig/halt! sys))
                              (-> config
-                                 (ig/expand)
+                                 (ig/prep)
                                  (ig/init)))))
 
 (defn stop
@@ -616,6 +621,12 @@
 
       (deref p))
     (catch Throwable cause
-      (ex/print-throwable cause)
+      (binding [*out* *err*]
+        (println "==== ERROR ===="))
+      (.printStackTrace cause)
+      (when-let [cause' (ex-cause cause)]
+        (binding [*out* *err*]
+          (println "==== CAUSE ===="))
+        (.printStackTrace cause'))
       (px/sleep 500)
       (System/exit -1))))

backend/src/app/media.clj

@@ -46,15 +46,14 @@
   (s/keys :req-un [::path]
           :opt-un [::mtype]))
 
-(sm/register!
- ^{::sm/type ::upload}
- [:map {:title "Upload"}
-  [:filename :string]
-  [:size ::sm/int]
-  [:path ::fs/path]
-  [:mtype {:optional true} :string]
-  [:headers {:optional true}
-   [:map-of :string :string]]])
+(sm/register! ::upload
+  [:map {:title "Upload"}
+   [:filename :string]
+   [:size ::sm/int]
+   [:path ::fs/path]
+   [:mtype {:optional true} :string]
+   [:headers {:optional true}
+    [:map-of :string :string]]])
 
 (defn validate-media-type!
   ([upload] (validate-media-type! upload cm/valid-image-types))
@@ -226,7 +225,7 @@
   (letfn [(ttf->otf [data]
             (let [finput  (tmp/tempfile :prefix "penpot.font." :suffix "")
                   foutput (fs/path (str finput ".otf"))
-                  _       (io/write* finput data)
+                  _       (io/write-to-file! data finput)
                   res     (sh/sh "fontforge" "-lang=ff" "-c"
                                  (str/fmt "Open('%s'); Generate('%s')"
                                           (str finput)
@@ -237,7 +236,7 @@
           (otf->ttf [data]
             (let [finput  (tmp/tempfile :prefix "penpot.font." :suffix "")
                   foutput (fs/path (str finput ".ttf"))
-                  _       (io/write* finput data)
+                  _       (io/write-to-file! data finput)
                   res     (sh/sh "fontforge" "-lang=ff" "-c"
                                  (str/fmt "Open('%s'); Generate('%s')"
                                           (str finput)
@@ -251,14 +250,14 @@
             ;; command.
             (let [finput  (tmp/tempfile :prefix "penpot.font." :suffix "")
                   foutput (fs/path (str finput ".woff"))
-                  _       (io/write* finput data)
+                  _       (io/write-to-file! data finput)
                   res     (sh/sh "sfnt2woff" (str finput))]
               (when (zero? (:exit res))
                 foutput)))
 
           (woff->sfnt [data]
             (let [finput  (tmp/tempfile :prefix "penpot" :suffix "")
-                  _       (io/write* finput data)
+                  _       (io/write-to-file! data finput)
                   res     (sh/sh "woff2sfnt" (str finput)
                                  :out-enc :bytes)]
               (when (zero? (:exit res))

backend/src/app/metrics.clj

@@ -8,8 +8,9 @@
   (:refer-clojure :exclude [run!])
   (:require
    [app.common.logging :as l]
-   [app.common.schema :as sm]
+   [app.common.spec :as us]
    [app.metrics.definition :as-alias mdef]
+   [clojure.spec.alpha :as s]
    [integrant.core :as ig])
   (:import
    io.prometheus.client.CollectorRegistry
@@ -33,52 +34,41 @@
 (declare create-collector)
 (declare handler)
 
-(defprotocol IMetrics
-  (get-registry [_])
-  (get-collector [_ id])
-  (get-handler [_]))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; METRICS SERVICE PROVIDER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(sm/register!
- {:type ::collector
-  :pred #(instance? SimpleCollector %)
-  :type-properties
-  {:title "collector"
-   :description "An instance of SimpleCollector"}})
+(s/def ::mdef/name string?)
+(s/def ::mdef/help string?)
+(s/def ::mdef/labels (s/every string? :kind vector?))
+(s/def ::mdef/type #{:gauge :counter :summary :histogram})
 
-(sm/register!
- {:type ::registry
-  :pred  #(instance? CollectorRegistry %)
-  :type-properties
-  {:title "Metrics Registry"
-   :description "Instance of CollectorRegistry"}})
+(s/def ::mdef/instance
+  #(instance? SimpleCollector %))
 
-(def ^:private schema:definitions
-  [:map-of :keyword
-   [:map {:title "definition"}
-    [::mdef/name :string]
-    [::mdef/help :string]
-    [::mdef/type [:enum :gauge :counter :summary :histogram]]
-    [::mdef/labels {:optional true} [::sm/vec :string]]
-    [::mdef/instance {:optional true} ::collector]]])
+(s/def ::mdef/definition
+  (s/keys :req [::mdef/name
+                ::mdef/help
+                ::mdef/type]
+          :opt [::mdef/labels
+                ::mdef/instance]))
 
-(defn metrics?
-  [o]
-  (satisfies? IMetrics o))
+(s/def ::definitions
+  (s/map-of keyword? ::mdef/definition))
 
-(sm/register!
- {:type ::metrics
-  :pred metrics?})
+(s/def ::registry
+  #(instance? CollectorRegistry %))
 
-(def ^:private valid-definitions?
-  (sm/validator schema:definitions))
+(s/def ::handler fn?)
+(s/def ::metrics
+  (s/keys :req [::registry
+                ::handler
+                ::definitions]))
 
-(defmethod ig/assert-key ::metrics
-  [_ {:keys [default]}]
-  (assert (valid-definitions? default) "expected valid definitions"))
+(s/def ::default ::definitions)
+
+(defmethod ig/pre-init-spec ::metrics [_]
+  (s/keys :req-un [::default]))
 
 (defmethod ig/init-key ::metrics
   [_ cfg]
@@ -91,14 +81,12 @@
                                {}
                                (:default cfg))]
 
-    (reify
-      IMetrics
-      (get-handler [_]
-        (partial handler registry))
-      (get-collector [_ id]
-        (get definitions id))
-      (get-registry [_]
-        registry))))
+    (us/verify! ::definitions definitions)
+
+    {::handler (partial handler registry)
+     ::definitions definitions
+     ::registry registry}))
+
 
 (defn- handler
   [registry _]
@@ -108,14 +96,17 @@
     {:headers {"content-type" TextFormat/CONTENT_TYPE_004}
      :body (.toString writer)}))
 
-(defmethod ig/assert-key ::routes
-  [_ {:keys [::metrics]}]
-  (assert (metrics? metrics) "expected a valid instance for metrics"))
+
+
+(s/def ::routes vector?)
+(defmethod ig/pre-init-spec ::routes [_]
+  (s/keys :req [::metrics]))
 
 (defmethod ig/init-key ::routes
   [_ {:keys [::metrics]}]
-  ["/metrics" {:handler (get-handler metrics)
-               :allowed-methods #{:get}}])
+  (let [registry (::registry metrics)]
+    ["/metrics" {:handler (partial handler registry)
+                 :allowed-methods #{:get}}]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Implementation
@@ -135,9 +126,8 @@
 (defmulti create-collector ::mdef/type)
 
 (defn run!
-  [instance & {:keys [id] :as params}]
-  (assert (metrics? instance) "expected valid metrics instance")
-  (when-let [mobj (get-collector instance id)]
+  [{:keys [::definitions]} & {:keys [id] :as params}]
+  (when-let [mobj (get definitions id)]
     (run-collector! mobj params)
     true))
 

backend/src/app/migrations.clj

@@ -11,6 +11,7 @@
    [app.db :as db]
    [app.migrations.clj.migration-0023 :as mg0023]
    [app.util.migrations :as mg]
+   [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
 (def migrations
@@ -411,22 +412,7 @@
     :fn (mg/resource "app/migrations/sql/0129-mod-file-change-table.sql")}
 
    {:name "0130-mod-file-change-table"
-    :fn (mg/resource "app/migrations/sql/0130-mod-file-change-table.sql")}
-
-   {:name "0131-mod-webhook-table"
-    :fn (mg/resource "app/migrations/sql/0131-mod-webhook-table.sql")}
-
-   {:name "0132-mod-file-change-table"
-    :fn (mg/resource "app/migrations/sql/0132-mod-file-change-table.sql")}
-
-   {:name "0133-mod-file-table"
-    :fn (mg/resource "app/migrations/sql/0133-mod-file-table.sql")}
-
-   {:name "0134-mod-file-change-table"
-    :fn (mg/resource "app/migrations/sql/0134-mod-file-change-table.sql")}
-
-   {:name "0135-mod-team-invitation-table.sql"
-    :fn (mg/resource "app/migrations/sql/0135-mod-team-invitation-table.sql")}])
+    :fn (mg/resource "app/migrations/sql/0130-mod-file-change-table.sql")}])
 
 (defn apply-migrations!
   [pool name migrations]
@@ -434,9 +420,9 @@
     (mg/setup! conn)
     (mg/migrate! conn {:name name :steps migrations})))
 
-(defmethod ig/assert-key ::migrations
-  [_ {:keys [::db/pool]}]
-  (assert (db/pool? pool) "expected valid pool"))
+(defmethod ig/pre-init-spec ::migrations
+  [_]
+  (s/keys :req [::db/pool]))
 
 (defmethod ig/init-key ::migrations
   [module {:keys [::db/pool]}]

backend/src/app/migrations/sql/0131-mod-webhook-table.sql

@@ -1,6 +0,0 @@
-ALTER TABLE webhook
-  ADD COLUMN profile_id uuid NULL REFERENCES profile (id) ON DELETE SET NULL;
-
-CREATE INDEX webhook__profile_id__idx
-    ON webhook (profile_id)
- WHERE profile_id IS NOT NULL;

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

@@ -1,2 +0,0 @@
-ALTER TABLE file_change
-  ADD COLUMN created_by text NOT NULL DEFAULT 'system';

backend/src/app/migrations/sql/0133-mod-file-table.sql

@@ -1,2 +0,0 @@
-ALTER TABLE file
-  ADD COLUMN vern int NOT NULL DEFAULT 0;

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

@@ -1,18 +0,0 @@
-ALTER TABLE file_change
-  ADD COLUMN updated_at timestamptz DEFAULT now(),
-  ADD COLUMN deleted_at timestamptz DEFAULT NULL,
-ALTER COLUMN created_at SET DEFAULT now();
-
-DROP INDEX file_change__created_at__idx;
-DROP INDEX file_change__created_at__label__idx;
-DROP INDEX file_change__label__idx;
-
-CREATE INDEX file_change__deleted_at__idx
-    ON file_change (deleted_at, id)
- WHERE deleted_at IS NOT NULL;
-
-CREATE INDEX file_change__system_snapshots__idx
-    ON file_change (file_id, created_at)
- WHERE data IS NOT NULL
-   AND created_by = 'system'
-   AND deleted_at IS NULL;

backend/src/app/migrations/sql/0135-mod-team-invitation-table.sql

@@ -1,2 +0,0 @@
-ALTER TABLE team_invitation
-  ADD COLUMN created_by uuid NULL REFERENCES profile(id) ON DELETE SET NULL;

backend/src/app/msgbus.clj

@@ -9,27 +9,22 @@
   (:require
    [app.common.data :as d]
    [app.common.logging :as l]
-   [app.common.schema :as sm]
+   [app.common.spec :as us]
    [app.common.transit :as t]
    [app.config :as cfg]
    [app.redis :as rds]
    [app.util.time :as dt]
    [app.worker :as wrk]
+   [clojure.spec.alpha :as s]
    [integrant.core :as ig]
    [promesa.core :as p]
    [promesa.exec :as px]
    [promesa.exec.csp :as sp]))
 
 (set! *warn-on-reflection* true)
+
 (def ^:private prefix (cfg/get :tenant))
 
-(defprotocol IMsgBus
-  (-sub [_ topics chan])
-  (-pub [_ topic message])
-  (-purge [_ chans]))
-
-
-
 (defn- prefix-topic
   [topic]
   (str prefix "." topic))
@@ -37,33 +32,30 @@
 (def ^:private xform-prefix-topic
   (map (fn [obj] (update obj :topic prefix-topic))))
 
-(declare ^:private redis-pub)
-(declare ^:private redis-sub)
-(declare ^:private redis-unsub)
-(declare ^:private start-io-loop)
+(declare ^:private redis-pub!)
+(declare ^:private redis-sub!)
+(declare ^:private redis-unsub!)
+(declare ^:private start-io-loop!)
 (declare ^:private subscribe-to-topics)
 (declare ^:private unsubscribe-channels)
 
-(defn msgbus?
-  [o]
-  (satisfies? IMsgBus o))
+(s/def ::cmd-ch sp/chan?)
+(s/def ::rcv-ch sp/chan?)
+(s/def ::pub-ch sp/chan?)
+(s/def ::state ::us/agent)
+(s/def ::pconn ::rds/connection-holder)
+(s/def ::sconn ::rds/connection-holder)
+(s/def ::msgbus
+  (s/keys :req [::cmd-ch ::rcv-ch ::pub-ch ::state ::pconn ::sconn ::wrk/executor]))
 
-(sm/register!
- {:type ::msgbus
-  :pred msgbus?})
+(defmethod ig/pre-init-spec ::msgbus [_]
+  (s/keys :req [::rds/redis ::wrk/executor]))
 
-(defmethod ig/expand-key ::msgbus
-  [k v]
-  {k (-> (d/without-nils v)
-         (assoc ::buffer-size 128)
-         (assoc ::timeout (dt/duration {:seconds 30})))})
-
-(def ^:private schema:params
-  [:map ::rds/redis ::wrk/executor])
-
-(defmethod ig/assert-key ::msgbus
-  [_ params]
-  (assert (sm/check schema:params params)))
+(defmethod ig/prep-key ::msgbus
+  [_ cfg]
+  (-> cfg
+      (assoc ::buffer-size 128)
+      (assoc ::timeout (dt/duration {:seconds 30}))))
 
 (defmethod ig/init-key ::msgbus
   [_ {:keys [::buffer-size ::wrk/executor ::timeout ::rds/redis] :as cfg}]
@@ -74,66 +66,46 @@
                         :xf  xform-prefix-topic)
         state  (agent {})
 
-        pconn  (rds/connect redis :type :default :timeout timeout)
+        pconn  (rds/connect redis :timeout timeout)
         sconn  (rds/connect redis :type :pubsub :timeout timeout)
-
-        _      (set-error-handler! state #(l/error :cause % :hint "unexpected error on agent" ::l/sync? true))
-        _      (set-error-mode! state :continue)
-
-        cfg    (-> cfg
+        msgbus (-> cfg
                    (assoc ::pconn pconn)
                    (assoc ::sconn sconn)
                    (assoc ::cmd-ch cmd-ch)
                    (assoc ::rcv-ch rcv-ch)
                    (assoc ::pub-ch pub-ch)
-                   (assoc ::state state))
+                   (assoc ::state state)
+                   (assoc ::wrk/executor executor))]
 
-        io-thr (start-io-loop cfg)]
+    (set-error-handler! state #(l/error :cause % :hint "unexpected error on agent" ::l/sync? true))
+    (set-error-mode! state :continue)
 
-    (reify
-      java.lang.AutoCloseable
-      (close [_]
-        (px/interrupt! io-thr)
-        (sp/close! cmd-ch)
-        (sp/close! rcv-ch)
-        (sp/close! pub-ch)
-        (d/close! pconn)
-        (d/close! sconn))
-
-      IMsgBus
-      (-sub [_ topics chan]
-        (l/debug :hint "subscribe" :topics topics :chan (hash chan))
-        (send-via executor state subscribe-to-topics cfg topics chan))
-
-      (-pub [_ topic message]
-        (let [message (assoc message :topic topic)]
-          (sp/put! pub-ch {:topic topic :message message})))
-
-      (-purge [_ chans]
-        (l/debug :hint "purge" :chans (count chans))
-        (send-via executor state unsubscribe-channels cfg chans)))))
+    (assoc msgbus ::io-thr (start-io-loop! msgbus))))
 
 (defmethod ig/halt-key! ::msgbus
-  [_ instance]
-  (d/close! instance))
+  [_ msgbus]
+  (px/interrupt! (::io-thr msgbus))
+  (sp/close! (::cmd-ch msgbus))
+  (sp/close! (::rcv-ch msgbus))
+  (sp/close! (::pub-ch msgbus))
+  (d/close! (::pconn msgbus))
+  (d/close! (::sconn msgbus)))
 
 (defn sub!
-  [instance & {:keys [topic topics chan]}]
-  (assert (satisfies? IMsgBus instance) "expected valid msgbus instance")
+  [{:keys [::state ::wrk/executor] :as cfg} & {:keys [topic topics chan]}]
   (let [topics (into [] (map prefix-topic) (if topic [topic] topics))]
-    (-sub instance topics chan)
+    (l/debug :hint "subscribe" :topics topics :chan (hash chan))
+    (send-via executor state subscribe-to-topics cfg topics chan)
     nil))
 
 (defn pub!
-  [instance & {:keys [topic message]}]
-  (assert (satisfies? IMsgBus instance) "expected valid msgbus instance")
-  (-pub instance topic message))
+  [{::keys [pub-ch]} & {:as params}]
+  (sp/put! pub-ch params))
 
 (defn purge!
-  [instance chans]
-  (assert (satisfies? IMsgBus instance) "expected valid msgbus instance")
-  (assert (every? sp/chan? chans) "expected a seq of chans")
-  (-purge instance chans)
+  [{:keys [::state ::wrk/executor] :as msgbus} chans]
+  (l/debug :hint "purge" :chans (count chans))
+  (send-via executor state unsubscribe-channels msgbus chans)
   nil)
 
 ;; --- IMPL
@@ -146,7 +118,7 @@
   (let [nsubs (if (nil? nsubs) #{chan} (conj nsubs chan))]
     (when (= 1 (count nsubs))
       (l/trace :hint "open subscription" :topic topic ::l/sync? true)
-      (redis-sub cfg topic))
+      (redis-sub! cfg topic))
     nsubs))
 
 (defn- disj-subscription
@@ -157,7 +129,7 @@
   (let [nsubs (disj nsubs chan)]
     (when (empty? nsubs)
       (l/trace :hint "close subscription" :topic topic ::l/sync? true)
-      (redis-unsub cfg topic))
+      (redis-unsub! cfg topic))
     nsubs))
 
 (defn- subscribe-to-topics
@@ -198,7 +170,7 @@
                    (when-not (sp/offer! rcv-ch val)
                      (l/warn :msg "dropping message on subscription loop"))))))
 
-(defn- process-input
+(defn- process-input!
   [{:keys [::state ::wrk/executor] :as cfg} topic message]
   (let [chans (get-in @state [:topics topic])]
     (when-let [closed (loop [chans  (seq chans)
@@ -211,9 +183,9 @@
       (send-via executor state unsubscribe-channels cfg closed))))
 
 
-(defn start-io-loop
+(defn start-io-loop!
   [{:keys [::sconn ::rcv-ch ::pub-ch ::state ::wrk/executor] :as cfg}]
-  (rds/add-listener sconn (create-listener rcv-ch))
+  (rds/add-listener! sconn (create-listener rcv-ch))
 
   (px/thread
     {:name "penpot/msgbus/io-loop"
@@ -237,12 +209,12 @@
 
             (identical? port rcv-ch)
             (let [{:keys [topic message]} val]
-              (process-input cfg topic message)
+              (process-input! cfg topic message)
               (recur))
 
             (identical? port pub-ch)
             (do
-              (redis-pub cfg val)
+              (redis-pub! cfg val)
               (recur)))))
 
       (catch InterruptedException _
@@ -258,12 +230,13 @@
 
         (l/debug :hint "io-loop thread terminated")))))
 
-(defn- redis-pub
+
+(defn- redis-pub!
   "Publish a message to the redis server. Asynchronous operation,
   intended to be used in core.async go blocks."
   [{:keys [::pconn] :as cfg} {:keys [topic message]}]
   (try
-    (p/await! (rds/publish pconn topic (t/encode message)))
+    (p/await! (rds/publish! pconn topic (t/encode message)))
     (catch InterruptedException cause
       (throw cause))
     (catch Throwable cause
@@ -271,23 +244,23 @@
                :message message
                :cause cause))))
 
-(defn- redis-sub
+(defn- redis-sub!
   "Create redis subscription. Blocking operation, intended to be used
   inside an agent."
   [{:keys [::sconn] :as cfg} topic]
   (try
-    (rds/subscribe sconn [topic])
+    (rds/subscribe! sconn topic)
     (catch InterruptedException cause
       (throw cause))
     (catch Throwable cause
       (l/trace :hint "exception on subscribing" :topic topic :cause cause))))
 
-(defn- redis-unsub
+(defn- redis-unsub!
   "Removes redis subscription. Blocking operation, intended to be used
   inside an agent."
   [{:keys [::sconn] :as cfg} topic]
   (try
-    (rds/unsubscribe sconn [topic])
+    (rds/unsubscribe! sconn topic)
     (catch InterruptedException cause
       (throw cause))
     (catch Throwable cause

backend/src/app/redis.clj

@@ -6,12 +6,11 @@
 
 (ns app.redis
   "The msgbus abstraction implemented using redis as underlying backend."
-  (:refer-clojure :exclude [eval])
   (:require
    [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
-   [app.common.schema :as sm]
+   [app.common.spec :as us]
    [app.metrics :as mtx]
    [app.redis.script :as-alias rscript]
    [app.util.cache :as cache]
@@ -19,11 +18,13 @@
    [app.worker :as-alias wrk]
    [clojure.core :as c]
    [clojure.java.io :as io]
+   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [integrant.core :as ig]
    [promesa.core :as p]
    [promesa.exec :as px])
   (:import
+   clojure.lang.IDeref
    clojure.lang.MapEntry
    io.lettuce.core.KeyValue
    io.lettuce.core.RedisClient
@@ -52,24 +53,79 @@
 
 (set! *warn-on-reflection* true)
 
-(declare ^:private initialize-resources)
-(declare ^:private shutdown-resources)
-(declare ^:private impl-eval)
+(declare initialize-resources)
+(declare shutdown-resources)
+(declare connect*)
 
-(defprotocol IRedis
-  (-connect [_ options])
-  (-get-or-connect [_ key options]))
+(s/def ::timer
+  #(instance? Timer %))
 
-(defprotocol IConnection
-  (publish [_ topic message])
-  (rpush [_ key payload])
-  (blpop [_ timeout keys])
-  (eval [_ script]))
+(s/def ::default-connection
+  #(or (instance? StatefulRedisConnection %)
+       (and (instance? IDeref %)
+            (instance? StatefulRedisConnection (deref %)))))
 
-(defprotocol IPubSubConnection
-  (add-listener [_ listener])
-  (subscribe [_ topics])
-  (unsubscribe [_ topics]))
+(s/def ::pubsub-connection
+  #(or (instance? StatefulRedisPubSubConnection %)
+       (and (instance? IDeref %)
+            (instance? StatefulRedisPubSubConnection (deref %)))))
+
+(s/def ::connection
+  (s/or :default ::default-connection
+        :pubsub  ::pubsub-connection))
+
+(s/def ::connection-holder
+  (s/keys :req [::connection]))
+
+(s/def ::redis-uri
+  #(instance? RedisURI %))
+
+(s/def ::resources
+  #(instance? ClientResources %))
+
+(s/def ::pubsub-listener
+  #(instance? RedisPubSubListener %))
+
+(s/def ::uri ::us/not-empty-string)
+(s/def ::timeout ::dt/duration)
+(s/def ::connect? ::us/boolean)
+(s/def ::io-threads ::us/integer)
+(s/def ::worker-threads ::us/integer)
+(s/def ::cache cache/cache?)
+
+(s/def ::redis
+  (s/keys :req [::resources
+                ::redis-uri
+                ::timer
+                ::mtx/metrics]
+          :opt [::connection
+                ::cache]))
+
+(defmethod ig/prep-key ::redis
+  [_ cfg]
+  (let [cpus    (px/get-available-processors)
+        threads (max 1 (int (* cpus 0.2)))]
+    (merge {::timeout (dt/duration "10s")
+            ::io-threads (max 3 threads)
+            ::worker-threads (max 3 threads)}
+           (d/without-nils cfg))))
+
+(defmethod ig/pre-init-spec ::redis [_]
+  (s/keys :req [::uri ::mtx/metrics]
+          :opt [::timeout
+                ::connect?
+                ::io-threads
+                ::worker-threads]))
+
+(defmethod ig/init-key ::redis
+  [_ {:keys [::connect?] :as cfg}]
+  (let [state (initialize-resources cfg)]
+    (cond-> state
+      connect? (assoc ::connection (connect* cfg {})))))
+
+(defmethod ig/halt-key! ::redis
+  [_ state]
+  (shutdown-resources state))
 
 (def default-codec
   (RedisCodec/of StringCodec/UTF8 ByteArrayCodec/INSTANCE))
@@ -77,76 +133,23 @@
 (def string-codec
   (RedisCodec/of StringCodec/UTF8 StringCodec/UTF8))
 
-(sm/register!
- {:type ::connection
-  :pred #(satisfies? IConnection %)
-  :type-properties
-  {:title "connection"
-   :description "redis connection instance"}})
-
-(sm/register!
- {:type ::pubsub-connection
-  :pred #(satisfies? IPubSubConnection %)
-  :type-properties
-  {:title "connection"
-   :description "redis connection instance"}})
-
-(defn redis?
-  [o]
-  (satisfies? IRedis o))
-
-(sm/register!
- {:type ::redis
-  :pred redis?})
-
-(def ^:private schema:script
-  [:map {:title "script"}
-   [::rscript/name qualified-keyword?]
-   [::rscript/path ::sm/text]
-   [::rscript/keys {:optional true} [:vector :any]]
-   [::rscript/vals {:optional true} [:vector :any]]])
-
-(def valid-script?
-  (sm/lazy-validator schema:script))
-
-(defmethod ig/expand-key ::redis
-  [k v]
-  (let [cpus    (px/get-available-processors)
-        threads (max 1 (int (* cpus 0.2)))]
-    {k (-> (d/without-nils v)
-           (assoc ::timeout (dt/duration "10s"))
-           (assoc ::io-threads (max 3 threads))
-           (assoc ::worker-threads (max 3 threads)))}))
-
-(def ^:private schema:redis-params
-  [:map {:title "redis-params"}
-   ::wrk/executor
-   ::mtx/metrics
-   [::uri ::sm/uri]
-   [::worker-threads ::sm/int]
-   [::io-threads ::sm/int]
-   [::timeout ::dt/duration]])
-
-(defmethod ig/assert-key ::redis
-  [_ params]
-  (assert (sm/check schema:redis-params params)))
-
-(defmethod ig/init-key ::redis
-  [_ params]
-  (initialize-resources params))
-
-(defmethod ig/halt-key! ::redis
-  [_ instance]
-  (d/close! instance))
+(defn- create-cache
+  [{:keys [::wrk/executor] :as cfg}]
+  (letfn [(on-remove [key val cause]
+            (l/trace :hint "evict connection (cache)" :key key :reason cause)
+            (some-> val d/close!))]
+    (cache/create :executor executor
+                  :on-remove on-remove
+                  :keepalive "5m")))
 
 (defn- initialize-resources
   "Initialize redis connection resources"
-  [{:keys [::uri ::io-threads ::worker-threads ::wrk/executor ::mtx/metrics] :as params}]
-
-  (l/inf :hint "initialize redis resources"
-         :uri (str uri)
-         :io-threads io-threads
-         :worker-threads worker-threads)
+  [{:keys [::uri ::io-threads ::worker-threads ::connect?] :as cfg}]
+  (l/info :hint "initialize redis resources"
+          :uri uri
+          :io-threads io-threads
+          :worker-threads worker-threads
+          :connect? connect?)
 
   (let [timer     (HashedWheelTimer.)
         resources (.. (DefaultClientResources/builder)
@@ -155,134 +158,147 @@
                       (timer ^Timer timer)
                       (build))
 
-        redis-uri (RedisURI/create ^String (str uri))
+        redis-uri (RedisURI/create ^String uri)
+        cfg       (-> cfg
+                      (assoc ::resources resources)
+                      (assoc ::timer timer)
+                      (assoc ::redis-uri redis-uri))]
 
-        shutdown  (fn [client conn]
-                    (ex/ignoring (.close ^StatefulConnection conn))
-                    (ex/ignoring (.close ^RedisClient client))
-                    (l/trc :hint "disconnect" :hid (hash client)))
+    (assoc cfg ::cache (create-cache cfg))))
 
-        on-remove (fn [key val cause]
-                    (l/trace :hint "evict connection (cache)" :key key :reason cause)
-                    (some-> val d/close!))
+(defn- shutdown-resources
+  [{:keys [::resources ::cache ::timer]}]
+  (cache/invalidate! cache)
 
-        cache     (cache/create :executor executor
-                                :on-remove on-remove
-                                :keepalive "5m")]
+  (when resources
+    (.shutdown ^ClientResources resources))
+
+  (when timer
+    (.stop ^Timer timer)))
+
+(defn connect*
+  [{:keys [::resources ::redis-uri] :as state}
+   {:keys [timeout codec type]
+    :or {codec default-codec type :default}}]
+
+  (us/assert! ::resources resources)
+  (let [client  (RedisClient/create ^ClientResources resources ^RedisURI redis-uri)
+        timeout (or timeout (::timeout state))
+        conn    (case type
+                  :default (.connect ^RedisClient client ^RedisCodec codec)
+                  :pubsub  (.connectPubSub ^RedisClient client ^RedisCodec codec))]
+
+    (l/trc :hint "connect" :hid (hash client))
+    (.setTimeout ^StatefulConnection conn ^Duration timeout)
     (reify
-      java.lang.AutoCloseable
+      IDeref
+      (deref [_] conn)
+
+      AutoCloseable
       (close [_]
-        (ex/ignoring (cache/invalidate! cache))
-        (ex/ignoring (.shutdown ^ClientResources resources))
-        (ex/ignoring (.stop ^Timer timer)))
-
-      IRedis
-      (-get-or-connect [this key options]
-        (let [create (fn [_] (-connect this options))]
-          (cache/get cache key create)))
-
-      (-connect [_ options]
-        (let [timeout (or (:timeout options) (::timeout params))
-              codec   (get options :codec default-codec)
-              type    (get options :type :default)
-              client  (RedisClient/create ^ClientResources resources
-                                          ^RedisURI redis-uri)]
-
-          (l/trc :hint "connect" :hid (hash client))
-          (if (= type :pubsub)
-            (let [conn (.connectPubSub ^RedisClient client
-                                       ^RedisCodec codec)]
-              (.setTimeout ^StatefulConnection conn
-                           ^Duration timeout)
-              (reify
-                IPubSubConnection
-                (add-listener [_ listener]
-                  (assert (instance? RedisPubSubListener listener) "expected listener instance")
-                  (.addListener ^StatefulRedisPubSubConnection conn
-                                ^RedisPubSubListener listener))
-
-                (subscribe [_ topics]
-                  (try
-                    (let [topics (into-array String (map str topics))
-                          cmd    (.sync ^StatefulRedisPubSubConnection conn)]
-                      (.subscribe ^RedisPubSubCommands cmd topics))
-                    (catch RedisCommandInterruptedException cause
-                      (throw (InterruptedException. (ex-message cause))))))
-
-                (unsubscribe [_ topics]
-                  (try
-                    (let [topics (into-array String (map str topics))
-                          cmd    (.sync ^StatefulRedisPubSubConnection conn)]
-                      (.unsubscribe ^RedisPubSubCommands cmd topics))
-                    (catch RedisCommandInterruptedException cause
-                      (throw (InterruptedException. (ex-message cause))))))
-
-
-                AutoCloseable
-                (close [_] (shutdown client conn))))
-
-            (let [conn (.connect ^RedisClient client ^RedisCodec codec)]
-              (.setTimeout ^StatefulConnection conn ^Duration timeout)
-              (reify
-                IConnection
-                (publish [_ topic message]
-                  (assert (string? topic) "expected topic to be string")
-                  (assert (bytes? message) "expected message to be a byte array")
-
-                  (let [pcomm (.async ^StatefulRedisConnection conn)]
-                    (.publish ^RedisAsyncCommands pcomm ^String topic ^bytes message)))
-
-                (rpush [_ key payload]
-                  (assert (or (and (vector? payload)
-                                   (every? bytes? payload))
-                              (bytes? payload)))
-                  (try
-                    (let [cmd  (.sync ^StatefulRedisConnection conn)
-                          data (if (vector? payload) payload [payload])
-                          vals (make-array (. Class (forName "[B")) (count data))]
-
-                      (loop [i 0 xs (seq data)]
-                        (when xs
-                          (aset ^"[[B" vals i ^bytes (first xs))
-                          (recur (inc i) (next xs))))
-
-                      (.rpush ^RedisCommands cmd
-                              ^String key
-                              ^"[[B" vals))
-
-                    (catch RedisCommandInterruptedException cause
-                      (throw (InterruptedException. (ex-message cause))))))
-
-                (blpop [_ timeout keys]
-                  (try
-                    (let [keys    (into-array Object (map str keys))
-                          cmd     (.sync ^StatefulRedisConnection conn)
-                          timeout (/ (double (inst-ms timeout)) 1000.0)]
-                      (when-let [res (.blpop ^RedisCommands cmd
-                                             ^double timeout
-                                             ^"[Ljava.lang.String;" keys)]
-                        (MapEntry/create
-                         (.getKey ^KeyValue res)
-                         (.getValue ^KeyValue res))))
-                    (catch RedisCommandInterruptedException cause
-                      (throw (InterruptedException. (ex-message cause))))))
-
-                (eval [_ script]
-                  (assert (valid-script? script) "expected valid script")
-                  (impl-eval conn metrics script))
-
-                AutoCloseable
-                (close [_] (shutdown client conn))))))))))
+        (ex/ignoring (.close ^StatefulConnection conn))
+        (ex/ignoring (.shutdown ^RedisClient client))
+        (l/trc :hint "disconnect" :hid (hash client))))))
 
 (defn connect
-  [instance & {:as opts}]
-  (assert (satisfies? IRedis instance) "expected valid redis instance")
-  (-connect instance opts))
+  [state & {:as opts}]
+  (let [connection (connect* state opts)]
+    (-> state
+        (assoc ::connection connection)
+        (dissoc ::cache)
+        (vary-meta assoc `d/close! (fn [_] (d/close! connection))))))
 
 (defn get-or-connect
-  [instance key & {:as opts}]
-  (assert (satisfies? IRedis instance) "expected valid redis instance")
-  (-get-or-connect instance key opts))
+  [{:keys [::cache] :as state} key options]
+  (us/assert! ::redis state)
+  (let [create     (fn [_] (connect* state options))
+        connection (cache/get cache key create)]
+    (-> state
+        (dissoc ::cache)
+        (assoc ::connection connection))))
+
+(defn add-listener!
+  [{:keys [::connection] :as conn} listener]
+  (us/assert! ::pubsub-connection connection)
+  (us/assert! ::pubsub-listener listener)
+  (.addListener ^StatefulRedisPubSubConnection @connection
+                ^RedisPubSubListener listener)
+  conn)
+
+(defn publish!
+  [{:keys [::connection]} topic message]
+  (us/assert! ::us/string topic)
+  (us/assert! ::us/bytes message)
+  (us/assert! ::default-connection connection)
+
+  (let [pcomm (.async ^StatefulRedisConnection @connection)]
+    (.publish ^RedisAsyncCommands pcomm ^String topic ^bytes message)))
+
+(defn subscribe!
+  "Blocking operation, intended to be used on a thread/agent thread."
+  [{:keys [::connection]} & topics]
+  (us/assert! ::pubsub-connection connection)
+  (try
+    (let [topics (into-array String (map str topics))
+          cmd    (.sync ^StatefulRedisPubSubConnection @connection)]
+      (.subscribe ^RedisPubSubCommands cmd topics))
+    (catch RedisCommandInterruptedException cause
+      (throw (InterruptedException. (ex-message cause))))))
+
+(defn unsubscribe!
+  "Blocking operation, intended to be used on a thread/agent thread."
+  [{:keys [::connection]} & topics]
+  (us/assert! ::pubsub-connection connection)
+  (try
+    (let [topics (into-array String (map str topics))
+          cmd    (.sync ^StatefulRedisPubSubConnection @connection)]
+      (.unsubscribe ^RedisPubSubCommands cmd topics))
+    (catch RedisCommandInterruptedException cause
+      (throw (InterruptedException. (ex-message cause))))))
+
+(defn rpush!
+  [{:keys [::connection]} key payload]
+  (us/assert! ::default-connection connection)
+  (us/assert! (or (and (vector? payload)
+                       (every? bytes? payload))
+                  (bytes? payload)))
+  (try
+    (let [cmd  (.sync ^StatefulRedisConnection @connection)
+          data (if (vector? payload) payload [payload])
+          vals (make-array (. Class (forName "[B")) (count data))]
+
+      (loop [i 0 xs (seq data)]
+        (when xs
+          (aset ^"[[B" vals i ^bytes (first xs))
+          (recur (inc i) (next xs))))
+
+      (.rpush ^RedisCommands cmd
+              ^String key
+              ^"[[B" vals))
+
+    (catch RedisCommandInterruptedException cause
+      (throw (InterruptedException. (ex-message cause))))))
+
+(defn blpop!
+  [{:keys [::connection]} timeout & keys]
+  (us/assert! ::default-connection connection)
+  (try
+    (let [keys    (into-array Object (map str keys))
+          cmd     (.sync ^StatefulRedisConnection @connection)
+          timeout (/ (double (inst-ms timeout)) 1000.0)]
+      (when-let [res (.blpop ^RedisCommands cmd
+                             ^double timeout
+                             ^"[Ljava.lang.String;" keys)]
+        (MapEntry/create
+         (.getKey ^KeyValue res)
+         (.getValue ^KeyValue res))))
+    (catch RedisCommandInterruptedException cause
+      (throw (InterruptedException. (ex-message cause))))))
+
+(defn open?
+  [{:keys [::connection]}]
+  (us/assert! ::pubsub-connection connection)
+  (.isOpen ^StatefulConnection @connection))
 
 (defn pubsub-listener
   [& {:keys [on-message on-subscribe on-unsubscribe]}]
@@ -312,10 +328,26 @@
         (on-unsubscribe nil topic count)))))
 
 (def ^:private scripts-cache (atom {}))
+(def noop-fn (constantly nil))
 
-(defn- impl-eval
-  [^StatefulRedisConnection connection metrics script]
-  (let [cmd   (.async ^StatefulRedisConnection connection)
+(s/def ::rscript/name qualified-keyword?)
+(s/def ::rscript/path ::us/not-empty-string)
+(s/def ::rscript/keys (s/every any? :kind vector?))
+(s/def ::rscript/vals (s/every any? :kind vector?))
+
+(s/def ::rscript/script
+  (s/keys :req [::rscript/name
+                ::rscript/path]
+          :opt [::rscript/keys
+                ::rscript/vals]))
+
+(defn eval!
+  [{:keys [::mtx/metrics ::connection] :as state} script]
+  (us/assert! ::redis state)
+  (us/assert! ::default-connection connection)
+  (us/assert! ::rscript/script script)
+
+  (let [cmd   (.async ^StatefulRedisConnection @connection)
         keys  (into-array String (map str (::rscript/keys script)))
         vals  (into-array String (map str (::rscript/vals script)))
         sname (::rscript/name script)]

backend/src/app/rpc.clj

@@ -36,8 +36,8 @@
    [cuerdas.core :as str]
    [integrant.core :as ig]
    [promesa.core :as p]
-   [yetti.request :as yreq]
-   [yetti.response :as yres]))
+   [ring.request :as rreq]
+   [ring.response :as rres]))
 
 (s/def ::profile-id ::us/uuid)
 
@@ -64,16 +64,16 @@
         response (if (fn? result)
                    (result request)
                    (let [result (rph/unwrap result)]
-                     {::yres/status  (::http/status mdata 200)
-                      ::yres/headers (::http/headers mdata {})
-                      ::yres/body    result}))]
+                     {::rres/status  (::http/status mdata 200)
+                      ::rres/headers (::http/headers mdata {})
+                      ::rres/body    result}))]
     (-> response
         (handle-response-transformation request mdata)
         (handle-before-comple-hook mdata))))
 
 (defn get-external-session-id
   [request]
-  (when-let [session-id (yreq/get-header request "x-external-session-id")]
+  (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))
@@ -81,7 +81,7 @@
 
 (defn- get-external-event-origin
   [request]
-  (when-let [origin (yreq/get-header request "x-event-origin")]
+  (when-let [origin (rreq/get-header request "x-event-origin")]
     (when-not (or (> (count origin) 256)
                   (= origin "null")
                   (str/blank? origin))
@@ -92,7 +92,7 @@
   internal async flow into ring async flow."
   [methods {:keys [params path-params method] :as request}]
   (let [handler-name (:type path-params)
-        etag         (yreq/get-header request "if-none-match")
+        etag         (rreq/get-header request "if-none-match")
         profile-id   (or (::session/profile-id request)
                          (::actoken/profile-id request))
 
@@ -149,13 +149,6 @@
                   :hint "authentication required for this endpoint")
         (f cfg params)))))
 
-(defn- wrap-db-transaction
-  [_ f mdata]
-  (if (::db/transaction mdata)
-    (fn [cfg params]
-      (db/tx-run! cfg f params))
-    f))
-
 (defn- wrap-audit
   [_ f mdata]
   (if (or (contains? cf/flags :webhooks)
@@ -203,7 +196,6 @@
 (defn- wrap-all
   [cfg f mdata]
   (as-> f $
-    (wrap-db-transaction cfg $ mdata)
     (cond/wrap cfg $ mdata)
     (retry/wrap-retry cfg $ mdata)
     (climit/wrap cfg $ mdata)
@@ -250,49 +242,39 @@
           'app.rpc.commands.projects
           'app.rpc.commands.search
           'app.rpc.commands.teams
-          'app.rpc.commands.teams-invitations
           'app.rpc.commands.verify-token
           'app.rpc.commands.viewer
           'app.rpc.commands.webhooks)
          (map (partial process-method cfg))
          (into {}))))
 
-(def ^:private schema:methods-params
-  [:map {:title "methods-params"}
-   ::session/manager
-   ::http.client/client
-   ::db/pool
-   ::mbus/msgbus
-   ::sto/storage
-   ::mtx/metrics
-   [::ldap/provider [:maybe ::ldap/provider]]
-   [::climit [:maybe ::climit]]
-   [::rlimit [:maybe ::rlimit]]
-   ::setup/props])
-
-(defmethod ig/assert-key ::methods
-  [_ params]
-  (assert (sm/check schema:methods-params params)))
+(defmethod ig/pre-init-spec ::methods [_]
+  (s/keys :req [::session/manager
+                ::http.client/client
+                ::db/pool
+                ::mbus/msgbus
+                ::ldap/provider
+                ::sto/storage
+                ::mtx/metrics
+                ::setup/props]
+          :opt [::climit
+                ::rlimit]))
 
 (defmethod ig/init-key ::methods
   [_ cfg]
   (let [cfg (d/without-nils cfg)]
     (resolve-command-methods cfg)))
 
-(def ^:private schema:methods
-  [:map-of :keyword [:tuple :map ::sm/fn]])
+(s/def ::methods
+  (s/map-of keyword? (s/tuple map? fn?)))
 
-(sm/register! ::methods schema:methods)
+(s/def ::routes vector?)
 
-(def ^:private valid-methods?
-  (sm/validator schema:methods))
-
-(defmethod ig/assert-key ::routes
-  [_ params]
-  (assert (db/pool? (::db/pool params)) "expect valid database pool")
-  (assert (some? (::setup/props params)))
-  (assert (session/manager? (::session/manager params)) "expect valid session manager")
-  (assert (valid-methods? (::methods params)) "expect valid methods map"))
+(defmethod ig/pre-init-spec ::routes [_]
+  (s/keys :req [::methods
+                ::db/pool
+                ::setup/props
+                ::session/manager]))
 
 (defmethod ig/init-key ::routes
   [_ {:keys [::methods] :as cfg}]

backend/src/app/rpc/climit.clj

@@ -10,15 +10,18 @@
   (:require
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
-   [app.common.schema :as sm]
+   [app.common.spec :as us]
+   [app.config :as cf]
    [app.metrics :as mtx]
    [app.rpc :as-alias rpc]
+   [app.rpc.climit.config :as-alias config]
    [app.util.cache :as cache]
    [app.util.services :as-alias sv]
    [app.util.time :as dt]
    [app.worker :as-alias wrk]
    [clojure.edn :as edn]
    [clojure.set :as set]
+   [clojure.spec.alpha :as s]
    [datoteka.fs :as fs]
    [integrant.core :as ig]
    [promesa.exec :as px]
@@ -29,62 +32,6 @@
 
 (set! *warn-on-reflection* true)
 
-(declare ^:private impl-invoke)
-(declare ^:private id->str)
-(declare ^:private create-cache)
-
-(defprotocol IConcurrencyLimiter
-  (^:private get-config [_ limit-id] "get a config for a key")
-  (^:private invoke [_ config handler] "invoke a handler for a config"))
-
-(sm/register!
- {:type ::rpc/climit
-  :pred #(satisfies? IConcurrencyLimiter %)})
-
-(def ^:private schema:config
-  [:map-of :keyword
-   [:map
-    [::id {:optional true} :keyword]
-    [::key {:optional true} :any]
-    [::label {:optional true} ::sm/text]
-    [::params {:optional true} :map]
-    [::permits {:optional true} ::sm/int]
-    [::queue {:optional true} ::sm/int]
-    [::timeout {:optional true} ::sm/int]]])
-
-(def ^:private check-config
-  (sm/check-fn schema:config))
-
-(def ^:private schema:climit-params
-  [:map
-   ::mtx/metrics
-   ::wrk/executor
-   [::enabled {:optional true} ::sm/boolean]
-   [::config {:optional true} ::fs/path]])
-
-(defmethod ig/assert-key ::rpc/climit
-  [_ params]
-  (assert (sm/valid? schema:climit-params params)))
-
-(defmethod ig/init-key ::rpc/climit
-  [_ {:keys [::config ::enabled ::mtx/metrics] :as cfg}]
-  (when enabled
-    (when-let [params (some->> config slurp edn/read-string check-config)]
-      (l/inf :hint "initializing concurrency limit" :config (str config))
-      (let [params (reduce-kv (fn [result k v]
-                                (assoc result k (assoc v ::id k)))
-                              params
-                              params)
-            cache  (create-cache cfg)]
-
-        (reify
-          IConcurrencyLimiter
-          (get-config [_ id]
-            (get params id))
-
-          (invoke [_ config handler]
-            (impl-invoke metrics cache config handler)))))))
-
 (defn- id->str
   ([id]
    (-> (str id)
@@ -94,23 +41,59 @@
      (str (-> (str id) (subs 1)) "/" key)
      (id->str id))))
 
+(defn- create-cache
+  [{:keys [::wrk/executor]}]
+  (letfn [(on-remove [key _ cause]
+            (let [[id skey] key]
+              (l/trc :hint "disposed" :id (id->str id skey) :reason (str cause))))]
+    (cache/create :executor executor
+                  :on-remove on-remove
+                  :keepalive "5m")))
+
+(s/def ::config/permits ::us/integer)
+(s/def ::config/queue ::us/integer)
+(s/def ::config/timeout ::us/integer)
+(s/def ::config
+  (s/map-of keyword?
+            (s/keys :opt-un [::config/permits
+                             ::config/queue
+                             ::config/timeout])))
+
+(defmethod ig/prep-key ::rpc/climit
+  [_ cfg]
+  (assoc cfg ::path (cf/get :rpc-climit-config)))
+
+(s/def ::path ::fs/path)
+(defmethod ig/pre-init-spec ::rpc/climit [_]
+  (s/keys :req [::mtx/metrics ::wrk/executor ::path]))
+
+(defmethod ig/init-key ::rpc/climit
+  [_ {:keys [::path ::mtx/metrics] :as cfg}]
+  (when (contains? cf/flags :rpc-climit)
+    (when-let [params (some->> path slurp edn/read-string)]
+      (l/inf :hint "initializing concurrency limit" :config (str path))
+      (us/verify! ::config params)
+      {::cache (create-cache cfg)
+       ::config params
+       ::mtx/metrics metrics})))
+
+(s/def ::cache cache/cache?)
+(s/def ::instance
+  (s/keys :req [::cache ::config]))
+
+(s/def ::rpc/climit
+  (s/nilable ::instance))
+
 (defn- create-limiter
-  [config id]
-  (l/trc :hint "created" :id id)
+  [config [id skey]]
+  (l/trc :hint "created" :id (id->str id skey))
   (pbh/create :permits (or (:permits config) (:concurrency config))
               :queue (or (:queue config) (:queue-size config))
               :timeout (:timeout config)
               :type :semaphore))
 
-(defn- create-cache
-  [{:keys [::wrk/executor]}]
-  (letfn [(on-remove [id _ cause]
-            (l/trc :hint "disposed" :id id :reason (str cause)))]
-    (cache/create :executor executor
-                  :on-remove on-remove
-                  :keepalive "5m")))
 
-(defn- measure
+(defn measure!
   [metrics mlabels stats elapsed]
   (let [mpermits (:max-permits stats)
         permits  (:permits stats)
@@ -134,14 +117,8 @@
                 :val (inst-ms elapsed)
                 :labels mlabels))))
 
-(defn- prepare-params-for-debug
-  [params]
-  (-> (select-keys params [::rpc/profile-id :file-id :profile-id])
-      (set/rename-keys {::rpc/profile-id :profile-id})
-      (update-vals str)))
-
-(defn- log
-  [action req-id stats limit-id limit-label limit-params elapsed]
+(defn log!
+  [action req-id stats limit-id limit-label params elapsed]
   (let [mpermits (:max-permits stats)
         queue    (:queue stats)
         queue    (- queue mpermits)
@@ -155,42 +132,37 @@
            :label limit-label
            :queue queue
            :elapsed (some-> elapsed dt/format-duration)
-           :params @limit-params)))
+           :params (-> (select-keys params [::rpc/profile-id :file-id :profile-id])
+                       (set/rename-keys {::rpc/profile-id :profile-id})
+                       (update-vals str)))))
 
 (def ^:private idseq (AtomicLong. 0))
 
-(defn- impl-invoke
-  [metrics cache config handler]
-  (let [limit-id     (::id config)
-        limit-key    (::key config)
-        limit-label  (::label config)
-        limit-params (delay
-                       (prepare-params-for-debug
-                        (::params config)))
+(defn- invoke
+  [limiter metrics limit-id limit-key limit-label handler params]
+  (let [tpoint    (dt/tpoint)
+        mlabels   (into-array String [(id->str limit-id)])
+        limit-id  (id->str limit-id limit-key)
+        stats     (pbh/get-stats limiter)
+        req-id    (.incrementAndGet ^AtomicLong idseq)]
 
-        mlabels     (into-array String [(id->str limit-id)])
-        limit-id    (id->str limit-id limit-key)
-        limiter     (cache/get cache limit-id (partial create-limiter config))
-        tpoint      (dt/tpoint)
-        req-id      (.incrementAndGet ^AtomicLong idseq)]
     (try
-      (let [stats (pbh/get-stats limiter)]
-        (measure metrics mlabels stats nil)
-        (log "enqueued" req-id stats limit-id limit-label limit-params nil))
-
+      (measure! metrics mlabels stats nil)
+      (log! "enqueued" req-id stats limit-id limit-label params nil)
       (px/invoke! limiter (fn []
                             (let [elapsed (tpoint)
                                   stats   (pbh/get-stats limiter)]
-                              (measure metrics mlabels stats elapsed)
-                              (log "acquired" req-id stats limit-id limit-label limit-params elapsed)
-                              (handler))))
+
+                              (measure! metrics mlabels stats elapsed)
+                              (log! "acquired" req-id stats limit-id limit-label params elapsed)
+
+                              (handler params))))
 
       (catch ExceptionInfo cause
         (let [{:keys [type code]} (ex-data cause)]
           (if (= :bulkhead-error type)
-            (let [elapsed (tpoint)
-                  stats   (pbh/get-stats limiter)]
-              (log "rejected" req-id stats limit-id limit-label limit-params elapsed)
+            (let [elapsed (tpoint)]
+              (log! "rejected" req-id stats limit-id limit-label params elapsed)
               (ex/raise :type :concurrency-limit
                         :code code
                         :hint "concurrency limit reached"
@@ -201,8 +173,8 @@
         (let [elapsed (tpoint)
               stats (pbh/get-stats limiter)]
 
-          (measure metrics mlabels stats nil)
-          (log "finished" req-id stats limit-id limit-label limit-params elapsed))))))
+          (measure! metrics mlabels stats nil)
+          (log! "finished" req-id stats limit-id limit-label params elapsed))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; MIDDLEWARE
@@ -232,70 +204,71 @@
       (throw (IllegalArgumentException. "unable to normalize limit")))))
 
 (defn wrap
-  [cfg handler {label ::sv/name :as mdata}]
-  (if-let [climit (::rpc/climit cfg)]
-    (reduce (fn [handler [limit-id key-fn]]
-              (if-let [config (get-config climit limit-id)]
-                (let [key-fn (or key-fn noop-fn)]
-                  (l/trc :hint "instrumenting method"
-                         :method label
-                         :limit (id->str limit-id)
-                         :timeout (:timeout config)
-                         :permits (:permits config)
-                         :queue (:queue config)
-                         :keyed (not= key-fn nil))
+  [{:keys [::rpc/climit ::mtx/metrics]} handler mdata]
+  (let [cache  (::cache climit)
+        config (::config climit)
+        label  (::sv/name mdata)]
 
-                  (if (and (= key-fn ::rpc/profile-id)
-                           (false? (::rpc/auth mdata true)))
+    (if climit
+      (reduce (fn [handler [limit-id key-fn]]
+                (if-let [config (get config limit-id)]
+                  (let [key-fn (or key-fn noop-fn)]
+                    (l/trc :hint "instrumenting method"
+                           :method label
+                           :limit (id->str limit-id)
+                           :timeout (:timeout config)
+                           :permits (:permits config)
+                           :queue (:queue config)
+                           :keyed (not= key-fn noop-fn))
 
-                    ;; We don't enforce by-profile limit on methods that does
-                    ;; not require authentication
-                    handler
+                    (if (and (= key-fn ::rpc/profile-id)
+                             (false? (::rpc/auth mdata true)))
 
-                    (fn [cfg params]
-                      (let [config (-> config
-                                       (assoc ::key (key-fn params))
-                                       (assoc ::label label)
-                                       ;; NOTE: only used for debugging output
-                                       (assoc ::params params))]
-                        (invoke climit config (partial handler cfg params))))))
+                      ;; We don't enforce by-profile limit on methods that does
+                      ;; not require authentication
+                      handler
 
-                (do
-                  (l/wrn :hint "no config found for specified queue" :id (id->str limit-id))
-                  handler)))
-            handler
-            (concat global-limits (get-limits mdata)))
+                      (fn [cfg params]
+                        (let [limit-key  (key-fn params)
+                              cache-key  [limit-id limit-key]
+                              limiter    (cache/get cache cache-key (partial create-limiter config))
+                              handler    (partial handler cfg)]
+                          (invoke limiter metrics limit-id limit-key label handler params)))))
 
-    handler))
+                  (do
+                    (l/wrn :hint "no config found for specified queue" :id (id->str limit-id))
+                    handler)))
+
+              handler
+              (concat global-limits (get-limits mdata)))
+      handler)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; PUBLIC API
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defn- build-exec-chain
-  [{:keys [::label ::rpc/climit] :as cfg} f]
-  (reduce (fn [handler [limit-id limit-key]]
-            (if-let [config (get-config climit limit-id)]
-              (let [config (-> config
-                               (assoc ::key limit-key)
-                               (assoc ::label label))]
+  [{:keys [::label ::rpc/climit ::mtx/metrics] :as cfg} f]
+  (let [config (get climit ::config)
+        cache  (get climit ::cache)]
+    (reduce (fn [handler [limit-id limit-key :as ckey]]
+              (if-let [config (get config limit-id)]
                 (fn [cfg params]
-                  (let [config (assoc config ::params params)]
-                    (invoke climit config (partial handler cfg params)))))
-              (do
-                (l/wrn :hint "config not found" :label label :id limit-id)
-                f)))
-          f
-          (get-limits cfg)))
+                  (let [limiter (cache/get cache ckey (partial create-limiter config))
+                        handler (partial handler cfg)]
+                    (invoke limiter metrics limit-id limit-key label handler params)))
+                (do
+                  (l/wrn :hint "config not found" :label label :id limit-id)
+                  f)))
+            f
+            (get-limits cfg))))
 
 (defn invoke!
   "Run a function in context of climit.
   Intended to be used in virtual threads."
-  [{:keys [::executor ::rpc/climit] :as cfg} f params]
-  (let [f (if climit
-            (let [f (if (some? executor)
-                      (fn [cfg params] (px/await! (px/submit! executor (fn [] (f cfg params)))))
-                      f)]
-              (build-exec-chain cfg f))
-            f)]
+  [{:keys [::executor] :as cfg} f params]
+  (let [f (if (some? executor)
+            (fn [cfg params] (px/await! (px/submit! executor (fn [] (f cfg params)))))
+            f)
+        f (build-exec-chain cfg f)]
     (f cfg params)))

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

@@ -30,17 +30,18 @@
                                            :tid token-id
                                            :iat created-at})
 
-        expires-at (some-> expiration dt/in-future)
-        token      (db/insert! conn :access-token
-                               {:id token-id
-                                :name name
-                                :token token
-                                :profile-id profile-id
-                                :created-at created-at
-                                :updated-at created-at
-                                :expires-at expires-at
-                                :perms (db/create-array conn "text" [])})]
-    (decode-row token)))
+        expires-at (some-> expiration dt/in-future)]
+
+    (db/insert! conn :access-token
+                {:id token-id
+                 :name name
+                 :token token
+                 :profile-id profile-id
+                 :created-at created-at
+                 :updated-at created-at
+                 :expires-at expires-at
+                 :perms (db/create-array conn "text" [])})))
+
 
 (defn repl:create-access-token
   [{:keys [::db/pool] :as system} profile-id name expiration]
@@ -59,12 +60,14 @@
 (sv/defmethod ::create-access-token
   {::doc/added "1.18"
    ::sm/params schema:create-access-token}
-  [cfg {:keys [::rpc/profile-id name expiration]}]
-
-  (quotes/check! cfg {::quotes/id ::quotes/access-tokens-per-profile
-                      ::quotes/profile-id profile-id})
-
-  (db/tx-run! cfg create-access-token profile-id name expiration))
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id name expiration]}]
+  (db/with-atomic [conn pool]
+    (let [cfg (assoc cfg ::db/conn conn)]
+      (quotes/check-quote! conn
+                           {::quotes/id ::quotes/access-tokens-per-profile
+                            ::quotes/profile-id profile-id})
+      (-> (create-access-token cfg profile-id name expiration)
+          (decode-row)))))
 
 (def ^:private schema:delete-access-token
   [:map {:title "delete-access-token"}

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

@@ -273,8 +273,7 @@
                       (merge {:viewed-tutorial? false
                               :viewed-walkthrough? false
                               :nudge {:big 10 :small 1}
-                              :v2-info-shown true
-                              :release-notes-viewed (:main cf/version)})
+                              :v2-info-shown true})
                       (db/tjson))
 
         password  (or (:password params) "!")
@@ -384,9 +383,7 @@
         invitation (when-let [token (:invitation-token params)]
                      (tokens/verify (::setup/props cfg) {:token token :iss :team-invitation}))
 
-        props      (-> (audit/profile->props profile)
-                       (assoc :from-invitation (some? invitation)))
-
+        props      (audit/profile->props profile)
 
         create-welcome-file-when-needed
         (fn []

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

@@ -8,7 +8,6 @@
   (:refer-clojure :exclude [assert])
   (:require
    [app.binfile.v1 :as bf.v1]
-   [app.binfile.v3 :as bf.v3]
    [app.common.logging :as l]
    [app.common.schema :as sm]
    [app.db :as db]
@@ -25,7 +24,7 @@
    [app.util.time :as dt]
    [app.worker :as-alias wrk]
    [promesa.exec :as px]
-   [yetti.response :as yres]))
+   [ring.response :as rres]))
 
 (set! *warn-on-reflection* true)
 
@@ -36,103 +35,51 @@
   [:map {:title "export-binfile"}
    [:name [:string {:max 250}]]
    [:file-id ::sm/uuid]
-   [:version {:optional true} ::sm/int]
-   [:include-libraries ::sm/boolean]
-   [:embed-assets ::sm/boolean]])
-
-(defn stream-export-v1
-  [cfg {:keys [file-id include-libraries embed-assets] :as params}]
-  (yres/stream-body
-   (fn [_ output-stream]
-     (try
-       (-> cfg
-           (assoc ::bf.v1/ids #{file-id})
-           (assoc ::bf.v1/embed-assets embed-assets)
-           (assoc ::bf.v1/include-libraries include-libraries)
-           (bf.v1/export-files! output-stream))
-       (catch Throwable cause
-         (l/err :hint "exception on exporting file"
-                :file-id (str file-id)
-                :cause cause))))))
-
-(defn stream-export-v3
-  [cfg {:keys [file-id include-libraries embed-assets] :as params}]
-  (yres/stream-body
-   (fn [_ output-stream]
-     (try
-       (-> cfg
-           (assoc ::bf.v3/ids #{file-id})
-           (assoc ::bf.v3/embed-assets embed-assets)
-           (assoc ::bf.v3/include-libraries include-libraries)
-           (bf.v3/export-files! output-stream))
-       (catch Throwable cause
-         (l/err :hint "exception on exporting file"
-                :file-id (str file-id)
-                :cause cause))))))
+   [:include-libraries :boolean]
+   [:embed-assets :boolean]])
 
 (sv/defmethod ::export-binfile
   "Export a penpot file in a binary format."
   {::doc/added "1.15"
    ::webhooks/event? true
    ::sm/result schema:export-binfile}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id version file-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id include-libraries embed-assets] :as params}]
   (files/check-read-permissions! pool profile-id file-id)
   (fn [_]
-    (let [version (or version 1)
-          body    (case (int version)
-                    1 (stream-export-v1 cfg params)
-                    2 (throw (ex-info "not-implemented" {}))
-                    3 (stream-export-v3 cfg params))]
-
-      {::yres/status 200
-       ::yres/headers {"content-type" "application/octet-stream"}
-       ::yres/body body})))
+    {::rres/status 200
+     ::rres/headers {"content-type" "application/octet-stream"}
+     ::rres/body (reify rres/StreamableResponseBody
+                   (-write-body-to-stream [_ _ output-stream]
+                     (try
+                       (-> cfg
+                           (assoc ::bf.v1/ids #{file-id})
+                           (assoc ::bf.v1/embed-assets embed-assets)
+                           (assoc ::bf.v1/include-libraries include-libraries)
+                           (bf.v1/export-files! output-stream))
+                       (catch Throwable cause
+                         (l/err :hint "exception on exporting file"
+                                :file-id (str file-id)
+                                :cause cause)))))}))
 
 ;; --- Command: import-binfile
 
-(defn- import-binfile-v1
-  [{:keys [::wrk/executor] :as cfg} {:keys [project-id profile-id name file]}]
-  (let [cfg (-> cfg
-                (assoc ::bf.v1/project-id project-id)
-                (assoc ::bf.v1/profile-id profile-id)
-                (assoc ::bf.v1/name name)
-                (assoc ::bf.v1/input (:path file)))]
-
-    ;; 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.
-    (px/invoke! executor (partial bf.v1/import-files! cfg))))
-
-(defn- import-binfile-v3
-  [{:keys [::wrk/executor] :as cfg} {:keys [project-id profile-id name file]}]
-  (let [cfg (-> cfg
-                (assoc ::bf.v3/project-id project-id)
-                (assoc ::bf.v3/profile-id profile-id)
-                (assoc ::bf.v3/name name)
-                (assoc ::bf.v3/input (:path file)))]
-    ;; 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.
-    (px/invoke! executor (partial bf.v3/import-files! cfg))))
-
 (defn- import-binfile
-  [{:keys [::db/pool] :as cfg} {:keys [project-id version] :as params}]
-  (let [result (case (int version)
-                 1 (import-binfile-v1 cfg params)
-                 3 (import-binfile-v3 cfg params))]
+  [{:keys [::wrk/executor ::bf.v1/project-id ::db/pool] :as cfg} input]
+  ;; 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/invoke! executor (partial bf.v1/import-files! cfg input))]
     (db/update! pool :project
                 {:modified-at (dt/now)}
                 {:id project-id})
     result))
 
-(def ^:private schema:import-binfile
+(def ^:private
+  schema:import-binfile
   [:map {:title "import-binfile"}
-   [:name [:or [:string {:max 250}]
-           [:map-of ::sm/uuid [:string {:max 250}]]]]
+   [:name [:string {:max 250}]]
    [:project-id ::sm/uuid]
-   [:version {:optional true} ::sm/int]
    [:file ::media/upload]])
 
 (sv/defmethod ::import-binfile
@@ -141,11 +88,12 @@
    ::webhooks/event? true
    ::sse/stream? true
    ::sm/params schema:import-binfile}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id project-id version] :as params}]
-  (projects/check-edition-permissions! pool profile-id project-id)
-  (let [params (-> params
-                   (assoc :profile-id profile-id)
-                   (assoc :version (or version 1)))]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id name project-id file] :as params}]
+  (projects/check-read-permissions! pool profile-id project-id)
+  (let [cfg (-> cfg
+                (assoc ::bf.v1/project-id project-id)
+                (assoc ::bf.v1/profile-id profile-id)
+                (assoc ::bf.v1/name name))]
     (with-meta
-      (sse/response (partial import-binfile cfg params))
+      (sse/response #(import-binfile cfg (:path file)))
       {::audit/props {:file nil}})))

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

@@ -71,15 +71,10 @@
   [conn comment-id & {:as opts}]
   (db/get-by-id conn :comment comment-id opts))
 
-(def ^:private sql:get-next-seqn
-  "SELECT (f.comment_thread_seqn + 1) AS next_seqn
-     FROM file AS f
-    WHERE f.id = ?
-      FOR UPDATE")
-
 (defn- get-next-seqn
   [conn file-id]
-  (let [res (db/exec-one! conn [sql:get-next-seqn file-id])]
+  (let [sql "select (f.comment_thread_seqn + 1) as next_seqn from file as f where f.id = ?"
+        res (db/exec-one! conn [sql file-id])]
     (:next-seqn res)))
 
 (def sql:upsert-comment-thread-status
@@ -309,43 +304,38 @@
    ::rtry/when rtry/conflict-exception?
    ::sm/params schema:create-comment-thread}
   [cfg {:keys [::rpc/profile-id ::rpc/request-at file-id page-id share-id position content frame-id]}]
-  (files/check-comment-permissions! cfg profile-id file-id share-id)
 
-  (let [{:keys [team-id project-id page-name]} (get-file cfg file-id page-id)]
+  (db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
+                    (files/check-comment-permissions! cfg profile-id file-id share-id)
+                    (let [{:keys [team-id project-id page-name]} (get-file conn file-id page-id)]
 
-    (-> cfg
-        (assoc ::quotes/profile-id profile-id)
-        (assoc ::quotes/team-id team-id)
-        (assoc ::quotes/project-id project-id)
-        (assoc ::quotes/file-id file-id)
-        (quotes/check! {::quotes/id ::quotes/comment-threads-per-file}
-                       {::quotes/id ::quotes/comments-per-file}))
+                      (run! (partial quotes/check-quote! cfg)
+                            (list {::quotes/id ::quotes/comment-threads-per-file
+                                   ::quotes/profile-id profile-id
+                                   ::quotes/team-id team-id
+                                   ::quotes/project-id project-id
+                                   ::quotes/file-id file-id}
+                                  {::quotes/id ::quotes/comments-per-file
+                                   ::quotes/profile-id profile-id
+                                   ::quotes/team-id team-id
+                                   ::quotes/project-id project-id
+                                   ::quotes/file-id file-id}))
 
-    (let [params {:created-at request-at
-                  :profile-id profile-id
-                  :file-id file-id
-                  :page-id page-id
-                  :page-name page-name
-                  :position position
-                  :content content
-                  :frame-id frame-id}
-          thread (db/tx-run! cfg create-comment-thread params)]
-
-      (vary-meta thread assoc ::audit/props thread))))
+                      (create-comment-thread conn {:created-at request-at
+                                                   :profile-id profile-id
+                                                   :file-id file-id
+                                                   :page-id page-id
+                                                   :page-name page-name
+                                                   :position position
+                                                   :content content
+                                                   :frame-id frame-id})))))
 
 (defn- create-comment-thread
-  [{:keys [::db/conn] :as cfg}
-   {:keys [profile-id file-id page-id page-name created-at position content frame-id]}]
-
-  (let [;; NOTE: we take the next seq number from a separate query
-        ;; because we need to lock the file for avoid race conditions
-
-        ;; FIXME: this method touches and locks the file table,which
-        ;; is already heavy-update tablel; we need to think on move
-        ;; the sequence state management to a different table or
-        ;; different storage (example: redis) for alivate the update
-        ;; pression on the file table
+  [conn {:keys [profile-id file-id page-id page-name created-at position content frame-id]}]
 
+  (let [;; NOTE: we take the next seq number from a separate query because the whole
+        ;; operation can be retried on conflict, and in this case the new seq shold be
+        ;; retrieved from the database.
         seqn      (get-next-seqn conn file-id)
         thread-id (uuid/next)
         thread    (db/insert! conn :comment-thread
@@ -374,8 +364,7 @@
     ;; Optimistic update of current seq number on file.
     (db/update! conn :file
                 {:comment-thread-seqn seqn}
-                {:id file-id}
-                {::db/return-keys false})
+                {:id file-id})
 
     (-> thread
         (select-keys [:id :file-id :page-id])
@@ -398,6 +387,7 @@
                       (files/check-comment-permissions! conn profile-id file-id share-id)
                       (upsert-comment-thread-status! conn profile-id id)))))
 
+
 ;; --- COMMAND: Update Comment Thread
 
 (def ^:private
@@ -442,11 +432,12 @@
                       {:keys [team-id project-id page-name] :as file} (get-file cfg file-id page-id)]
 
                   (files/check-comment-permissions! conn profile-id file-id share-id)
-                  (quotes/check! cfg {::quotes/id ::quotes/comments-per-file
-                                      ::quotes/profile-id profile-id
-                                      ::quotes/team-id team-id
-                                      ::quotes/project-id project-id
-                                      ::quotes/file-id file-id})
+                  (quotes/check-quote! conn
+                                       {::quotes/id ::quotes/comments-per-file
+                                        ::quotes/profile-id profile-id
+                                        ::quotes/team-id team-id
+                                        ::quotes/project-id project-id
+                                        ::quotes/file-id file-id})
 
                   ;; Update the page-name cached attribute on comment thread table.
                   (when (not= page-name (:page-name thread))

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

@@ -17,12 +17,12 @@
    [app.rpc.doc :as-alias doc]
    [app.util.services :as sv]))
 
-(declare ^:private send-user-feedback!)
+(declare ^:private send-feedback!)
 
 (def ^:private schema:send-user-feedback
   [:map {:title "send-user-feedback"}
-   [:subject [:string {:max 400}]]
-   [:content [:string {:max 2500}]]])
+   [:subject [:string {:max 250}]]
+   [:content [:string {:max 250}]]])
 
 (sv/defmethod ::send-user-feedback
   {::doc/added "1.18"
@@ -34,16 +34,14 @@
               :hint "feedback not enabled"))
 
   (let [profile (profile/get-profile pool profile-id)]
-    (send-user-feedback! pool profile params)
+    (send-feedback! pool profile params)
     nil))
 
-(defn- send-user-feedback!
+(defn- send-feedback!
   [pool profile params]
-  (let [dest (or (cf/get :user-feedback-destination)
-                 ;; LEGACY
-                 (cf/get :feedback-destination))]
+  (let [dest (cf/get :feedback-destination)]
     (eml/send! {::eml/conn pool
-                ::eml/factory eml/user-feedback
+                ::eml/factory eml/feedback
                 :from     dest
                 :to       dest
                 :profile  profile

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

@@ -17,7 +17,6 @@
    [app.common.schema.desc-js-like :as-alias smdj]
    [app.common.types.components-list :as ctkl]
    [app.common.types.file :as ctf]
-   [app.common.uri :as uri]
    [app.config :as cf]
    [app.db :as db]
    [app.db.sql :as-alias sql]
@@ -36,8 +35,7 @@
    [app.util.services :as sv]
    [app.util.time :as dt]
    [app.worker :as wrk]
-   [cuerdas.core :as str]
-   [promesa.exec :as px]))
+   [cuerdas.core :as str]))
 
 ;; --- FEATURES
 
@@ -183,7 +181,6 @@
    [:comment-thread-seqn [::sm/int {:min 0}]]
    [:name [:string {:max 250}]]
    [:revn [::sm/int {:min 0}]]
-   [:vern [::sm/int {:min 0}]]
    [:modified-at ::dt/instant]
    [:is-shared ::sm/boolean]
    [:project-id ::sm/uuid]
@@ -246,16 +243,16 @@
       file)))
 
 (defn get-file
-  [{:keys [::db/conn ::wrk/executor] :as cfg} id
-   & {:keys [project-id
-             migrate?
-             include-deleted?
-             lock-for-update?]
-      :or {include-deleted? false
-           lock-for-update? false
-           migrate? true}}]
-
-  (assert (db/connection? conn) "expected cfg with valid connection")
+  [{:keys [::db/conn] :as cfg} id & {:keys [project-id
+                                            migrate?
+                                            include-deleted?
+                                            lock-for-update?]
+                                     :or {include-deleted? false
+                                          lock-for-update? false
+                                          migrate? true}}]
+  (dm/assert!
+   "expected cfg with valid connection"
+   (db/connection-map? cfg))
 
   (let [params (merge {:id id}
                       (when (some? project-id)
@@ -264,76 +261,55 @@
                             {::db/check-deleted (not include-deleted?)
                              ::db/remove-deleted (not include-deleted?)
                              ::sql/for-update lock-for-update?})
-                    (feat.fdata/resolve-file-data cfg))
-
-        ;; NOTE: we perform the file decoding in a separate thread
-        ;; because it has heavy and synchronous operations for
-        ;; decoding file body that are not very friendly with virtual
-        ;; threads.
-        file   (px/invoke! executor #(decode-row file))]
-
+                    (feat.fdata/resolve-file-data cfg)
+                    (decode-row))]
     (if (and migrate? (fmg/need-migration? file))
       (migrate-file cfg file)
       file)))
 
 (defn get-minimal-file
   [cfg id & {:as opts}]
-  (let [opts (assoc opts ::sql/columns [:id :modified-at :deleted-at :revn :vern :data-ref-id :data-backend])]
+  (let [opts (assoc opts ::sql/columns [:id :modified-at :deleted-at :revn :data-ref-id :data-backend])]
     (db/get cfg :file {:id id} opts)))
 
-(defn- get-minimal-file-with-perms
-  [cfg {:keys [:id ::rpc/profile-id]}]
-  (let [mfile (get-minimal-file cfg id)
-        perms (get-permissions cfg profile-id id)]
-    (assoc mfile :permissions perms)))
-
 (defn get-file-etag
-  [{:keys [::rpc/profile-id]} {:keys [modified-at revn vern permissions]}]
-  (str profile-id "/" revn "/" vern "/"
-       (dt/format-instant modified-at :iso)
-       "/"
-       (uri/map->query-string permissions)))
+  [{:keys [::rpc/profile-id]} {:keys [modified-at revn]}]
+  (str profile-id (dt/format-instant modified-at :iso) revn))
 
 (sv/defmethod ::get-file
   "Retrieve a file by its ID. Only authenticated users."
   {::doc/added "1.17"
-   ::cond/get-object #(get-minimal-file-with-perms %1 %2)
+   ::cond/get-object #(get-minimal-file %1 (:id %2))
    ::cond/key-fn get-file-etag
    ::sm/params schema:get-file
-   ::sm/result schema:file-with-permissions
-   ::db/transaction true}
-  [{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id id project-id] :as params}]
-  ;; The COND middleware makes initial request for a file and
-  ;; permissions when the incoming request comes with an
-  ;; ETAG. When ETAG does not matches, the request is resolved
-  ;; and this code is executed, in this case the permissions
-  ;; will be already prefetched and we just reuse them instead
-  ;; of making an additional database queries.
-  (let [perms (or (:permissions (::cond/object params))
-                  (get-permissions conn profile-id id))]
-    (check-read-permissions! perms)
+   ::sm/result schema:file-with-permissions}
+  [cfg {:keys [::rpc/profile-id id project-id] :as params}]
+  (db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
+                    (let [perms (get-permissions conn profile-id id)]
+                      (check-read-permissions! perms)
+                      (let [team (teams/get-team conn
+                                                 :profile-id profile-id
+                                                 :project-id project-id
+                                                 :file-id id)
 
-    (let [team (teams/get-team conn
-                               :profile-id profile-id
-                               :project-id project-id
-                               :file-id id)
+                            file (-> (get-file cfg id :project-id project-id)
+                                     (assoc :permissions perms)
+                                     (check-version!))
 
-          file (-> (get-file cfg id :project-id project-id)
-                   (assoc :permissions perms)
-                   (check-version!))]
+                            _    (-> (cfeat/get-team-enabled-features cf/flags team)
+                                     (cfeat/check-client-features! (:features params))
+                                     (cfeat/check-file-features! (:features file) (:features params)))
 
-      (-> (cfeat/get-team-enabled-features cf/flags team)
-          (cfeat/check-client-features! (:features params))
-          (cfeat/check-file-features! (:features file) (:features params)))
+                            ;; This operation is needed for backward comapatibility with frontends that
+                            ;; does not support pointer-map resolution mechanism; this just resolves the
+                            ;; pointers on backend and return a complete file.
+                            file (if (and (contains? (:features file) "fdata/pointer-map")
+                                          (not (contains? (:features params) "fdata/pointer-map")))
+                                   (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)]
+                                     (update file :data feat.fdata/process-pointers deref))
+                                   file)]
 
-      ;; This operation is needed for backward comapatibility with frontends that
-      ;; does not support pointer-map resolution mechanism; this just resolves the
-      ;; pointers on backend and return a complete file.
-      (if (and (contains? (:features file) "fdata/pointer-map")
-               (not (contains? (:features params) "fdata/pointer-map")))
-        (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg id)]
-          (update file :data feat.fdata/process-pointers deref))
-        file))))
+                        (vary-meta file assoc ::cond/key (get-file-etag params file)))))))
 
 ;; --- COMMAND QUERY: get-file-fragment (by id)
 
@@ -379,9 +355,8 @@
           f.modified_at,
           f.name,
           f.revn,
-          f.vern,
           f.is_shared,
-          ft.media_id AS thumbnail_id
+          ft.media_id
      from file as f
      left join file_thumbnail as ft on (ft.file_id = f.id
                                         and ft.revn = f.revn
@@ -392,7 +367,13 @@
 
 (defn get-project-files
   [conn project-id]
-  (db/exec! conn [sql:project-files project-id]))
+  (->> (db/exec! conn [sql:project-files project-id])
+       (mapv (fn [row]
+               (if-let [media-id (:media-id row)]
+                 (-> row
+                     (dissoc :media-id)
+                     (assoc :thumbnail-uri (resolve-public-uri media-id)))
+                 (dissoc row :media-id))))))
 
 (def schema:get-project-files
   [:map {:title "get-project-files"}
@@ -529,7 +510,6 @@
 (def ^:private sql:team-shared-files
   "select f.id,
           f.revn,
-          f.vern,
           f.data,
           f.project_id,
           f.created_at,
@@ -613,7 +593,6 @@
           l.deleted_at,
           l.name,
           l.revn,
-          l.vern,
           l.synced_at
      FROM libs AS l
     WHERE l.deleted_at IS NULL OR l.deleted_at > now();")
@@ -675,7 +654,6 @@
   "with recent_files as (
      select f.id,
             f.revn,
-            f.vern,
             f.project_id,
             f.created_at,
             f.modified_at,
@@ -698,7 +676,11 @@
 
 (defn get-team-recent-files
   [conn team-id]
-  (db/exec! conn [sql:team-recent-files team-id]))
+  (->> (db/exec! conn [sql:team-recent-files team-id])
+       (mapv (fn [row]
+               (if-let [media-id (:thumbnail-id row)]
+                 (assoc row :thumbnail-uri (resolve-public-uri media-id))
+                 (dissoc row :media-id))))))
 
 (def ^:private schema:get-team-recent-files
   [:map {:title "get-team-recent-files"}

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

@@ -98,50 +98,46 @@
   {::doc/added "1.17"
    ::doc/module :files
    ::webhooks/event? true
-   ::sm/params schema:create-file
-   ::db/transaction true}
-  [{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id project-id] :as params}]
-  (projects/check-edition-permissions! conn profile-id project-id)
-  (let [team     (teams/get-team conn
-                                 :profile-id profile-id
-                                 :project-id project-id)
-        team-id  (:id team)
+   ::sm/params schema:create-file}
+  [cfg {:keys [::rpc/profile-id project-id] :as params}]
+  (db/tx-run! cfg
+              (fn [{:keys [::db/conn] :as cfg}]
+                (projects/check-edition-permissions! conn profile-id project-id)
+                (let [team     (teams/get-team conn
+                                               :profile-id profile-id
+                                               :project-id project-id)
+                      team-id  (:id team)
 
-        ;; When we create files, we only need to respect the team
-        ;; features, because some features can be enabled
-        ;; globally, but the team is still not migrated properly.
-        features (-> (cfeat/get-team-enabled-features cf/flags team)
-                     (cfeat/check-client-features! (:features params)))
+                      ;; When we create files, we only need to respect the team
+                      ;; features, because some features can be enabled
+                      ;; globally, but the team is still not migrated properly.
+                      features (-> (cfeat/get-team-enabled-features cf/flags team)
+                                   (cfeat/check-client-features! (:features params)))
 
-        ;; We also include all no migration features declared by
-        ;; client; that enables the ability to enable a runtime
-        ;; feature on frontend and make it permanent on file
-        features (-> (:features params #{})
-                     (set/intersection cfeat/no-migration-features)
-                     (set/difference cfeat/frontend-only-features)
-                     (set/union features))
+                      ;; We also include all no migration features declared by
+                      ;; client; that enables the ability to enable a runtime
+                      ;; feature on frontend and make it permanent on file
+                      features (-> (:features params #{})
+                                   (set/intersection cfeat/no-migration-features)
+                                   (set/union features))
 
-        params   (-> params
-                     (assoc :profile-id profile-id)
-                     (assoc :features (set/difference features cfeat/frontend-only-features)))]
+                      params   (-> params
+                                   (assoc :profile-id profile-id)
+                                   (assoc :features features))]
 
-    (quotes/check! cfg {::quotes/id ::quotes/files-per-project
-                        ::quotes/team-id team-id
-                        ::quotes/profile-id profile-id
-                        ::quotes/project-id project-id})
+                  (run! (partial quotes/check-quote! conn)
+                        (list {::quotes/id ::quotes/files-per-project
+                               ::quotes/team-id team-id
+                               ::quotes/profile-id profile-id
+                               ::quotes/project-id project-id}))
 
-    ;; FIXME: IMPORTANT: this code can have race
-    ;; conditions, because we have no locks for updating
-    ;; team so, creating two files concurrently can lead
-    ;; to lost team features updating
+                  ;; When newly computed features does not match exactly with
+                  ;; the features defined on team row, we update it.
+                  (when (not= features (:features team))
+                    (let [features (db/create-array conn "text" features)]
+                      (db/update! conn :team
+                                  {:features features}
+                                  {:id team-id})))
 
-    ;; When newly computed features does not match exactly with
-    ;; the features defined on team row, we update it.
-    (when (not= features (:features team))
-      (let [features (db/create-array conn "text" features)]
-        (db/update! conn :team
-                    {:features features}
-                    {:id team-id})))
-
-    (-> (create-file cfg params)
-        (vary-meta assoc ::audit/props {:team-id team-id}))))
+                  (-> (create-file cfg params)
+                      (vary-meta assoc ::audit/props {:team-id team-id}))))))

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

@@ -15,11 +15,10 @@
    [app.db.sql :as-alias sql]
    [app.features.fdata :as feat.fdata]
    [app.main :as-alias main]
-   [app.msgbus :as mbus]
    [app.rpc :as-alias rpc]
    [app.rpc.commands.files :as files]
+   [app.rpc.commands.profile :as profile]
    [app.rpc.doc :as-alias doc]
-   [app.rpc.quotes :as quotes]
    [app.storage :as sto]
    [app.util.blob :as blob]
    [app.util.pointer-map :as pmap]
@@ -27,58 +26,173 @@
    [app.util.time :as dt]
    [cuerdas.core :as str]))
 
+(defn check-authorized!
+  [{:keys [::db/pool]} profile-id]
+  (when-not (or (= "devenv" (cf/get :host))
+                (let [profile (ex/ignoring (profile/get-profile pool profile-id))
+                      admins  (or (cf/get :admins) #{})]
+                  (contains? admins (:email profile))))
+    (ex/raise :type :authentication
+              :code :authentication-required
+              :hint "only admins allowed")))
+
 (def sql:get-file-snapshots
-  "WITH changes AS (
-      SELECT id, label, revn, created_at, created_by, profile_id
-        FROM file_change
-       WHERE file_id = ?
-         AND data IS NOT NULL
-         AND (deleted_at IS NULL OR deleted_at > now())
-   ), versions AS (
-      (SELECT * FROM changes WHERE created_by = 'system' LIMIT 1000)
-      UNION ALL
-      (SELECT * FROM changes WHERE created_by != 'system' LIMIT 1000)
-   )
-   SELECT * FROM versions
-    ORDER BY created_at DESC;")
+  "SELECT id, label, revn, created_at
+     FROM file_change
+    WHERE file_id = ?
+      AND created_at < ?
+      AND label IS NOT NULL
+    ORDER BY created_at DESC
+    LIMIT ?")
 
 (defn get-file-snapshots
-  [conn file-id]
-  (db/exec! conn [sql:get-file-snapshots file-id]))
+  [{:keys [::db/conn]} {:keys [file-id limit start-at]
+                        :or {limit Long/MAX_VALUE}}]
+  (let [start-at (or start-at (dt/now))
+        limit    (min limit 20)]
+    (->> (db/exec! conn [sql:get-file-snapshots file-id start-at limit])
+         (mapv (fn [row]
+                 (update row :created-at dt/format-instant :rfc1123))))))
 
 (def ^:private schema:get-file-snapshots
-  [:map {:title "get-file-snapshots"}
-   [:file-id ::sm/uuid]])
+  [:map [:file-id ::sm/uuid]])
 
 (sv/defmethod ::get-file-snapshots
   {::doc/added "1.20"
+   ::doc/skip true
    ::sm/params schema:get-file-snapshots}
-  [cfg {:keys [::rpc/profile-id file-id] :as params}]
-  (db/run! cfg (fn [{:keys [::db/conn]}]
-                 (files/check-read-permissions! conn profile-id file-id)
-                 (get-file-snapshots conn file-id))))
+  [cfg {:keys [::rpc/profile-id] :as params}]
+  (check-authorized! cfg profile-id)
+  (db/run! cfg get-file-snapshots params))
 
-(def ^:private sql:get-file
-  "SELECT f.*,
-          p.id AS project_id,
-          p.team_id AS team_id
-     FROM file AS f
-    INNER JOIN project AS p ON (p.id = f.project_id)
-    WHERE f.id = ?")
+(defn restore-file-snapshot!
+  [{:keys [::db/conn] :as cfg} {:keys [file-id id]}]
+  (let [storage  (sto/resolve cfg {::db/reuse-conn true})
+        file     (files/get-minimal-file conn file-id {::db/for-update true})
+        snapshot (db/get* conn :file-change
+                          {:file-id file-id
+                           :id id}
+                          {::db/for-share true})]
+
+    (when-not snapshot
+      (ex/raise :type :not-found
+                :code :snapshot-not-found
+                :hint "unable to find snapshot with the provided label"
+                :id id
+                :file-id file-id))
+
+    (let [snapshot (feat.fdata/resolve-file-data cfg snapshot)]
+      (when-not (:data snapshot)
+        (ex/raise :type :precondition
+                  :code :snapshot-without-data
+                  :hint "snapshot has no data"
+                  :label (:label snapshot)
+                  :file-id file-id))
+
+      (l/dbg :hint "restoring snapshot"
+             :file-id (str file-id)
+             :label (:label snapshot)
+             :snapshot-id (str (:id snapshot)))
+
+      ;; If the file was already offloaded, on restring the snapshot
+      ;; we are going to replace the file data, so we need to touch
+      ;; the old referenced storage object and avoid possible leaks
+      (when (feat.fdata/offloaded? file)
+        (sto/touch-object! storage (:data-ref-id file)))
+
+      (db/update! conn :file
+                  {:data (:data snapshot)
+                   :revn (inc (:revn file))
+                   :version (:version snapshot)
+                   :data-backend nil
+                   :data-ref-id nil
+                   :has-media-trimmed false
+                   :features (:features snapshot)}
+                  {:id file-id})
+
+      ;; clean object thumbnails
+      (let [sql (str "update file_tagged_object_thumbnail "
+                     "   set deleted_at = now() "
+                     " where file_id=? returning media_id")
+            res (db/exec! conn [sql file-id])]
+        (doseq [media-id (into #{} (keep :media-id) res)]
+          (sto/touch-object! storage media-id)))
+
+      ;; clean file thumbnails
+      (let [sql (str "update file_thumbnail "
+                     "   set deleted_at = now() "
+                     " where file_id=? returning media_id")
+            res (db/exec! conn [sql file-id])]
+        (doseq [media-id (into #{} (keep :media-id) res)]
+          (sto/touch-object! storage media-id)))
+
+      {:id (:id snapshot)
+       :label (:label snapshot)})))
+
+(defn- resolve-snapshot-by-label
+  [conn file-id label]
+  (->> (db/query conn :file-change
+                 {:file-id file-id
+                  :label label}
+                 {::sql/order-by [[:created-at :desc]]
+                  ::sql/columns [:file-id :id :label]})
+       (first)))
+
+(def ^:private
+  schema:restore-file-snapshot
+  [:and
+   [:map
+    [:file-id ::sm/uuid]
+    [:id {:optional true} ::sm/uuid]
+    [:label {:optional true} :string]]
+   [::sm/contains-any #{:id :label}]])
+
+(sv/defmethod ::restore-file-snapshot
+  {::doc/added "1.20"
+   ::doc/skip true
+   ::sm/params schema:restore-file-snapshot}
+  [cfg {:keys [::rpc/profile-id file-id id label] :as params}]
+  (check-authorized! cfg profile-id)
+  (db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
+                    (let [params (cond-> params
+                                   (and (not id) (string? label))
+                                   (merge (resolve-snapshot-by-label conn file-id label)))]
+                      (restore-file-snapshot! cfg params)))))
 
 (defn- get-file
   [cfg file-id]
-  (let [file (->> (db/exec-one! cfg [sql:get-file file-id])
+  (let [file (->> (db/get cfg :file {:id file-id})
                   (feat.fdata/resolve-file-data cfg))]
     (binding [pmap/*load-fn* (partial feat.fdata/load-pointer cfg file-id)]
       (-> file
           (update :data blob/decode)
           (update :data feat.fdata/process-pointers deref)
           (update :data feat.fdata/process-objects (partial into {}))
-          (update :data assoc ::id file-id)
           (update :data blob/encode)))))
 
-(defn- generate-snapshot-label
+(defn take-file-snapshot!
+  [cfg {:keys [file-id label ::rpc/profile-id]}]
+  (let [file  (get-file cfg file-id)
+        id    (uuid/next)]
+
+    (l/debug :hint "creating file snapshot"
+             :file-id (str file-id)
+             :label label)
+
+    (db/insert! cfg :file-change
+                {:id id
+                 :revn (:revn file)
+                 :data (:data file)
+                 :version (:version file)
+                 :features (:features file)
+                 :profile-id profile-id
+                 :file-id (:id file)
+                 :label label}
+                {::db/return-keys false})
+
+    {:id id :label label}))
+
+(defn generate-snapshot-label
   []
   (let [ts (-> (dt/now)
                (dt/format-instant)
@@ -86,218 +200,17 @@
                (str/rtrim "Z"))]
     (str "snapshot-" ts)))
 
-(defn create-file-snapshot!
-  [cfg profile-id file-id label]
-  (let [file (get-file cfg file-id)
+(def ^:private schema:take-file-snapshot
+  [:map [:file-id ::sm/uuid]])
 
-        ;; NOTE: final user never can provide label as `:system`
-        ;; keyword because the validator implies label always as
-        ;; string; keyword is used for signal a special case
-        created-by
-        (if (= label :system)
-          "system"
-          "user")
-
-        deleted-at
-        (if (= label :system)
-          (dt/plus (dt/now) (cf/get-deletion-delay))
-          nil)
-
-        label
-        (if (= label :system)
-          (str "internal/snapshot/" (:revn file))
-          (or label (generate-snapshot-label)))
-
-        snapshot-id
-        (uuid/next)]
-
-    (-> cfg
-        (assoc ::quotes/profile-id profile-id)
-        (assoc ::quotes/project-id (:project-id file))
-        (assoc ::quotes/team-id (:team-id file))
-        (assoc ::quotes/file-id (:id file))
-        (quotes/check! {::quotes/id ::quotes/snapshots-per-file}
-                       {::quotes/id ::quotes/snapshots-per-team}))
-
-    (l/debug :hint "creating file snapshot"
-             :file-id (str file-id)
-             :id (str snapshot-id)
-             :label label)
-
-    (db/insert! cfg :file-change
-                {:id snapshot-id
-                 :revn (:revn file)
-                 :data (:data file)
-                 :version (:version file)
-                 :features (:features file)
-                 :profile-id profile-id
-                 :file-id (:id file)
-                 :label label
-                 :deleted-at deleted-at
-                 :created-by created-by}
-                {::db/return-keys false})
-
-    {:id snapshot-id :label label}))
-
-(def ^:private schema:create-file-snapshot
-  [:map
-   [:file-id ::sm/uuid]
-   [:label {:optional true} :string]])
-
-(sv/defmethod ::create-file-snapshot
+(sv/defmethod ::take-file-snapshot
   {::doc/added "1.20"
-   ::sm/params schema:create-file-snapshot}
-  [cfg {:keys [::rpc/profile-id file-id label]}]
-  (db/tx-run! cfg
-              (fn [{:keys [::db/conn] :as cfg}]
-                (files/check-edition-permissions! conn profile-id file-id)
-                (create-file-snapshot! cfg profile-id file-id label))))
+   ::doc/skip true
+   ::sm/params schema:take-file-snapshot}
+  [cfg {:keys [::rpc/profile-id] :as params}]
+  (check-authorized! cfg profile-id)
+  (db/tx-run! cfg (fn [cfg]
+                    (let [params (update params :label (fn [label]
+                                                         (or label (generate-snapshot-label))))]
+                      (take-file-snapshot! cfg params)))))
 
-(defn restore-file-snapshot!
-  [{:keys [::db/conn ::mbus/msgbus] :as cfg} file-id snapshot-id]
-  (let [storage  (sto/resolve cfg {::db/reuse-conn true})
-        file     (files/get-minimal-file conn file-id {::db/for-update true})
-        vern     (rand-int Integer/MAX_VALUE)
-        snapshot (some->> (db/get* conn :file-change
-                                   {:file-id file-id
-                                    :id snapshot-id}
-                                   {::db/for-share true})
-                          (feat.fdata/resolve-file-data cfg))]
-
-    (when-not snapshot
-      (ex/raise :type :not-found
-                :code :snapshot-not-found
-                :hint "unable to find snapshot with the provided label"
-                :snapshot-id snapshot-id
-                :file-id file-id))
-
-    (when-not (:data snapshot)
-      (ex/raise :type :validation
-                :code :snapshot-without-data
-                :hint "snapshot has no data"
-                :label (:label snapshot)
-                :file-id file-id))
-
-    (l/dbg :hint "restoring snapshot"
-           :file-id (str file-id)
-           :label (:label snapshot)
-           :snapshot-id (str (:id snapshot)))
-
-    ;; If the file was already offloaded, on restring the snapshot
-    ;; we are going to replace the file data, so we need to touch
-    ;; the old referenced storage object and avoid possible leaks
-    (when (feat.fdata/offloaded? file)
-      (sto/touch-object! storage (:data-ref-id file)))
-
-    (db/update! conn :file
-                {:data (:data snapshot)
-                 :revn (inc (:revn file))
-                 :vern vern
-                 :version (:version snapshot)
-                 :data-backend nil
-                 :data-ref-id nil
-                 :has-media-trimmed false
-                 :features (:features snapshot)}
-                {:id file-id})
-
-    ;; clean object thumbnails
-    (let [sql (str "update file_tagged_object_thumbnail "
-                   "   set deleted_at = now() "
-                   " where file_id=? returning media_id")
-          res (db/exec! conn [sql file-id])]
-      (doseq [media-id (into #{} (keep :media-id) res)]
-        (sto/touch-object! storage media-id)))
-
-    ;; clean file thumbnails
-    (let [sql (str "update file_thumbnail "
-                   "   set deleted_at = now() "
-                   " where file_id=? returning media_id")
-          res (db/exec! conn [sql file-id])]
-      (doseq [media-id (into #{} (keep :media-id) res)]
-        (sto/touch-object! storage media-id)))
-
-    ;; Send to the clients a notification to reload the file
-    (mbus/pub! msgbus
-               :topic (:id file)
-               :message {:type :file-restore
-                         :file-id (:id file)
-                         :vern vern})
-    {:id (:id snapshot)
-     :label (:label snapshot)}))
-
-(def ^:private schema:restore-file-snapshot
-  [:map {:title "restore-file-snapshot"}
-   [:file-id ::sm/uuid]
-   [:id ::sm/uuid]])
-
-(sv/defmethod ::restore-file-snapshot
-  {::doc/added "1.20"
-   ::sm/params schema:restore-file-snapshot}
-  [cfg {:keys [::rpc/profile-id file-id id] :as params}]
-  (db/tx-run! cfg
-              (fn [{:keys [::db/conn] :as cfg}]
-                (files/check-edition-permissions! conn profile-id file-id)
-                (create-file-snapshot! cfg profile-id file-id :system)
-                (restore-file-snapshot! cfg file-id id))))
-
-(def ^:private schema:update-file-snapshot
-  [:map {:title "update-file-snapshot"}
-   [:id ::sm/uuid]
-   [:label ::sm/text]])
-
-(defn- update-file-snapshot!
-  [conn snapshot-id label]
-  (-> (db/update! conn :file-change
-                  {:label label
-                   :created-by "user"
-                   :deleted-at nil}
-                  {:id snapshot-id}
-                  {::db/return-keys true})
-      (dissoc :data :features)))
-
-(defn- get-snapshot
-  "Get a minimal snapshot from database and lock for update"
-  [conn id]
-  (db/get conn :file-change
-          {:id id}
-          {::sql/columns [:id :file-id :created-by :deleted-at]
-           ::db/for-update true}))
-
-(sv/defmethod ::update-file-snapshot
-  {::doc/added "1.20"
-   ::sm/params schema:update-file-snapshot}
-  [cfg {:keys [::rpc/profile-id id label]}]
-  (db/tx-run! cfg
-              (fn [{:keys [::db/conn]}]
-                (let [snapshot (get-snapshot conn id)]
-                  (files/check-edition-permissions! conn profile-id (:file-id snapshot))
-                  (update-file-snapshot! conn id label)))))
-
-(def ^:private schema:remove-file-snapshot
-  [:map {:title "remove-file-snapshot"}
-   [:id ::sm/uuid]])
-
-(defn- delete-file-snapshot!
-  [conn snapshot-id]
-  (db/update! conn :file-change
-              {:deleted-at (dt/now)}
-              {:id snapshot-id}
-              {::db/return-keys false})
-  nil)
-
-(sv/defmethod ::delete-file-snapshot
-  {::doc/added "1.20"
-   ::sm/params schema:remove-file-snapshot}
-  [cfg {:keys [::rpc/profile-id id]}]
-  (db/tx-run! cfg
-              (fn [{:keys [::db/conn]}]
-                (let [snapshot (get-snapshot conn id)]
-                  (files/check-edition-permissions! conn profile-id (:file-id snapshot))
-
-                  (when (not= (:created-by snapshot) "user")
-                    (ex/raise :type :validation
-                              :code :system-snapshots-cant-be-deleted
-                              :snapshot-id id
-                              :profile-id profile-id))
-
-                  (delete-file-snapshot! conn id)))))

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

@@ -45,38 +45,37 @@
 (sv/defmethod ::create-temp-file
   {::doc/added "1.17"
    ::doc/module :files
-   ::sm/params schema:create-temp-file
-   ::db/transaction true}
-  [{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id project-id] :as params}]
-  (projects/check-edition-permissions! conn profile-id project-id)
-  (let [team (teams/get-team conn :profile-id profile-id :project-id project-id)
-        ;; When we create files, we only need to respect the team
-        ;; features, because some features can be enabled
-        ;; globally, but the team is still not migrated properly.
-        input-features
-        (:features params #{})
+   ::sm/params schema:create-temp-file}
+  [cfg {:keys [::rpc/profile-id project-id] :as params}]
+  (db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
+                    (projects/check-edition-permissions! conn profile-id project-id)
+                    (let [team     (teams/get-team conn :profile-id profile-id :project-id project-id)
 
-        ;; If the imported project doesn't contain v2 we need to remove it
-        team-features
-        (cond-> (cfeat/get-team-enabled-features cf/flags team)
-          (not (contains? input-features "components/v2"))
-          (disj "components/v2"))
+                          ;; When we create files, we only need to respect the team
+                          ;; features, because some features can be enabled
+                          ;; globally, but the team is still not migrated properly.
+                          input-features (:features params #{})
 
-        ;; We also include all no migration features declared by
-        ;; client; that enables the ability to enable a runtime
-        ;; feature on frontend and make it permanent on file
-        features
-        (-> input-features
-            (set/intersection cfeat/no-migration-features)
-            (set/union team-features))
+                          ;; If the imported project doesn't contain v2 we need to remove it
+                          team-features
+                          (cond-> (cfeat/get-team-enabled-features cf/flags team)
+                            (not (contains? input-features "components/v2"))
+                            (disj "components/v2"))
 
-        params
-        (-> params
-            (assoc :profile-id profile-id)
-            (assoc :deleted-at (dt/in-future {:days 1}))
-            (assoc :features features))]
 
-    (files.create/create-file cfg params)))
+                          ;; We also include all no migration features declared by
+                          ;; client; that enables the ability to enable a runtime
+                          ;; feature on frontend and make it permanent on file
+                          features (-> input-features
+                                       (set/intersection cfeat/no-migration-features)
+                                       (set/union team-features))
+
+                          params   (-> params
+                                       (assoc :profile-id profile-id)
+                                       (assoc :deleted-at (dt/in-future {:days 1}))
+                                       (assoc :features features))]
+
+                      (files.create/create-file cfg params)))))
 
 ;; --- MUTATION COMMAND: update-temp-file
 

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

@@ -50,7 +50,8 @@
              " where file_id=? and tag=? and deleted_at is null")
         res (db/exec! conn [sql file-id tag])]
     (->> res
-         (d/index-by :object-id :media-id)
+         (d/index-by :object-id (fn [row]
+                                  (files/resolve-public-uri (:media-id row))))
          (d/without-nils))))
 
 (defn- get-object-thumbnails
@@ -61,7 +62,8 @@
               " where file_id=? and deleted_at is null")
          res (db/exec! conn [sql file-id])]
      (->> res
-          (d/index-by :object-id :media-id)
+          (d/index-by :object-id (fn [row]
+                                   (files/resolve-public-uri (:media-id row))))
           (d/without-nils))))
 
   ([conn file-id object-ids]
@@ -73,7 +75,8 @@
          res (db/exec! conn [sql file-id ids])]
 
      (->> res
-          (d/index-by :object-id :media-id)
+          (d/index-by :object-id (fn [row]
+                                   (files/resolve-public-uri (:media-id row))))
           (d/without-nils)))))
 
 (sv/defmethod ::get-file-object-thumbnails
@@ -124,11 +127,8 @@
               (if-let [frame  (-> frames first)]
                 (let [frame-id  (:id frame)
                       object-id (thc/fmt-object-id (:id file) page-id frame-id "frame")
-
-                      frame     (if-let [media-id (get thumbnails object-id)]
-                                  (-> frame
-                                      (assoc :thumbnail-id media-id)
-                                      (assoc :shapes []))
+                      frame     (if-let [thumb (get thumbnails object-id)]
+                                  (assoc frame :thumbnail thumb :shapes [])
                                   (dissoc frame :thumbnail))
 
                       children-ids
@@ -402,10 +402,7 @@
 
   [cfg {:keys [::rpc/profile-id file-id] :as params}]
   (db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
-                    ;; TODO For now we check read permissions instead of write,
-                    ;; to allow viewer users to update thumbnails. We might
-                    ;; review this approach on the future.
-                    (files/check-read-permissions! conn profile-id file-id)
+                    (files/check-edition-permissions! conn profile-id file-id)
                     (when-not (db/read-only? conn)
                       (let [media (create-file-thumbnail! cfg params)]
                         {:uri (files/resolve-public-uri (:id media))

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

@@ -34,7 +34,7 @@
    [app.util.pointer-map :as pmap]
    [app.util.services :as sv]
    [app.util.time :as dt]
-   [app.worker :as wrk]
+   [app.worker :as-alias wrk]
    [clojure.set :as set]
    [promesa.exec :as px]))
 
@@ -44,6 +44,7 @@
 (declare ^:private update-file*)
 (declare ^:private process-changes-and-validate)
 (declare ^:private take-snapshot?)
+(declare ^:private delete-old-snapshots!)
 
 ;; PUBLIC API; intended to be used outside of this module
 (declare update-file!)
@@ -59,7 +60,6 @@
    [:id ::sm/uuid]
    [:session-id ::sm/uuid]
    [:revn {:min 0} ::sm/int]
-   [:vern {:min 0} ::sm/int]
    [:features {:optional true} ::cfeat/features]
    [:changes {:optional true} [:vector ::cpc/change]]
    [:changes-with-metadata {:optional true}
@@ -147,7 +147,7 @@
 
                           params   (-> params
                                        (assoc :profile-id profile-id)
-                                       (assoc :features (set/difference features cfeat/frontend-only-features))
+                                       (assoc :features features)
                                        (assoc :team team)
                                        (assoc :file file)
                                        (assoc :changes changes))
@@ -157,14 +157,6 @@
                           tpoint   (dt/tpoint)]
 
 
-                      (when (not= (:vern params)
-                                  (:vern file))
-                        (ex/raise :type :validation
-                                  :code :vern-conflict
-                                  :hint "A different version has been restored for the file."
-                                  :context {:incoming-revn (:revn params)
-                                            :stored-revn (:revn file)}))
-
                       (when (> (:revn params)
                                (:revn file))
                         (ex/raise :type :validation
@@ -223,25 +215,23 @@
       (let [storage (sto/resolve cfg ::db/reuse-conn true)]
         (some->> (:data-ref-id file) (sto/touch-object! storage))))
 
+    ;; TODO: move this to asynchronous task
+    (when (::snapshot-data file)
+      (delete-old-snapshots! cfg file))
+
     (persist-file! cfg file)
 
     (let [params   (assoc params :file file)
           response {:revn (:revn file)
                     :lagged (get-lagged-changes conn params)}
-          features (db/create-array conn "text" (:features file))
-          deleted-at (if (::snapshot-data file)
-                       (dt/plus timestamp (cf/get-deletion-delay))
-                       (dt/plus timestamp (dt/duration {:hours 1})))]
+          features (db/create-array conn "text" (:features file))]
 
-      ;; Insert change (xlog) with deleted_at in a future data for
-      ;; make them automatically eleggible for GC once they expires
+      ;; Insert change (xlog)
       (db/insert! conn :file-change
                   {:id (uuid/next)
                    :session-id session-id
                    :profile-id profile-id
                    :created-at timestamp
-                   :updated-at timestamp
-                   :deleted-at deleted-at
                    :file-id (:id file)
                    :revn (:revn file)
                    :version (:version file)
@@ -459,6 +449,33 @@
           (> (inst-ms (dt/diff modified-at (dt/now)))
              (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 LIKE 'internal/%'
+      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 :auto-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
   "select s.id, s.revn, s.file_id,
           s.session_id, s.changes
@@ -485,7 +502,6 @@
                          :file-id (:id file)
                          :session-id (:session-id params)
                          :revn (:revn file)
-                         :vern (:vern file)
                          :changes changes})
 
     (when (and (:is-shared file) (seq lchanges))

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

@@ -86,9 +86,6 @@
    [:font-weight [::sm/one-of {:format "number"} valid-weight]]
    [:font-style [::sm/one-of {:format "string"} valid-style]]])
 
-;; FIXME: IMPORTANT: refactor this, we should not hold a whole db
-;; connection around the font creation
-
 (sv/defmethod ::create-font-variant
   {::doc/added "1.18"
    ::climit/id [[:process-font/by-profile ::rpc/profile-id]
@@ -99,9 +96,9 @@
   (db/tx-run! cfg
               (fn [{:keys [::db/conn] :as cfg}]
                 (teams/check-edition-permissions! conn profile-id team-id)
-                (quotes/check! cfg {::quotes/id ::quotes/font-variants-per-team
-                                    ::quotes/profile-id profile-id
-                                    ::quotes/team-id team-id})
+                (quotes/check-quote! conn {::quotes/id ::quotes/font-variants-per-team
+                                           ::quotes/profile-id profile-id
+                                           ::quotes/team-id team-id})
                 (create-font-variant cfg (assoc params :profile-id profile-id)))))
 
 (defn create-font-variant

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

@@ -176,7 +176,7 @@
 
   (binding [bfc/*state* (volatile! {:index {team-id (uuid/next)}})]
     (let [projs (bfc/get-team-projects cfg team-id)
-          files (bfc/get-team-files-ids cfg team-id)
+          files (bfc/get-team-files cfg team-id)
           frels (bfc/get-files-rels cfg files)
 
           team  (-> (db/get-by-id conn :team team-id)
@@ -326,7 +326,7 @@
 (def ^:private
   schema:move-files
   [:map {:title "move-files"}
-   [:ids [::sm/set {:min 1} ::sm/uuid]]
+   [:ids ::sm/set-of-uuid]
    [:project-id ::sm/uuid]])
 
 (sv/defmethod ::move-files
@@ -335,7 +335,7 @@
    ::webhooks/event? true
    ::sm/params schema:move-files}
   [cfg {:keys [::rpc/profile-id] :as params}]
-  (db/tx-run! cfg move-files (assoc params :profile-id profile-id)))
+  (db/tx-run! cfg #(move-files % (assoc params :profile-id profile-id))))
 
 ;; --- COMMAND: Move project
 
@@ -396,15 +396,14 @@
 (defn clone-template
   [cfg {:keys [project-id profile-id] :as params} template]
   (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.
+                    ;; 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 [cfg    (-> cfg
                                      (assoc ::bf.v1/project-id project-id)
-                                     (assoc ::bf.v1/profile-id profile-id)
-                                     (assoc ::bf.v1/input template))
-                          result (px/invoke! executor (partial bf.v1/import-files! cfg))]
+                                     (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)}

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

@@ -60,25 +60,15 @@
   (media/validate-media-type! content)
   (media/validate-media-size! content)
 
-  (db/run! cfg (fn [{:keys [::db/conn] :as cfg}]
-                 ;; We get the minimal file for proper checking if
-                 ;; file is not already deleted
-                 (let [_     (files/get-minimal-file conn file-id)
-                       mobj  (create-file-media-object cfg params)]
-
-                   (db/update! conn :file
-                               {:modified-at (dt/now)
-                                :has-media-trimmed false}
-                               {:id file-id}
-                               {::db/return-keys false})
-
-                   (with-meta mobj
-                     {::audit/replace-props
-                      {:name (:name params)
-                       :file-id file-id
-                       :is-local (:is-local params)
-                       :size (:size content)
-                       :mtype (:mtype content)}})))))
+  (db/run! cfg (fn [cfg]
+                 (let [object (create-file-media-object cfg params)
+                       props  {:name (:name params)
+                               :file-id file-id
+                               :is-local (:is-local params)
+                               :size (:size content)
+                               :mtype (:mtype content)}]
+                   (with-meta object
+                     {::audit/replace-props props})))))
 
 (defn- big-enough-for-thumbnail?
   "Checks if the provided image info is big enough for
@@ -152,14 +142,20 @@
       :always
       (assoc ::image (process-main-image info)))))
 
-(defn- create-file-media-object
-  [{:keys [::sto/storage ::db/conn ::wrk/executor] :as cfg}
+(defn create-file-media-object
+  [{:keys [::sto/storage ::db/conn ::wrk/executor]}
    {:keys [id file-id is-local name content]}]
+
   (let [result (px/invoke! executor (partial process-image content))
         image  (sto/put-object! storage (::image result))
         thumb  (when-let [params (::thumb result)]
                  (sto/put-object! storage params))]
 
+    (db/update! conn :file
+                {:modified-at (dt/now)
+                 :has-media-trimmed false}
+                {:id file-id})
+
     (db/exec-one! conn [sql:create-file-media-object
                         (or id (uuid/next))
                         file-id is-local name
@@ -186,18 +182,7 @@
    ::sm/params schema:create-file-media-object-from-url}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id file-id] :as params}]
   (files/check-edition-permissions! pool profile-id file-id)
-  ;; We get the minimal file for proper checking if file is not
-  ;; already deleted
-  (let [_    (files/get-minimal-file cfg file-id)
-        mobj (create-file-media-object-from-url cfg (assoc params :profile-id profile-id))]
-
-    (db/update! pool :file
-                {:modified-at (dt/now)
-                 :has-media-trimmed false}
-                {:id file-id}
-                {::db/return-keys false})
-
-    mobj))
+  (create-file-media-object-from-url cfg (assoc params :profile-id profile-id)))
 
 (defn download-image
   [{:keys [::http/client]} uri]
@@ -231,7 +216,7 @@
                                                  {:response-type :input-stream :sync? true})
           {:keys [size mtype]} (parse-and-validate response)
           path    (tmp/tempfile :prefix "penpot.media.download.")
-          written (io/write* path body :size size)]
+          written (io/write-to-file! body path :size size)]
 
       (when (not= written size)
         (ex/raise :type :internal

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

@@ -422,9 +422,7 @@
                                   :deleted-at deleted-at
                                   :id profile-id}})
 
-
-      (-> (rph/wrap nil)
-          (rph/with-transform (session/delete-fn cfg))))))
+      (rph/with-transform {} (session/delete-fn cfg)))))
 
 
 ;; --- HELPERS
@@ -433,11 +431,8 @@
   "WITH owner_teams AS (
       SELECT tpr.team_id AS id
         FROM team_profile_rel AS tpr
-        JOIN team AS t ON (t.id = tpr.team_id)
        WHERE tpr.is_owner IS TRUE
          AND tpr.profile_id = ?
-         AND (t.deleted_at IS NULL OR
-              t.deleted_at > now())
    )
    SELECT tpr.team_id AS id,
           count(tpr.profile_id) - 1 AS participants

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

@@ -168,17 +168,6 @@
 
 ;; --- MUTATION: Create Project
 
-(defn- create-project
-  [{:keys [::db/conn] :as cfg} {:keys [profile-id team-id] :as params}]
-  (let [project (teams/create-project conn params)]
-    (teams/create-project-role conn profile-id (:id project) :owner)
-    (db/insert! conn :team-project-profile-rel
-                {:project-id (:id project)
-                 :profile-id profile-id
-                 :team-id team-id
-                 :is-pinned false})
-    (assoc project :is-pinned false)))
-
 (def ^:private schema:create-project
   [:map {:title "create-project"}
    [:team-id ::sm/uuid]
@@ -189,15 +178,23 @@
   {::doc/added "1.18"
    ::webhooks/event? true
    ::sm/params schema:create-project}
-  [cfg {:keys [::rpc/profile-id team-id] :as params}]
+  [{: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)
+    (quotes/check-quote! conn {::quotes/id ::quotes/projects-per-team
+                               ::quotes/profile-id profile-id
+                               ::quotes/team-id team-id})
 
-  (teams/check-edition-permissions! cfg profile-id team-id)
-  (quotes/check! cfg {::quotes/id ::quotes/projects-per-team
-                      ::quotes/profile-id profile-id
-                      ::quotes/team-id team-id})
+    (let [params  (assoc params :profile-id profile-id)
+          project (teams/create-project conn params)]
+      (teams/create-project-role conn profile-id (:id project) :owner)
+      (db/insert! conn :team-project-profile-rel
+                  {:project-id (:id project)
+                   :profile-id profile-id
+                   :team-id team-id
+                   :is-pinned false})
+      (assoc project :is-pinned false))))
 
-  (let [params (assoc params :profile-id profile-id)]
-    (db/tx-run! cfg create-project params)))
 
 ;; --- MUTATION: Toggle Project Pin
 
@@ -222,7 +219,7 @@
    ::webhooks/event? true}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id id team-id is-pinned] :as params}]
   (db/with-atomic [conn pool]
-    (check-read-permissions! conn profile-id id)
+    (check-edition-permissions! conn profile-id id)
     (db/exec-one! conn [sql:update-project-pin team-id id profile-id is-pinned is-pinned])
     nil))
 

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

@@ -10,8 +10,8 @@
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
    [app.common.features :as cfeat]
+   [app.common.logging :as l]
    [app.common.schema :as sm]
-   [app.common.types.team :as tt]
    [app.common.uuid :as uuid]
    [app.config :as cf]
    [app.db :as db]
@@ -20,18 +20,20 @@
    [app.loggers.audit :as audit]
    [app.main :as-alias main]
    [app.media :as media]
-   [app.msgbus :as mbus]
    [app.rpc :as-alias rpc]
    [app.rpc.commands.profile :as profile]
    [app.rpc.doc :as-alias doc]
+   [app.rpc.helpers :as rph]
    [app.rpc.permissions :as perms]
    [app.rpc.quotes :as quotes]
    [app.setup :as-alias setup]
    [app.storage :as sto]
+   [app.tokens :as tokens]
+   [app.util.blob :as blob]
    [app.util.services :as sv]
    [app.util.time :as dt]
    [app.worker :as wrk]
-   [clojure.set :as set]))
+   [cuerdas.core :as str]))
 
 ;; --- Helpers & Specs
 
@@ -80,19 +82,19 @@
   (cond-> row
     (some? features) (assoc :features (db/decode-pgarray features #{}))))
 
-;; FIXME: move
 
-(defn check-profile-muted
-  "Check if the member's email is part of the global bounce report"
+
+(defn- check-valid-email-muted
+  "Check if the member's email is part of the global bounce report."
   [conn member]
-  (let [email (profile/clean-email (:email member))]
+  (let [email  (profile/clean-email (:email member))]
     (when (and member (not (eml/allow-send-emails? conn member)))
       (ex/raise :type :validation
                 :code :member-is-muted
                 :email email
                 :hint "the profile has reported repeatedly as spam or has bounces"))))
 
-(defn check-email-bounce
+(defn- check-valid-email-bounce
   "Check if the email is part of the global complain report"
   [conn email show?]
   (when (eml/has-bounce-reports? conn email)
@@ -101,7 +103,7 @@
               :email (if show? email "private")
               :hint "this email has been repeatedly reported as bounce")))
 
-(defn check-email-spam
+(defn- check-valid-email-spam
   "Check if the member email is part of the global complain report"
   [conn email show?]
   (when (eml/has-complaint-reports? conn email)
@@ -225,16 +227,16 @@
 ;; --- Query: Team Members
 
 (def sql:team-members
-  "SELECT tp.*,
+  "select tp.*,
           p.id,
           p.email,
-          p.fullname AS name,
-          p.fullname AS fullname,
+          p.fullname as name,
+          p.fullname as fullname,
           p.photo_id,
           p.is_active
-     FROM team_profile_rel AS tp
-     JOIN profile AS p ON (p.id = tp.profile_id)
-    WHERE tp.team_id = ?")
+     from team_profile_rel as tp
+     join profile as p on (p.id = tp.profile_id)
+    where tp.team_id = ?")
 
 (defn get-team-members
   [conn team-id]
@@ -265,8 +267,6 @@
    [:fn #(or (contains? % :team-id)
              (contains? % :file-id))]])
 
-;; FIXME: split in two separated requests
-
 (sv/defmethod ::get-team-users
   "Get team users by team-id or by file-id"
   {::doc/added "1.17"
@@ -304,29 +304,20 @@
     inner join project as p on (f.project_id = p.id)
     where p.team_id = ?")
 
+(def sql:team-by-file
+  "select p.team_id as id
+     from project as p
+     join file as f on (p.id = f.project_id)
+    where f.id = ?")
+
 (defn get-users
   [conn team-id]
   (db/exec! conn [sql:team-users team-id team-id team-id]))
 
-(def sql:get-team-by-file
-  "SELECT t.*
-     FROM team AS t
-     JOIN project AS p ON (p.team_id = t.id)
-     JOIN file AS f ON (f.project_id = p.id)
-    WHERE f.id = ?")
-
 (defn get-team-for-file
   [conn file-id]
-  (let [team (->> (db/exec! conn [sql:get-team-by-file file-id])
-                  (remove db/is-row-deleted?)
-                  (map decode-row)
-                  (first))]
-    (when-not team
-      (ex/raise :type :not-found
-                :code :object-not-found
-                :hint "database object not found"))
-
-    team))
+  (->> [sql:team-by-file file-id]
+       (db/exec-one! conn)))
 
 ;; --- Query: Team Stats
 
@@ -412,20 +403,17 @@
   {::doc/added "1.17"
    ::sm/params schema:create-team}
   [cfg {:keys [::rpc/profile-id] :as params}]
+  (db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
+                    (quotes/check-quote! conn {::quotes/id ::quotes/teams-per-profile
+                                               ::quotes/profile-id profile-id})
 
-  (quotes/check! cfg {::quotes/id ::quotes/teams-per-profile
-                      ::quotes/profile-id profile-id})
-
-  (let [features (-> (cfeat/get-enabled-features cf/flags)
-                     (set/difference cfeat/frontend-only-features)
-                     (cfeat/check-client-features! (:features params)))
-        params   (-> params
-                     (assoc :profile-id profile-id)
-                     (assoc :features features))
-        team     (db/tx-run! cfg create-team params)]
-
-    (with-meta team
-      {::audit/props {:id (:id team)}})))
+                    (let [features (-> (cfeat/get-enabled-features cf/flags)
+                                       (cfeat/check-client-features! (:features params)))
+                          team (create-team cfg (assoc params
+                                                       :profile-id profile-id
+                                                       :features features))]
+                      (with-meta team
+                        {::audit/props {:id (:id team)}})))))
 
 (defn create-team
   "This is a complete team creation process, it creates the team
@@ -515,6 +503,8 @@
 
 ;; --- Mutation: Leave Team
 
+(declare role->params)
+
 (defn leave-team
   [conn {:keys [profile-id id reassign-to]}]
   (let [perms   (get-permissions conn profile-id id)
@@ -544,7 +534,7 @@
 
         ;; assign owner role to new profile
         (db/update! conn :team-profile-rel
-                    (get tt/permissions-for-role :owner)
+                    (role->params :owner)
                     {:team-id id :profile-id reassign-to}))
 
       ;; and finally, if all other conditions does not match and the
@@ -616,8 +606,24 @@
 
 ;; --- Mutation: Team Update Role
 
+;; Temporarily disabled viewer role
+;; https://tree.taiga.io/project/penpot/issue/1083
+(def valid-roles
+  #{:owner :admin :editor #_:viewer})
+
+(def schema:role
+  [::sm/one-of valid-roles])
+
+(defn role->params
+  [role]
+  (case role
+    :admin  {:is-owner false :is-admin true :can-edit true}
+    :editor {:is-owner false :is-admin false :can-edit true}
+    :owner  {:is-owner true  :is-admin true :can-edit true}
+    :viewer {:is-owner false :is-admin false :can-edit false}))
+
 (defn update-team-member-role
-  [{:keys [::db/conn ::mbus/msgbus]} {:keys [profile-id team-id member-id role] :as params}]
+  [conn {:keys [profile-id team-id member-id role] :as params}]
   ;; We retrieve all team members instead of query the
   ;; database for a single member. This is just for
   ;; convenience, if this becomes a bottleneck or problematic,
@@ -625,6 +631,7 @@
   (let [perms   (get-permissions conn profile-id team-id)
         members (get-team-members conn team-id)
         member  (d/seek #(= member-id (:id %)) members)
+
         is-owner? (:is-owner perms)
         is-admin? (:is-admin perms)]
 
@@ -648,14 +655,7 @@
       (ex/raise :type :validation
                 :code :cant-promote-to-owner))
 
-    (mbus/pub! msgbus
-               :topic member-id
-               :message {:type :team-role-change
-                         :topic member-id
-                         :team-id team-id
-                         :role role})
-
-    (let [params (get tt/permissions-for-role role)]
+    (let [params (role->params role)]
       ;; Only allow single owner on team
       (when (= role :owner)
         (db/update! conn :team-profile-rel
@@ -673,13 +673,14 @@
   [:map {:title "update-team-member-role"}
    [:team-id ::sm/uuid]
    [:member-id ::sm/uuid]
-   [:role ::tt/role]])
+   [:role schema:role]])
 
 (sv/defmethod ::update-team-member-role
   {::doc/added "1.17"
    ::sm/params schema:update-team-member-role}
-  [cfg {:keys [::rpc/profile-id] :as params}]
-  (db/tx-run! cfg update-team-member-role (assoc params :profile-id profile-id)))
+  [{: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
 
@@ -691,10 +692,9 @@
 (sv/defmethod ::delete-team-member
   {::doc/added "1.17"
    ::sm/params schema:delete-team-member}
-  [{:keys [::db/pool ::mbus/msgbus] :as cfg} {:keys [::rpc/profile-id team-id member-id] :as params}]
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id member-id] :as params}]
   (db/with-atomic [conn pool]
-    (let [team  (get-team pool :profile-id profile-id :team-id team-id)
-          perms (get-permissions conn profile-id team-id)]
+    (let [perms (get-permissions conn profile-id team-id)]
       (when-not (or (:is-owner perms)
                     (:is-admin perms))
         (ex/raise :type :validation
@@ -707,13 +707,6 @@
       (db/delete! conn :team-profile-rel {:profile-id member-id
                                           :team-id team-id})
 
-      (mbus/pub! msgbus
-                 :topic member-id
-                 :message {:type :team-membership-change
-                           :change :removed
-                           :team-id team-id
-                           :team-name (:name team)})
-
       nil)))
 
 ;; --- Mutation: Update Team Photo
@@ -731,7 +724,6 @@
    ::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"})
   (update-team-photo cfg (assoc params :profile-id profile-id)))
 
@@ -753,3 +745,484 @@
                   {:id team-id})
 
       (assoc team :photo-id (:id photo)))))
+
+;; --- Mutation: Create Team Invitation
+
+(def sql:upsert-team-invitation
+  "insert into team_invitation(id, team_id, email_to, role, valid_until)
+   values (?, ?, ?, ?, ?)
+       on conflict(team_id, email_to) do
+          update set role = ?, valid_until = ?, updated_at = now()
+   returning *")
+
+(defn- create-invitation-token
+  [cfg {:keys [profile-id valid-until team-id member-id member-email role]}]
+  (tokens/generate (::setup/props cfg)
+                   {:iss :team-invitation
+                    :exp valid-until
+                    :profile-id profile-id
+                    :role role
+                    :team-id team-id
+                    :member-email member-email
+                    :member-id member-id}))
+
+(defn- create-profile-identity-token
+  [cfg profile]
+  (tokens/generate (::setup/props cfg)
+                   {:iss :profile-identity
+                    :profile-id (:id profile)
+                    :exp (dt/in-future {:days 30})}))
+
+(defn- create-invitation
+  [{:keys [::db/conn] :as cfg} {:keys [team profile role email] :as params}]
+  (let [email  (profile/clean-email email)
+        member (profile/get-profile-by-email conn email)]
+
+    (check-valid-email-muted conn member)
+    (check-valid-email-bounce conn email true)
+    (check-valid-email-spam conn email true)
+
+
+    ;; When we have email verification disabled and invitation user is
+    ;; already present in the database, we proceed to add it to the
+    ;; team as-is, without email roundtrip.
+
+    ;; TODO: if member does not exists and email verification is
+    ;; disabled, we should proceed to create the profile (?)
+    (if (and (not (contains? cf/flags :email-verification))
+             (some? member))
+      (let [params (merge {:team-id (:id team)
+                           :profile-id (:id member)}
+                          (role->params role))]
+
+        ;; Insert the invited member to the team
+        (db/insert! conn :team-profile-rel params
+                    {::db/on-conflict-do-nothing? true})
+
+        ;; If profile is not yet verified, mark it as verified because
+        ;; accepting an invitation link serves as verification.
+        (when-not (:is-active member)
+          (db/update! conn :profile
+                      {:is-active true}
+                      {: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
+                                           (:id team) (str/lower email)
+                                           (name role) expire
+                                           (name role) expire])
+            updated?   (not= id (:id invitation))
+            tprops     {:profile-id (:id profile)
+                        :invitation-id (:id invitation)
+                        :valid-until expire
+                        :team-id (:id team)
+                        :member-email (:email-to invitation)
+                        :member-id (:id member)
+                        :role role}
+            itoken     (create-invitation-token cfg tprops)
+            ptoken     (create-profile-identity-token cfg profile)]
+
+        (when (contains? cf/flags :log-invitation-tokens)
+          (l/info :hint "invitation token" :token itoken))
+
+
+        (let [props  (-> (dissoc tprops :profile-id)
+                         (audit/clean-props))
+              evname (if updated?
+                       "update-team-invitation"
+                       "create-team-invitation")
+              event (-> (audit/event-from-rpc-params params)
+                        (assoc ::audit/name evname)
+                        (assoc ::audit/props props))]
+          (audit/submit! cfg event))
+
+        (eml/send! {::eml/conn conn
+                    ::eml/factory eml/invite-to-team
+                    :public-uri (cf/get :public-uri)
+                    :to email
+                    :invited-by (:fullname profile)
+                    :team (:name team)
+                    :token itoken
+                    :extra-data ptoken})
+
+        itoken))))
+
+(defn- add-user-to-team
+  [conn profile team email role]
+
+  (let [team-id (:id team)
+        member (db/get* conn :profile
+                        {:email (str/lower email)}
+                        {::sql/columns [:id :email]})
+        params (merge
+                {:team-id team-id
+                 :profile-id (:id member)}
+                (role->params role))]
+
+      ;; Do not allow blocked users to join teams.
+    (when (:is-blocked member)
+      (ex/raise :type :restriction
+                :code :profile-blocked))
+
+    (quotes/check-quote! conn
+                         {::quotes/id ::quotes/profiles-per-team
+                          ::quotes/profile-id (:id member)
+                          ::quotes/team-id team-id})
+
+    ;; Insert the member to the team
+    (db/insert! conn :team-profile-rel params {::db/on-conflict-do-nothing? true})
+
+    ;; Delete any request
+    (db/delete! conn :team-access-request
+                {:team-id team-id :requester-id (:id member)})
+
+    ;; Delete any invitation
+    (db/delete! conn :team-invitation
+                {:team-id team-id :email-to (:email member)})
+
+    (eml/send! {::eml/conn conn
+                ::eml/factory eml/join-team
+                :public-uri (cf/get :public-uri)
+                :to email
+                :invited-by (:fullname profile)
+                :team (:name team)
+                :team-id (:id team)})))
+
+(def sql:valid-requests-email
+  "SELECT p.email
+     FROM team_access_request AS tr
+     JOIN profile AS p ON (tr.requester_id = p.id)
+    WHERE tr.team_id = ?
+      AND tr.auto_join_until > now()")
+
+(defn- get-valid-requests-email
+  [conn team-id]
+  (db/exec! conn [sql:valid-requests-email team-id]))
+
+(def ^:private schema:create-team-invitations
+  [:map {:title "create-team-invitations"}
+   [:team-id ::sm/uuid]
+   [:role schema:role]
+   [:emails [::sm/set ::sm/email]]])
+
+(sv/defmethod ::create-team-invitations
+  "A rpc call that allow to send a single or multiple invitations to
+  join the team."
+  {::doc/added "1.17"
+   ::sm/params schema:create-team-invitations}
+  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id emails role] :as params}]
+  (db/with-atomic [conn pool]
+    (let [perms    (get-permissions conn profile-id team-id)
+          profile  (db/get-by-id conn :profile profile-id)
+          team     (db/get-by-id conn :team team-id)
+          emails   (into #{} (map profile/clean-email) emails)]
+
+      (run! (partial quotes/check-quote! conn)
+            (list {::quotes/id ::quotes/invitations-per-team
+                   ::quotes/profile-id profile-id
+                   ::quotes/team-id (:id team)
+                   ::quotes/incr (count emails)}
+                  {::quotes/id ::quotes/profiles-per-team
+                   ::quotes/profile-id profile-id
+                   ::quotes/team-id (:id team)
+                   ::quotes/incr (count emails)}))
+
+      (when-not (:is-admin perms)
+        (ex/raise :type :validation
+                  :code :insufficient-permissions))
+
+      ;; Check if the current profile is allowed to send emails.
+      (check-valid-email-muted conn profile)
+
+
+      (let [requested     (into #{} (map :email) (get-valid-requests-email conn team-id))
+            emails-to-add (filter #(contains? requested %) emails)
+            emails        (remove #(contains? requested %) emails)
+            cfg           (assoc cfg ::db/conn conn)
+            members     (->> (db/exec! conn [sql:team-members team-id])
+                             (into #{} (map :email)))
+
+            invitations (into #{}
+                              (comp
+                               ;;  We don't re-send inviation to already existing members
+                               (remove (partial contains? members))
+                               (map (fn [email]
+                                      (-> params
+                                          (assoc :email email)
+                                          (assoc :team team)
+                                          (assoc :profile profile)
+                                          (assoc :role role))))
+                               (keep (partial create-invitation cfg)))
+                              emails)]
+          ;; For requested invitations, do not send invitation emails, add the user directly to the team
+        (doseq [email emails-to-add]
+          (add-user-to-team conn profile team email role))
+
+        (with-meta {:total (count invitations)
+                    :invitations invitations}
+          {::audit/props {:invitations (count invitations)}})))))
+
+;; --- Mutation: Create Team & Invite Members
+
+(def ^:private schema:create-team-with-invitations
+  [:map {:title "create-team-with-invitations"}
+   [:name [:string {:max 250}]]
+   [:features {:optional true} ::cfeat/features]
+   [:id {:optional true} ::sm/uuid]
+   [:emails [::sm/set ::sm/email]]
+   [:role schema:role]])
+
+(sv/defmethod ::create-team-with-invitations
+  {::doc/added "1.17"
+   ::sm/params schema:create-team-with-invitations}
+  [cfg {:keys [::rpc/profile-id emails role name] :as params}]
+
+  (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   (-> params
+                                   (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]
+                              (-> params
+                                  (assoc :team team)
+                                  (assoc :profile profile)
+                                  (assoc :email email)
+                                  (assoc :role role))))
+                       (run! (partial create-invitation cfg)))
+
+                  (run! (partial quotes/check-quote! conn)
+                        (list {::quotes/id ::quotes/teams-per-profile
+                               ::quotes/profile-id profile-id}
+                              {::quotes/id ::quotes/invitations-per-team
+                               ::quotes/profile-id profile-id
+                               ::quotes/team-id (:id team)
+                               ::quotes/incr (count emails)}
+                              {::quotes/id ::quotes/profiles-per-team
+                               ::quotes/profile-id profile-id
+                               ::quotes/team-id (:id team)
+                               ::quotes/incr (count emails)}))
+
+                  (vary-meta team assoc ::audit/props {:invitations (count emails)})))))
+
+;; --- Query: get-team-invitation-token
+
+(def ^:private schema:get-team-invitation-token
+  [:map {:title "get-team-invitation-token"}
+   [:team-id ::sm/uuid]
+   [:email ::sm/email]])
+
+(sv/defmethod ::get-team-invitation-token
+  {::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)
+        invit (-> (db/get pool :team-invitation
+                          {:team-id team-id
+                           :email-to email})
+                  (update :role keyword))
+
+        member (profile/get-profile-by-email pool (:email-to invit))
+        token  (create-invitation-token cfg {:team-id (:team-id invit)
+                                             :profile-id profile-id
+                                             :valid-until (:valid-until invit)
+                                             :role (:role invit)
+                                             :member-id (:id member)
+                                             :member-email (or (:email member)
+                                                               (profile/clean-email (:email-to invit)))})]
+    {:token token}))
+
+;; --- Mutation: Update invitation role
+
+(def ^:private schema:update-team-invitation-role
+  [:map {:title "update-team-invitation-role"}
+   [:team-id ::sm/uuid]
+   [:email ::sm/email]
+   [:role schema:role]])
+
+(sv/defmethod ::update-team-invitation-role
+  {::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)]
+
+      (when-not (:is-admin perms)
+        (ex/raise :type :validation
+                  :code :insufficient-permissions))
+
+      (db/update! conn :team-invitation
+                  {:role (name role) :updated-at (dt/now)}
+                  {:team-id team-id :email-to (profile/clean-email email)})
+      nil)))
+
+;; --- Mutation: Delete invitation
+
+(def ^:private schema:delete-team-invition
+  [:map {:title "delete-team-invitation"}
+   [:team-id ::sm/uuid]
+   [:email ::sm/email]])
+
+(sv/defmethod ::delete-team-invitation
+  {::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)]
+
+      (when-not (:is-admin perms)
+        (ex/raise :type :validation
+                  :code :insufficient-permissions))
+
+      (let [invitation (db/delete! conn :team-invitation
+                                   {:team-id team-id
+                                    :email-to (profile/clean-email email)}
+                                   {::db/return-keys true})]
+        (rph/wrap nil {::audit/props {:invitation-id (:id invitation)}})))))
+
+
+
+
+;; --- Mutation: Request Team Invitation
+
+(def sql:upsert-team-access-request
+  "INSERT INTO team_access_request (id, team_id, requester_id, valid_until, auto_join_until)
+   VALUES (?, ?, ?, ?, ?)
+       ON conflict(id)
+       DO UPDATE SET valid_until = ?, auto_join_until = ?, updated_at = now()
+   RETURNING *")
+
+
+(def sql:team-access-request
+  "SELECT id, (valid_until < now()) AS expired
+     FROM team_access_request
+    WHERE team_id = ?
+      AND requester_id = ?")
+
+(def sql:team-owner
+  "SELECT profile_id
+     FROM team_profile_rel
+    WHERE team_id = ?
+      AND is_owner = true")
+
+
+(defn- create-team-access-request
+  [{:keys [::db/conn] :as cfg} {:keys [team requester team-owner file is-viewer] :as params}]
+  (let [old-request (->> (db/exec-one! conn [sql:team-access-request (:id team) (:id requester)])
+                         (decode-row))]
+    (when (false? (:expired old-request))
+      (ex/raise :type :validation
+                :code :request-already-sent
+                :hint "you have already made a request to join this team less than 24 hours ago"))
+
+    (let [id              (or (:id old-request) (uuid/next))
+          valid_until     (dt/in-future "24h")
+          auto_join_until (dt/in-future "168h") ;; 7 days
+          request         (db/exec-one! conn [sql:upsert-team-access-request
+                                              id (:id team) (:id requester) valid_until auto_join_until
+                                              valid_until auto_join_until])
+          factory         (cond
+                            (and (some? file) (:is-default team) is-viewer)
+                            eml/request-file-access-yourpenpot-view
+                            (and (some? file) (:is-default team))
+                            eml/request-file-access-yourpenpot
+                            (some? file)
+                            eml/request-file-access
+                            :else
+                            eml/request-team-access)
+          page-id         (when (some? file)
+                            (-> file :data :pages first))]
+
+      ;; TODO needs audit?
+
+      (eml/send! {::eml/conn conn
+                  ::eml/factory factory
+                  :public-uri (cf/get :public-uri)
+                  :to (:email team-owner)
+                  :requested-by (:fullname requester)
+                  :requested-by-email (:email requester)
+                  :team-name (:name team)
+                  :team-id (:id team)
+                  :file-name (:name file)
+                  :file-id (:id file)
+                  :page-id page-id})
+
+      request)))
+
+
+(def ^:private schema:create-team-access-request
+  [:and
+   [:map {:title "create-team-access-request"}
+    [:file-id {:optional true} ::sm/uuid]
+    [:team-id {:optional true} ::sm/uuid]
+    [:is-viewer {:optional true} ::sm/boolean]]
+
+   [:fn (fn [params]
+          (or (contains? params :file-id)
+              (contains? params :team-id)))]])
+
+
+(sv/defmethod ::create-team-access-request
+  "A rpc call that allow to request for an invitations to join the team."
+  {::doc/added "2.2.0"
+   ::sm/params schema:create-team-access-request}
+  [cfg {:keys [::rpc/profile-id file-id team-id is-viewer] :as params}]
+
+  (db/tx-run! cfg
+              (fn [{:keys [::db/conn] :as cfg}]
+
+                (let [requester     (db/get-by-id conn :profile profile-id)
+                      team-id       (if (some? team-id)
+                                      team-id
+                                      (:id (get-team-for-file conn file-id)))
+                      team          (db/get-by-id conn :team team-id)
+                      owner-id      (->> (db/exec! conn [sql:team-owner (:id team)])
+                                         (map decode-row)
+                                         (first)
+                                         :profile-id)
+                      team-owner    (db/get-by-id conn :profile owner-id)
+                      file          (when (some? file-id)
+                                      (db/get* conn :file
+                                               {:id file-id}
+                                               {::sql/columns [:id :name :data]}))
+                      file          (when (some? file)
+                                      (assoc file :data (blob/decode (:data file))))]
+
+                  ;;TODO needs quotes?
+
+                  (when (or (nil? requester) (nil? team) (nil? team-owner) (and (some? file-id) (nil? file)))
+                    (ex/raise :type :validation
+                              :code :invalid-parameters))
+
+                  ;; Check that the requester is not muted
+                  (check-valid-email-muted conn requester)
+
+                  ;; Check that the owner is not marked as bounce nor spam
+                  (check-valid-email-bounce conn (:email team-owner) false)
+                  (check-valid-email-spam conn (:email team-owner) true)
+
+                  (let [request (create-team-access-request
+                                 cfg {:team team :requester requester :team-owner team-owner :file file :is-viewer is-viewer})]
+                    (when request
+                      (with-meta {:request request}
+                        {::audit/props {:request 1}})))))))

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

@@ -1,576 +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.rpc.commands.teams-invitations
-  (:require
-   [app.common.data.macros :as dm]
-   [app.common.exceptions :as ex]
-   [app.common.features :as cfeat]
-   [app.common.logging :as l]
-   [app.common.schema :as sm]
-   [app.common.types.team :as types.team]
-   [app.common.uuid :as uuid]
-   [app.config :as cf]
-   [app.db :as db]
-   [app.db.sql :as sql]
-   [app.email :as eml]
-   [app.loggers.audit :as audit]
-   [app.main :as-alias main]
-   [app.rpc :as-alias rpc]
-   [app.rpc.commands.files :as files]
-   [app.rpc.commands.profile :as profile]
-   [app.rpc.commands.teams :as teams]
-   [app.rpc.doc :as-alias doc]
-   [app.rpc.helpers :as rph]
-   [app.rpc.quotes :as quotes]
-   [app.setup :as-alias setup]
-   [app.tokens :as tokens]
-   [app.util.services :as sv]
-   [app.util.time :as dt]
-   [cuerdas.core :as str]))
-
-;; --- Mutation: Create Team Invitation
-
-
-(def sql:upsert-team-invitation
-  "insert into team_invitation(id, team_id, email_to, created_by, role, valid_until)
-   values (?, ?, ?, ?, ?, ?)
-       on conflict(team_id, email_to) do
-          update set role = ?, valid_until = ?, updated_at = now()
-   returning *")
-
-(defn- create-invitation-token
-  [cfg {:keys [profile-id valid-until team-id member-id member-email role]}]
-  (tokens/generate (::setup/props cfg)
-                   {:iss :team-invitation
-                    :exp valid-until
-                    :profile-id profile-id
-                    :role role
-                    :team-id team-id
-                    :member-email member-email
-                    :member-id member-id}))
-
-(defn- create-profile-identity-token
-  [cfg profile-id]
-
-  (dm/assert!
-   "expected valid uuid for profile-id"
-   (uuid? profile-id))
-
-  (tokens/generate (::setup/props cfg)
-                   {:iss :profile-identity
-                    :profile-id profile-id
-                    :exp (dt/in-future {:days 30})}))
-
-(def ^:private schema:create-invitation
-  [:map {:title "params:create-invitation"}
-   [::rpc/profile-id ::sm/uuid]
-   [:team
-    [:map
-     [:id ::sm/uuid]
-     [:name :string]]]
-   [:profile
-    [:map
-     [:id ::sm/uuid]
-     [:fullname :string]]]
-   [:role ::types.team/role]
-   [:email ::sm/email]])
-
-(def ^:private check-create-invitation-params!
-  (sm/check-fn schema:create-invitation))
-
-(defn- create-invitation
-  [{:keys [::db/conn] :as cfg} {:keys [team profile role email] :as params}]
-
-  (dm/assert!
-   "expected valid connection on cfg parameter"
-   (db/connection? conn))
-
-  (dm/assert!
-   "expected valid params for `create-invitation` fn"
-   (check-create-invitation-params! params))
-
-  (let [email  (profile/clean-email email)
-        member (profile/get-profile-by-email conn email)]
-
-    (teams/check-profile-muted conn member)
-    (teams/check-email-bounce conn email true)
-    (teams/check-email-spam conn email true)
-
-    ;; When we have email verification disabled and invitation user is
-    ;; already present in the database, we proceed to add it to the
-    ;; team as-is, without email roundtrip.
-
-    ;; TODO: if member does not exists and email verification is
-    ;; disabled, we should proceed to create the profile (?)
-    (if (and (not (contains? cf/flags :email-verification))
-             (some? member))
-      (let [params (merge {:team-id (:id team)
-                           :profile-id (:id member)}
-                          (get types.team/permissions-for-role role))]
-
-        ;; Insert the invited member to the team
-        (db/insert! conn :team-profile-rel params
-                    {::db/on-conflict-do-nothing? true})
-
-        ;; If profile is not yet verified, mark it as verified because
-        ;; accepting an invitation link serves as verification.
-        (when-not (:is-active member)
-          (db/update! conn :profile
-                      {:is-active true}
-                      {: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
-                                           (:id team) (str/lower email)
-                                           (:id profile)
-                                           (name role) expire
-                                           (name role) expire])
-            updated?   (not= id (:id invitation))
-            profile-id (:id profile)
-            tprops     {:profile-id profile-id
-                        :invitation-id (:id invitation)
-                        :valid-until expire
-                        :team-id (:id team)
-                        :member-email (:email-to invitation)
-                        :member-id (:id member)
-                        :role role}
-            itoken     (create-invitation-token cfg tprops)
-            ptoken     (create-profile-identity-token cfg profile-id)]
-
-        (when (contains? cf/flags :log-invitation-tokens)
-          (l/info :hint "invitation token" :token itoken))
-
-        (let [props  (-> (dissoc tprops :profile-id)
-                         (audit/clean-props))
-              evname (if updated?
-                       "update-team-invitation"
-                       "create-team-invitation")
-              event (-> (audit/event-from-rpc-params params)
-                        (assoc ::audit/name evname)
-                        (assoc ::audit/props props))]
-          (audit/submit! cfg event))
-
-        (eml/send! {::eml/conn conn
-                    ::eml/factory eml/invite-to-team
-                    :public-uri (cf/get :public-uri)
-                    :to email
-                    :invited-by (:fullname profile)
-                    :team (:name team)
-                    :token itoken
-                    :extra-data ptoken})
-
-        itoken))))
-
-(defn- add-user-to-team
-  [conn profile team role email]
-
-  (let [team-id (:id team)
-        member  (db/get* conn :profile
-                         {:email (str/lower email)}
-                         {::sql/columns [:id :email]})
-        params  (merge
-                 {:team-id team-id
-                  :profile-id (:id member)}
-                 (get types.team/permissions-for-role role))]
-
-      ;; Do not allow blocked users to join teams.
-    (when (:is-blocked member)
-      (ex/raise :type :restriction
-                :code :profile-blocked))
-
-    (quotes/check!
-     {::db/conn conn
-      ::quotes/id ::quotes/profiles-per-team
-      ::quotes/profile-id (:id member)
-      ::quotes/team-id team-id})
-
-    ;; Insert the member to the team
-    (db/insert! conn :team-profile-rel params {::db/on-conflict-do-nothing? true})
-
-    ;; Delete any request
-    (db/delete! conn :team-access-request
-                {:team-id team-id :requester-id (:id member)})
-
-    ;; Delete any invitation
-    (db/delete! conn :team-invitation
-                {:team-id team-id :email-to (:email member)})
-
-    (eml/send! {::eml/conn conn
-                ::eml/factory eml/join-team
-                :public-uri (cf/get :public-uri)
-                :to email
-                :invited-by (:fullname profile)
-                :team (:name team)
-                :team-id (:id team)})))
-
-(def sql:valid-requests-email
-  "SELECT p.email
-     FROM team_access_request AS tr
-     JOIN profile AS p ON (tr.requester_id = p.id)
-    WHERE tr.team_id = ?
-      AND tr.auto_join_until > now()")
-
-(defn- get-valid-requests-email
-  [conn team-id]
-  (db/exec! conn [sql:valid-requests-email team-id]))
-
-(def ^:private xf:map-email
-  (map :email))
-
-(defn- create-team-invitations
-  [{:keys [::db/conn] :as cfg} {:keys [profile team role emails] :as params}]
-  (let [join-requests    (into #{} xf:map-email
-                               (get-valid-requests-email conn (:id team)))
-        team-members     (into #{} xf:map-email
-                               (teams/get-team-members conn (:id team)))
-
-        invitations      (into #{}
-                               (comp
-                                ;;  We don't re-send inviation to
-                                ;;  already existing members
-                                (remove team-members)
-                                ;; We don't send invitations to
-                                ;; join-requested members
-                                (remove join-requests)
-                                (map (fn [email] (assoc params :email email)))
-                                (keep (partial create-invitation cfg)))
-                               emails)]
-
-    ;; For requested invitations, do not send invitation emails, add
-    ;; the user directly to the team
-    (->> (filter join-requests emails)
-         (run! (partial add-user-to-team conn profile team role)))
-
-    invitations))
-
-(def ^:private schema:create-team-invitations
-  [:map {:title "create-team-invitations"}
-   [:team-id ::sm/uuid]
-   [:role ::types.team/role]
-   [:emails [::sm/set ::sm/email]]])
-
-(def ^:private max-invitations-by-request-threshold
-  "The number of invitations can be sent in a single rpc request"
-  25)
-
-(sv/defmethod ::create-team-invitations
-  "A rpc call that allow to send a single or multiple invitations to
-  join the team."
-  {::doc/added "1.17"
-   ::doc/module :teams
-   ::sm/params schema:create-team-invitations}
-  [cfg {:keys [::rpc/profile-id team-id emails] :as params}]
-  (let [perms    (teams/get-permissions cfg profile-id team-id)
-        profile  (db/get-by-id cfg :profile profile-id)
-        emails   (into #{} (map profile/clean-email) emails)]
-
-    (when-not (:is-admin perms)
-      (ex/raise :type :validation
-                :code :insufficient-permissions))
-
-    (when (> (count emails) max-invitations-by-request-threshold)
-      (ex/raise :type :validation
-                :code :max-invitations-by-request
-                :hint "the maximum of invitation on single request is reached"
-                :threshold max-invitations-by-request-threshold))
-
-    (-> cfg
-        (assoc ::quotes/profile-id profile-id)
-        (assoc ::quotes/team-id team-id)
-        (assoc ::quotes/incr (count emails))
-        (quotes/check! {::quotes/id ::quotes/invitations-per-team}
-                       {::quotes/id ::quotes/profiles-per-team}))
-
-    ;; Check if the current profile is allowed to send emails
-    (teams/check-profile-muted cfg profile)
-
-    (let [team        (db/get-by-id cfg :team team-id)
-          ;; NOTE: Is important pass RPC method params down to the
-          ;; `create-team-invitations` because it uses the implicit
-          ;; RPC properties from params for fill necessary data on
-          ;; emiting an entry to the audit-log
-          invitations (db/tx-run! cfg create-team-invitations
-                                  (-> params
-                                      (assoc :profile profile)
-                                      (assoc :team team)
-                                      (assoc :emails emails)))]
-
-      (with-meta {:total (count invitations)
-                  :invitations invitations}
-        {::audit/props {:invitations (count invitations)}}))))
-
-;; --- Mutation: Create Team & Invite Members
-
-(def ^:private schema:create-team-with-invitations
-  [:map {:title "create-team-with-invitations"}
-   [:name [:string {:max 250}]]
-   [:features {:optional true} ::cfeat/features]
-   [:id {:optional true} ::sm/uuid]
-   [:emails [::sm/set ::sm/email]]
-   [:role ::types.team/role]])
-
-(sv/defmethod ::create-team-with-invitations
-  {::doc/added "1.17"
-   ::doc/module :teams
-   ::sm/params schema:create-team-with-invitations
-   ::db/transaction true}
-  [{:keys [::db/conn] :as cfg} {:keys [::rpc/profile-id emails role name] :as params}]
-  (let [features (-> (cfeat/get-enabled-features cf/flags)
-                     (cfeat/check-client-features! (:features params)))
-
-        params   (-> params
-                     (assoc :profile-id profile-id)
-                     (assoc :features features))
-
-        team     (teams/create-team cfg params)
-        emails   (into #{} (map profile/clean-email) emails)]
-
-    (-> cfg
-        (assoc ::quotes/profile-id profile-id)
-        (assoc ::quotes/team-id (:id team))
-        (assoc ::quotes/incr (count emails))
-        (quotes/check! {::quotes/id ::quotes/teams-per-profile}
-                       {::quotes/id ::quotes/invitations-per-team}
-                       {::quotes/id ::quotes/profiles-per-team}))
-
-    (when (> (count emails) max-invitations-by-request-threshold)
-      (ex/raise :type :validation
-                :code :max-invitations-by-request
-                :hint "the maximum of invitation on single request is reached"
-                :threshold max-invitations-by-request-threshold))
-
-    (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.
-    (let [profile     (db/get-by-id conn :profile profile-id)
-          params      (-> params
-                          (assoc :team team)
-                          (assoc :profile profile)
-                          (assoc :role role))
-          invitations (->> emails
-                           (map (fn [email] (assoc params :email email)))
-                           (map (partial create-invitation cfg)))]
-
-      (vary-meta team assoc ::audit/props {:invitations (count invitations)}))))
-
-;; --- Query: get-team-invitation-token
-
-(def ^:private schema:get-team-invitation-token
-  [:map {:title "get-team-invitation-token"}
-   [:team-id ::sm/uuid]
-   [:email ::sm/email]])
-
-(sv/defmethod ::get-team-invitation-token
-  {::doc/added "1.17"
-   ::doc/module :teams
-   ::sm/params schema:get-team-invitation-token}
-  [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id email] :as params}]
-  (teams/check-read-permissions! pool profile-id team-id)
-  (let [email (profile/clean-email email)
-        invit (-> (db/get pool :team-invitation
-                          {:team-id team-id
-                           :email-to email})
-                  (update :role keyword))
-
-        member (profile/get-profile-by-email pool (:email-to invit))
-        token  (create-invitation-token cfg {:team-id (:team-id invit)
-                                             :profile-id profile-id
-                                             :valid-until (:valid-until invit)
-                                             :role (:role invit)
-                                             :member-id (:id member)
-                                             :member-email (or (:email member)
-                                                               (profile/clean-email (:email-to invit)))})]
-    {:token token}))
-
-;; --- Mutation: Update invitation role
-
-(def ^:private schema:update-team-invitation-role
-  [:map {:title "update-team-invitation-role"}
-   [:team-id ::sm/uuid]
-   [:email ::sm/email]
-   [:role ::types.team/role]])
-
-(sv/defmethod ::update-team-invitation-role
-  {::doc/added "1.17"
-   ::doc/module :teams
-   ::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 (teams/get-permissions conn profile-id team-id)]
-
-      (when-not (:is-admin perms)
-        (ex/raise :type :validation
-                  :code :insufficient-permissions))
-
-      (db/update! conn :team-invitation
-                  {:role (name role) :updated-at (dt/now)}
-                  {:team-id team-id :email-to (profile/clean-email email)})
-
-      nil)))
-
-;; --- Mutation: Delete invitation
-
-(def ^:private schema:delete-team-invition
-  [:map {:title "delete-team-invitation"}
-   [:team-id ::sm/uuid]
-   [:email ::sm/email]])
-
-(sv/defmethod ::delete-team-invitation
-  {::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 (teams/get-permissions conn profile-id team-id)]
-
-      (when-not (:is-admin perms)
-        (ex/raise :type :validation
-                  :code :insufficient-permissions))
-
-      (let [invitation (db/delete! conn :team-invitation
-                                   {:team-id team-id
-                                    :email-to (profile/clean-email email)}
-                                   {::db/return-keys true})]
-        (rph/wrap nil {::audit/props {:invitation-id (:id invitation)}})))))
-
-
-;; --- Mutation: Request Team Invitation
-
-(def ^:private sql:get-team-owner
-  "SELECT p.*
-     FROM profile AS p
-     JOIN team_profile_rel AS tpr ON (tpr.profile_id = p.id)
-    WHERE tpr.team_id = ?
-      AND tpr.is_owner IS TRUE")
-
-(defn- get-team-owner
-  "Return a complete profile of the team owner"
-  [conn team-id]
-  (->> (db/exec! conn [sql:get-team-owner team-id])
-       (remove db/is-row-deleted?)
-       (map profile/decode-row)
-       (first)))
-
-(defn- check-existing-team-access-request
-  "Checks if an existing team access request is still valid"
-  [conn team-id profile-id]
-  (when-let [request (db/get* conn :team-access-request
-                              {:team-id team-id
-                               :requester-id profile-id})]
-    (when (dt/is-after? (:valid-until request) (dt/now))
-      (ex/raise :type :validation
-                :code :request-already-sent
-                :hint "you have already made a request to join this team less than 24 hours ago"))))
-
-(def ^:private sql:upsert-team-access-request
-  "INSERT INTO team_access_request (id, team_id, requester_id, valid_until, auto_join_until)
-   VALUES (?, ?, ?, ?, ?)
-       ON CONFLICT (team_id, requester_id)
-       DO UPDATE SET valid_until = ?, auto_join_until = ?, updated_at = now()
-   RETURNING *")
-
-(defn- upsert-team-access-request
-  "Create or update team access request for provided team and profile-id"
-  [conn team-id requester-id]
-  (check-existing-team-access-request conn team-id requester-id)
-  (let [valid-until     (dt/in-future {:hours 24})
-        auto-join-until (dt/in-future {:days 7})
-        request-id      (uuid/next)]
-    (db/exec-one! conn [sql:upsert-team-access-request
-                        request-id team-id requester-id
-                        valid-until auto-join-until
-                        valid-until auto-join-until])))
-
-(defn- get-file-for-team-access-request
-  "A specific method for obtain a file with name and page-id used for
-  team request access procediment"
-  [cfg file-id]
-  (let [file (files/get-file cfg file-id :migrate? false)]
-    (-> file
-        (dissoc :data)
-        (dissoc :deleted-at)
-        (assoc :page-id (-> file :data :pages first)))))
-
-(def ^:private schema:create-team-access-request
-  [:and
-   [:map {:title "create-team-access-request"}
-    [:file-id {:optional true} ::sm/uuid]
-    [:team-id {:optional true} ::sm/uuid]
-    [:is-viewer {:optional true} ::sm/boolean]]
-
-   [:fn (fn [params]
-          (or (contains? params :file-id)
-              (contains? params :team-id)))]])
-
-(sv/defmethod ::create-team-access-request
-  "A rpc call that allow to request for an invitations to join the team."
-  {::doc/added "2.2.0"
-   ::doc/module :teams
-   ::sm/params schema:create-team-access-request
-   ::db/transaction true}
-  [{:keys [::db/conn] :as cfg}
-   {:keys [::rpc/profile-id file-id team-id is-viewer] :as params}]
-
-  (let [requester  (profile/get-profile conn profile-id)
-        team       (if team-id
-                     (->> (db/get-by-id conn :team team-id)
-                          (teams/decode-row))
-                     (teams/get-team-for-file conn file-id))
-
-        team-id    (:id team)
-
-        team-owner (get-team-owner conn team-id)
-
-        file       (when (some? file-id)
-                     (get-file-for-team-access-request cfg file-id))]
-
-    (-> cfg
-        (assoc ::quotes/profile-id profile-id)
-        (assoc ::quotes/team-id team-id)
-        (quotes/check! {::quotes/id ::quotes/team-access-requests-per-team}
-                       {::quotes/id ::quotes/team-access-requests-per-requester}))
-
-    (teams/check-profile-muted conn requester)
-    (teams/check-email-bounce conn (:email team-owner) false)
-    (teams/check-email-spam conn (:email team-owner) true)
-
-    (let [request (upsert-team-access-request conn team-id profile-id)
-          factory (cond
-                    (and (some? file) (:is-default team) is-viewer)
-                    eml/request-file-access-yourpenpot-view
-
-                    (and (some? file) (:is-default team))
-                    eml/request-file-access-yourpenpot
-
-                    (some? file)
-                    eml/request-file-access
-
-                    :else
-                    eml/request-team-access)]
-
-      (eml/send! {::eml/conn conn
-                  ::eml/factory factory
-                  :public-uri (cf/get :public-uri)
-                  :to (:email team-owner)
-                  :requested-by (:fullname requester)
-                  :requested-by-email (:email requester)
-                  :team-name (:name team)
-                  :team-id team-id
-                  :file-name (:name file)
-                  :file-id file-id
-                  :page-id (:page-id file)})
-
-      (with-meta {:request request}
-        {::audit/props {:request 1}}))))
-
-

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

@@ -8,7 +8,6 @@
   (:require
    [app.common.exceptions :as ex]
    [app.common.schema :as sm]
-   [app.common.types.team :as types.team]
    [app.config :as cf]
    [app.db :as db]
    [app.db.sql :as-alias sql]
@@ -17,6 +16,7 @@
    [app.main :as-alias main]
    [app.rpc :as-alias rpc]
    [app.rpc.commands.profile :as profile]
+   [app.rpc.commands.teams :as teams]
    [app.rpc.doc :as-alias doc]
    [app.rpc.helpers :as rph]
    [app.rpc.quotes :as quotes]
@@ -37,12 +37,14 @@
    ::doc/added "1.15"
    ::doc/module :auth
    ::sm/params schema:verify-token}
-  [cfg {:keys [token] :as params}]
-  (let [claims (tokens/verify (::setup/props cfg) {:token token})]
-    (db/tx-run! cfg process-token params claims)))
+  [{:keys [::db/pool] :as cfg} {:keys [token] :as params}]
+  (db/with-atomic [conn pool]
+    (let [claims (tokens/verify (::setup/props cfg) {:token token})
+          cfg    (assoc cfg :conn conn)]
+      (process-token cfg params claims))))
 
 (defmethod process-token :change-email
-  [{:keys [::db/conn] :as cfg} _params {:keys [profile-id email] :as claims}]
+  [{:keys [conn] :as cfg} _params {:keys [profile-id email] :as claims}]
   (let [email (profile/clean-email email)]
     (when (profile/get-profile-by-email conn email)
       (ex/raise :type :validation
@@ -58,7 +60,7 @@
        ::audit/profile-id profile-id})))
 
 (defmethod process-token :verify-email
-  [{:keys [::db/conn] :as cfg} _ {:keys [profile-id] :as claims}]
+  [{:keys [conn] :as cfg} _ {:keys [profile-id] :as claims}]
   (let [profile (profile/get-profile conn profile-id)
         claims  (assoc claims :profile profile)]
 
@@ -79,29 +81,30 @@
                         ::audit/profile-id (:id profile)}))))
 
 (defmethod process-token :auth
-  [{:keys [::db/conn] :as cfg} _params {:keys [profile-id] :as claims}]
+  [{:keys [conn] :as cfg} _params {:keys [profile-id] :as claims}]
   (let [profile (profile/get-profile conn profile-id)]
     (assoc claims :profile profile)))
 
 ;; --- Team Invitation
 
 (defn- accept-invitation
-  [{:keys [::db/conn] :as cfg} {:keys [team-id role member-email] :as claims} invitation member]
+  [{:keys [conn] :as cfg} {:keys [team-id role member-email] :as claims} invitation member]
   (let [;; Update the role if there is an invitation
         role   (or (some-> invitation :role keyword) role)
         params (merge
                 {:team-id team-id
                  :profile-id (:id member)}
-                (get types.team/permissions-for-role role))]
+                (teams/role->params role))]
 
     ;; Do not allow blocked users accept invitations.
     (when (:is-blocked member)
       (ex/raise :type :restriction
                 :code :profile-blocked))
 
-    (quotes/check! cfg {::quotes/id ::quotes/profiles-per-team
-                        ::quotes/profile-id (:id member)
-                        ::quotes/team-id team-id})
+    (quotes/check-quote! conn
+                         {::quotes/id ::quotes/profiles-per-team
+                          ::quotes/profile-id (:id member)
+                          ::quotes/team-id team-id})
 
     ;; Insert the invited member to the team
     (db/insert! conn :team-profile-rel params {::db/on-conflict-do-nothing? true})
@@ -128,7 +131,7 @@
    [:iss :keyword]
    [:exp ::dt/instant]
    [:profile-id ::sm/uuid]
-   [:role ::types.team/role]
+   [:role teams/schema:role]
    [:team-id ::sm/uuid]
    [:member-email ::sm/email]
    [:member-id {:optional true} ::sm/uuid]])
@@ -137,7 +140,7 @@
   (sm/lazy-validator schema:team-invitation-claims))
 
 (defmethod process-token :team-invitation
-  [{:keys [::db/conn] :as cfg}
+  [{:keys [conn] :as cfg}
    {:keys [::rpc/profile-id token] :as params}
    {:keys [member-id team-id member-email] :as claims}]
 
@@ -166,28 +169,13 @@
         ;; invited team.
         (let [props {:team-id (:team-id claims)
                      :role (:role claims)
-                     :invitation-id (:id invitation)}]
-
-          (audit/submit!
-           cfg
-           (-> (audit/event-from-rpc-params params)
-               (assoc ::audit/name "accept-team-invitation")
-               (assoc ::audit/props props)))
-
-          ;; NOTE: Backward compatibility; old invitations can
-          ;; have the `created-by` to be nil; so in this case we
-          ;; don't submit this event to the audit-log
-          (when-let [created-by (:created-by invitation)]
-            (audit/submit!
-             cfg
-             (-> (audit/event-from-rpc-params params)
-                 (assoc ::audit/profile-id created-by)
-                 (assoc ::audit/name "accept-team-invitation-from")
-                 (assoc ::audit/props (assoc props
-                                             :profile-id (:id profile)
-                                             :email (:email profile))))))
+                     :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

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

@@ -15,27 +15,12 @@
    [app.http.client :as http]
    [app.loggers.webhooks :as webhooks]
    [app.rpc :as-alias rpc]
-   [app.rpc.commands.teams :refer [check-read-permissions!] :as t]
+   [app.rpc.commands.teams :refer [check-edition-permissions! check-read-permissions!]]
    [app.rpc.doc :as-alias doc]
-   [app.rpc.permissions :as perms]
    [app.util.services :as sv]
    [app.util.time :as dt]
    [cuerdas.core :as str]))
 
-(defn get-webhooks-permissions
-  [conn profile-id team-id creator-id]
-  (let [permissions (t/get-permissions conn profile-id team-id)
-
-        can-edit (boolean (or (:can-edit permissions)
-                              (= profile-id creator-id)))]
-    (assoc permissions :can-edit can-edit)))
-
-(def has-webhook-edit-permissions?
-  (perms/make-edition-predicate-fn get-webhooks-permissions))
-
-(def check-webhook-edition-permissions!
-  (perms/make-check-fn has-webhook-edit-permissions?))
-
 (defn decode-row
   [{:keys [uri] :as row}]
   (cond-> row
@@ -80,12 +65,11 @@
                                 max-hooks-for-team)))))
 
 (defn- insert-webhook!
-  [{:keys [::db/pool]} {:keys [team-id uri mtype is-active ::rpc/profile-id] :as params}]
+  [{:keys [::db/pool]} {:keys [team-id uri mtype is-active] :as params}]
   (-> (db/insert! pool :webhook
                   {:id (uuid/next)
                    :team-id team-id
                    :uri (str uri)
-                   :profile-id profile-id
                    :is-active is-active
                    :mtype mtype})
       (decode-row)))
@@ -117,7 +101,7 @@
   {::doc/added "1.17"
    ::sm/params schema:create-webhook}
   [{:keys [::db/pool] :as cfg} {:keys [::rpc/profile-id team-id] :as params}]
-  (check-webhook-edition-permissions! pool profile-id team-id profile-id)
+  (check-edition-permissions! pool profile-id team-id)
   (validate-quotes! cfg params)
   (validate-webhook! cfg nil params)
   (insert-webhook! cfg params))
@@ -134,7 +118,7 @@
    ::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-webhook-edition-permissions! pool profile-id (:team-id whook) (:profile-id whook))
+    (check-edition-permissions! pool profile-id (:team-id whook))
     (validate-webhook! cfg whook params)
     (update-webhook! cfg whook params)))
 
@@ -148,17 +132,15 @@
   [{: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)]
-      (check-webhook-edition-permissions! conn profile-id (:team-id whook) (:profile-id whook))
+      (check-edition-permissions! conn profile-id (:team-id whook))
       (db/delete! conn :webhook {:id id})
       nil)))
 
 ;; --- Query: Webhooks
 
 (def sql:get-webhooks
-  "SELECT id, uri, mtype, is_active, error_code, error_count, profile_id 
-     FROM webhook 
-    WHERE team_id = ? 
-    ORDER BY uri")
+  "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"}

backend/src/app/rpc/cond.clj

@@ -29,7 +29,7 @@
    [app.util.services :as-alias sv]
    [buddy.core.codecs :as bc]
    [buddy.core.hash :as bh]
-   [yetti.response :as-alias yres]))
+   [ring.response :as-alias rres]))
 
 (def
   ^{:dynamic true
@@ -48,25 +48,20 @@
   (str "W/\"" (encode s) "\""))
 
 (defn wrap
-  [_ f {:keys [::get-object ::key-fn ::reuse-key?] :or {reuse-key? true} :as mdata}]
+  [_ f {:keys [::get-object ::key-fn ::reuse-key?] :as mdata}]
   (if (and (ifn? get-object) (ifn? key-fn))
     (do
       (l/trc :hint "instrumenting method" :service (::sv/name mdata))
       (fn [cfg {:keys [::key] :as params}]
         (if *enabled*
-          (let [object (when (some? key)
-                         (get-object cfg params))
-                key'   (when (some? object)
-                         (->> object (key-fn params) (fmt-key)))]
+          (let [key' (when (or key reuse-key?)
+                       (some->> (get-object cfg params) (key-fn params) (fmt-key)))]
             (if (and (some? key) (= key key'))
-              (fn [_] {::yres/status 304})
-              (let [params (if (some? object)
-                             (assoc params ::object object)
-                             params)
-                    result (f cfg params)
+              (fn [_] {::rres/status 304})
+              (let [result (f cfg params)
                     etag   (or (and reuse-key? key')
-                               (some->> result meta ::key fmt-key)
-                               (some->> result (key-fn params) fmt-key))]
+                               (some-> result meta ::key fmt-key)
+                               (some-> result key-fn fmt-key))]
                 (rph/with-header result "etag" etag))))
           (f cfg params))))
     f))

backend/src/app/rpc/doc.clj

@@ -27,7 +27,7 @@
    [cuerdas.core :as str]
    [integrant.core :as ig]
    [pretty-spec.core :as ps]
-   [yetti.response :as-alias yres]))
+   [ring.response :as-alias rres]))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; DOC (human readable)
@@ -87,11 +87,11 @@
       (let [params  (:query-params request)
             pstyle  (:type params "js")
             context (assoc context :param-style pstyle)]
-        {::yres/status 200
-         ::yres/body (-> (io/resource "app/templates/api-doc.tmpl")
+        {::rres/status 200
+         ::rres/body (-> (io/resource "app/templates/api-doc.tmpl")
                          (tmpl/render context))}))
     (fn [_]
-      {::yres/status 404})))
+      {::rres/status 404})))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; OPENAPI / SWAGGER (v3.1)
@@ -175,12 +175,12 @@
   [context]
   (if (contains? cf/flags :backend-openapi-doc)
     (fn [_]
-      {::yres/status 200
-       ::yres/headers {"content-type" "application/json; charset=utf-8"}
-       ::yres/body (json/encode context)})
+      {::rres/status 200
+       ::rres/headers {"content-type" "application/json; charset=utf-8"}
+       ::rres/body (json/encode context)})
 
     (fn [_]
-      {::yres/status 404})))
+      {::rres/status 404})))
 
 (defn openapi-handler
   []
@@ -191,20 +191,21 @@
             context    {:public-uri (cf/get :public-uri)
                         :swagger-js swagger-js
                         :swagger-css swagger-cs}]
-        {::yres/status 200
-         ::yres/headers {"content-type" "text/html"}
-         ::yres/body (-> (io/resource "app/templates/openapi.tmpl")
+        {::rres/status 200
+         ::rres/headers {"content-type" "text/html"}
+         ::rres/body (-> (io/resource "app/templates/openapi.tmpl")
                          (tmpl/render context))}))
     (fn [_]
-      {::yres/status 404})))
+      {::rres/status 404})))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; MODULE INIT
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defmethod ig/assert-key ::routes
-  [_ params]
-  (assert (sm/valid? ::rpc/methods (::rpc/methods params)) "expected valid methods"))
+(s/def ::routes vector?)
+
+(defmethod ig/pre-init-spec ::routes [_]
+  (s/keys :req-un [::rpc/methods]))
 
 (defmethod ig/init-key ::routes
   [_ {:keys [methods] :as cfg}]

backend/src/app/rpc/helpers.clj

@@ -11,7 +11,7 @@
    [app.common.data.macros :as dm]
    [app.http :as-alias http]
    [app.rpc :as-alias rpc]
-   [yetti.response :as-alias yres]))
+   [ring.response :as-alias rres]))
 
 ;; A utilty wrapper object for wrap service responses that does not
 ;; implements the IObj interface that make possible attach metadata to
@@ -77,4 +77,4 @@
              (fn [_ response]
                (let [exp (if (integer? max-age) max-age (inst-ms max-age))
                      val (dm/fmt "max-age=%" (int (/ exp 1000.0)))]
-                 (update response ::yres/headers assoc "cache-control" val)))))
+                 (update response ::rres/headers assoc "cache-control" val)))))

backend/src/app/rpc/permissions.clj

@@ -8,24 +8,25 @@
   "A permission checking helper factories."
   (:require
    [app.common.exceptions :as ex]
-   [app.common.schema :as sm]))
+   [app.common.schema :as sm]
+   [app.common.spec :as us]
+   [clojure.spec.alpha :as s]))
 
-(sm/register!
- ^{::sm/type ::permissions}
- [:map {:title "Permissions"}
-  [:type {:gen/elements [:membership :share-link]} :keyword]
-  [:is-owner ::sm/boolean]
-  [:is-admin ::sm/boolean]
-  [:can-edit ::sm/boolean]
-  [:can-read ::sm/boolean]
-  [:is-logged ::sm/boolean]])
+(sm/register! ::permissions
+  [:map {:title "Permissions"}
+   [:type {:gen/elements [:membership :share-link]} :keyword]
+   [:is-owner ::sm/boolean]
+   [:is-admin ::sm/boolean]
+   [:can-edit ::sm/boolean]
+   [:can-read ::sm/boolean]
+   [:is-logged ::sm/boolean]])
 
-(def valid-roles
-  #{:admin :owner :editor :viewer})
+
+(s/def ::role #{:admin :owner :editor :viewer})
 
 (defn assign-role-flags
   [params role]
-  (assert (contains? valid-roles role) "expected a valid role")
+  (us/verify ::role role)
   (cond-> params
     (= role :owner)
     (assoc :is-owner true
@@ -50,7 +51,7 @@
 (defn make-admin-predicate-fn
   "A simple factory for admin permission predicate functions."
   [qfn]
-  (assert (fn? qfn) "expected a function")
+  (us/assert fn? qfn)
   (fn check
     ([perms] (:is-admin perms))
     ([conn & args] (check (apply qfn conn args)))))
@@ -58,7 +59,7 @@
 (defn make-edition-predicate-fn
   "A simple factory for edition permission predicate functions."
   [qfn]
-  (assert (fn? qfn) "expected a function")
+  (us/assert fn? qfn)
   (fn check
     ([perms] (:can-edit perms))
     ([conn & args] (check (apply qfn conn args)))))
@@ -66,7 +67,7 @@
 (defn make-read-predicate-fn
   "A simple factory for read permission predicate functions."
   [qfn]
-  (assert (fn? qfn) "expected a function")
+  (us/assert fn? qfn)
   (fn check
     ([perms] (:can-read perms))
     ([conn & args] (check (apply qfn conn args)))))
@@ -74,7 +75,7 @@
 (defn make-comment-predicate-fn
   "A simple factory for comment permission predicate functions."
   [qfn]
-  (assert (fn? qfn) "expected a function")
+  (us/assert fn? qfn)
   (fn check
     ([perms]
      (and (:is-logged perms) (= (:who-comment perms) "all")))

backend/src/app/rpc/quotes.clj

@@ -7,13 +7,16 @@
 (ns app.rpc.quotes
   "Penpot resource usage quotes."
   (:require
+   [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [app.common.schema :as sm]
+   [app.common.spec :as us]
    [app.config :as cf]
    [app.db :as db]
    [app.util.time :as dt]
    [app.worker :as wrk]
+   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]))
 
 (defmulti check-quote ::id)
@@ -31,9 +34,6 @@
    [::id :keyword]
    [::profile-id ::sm/uuid]])
 
-(def valid-quote?
-  (sm/lazy-validator schema:quote))
-
 (def ^:private enabled (volatile! true))
 
 (defn enable!
@@ -46,31 +46,20 @@
   []
   (vswap! enabled (constantly false)))
 
-(defn- check
-  [cfg quote]
-  (let [quote (merge cfg quote)
-        id    (::id quote)]
+(defn check-quote!
+  [ds quote]
+  (dm/assert!
+   "expected valid quote map"
+   (sm/validate schema:quote quote))
 
-    (when-not (valid-quote? quote)
-      (ex/raise :type :internal
-                :code :invalid-quote-definition
-                :hint "found invalid data for quote schema"
-                :quote (name id)))
-
-    (-> (assoc quote ::target (name id))
-        (check-quote))))
-
-(defn check!
-  ([cfg]
-   (when (contains? cf/flags :quotes)
-     (when @enabled
-       (db/run! cfg check {}))))
-
-  ([cfg & others]
-   (when (contains? cf/flags :quotes)
-     (when @enabled
-       (db/run! cfg (fn [cfg]
-                      (run! (partial check cfg) others)))))))
+  (when (contains? cf/flags :quotes)
+    (when @enabled
+      ;; This approach add flexibility on how and where the
+      ;; check-quote! can be called (in or out of transaction)
+      (db/run! ds (fn [cfg]
+                    (-> (merge cfg quote)
+                        (assoc ::target (name (::id quote)))
+                        (check-quote)))))))
 
 (defn- send-notification!
   [{:keys [::db/conn] :as params}]
@@ -111,7 +100,7 @@
                    (map :quote)
                    (reduce max (- Integer/MAX_VALUE)))
         quote (if (pos? quote) quote default)
-        total (:total (db/exec-one! conn count-sql))]
+        total (->> (db/exec! conn count-sql) first :total)]
 
     (when (> (+ total incr) quote)
       (if (contains? cf/flags :soft-quotes)
@@ -123,81 +112,72 @@
                   :count total)))))
 
 (def ^:private sql:get-quotes-1
-  "SELECT id, quote
-     FROM usage_quote
-    WHERE target = ?
-      AND profile_id = ?
-      AND team_id IS NULL
-      AND project_id IS NULL
-      AND file_id IS NULL;")
+  "select id, quote from usage_quote
+    where target = ?
+      and profile_id = ?
+      and team_id is null
+      and project_id is null
+      and file_id is null;")
 
 (def ^:private sql:get-quotes-2
-  "SELECT id, quote
-     FROM usage_quote
-    WHERE target = ?
-      AND ((team_id = ? AND (profile_id = ? OR profile_id IS NULL)) OR
-           (profile_id = ? AND team_id IS NULL AND project_id IS NULL AND file_id IS NULL));")
+  "select id, quote from usage_quote
+    where target = ?
+      and ((team_id = ? and (profile_id = ? or profile_id is null)) or
+           (profile_id = ? and team_id is null and project_id is null and file_id is null));")
 
 (def ^:private sql:get-quotes-3
-  "SELECT id, quote
-     FROM usage_quote
-    WHERE target = ?
-      AND ((project_id = ? AND (profile_id = ? OR profile_id IS NULL)) OR
-           (team_id = ? AND (profile_id = ? OR profile_id IS NULL)) OR
-           (profile_id = ? AND team_id IS NULL AND project_id IS NULL AND file_id IS NULL));")
+  "select id, quote from usage_quote
+    where target = ?
+      and ((project_id = ? and (profile_id = ? or profile_id is null)) or
+           (team_id = ? and (profile_id = ? or profile_id is null)) or
+           (profile_id = ? and team_id is null and project_id is null and file_id is null));")
 
 (def ^:private sql:get-quotes-4
-  "SELECT id, quote
-     FROM usage_quote
-    WHERE target = ?
-      AND ((file_id = ? AND (profile_id = ? OR profile_id IS NULL)) OR
-           (project_id = ? AND (profile_id = ? OR profile_id IS NULL)) OR
-           (team_id = ? AND (profile_id = ? OR profile_id IS NULL)) OR
-           (profile_id = ? AND team_id IS NULL AND project_id IS NULL AND file_id IS NULL));")
+  "select id, quote from usage_quote
+    where target = ?
+      and ((file_id = ? and (profile_id = ? or profile_id is null)) or
+           (project_id = ? and (profile_id = ? or profile_id is null)) or
+           (team_id = ? and (profile_id = ? or profile_id is null)) or
+           (profile_id = ? and team_id is null and project_id is null and file_id is null));")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; QUOTE: TEAMS-PER-PROFILE
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(def ^:private schema:teams-per-profile
-  [:map [::profile-id ::sm/uuid]])
-
-(def ^:private valid-teams-per-profile-quote?
-  (sm/lazy-validator schema:teams-per-profile))
-
 (def ^:private sql:get-teams-per-profile
-  "SELECT count(*) AS total
-     FROM team_profile_rel
-    WHERE profile_id = ?")
+  "select count(*) as total
+     from team_profile_rel
+    where profile_id = ?")
+
+(s/def ::profile-id ::us/uuid)
+(s/def ::teams-per-profile
+  (s/keys :req [::profile-id ::target]))
 
 (defmethod check-quote ::teams-per-profile
   [{:keys [::profile-id ::target] :as quote}]
-  (assert (valid-teams-per-profile-quote? quote) "invalid quote parameters")
+  (us/assert! ::teams-per-profile quote)
   (-> quote
       (assoc ::default (cf/get :quotes-teams-per-profile Integer/MAX_VALUE))
       (assoc ::quote-sql [sql:get-quotes-1 target profile-id])
       (assoc ::count-sql [sql:get-teams-per-profile profile-id])
       (generic-check!)))
 
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; QUOTE: ACCESS-TOKENS-PER-PROFILE
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(def ^:private schema:access-tokens-per-profile
-  [:map [::profile-id ::sm/uuid]])
-
-(def ^:private valid-access-tokens-per-profile-quote?
-  (sm/lazy-validator schema:access-tokens-per-profile))
-
 (def ^:private sql:get-access-tokens-per-profile
-  "SELECT count(*) AS total
-     FROM access_token
-    WHERE profile_id = ?")
+  "select count(*) as total
+     from access_token
+    where profile_id = ?")
+
+(s/def ::access-tokens-per-profile
+  (s/keys :req [::profile-id ::target]))
 
 (defmethod check-quote ::access-tokens-per-profile
   [{:keys [::profile-id ::target] :as quote}]
-  (assert (valid-access-tokens-per-profile-quote? quote) "invalid quote parameters")
-
+  (us/assert! ::access-tokens-per-profile quote)
   (-> quote
       (assoc ::default (cf/get :quotes-access-tokens-per-profile Integer/MAX_VALUE))
       (assoc ::quote-sql [sql:get-quotes-1 target profile-id])
@@ -208,51 +188,40 @@
 ;; QUOTE: PROJECTS-PER-TEAM
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(def ^:private schema:projects-per-team
-  [:map
-   [::profile-id ::sm/uuid]
-   [::team-id ::sm/uuid]])
-
-(def ^:private valid-projects-per-team-quote?
-  (sm/lazy-validator schema:projects-per-team))
-
 (def ^:private sql:get-projects-per-team
-  "SELECT count(*) AS total
-     FROM project AS p
-    WHERE p.team_id = ?
-      AND p.deleted_at IS NULL")
+  "select count(*) as total
+     from project as p
+    where p.team_id = ?
+      and p.deleted_at is null")
+
+(s/def ::team-id ::us/uuid)
+(s/def ::projects-per-team
+  (s/keys :req [::profile-id ::team-id ::target]))
 
 (defmethod check-quote ::projects-per-team
   [{:keys [::profile-id ::team-id ::target] :as quote}]
-  (assert (valid-projects-per-team-quote? quote) "invalid quote parameters")
-
   (-> quote
       (assoc ::default (cf/get :quotes-projects-per-team Integer/MAX_VALUE))
       (assoc ::quote-sql [sql:get-quotes-2 target team-id profile-id profile-id])
       (assoc ::count-sql [sql:get-projects-per-team team-id])
       (generic-check!)))
 
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; QUOTE: FONT-VARIANTS-PER-TEAM
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(def ^:private schema:font-variants-per-team
-  [:map
-   [::profile-id ::sm/uuid]
-   [::team-id ::sm/uuid]])
-
-(def ^:private valid-font-variant-per-team-quote?
-  (sm/lazy-validator schema:font-variants-per-team))
-
 (def ^:private sql:get-font-variants-per-team
-  "SELECT count(*) AS total
-     FROM team_font_variant AS v
-     WHERE v.team_id = ?")
+  "select count(*) as total
+     from team_font_variant as v
+     where v.team_id = ?")
+
+(s/def ::font-variants-per-team
+  (s/keys :req [::profile-id ::team-id ::target]))
 
 (defmethod check-quote ::font-variants-per-team
   [{:keys [::profile-id ::team-id ::target] :as quote}]
-  (assert (valid-font-variant-per-team-quote? quote) "invalid quote parameters")
-
+  (us/assert! ::font-variants-per-team quote)
   (-> quote
       (assoc ::default (cf/get :quotes-font-variants-per-team Integer/MAX_VALUE))
       (assoc ::quote-sql [sql:get-quotes-2 target team-id profile-id profile-id])
@@ -264,86 +233,70 @@
 ;; QUOTE: INVITATIONS-PER-TEAM
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(def ^:private schema:invitations-per-team
-  [:map
-   [::profile-id ::sm/uuid]
-   [::team-id ::sm/uuid]])
-
-(def ^:private valid-invitations-per-team-quote?
-  (sm/lazy-validator schema:invitations-per-team))
-
 (def ^:private sql:get-invitations-per-team
-  "SELECT count(*) AS total
-     FROM team_invitation
-    WHERE team_id = ?")
+  "select count(*) as total
+     from team_invitation
+    where team_id = ?")
+
+(s/def ::invitations-per-team
+  (s/keys :req [::profile-id ::team-id ::target]))
 
 (defmethod check-quote ::invitations-per-team
   [{:keys [::profile-id ::team-id ::target] :as quote}]
-  (assert (valid-invitations-per-team-quote? quote) "invalid quote parameters")
-
+  (us/assert! ::invitations-per-team quote)
   (-> quote
       (assoc ::default (cf/get :quotes-invitations-per-team Integer/MAX_VALUE))
       (assoc ::quote-sql [sql:get-quotes-2 target team-id profile-id profile-id])
       (assoc ::count-sql [sql:get-invitations-per-team team-id])
       (generic-check!)))
 
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; QUOTE: PROFILES-PER-TEAM
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(def ^:private schema:profiles-per-team
-  [:map
-   [::profile-id ::sm/uuid]
-   [::team-id ::sm/uuid]])
-
-(def ^:private valid-profiles-per-team-quote?
-  (sm/lazy-validator schema:profiles-per-team))
-
 (def ^:private sql:get-profiles-per-team
-  "SELECT (SELECT count(*)
-             FROM team_profile_rel
-            WHERE team_id = ?) +
-          (SELECT count(*)
-             FROM team_invitation
-            WHERE team_id = ?
-              AND valid_until > now()) AS total;")
+  "select (select count(*)
+             from team_profile_rel
+            where team_id = ?) +
+          (select count(*)
+             from team_invitation
+            where team_id = ?
+              and valid_until > now()) as total;")
 
 ;; NOTE: the total number of profiles is determined by the number of
 ;; effective members plus ongoing valid invitations.
 
+(s/def ::profiles-per-team
+  (s/keys :req [::profile-id ::team-id ::target]))
+
 (defmethod check-quote ::profiles-per-team
   [{:keys [::profile-id ::team-id ::target] :as quote}]
-  (assert (valid-profiles-per-team-quote? quote) "invalid quote parameters")
-
+  (us/assert! ::profiles-per-team quote)
   (-> quote
       (assoc ::default (cf/get :quotes-profiles-per-team Integer/MAX_VALUE))
       (assoc ::quote-sql [sql:get-quotes-2 target team-id profile-id profile-id])
       (assoc ::count-sql [sql:get-profiles-per-team team-id team-id])
       (generic-check!)))
 
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; QUOTE: FILES-PER-PROJECT
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(def ^:private schema:files-per-project
-  [:map
-   [::profile-id ::sm/uuid]
-   [::project-id ::sm/uuid]
-   [::team-id ::sm/uuid]])
-
-(def ^:private valid-files-per-project-quote?
-  (sm/lazy-validator schema:files-per-project))
-
 (def ^:private sql:get-files-per-project
-  "SELECT count(*) AS total
-     FROM file AS f
-    WHERE f.project_id = ?
-      AND f.deleted_at IS NULL")
+  "select count(*) as total
+     from file as f
+    where f.project_id = ?
+      and f.deleted_at is null")
+
+(s/def ::project-id ::us/uuid)
+(s/def ::files-per-project
+  (s/keys :req [::profile-id ::project-id ::team-id ::target]))
 
 (defmethod check-quote ::files-per-project
   [{:keys [::profile-id ::project-id ::team-id ::target] :as quote}]
-  (assert (valid-files-per-project-quote? quote) "invalid quote parameters")
-
+  (us/assert! ::files-per-project quote)
   (-> quote
       (assoc ::default (cf/get :quotes-files-per-project Integer/MAX_VALUE))
       (assoc ::quote-sql [sql:get-quotes-3 target project-id profile-id team-id profile-id profile-id])
@@ -354,24 +307,17 @@
 ;; QUOTE: COMMENT-THREADS-PER-FILE
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(def ^:private schema:comment-threads-per-file
-  [:map
-   [::profile-id ::sm/uuid]
-   [::project-id ::sm/uuid]
-   [::team-id ::sm/uuid]])
-
-(def ^:private valid-comment-threads-per-file-quote?
-  (sm/lazy-validator schema:comment-threads-per-file))
-
 (def ^:private sql:get-comment-threads-per-file
-  "SELECT count(*) AS total
-     FROM comment_thread AS ct
-    WHERE ct.file_id = ?")
+  "select count(*) as total
+     from comment_thread as ct
+    where ct.file_id = ?")
+
+(s/def ::comment-threads-per-file
+  (s/keys :req [::profile-id ::project-id ::team-id ::target]))
 
 (defmethod check-quote ::comment-threads-per-file
   [{:keys [::profile-id ::file-id ::team-id ::project-id ::target] :as quote}]
-  (assert (valid-comment-threads-per-file-quote? quote) "invalid quote parameters")
-
+  (us/assert! ::files-per-project quote)
   (-> quote
       (assoc ::default (cf/get :quotes-comment-threads-per-file Integer/MAX_VALUE))
       (assoc ::quote-sql [sql:get-quotes-4 target file-id profile-id project-id
@@ -379,28 +325,23 @@
       (assoc ::count-sql [sql:get-comment-threads-per-file file-id])
       (generic-check!)))
 
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; QUOTE: COMMENTS-PER-FILE
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(def ^:private schema:comments-per-file
-  [:map
-   [::profile-id ::sm/uuid]
-   [::project-id ::sm/uuid]
-   [::team-id ::sm/uuid]])
-
-(def ^:private valid-comments-per-file-quote?
-  (sm/lazy-validator schema:comments-per-file))
-
 (def ^:private sql:get-comments-per-file
-  "SELECT count(*) AS total
-     FROM comment AS c
-     JOIN comment_thread AS ct ON (ct.id = c.thread_id)
-    WHERE ct.file_id = ?")
+  "select count(*) as total
+     from comment as c
+     join comment_thread as ct on (ct.id = c.thread_id)
+    where ct.file_id = ?")
+
+(s/def ::comments-per-file
+  (s/keys :req [::profile-id ::project-id ::team-id ::target]))
 
 (defmethod check-quote ::comments-per-file
   [{:keys [::profile-id ::file-id ::team-id ::project-id ::target] :as quote}]
-  (assert (valid-comments-per-file-quote? quote) "invalid quote parameters")
+  (us/assert! ::files-per-project quote)
   (-> quote
       (assoc ::default (cf/get :quotes-comments-per-file Integer/MAX_VALUE))
       (assoc ::quote-sql [sql:get-quotes-4 target file-id profile-id project-id
@@ -408,121 +349,6 @@
       (assoc ::count-sql [sql:get-comments-per-file file-id])
       (generic-check!)))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; QUOTE: SNAPSHOTS-PER-FILE
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(def ^:private schema:snapshots-per-file
-  [:map
-   [::profile-id ::sm/uuid]
-   [::project-id ::sm/uuid]
-   [::team-id ::sm/uuid]
-   [::file-id ::sm/uuid]])
-
-(def ^:private valid-snapshots-per-file-quote?
-  (sm/lazy-validator schema:snapshots-per-file))
-
-(def ^:private sql:get-snapshots-per-file
-  "SELECT count(*) AS total
-     FROM file_change AS fc
-    WHERE fc.file_id = ?
-      AND fc.created_by = 'user'
-      AND fc.deleted_at IS NULL
-      AND fc.data IS NOT NULL")
-
-(defmethod check-quote ::snapshots-per-file
-  [{:keys [::profile-id ::file-id ::team-id ::project-id ::target] :as quote}]
-  (assert (valid-snapshots-per-file-quote? quote) "invalid quote parameters")
-  (-> quote
-      (assoc ::default (cf/get :quotes-snapshots-per-file Integer/MAX_VALUE))
-      (assoc ::quote-sql [sql:get-quotes-4 target file-id profile-id project-id
-                          profile-id team-id profile-id profile-id])
-      (assoc ::count-sql [sql:get-snapshots-per-file file-id])
-      (generic-check!)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; QUOTE: SNAPSHOTS-PER-TEAM
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(def ^:private schema:snapshots-per-team
-  [:map
-   [::profile-id ::sm/uuid]
-   [::team-id ::sm/uuid]])
-
-(def ^:private valid-snapshots-per-team-quote?
-  (sm/lazy-validator schema:snapshots-per-team))
-
-(def ^:private sql:get-snapshots-per-team
-  "SELECT count(*) AS total
-     FROM file_change AS fc
-     JOIN file AS f ON (f.id = fc.file_id)
-     JOIN project AS p ON (p.id = f.project_id)
-    WHERE p.team_id = ?
-      AND fc.created_by = 'user'
-      AND fc.deleted_at IS NULL
-      AND fc.data IS NOT NULL")
-
-(defmethod check-quote ::snapshots-per-team
-  [{:keys [::profile-id ::team-id ::target] :as quote}]
-  (assert (valid-snapshots-per-team-quote? quote) "invalid quote parameters")
-  (-> quote
-      (assoc ::default (cf/get :quotes-snapshots-per-team Integer/MAX_VALUE))
-      (assoc ::quote-sql [sql:get-quotes-2 target team-id profile-id profile-id])
-      (assoc ::count-sql [sql:get-snapshots-per-team team-id])
-      (generic-check!)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; QUOTE: TEAM-ACCESS-REQUESTS-PER-TEAM
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(def ^:private schema:team-access-requests-per-team
-  [:map
-   [::profile-id ::sm/uuid]
-   [::team-id ::sm/uuid]])
-
-(def ^:private valid-team-access-requests-per-team-quote?
-  (sm/lazy-validator schema:team-access-requests-per-team))
-
-(def ^:private sql:get-team-access-requests-per-team
-  "SELECT count(*) AS total
-     FROM team_access_request AS tar
-    WHERE tar.team_id = ?")
-
-(defmethod check-quote ::team-access-requests-per-team
-  [{:keys [::profile-id ::team-id ::target] :as quote}]
-  (assert (valid-team-access-requests-per-team-quote? quote) "invalid quote parameters")
-  (-> quote
-      (assoc ::default (cf/get :quotes-team-access-requests-per-team Integer/MAX_VALUE))
-      (assoc ::quote-sql [sql:get-quotes-2 target team-id profile-id profile-id])
-      (assoc ::count-sql [sql:get-team-access-requests-per-team team-id])
-      (generic-check!)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; QUOTE: TEAM-ACCESS-REQUESTS-PER-REQUESTER
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(def ^:private schema:team-access-requests-per-requester
-  [:map
-   [::profile-id ::sm/uuid]])
-
-(def ^:private valid-team-access-requests-per-requester-quote?
-  (sm/lazy-validator schema:team-access-requests-per-requester))
-
-(def ^:private sql:get-team-access-requests-per-requester
-  "SELECT count(*) AS total
-     FROM team_access_request AS tar
-    WHERE tar.requester_id = ?")
-
-(defmethod check-quote ::team-access-requests-per-requester
-  [{:keys [::profile-id ::target] :as quote}]
-  (assert (valid-team-access-requests-per-requester-quote? quote) "invalid quote parameters")
-  (-> quote
-      (assoc ::default (cf/get :quotes-team-access-requests-per-requester Integer/MAX_VALUE))
-      (assoc ::quote-sql [sql:get-quotes-1 target profile-id])
-      (assoc ::count-sql [sql:get-team-access-requests-per-requester profile-id])
-      (generic-check!)))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; QUOTE: DEFAULT
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

backend/src/app/rpc/rlimit.clj

@@ -46,7 +46,7 @@
    [app.common.data :as d]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
-   [app.common.schema :as sm]
+   [app.common.spec :as us]
    [app.common.uri :as uri]
    [app.common.uuid :as uuid]
    [app.config :as cf]
@@ -61,6 +61,7 @@
    [app.util.time :as dt]
    [app.worker :as wrk]
    [clojure.edn :as edn]
+   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [datoteka.fs :as fs]
    [integrant.core :as ig]
@@ -94,46 +95,9 @@
 (defmulti parse-limit   (fn [[_ strategy _]] strategy))
 (defmulti process-limit (fn [_ _ _ o] (::strategy o)))
 
-(sm/register!
- {:type ::rpc/rlimit
-  :pred #(instance? clojure.lang.Agent %)})
-
-(def ^:private schema:strategy
-  [:enum :window :bucket])
-
-(def ^:private schema:limit-tuple
-  [:tuple :keyword schema:strategy :string])
-
-(def ^:private schema:limit
-  [:and
-   [:map
-    [::name :any]
-    [::strategy schema:strategy]
-    [::key :string]
-    [::opts :string]]
-   [:or
-    [:map
-     [::capacity ::sm/int]
-     [::rate ::sm/int]
-     [::internal ::dt/duration]
-     [::params [::sm/vec :any]]]
-    [:map
-     [::nreq ::sm/int]
-     [::unit [:enum :days :hours :minutes :seconds :weeks]]]]])
-
-(def ^:private schema:limits
-  [:map-of :keyword [::sm/vec schema:limit]])
-
-(def ^:private valid-limit-tuple?
-  (sm/lazy-validator schema:limit-tuple))
-
-(def ^:private valid-rlimit-instance?
-  (sm/lazy-validator ::rpc/rlimit))
-
 (defmethod parse-limit :window
   [[name strategy opts :as vlimit]]
-  (assert (valid-limit-tuple? vlimit) "expected valid limit tuple")
-
+  (us/assert! ::limit-tuple vlimit)
   (merge
    {::name name
     ::strategy strategy}
@@ -154,8 +118,7 @@
 
 (defmethod parse-limit :bucket
   [[name strategy opts :as vlimit]]
-  (assert (valid-limit-tuple? vlimit) "expected valid limit tuple")
-
+  (us/assert! ::limit-tuple vlimit)
   (if-let [[_ capacity rate interval] (re-find bucket-opts-re opts)]
     (let [interval (dt/duration interval)
           rate     (parse-long rate)
@@ -177,7 +140,7 @@
   (let [script    (-> bucket-rate-limit-script
                       (assoc ::rscript/keys [(str key "." service "." user-id)])
                       (assoc ::rscript/vals (conj params (dt/->seconds now))))
-        result    (rds/eval redis script)
+        result    (rds/eval! redis script)
         allowed?  (boolean (nth result 0))
         remaining (nth result 1)
         reset     (* (/ (inst-ms interval) rate)
@@ -201,7 +164,7 @@
         script    (-> window-rate-limit-script
                       (assoc ::rscript/keys [(str key "." service "." user-id "." (dt/format-instant ts))])
                       (assoc ::rscript/vals [nreq (dt/->seconds ttl)]))
-        result    (rds/eval redis script)
+        result    (rds/eval! redis script)
         allowed?  (boolean (nth result 0))
         remaining (nth result 1)]
     (l/trace :hint "limit processed"
@@ -282,8 +245,8 @@
 
 (defn wrap
   [{:keys [::rpc/rlimit ::rds/redis] :as cfg} f mdata]
-  (assert (rds/redis? redis) "expected a valid redis instance")
-  (assert (or (nil? rlimit) (valid-rlimit-instance? rlimit)) "expected a valid rlimit instance")
+  (us/assert! ::rpc/rlimit rlimit)
+  (us/assert! ::rds/redis redis)
 
   (if rlimit
     (let [skey  (keyword (::rpc/type cfg) (->> mdata ::sv/spec name))
@@ -312,19 +275,42 @@
 ;; CONFIG WATCHER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(def ^:private schema:config
-  [:map-of
-   [:or :keyword [:set :keyword]]
-   [:vector schema:limit-tuple]])
+(s/def ::strategy (s/and ::us/keyword #{:window :bucket}))
+(s/def ::capacity ::us/integer)
+(s/def ::rate ::us/integer)
+(s/def ::interval ::dt/duration)
+(s/def ::key ::us/string)
+(s/def ::opts ::us/string)
+(s/def ::params vector?)
+(s/def ::unit #{:days :hours :minutes :seconds :weeks})
+(s/def ::nreq ::us/integer)
+(s/def ::refresh ::dt/duration)
 
-(def ^:private check-config
-  (sm/check-fn schema:config))
+(s/def ::limit-tuple
+  (s/tuple ::us/keyword ::strategy string?))
 
-(def ^:private check-refresh
-  (sm/check-fn ::dt/duration))
+(s/def ::limits
+  (s/map-of keyword? (s/every ::limit :kind vector?)))
 
-(def ^:private check-limits
-  (sm/check-fn schema:limits))
+(s/def ::limit
+  (s/and
+   (s/keys :req [::name ::strategy ::key ::opts])
+   (s/or :bucket
+         (s/keys :req [::capacity
+                       ::rate
+                       ::interval
+                       ::params])
+         :window
+         (s/keys :req [::nreq
+                       ::unit]))))
+
+(s/def ::rpc/rlimit
+  (s/nilable
+   #(instance? clojure.lang.Agent %)))
+
+(s/def ::config
+  (s/map-of (s/or :kw keyword? :set set?)
+            (s/every ::limit-tuple :kind vector?)))
 
 (defn read-config
   [path]
@@ -350,9 +336,13 @@
                          {}
                          config)))]
 
-    (when-let [config (some->> path slurp edn/read-string check-config)]
-      (let [refresh (->> config meta :refresh dt/duration check-refresh)
-            limits  (->> config compile-pass-1 compile-pass-2 check-limits)]
+    (when-let [config (some->> path slurp edn/read-string)]
+      (us/verify! ::config config)
+      (let [refresh (->> config meta :refresh dt/duration)
+            limits  (->> config compile-pass-1 compile-pass-2)]
+
+        (us/verify! ::limits limits)
+        (us/verify! ::refresh refresh)
 
         {::refresh refresh
          ::limits limits}))))
@@ -395,9 +385,8 @@
   (when-let [path (cf/get :rpc-rlimit-config)]
     (and (fs/exists? path) (fs/regular-file? path) path)))
 
-(defmethod ig/assert-key :app.rpc/rlimit
-  [_ {:keys [::wrk/executor]}]
-  (assert (sm/valid? ::wrk/executor executor) "expect valid executor"))
+(defmethod ig/pre-init-spec :app.rpc/rlimit [_]
+  (s/keys :req [::wrk/executor]))
 
 (defmethod ig/init-key ::rpc/rlimit
   [_ {:keys [::wrk/executor] :as cfg}]

backend/src/app/setup.clj

@@ -9,7 +9,7 @@
   (:require
    [app.common.data :as d]
    [app.common.logging :as l]
-   [app.common.schema :as sm]
+   [app.common.spec :as us]
    [app.common.uuid :as uuid]
    [app.db :as db]
    [app.main :as-alias main]
@@ -17,6 +17,7 @@
    [app.setup.templates]
    [buddy.core.codecs :as bc]
    [buddy.core.nonce :as bn]
+   [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
 (defn- generate-random-key
@@ -72,10 +73,12 @@
     (db/run! system (fn [{:keys [::db/conn]}]
                       (db/exec-one! conn [sql:add-prop prop value false value false])))))
 
-(defmethod ig/assert-key ::props
-  [_ params]
-  (assert (db/pool? (::db/pool params)) "expected valid database pool")
-  (assert (string? (::key params)) "expected valid key string"))
+(s/def ::key ::us/string)
+(s/def ::props (s/map-of ::us/keyword some?))
+
+(defmethod ig/pre-init-spec ::props [_]
+  (s/keys :req [::db/pool]
+          :opt [::key]))
 
 (defmethod ig/init-key ::props
   [_ {:keys [::db/pool ::key] :as cfg}]
@@ -91,7 +94,3 @@
           (assoc :secret-key secret)
           (assoc :tokens-key (keys/derive secret :salt "tokens"))
           (update :instance-id handle-instance-id conn (db/read-only? pool))))))
-
-
-;; FIXME
-(sm/register! ::props :any)

backend/src/app/setup/templates.clj

@@ -10,7 +10,6 @@
   (:require
    [app.common.data :as d]
    [app.common.data.macros :as dm]
-   [app.common.exceptions :as ex]
    [app.common.logging :as l]
    [app.common.schema :as sm]
    [app.http.client :as http]
@@ -20,26 +19,26 @@
    [datoteka.fs :as fs]
    [integrant.core :as ig]))
 
-(def ^:private schema:template
+(def ^:private
+  schema:template
   [:map {:title "Template"}
    [:id ::sm/word-string]
    [:name ::sm/word-string]
    [:file-uri ::sm/word-string]])
 
-(def ^:private schema:templates
+(def ^:private
+  schema:templates
   [:vector schema:template])
 
-(def check-templates!
-  (sm/check-fn schema:templates
-               :code :invalid-templates
-               :hint "invalid templates"))
-
 (defmethod ig/init-key ::setup/templates
   [_ _]
   (let [templates (-> "app/onboarding.edn" io/resource slurp edn/read-string)
-        templates (check-templates! templates)
         dest      (fs/join fs/*cwd* "builtin-templates")]
 
+    (dm/verify!
+     "expected a valid templates file"
+     (sm/check! schema:templates templates))
+
     (doseq [{:keys [id path] :as template} templates]
       (let [path (or path (fs/join dest id))]
         (if (fs/exists? path)
@@ -59,9 +58,9 @@
         (let [resp (http/req! cfg
                               {:method :get :uri (:file-uri template)}
                               {:response-type :input-stream :sync? true})]
-          (when-not (= 200 (:status resp))
-            (ex/raise :type :internal
-                      :code :unexpected-status-code
-                      :hint (str "unable to download template, recevied status " (:status resp))))
+
+          (dm/verify!
+           "unexpected response found on fetching template"
+           (= 200 (:status resp)))
 
           (io/input-stream (:body resp)))))))

backend/src/app/setup/welcome_file.clj

@@ -10,7 +10,6 @@
    [app.db :as db]
    [app.rpc :as-alias rpc]
    [app.rpc.climit :as-alias climit]
-   [app.rpc.commands.files :as files]
    [app.rpc.commands.files-update :as fupdate]
    [app.rpc.commands.management :as management]
    [app.rpc.commands.profile :as profile]
@@ -52,11 +51,9 @@
                            :project-id (:default-project-id profile)}
           template-stream (tmpl/get-template-stream cfg "welcome")
           file-id         (-> (management/clone-template cfg params template-stream)
-                              first)
-          file-name       (str fullname "'s first file")]
+                              first)]
 
       (db/tx-run! cfg (fn [{:keys [::db/conn] :as cfg}]
-                        (files/rename-file conn {:id file-id :name file-name})
                         (fupdate/update-file! cfg file-id update-welcome-shape fullname)
                         (profile/update-profile-props cfg id {:welcome-file-id file-id})
                         (db/exec-one! conn [sql:mark-file-object-thumbnails-deleted file-id])

backend/src/app/srepl.clj

@@ -8,6 +8,7 @@
   "Server Repl."
   (:require
    [app.common.logging :as l]
+   [app.common.spec :as us]
    [app.config :as cf]
    [app.srepl.cli]
    [app.srepl.main]
@@ -15,6 +16,7 @@
    [app.util.locks :as locks]
    [clojure.core.server :as ccs]
    [clojure.main :as cm]
+   [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
 (defn- repl-init
@@ -42,14 +44,16 @@
 
 ;; --- State initialization
 
-(defmethod ig/assert-key ::server
-  [_ params]
-  (assert (int? (::port params)) "expected valid port")
-  (assert (string? (::host params)) "expected valid host"))
+(s/def ::port ::us/integer)
+(s/def ::host ::us/not-empty-string)
 
-(defmethod ig/expand-key ::server
-  [[type :as k] v]
-  {k (assoc v ::flag (keyword (str (name type) "-server")))})
+(defmethod ig/pre-init-spec ::server
+  [_]
+  (s/keys :req [::host ::port]))
+
+(defmethod ig/prep-key ::server
+  [[type _] cfg]
+  (assoc cfg ::flag (keyword (str (name type) "-server"))))
 
 (defmethod ig/init-key ::server
   [[type _] {:keys [::flag ::port ::host] :as cfg}]

backend/src/app/srepl/helpers.clj

@@ -122,19 +122,22 @@
       WHERE file_id = ANY(?)
         AND id IS NOT NULL")
 
-(defn search-file-snapshots
+(defn get-file-snapshots
   "Get a seq parirs of file-id and snapshot-id for a set of files
    and specified label"
-  [conn file-ids label]
+  [conn label ids]
   (db/exec! conn [sql:snapshots-with-file label
-                  (db/create-array conn "uuid" file-ids)]))
+                  (db/create-array conn "uuid" ids)]))
 
 (defn take-team-snapshot!
   [system team-id label]
   (let [conn (db/get-connection system)]
     (->> (feat.comp-v2/get-and-lock-team-files conn team-id)
-         (reduce (fn [result file-id]
-                   (fsnap/create-file-snapshot! system nil file-id label)
+         (map (fn [file-id]
+                {:file-id file-id
+                 :label label}))
+         (reduce (fn [result params]
+                   (fsnap/take-file-snapshot! conn params)
                    (inc result))
                  0))))
 
@@ -144,7 +147,7 @@
         ids  (->> (feat.comp-v2/get-and-lock-team-files conn team-id)
                   (into #{}))
 
-        snap (search-file-snapshots conn ids label)
+        snap (get-file-snapshots conn label ids)
 
         ids' (into #{} (map :file-id) snap)
         team (-> (feat.comp-v2/get-team conn team-id)
@@ -154,8 +157,8 @@
       (throw (RuntimeException. "no uniform snapshot available")))
 
     (feat.comp-v2/update-team! conn team)
-    (reduce (fn [result {:keys [file-id id]}]
-              (fsnap/restore-file-snapshot! system file-id id)
+    (reduce (fn [result params]
+              (fsnap/restore-file-snapshot! conn params)
               (inc result))
             0
             snap)))
@@ -164,7 +167,7 @@
   [system file-id update-fn & {:keys [label validate? with-libraries?] :or {validate? true} :as opts}]
 
   (when (string? label)
-    (fsnap/create-file-snapshot! system nil file-id label))
+    (fsnap/take-file-snapshot! system {:file-id file-id :label label}))
 
   (let [conn  (db/get-connection system)
         file  (get-file system file-id opts)

backend/src/app/srepl/main.clj

@@ -155,10 +155,9 @@
 
 (defn enable-team-feature!
   [team-id feature]
-  (when-not (contains? cfeat/supported-features feature)
-    (ex/raise :type :assertion
-              :code :feature-not-supported
-              :hint (str "feature '" feature "' not supported")))
+  (dm/verify!
+   "feature should be supported"
+   (contains? cfeat/supported-features feature))
 
   (let [team-id (h/parse-uuid team-id)]
     (db/tx-run! main/system
@@ -174,11 +173,9 @@
 
 (defn disable-team-feature!
   [team-id feature]
-
-  (when-not (contains? cfeat/supported-features feature)
-    (ex/raise :type :assertion
-              :code :feature-not-supported
-              :hint (str "feature '" feature "' not supported")))
+  (dm/verify!
+   "feature should be supported"
+   (contains? cfeat/supported-features feature))
 
   (let [team-id (h/parse-uuid team-id)]
     (db/tx-run! main/system
@@ -206,11 +203,9 @@
   [{:keys [::mbus/msgbus ::db/pool]} & {:keys [dest code message level]
                                         :or {code :generic level :info}
                                         :as params}]
-
-  (when-not (contains? #{:success :error :info :warning} level)
-    (ex/raise :type :assertion
-              :code :incorrect-level
-              :hint (str "level '" level "' not supported")))
+  (dm/verify!
+   ["invalid level %" level]
+   (contains? #{:success :error :info :warning} level))
 
   (letfn [(send [dest]
             (l/inf :hint "sending notification" :dest (str dest))
@@ -311,29 +306,33 @@
   collectable file-changes entry."
   [& {:keys [file-id label]}]
   (let [file-id (h/parse-uuid file-id)]
-    (db/tx-run! main/system fsnap/create-file-snapshot! {:file-id file-id :label label})))
+    (db/tx-run! main/system fsnap/take-file-snapshot! {:file-id file-id :label label})))
 
 (defn restore-file-snapshot!
   [file-id label]
   (let [file-id (h/parse-uuid file-id)]
     (db/tx-run! main/system
                 (fn [{:keys [::db/conn] :as system}]
-                  (when-let [snapshot (->> (h/search-file-snapshots conn #{file-id} label)
+                  (when-let [snapshot (->> (h/get-file-snapshots conn label #{file-id})
                                            (map :id)
                                            (first))]
-                    (fsnap/restore-file-snapshot! system file-id (:id snapshot)))))))
+                    (fsnap/restore-file-snapshot! system
+                                                  {:id (:id snapshot)
+                                                   :file-id file-id}))))))
 
 (defn list-file-snapshots!
-  [file-id & {:as _}]
+  [file-id & {:keys [limit]}]
   (let [file-id (h/parse-uuid file-id)]
     (db/tx-run! main/system
-                (fn [{:keys [::db/conn]}]
-                  (->> (fsnap/get-file-snapshots conn file-id)
-                       (print-table [:label :id :revn :created-at]))))))
+                (fn [system]
+                  (let [params {:file-id file-id :limit limit}]
+                    (->> (fsnap/get-file-snapshots system (d/without-nils params))
+                         (print-table [:label :id :revn :created-at])))))))
 
 (defn take-team-snapshot!
   [team-id & {:keys [label rollback?] :or {rollback? true}}]
-  (let [team-id (h/parse-uuid team-id)]
+  (let [team-id (h/parse-uuid team-id)
+        label   (or label (fsnap/generate-snapshot-label))]
     (-> (assoc main/system ::db/rollback rollback?)
         (db/tx-run! h/take-team-snapshot! team-id label))))
 

backend/src/app/storage.clj

@@ -10,8 +10,7 @@
   (:require
    [app.common.data :as d]
    [app.common.data.macros :as dm]
-   [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]
@@ -19,7 +18,7 @@
    [app.storage.impl :as impl]
    [app.storage.s3 :as ss3]
    [app.util.time :as dt]
-   [cuerdas.core :as str]
+   [clojure.spec.alpha :as s]
    [datoteka.fs :as fs]
    [integrant.core :as ig])
   (:import
@@ -31,61 +30,41 @@
     (case name
       :assets-fs :fs
       :assets-s3 :s3
-      nil)))
-
-(def valid-buckets
-  #{"file-media-object"
-    "team-font-variant"
-    "file-object-thumbnail"
-    "file-thumbnail"
-    "profile"
-    "file-data"
-    "file-data-fragment"
-    "file-change"})
+      :fs)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Storage Module State
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(def ^:private schema:backends
-  [:map-of :keyword
-   [:maybe
-    [:or ::ss3/backend ::sfs/backend]]])
+(s/def ::id #{:assets-fs :assets-s3 :fs :s3})
+(s/def ::s3 ::ss3/backend)
+(s/def ::fs ::sfs/backend)
+(s/def ::type #{:fs :s3})
 
-(def ^:private valid-backends?
-  (sm/validator schema:backends))
+(s/def ::backends
+  (s/map-of ::us/keyword
+            (s/nilable
+             (s/or :s3 ::ss3/backend
+                   :fs ::sfs/backend))))
 
-(def ^:private schema:storage
-  [:map {:title "storage"}
-   [::backends schema:backends]
-   [::backend [:enum :s3 :fs]]
-   ::db/connectable])
-
-(def valid-storage?
-  (sm/validator schema:storage))
-
-(sm/register! ::storage schema:storage)
-
-(defmethod ig/assert-key ::storage
-  [_ params]
-  (assert (db/pool? (::db/pool params)) "expected valid database pool")
-  (assert (valid-backends? (::backends params)) "expected valid backends map"))
+(defmethod ig/pre-init-spec ::storage [_]
+  (s/keys :req [::db/pool ::backends]))
 
 (defmethod ig/init-key ::storage
   [_ {:keys [::backends ::db/pool] :as cfg}]
-  (let [backend (or (get-legacy-backend)
-                    (cf/get :objects-storage-backend)
-                    :fs)
-        backends (d/without-nils backends)]
+  (-> (d/without-nils cfg)
+      (assoc ::backends (d/without-nils backends))
+      (assoc ::backend (or (get-legacy-backend)
+                           (cf/get :objects-storage-backend :fs)))
+      (assoc ::db/connectable pool)))
 
-    (l/dbg :hint "initialize"
-           :default (d/name backend)
-           :available (str/join "," (map d/name (keys backends))))
+(s/def ::backend keyword?)
+(s/def ::storage
+  (s/keys :req [::backends ::db/pool ::db/connectable]
+          :opt [::backend]))
 
-    (-> (d/without-nils cfg)
-        (assoc ::backends backends)
-        (assoc ::backend backend)
-        (assoc ::db/connectable pool))))
+(s/def ::storage-with-backend
+  (s/and ::storage #(contains? % ::backend)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Database Objects
@@ -201,16 +180,15 @@
 (dm/export impl/object?)
 
 (defn get-object
-  [{:keys [::db/connectable] :as storage}  id]
-  (assert (valid-storage? storage))
+  [{:keys [::db/connectable] :as storage} id]
+  (us/assert! ::storage storage)
   (retrieve-database-object connectable id))
 
 (defn put-object!
   "Creates a new object with the provided content."
   [{:keys [::backend] :as storage} {:keys [::content] :as params}]
-  (assert (valid-storage? storage))
-  (assert (impl/content? content) "expected an instance of content")
-
+  (us/assert! ::storage-with-backend storage)
+  (us/assert! ::impl/content content)
   (let [object (create-database-object storage params)]
     (if (::created? (meta object))
       ;; Store the data finally on the underlying storage subsystem.
@@ -221,7 +199,7 @@
 (defn touch-object!
   "Mark object as touched."
   [{:keys [::db/connectable] :as storage} object-or-id]
-  (assert (valid-storage? storage))
+  (us/assert! ::storage storage)
   (let [id (if (impl/object? object-or-id) (:id object-or-id) object-or-id)]
     (-> (db/update! connectable :storage-object
                     {:touched-at (dt/now)}
@@ -233,7 +211,7 @@
   "Return an input stream instance of the object content."
   ^InputStream
   [storage object]
-  (assert (valid-storage? storage))
+  (us/assert! ::storage storage)
   (when (or (nil? (:expired-at object))
             (dt/is-after? (:expired-at object) (dt/now)))
     (-> (impl/resolve-backend storage (:backend object))
@@ -242,7 +220,7 @@
 (defn get-object-bytes
   "Returns a byte array of object content."
   [storage object]
-  (assert (valid-storage? storage))
+  (us/assert! ::storage storage)
   (when (or (nil? (:expired-at object))
             (dt/is-after? (:expired-at object) (dt/now)))
     (-> (impl/resolve-backend storage (:backend object))
@@ -252,7 +230,7 @@
   ([storage object]
    (get-object-url storage object nil))
   ([storage object options]
-   (assert (valid-storage? storage))
+   (us/assert! ::storage storage)
    (when (or (nil? (:expired-at object))
              (dt/is-after? (:expired-at object) (dt/now)))
      (-> (impl/resolve-backend storage (:backend object))
@@ -262,7 +240,7 @@
   "Get the Path to the object. Only works with `:fs` type of
   storages."
   [storage object]
-  (assert (valid-storage? storage))
+  (us/assert! ::storage storage)
   (let [backend (impl/resolve-backend storage (:backend object))]
     (when (and (= :fs (::type backend))
                (or (nil? (:expired-at object))
@@ -271,7 +249,7 @@
 
 (defn del-object!
   [{:keys [::db/connectable] :as storage} object-or-id]
-  (assert (valid-storage? storage))
+  (us/assert! ::storage storage)
   (let [id  (if (impl/object? object-or-id) (:id object-or-id) object-or-id)
         res (db/update! connectable :storage-object
                         {:deleted-at (dt/now)}
@@ -279,12 +257,9 @@
     (pos? (db/get-update-count res))))
 
 (dm/export impl/calculate-hash)
-(dm/export impl/get-hash)
-(dm/export impl/get-size)
 
 (defn configure
   [storage connectable]
-  (assert (valid-storage? storage))
   (assoc storage ::db/connectable connectable))
 
 (defn resolve

backend/src/app/storage/fs.clj

@@ -6,29 +6,27 @@
 
 (ns app.storage.fs
   (:require
+   [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
-   [app.common.schema :as sm]
+   [app.common.spec :as us]
    [app.common.uri :as u]
    [app.storage :as-alias sto]
    [app.storage.impl :as impl]
+   [clojure.spec.alpha :as s]
    [cuerdas.core :as str]
    [datoteka.fs :as fs]
    [datoteka.io :as io]
    [integrant.core :as ig])
   (:import
-   java.io.InputStream
-   java.io.OutputStream
    java.nio.file.Files
    java.nio.file.Path))
 
-(set! *warn-on-reflection* true)
-
 ;; --- BACKEND INIT
 
-(defmethod ig/assert-key ::backend
-  [_ params]
-  ;; FIXME:  path (?)
-  (assert (string? (::directory params))))
+(s/def ::directory ::us/string)
+
+(defmethod ig/pre-init-spec ::backend [_]
+  (s/keys :opt [::directory]))
 
 (defmethod ig/init-key ::backend
   [_ cfg]
@@ -41,22 +39,18 @@
              ::directory (str dir)
              ::uri (u/uri (str "file://" dir))))))
 
-(def ^:private schema:backend
-  [:map {:title "fs-backend"}
-   [::directory :string]
-   [::uri ::sm/uri]
-   [::sto/type [:= :fs]]])
-
-(sm/register! ::backend schema:backend)
-
-(def ^:private valid-backend?
-  (sm/validator schema:backend))
+(s/def ::uri u/uri?)
+(s/def ::backend
+  (s/keys :req [::directory
+                ::uri]
+          :opt [::sto/type
+                ::sto/id]))
 
 ;; --- API IMPL
 
 (defmethod impl/put-object :fs
   [backend {:keys [id] :as object} content]
-  (assert (valid-backend? backend) "expected a valid backend instance")
+  (us/assert! ::backend backend)
   (let [base (fs/path (::directory backend))
         path (fs/path (impl/id->path id))
         full (fs/normalize (fs/join base path))]
@@ -64,15 +58,15 @@
     (when-not (fs/exists? (fs/parent full))
       (fs/create-dir (fs/parent full)))
 
-    (with-open [^InputStream src (io/input-stream content)]
-      (with-open [^OutputStream dst (io/output-stream full)]
-        (io/copy src dst)))
+    (dm/with-open [src (io/input-stream content)
+                   dst (io/output-stream full)]
+      (io/copy! src dst))
 
     object))
 
 (defmethod impl/get-object-data :fs
   [backend {:keys [id] :as object}]
-  (assert (valid-backend? backend) "expected a valid backend instance")
+  (us/assert! ::backend backend)
   (let [^Path base (fs/path (::directory backend))
         ^Path path (fs/path (impl/id->path id))
         ^Path full (fs/normalize (fs/join base path))]
@@ -84,12 +78,12 @@
 
 (defmethod impl/get-object-bytes :fs
   [backend object]
-  (with-open [^InputStream input (impl/get-object-data backend object)]
-    (io/read input)))
+  (dm/with-open [input (impl/get-object-data backend object)]
+    (io/read-as-bytes input)))
 
 (defmethod impl/get-object-url :fs
   [{:keys [::uri] :as backend} {:keys [id] :as object} _]
-  (assert (valid-backend? backend) "expected a valid backend instance")
+  (us/assert! ::backend backend)
   (update uri :path
           (fn [existing]
             (if (str/ends-with? existing "/")
@@ -98,7 +92,7 @@
 
 (defmethod impl/del-object :fs
   [backend {:keys [id] :as object}]
-  (assert (valid-backend? backend) "expected a valid backend instance")
+  (us/assert! ::backend backend)
   (let [base (fs/path (::directory backend))
         path (fs/path (impl/id->path id))
         path (fs/join base path)]
@@ -106,7 +100,7 @@
 
 (defmethod impl/del-objects-in-bulk :fs
   [backend ids]
-  (assert (valid-backend? backend) "expected a valid backend instance")
+  (us/assert! ::backend backend)
   (let [base (fs/path (::directory backend))]
     (doseq [id ids]
       (let [path (fs/path (impl/id->path id))

backend/src/app/storage/gc_deleted.clj

@@ -16,9 +16,10 @@
    [app.common.data :as d]
    [app.common.logging :as l]
    [app.db :as db]
-   [app.storage :as sto]
+   [app.storage :as-alias sto]
    [app.storage.impl :as impl]
    [app.util.time :as dt]
+   [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
 (def ^:private sql:lock-sobjects
@@ -99,14 +100,13 @@
           0
           (get-buckets conn min-age)))
 
-(defmethod ig/assert-key ::handler
-  [_ params]
-  (assert (sto/valid-storage? (::sto/storage params)) "expect valid storage")
-  (assert (db/pool? (::db/pool params)) "expect valid storage"))
 
-(defmethod ig/expand-key ::handler
-  [k v]
-  {k (assoc v ::min-age (dt/duration {:hours 2}))})
+(defmethod ig/pre-init-spec ::handler [_]
+  (s/keys :req [::sto/storage ::db/pool]))
+
+(defmethod ig/prep-key ::handler
+  [_ cfg]
+  (assoc cfg ::min-age (dt/duration {:hours 2})))
 
 (defmethod ig/init-key ::handler
   [_ {:keys [::min-age] :as cfg}]

backend/src/app/storage/gc_touched.clj

@@ -25,6 +25,7 @@
    [app.db :as db]
    [app.storage :as-alias sto]
    [app.storage.impl :as impl]
+   [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
 (def ^:private sql:has-team-font-variant-refs
@@ -225,9 +226,8 @@
 ;; HANDLER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defmethod ig/assert-key ::handler
-  [_ params]
-  (assert (db/pool? (::db/pool params)) "expect valid storage"))
+(defmethod ig/pre-init-spec ::handler [_]
+  (s/keys :req [::db/pool]))
 
 (defmethod ig/init-key ::handler
   [_ cfg]

backend/src/app/storage/impl.clj

@@ -14,6 +14,7 @@
    [buddy.core.codecs :as bc]
    [buddy.core.hash :as bh]
    [clojure.java.io :as jio]
+   [clojure.spec.alpha :as s]
    [datoteka.io :as io])
   (:import
    java.nio.ByteBuffer
@@ -233,3 +234,7 @@
   [v]
   (satisfies? IContentObject v))
 
+(s/def ::object object?)
+(s/def ::content content?)
+
+

backend/src/app/storage/s3.clj

@@ -11,14 +11,14 @@
    [app.common.data.macros :as dm]
    [app.common.exceptions :as ex]
    [app.common.logging :as l]
-   [app.common.schema :as sm]
+   [app.common.spec :as us]
    [app.common.uri :as u]
    [app.storage :as-alias sto]
    [app.storage.impl :as impl]
    [app.storage.tmp :as tmp]
    [app.util.time :as dt]
-   [app.worker :as-alias wrk]
    [clojure.java.io :as io]
+   [clojure.spec.alpha :as s]
    [datoteka.fs :as fs]
    [integrant.core :as ig]
    [promesa.core :as p]
@@ -27,15 +27,17 @@
    java.io.FilterInputStream
    java.io.InputStream
    java.net.URI
+   java.nio.ByteBuffer
    java.nio.file.Path
    java.time.Duration
    java.util.Collection
    java.util.Optional
+   java.util.concurrent.Semaphore
    org.reactivestreams.Subscriber
+   org.reactivestreams.Subscription
    software.amazon.awssdk.core.ResponseBytes
    software.amazon.awssdk.core.async.AsyncRequestBody
    software.amazon.awssdk.core.async.AsyncResponseTransformer
-   software.amazon.awssdk.core.async.BlockingInputStreamAsyncRequestBody
    software.amazon.awssdk.core.client.config.ClientAsyncConfiguration
    software.amazon.awssdk.core.client.config.SdkAdvancedAsyncClientOption
    software.amazon.awssdk.http.nio.netty.NettyNioAsyncHttpClient
@@ -57,20 +59,6 @@
    software.amazon.awssdk.services.s3.presigner.model.GetObjectPresignRequest
    software.amazon.awssdk.services.s3.presigner.model.PresignedGetObjectRequest))
 
-(def ^:private max-retries
-  "A maximum number of retries on internal operations"
-  3)
-
-(def ^:private max-concurrency
-  "Maximum concurrent request to S3 service"
-  128)
-
-(def ^:private max-pending-connection-acquires
-  20000)
-
-(def default-timeout
-  (dt/duration {:seconds 30}))
-
 (declare put-object)
 (declare get-object-bytes)
 (declare get-object-data)
@@ -85,121 +73,108 @@
 
 ;; --- BACKEND INIT
 
-(def ^:private schema:config
-  [:map {:title "s3-backend-config"}
-   ::wrk/executor
-   [::region {:optional true} :keyword]
-   [::bucket {:optional true} ::sm/text]
-   [::prefix {:optional true} ::sm/text]
-   [::endpoint {:optional true} ::sm/uri]
-   [::io-threads {:optional true} ::sm/int]])
+(s/def ::region ::us/keyword)
+(s/def ::bucket ::us/string)
+(s/def ::prefix ::us/string)
+(s/def ::endpoint ::us/string)
+(s/def ::io-threads ::us/integer)
 
-(defmethod ig/expand-key ::backend
-  [k v]
-  {k (merge {::region :eu-central-1} (d/without-nils v))})
+(defmethod ig/pre-init-spec ::backend [_]
+  (s/keys :opt [::region ::bucket ::prefix ::endpoint ::io-threads]))
 
-(defmethod ig/assert-key ::backend
-  [_ params]
-  (assert (sm/check schema:config params)))
+(defmethod ig/prep-key ::backend
+  [_ {:keys [::prefix ::region] :as cfg}]
+  (cond-> (d/without-nils cfg)
+    (some? prefix) (assoc ::prefix prefix)
+    (nil? region)  (assoc ::region :eu-central-1)))
 
 (defmethod ig/init-key ::backend
-  [_ params]
-  (when (and (contains? params ::region)
-             (contains? params ::bucket))
-    (let [client    (build-s3-client params)
-          presigner (build-s3-presigner params)]
-      (assoc params
+  [_ cfg]
+  ;; Return a valid backend data structure only if all optional
+  ;; parameters are provided.
+  (when (and (contains? cfg ::region)
+             (string? (::bucket cfg)))
+    (let [client    (build-s3-client cfg)
+          presigner (build-s3-presigner cfg)]
+      (assoc cfg
              ::sto/type :s3
              ::client @client
              ::presigner presigner
              ::close-fn #(.close ^java.lang.AutoCloseable client)))))
 
-(defmethod ig/resolve-key ::backend
-  [_ params]
-  (dissoc params ::close-fn))
-
 (defmethod ig/halt-key! ::backend
   [_ {:keys [::close-fn]}]
   (when (fn? close-fn)
     (px/run! close-fn)))
 
-(def ^:private schema:backend
-  [:map {:title "s3-backend"}
-   ;; [::region :keyword]
-   ;; [::bucket ::sm/text]
-   [::client [:fn #(instance? S3AsyncClient %)]]
-   [::presigner [:fn #(instance? S3Presigner %)]]
-   [::prefix {:optional true} ::sm/text]
-   #_[::sto/type [:= :s3]]])
-
-(sm/register! ::backend schema:backend)
-
-(def ^:private valid-backend?
-  (sm/validator schema:backend))
+(s/def ::client #(instance? S3AsyncClient %))
+(s/def ::presigner #(instance? S3Presigner %))
+(s/def ::backend
+  (s/keys :req [::region
+                ::bucket
+                ::client
+                ::presigner]
+          :opt [::prefix
+                ::sto/id]))
 
 ;; --- API IMPL
 
 (defmethod impl/put-object :s3
   [backend object content]
-  (assert (valid-backend? backend) "expected a valid backend instance")
+  (us/assert! ::backend backend)
   (p/await! (put-object backend object content)))
 
 (defmethod impl/get-object-data :s3
   [backend object]
-  (assert (valid-backend? backend) "expected a valid backend instance")
-  (loop [result (get-object-data backend object)
-         retryn 0]
+  (us/assert! ::backend backend)
 
-    (let [result (p/await result)]
-      (if (ex/exception? result)
-        (cond
-          (ex/instance? NoSuchKeyException result)
-          (ex/raise :type :not-found
-                    :code :object-not-found
-                    :hint "s3 object not found"
-                    :object-id (:id object)
-                    :object-path (impl/id->path (:id object))
-                    :cause result)
+  (let [result (p/await (get-object-data backend object))]
+    (if (ex/exception? result)
+      (cond
+        (ex/instance? NoSuchKeyException result)
+        (ex/raise :type :not-found
+                  :code :object-not-found
+                  :hint "s3 object not found"
+                  :cause result)
+        :else
+        (throw result))
 
-          (and (ex/instance? java.nio.file.FileAlreadyExistsException result)
-               (< retryn max-retries))
-          (recur (get-object-data backend object)
-                 (inc retryn))
-
-          :else
-          (throw result))
-
-        result))))
+      result)))
 
 (defmethod impl/get-object-bytes :s3
   [backend object]
-  (assert (valid-backend? backend) "expected a valid backend instance")
+  (us/assert! ::backend backend)
   (p/await! (get-object-bytes backend object)))
 
 (defmethod impl/get-object-url :s3
   [backend object options]
-  (assert (valid-backend? backend) "expected a valid backend instance")
+  (us/assert! ::backend backend)
   (get-object-url backend object options))
 
 (defmethod impl/del-object :s3
   [backend object]
+  (us/assert! ::backend backend)
   (p/await! (del-object backend object)))
 
 (defmethod impl/del-objects-in-bulk :s3
   [backend ids]
-  (assert (valid-backend? backend) "expected a valid backend instance")
+  (us/assert! ::backend backend)
   (p/await! (del-object-in-bulk backend ids)))
 
 ;; --- HELPERS
 
+(def default-timeout
+  (dt/duration {:seconds 30}))
+
 (defn- lookup-region
   ^Region
   [region]
   (Region/of (name region)))
 
 (defn- build-s3-client
-  [{:keys [::region ::endpoint ::io-threads ::wrk/executor]}]
-  (let [aconfig  (-> (ClientAsyncConfiguration/builder)
+  [{:keys [::region ::endpoint ::io-threads]}]
+  (let [executor (px/resolve-executor :virtual)
+        aconfig  (-> (ClientAsyncConfiguration/builder)
                      (.advancedOption SdkAdvancedAsyncClientOption/FUTURE_COMPLETION_EXECUTOR executor)
                      (.build))
 
@@ -215,8 +190,6 @@
                      (.connectionTimeout default-timeout)
                      (.readTimeout default-timeout)
                      (.writeTimeout default-timeout)
-                     (.maxConcurrency (int max-concurrency))
-                     (.maxPendingConnectionAcquires (int max-pending-connection-acquires))
                      (.build))
 
         client   (let [builder (S3AsyncClient/builder)
@@ -226,7 +199,7 @@
                        builder (.region ^S3AsyncClientBuilder builder (lookup-region region))
                        builder (cond-> ^S3AsyncClientBuilder builder
                                  (some? endpoint)
-                                 (.endpointOverride (URI. (str endpoint))))]
+                                 (.endpointOverride (URI. endpoint)))]
                    (.build ^S3AsyncClientBuilder builder))]
 
     (reify
@@ -245,43 +218,74 @@
                    (.build))]
 
     (-> (S3Presigner/builder)
-        (cond-> (some? endpoint) (.endpointOverride (URI. (str endpoint))))
+        (cond-> (some? endpoint) (.endpointOverride (URI. endpoint)))
         (.region (lookup-region region))
         (.serviceConfiguration ^S3Configuration config)
         (.build))))
 
-(defn- write-input-stream
-  [delegate input]
-  (try
-    (.writeInputStream ^BlockingInputStreamAsyncRequestBody delegate
-                       ^InputStream input)
-    (catch Throwable cause
-      (l/error :hint "encountered error while writing input stream to service"
-               :cause cause))
-    (finally
-      (.close ^InputStream input))))
+(defn- upload-thread
+  [id subscriber sem content]
+  (px/thread
+    {:name "penpot/s3/uploader"
+     :virtual true
+     :daemon true}
+    (l/trace :hint "start upload thread"
+             :object-id (str id)
+             :size (impl/get-size content)
+             ::l/sync? true)
+    (let [stream (io/input-stream content)
+          bsize  (* 1024 64)
+          tpoint (dt/tpoint)]
+      (try
+        (loop []
+          (.acquire ^Semaphore sem 1)
+          (let [buffer (byte-array bsize)
+                readed (.read ^InputStream stream buffer)]
+            (when (pos? readed)
+              (let [data (ByteBuffer/wrap ^bytes buffer 0 readed)]
+                (.onNext ^Subscriber subscriber ^ByteBuffer data)
+                (when (= readed bsize)
+                  (recur))))))
+        (.onComplete ^Subscriber subscriber)
+        (catch InterruptedException _
+          (l/trace :hint "interrupted upload thread"
+                   :object-:id (str id)
+                   ::l/sync? true)
+          nil)
+        (catch Throwable cause
+          (.onError ^Subscriber subscriber cause))
+        (finally
+          (l/trace :hint "end upload thread"
+                   :object-id (str id)
+                   :elapsed (dt/format-duration (tpoint))
+                   ::l/sync? true)
+          (.close ^InputStream stream))))))
 
 (defn- make-request-body
-  [executor content]
-  (let [size (impl/get-size content)]
-    (reify
-      AsyncRequestBody
-      (contentLength [_]
-        (Optional/of (long size)))
+  [id content]
+  (reify
+    AsyncRequestBody
+    (contentLength [_]
+      (Optional/of (long (impl/get-size content))))
+
+    (^void subscribe [_ ^Subscriber subscriber]
+      (let [sem (Semaphore. 0)
+            thr (upload-thread id subscriber sem content)]
+        (.onSubscribe subscriber
+                      (reify Subscription
+                        (cancel [_]
+                          (px/interrupt! thr)
+                          (.release sem 1))
+                        (request [_ n]
+                          (.release sem (int n)))))))))
 
-      (^void subscribe [_ ^Subscriber subscriber]
-        (let [delegate (AsyncRequestBody/forBlockingInputStream (long size))
-              input    (io/input-stream content)]
-          (px/run! executor (partial write-input-stream delegate input))
-          (.subscribe ^BlockingInputStreamAsyncRequestBody delegate
-                      ^Subscriber subscriber))))))
 
 (defn- put-object
-  [{:keys [::client ::bucket ::prefix ::wrk/executor]} {:keys [id] :as object} content]
+  [{:keys [::client ::bucket ::prefix]} {:keys [id] :as object} content]
   (let [path    (dm/str prefix (impl/id->path id))
         mdata   (meta object)
         mtype   (:content-type mdata "application/octet-stream")
-        rbody   (make-request-body executor content)
+        rbody   (make-request-body id content)
         request (.. (PutObjectRequest/builder)
                     (bucket bucket)
                     (contentType mtype)
@@ -342,8 +346,7 @@
 
 (defn- get-object-url
   [{:keys [::presigner ::bucket ::prefix]} {:keys [id]} {:keys [max-age] :or {max-age default-max-age}}]
-  (assert (dt/duration? max-age) "expected valid duration instance")
-
+  (us/assert dt/duration? max-age)
   (let [gor  (.. (GetObjectRequest/builder)
                  (bucket bucket)
                  (key (dm/str prefix (impl/id->path id)))

backend/src/app/storage/tmp.clj

@@ -11,16 +11,13 @@
   permanently delete these files (look at systemd-tempfiles)."
   (:require
    [app.common.logging :as l]
-   [app.common.schema :as sm]
-   [app.common.uuid :as uuid]
    [app.util.time :as dt]
    [app.worker :as wrk]
+   [clojure.spec.alpha :as s]
    [datoteka.fs :as fs]
    [integrant.core :as ig]
    [promesa.exec :as px]
-   [promesa.exec.csp :as sp])
-  (:import
-   java.nio.file.Files))
+   [promesa.exec.csp :as sp]))
 
 (def default-tmp-dir "/tmp/penpot")
 
@@ -29,13 +26,12 @@
 
 (defonce queue (sp/chan :buf 128))
 
-(defmethod ig/assert-key ::cleaner
-  [_ {:keys [::wrk/executor]}]
-  (assert (sm/valid? ::wrk/executor executor)))
+(defmethod ig/pre-init-spec ::cleaner [_]
+  (s/keys :req [::wrk/executor]))
 
-(defmethod ig/expand-key ::cleaner
-  [k v]
-  {k (assoc v ::min-age (dt/duration "60m"))})
+(defmethod ig/prep-key ::cleaner
+  [_ cfg]
+  (assoc cfg ::min-age (dt/duration "60m")))
 
 (defmethod ig/init-key ::cleaner
   [_ cfg]
@@ -80,9 +76,11 @@
   [& {:keys [suffix prefix min-age]
       :or {prefix "penpot."
            suffix ".tmp"}}]
-  (let [attrs (fs/make-permissions "rw-r--r--")
-        path  (fs/join default-tmp-dir (str prefix (uuid/next) suffix))
-        path  (Files/createFile path attrs)]
+  (let [path (fs/create-tempfile
+              :perms "rw-r--r--"
+              :dir default-tmp-dir
+              :suffix suffix
+              :prefix prefix)]
     (fs/delete-on-exit! path)
     (sp/offer! queue [path (some-> min-age dt/duration)])
     path))

backend/src/app/svgo.clj

@@ -7,32 +7,36 @@
 (ns app.svgo
   "A SVG Optimizer service"
   (:require
+   [app.common.jsrt :as jsrt]
    [app.common.logging :as l]
-   [app.util.shell :as shell]
-   [datoteka.fs :as fs]
-   [promesa.exec.semaphore :as ps]))
+   [app.worker :as-alias wrk]
+   [integrant.core :as ig]
+   [promesa.exec.semaphore :as ps]
+   [promesa.util :as pu]))
 
 (def ^:dynamic *semaphore*
   "A dynamic variable that can optionally contain a traffic light to
   appropriately delimit the use of resources, managed externally."
   nil)
 
-(set! *warn-on-reflection* true)
-
 (defn optimize
-  [system data]
+  [{pool ::optimizer} data]
   (try
     (some-> *semaphore* ps/acquire!)
-    (let [script (fs/join fs/*cwd* "scripts/svgo-cli.js")
-          cmd    ["node" (str script)]
-          result (shell/exec! system
-                              :cmd cmd
-                              :in data)]
-      (if (= (:exit result) 0)
-        (:out result)
-        (do
-          (l/raw! :warn (str "Error on optimizing svg, returning svg as-is." (:err result)))
-          data)))
-
+    (jsrt/run! pool
+               (fn [context]
+                 (jsrt/set! context "svgData" data)
+                 (jsrt/eval! context "penpotSvgo.optimize(svgData, {plugins: ['safeAndFastPreset']})")))
     (finally
       (some-> *semaphore* ps/release!))))
+
+(defmethod ig/init-key ::optimizer
+  [_ _]
+  (l/inf :hint "initializing svg optimizer pool")
+  (let [init (jsrt/resource->source "app/common/svg/optimizer.js")]
+    (jsrt/pool :init init)))
+
+(defmethod ig/halt-key! ::optimizer
+  [_ pool]
+  (l/info :hint "stopping svg optimizer pool")
+  (pu/close! pool))

backend/src/app/tasks/delete_object.clj

@@ -12,6 +12,7 @@
    [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]))
 
 (def ^:dynamic *team-deletion* false)
@@ -112,9 +113,8 @@
   [_cfg props]
   (l/wrn :hint "not implementation found" :rel (:object props)))
 
-(defmethod ig/assert-key ::handler
-  [_ params]
-  (assert (db/pool? (::db/pool params)) "expected a valid database pool"))
+(defmethod ig/pre-init-spec ::handler [_]
+  (s/keys :req [::db/pool]))
 
 (defmethod ig/init-key ::handler
   [_ cfg]

backend/src/app/tasks/file_gc.clj

@@ -27,6 +27,7 @@
    [app.util.time :as dt]
    [app.worker :as wrk]
    [clojure.set :as set]
+   [clojure.spec.alpha :as s]
    [integrant.core :as ig]))
 
 (declare ^:private get-file)
@@ -43,7 +44,7 @@
           f.data_ref_id
      FROM file_change AS f
     WHERE f.file_id = ?
-      AND f.data IS NOT NULL
+      AND f.label IS NOT NULL
     ORDER BY f.created_at ASC")
 
 (def ^:private sql:mark-file-media-object-deleted
@@ -314,10 +315,8 @@
 ;; HANDLER
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(defmethod ig/assert-key ::handler
-  [_ params]
-  (assert (db/pool? (::db/pool params)) "expected a valid database pool")
-  (assert (sto/valid-storage? (::sto/storage params)) "expected valid storage to be provided"))
+(defmethod ig/pre-init-spec ::handler [_]
+  (s/keys :req [::db/pool ::sto/storage]))
 
 (defmethod ig/init-key ::handler
   [_ cfg]